I would need some help with the missing code here:
selectInput("portfolio",
"Portfolio:",
c("p1","p2"))
## missing code:
## if input$portfolio == "p1" do a bunch of calculations and spit out the variable var (a tibble).
# variable var goes into a reactiveVal...
table <- reactiveVal()
table(var)
On the server you can, set table (not a great name, perhaps use something else, like my_table? to reactiveValues(), and then observe for changes in input$portfolio
table <- reactiveValues(var=NULL)
observeEvent(input$portfolio, {
if(input$portfolio == "p1") {
table$var = <- someFunction()
}
})
Here is a full example, using mtcars
library(shiny)
ui <- fluidPage(
selectInput("make","Make:", choices = rownames(mtcars)),
tableOutput("subtable")
)
server <- function(input, output, session) {
subtable <- reactiveValues(var=NULL)
observeEvent(input$make, {
subtable$var = dplyr::filter(cbind(makes,mtcars), makes == input$make)
})
output$subtable <- renderTable(subtable$var)
}
shinyApp(ui, server)
Related
I would like to run a function that has a shiny app inside, but I can't.
Running this example separately, I first remove column one from my input data frame; then I run shiny to change whatever is necessary in the data frame and, when I close the window, a new object is saved with the changes; and finally I create a new column in the data frame.
This is an example script, but I would like that, when executing the function, the shiny window opens and some things are changed in the data frame for the user interactively. Could someone help?
library(shiny)
library(rhandsontable)
my_function <- function(x){
select <- x[,-1]
ui <- fluidPage(
fluidRow(
column(
width = 12,
rHandsontableOutput("myTable")
)))
server <- function(input, output, session) {
# dummy dataframe
df = select
# convert it to a "rhansontable" object
output$myTable <- renderRHandsontable({rhandsontable(df)
})
observeEvent(input$myTable, {
test_df = hot_to_r(input$myTable)
assign('my_data_frame',test_df,envir=.GlobalEnv)
# browser() # uncomment for debugging
})
}
shinyApp(ui, server)
my_data_frame2 <- my_data_frame %>%
mutate(new_column_test = "hello")
return(my_data_frame2)
}
my_function(mtcars)
Hi you almost made it you don't want to return anything but add the data simply using assign
library(shiny)
library(rhandsontable)
myapp_function <- function(data) {
ui <- basicPage(
actionButton("quit", label = "Close"),
actionButton("create", label = "Create copy"),
textInput("name","Set dataframe name", value = "my_data_frame"),
rHandsontableOutput("myTable")
)
server <- function(input, output, session) {
output$myTable <- renderRHandsontable({
rhandsontable(data)
})
observeEvent(input$create, {
assign( input$name, hot_to_r(input$myTable), envir=.GlobalEnv)
})
observeEvent(input$quit,{
stopApp()
})
}
## launch app
shinyApp(ui, server,options=c(shiny.launch.browser = .rs.invokeShinyPaneViewer))
}
## test
myapp_function(iris)
myapp_function(mtcars)
myapp_function(PlantGrowth)
I would suggest to create the ui and server outside of the myapp_function - otherwise it will become a very large function...also creating a function inside another function is not the best practise.
My goal is to display an (conditional) editable rhandsontable inside a modal by clicking an actionbutton. Creating and displaying the table worked fine, however I'm struggling on how to properly assign an ID in the ui for the table in order to recognize user changes.
Any help is appreciated, thank you :)
library(shiny)
ui <- fluidPage(
actionButton('openModal', "Open Modal")
# rHandsontableOutput("DataEditor") # doesn't work
)
server <- function(input, output, session) {
observeEvent(input$openModal, {
irrelevant_condition <- FALSE # include that rhandsontable doesn't have to appear always
if (irrelevant_condition == TRUE) {
return(showModal(modalDialog("Choose some variables to display first")))
} else {
# display rhandsontable if user made a valid choice
showModal(modalDialog(
updDataEditor()
))
}
})
updDataEditor <- function() {
output$DataEditor <- renderRHandsontable({
# in real app some conditional calculations leading to a DF called 'current.DF'
# why function?: in real app with variation, depending on some inputs the user chose
current.DF <- data.frame(Name = c("Name1", "Name2"), value1 = c(0,0), value2=c(0,0)) # example df
rhandsontable(current.DF)
})
}
observeEvent(input$DataEditor, {
# Here's the problem
# won't get called when DataEditor is modified by the user
browser()
return()
})
}
shinyApp(ui,server)
This works like this:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
actionButton('openModal', "Open Modal")
)
server <- function(input, output, session) {
current.DF <- reactive(
data.frame(Name = c("Name1", "Name2"), value1 = c(0,0), value2=c(0,0))
)
observeEvent(input$openModal, {
irrelevant_condition <- FALSE # include that rhandsontable doesn't have to appear always
if (irrelevant_condition == TRUE) {
return(showModal(modalDialog("Choose some variables to display first")))
} else {
# display rhandsontable if user made a valid choice
showModal(modalDialog(
rHandsontableOutput("DataEditor")
))
}
})
output$DataEditor <- renderRHandsontable({
rhandsontable(current.DF())
})
observeEvent(input$DataEditor, {
print(input$DataEditor$changes)
})
}
shinyApp(ui,server)
Is it what you want? For the dataframe which can change I would use a reactive value. If only some cells are changed you can use the set_data function, better.
EDIT Solving the problem raised in the comments:
output$DataEditor <- renderRHandsontable({
rhandsontable(current.DF()) %>% htmlwidgets::onRender(
"function(el){var hot = this.hot; setTimeout(function(){hot.render();}, 1000)}"
)
})
I have this question: In a Shiny App, I construct a varible with a reactive(). The thing is that, in the midle of this process (that is a long one) I construct other varibles that I need too.
For example:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names())
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
In this (very short) example, I would need the variable "a" (of course) and the variable "column_names". I can do something like create a new reactive that reproduce all the process until the line that contain "column_names" and finish it there. But the process is too long and I prefer to do it more "eficiently".
Any idea??
Thank you so much!
The process you're describing is correct : instead of assigning variables, just assign reactives and Shiny will handle the depedencies between them.
Note that in the example you provided, reactives aren't needed because the content is up to now static.
library(shiny)
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("column_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
a <- reactive({subset(df_1,select=-c(fc))})
column_names <- reactive({colnames(a())})
output$my_table = renderTable({a()})
output$column_names = renderTable({column_names()})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
I found a interesting answer to my own question: if you want to do something like that, you can use "<<-" instead of "<-" and it save the variable when you are working insede a function (like reactive()). Let´s see:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
# HERE THE SOLUTION!!
column_names_saved <<- column_names
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names_saved)
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
Then, into the funtion you must continues with the variable "column_names", but when you need to use it later, you can use "column_name_saved". (just be carefull with one thing: onece you save the variable into the funtion, you canot change it)
Thanks!!!
I have this problem and the closest I can find is in reference to the submission here but it doesn't quite address what I'm trying to solve Reactive shiny modules sharing data
Referring to the corrected example in the link above, what if I want to be able to edit table a (cells in column x_2), and this will automatically update table c (the corresponding cells in column x_2).
Thanks
Here is a bit simpler version that doesn't work with proxies (and uses the new module interface), I hope it is ok. You can change any value in the first 2 tables and the 3rd table shows the sum and is updated. The trick is that the modules where you edit data have to return the edited data as reactives, these are saved as variables in the main server function. The module that updates based on this data needs to take these variables as reactive inputs.
Very important is:
the modules that return data need to return a reactive, the easiest way to do this is return(reactive({returnvalue}))
in the server function the reactives passed to the module mustn't be evaluated, e.g. you have to use my_reactive_value instead of my_reactive_value()
### Libraries
library(shiny)
library(dplyr)
library(DT)
### Data----------------------------------------
set.seed(4)
table_a <- data.frame(
id=seq(from=1,to=10),
x_1=rnorm(n=10,mean=0,sd=10),
x_2=rnorm(n=10,mean=0,sd=10),
x_3=rnorm(n=10,mean=0,sd=10)
) %>%
mutate_all(round,3)
table_b <- data.frame(
id=seq(from=1,to=10),
x_1=rnorm(n=10,mean=0,sd=10),
x_2=rnorm(n=10,mean=0,sd=10),
x_3=rnorm(n=10,mean=0,sd=10)
)%>%
mutate_all(round,3)
mod_table_edit <- function(id, data_initialisation) {
moduleServer(
id,
function(input, output, session) {
# initialise the reactive data object for the table
data <- reactiveValues(table = data_initialisation)
# render the table
output$table <- renderDT({
datatable(data$table,
editable = TRUE)
})
# update the underlying data
observeEvent(input$table_cell_edit, {
data$table <- editData(data$table, input$table_cell_edit)
})
# return the data as a reactive
return(reactive(data$table))
}
)
}
mod_table_add <- function(id, data_input_1, data_input_2) {
moduleServer(
id,
function(input, output, session) {
# do the calculations
data_table <- reactive({
data_input_1() + data_input_2()
})
# render the table
output$table <- renderDT({
datatable(data_table())
})
}
)
}
modFunctionUI <- function(id) {
ns <- NS(id)
DTOutput(ns("table"))
}
ui <- fluidPage(
fluidRow(
column(4,
modFunctionUI("table_1")),
column(4,
modFunctionUI("table_2")),
column(4,
modFunctionUI("table_3"))
)
)
server <- function(input, output, session) {
# call the modules for the editable tables and store the results
data_table_1 <- mod_table_edit("table_1", data_initialisation = table_a)
data_table_2 <- mod_table_edit("table_2", data_initialisation = table_b)
# call the module for the table that takes inputs
# the reactives musn't be evaluated
mod_table_add("table_3",
data_input_1 = data_table_1,
data_input_2 = data_table_2)
}
shinyApp(ui, server)
I have an app that has a few dependent selectInputs, so if you choose something in the first, the second should update to a specific value. That works fine. However! Now I want to force a specific combination on the two selects that do not correspond to the update logic, but after I update the two selects, the change of the first triggers an update of the other and I end up with the wrong result. Also after the forced combination has been applied, if a new change to the first select is done, then the "old" rule should reapply.
library(shiny)
ui <- fluidPage(
selectInput("A_sel","select" ,c("A","B","C","D"),"A",FALSE)
,selectInput("B_sel","same" ,c("A","B","C","D"),"A",FALSE)
,actionButton("ForceCombi","force C and D")
)
server <- function(input, output, session) {
observeEvent(input$A_sel,{
updateSelectInput(session,"B_sel",selected = input$A_sel)
})
observeEvent(input$ForceCombi,{
updateSelectInput(session,"A_sel",selected = "C")
updateSelectInput(session,"B_sel",selected = "D")
})
}
shinyApp(ui, server)
EDIT - Timer solution:
I set a timestamp to each activation and see which was the last to be activated, except if the time difference is less than a sec then I assume that the button was pressed which activated the select. Then the return from that reactive is decides how to update the selects. A bit of a hack:
library(shiny)
library(dplyr)
ui <- fluidPage(
selectInput("A_sel","select",c("A","B","C","D"),"A",FALSE)
,selectInput("B_sel","same as above",c("A","B","C","D"),"A",FALSE)
,actionButton("A_to_B","force C and D")
)
server <- function(input, output, session) {
but <- eventReactive(input$A_to_B,{tibble(src = "but", time = Sys.time())})
sel <- eventReactive(input$A_sel ,{tibble(src = "sel", time = Sys.time())})
src <- eventReactive(c(input$A_to_B,input$A_sel),{
df <- try(rbind(but(),sel()))
if(typeof(df) == "character") return("sel")
if(abs(difftime(df$time[1],df$time[2],units = "sec")) < 1) return("but")
df %>% arrange(time) %>% pull(src) %>% last -> df
return(df)
})
observe({
src <- src()
if(src == "sel") {
updateSelectInput(session,"B_sel",selected = input$A_sel)
} else if (src == "but") {
updateSelectInput(session,"A_sel",selected = "C")
updateSelectInput(session,"B_sel",selected = "D")
}
})
}
shinyApp(ui, server)
Here's a simpler implementation of your timestamp idea. I have set the threshold to 0.5 seconds but actual threshold can only be determined after considering other reactive dependencies in the app. You should also look into the priority arguments of observe and observeEvent using which you could potentially control the execution sequence of reactives.
Having said that, I still have a feeling that there is a better way to do this. I think looking at ?shiny::throttle and ?shiny::debounce could help as well.
library(shiny)
ui <- fluidPage(
selectInput("A_sel","select", c("A","B","C","D"),"A",FALSE)
,selectInput("B_sel","same", c("A","B","C","D"),"A",FALSE)
,actionButton("ForceCombi", "force C and D")
)
server <- function(input, output, session) {
tstamp <- reactiveValues(t = Sys.time())
observeEvent(input$A_sel, {
req((Sys.time() - tstamp$t) > 0.5)
tstamp$t <- Sys.time()
updateSelectInput(session,"B_sel", selected = input$A_sel)
})
observeEvent(input$ForceCombi, {
updateSelectInput(session,"A_sel", selected = "C")
updateSelectInput(session,"B_sel", selected = "D")
tstamp$t <- Sys.time()
})
}
shinyApp(ui, server)