I am executing a shiny application where there is while loop inside Modal funtion. Refer below. So the expected output after clicking a button should be a pop up with 4 rows (A, B,C, D). So basically when the col_name change so as to number of rows in modal box. In this case there should be 4 rows since we have only (A, B, C, D)
library(shiny)
ui <- fluidPage(
actionButton("show","show")
)
shinyApp(ui, server = function(input, output) {
col_name <- c("A","B","C","D")
i <- 1
observeEvent(input$show,
showModal(
modalDialog(
title = "Edit",
while (i < length(col_name)) {
print(i)
fluidRow(
column(width = 4,
col_name[i]
i = i + 1
)
)
}
)))
})
Expected output after clicking a button
Here's a solution that works, if you have to do it while loop for some reason
library(shiny)
ui <- fluidPage(
actionButton("show","show")
)
server = function(input, output) {
col_name <- c("A","B","C","D")
observeEvent(input$show,{
text <- ""
i <- 1
while (i <= length(col_name)) {
print(i)
text <- paste(text,col_name[i],"<br/>")
i = i+1
}
text <- HTML(text)
showModal(modalDialog(
title = "Edit",
text
))
})
}
shinyApp(ui,server)
But, if you don't need the while loop, here's a cleaner solution.
library(shiny)
ui <- fluidPage(
actionButton("show","show")
)
server = function(input, output) {
col_name <- c("A","B","C","D")
observeEvent(input$show,{
showModal(modalDialog(
title = "Edit",
HTML(paste(col_name, collapse = "<br/>"))
))
})
}
shinyApp(ui,server)
Related
Here's an example:
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
tabPanel(
"tab 2",
actionButton(ns("change_dataset"), "change dataset")
)
}
mod_server <- function(input, output, session){
data <- reactive({ mtcars })
observeEvent(input$change_dataset, {
data <- reactive({ iris })
# Comment the line above and uncomment the
# one below to check that this button works:
# print("button works")
})
return(
list(
data_1 = data
)
)
}
ui <- navbarPage(
title = "",
id = "a_navbar",
tabPanel(
"tab 1",
dataTableOutput("data_test")
),
mod_ui("tab_2")
)
server <- function(input, output, session) {
mod_return <- callModule(mod_server, "tab_2")
output$data_test <- renderDataTable({
mod_return$data_1()
})
}
shinyApp(ui, server)
Basically, this app displays the mtcars dataset in tab 1, and it should display the iris dataset if the user clicks on the button "change dataset" in tab 2. But clicking on this button does not update the table. Why is this the case? How can I fix it?
You should avoid nesting reactives in observers.
You can use eventReactive instead. Please check the following:
library(shiny)
library(DT)
mod_ui <- function(id) {
ns <- NS(id)
tabPanel("tab 2",
actionButton(ns("change_dataset"), "change dataset"))
}
mod_server <- function(input, output, session) {
data <- eventReactive(input$change_dataset, {
if (input$change_dataset %% 2) {
iris
} else {
mtcars
}
}, ignoreNULL = FALSE)
return(list(data_1 = data))
}
ui <- navbarPage(
title = "",
id = "a_navbar",
tabPanel("tab 1",
DT::dataTableOutput("data_test")),
mod_ui("tab_2")
)
server <- function(input, output, session) {
mod_return <- callModule(mod_server, "tab_2")
output$data_test <- DT::renderDataTable({
mod_return$data_1()
})
}
shinyApp(ui, server)
Another approach would be to set a reactiveVal in the observeEvent.
I want to dynamically populate a table and update a list of items selected using the checkbox.
Here is my attempt. I report some random data points into a table and uncheck some of them expecting the list at the bottom of the plot to change.
The list is correctly updated only when unchecking the last item but not the others.
Any suggestions?
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(
column(4,
plotOutput("plot1", click = "plot_click"),
textInput("collection_txt",label="Foo")),
column(4,
DT::dataTableOutput("table"))
)
)
server <- function(input, output,session) {
# collect data points
x <- reactiveValues(selected = '')
y <- reactiveValues(selected = '')
observeEvent(input$plot_click, {
x$x <- c(x$x,input$plot_click$x)
y$y <- c(y$y,input$plot_click$y)
})
output$plot1 <- renderPlot({
plot(1,1, type='n')
points(x$x,y$y)
})
# populate the table
shinyInput <- function(FUN,id,num,...) {
inputs <- character(num)
for (i in seq_len(num)) {
inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
}
inputs
}
output$table = DT::renderDataTable({
tab <- data.frame('x'=x$x ,'y'=y$y)
DT::datatable(cbind(tab, Selected=shinyInput(checkboxInput,"srows_",nrow(tab),value=TRUE,width=1)),
options = list(orderClasses = TRUE,
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}'),
dom = 't', searching=FALSE),
selection='none',escape=F)
})
# show the list of selected items
rowSelect <- reactive({
rows=names(input)[grepl(pattern = "srows_",names(input))]
paste(unlist(lapply(rows,function(i){
if(input[[i]]==T){
return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
}
})))
})
observe({
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Selected:" )
})
}
shinyApp(ui, server)
You have to unbind the previously created Shiny objects before creating the new table, when you click on a point. For example with shinyjs:
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
......
observeEvent(input$plot_click, {
runjs("Shiny.unbindAll($('#table').find('table').DataTable().table().node());")
x$x <- c(x$x,input$plot_click$x)
y$y <- c(y$y,input$plot_click$y)
})
i want to render the elements of each list to a valuebox.
i am able to show the element of single list like below example (run the code for ex) but not nested list.
what i want is to have valuebox which consist of elements of all list.
Please run the code to get the idea.Thankyou
#this should be the result:
1stvaluebox 2ndvaluebox 3rdvaluebox 4thvaluebox
A C E H
Kim John Satish Kevin
1 2 3 4
#Data and code
list_data <- list(letters = c("A","C","E","H"),names = c("Kim","John","Satish","Kevin"),numbers = 1:4)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_entities")
)
)
)
)
)
)
)
server <- function(input, output) {
output$nlp_entities <- renderUI({
a <- lapply(list_data[[1]], function(x) {
valueBox(x,"names")
})
tagList(a)
})
}
shinyApp(ui = ui, server = server)
You can iterate from 1 to the length of sub-list and with each iteration extract wanted information.
server <- function(input, output) {
output$nlp_entities <- renderUI({
a <- list()
for(i in seq_len(lengths(list_data)[1])) {
a[[i]] <- valueBox(lapply(list_data[c(1, 3)], "[[", i),
list_data[[2]][i])
}
tagList(a)
})
}
I want to have a set of two action buttons in Shiny where the inputID and number of duplicates is based off the number of rows in a data.frame. Attached below is my thought process that isn't currently functioning correct. Instead of adding a button whenever a button is pressed, I want "n" sets of buttons equal to the number of rows in a data.frame.
library(shiny)
ui <- basicPage(
fluidRow(
actionButton(inputId = "add_button",
label = "Add Button")
),
uiOutput("more_buttons")
)
server <- function(input, output){
rvs <- reactiveValues(buttons = list(actionButton(inputId = "button1",
label = 1)))
observeEvent(eventExpr = input$add_button,
handlerExpr = {
len <- length(rvs$buttons) + 1
rvs$buttons[[len]] <- actionButton(inputId = paste0("button",len),
label = len)
})
output$more_buttons <- renderUI({
do.call(fluidRow, rvs$buttons)
})
observeEvent(rvs$buttons,{
for(ii in 1:length(rvs$buttons)){
local({
i <- ii
observeEvent(eventExpr = input[[paste0("button",i)]],
handlerExpr = {print(sprintf("You clicked btn number %d",i))})
})
}
})
}
shinyApp(ui, server)
Here is a simplified version of what you want to accomplish
ui <- fluidPage(
selectInput("df", "choose a dataframe",
c("mtcars", "mpg")),
uiOutput("buttons")
)
server = function(input, output, session){
reactiveFrame = reactive({
if(input$df == "mtcars")
return(mtcars)
return(ggplot2::mpg)
})
nrowR = reactive({
nrow(reactiveFrame())
})
m <- 0
output$buttons = renderUI({
m <- m+1
do.call(
fluidPage,
lapply(
1:nrowR(),
function(i)
span(
actionButton(paste0("a", i, "-", m),paste0("a", i)),
actionButton(paste0("b", i, "-", m),paste0("b", i))
)
)
)
})
}
shinyApp(ui,server)
I'm trying to use lapply to create multiple tabs in a tabsetPanel in Shiny based on this example: http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html. Below is my app.R code. When I run it, it doesn't create 5 tabs, nor does it print the name of each tab. What am I doing wrong?
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
tabsetPanel(id='t',
lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})
)
)
)
server <- function(input, output) {
observe({
print(input$t)
})
lapply(1:5, function(j) {
output[[paste0('a',j)]] <- renderPrint({
input$t
})
})
}
shinyApp(ui, server)
It's a bit tricky, because tabsetPanel does not accept a list of tabset as an argument. You can use do.call to "unlist" arguments:
mainPanel(
do.call(tabsetPanel, c(id='t',lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})))
)
stack.app <- function(n = 5){
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(
verbatimTextOutput("show_selected")
),
mainPanel(
uiOutput('my_tabs')
)
)
server <- function(input, output, session) {
output$my_tabs <- renderUI({
### Had to hicjack this from shiny to get it to work...
shiny:::buildTabset(
id = "t",
lapply(1:n, function(i){
tabPanel(title = sprintf("tt_%s",i),
HTML(sprintf("This is tab %s content", i))
)
}), paste0("nav nav-","tabs")) %>% (function(x){
tags$div(class = "tabbable", x[[1]], x[[2]])
})
})
output$show_selected <- renderPrint({
sprintf("SELECTED TAB IS : %s", input$t)
})
}
shinyApp(ui, server)
}
Which results in: