The goal is to have a shiny module ui1.R activating the submit button only when something is typed in lsuId. The current code doesn't retrieve any errors, but it seems it never calls toggleState.
ui.R
library(shiny)
library(shinyjs)
htmlOutput("page")
server.R
rm(list = ls())
library(shiny)
library(dplyr)
library(shinyjs)
Logged <- FALSE
shinyServer(function(input, output) {
observeEvent(input$"ui1Output-confirm", {
Logged <<- T
})
observe({
input$"ui1Output-confirm"
if (Logged == FALSE) {
output$page <- renderUI({
ui1Output('ui1Output')
})
output$lsuId <- renderText({ input$lsuId })
}
if (Logged == TRUE)
{
output$page <- renderUI({ ui2 })
}
})
callModule(ui1,'ui1')
})
ui1.R
library(shinyjs)
ui1Output <- function(id, label = "ui1") {
ns <- NS(id)
shinyUI(fluidPage(
useShinyjs(),
titlePanel("Form"),
div(textInput(ns("lsuId"), "This has to be filled", ""),
actionButton(ns("confirm"), "Submit", class = "btn-primary")
)
))
}
ui1 <- function(input, output, session) {
shinyjs::toggleState(id = "confirm", condition = F)
observeEvent(input$lsuId!="", {
shinyjs::toggleState(id = "confirm", condition = T)
})
}
ui2.R
ui2<- shinyUI(fluidPage(
div("well done!")
))
global.R
source('ui1.R') #login page
source('ui2.R')
Here's how I would approach this one:
ui.R
library(shiny)
shinyUI(
fluidPage(
fluidRow(column(width = 12,
align = 'center',
h1('Conditional Submit Button'))),
fluidRow(column(width = 12,
align = 'center',
textInput(inputId = 'text.field',
label = 'What is your greatest fear?',
value = ''),
uiOutput('submit.button')))
)
)
server.R
library(shiny)
shinyServer(
function(input, output) {
output$submit.button <-
renderUI(expr = if (nchar(input$text.field)) {
submitButton()
} else {
NULL
})
}
)
This approach doesn't use shinyjs, which I think is a positive (fewer dependencies), but I don't know if there's some reason you are interested in doing it with shinyjs that isn't stated in your question.
Here, ui.R simply has a textInput UI element with inputId 'text.field' and a promise that another UI element will be rendered in server.R called 'submit.button'.
In server.R, output$submit.button is set to NULL if the number of characters in input$text.field is 0, and set to submitButton() otherwise.
observe({
if (is.null(input$lsuId) || input$lsuId == "") {
shinyjs::disable("submit")
} else {
shinyjs::enable("submit")
}
})
Related
I am trying to pass a value assigned in an observeEvent to another observeEvent in shiny. In addition to the codes below, I also attempted to use my_dynamic_table(), but unfortunately I couldn't achieve my goal.
My aim is to have "Something 1" on the screen if my_dynamic_table is not empty.
library(shiny)
library(DT)
my_dynamic_table = data.frame(NA)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
observeEvent (input$call ,{
my_dynamic_table <- mtcars
output$table_out <- DT::renderDataTable(
my_dynamic_table
) # renderDataTable : table_out
})
observeEvent (input$save,{
output$text <- renderText({
if(nrow(my_dynamic_table)>1) {
"Something 1"
}else {
"Something 2"
}
}) #renderText
}) #observeEvent
} #server
) #shinyApp
One option to achieve that would be to use a reactiveVal or reactiveValues:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call", "Call"),
actionButton("save", "Save"),
verbatimTextOutput("text"),
DT::dataTableOutput("table_out")
),
server = function(input, output, session) {
my_dynamic_table <- reactiveVal(data.frame())
observeEvent(input$call, {
my_dynamic_table(mtcars)
output$table_out <- DT::renderDataTable(
my_dynamic_table()
)
})
observeEvent(input$save, {
output$text <- renderText({
if (nrow(my_dynamic_table()) > 0) {
"Something 1"
} else {
"Something 2"
}
}) # renderText
}) # observeEvent
} # server
) # shinyApp
While I do think that using reactiveValues is a good solution to this problem, I'd say its never a good idea to use an output inside an observeEvent(). I would rearrange the code as below. In the observeEvent we observe the action buttons, and when clicked, update the reactiveValues. Those are again intermediates for your output.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
my <- reactiveValues(dynamic_table = data.frame(NA),
text = NA)
observeEvent(input$call, {
my$dynamic_table <- mtcars
})
observeEvent(input$save, {
if (nrow(my$dynamic_table) > 1) {
my$text <- "Something 1"
} else {
my$text <-"Something 2"
}
})
output$text <- renderText({
req(input$save)
my$text
})
output$table_out <- DT::renderDataTable({
req(input$call)
my$dynamic_table
})
} #server
) #shinyApp
I have this shiny app. The main aim is to upload excel sheet with data and plot some graphs in tabs. User is able to select a sheet to make the graph. The seet will render to observe the selected data. This works well.
But I am struggling to manipulate with input data to make the graph.
I tried to use reactive value named data and then make the graph from that. I am quite new with shiny apps.
library(shiny)
library(readxl)
library(dplyr)
library(tidyverse)
library(lubridate)
ui <- fluidPage(
titlePanel("OTD project update"),
sidebarPanel(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
textInput('file1sheet','Name of Sheet (Case-Sensitive)')),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("Data", tableOutput("value")),
tabPanel("OTD", plotOutput("OTD"))
)
)
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
output$value <- renderTable({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$file1$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
data <- reactive({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
}
shinyApp(ui, server)
It may be better to use the sheet names in radio buttons to pick instead of typing it. Also, there was a typo. Try this
library(shiny)
library(readxl)
library(dplyr)
library(tidyverse)
library(lubridate)
library(DT)
ui <- fluidPage(
titlePanel("OTD project update"),
sidebarPanel(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
#textInput('file1sheet','Name of Sheet (Case-Sensitive)')
uiOutput("sheet")
),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel("Data", DTOutput("table")),
tabPanel("OTD", plotOutput("plot"))
)
)
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
data <- reactive({
req(sheets_name())
if (!is.null(input$file1)) {
return(read_excel(input$file1$datapath, sheet = input$mysheet))
} else {
return(NULL)
}
})
output$sheet <- renderUI({
req(sheets_name())
radioButtons("mysheet", "Select a Sheet", choices = sheets_name())
})
output$table <- renderDT(data())
output$plot <- renderPlot({plot(cars)})
}
shinyApp(ui, server)
I am building a dashboard where I need to create a number of boxes (based on the dataset) provided and then have each box be able to click and show subset boxes.
I can do this if I knew the data beforehand but I am having trouble with creating link id's and showing and hiding content when creating things dynamically.
Below is the code of how it should function (but using static content)
library(shiny)
library(shinydashboard)
library(shinyjs)
#####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
uiOutput("box1"),
uiOutput("box2"),
uiOutput("box3")
),
fluidRow(
div(id = "ILRow",
uiOutput("box1a"),
uiOutput("box1b"),
uiOutput("box1c")
),
div(id = "NCRow",
uiOutput("box2a"),
uiOutput("box2b")
),
div(id = "INRow",
uiOutput("box3a")
)
)
)
ui <- dashboardPage(header, sidebar, body)
#####/SERVER/####
server <- function(input, output) {
CSRbox <- function(description = NULL, linkName = NULL) {
# the box tags
withTags(
# col
div(
class = "col-md-2",
# Widget: user widget style 1
div(
class = "box",
## Box Header ##
div(
actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x")),
h2(description)
)
)
)
)
}
dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))
output$box1 <- renderUI({
CSRbox("Illinois", "Ill_Link")
})
output$box2 <- renderUI({
CSRbox("North Carolina", "NC_Link")
})
output$box3 <- renderUI({
CSRbox("Indiana", "IN_Link")
})
output$box1a <- renderUI({
CSRbox("Chicago", "CH_Link")
})
output$box1b <- renderUI({
CSRbox("Niles", "NI_Link")
})
output$box1c <- renderUI({
CSRbox("Evanston", "EV_Link")
})
output$box2a <- renderUI({
CSRbox("Charlotte", "CA_Link")
})
output$box2b <- renderUI({
CSRbox("Raleigh", "RL_Link")
})
output$box3a <- renderUI({
CSRbox("West Lafayette", "WL_Link")
})
shinyjs::hide("ILRow")
shinyjs::hide("NCRow")
shinyjs::hide("INRow")
observeEvent(input$Ill_Link, {
shinyjs::toggle("ILRow")
shinyjs::hide("NCRow")
shinyjs::hide("INRow")
})
observeEvent(input$NC_Link, {
shinyjs::toggle("NCRow")
shinyjs::hide("ILRow")
shinyjs::hide("INRow")
})
observeEvent(input$IN_Link, {
shinyjs::toggle("INRow")
shinyjs::hide("ILRow")
shinyjs::hide("NCRow")
})
}
shinyApp(ui, server)
Below is the code of creating the boxes dynamically but the functionality doesn't work (this is where I need help!):
library(shiny)
library(shinydashboard)
library(shinyjs)
#####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
uiOutput("boxLevel1")
),
fluidRow(
div(id = "LevelDetail",
uiOutput("boxLevel2")
)
)
)
ui <- dashboardPage(header, sidebar, body)
#####/SERVER/####
server <- function(input, output) {
CSRbox <- function(description = NULL, linkName = NULL) {
# the box tags
withTags(
# col
div(
class = "col-md-2",
# Widget: user widget style 1
div(
class = "box",
## Box Header ##
div(
actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x")),
h2(description)
)
)
)
)
}
dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))
output$boxLevel1 <- renderUI({
lapply(sort(unique(dat$State)), function(name) {
CSRbox(name, paste0(name,"Link"))
})
})
output$boxLevel2 <- renderUI({
temp <- dat[dat$State == "Illinois",] #Should be based of off the input$Click of the Input Link. Ex: input$Illinois
lapply(sort(unique(temp$City)), function(name) {
CSRbox(name, paste0(name,"Link2"))
})
})
shinyjs::hide("LevelDetail")
observeEvent(input$IllinoisLink, { #Would need to loop through and make an observeEvent for each possible input$click
shinyjs::toggle("LevelDetail")
})
}
shinyApp(ui, server)
UPDATE
I have figured out how to track the input ID's which allows me to create the correct subset of boxes dynamically(woo!). I am still having trouble with the show and hide though. I have figured out how to show the subset of boxes but I can't figure out how to hide since I am using the input ID which doesn't change when pressing on the link twice so the observeEvent doesn't run. I tried to get just the input of the link which would tell me the count of it so I know if it's changed BUT I am getting errors when I use the input[[input$last_btn]] (which should be the same as ex: input$Illinois). Any help is appreciated! I could add another button separately that would do the hide but that is not ideal.
library(shiny)
library(shinydashboard)
library(shinyjs)
#####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
tags$head(tags$script(HTML("$(document).on('click', '.needed', function () {
Shiny.onInputChange('last_btn',this.id);
});"))),
fluidRow(
uiOutput("boxLevel1"),
textOutput("lastButtonCliked")
),
fluidRow(
div(id = "LevelDetail",
uiOutput("boxLevel2")
)
)
)
ui <- dashboardPage(header, sidebar, body)
#####/SERVER/####
server <- function(input, output) {
CSRbox <- function(description = NULL, linkName = NULL) {
# the box tags
withTags(
# col
div(
class = "col-md-2",
# Widget: user widget style 1
div(
class = "box",
## Box Header ##
div(
actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x"), class="needed"),
h2(description)
)
)
)
)
}
dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))
output$boxLevel1 <- renderUI({
lapply(sort(unique(dat$State)), function(name) {
CSRbox(name, paste0(name))
})
})
output$boxLevel2 <- renderUI({
temp <- dat[dat$State == input$last_btn,] #Should be based of off the input$Click of the Input Link. Ex: input$Illinois
lapply(sort(unique(temp$City)), function(name) {
CSRbox(name, paste0(name,"Link2"))
})
})
avs <- reactiveValues(
clickN = NA, #new click
clickO = NA, #original click
dataSame = TRUE #data sets are the same
)
observe({
avs$clickN <- input$last_btn
})
shinyjs::hide("LevelDetail")
observeEvent(input$last_btn, {
avs$dataSame <- identical(avs$clickN, avs$clickO)
if(!avs$dataSame) {
shinyjs::show("LevelDetail")
avs$clickO <- avs$clickN
} else {
shinyjs::hide("LevelDetail")
avs$clickO <- NULL
}
})
}
shinyApp(ui, server)
Quick question: How is it possible to use/get the selection of a gvisTable in shiny?
I can achieve this with the DT package like this:
library(DT)
library(shiny)
server <- function(input, output) {
output$dt <- renderDataTable({
datatable(cbind(c(1,2,3,4,5),c(5,4,3,2,1)))
})
output$dtselect <- renderText({
input$dt_rows_selected
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
"Selected Rows from Datatable in Text Output"
),
mainPanel(dataTableOutput("dt"),
textOutput("dtselect"))
)
)
shinyApp(ui = ui, server = server)
Is it possible to get the same selection with gvis? I googled a lot but could not find somebody reproducing the same in shiny.
You can add a listenerto the options and bind it to a variable called text as I did
rm(list = ls())
library(shiny)
library(googleVis)
mydata <- as.data.frame(cbind(c(1,2,3,4,5),c(5,4,3,2,1)))
server <- function(input, output) {
output$myTable <- renderGvis({
gvisTable(mydata, chartid = "mydata",
options = list(gvis.listener.jscode = "var text = data.getValue(chart.getSelection()[0].row,0);Shiny.onInputChange('text', text.toString());"))})
output$dtselect <- renderText({input$text})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
"Selected Rows from Datatable in Text Output"
),
mainPanel(htmlOutput("myTable"),textOutput("dtselect"))
)
)
shinyApp(ui = ui, server = server)
Variant to handle multiple selection (as told here )
library(googleVis)
library(shiny)
mydata <- as.data.frame(cbind(c(1,2,3,4,5),c(5,4,3,2,1)))
shinyApp(
ui = fluidPage(
htmlOutput("myTable")
)
,
server = function(input,output){
observe({
print(input$r_select)
})
output$myTable <- renderGvis({
gt= gvisTable(mydata,chartid="mydata")
jsInsert ="
google.visualization.events.addListener(chart, 'select', selectHandler);
var selectedRows = new Array();
function selectHandler() {
var selection = chart.getSelection();
for (var idx in selection){
var item = selection[idx];
if (item) {
i = selectedRows.indexOf(item.row);
if (i == -1){
selectedRows.push(item.row);
data.setProperty(item.row, 0,'style','background-color:#d6e9f8;');
data.setProperty(item.row, 1,'style','background-color:#d6e9f8;');
} else {
selectedRows.splice(i,1);
data.setProperty(item.row,0,'style',null);
data.setProperty(item.row,1,'style',null);
}
}
}
chart.setSelection(null);
Shiny.onInputChange('r_select',selectedRows);
chart.draw(data,options);
}
chart.draw(data,options);
"
gt$html$chart[['jsDrawChart']] <- gsub("chart.draw\\(data,options\\);", jsInsert, gt$html$chart[['jsDrawChart']])
gt
})
}
)
Print values of selected rows in observe.
Indexing start from 0
I just new in Shiny, and i have problem. i have a event reactive and the stop function inside. when I run my code(no checkbox and do click button), the shiny is work well. but in console display the error message "eventReactiveHandler". do you have a solution for my problem? i want to no error message in my console.
and i not expect the solution is
opt <- options(show.error.messages=FALSE)
on.exit(options(opt))
because the error will not display in my all code, i want just specifically in this error.
thank you... this is the code...
rm(list = ls())
library(shiny)
library(shinyBS)
var.x<-reactiveValues()
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput("indepvar","Independent Variable",
choices = c("1"=1,"2"=2)),
actionButton("tabBut", "View Table")
),
mainPanel(
uiOutput("coba"),
uiOutput("popup4")
)
)
),
server =
function(input, output, session) {
output$coba <- renderUI({
gendata()
indep<-NULL
for(i in 1:length(var.x)){
indep <- paste(indep,var.x[i],",")
}
list(
renderText(indep)
)
})
gendata<- eventReactive(input$tabBut,{
if(is.null(input$indepvar)){
stop()
}
var.x<<- input$indepvar
})
output$popup4 <- renderUI({
if(!is.null(input$indepvar))return()
list(
bsModal("modalExample4", "Peringatan", "tabBut", size = "small",wellPanel(
"Anda belum memilih independent variabel..."
))
)
})
}
)
I wouldn't advise suppressing error messages, as there are in there for you, I suggest you look into validate and need in shiny, you can go read validation article
To quickfix you issue you can just return NULL
rm(list = ls())
library(shiny)
library(shinyBS)
var.x<-reactiveValues()
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput("indepvar","Independent Variable",
choices = c("1"=1,"2"=2)),
actionButton("tabBut", "View Table")
),
mainPanel(
uiOutput("coba")
)
)
),
server =
function(input, output, session) {
output$coba <- renderUI({
gendata()
indep<-NULL
for(i in 1:length(var.x)){
indep <- paste(indep,var.x[i],",")
}
list(
renderText(indep)
)
})
gendata<- eventReactive(input$tabBut,{
if(is.null(input$indepvar)){
var.x <<- NULL
return(NULL)
stop()
}
var.x<<- input$indepvar
})
}
)
You need to do two things as per the code below:
Make sure that gendata returns nothing when there are no independent variables selected (see lines 37-40). This stops your original error message
Make sure that output$coba is not evaluated when gendata has no value (see line 25)
Hope this helps,
John
rm(list = ls())
library(shiny)
library(shinyBS)
var.x<-reactiveValues()
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput("indepvar","Independent Variable",
choices = c("1"=1,"2"=2)),
actionButton("tabBut", "View Table")
),
mainPanel(
uiOutput("coba"),
uiOutput("popup4")
)
)
),
server =
function(input, output, session) {
output$coba <- renderUI({
req(gendata())
indep<-NULL
for(i in 1:length(var.x)){
indep <- paste(indep,var.x[i],",")
}
list(
renderText(indep)
)
})
gendata<- eventReactive(input$tabBut,{
if(is.null(input$indepvar)) {
var.x <<- NULL
return()
}
var.x<<- input$indepvar
})
output$popup4 <- renderUI({
if(!is.null(input$indepvar))return()
list(
bsModal("modalExample4", "Peringatan", "tabBut", size = "small",wellPanel(
"Anda belum memilih independent variabel..."
))
)
})
}
)