I am trying to edit a data table (DT: datatable) on server side and i am using a reactive data table which is rendered on the front end. Now i want to edit the data table and retrieve the information from edited data table. Here is a reproducible example of what i am trying to achieve as mentioned in the comments in the reprex :
library(shiny)
library(DT)
library(tidyverse)
d <- iris
ui <- fluidPage(
dataTableOutput("table1"),
dataTableOutput("table2")
)
server <- function(input,output,session){
# This is the main table I would want to display in its full context
output$table1 <- renderDataTable(
datatable(d)
)
get_row <-reactive({
d %>% slice(input$table1_rows_selected)})
# Here the table with row selected from table 1 is displayed
output$table2 <- renderDataTable({
datatable(get_row(),
editable = TRUE)
})
# Now as the cell gets edited in table 2, i want the edited value to show and make the last column values = NA
proxy <- dataTableProxy("table2")
observeEvent(eventExpr = input$table2_cell_edit, handlerExpr = {
x <- isolate(get_row())
info = input$table2_cell_edit
i = info$row
j = info$column
v = info$value
x[i, j] <<- DT::coerceValue(v, x[i, j])
x <- x %>% mutate(Species = NA)
replaceData(proxy, x, resetPaging = FALSE)
})
}
shinyApp(ui = ui, server = server)
I am getting an error Error in <<-: object 'x' not found. Not sure where am i wrong.
The solution came down to your input$table2_cell_edit names. It uses col not column. The error created an empty x that couldn't accept your assignment of the new value. I used a simpler assignment of the new value.
In the future, use the print() function to print out variables in your app to figure out what's being passed or not passed downstream. That's how a figured out this error.
library(shiny)
library(DT)
library(tidyverse)
d <- iris
ui <- fluidPage(
dataTableOutput("table1"),
dataTableOutput("table2")
)
server <- function(input,output,session){
# This is the main table I would want to display in its full context
output$table1 <- renderDataTable(
datatable(d)
)
get_row <-reactive({
req(input$table1_rows_selected)
d %>% slice(input$table1_rows_selected)})
# Here the table with row selected from table 1 is displayed
output$table2 <- renderDataTable({
req(get_row)
datatable(get_row(),
editable = TRUE)
})
# Now as the cell gets edited in table 2, i want the edited value to show and make the last column values = NA
proxy <- dataTableProxy("table2")
observeEvent(eventExpr = input$table2_cell_edit, handlerExpr = {
x <- isolate(get_row())
info = input$table2_cell_edit
i = info$row
### info uses 'col' not 'column'
j = info$col
v = info$value
### used a base R subset assignment
x[i, j] <- v
x <- x %>% mutate(Species = NA)
replaceData(proxy, x, resetPaging = FALSE)
})
}
shinyApp(ui = ui, server = server)
I'm triying to create a shiny app that allow users to filter a data table by choosing a numeric variable in a selectInput() and a numeric value in a numericValue().
I'm getting erros, whatever I tried
I tried to call a variable in the server function using four ways (input$y, get(input$y), !!get(input$y), !!sym(input$y)), without getting the expected result.
server <- shinyServer(function(input, output){
output$filteredtable <- DT::renderDataTable({
newtab <- movies %>%
dplyr::filter(!!sym(input$y) < !!sym(input$numValue))
DT::datatable(data = newtab)
})
})
I am expecting that the table reacts interactively to the seledcted Input and the defined numeric value.
input$y --> gives an empty table that doesn't interact with what we choose in the selectInput()
get(input$y) --> gives the error: invalid first argument.
!!get(input$y) --> gives the error: object 'runtime' not found ('runtime' is a numeric variable from the used file).
!!sym(input$y) --> gives the error: Only strings can be converted to symbols
For sure #Thomas Fuchs
ui <- shinyUI(
dashboardPage(
dashboardHeader(),
dashboardSidebar(
# Critère du filtre
selectInput(inputId = "y",
label = "Choisir ici le critère du filtre : ",
choices = c("runtime", "thtr_rel_day", "dvd_rel_year","critics_score", "audience_score"),
selected = "runtime"),
# Slider
numericInput(inputId = "numValue",
label = "Choisir une valeur numérique pour le filtre",
value ="500",
min = 1,
max = 1000,
step = 50,
width = '100%')
),
# body
dashboardBody(
fluidPage(
box(DT::dataTableOutput(outputId = "filteredtable"),
title = "Les données filtrées")
)
)
)
)
Hello I am creating an environmental shiny app in which I want to use a leaflet map to create some simple plots based on openair package(https://rpubs.com/NateByers/Openair).
Aq_measurements() general form
AQ<- (aq_measurements(country = “country”, city = “city”, location = “location”, parameter = “pollutant choice”, date_from = “YYYdateY-MM-DD”, date_to = “YYYY-MM-DD”).
All parameters available in locations dataframe.
worldmet() general form
met <- importNOAA(code = "12345-12345", year = YYYYY:YYYY)
NOAA Code available in locations dataframe
Below I create a sample of my initial data frame:
location = c("100 ail","16th and Whitmore","40AB01 - ANTWERPEN")
lastUpdated = c("2018-02-01 09:30:00", "2018-02-01 03:00:00", "2017-03-07 10:00:00")
firstUpdated = c("2015-09-01 00:00:00","2016-03-06 19:00:00","2016-11-22 15:00:00")
pm25=c("FALSE","FALSE","FALSE")
pm10=c("TRUE","FALSE","FALSE")
no2=c("TRUE","FALSE","FALSE")
latitude=c(47.932907,41.322470,36.809700)
longitude=c(106.92139000,-95.93799000
,-107.65170000)
df = data.frame(location, lastUpdated, firstUpdated,latitude,longitude,pm25,pm10,no2)
As a general idea I want to be able to click on a certain location in the map based on this dataframe. Then I have one selectInput() and 2 dateInput(). The 2 dateInput() should take as inputs the df$firstUpdated and df$lastUpdated respectively. Then the selectInput() should take as inputs the pollutants that exist in the df based on "TRUE"/"FALSE" value. And then the plots should be created. All of these should be triggered by clicking on the map.
Up to now I was not able to achieve this so in order to help you understand I connected the selectInput() and the dateInput() with input$loc which is a selectIpnut() with locations in the first tab as I will not need this when I find the solution.
library(shiny)
library(leaflet)
library(plotly)
library(shinythemes)
library(htmltools)
library(DT)
library(utilr)
library(openair)
library(plotly)
library(dplyr)
library(ggplot2)
library(gissr)
library(ropenaq)
library(worldmet)
# Define UI for application that draws a histogram
ui = navbarPage("ROPENAQ",
tabPanel("CREATE DATAFRAME",
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
wellPanel(
uiOutput("loc"),
helpText("Choose a Location to create the dataframe.")
)
),
mainPanel(
)
)
),
tabPanel("LEAFLET MAP",
leafletOutput("map"),
wellPanel(
uiOutput("dt"),
uiOutput("dt2"),
helpText("Choose a start and end date for the dataframe creation. Select up to 2 dates")
),
"Select your Pollutant",
uiOutput("pollutant"),
helpText("While all pollutants are listed here, not all pollutants are measured at all locations and all times.
Results may not be available; this will be corrected in further revisions of the app. Please refer to the measurement availability
in the 'popup' on the map."),
hr(),
fluidRow(column(8, plotOutput("tim")),
column(4,plotOutput("polv"))),
hr(),
fluidRow(column(4, plotOutput("win")),
column(8,plotOutput("cal"))),
hr(),
fluidRow(column(12, plotOutput("ser"))
)
)
)
#server.r
# load data
# veh_data_full <- readRDS("veh_data_full.RDS")
# veh_data_time_var_type <- readRDS("veh_data_time_var_type.RDS")
df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {
output$pollutant<-renderUI({
selectInput("pollutant", label = h4("Choose Pollutant"),
choices = colnames(df[,6:8]),
selected = 1)
})
#Stores the value of the pollutant selection to pass to openAQ request
###################################
#output$OALpollutant <- renderUI({OALpollutant})
##################################
# create the map, using dataframe 'locations' which is polled daily (using ropenaq)
#MOD TO CONSIDER: addd all available measurements to the popup - true/false for each pollutant, and dates of operation.
output$map <- renderLeaflet({
leaflet(subset(df,(df[,input$pollutant]=="TRUE")))%>% addTiles() %>%
addMarkers(lng = subset(df,(df[,input$pollutant]=="TRUE"))$longitude, lat = subset(df,(df[,input$pollutant]=="TRUE"))$latitude,
popup = paste("Location:", subset(df,(df[,input$pollutant]=="TRUE"))$location, "<br>",
"Pollutant:", input$pollutant, "<br>",
"First Update:", subset(df,(df[,input$pollutant]=="TRUE"))$firstUpdated, "<br>",
"Last Update:", subset(df,(df[,input$pollutant]=="TRUE"))$lastUpdated
))
})
#Process Tab
OAL_site <- reactive({
req(input$map_marker_click)
location %>%
filter(latitude == input$map_marker_click$lat,
longitude == input$map_marker_click$lng)
###########
#call Functions for data retrieval and processing. Might be best to put all data request
#functions into a seperate single function. Need to:
# call importNOAA() to retrieve meteorology data into temporary data frame
# call aq_measurements() to retrieve air quality into a temporary data frame
# merge meteorology and air quality datasets into one working dataset for computations; temporary
# meteorology and air quality datasets to be removed.
# call openAir() functions to create plots from merged file. Pass output to a dashboard to assemble
# into appealing output.
# produce output, either as direct download, or as an emailable PDF.
# delete all temporary files and reset for next run.
})
#fun
output$loc<-renderUI({
selectInput("loc", label = h4("Choose location"),
choices = df$location ,selected = 1
)
})
output$dt<-renderUI({
dateInput('date',
label = 'First Available Date',
value = subset(df$firstUpdated,(df[,1]==input$loc))
)
})
output$dt2<-renderUI({
dateInput('date2',
label = 'Last available Date',
value = subset(df$lastUpdated,(df[,1]==input$loc))
)
})
rt<-reactive({
AQ<- aq_measurements(location = input$loc, date_from = input$dt,date_to = input$dt2,parameter = input$pollutant)
met <- importNOAA(year = 2014:2018)
colnames(AQ)[9] <- "date"
merged<-merge(AQ, met, by="date")
# date output -- reports user-selected state & stop dates in UI
merged$location <- gsub( " " , "+" , merged$location)
merged
})
#DT
output$tim = renderPlot({
timeVariation(rt(), pollutant = "value")
})
}
shinyApp(ui = ui, server = server)
The part of my code that I believe input$MAPID_click should be applied is:
output$map <- renderLeaflet({
leaflet(subset(locations,(locations[,input$pollutant]=="TRUE")))%>% addTiles() %>%
addMarkers(lng = subset(locations,(locations[,input$pollutant]=="TRUE"))$longitude, lat = subset(locations,(locations[,input$pollutant]=="TRUE"))$latitude,
popup = paste("Location:", subset(locations,(locations[,input$pollutant]=="TRUE"))$location, "<br>",
"Pollutant:", input$pollutant, "<br>",
"First Update:", subset(locations,(locations[,input$pollutant]=="TRUE"))$firstUpdated, "<br>",
"Last Update:", subset(locations,(locations[,input$pollutant]=="TRUE"))$lastUpdated
))
})
output$dt<-renderUI({
dateInput('date',
label = 'First Available Date',
value = subset(locations$firstUpdated,(locations[,1]==input$loc))
)
})
output$dt2<-renderUI({
dateInput('date2',
label = 'Last available Date',
value = subset(locations$lastUpdated,(locations[,1]==input$loc))
)
})
rt<-reactive({
AQ<- aq_measurements(location = input$loc, date_from = input$dt,date_to = input$dt2)
met <- importNOAA(year = 2014:2018)
colnames(AQ)[9] <- "date"
merged<-merge(AQ, met, by="date")
# date output -- reports user-selected state & stop dates in UI
merged$location <- gsub( " " , "+" , merged$location)
merged
})
#DT
output$tim = renderPlot({
timeVariation(rt(), pollutant = "value")
})
Here is a minimal example. You click on your marker and you get a plot.
ui = fluidPage(
leafletOutput("map"),
textOutput("temp"),
plotOutput('tim')
)
#server.r
#df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {
output$map <- renderLeaflet({
leaflet(df)%>% addTiles() %>% addMarkers(lng = longitude, lat = latitude)
})
output$temp <- renderPrint({
input$map_marker_click$lng
})
output$tim <- renderPlot({
temp <- df %>% filter(longitude == input$map_marker_click$lng)
# timeVariation(temp, pollutant = "value")
print(ggplot(data = temp, aes(longitude, latitude)) + geom_point())
})
}
shinyApp(ui = ui, server = server)
I would like to load a CSV file with inside a list of variable names such as
"var_A", "var_B", "var_C"
and create in the GUI a list of numeric inputs for each variable name. I guess I need to pass by uiOutput function but no idea to do that. here's a kinda draft of what I'm trying to do
ui <- bootstrapPage(
fileInput('file1', 'Choose CSV File', accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv'))
# list of numeric inputs
#uiOutput("list_numeric_inputs")
)
server <- function(input,output) {
data_set <- reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
data_set<-read.csv(inFile$datapath, header=F)
})
# # list of numeric inputs
# output$list_numeric_inputs <- renderUI({
# # If missing input, return to avoid error later in function
# if(is.null(input$data_set()))
# return()
#
# # Get the data set value for variable name
# for (i in 1:nrow(data_set)) {
# numericInput("...", paste0(data_set[i]), value = 0.)
# }
# })
}
shinyApp(ui, server)
1) Your example not working ( havent inputs for header=input$header,sep=input$sep, quote=input$quote)
2)You havent input$dataset only data_set <- reactive
3) So working one :
library(shiny)
ui <- bootstrapPage(
fileInput('file1', 'Choose CSV File', accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
# list of numeric inputs
uiOutput("list_numeric_inputs")
)
server <- function(input,output) {
data_set <- reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
data_set<-read.csv(inFile$datapath,header = F)
})
# list of numeric inputs
output$list_numeric_inputs <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(data_set()))
return()
# Get the data set value for variable name
lapply(data_set(),function(i){
numericInput(paste0(i,"_ID"), i, value = 0.)
}
)
})
}
shinyApp(ui, server)
I have searched thoroughly (at least I believe so) and I didn't find any answer for my problem, so I'd like to ask you for help.
I'm trying to determine when a user right-clicks a row in my treeView (list of users) and then show a pop-up window with options to edit and delete them.
Here's how my app looks so far
Here's the code that generates the treeView:
import Graphics.UI.Gtk
import System.Glib.Signals (on)
import Graphics.UI.Gtk.Glade
import Graphics.UI.Gtk.ModelView as New
import SzuDB
data GUI = GUI {
mainWindow :: Window,
--Buttony
dodajUczBt :: Button,
cancelAddUczBt :: Button,
zapiszUczBtn :: Button,
--TreeView
listaUczView :: TreeView,
-- Dialogi
dodajUzDialog :: Dialog,
-- Entry
nImie :: Entry,
nNazwisko :: Entry,
nWiek :: SpinButton,
lblLiczbaUcz :: Label
}
-- Różne listy
data ListStores = ListStores { uczestnicy :: ListStore Uczestnik }
main = do
initGUI
dbh <- connect "szu.db"
gui <- loadGlade "szu.glade" dbh
-- lapiemy uzytkownikow
uczestnicy <- getAllUsers dbh
labelSetText (lblLiczbaUcz gui) $ "Liczba uczestników: "++ show (length uczestnicy)
listaUczestnikow <- New.listStoreNew uczestnicy
New.treeViewSetModel (listaUczView gui) listaUczestnikow
wyswietlUczestnikow (listaUczView gui) listaUczestnikow
let liststore = ListStores $ listaUczestnikow
loadGUIEvents gui dbh liststore
widgetShowAll (mainWindow gui)
mainGUI
-- loadGlade etc.
wyswietlUczestnikow view uczestnik = do
New.treeViewSetHeadersVisible view True
-- add a couple columns
renderer1 <- New.cellRendererTextNew
col1 <- New.treeViewColumnNew
New.treeViewColumnPackStart col1 renderer1 True
New.cellLayoutSetAttributes col1 renderer1 uczestnik $ \row -> [ New.cellText := imie row ]
New.treeViewColumnSetTitle col1 "Imię"
New.treeViewAppendColumn view col1
renderer2 <- New.cellRendererTextNew
col2 <- New.treeViewColumnNew
New.treeViewColumnPackStart col2 renderer2 True
New.cellLayoutSetAttributes col2 renderer2 uczestnik $ \row -> [ New.cellText := nazwisko row ]
New.treeViewColumnSetTitle col2 "Nazwisko"
New.treeViewAppendColumn view col2
renderer3 <- New.cellRendererTextNew
col3 <- New.treeViewColumnNew
New.treeViewColumnPackStart col3 renderer3 True
New.cellLayoutSetAttributes col3 renderer3 uczestnik $ \row -> [ New.cellText := show (wiek row) ]
New.treeViewColumnSetTitle col3 "Wiek"
New.treeViewAppendColumn view col3
--
-- ladujemy wydarzenia
--
-- loadGuiEvents etc.
I have already tried to use the example at http://www.muitovar.com/gtk2hs/chap7-2.html but it resulted in compile error (it said that eventButton is used with one argument while it requires none).
Any help would be greatly appreciated :)
Cheers
Okay it seems I'm going be the first one to find answer for my own question :)
(1) First of all the example at http://www.muitovar.com/gtk2hs/chap7-2.html didn't work for me because you have two eventButton functions in gtk2hs and you have to use the one from Graphics.UI.Gtk.Gdk.Events. So you have to add at the beginning of the file:
import Graphics.UI.Gtk.Gdk.Events as Ev
and then add Ev. prefix to eventButton, RightButton and eventSent. It'll work now :)
(2) How to respond to right clicks on treeView row:
Having solved the aforementioned problem I stumbled upon this example, where it's shown how to respond to selecting a row in treeView. So I mixed those two solutions and came up with something like this (most of the code comes from the treeview example with some of my tweaks):
module Main where
{- an example how to select from a list
not satisfactory yet:
- there should be a simpler way to render a simple list
- i could not convert the model i got back to a list
from which to get the value
- the interface offers a great number of functions
and it is very difficult to find which ones are
really needed for simple tasks
-}
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as Model
import Graphics.UI.Gtk.Gdk.Events as Ev
main :: IO ()
main = do
initGUI -- is start
window <- windowNew
list <- listStoreNew ["Vince", "Jhen", "Chris", "Sharon"]
treeview <- Model.treeViewNewWithModel list
Model.treeViewSetHeadersVisible treeview True
-- there should be a simpler way to render a list as the following!
col <- Model.treeViewColumnNew
Model.treeViewColumnSetTitle col "colTitle"
renderer <- Model.cellRendererTextNew
Model.cellLayoutPackStart col renderer False
Model.cellLayoutSetAttributes col renderer list
$ \ind -> [Model.cellText := ind]
Model.treeViewAppendColumn treeview col
--tree <- Model.treeViewGetSelection treeview
--Model.treeSelectionSetMode tree SelectionSingle
--Model.onSelectionChanged tree (oneSelection list tree)
set window [ windowDefaultWidth := 100
, windowDefaultHeight := 200
, containerChild := treeview
]
-- here comes the right-click popup
eda <- actionNew "EDA" "Edit" Nothing Nothing
pra <- actionNew "PRA" "Process" Nothing Nothing
rma <- actionNew "RMA" "Remove" Nothing Nothing
saa <- actionNew "SAA" "Save" Nothing Nothing
agr <- actionGroupNew "AGR1"
mapM_ (actionGroupAddAction agr) [eda,pra,rma,saa]
uiman <- uiManagerNew
uiManagerAddUiFromString uiman uiDecl
uiManagerInsertActionGroup uiman agr 0
maybePopup <- uiManagerGetWidget uiman "/ui/popup"
let pop = case maybePopup of
(Just x) -> x
Nothing -> error "Cannot get popup from string"
onButtonPress treeview (\x -> if (Ev.eventButton x) == Ev.RightButton
then do
menuPopup (castToMenu pop) Nothing
return (Ev.eventSent x)
else return (Ev.eventSent x))
mapM_ (prAct treeview list) [eda,pra,rma,saa]
onDestroy window mainQuit
widgetShowAll window
mainGUI
return ()
uiDecl = "<ui> \
\ <popup>\
\ <menuitem action=\"EDA\" />\
\ <menuitem action=\"PRA\" />\
\ <menuitem action=\"RMA\" />\
\ <separator />\
\ <menuitem action=\"SAA\" />\
\ </popup>\
\ </ui>"
-- Handle the right-click. You can write a function that'll respond to various
-- actions, like for example: handleAction "EDA" = do something, etc.
prAct treeview list a = onActionActivate a $ do
name <- actionGetName a
-- getting the selected row
tree <- Model.treeViewGetSelection treeview
-- you can also use treeSelectionGetSelected to get the Iter object
-- and then convert it to Int by using listStoreIterToIndex and so get
-- the ListStore item at given index
sel <- Model.treeSelectionGetSelectedRows tree
let s = head (head sel)
v <- Model.listStoreGetValue list s
putStrLn ("Action Name: " ++ name ++ " | Item: " ++ v)
I hope it'll be helpful for someone :)
Cheers