I want to generate a boxPlus around my DT-Output. Now when I start my APP, the frame of the box is already there. How do I manage that the box is only displayed when the tableoutput is finished? As input I use a text input.
In my UI I use for the Input:
textInput("name", "Insert Number:")
the final box I create with:
uiOutput("box")
On Serverside I do:
output$name <- renderText(input$name)
New_input <- reactive({
list(input$name)
})
and the box I create like this:
output$box <- renderUI({
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
})
I tried it with: Similar Problem but I can not resolve the problem. Without the box everything works fine.
Never use reactive expressions inside a renderText function.
You have to wrap tagList around your two elements to return a SINGLE element (a list in your case).
Here is a reproduceable example.
library(shiny)
library(shinydashboardPlus)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Hide box"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("name", "Insert Number to filter cyl:")
),
mainPanel(
uiOutput("box")
)
)
)
server <- function(input, output) {
resultdf <- reactive({
mtcars %>%
filter(cyl > input$name)
})
output$box <- renderUI({
output$table <- renderDataTable({
resultdf()
})
if(input$name == "") {
return(NULL)
} else {
return(
tagList(
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
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 am trying to render a few outputs in a shiny application that are contained within a shinyjs::hidden section upon the application running rather than once the section is visible.
EDIT: I had the app set up incorrectly in the original example so have changed it.
I want to be able to run the reactive statement before running the final observe to change the UI from the Alpha text to the Beta text and plot. Ideally this would mean in the console would see "Done plotting" before "Observe run".
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id = "before-content", h3("Aux Text Alpha")),
shinyjs::hidden(
div(
id = "after-content",
h1("Aux Text Beta"),
plotOutput("text")
)
)
)
server <- function( session,input, output) {
in_plot <- reactive({
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observe({
print("Observe run")
hide("before-content")
show("after-content")
})
}
shinyApp(ui, server)
An alternative would be to have a layer over what is classed as the hidden section but am not too sure on how that is accomplished.
You can hide it in the reactive, like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("button", "Click me"),
plotOutput("text")
)
server <- function( session,input, output) {
in_plot <- reactive({
hide("text")
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observeEvent(input$button, {
show("text")
})
}
shinyApp(ui, server)
I'm trying to create the scenario whereby using conditionalpanel, I am able to have an user input of checked boxes to display either 1 or 2 plots, one after another.
My reproducible code can be found below, however, I am unable to display the plots.
Could someone please share with me where did I make a mistake?
library(shiny)
ui = fluidPage(
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot1'",
plotOutput("plot1")
),
conditionalPanel(
condition = "input.my_choices == 'Plot2'",
plotOutput("plot2")
),
conditionalPanel(
condition = "input.my_choices.includes('Plot1', 'Plot2')",
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
}
shinyApp(ui, server)
Update:
I've got what I wanted but without using ConditionalPanel function. Here's the code below:
Would appreciate if someone can share with me the proper way of using ConditionalPanel Function! (:
library(shiny)
#data
df <- iris
#ui
ui <- fluidPage(
sidebarPanel(
checkboxGroupInput(inputId = "Question",
label = "Choose the plots",
choices = c("Plot1", "Plot2", "Plot3"),
selected = "")),
mainPanel(
uiOutput('ui_plot')
)
)
#server
server <- function(input, output)
{
# gen plot containers
output$ui_plot <- renderUI({
out <- list()
if (length(input$Question)==0){return(NULL)}
for (i in 1:length(input$Question)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
# render plots
observe({
for (i in 1:3){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
if ( length(input$Question) > ii-1 ){
return(plot(runif(100)))
}
NULL
})
})
}
})
}
shinyApp(ui, server)
I would give you an alternative as you will need to create new plots with different id in order for that to work. The simplest one I can think of is using shinyjs package and its hide and show functions. You can also do this via renderUI but you shouldn't give unnecessary work to your server only if you're showing and hiding the elements
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
server = function(input, output,session) {
# hide plots on start
hide("plot1");hide("plot2")
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
observeEvent(input$my_choices,{
if(is.null(input$my_choices)){
hide("plot1"); hide("plot2")
}
else if(length(input$my_choices) == 1){
if(input$my_choices == "Plot1"){
show("plot1");hide("plot2")
}
if(input$my_choices == "Plot2"){
hide("plot1");show("plot2")
}
}
else{
if(all(c("Plot1","Plot2") %in% input$my_choices)){
show("plot1");show("plot2")
}
}
},ignoreNULL = F)
}
shinyApp(ui, server)
I have a tabbed UI that shows up whenever the user selects rows in a datatable (in the following code, the outputs are random, in real life the calculation is quite involved).
I would like to condition the tabbed UI showing up to the click of a button. Currently every time you select an additional row, it does the calculation all over again for the already selected rows. I would like to limit that to a one-time calculation when the user is done selecting all the rows he wants to see.
library(shiny)
library(DT)
The UI : the table, the action button and the tabbed section.
ui <- fluidPage(
mainPanel(
fluidRow(
column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
),
actionButton(inputId = 'showSelectedButton',label = 'Show Selec'),
fluidRow(
uiOutput("myTabUI")
)
)
)
The server function : If I remove the output$myTabUI <- eventReactive(input$launchCalcButton, { part and instead do output$myTabUI <- renderUI ({ ... directly it works as intended (minus the calculation following click on the button of course).
server <- function(input,output){
output$tableCurrencies <- DT::renderDataTable({datatable(data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10)))})
origTable_selected <- reactive({
ids <- input$tableCurrencies_rows_selected
return(ids)
})
output$myTabUI <- eventReactive(input$launchCalcButton, {
selectedTabs <- renderUI({
myTabs <- lapply(origTable_selected(),function(i) {
tabName <- paste0("test",i)
a <- renderPlot({
hist(rnorm(50))
})
output[[paste0(tabName,"rates")]] <- a
return(tabPanel(
tabName,
fluidRow(
column(6,plotOutput(paste0(tabName,"rates")))
)
))
})
return(do.call(tabsetPanel,myTabs))
})
selectedTabs
})
}
app = shinyApp(ui,server)
runApp(app,port=3250,host='0.0.0.0')
Not sure how to go about fixing this. Any help welcome.
You can use isolate() to limit reactive dependencies
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
fluidRow(
column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
),
actionButton(inputId = 'showSelectedButton',label = 'Show Selec'),
fluidRow(uiOutput("myTabUI"))
)
)
server <- function(input,output){
output$tableCurrencies <- DT::renderDataTable({
data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10))})
origTable_selected <- reactive({
input$tableCurrencies_rows_selected
})
output$myTabUI <- renderUI({
input$showSelectedButton
myTabs <- lapply(isolate(origTable_selected()),function(i) {
tabName <- paste0("test",i)
a <- renderPlot({hist(rnorm(50))})
output[[paste0(tabName,"rates")]] <- a
return(tabPanel(
tabName,
fluidRow(column(6,plotOutput(paste0(tabName,"rates"))))
))
})
do.call(tabsetPanel,myTabs)
})
}
shinyApp(ui,server)
I'm a bit rusty to Shiny reactivity, but I want to do two things when a button is clicked:
add that button label to the sidebar (and add more labels to sidebar after more clicks)
update the button labels (i.e. more random integers)
I'm nervous about changing the label before recording it, so I want to get the timing right. Here's a skeleton of what I'm working with:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("clicks")
),
mainPanel(
uiOutput("button1"),
uiOutput("button2")
))
)
###################
server <- function(input, output, session) {
output$clicks <- renderText({
paste()
})
## reactive values
inside <- reactive({
inside <- sample(1:100,2)
})
## buttons
output$button1 <- renderUI({
actionButton("course1", label = inside()[1], style='padding:50px')
})
output$button2 <- renderUI({
actionButton("course2", label = inside()[2], style='padding:50px')
})
}
shinyApp(ui = ui, server = server)
Right now the sidebar is blank because I'm not sure how to add it, or what to add to make the button labels update after a click (whether to do it inside a reactive value or an observeEvent). Any help is much appreciated!
Here's a way to do it with reactiveValues:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("clicks")
),
mainPanel(
uiOutput("button1"),
uiOutput("button2")
))
)
###################
server <- function(input, output, session) {
# Show history
output$clicks <- renderText({
history[['clicked']]
})
## reactive values
# store history as reactive values
history <- reactiveValues(clicked = c())
# update history when a button is clicked
observeEvent(input$course1,{
history[['clicked']] <- c(history[['clicked']],inside()[1])
})
observeEvent(input$course2,{
history[['clicked']] <- c(history[['clicked']],inside()[2])
})
#update inside when history updates
inside <- reactive({
history[['clicked']]
inside <- sample(1:100,2)
})
## buttons
output$button1 <- renderUI({
actionButton("course1", label = inside()[1], style='padding:50px')
})
output$button2 <- renderUI({
actionButton("course2", label = inside()[2], style='padding:50px')
})
}
shinyApp(ui = ui, server = server)