I have a shiny app that saves a few variables globally. I would like for the user to be able to click a button 'Run' That would 1) save the variables globally and 2) run an R script that uses those variables.
Below is where I am at, but I am not able to save the variables before hitting the button.
library(shiny)
ui <- fluidPage(
column(4, wellPanel(dateInput('date', label = 'Date input: yyyy-mm-dd', value = Sys.Date()))),
column(4, wellPanel(numericInput('STD', 'STD', 1.2))),
actionButton("Run", "Run the tool")
)
server <- function(input, output) {
observeEvent(input$STD, {
STDShiny <<- input$STD1
})
observeEvent(input$date, {
dateShiny <<- input$date
})
observeEvent(input$Run, {
source("someScript.R")
})
}
Example script: someScript.R
dir.create(paste(date,STD, sep = ''))
Any assistance is appreciated.
Somescript.R code:
dir.create(paste(.GlobalEnv$dateShiny, .GlobalEnv$STDShiny, sep = ''))
Shinyapp:
library(shiny)
library(tidyverse)
ui <- fluidPage(
column(4, wellPanel(dateInput('date', label = 'Date input: yyyy-mm-dd', value = Sys.Date()))),
column(4, wellPanel(numericInput('STD', 'STD', 1.2))),
actionButton("Run", "Run the tool") #The button to trigger script
)
server <- function(input, output) {
#Upon clicking in the button the following code gets executed
observeEvent(input$Run,{
#declare as variables in the global env with the values of the inputs
walk2(c('STDShiny', 'dateShiny'), c(input$STD, input$date), ~{
assign(..1, ..2, envir = .GlobalEnv)
})
#Run the script
exec(source, file = 'someScript.R')
})}
shinyApp(ui, server)
Related
The below code is working, but I need to enhance it by observing multiple inputs.
I need a multiple observeEvent on input$dateinput which selects the xlsx file to open and input$myfilter which checks if the user wants to apply a specific filter to the data.
but when I change
observeEvent(input$dateinput,... to:
observeEvent( c(input$dateinput, input$myfilter),{
The app crashes with Warning: Error in file: invalid 'description' argument [No stack trace available]
The code otherwise runs fine. Any help? thanks
full code : EDIT: THIS IS NOW REPRODUCIBLE AND DOES NOT REQUIRE ANY EXCEL FILE
library(shiny)
library(shinyWidgets)
library(openxlsx)
opendir <- function(dir = getwd()){
if (.Platform['OS.type'] == "windows"){
shell.exec(dir)
} else {
system(paste(Sys.getenv("R_BROWSER"), dir))
}
}
ui <- fluidPage(
sidebarPanel(
uiOutput("gpui")
),
mainPanel(
titlePanel("test app"),
br(),
checkboxInput("myfilter", label = "Filter all unnecessary (71, 46, 44) documents", value = TRUE),
br(),
tableOutput("datatable")
)
)
server <- function(input, output, session) {
rvalues <- reactiveValues()
rvalues$listfiles <- list.files(pattern=".xlsx")
observeEvent(input$refresh, {
print(input$dateinput)
session$reload()
})
observeEvent(input$openfolder, {
opendir()
})
output$gpui <- renderUI({
tagList(
actionButton("openfolder", "Open Data Folder"),
actionButton("refresh", "Refresh data folder"),
pickerInput("dateinput","Choose the date", choices=isolate(rvalues$listfiles), options = list(`actions-box` = TRUE),multiple = F)
)
})
observeEvent(input$myfilter,{
print("myfilter")
})
observeEvent( input$dateinput ,{
print(input$dateinput)
print("selecteddata")
cols <- c("Purchasing.Document", "Net.Order.Value", "Currency", "G/L.Account",
"Short.Text",
"Requisitioner", "Release.indicator", "Deletion.indicator")
seldata <- read.xlsx(input$dateinput)
print(nrow(seldata))
seldata <- seldata[,cols]
myfilter <- substr(seldata$Purchasing.Document,1,2) %in% c("71", "46", "44")
if(input$myfilter) {
rvalues$data <- seldata[myfilter,]
}
rvalues$data <- seldata
})
output$datatable <- renderTable(
rvalues$data,
striped = T,
spacing = 's'
)
}
shinyApp(ui, server)
For multiple observes in observeEvent() wrap them in curly brackets without commas, just as regular code.
Try:
shiny::observeEvent(
eventExpr = {
input$dataInput
input$myFilter
},
handlerExpr = {
# You code to run
}
)
In my experience it can be safer to wrap complex observeEvent expressions (handlerExpr) in isolate({}) to suppress any undesired reactivity.
When your observer reacts to input$myfilter, it is triggered at the startup. And input$dateinput is NULL. So you get this error:
> openxlsx::read.xlsx(NULL)
Error in file(description = xlsxFile) : argument 'description' incorrect
I am researching how to change elements 'navbarPage' and 'tabPanel' components after loading R Shiny reactive system. Here is a code
library(shiny)
# How to change these elements after loading R Shiny reactive system
str_title <- "Title"
str_window_title <- "Window title"
str_cars <- "Cars"
str_iris <- "Iris"
# UI
ui <- fluidPage(
navbarPage(
title = str_title,
windowTitle = str_window_title,
tabPanel(title = str_cars, fluidPage(fluidRow(dataTableOutput("dt_mtcars")))),
tabPanel(title = str_iris, fluidPage(fluidRow(dataTableOutput("dt_iris"))))
))
# SERVER
server <- function(input, output) {
output$dt_mtcars <- renderDataTable(datatable(mtcars))
output$dt_iris <- renderDataTable(datatable(iris))
}
# RUN APP
shinyApp(ui = ui, server = server)
The question is how to change values of 'title', 'window_title' for 'navbarPage' component, and 'title' for 'tabPanel' component AFTER loading the Shiny app. For example, add to these names the prefix 'New ' and have the values 'New Title', 'New Window title', 'New Cars', 'New Iris'.
Thanks for sharing your ideas!
I couldn't find a solution for windowTitle, but for the 3 others elements you can use a textOutput and reactive values to make the elements change.
Here is an example of changing the elements names after clicking on an action button.
EDIT : found a way to change windowTitle too, based on this answer
library(shiny)
library(DT)
# UI
ui <- fluidPage(
actionButton("btn", "Change components' names"),
#javascript code to change window title
tags$script(HTML('Shiny.addCustomMessageHandler("changetitle", function(x) {document.title=x});')),
navbarPage(
title = textOutput("str_title"),
windowTitle = "Window title",
tabPanel(title = textOutput("str_cars"), fluidPage(fluidRow(dataTableOutput("dt_mtcars")))),
tabPanel(title = textOutput("str_iris"), fluidPage(fluidRow(dataTableOutput("dt_iris"))))
))
# SERVER
server <- function(input, output, session) {
# initialize names
rv <- reactiveValues(str_title = "Title",
str_window_title = "Window title",
str_cars ="Cars",
str_iris = "Iris")
output$dt_mtcars <- renderDataTable(datatable(mtcars))
output$dt_iris <- renderDataTable(datatable(iris))
output$str_title <- renderText({
rv$str_title
})
output$str_window_title <- renderText({
rv$str_window_title
})
output$str_cars <- renderText({
rv$str_cars
})
output$str_iris <- renderText({
rv$str_iris
})
#change names when button is clicked
observeEvent(input$btn,{
print("Change names")
rv$str_title <- paste0(rv$str_title,"+")
rv$str_window_title <- paste0(rv$str_window_title,"+")
rv$str_cars <- paste0(rv$str_cars,"+")
rv$str_iris <- paste0(rv$str_iris,"+")
session$sendCustomMessage("changetitle", rv$str_window_title )
})
}
# RUN APP
shinyApp(ui = ui, server = server)
Say I do an observeEvent like this where I generate random numbers, and then another to export those numbers to a csv:
observeEvent(input$generateButton, {
u = runif(input$nNumericInput)
})
observeEvent(input$exportButton, {
write.csv(data.frame(u),"randomNumbers.csv", row.names = FALSE)
})
That's basically what I'm trying to do but I'm generating the numbers in a more complex way that I don't want to repeat for each button because of efficieny.
Here's a working example. I'm also showing a table of the data that's produced when you update the numericInput. This should save in your working directory. Note that my_df is generated with an eventReactive, because it should be a reactive value (it should change when we change the numericInput), whereas write.csv is called within an observeEvent, because it's simply triggered by clicking the button (i.e., it's not creating any reactive object). Hope that helps.
library(shiny)
ui <- {
fluidPage(
fluidRow(
numericInput(
inputId = 'num_input',
label = 'Input',
value = 5),
actionButton(
inputId = 'num_input_button',
label = 'Generate df'),
actionButton(
inputId = 'write_data',
label = 'Write to csv')
),
fluidRow(
tableOutput('table')
)
)
}
server <- function(input, output, session) {
my_df <- eventReactive(input$num_input_button, {
runif(input$num_input)
})
observeEvent(input$write_data, {
write.csv(my_df(), 'random_numbers.csv')
})
output$table <- renderTable({
my_df()
})
}
shinyApp(ui, server)
I wrote a Shiny app that loads several user-defined csv files as fileInput. The app is designed to plot data from a running measurement and new datapoints are written to the input files about every five minutes. I want to be able to reload all inputs by clicking on an actionButton.
I tried to define the function reading the .csv as eventReactive:
library(shiny)
ui <- fluidPage(
actionButton(inputId = "update", label = "Reload input files"),
fileInput(inputId = "file", label = "Choose file"),
textOutput("test")
)
server <- function(input, output) {
data <- eventReactive(input$update, {
mydata <- read.delim(input$file$datapath)
return(nrow(mydata))
})
output$test <- renderText(print(data()))
}
shinyApp(ui = ui, server = server)
When I choose an input file and click the action button, the output is correctly rendered. If I now open the csv file, add additional rows and click the action button again, the output is not updated.
Based on this answer I was able to create a workaround for you problem.
As I pointed out in my comment above, the reason why it is not possible to update fileInput with an action button is that, apparently, fileInput creates a temporary file in a temporary directory and the Input$file$datapth links to this temporary file. So you can reload the file with using the action button as often as you like, changes to the orignial file will not be reflected, since the link is pointing to the temporary file. I really don't know why inputFile works with temp files, but using the shinyFiles packages, you can build a workaround. You have one button which gets the real link to your file and load the data in and another button to reload the data. Pressing the load button will reload the original data and all changes to it will be reflected.
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton("GetFile", "Choose a file" ,
title = "Please select a file:", multiple = FALSE,
buttonType = "default", class = NULL),
actionButton(inputId = "reload", label = "Reload data"),
tableOutput("test")
)
server <- function(input,output,session){
volumes <- getVolumes()
v = reactiveValues(path = NULL)
observe({
shinyFileChoose(input, "GetFile", roots = volumes, session = session)
if (!is.null(input$GetFile)) {
file_selected <- parseFilePaths(volumes, input$GetFile)
v$path <- as.character(file_selected$datapath)
req(v$path)
v$data <- read.csv(v$path)
}
})
observeEvent(input$reload, {
req(v$path)
v$data <- read.csv(v$path)
})
output$test <- renderTable({
print(v$path)
if (is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
Update
It is also possible to combine this approach with reactiveFileReader, see example below:
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton("GetFile", "Choose a file" ,
title = "Please select a file:", multiple = FALSE,
buttonType = "default", class = NULL),
tableOutput("test")
)
server <- function(input,output,session){
volumes <- getVolumes()
v = reactiveValues(path = NULL)
observe({
shinyFileChoose(input, "GetFile", roots = volumes, session = session)
req(input$GetFile)
file_selected <- parseFilePaths(volumes, input$GetFile)
v$path <- as.character(file_selected$datapath)
req(v$path)
v$data <- reactiveFileReader(1000, session, filePath = v$path, readFun = read.csv, sep = ";")
})
output$test <- renderTable({
print(v$path)
req(v$data)
v$data()
})
}
shinyApp(ui = ui, server = server)
Is it possible to capture the label of an actionButton once it is clicked?
Imagine I have 3 buttons on my ui.R and depending on which one I click I want to perform a different action on the server.R.
One caveat is that the buttons are created dynamically on the server.R with dynamic labels (thus the necessity of capturing the label on click)
Thanks
Something like that ?
library(shiny)
server <- function(input, session, output) {
output$printLabel <- renderPrint({input$btnLabel})
}
ui <- fluidPage(
actionButton("btn1", "Label1",
onclick = "Shiny.setInputValue('btnLabel', this.innerText);"),
actionButton("btn2", "Label2",
onclick = "Shiny.setInputValue('btnLabel', this.innerText);"),
verbatimTextOutput("printLabel")
)
shinyApp(ui = ui, server = server)
1) What button was clicked last by the user?
To answer this you can user observeEvent function and by setting up a a variable using reactiveValues function. Make sure you update your libraries and work in the latest version of R (version 3.1.3) as shiny is dependant on this version. Working on windows you can follow example on how to update here
rm(list = ls())
library(shiny)
ui =fluidPage(
sidebarPanel(
textInput("sample1", "Name1", value = "A"),
textInput("sample2", "Name2", value = "B"),
textInput("sample3", "Name3", value = "C"),
div(style="display:inline-block",uiOutput("my_button1")),
div(style="display:inline-block",uiOutput("my_button2")),
div(style="display:inline-block",uiOutput("my_button3"))),
mainPanel(textOutput("text1"))
)
server = function(input, output, session){
output$my_button1 <- renderUI({actionButton("action1", label = input$sample1)})
output$my_button2 <- renderUI({actionButton("action2", label = input$sample2)})
output$my_button3 <- renderUI({actionButton("action3", label = input$sample3)})
my_clicks <- reactiveValues(data = NULL)
observeEvent(input$action1, {
my_clicks$data <- input$sample1
})
observeEvent(input$action2, {
my_clicks$data <- input$sample2
})
observeEvent(input$action3, {
my_clicks$data <- input$sample3
})
output$text1 <- renderText({
if (is.null(my_clicks$data)) return()
my_clicks$data
})
}
runApp(list(ui = ui, server = server))
2) Save the clicks for further manipulation is below
Here's small example based on the work of jdharrison from Shiny UI: Save the Changes in the Inputs and the shinyStorage package.
rm(list = ls())
#devtools::install_github("johndharrison/shinyStorage")
library(shinyStorage)
library(shiny)
my_clicks <- NULL
ui =fluidPage(
#
addSS(),
sidebarPanel(
textInput("sample_text", "test", value = "0"),
uiOutput("my_button")),
mainPanel(uiOutput("text1"))
)
server = function(input, output, session){
ss <- shinyStore(session = session)
output$my_button <- renderUI({
actionButton("action", label = input$sample_text)
})
observe({
if(!is.null(input$sample_text)){
if(input$sample_text != ""){
ss$set("myVar", input$sample_text)
}
}
})
output$text1 <- renderUI({
input$action
myVar <- ss$get("myVar")
if(is.null(myVar)){
textInput("text1", "You button Name")
}else{
textInput("text1", "You button Name", myVar)
}
})
}
runApp(list(ui = ui, server = server))