I am building multiple lm() models using dplyr. I want to allow a user to change the independent variable value in a Shiny app - via shiny::sliderInput(). But only do so where "goodness of fit" say R^2 is greater than a threshold - otherwise disable the slider. I have tried to use the shinyjs::disable() function. See below, but can't get it to work. Any ideas on what I am doing wrong ?
library(shiny)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("test","Nice number",min = 1,max = 50,value = 30)
),
mainPanel(
textOutput("valueText")
)
)
))
# Define server to disable slider if value selected
server <- shinyServer(function(input, output) {
value <- reactive(input$test)
output$valueText <- renderText(paste(value()))
#How to diasble slider?
reactive(if(value()==35){
shinyjs::disable('test')
}
)
})
# Run the application
shinyApp(ui = ui, server = server)
You have to call useShinyjs() in ui.R.
This is the code:
library(shiny)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- shinyUI(
tagList(
useShinyjs(),
fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("test","Nice number",min = 1,max = 50,value = 30)
),
mainPanel(
textOutput("valueText")
)
)
)
)
)
# Define server to disable slider if value selected
server <- shinyServer(function(input, output) {
value <- reactive(input$test)
output$valueText <- renderText(paste(value()))
#How to diasble slider?
observeEvent(value(), {
if(value()==35){
shinyjs::disable('test')
}
})
})
# Run the application
shinyApp(ui = ui, server = server)
Related
I am not sure if what I am missing anything here, it seemed that event is not caught by observeEvent when an selectInput (multi-select on) is cleared. However, it is caught using reactive().
See example below, the goal is that with any changes in the selectInput, the program will pick up the change and display on screen. I used 2 examples:
Reactive to display on html_component2
ReactiveValues using observeEvent to display on html_component
For reactive function, it works perfectly. For the later, it works for all combinations, except when if user unselect everything. I am really confused on why, has anyone seen this issue before and if there are any workarounds for it? I'd prefer to use reactive values in this case for my application.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("sinput", "select here", c(1,2,3,4,5), multiple = T),
),
# Show a plot of the generated distribution
mainPanel(
htmlOutput("html_component"),
htmlOutput("html_component2"),
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
rv <- reactiveValues()
sel <- reactive({
input$sinput
})
observeEvent(input$sinput, {
rv$selected = input$sinput
})
output$html_component <- renderUI({
HTML(paste(c("1:", rv$selected)))
})
output$html_component2 <- renderUI({
HTML(paste(c("2:", sel())))
})
}
# Run the application
shinyApp(ui = ui, server = server)
By default observeEvent will ignore NULL in it's eventExpr, you need to set ignoreNULL = FALSE:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("sinput", "select here", c(1,2,3,4,5), multiple = T),
),
# Show a plot of the generated distribution
mainPanel(
htmlOutput("html_component"),
htmlOutput("html_component2"),
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
rv <- reactiveValues()
sel <- reactive({
input$sinput
})
observeEvent(input$sinput, {
rv$selected = input$sinput
}, ignoreNULL = FALSE)
output$html_component <- renderUI({
HTML(paste(c("1:", rv$selected)))
})
output$html_component2 <- renderUI({
HTML(paste(c("2:", sel())))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have the shiny app below with 2 actionButton(). I want when I press Datatable the Datatable2 to be disabled and when I click again on Datatable the Datatable2 to be available for pressing again.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("exc","Datatable"),
actionButton("exc2","Datatable2")
),
mainPanel(
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
This is really straightforward if you use the toggleState() function from the shinyjs package.
The help for that function gives you an extremely similar situation. In your case:
library(shiny)
ui <- fluidPage(
useShinyjs(), #this activates shinyjs
sidebarLayout(
sidebarPanel(
actionButton("exc","Datatable"),
actionButton("exc2","Datatable2")
),
mainPanel(
)
)
)
server <- function(input, output) {
observeEvent(input$exc, {
toggleState("exc2") #identify the element to toggle between active/inactive
})
}
shinyApp(ui = ui, server = server)
I am using shinydashboardplus.
I'd like to use the to do list but the example in the gallery is limited to just showing a list without any functionality.
To track a todo list for a user I am reading and writing to a csv for the moment.
I can read the csv to dynamically populate the list. Now I'd like to be able to strike through an item to indicate it is completed using the checked parameter.
The checked items should be removed from the csv.
Ill work on the adding items another day I think....
Here is my example (not reading from csv but from iris for this example).
library(shiny)
library(shinydashboardPlus)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
useShinydashboardPlus(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
box(
"Sortable todo list demo",
status = "warning",
todoList(
apply(mtcars,1, function(x)
todoListItem(
label = x[1],
x[2]
)
)
)
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Here is an approach using renderUI and a reactive data.frame:
library(shiny)
library(shinydashboardPlus)
library(shinyWidgets)
css <- "
.inlinecheckbox .shiny-input-container {
display: inline-block;
width: auto;
}
"
ui <- fluidPage(
tags$style(css),
titlePanel("Dynamic to do list"),
useShinydashboardPlus(),
sidebarLayout(
sidebarPanel(),
mainPanel(
box(
"Sortable todo list demo",
status = "warning",
uiOutput("myToDoList")
)
)
)
)
checkboxIDs <- paste0("checkbox", seq_len(nrow(mtcars)))
mtcars$checked <- FALSE
# Define server logic required to draw a histogram
server <- function(input, output) {
reactiveMtcars <- reactiveVal(mtcars)
observe({
for (i in seq_along(checkboxIDs)) {
if(!is.null(input[[checkboxIDs[1]]])){
mtcars$checked[i] <- input[[checkboxIDs[i]]]
}
}
reactiveMtcars(mtcars)
})
output$myToDoList <- renderUI({
req(reactiveMtcars())
todoListItems <- list()
for(i in seq_len(nrow(reactiveMtcars()))){
todoListItems[[i]] <- todoListItem(
label = div(rownames(reactiveMtcars())[i], style = ""),
span(class = "inlinecheckbox", checkboxInput(inputId = paste0("checkbox", i), label = NULL, value = reactiveMtcars()$checked[i])),
checked = reactiveMtcars()$checked[i],
)
}
todoList(todoListItems)
})
}
shinyApp(ui = ui, server = server)
I have a very simple app which fails. The reason it fails is that the reactive dataset is available solely within the observeEvent function but not outside. I use observeEvent to get datasets from two different sources wrangled. For this example I simply used cbind. My actual code is much more complicated.
This is a logical / syntax related problem but all my searching came up short. In essence I want merged_data() to be available for all parts of the app.
Minimum repr example - this fails because merged_data() is not available outside of the ObserveEvent.
library(shiny)
library(shinyjs)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("testing 1 2 3"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width = 2,
offset = 0,
align = "center",
actionButton(inputId = "fetch_data_inputId",
label = "data")
) #column
,
column(width = 10,
offset = 0,
align = "center",
DT::dataTableOutput("DT1")
) #column
)#fluidrow
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
observeEvent(input$fetch_data_inputId, {
req(iris)
button_data <- colnames(iris)
merged_data <- reactive({
if( !is.null(cbind(iris[,1:4],iris3))) {
cbind(iris[,1:4],iris3)
} else {NULL}
})
}) #observeevent
output$DT1 <- renderDataTable({#
rendered_table <- merged_data()
DT::datatable(rendered_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Minimum repr example - this works because the datatable is created within the ObserveEvent.
library(shiny)
library(shinyjs)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("testing 1 2 3"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width = 2,
offset = 0,
align = "center",
actionButton(inputId = "fetch_data_inputId",
label = "data")
) #column
,
column(width = 10,
offset = 0,
align = "center",
DT::dataTableOutput("DT1")
) #column
)#fluidrow
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
observeEvent(input$fetch_data_inputId, {
req(iris)
button_data <- colnames(iris)
merged_data <- reactive({
if( !is.null(cbind(iris[,1:4],iris3))) {
cbind(iris[,1:4],iris3)
} else {NULL}
})
output$DT1 <- renderDataTable({#
rendered_table <- merged_data()
DT::datatable(rendered_table)
})
}) #observeevent
}
# Run the application
shinyApp(ui = ui, server = server)
What I really need is for the reactive dataset to continue being created within observeEvent but to be accessible outside of the ObserveEvent environment so that i use it in other parts of the app, but I suspect it's the wrong approach. So anything that works would be great.
library(shiny)
library(shinyjs)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("testing 1 2 3"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width = 2,
offset = 0,
align = "center",
actionButton(inputId = "fetch_data_inputId",
label = "data")
) #column
,
column(width = 10,
offset = 0,
align = "center",
DT::dataTableOutput("DT1")
) #column
)#fluidrow
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
merged_data <- eventReactive(input$fetch_data_inputId, {
req(iris)
button_data <- colnames(iris)
if( !is.null(cbind(iris[,1:4],iris3))) {
cbind(iris[,1:4],iris3)
} else {NULL}
}) #eventReactive
output$DT1 <- renderDataTable({#
rendered_table <- merged_data()
DT::datatable(rendered_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am new with r shiny and I am trying to get selected value of a radio button as variable and then concatenate it with something else. Here is my code:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("This is test app"),
sidebarLayout(
sidebarPanel(
radioButtons("rd",
label="Select window size:",
choices=list("100","200","500","1000"),
selected="100")
),
mainPanel(
//Something
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
ncount <- reactive({input$rd})
print(ncount)
my_var <- paste(ncount,"100",sep="_")
})
Now when I print ncount it prints out "ncount" rather than the value stored in the variable. Is there anything that I'm missing here.
Thanks
UI
library(shiny)
shinyUI(fluidPage(
titlePanel("This is test app"),
sidebarLayout(
sidebarPanel(
radioButtons("rd",
label = "Select window size:",
choices = list("100" = 100,"200" = 200,"500" = 500,"1000" = 1000),
selected = 100)
),
mainPanel(
verbatimTextOutput("ncount_2")
)
)
))
Server
library(shiny)
shinyServer(function(input, output) {
# The current application doesnt need reactive
output$ncount_2 <- renderPrint({
ncount <- input$rd
paste(ncount,"100",sep="_")
})
# However, if you need reactive for your actual data, comment the above part
# and use this instead
# ncount <- reactive({input$rd})
#
# output$ncount_2 <- renderPrint({
# paste(ncount(),"100",sep="_")
# })
})