interactive shiny global date picker - r

I'm working with R in an environment that doesn't have a good date picker and I'm trying to pop up a date picker using R to fill in the gap.
Most R date pickers require UI libraries like GTK. Shiny's doesn't.
All I'd like to do is pop up a date picker, let the user choose the date and then end the shiny session and pass the date back to continue the R script.
Here's what I have so far, but no success. I'm trying to assign the date to a global variable x.
library("shiny")
## Only run examples in interactive R sessions
if (interactive()) {
ui <- fluidPage(
# Default value is the date in client's time zone
dateInput("date2", "Date:"),
verbatimTextOutput("date2")
)
shinyApp(ui, server = function(input, output) {
reactive(x <<- input$date2)
})
}
But the variable x doesn't show up in the global env.

The issue here is that you're never calling that reactive object. In server, you'd have to do something like:
shinyApp(ui, server = function(input, output) {
observeEvent(input$date2, {x <<- input$date2})
})
This way, a change in input$date2 will trigger the global assignment of x.

You could also do something like this, where you assign the value to the global env when the session ends.
library("shiny")
## Only run examples in interactive R sessions
ui <- fluidPage(
# Default value is the date in client's time zone
dateInput("date2", "Date:"),
verbatimTextOutput("date2")
)
shinyApp(ui, server = function(input, output, session) {
session$onSessionEnded(function() {
assign("x", isolate(dat()), pos = .GlobalEnv)
})
dat <- reactive({
req(input$date2);
x <- input$date2
x
})
})

Related

How to read a csv file in shiny an load to the global Environment?

Hi I have this shiny app. You can run it and try it.
This application helps me to read a csv files and render a Table with the information of the csv file.
app.R
library(shiny)
ui <- shinyUI(
fluidPage(
textInput("fname","File name: ",value="data.csv"),
verbatimTextOutput("text"),
actionButton("chck_file", "Check for file"),
actionButton("create_file", "Create file"),
#Data Table
tableOutput("table1")
))
server <- shinyServer(function(input, output, session) {
# Listens for click from element with ID=chck_file
observeEvent(input$chck_file,{
# Check if file exists
if ( file.exists( isolate({input$fname}) ) ){
# Display text
output$text <- renderText({ paste("File exists in: ",getwd(),sep="") })
data <- input$fname
print(data)
df = read.csv(data)
output$table1 <- renderTable(df)
}
else{
output$text <- renderText({ paste("No such file in: ",getwd(),sep="") })
}
})
# Listens for click from element with ID=create_file
observeEvent(input$create_file,{
# Create file
file.create(isolate({input$fname}))
})
})
shinyApp(ui = ui, server = server)
I want to be able to load the dataframe that I am reading in the global environment of RStudio, how can I do this?
I tried with this operator <<-
df <<- read.csv(data)
Warning: Error in observeEventHandler: cannot change value of locked binding for 'df'
Also I tried with this solution, but only works when I stop my shiny app
data <- reactiveValues()
output$contents <- renderText({
if(is.null(input$file1))return()
inFile <- input$file1
data2<-read.csv(inFile$datapath)
assign('data',data2,envir=.GlobalEnv)
print(summary(data))
})
And I don't want to stop my session in order to see my data frame in the global env
df <<- read.csv(data)
Warning: Error in observeEventHandler: cannot change value of locked binding for 'df'
The operator <<- does not mean assignment in the global environment. Rather, it means "non-local assignment". When you do x <<- 2, R searches for x in the current environment, then in the parent environment if it does not find it, etc, until the global environment. If x is never found then R performs the assignment in the global environment.
Here df is found: this is the name of a function in the stats package. And one cannot change its value. So you have to use another name. But I don't know whether this will have an effect before closing the app, I didn't try.
EDIT
Yes this works, but you have to refresh the environment pane while the app is running (click on the circular arrow in the environment pane).

R Shiny Handsontable automatically updating function after changing a single cell

I am trying to get familiar with the rhandsontable package. So I tried something I thought should be pretty easy but I can't find a solution. Here is the idea:
I am creating a dataframe with random numbers and in a text box. The mean of column 1 of the dataframe should be displayed. Furthermore, that number should be updated as soon as I change the value of a cell in the dataframe.
My code:
ui <- fluidPage(
textOutput("num"),
rHandsontableOutput(outputId="frame")
)
server <- function(input, output, session) {
datavalue <- reactiveValues(data=df)
observeEvent(input$frame$changes$changes,{
mean_col1 <- mean(datavalue$data[[1]][1:10])
})
output$num <- renderText({
mean(datavalue$data[[1]][1:10])
})
output$frame <- renderRHandsontable({
rhandsontable(datavalue$data)
})
}
shinyApp(ui = ui, server = server)
I think you want to use hot_to_r to convert the handsontable to an R object when there is a change. You can update your reactiveValue datavalue$data when that happens, and your output$num will account for this change as well with the new mean.
Try using this in your observeEvent:
datavalue$data <- hot_to_r(input$frame)
As an alternative, you can do a general observe as follows:
observe({
req(input$frame)
datavalue$data <- hot_to_r(input$frame)
})

Connect R script with selectizeInput in shiny

