I have a table where I get a value from the same column but from different rows and I would like to display in a verbatimTextOutput each value without overwriting each time.
I tried to do that but I get an error:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE)
)
server <- function(input, output) {
val <- reactiveVal(as.character(dt[input$table_rows_selected, 2]))
o <- reactiveVal(NULL)
observeEvent(input$table_rows_selected, {
o(c(o(), "\n", "You chose :", val()))
output$output <- renderText({ o() })
})
dt <- data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
output$table <- DT::renderDataTable({
DT::datatable(dt, selection = list(target = 'row'))
})
}
shinyApp(ui = ui, server = server)
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Related
I am trying to create a dashboard in rShiny which follow the following steps
Select a parameter
Filter data from a source table for this parameter
Create a list of this filtered data for one of the column
Iterate over this list to display graphs etc...
I have tried various options for making this work but the communication between ui and server is not happening as expected
I have created a setup as below fot testing
library(shiny)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)
select the number of gears
Find the cars with that number of gears
Create a list of these cars
Display the data for each of the car by using loop. Loop is needed as other output types like graphs can be latter added
simpUI <- function(id) {
tagList(tableOutput(NS(id, "dat_output"))
numericInput(NS(id, "GearNumber"), "Gear Numbers", 3),
lapply(seq(1, length(v_lst_CarName), by = 1), function(i) {
v_CarName = v_lst_CarName[i]
v_obj_CarName = paste0('sp_cars_', v_CarName)
tableOutput(NS(id, v_obj_CarName))
}))
}
simpServer <- function(id) {
moduleServer(id, function(input, output, session) {
output$dat_output <- renderTable(df_mtcars)
v_lst_CarName <-
reactive(df_mtcars[GearNumber == input$GearNumber]$CarName)
for (v_CarName in v_lst_CarName)
v_obj_CarName = paste0('sp_cars_', v_CarName)
output$v_obj_CarName <- renderTable(v_obj_CarName)
})
}
ui <- fluidPage(fluidRow(simpUI("cars")))
server <- function(input, output, session) {
simpServer("cars")
}
shinyApp(ui = ui, server = server)
It is better to do server side processing. Try this
library(shiny)
library(ggplot2)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)
simpUI <- function(id) {
ns <- NS(id)
tagList(tableOutput(ns("dat_output")),
numericInput(ns("GearNumber"), "Gear Numbers", 3),
uiOutput(ns("plotxy")),
tableOutput(ns("v_obj_CarName")),
verbatimTextOutput(ns("mylist")),
plotOutput(ns("myplot"))
)
}
simpServer <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$dat_output <- renderTable(head(df_mtcars))
mydf <- reactive(df_mtcars[df_mtcars$gear == input$GearNumber,])
v_lst_CarName <- eventReactive(mydf(), {paste0("sp_cars_",mydf()$CarName)})
output$plotxy <- renderUI({
req(mydf())
tagList(
selectInput(ns("xvar"), label = "X-axis variable", choices = names(mydf()), selected=names(mydf())[2] ),
selectInput(ns("yvar"), label = "Y-axis variable", choices = names(mydf()), selected=names(mydf())[5] )
)
})
output$v_obj_CarName <- renderTable({mydf()})
output$mylist <- renderPrint(list(v_lst_CarName() ))
output$myplot <- renderPlot({
req(input$xvar,input$yvar)
ggplot(mydf(),aes(x=.data[[input$xvar]], y=.data[[input$yvar]])) + geom_point()
})
})
}
ui <- fluidPage(fluidRow(simpUI("cars")))
server <- function(input, output, session) {
simpServer("cars")
}
shinyApp(ui = ui, server = server)
I would like to use a user defined function in Shiny to perform a simple calculation with output two variables. The function I wrote works when it is not part of a shiny app. However when part of a Shiny, the returned object (dfr) is ‘not in scope’. What am I missing?
library(shiny)
# Function ----------------------------------------------------------------
convert <- function(coef_1, coef_2, vec) {
part_1 <- coef_1/(2*sin((vec/2)*pi/180))
part_2 <- 2*(180/pi)*(asin(coef_2/(2*part_1)))
dfr <- data.frame(part_1, part_2)
return(dfr)
}
# End Function ------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("num", h3("Enter number to convert:"), value = NULL)
),
mainPanel(
verbatimTextOutput("text1", placeholder = TRUE),
verbatimTextOutput("text2", placeholder = TRUE)
)
)
)
server <- function(input, output) {
nums_str <- as.character(input$num)
nums_vector <- as.numeric(unlist(strsplit(nums_str, split = ",")))
convert(1.5, 1.1, nums_vector)
output$text1 <- renderText({
req(input$num)
dfr$part_1
})
output$text2 <- renderText({
req(input$num)
dfr$part_2
})
}
shinyApp(ui = ui, server = server)
When you use inputs, you need to do it in reactive environment, such as reactive(), renderDataTable(), etc.
Here, you need to run your function in a reactive() and then call it with dfr() in the outputs.
server <- function(input, output) {
dfr <- reactive({
convert(1.5, 1.1, as.numeric(input$num))
})
output$text1 <- renderText({
req(input$num)
dfr()$part_1
})
output$text2 <- renderText({
req(input$num)
dfr()$part_2
})
}
Since this is quite basic stuff with R Shiny, checking some tutorials might be very useful.
I have a button that when you click on it, it displays a table and when you click on a line, it displays the line number in a verbatimTextOutput
I have a reactive variable o() that saves all the lines that have been selected and when no line is selected it displays "nothing".
When I launch the application it displays several times "nothing" I don't understand why.
How could I redo the code to avoid these multiple appearances when launching the application?
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
dt <- reactiveVal()
o <- reactiveVal()
val <- reactive(
tail(
as.character(dt()[input$table_rows_selected, 2]),
n=1)
)
val2 <- reactiveVal()
observeEvent(input$updateTable, {
# the datatable
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
if(is.null(val())){ val2("nothing")}
})
observeEvent(val(), {
if(length(input$table_rows_selected) > 0){
val2(val())
o(c(o(), "\n", "You chose :", val2()))
} else{
val2("nothing")
o(c(o(), "\n", "You chose :", val2()))
}
output$output <- renderText({ o() })
})
}
shinyApp(ui = ui, server = server)
solution 1
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("showTable", "Show data table")
)
server <- function(input, output) {
val <- reactiveVal()
o <- reactiveVal()
dt <- reactiveVal()
observe({
val(as.character(dt()[input$table_rows_selected, 2]))
})
observeEvent(input$showTable, {
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
o(c(o(), "\n", "Display of the table"))
})
output$output <- renderText({
if(input$showTable)
{
if(!identical(val(), character(0))){
o(c( isolate(o()), "\n", "You chose: ", isolate(val())))
} else{
o(c( isolate(o()), "\n", "You chose: ", "nothing"))
}
o()
}
})
}
shinyApp(ui = ui, server = server)
Solution 2
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("showTable", "Show data table")
)
server <- function(input, output) {
o <- reactiveVal()
dt <- reactiveVal()
observeEvent(input$showTable, {
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
o(c(o(), "\n", "Display of the table"))
})
val <- reactive({
if(!is.null(input$table_rows_selected)){
tail(
as.character(dt()[input$table_rows_selected, 2]),
n = 1
)
} else{ "nothing" }
})
observeEvent(val(), {
if(input$showTable)
{
o(c(o(), "\n", "You chose: ", val()))
}
})
output$output <- renderText({ o() })
}
shinyApp(ui = ui, server = server)
Your approach is too complex. Here's a simplified way -
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
val <- reactiveVal()
dt <- eventReactive(input$updateTable, {
# the datatable
data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
})
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
observe({
val(c(isolate(val()), as.character(dt()[input$table_rows_selected, 2])))
})
output$output <- renderText({ paste0("\n You chose :", unique(val())) })
}
shinyApp(ui = ui, server = server)
It's due to your reactive values updating when the table is shown. The easiest solution is just remove adding "\n", "You chose :", val2() to your list and just have it as a default option for o().
See below for the code:
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
dt <- reactiveVal()
o <- reactiveVal()
val <- reactive(
tail(
as.character(dt()[input$table_rows_selected, 2]),
n=1)
)
val2 <- reactiveVal()
observeEvent(input$updateTable, {
# the datatable
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
if(is.null(val())){ val2("nothing")}
})
observeEvent(val(), {
if(length(input$table_rows_selected) > 0){
val2(val())
o(c(o(), "\n", "You chose :", val2()))
} else{
val2("nothing")
o(c("\n", "You chose :", val2()))
}
output$output <- renderText({ o() })
})
}
shinyApp(ui = ui, server = server)
UPDATED
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
#Data table
dt <- data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
output$table <- DT::renderDataTable({
DT::datatable(dt, selection = list(target = 'row'))
})
shinyjs::hide("table")
#Button
observeEvent(input$updateTable, {
shinyjs::show("table")
shinyjs::show("output")
})
#Value Box
o <- reactiveVal()
val <- reactive({
tail(
as.character(dt[input$table_rows_selected, 2]),
n = 1
)
})
observeEvent(val(), {
if(length(input$table_rows_selected) > 0){
o(c(o(), "\n", "You chose :", val()))
} else{
req(o())
o(c(o(), "\n", "You chose : nothing"))
}
})
output$output <- renderText({ o() })
shinyjs::hide("output")
}
shinyApp(ui = ui, server = server)
I am attempting to exclude a ShinyJS delay from a reactive bookmarking context in Shiny. I see that the delay ID in the URL is autogenerated and always different: delay-ad190e10123bd97f960fed7a8a9e6fde=3000.
I attempted to exclude the delay via regular expression, however I don't believe the regex is being parsed:
setBookmarkExclude(
c("delay-[[:alnum:]]"))
I would like a way to either set the ID on the delay so it is the same every time or to regex the setBookmarkExclude to exclude the randomly generated delay ID
Please see the following example:
library(shiny)
library(shinyjs)
ui <- function(request) {
fluidPage(
useShinyjs(),
br(),
bookmarkButton(id="bookmarkBtn"),
hr(),
textOutput("ExcludedIDsOut"),
hr(),
sliderInput(inputId="slider", label="My value will be bookmarked", min=0, max=10, value=5),
textOutput("out_1"),
textOutput("out_2"),
textOutput("out_3")
)
}
server <- function(input, output, session) {
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
ExcludedIDs <- reactiveVal(value = NULL)
observe({
toExclude <- "bookmarkBtn"
delayExclude <- grep("delay", names(input), value = TRUE)
if(length(delayExclude) > 0){
toExclude <- c(toExclude, delayExclude)
}
setBookmarkExclude(toExclude)
ExcludedIDs(toExclude)
})
output$ExcludedIDsOut <- renderText({
paste("ExcludedIDs:", paste(ExcludedIDs(), collapse = ", "))
})
delay(1000, {
output$out_1 <- renderText({
"My"
})
})
delay(2000, {
output$out_2 <- renderText({
"delayed"
})
})
delay(3000, {
output$out_3 <- renderText({
"output"
})
})
}
enableBookmarking(store = "url") # store = "server"
shinyApp(ui, server)
Update: Whitelist approach
library(shiny)
library(shinyjs)
ui <- function(request) {
fluidPage(
useShinyjs(),
br(),
bookmarkButton(id="bookmarkBtn"),
hr(),
textOutput("ExcludedIDsOut"),
hr(),
sliderInput(inputId="slider", label="My value will be bookmarked", min=0, max=10, value=5),
textOutput("out_1"),
textOutput("out_2"),
textOutput("out_3")
)
}
server <- function(input, output, session) {
bookmarkingWhitelist <- c("slider")
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
ExcludedIDs <- reactive({
toExclude <- setdiff(names(input), bookmarkingWhitelist)
setBookmarkExclude(toExclude)
toExclude
})
output$ExcludedIDsOut <- renderText({
paste("ExcludedIDs:", paste(ExcludedIDs(), collapse = ", "))
})
delay(1000, {
output$out_1 <- renderText({
"My"
})
})
delay(2000, {
output$out_2 <- renderText({
"delayed"
})
})
delay(3000, {
output$out_3 <- renderText({
"output"
})
})
}
enableBookmarking(store = "url") # store = "server"
shinyApp(ui, server)
Here is a related GitHub issue, note session$getBookmarkExclude() as an alternative to keep track of the excluded inputs.
The app is intended to display summarized_mod when the action button is clicked. But I keep getting a summarized_mod missing error.
summarized <- data.frame(id = 1:20, group = letters[1:4], TY_COMP = runif(20), LY_COMP = runif(20))
library(shiny)
ui <- fluidPage(
verbatimTextOutput("text"),
actionButton("btn", "Show the summarized")
)
server <- function(input, output){
summarized <- reactive({summarized})
observeEvent(input$btn,{
summarized_mod <-summarized()$TY_COMP / summarized()$LY_COMP-1 }
})
output$text <- renderPrint(summarized_mod())
}
shinyApp(ui, server)
dat <- data.frame(id = 1:20,
group = letters[1:4],
TY_COMP = runif(20),
LY_COMP = runif(20))
library(shiny)
ui <- fluidPage(
verbatimTextOutput("text"),
actionButton("btn", "Show the summarized")
)
server <- function(input, output){
# summarized <- reactive({summarized}) useless !
summarized_mod <- eventReactive(input$btn, {
dat$TY_COMP / dat$LY_COMP-1
})
output$text <- renderPrint(summarized_mod())
}
shinyApp(ui, server)