I have an R script (let us call it myscript.R) which is a function of input$year.
Once I select the year in the shinyapp I want that the computer run "myscript.R" ?
I tried kind of the following structure,but it does not work
fun=function(input,ouput,session){
year= input$year
}
observeEvent(input$year,{
fun(input,output,session)
})
Your answers are appreciated!
I am not sure if a function from a script is really what you want here. If you want to make output dependent on input, this is how you do it in Shiny:
library(shiny)
ui <- fluidPage(
selectInput("year","Year: ",choices=c(2000,2001,2002)),
textOutput("test")
)
server <- function(input, output, session) {
test_reactive <- reactive({
year = as.numeric(input$year)
year = year + 1
return(year)
})
output$test <- renderText({
test_reactive()
})
}
runApp(shinyApp(ui, server))
If you really want to call a function from a script, and within script.R you have a function, like:
my_function <- function(year)
{
...
}
You should do source(script.R) somewhere above the server function, and do my_function(year) where I have added 1 to the year.
Hope this helps.

reactively fetch new data from external source on action button

My goal is to retrieve data from a googlesheet and map it on a leaflet map.
Everything is working fine, only if the code to retrieve data from googlesheet is placed in the global.R and it is only valid for that session of the running shiny app. However, if meanwhile the sheet is updated, these updates are not reflected in the running session. So I need to wire up a ui.R button to fetch new data each time the button is fired and pass the data onto the relevant codes in server.R . (I hope this is clear).
In my current setup, the data gets downloaded from googlesheet (via global.R) and passed on to the environment and used for that running app session.
Here is my working shiny app setup:
ui.R
...
leafletOutput("map"),
actionButton("button", "Get New Data")
...
#added the below lines to update the question:
selectInput("Country",
"Country:",
c("All",
unique(as.character(draw$Country))))
server.R
shinyServer(function(input, output, session) {
#...
output$map <- renderLeaflet({
#... some options here
})
draw <- mydata
drawvalue <- reactive({
if (input$year == year1){return(mydata)} else {
filtered <- filter(mydata, Type == input$type1)
return(filtered)
}
})
observe({
#... some other variable definitions
colorBy <- input$color ##added to update the question
sizeBy <- input$size ##added to update the question
draw <- drawvalue()
colorData <- draw[[colorBy]] ##added to update the question
#... code related to the leaflet
})
#...
}
global.R
mydata <- gs_read(gs_key("0123456abcdabcd123123123"))
After some reading and exploring, I am told that I have to use reactive and observeEvent. But my faulty setup results in error, saying that 'object "mydata" not found'.
I tried in the server.R: (I know the code below is all faulty)
observeEvent(input$button,{
mydata <- gs_read(gs_key("0123456abcdabcd123123123"))
})
mydata <- eventReactive(input$button,{
mydata()
})
update:
in my ui.R, I also refer to "draw", this also bugs. How should I change this one? I updated the lines in the ui.R above in the question. this line is part of the ui.R line which call the DT package to show some tables.
by the way, this app is based on the superzip shiny app.
NB: I will give 100 points bounty for the accepted answer.
In general observe and observeEvent do not return any value and they are used for side effects. So this part of the code below doesn't return any value and even if you used <<- to override the variable mydata shiny wouldn't know that its value has changed.
observeEvent(input$button,{
mydata <- gs_read(gs_key("0123456abcdabcd123123123"))
})
So if you want shiny to know when the data is updated you should read it within reactive environment. So, instead of reading the data via global.R I would advice to do following within server.R:
mydata <- eventReactive(input$button, {
gs_read(gs_key("0123456abcdabcd123123123"))
})
After clicking the button shiny would read (new) data which could be then accessed with mydata() and passed to the render* functions and other reactive parts of the code. For example:
drawvalue <- reactive({
if (input$year == year1){return(mydata() )} else { # added ()
filtered <- filter(mydata(), Type == input$type1) # added () to mydata
return(filtered)
}
})
You had to change this part of code
draw <- drawvalue()
to
draw <- reactive({ drawvalue() })
and then access it with draw()
UPDATE:
If you want make choices of the widget selectInput from UI.R dependent on draw you can do following:
1) Add the parameter session to the server function for updateSelectInput
shinyServer(function(input, output, session) {...} # added session
2) Set choices of the widget in UI.R to ""
selectInput("Country", "Country:", choices = "")
3) Update the choices on the server side with:
observe({
req(draw()) # require that draw is available
updateSelectInput(session, "Country", "Country:",
c("All", unique(as.character(draw()$Country)))) # added ()
})

Can I let Shiny wait for a longer time for numericInput before updating?

In my Shiny App, there are a few numericInput and selectInput.
Shiny updates outputs during typing, especially when users type is slower in the numericInput.
sumbitButton could you be used to stop automatically updading. But I prefer to not to use it.
How could I let Shiny waits for a longer time for numericInput?
Thanks for any suggestion. Let me know if my question is not clear.
You can use debounce on the reactive function that uses your Inputs.
Setting it to 2000 milliseconds felt OK to me.
If you use the input directly in a render function you might need to create the data to use in your render function in a reactive function.
An example is here: https://shiny.rstudio.com/reference/shiny/latest/debounce.html
## Only run examples in interactive R sessions
if (interactive()) {
options(device.ask.default = FALSE)
library(shiny)
library(magrittr)
ui <- fluidPage(
plotOutput("plot", click = clickOpts("hover")),
helpText("Quickly click on the plot above, while watching the result table below:"),
tableOutput("result")
)
server <- function(input, output, session) {
hover <- reactive({
if (is.null(input$hover))
list(x = NA, y = NA)
else
input$hover
})
hover_d <- hover %>% debounce(1000)
hover_t <- hover %>% throttle(1000)
output$plot <- renderPlot({
plot(cars)
})
output$result <- renderTable({
data.frame(
mode = c("raw", "throttle", "debounce"),
x = c(hover()$x, hover_t()$x, hover_d()$x),
y = c(hover()$y, hover_t()$y, hover_d()$y)
)
})
}
shinyApp(ui, server)
}

Resources