I'm doing some tests with shinyapp.
Does anyone know any way to update the labels of all the sliders with the value of a "text input" without having to use the function "updateSliderInput" for each of them?
Pd: I paste a sample but it really would be 100 sliders
A greeting and thanks in advance
ui <- fluidPage(
fluidRow(
textInput("caption", "Const1", "strong"),
box(width = 3, title = "box1",
solidHeader = TRUE, status = "danger",
# Sd slider:
sliderInput(inputId = "c11",
label = "Con1",
value = 5, min = 1, max = 5),
sliderInput(inputId = "c12",
label = "Con2",
value = 3, min = 1, max = 5,step = 1),
sliderInput(inputId = "c13",
label = "Con3",
value = 4, min = 1, max = 5),
sliderInput(inputId = "c14",
label = "Con4",
value = 3, min = 1, max = 5),
sliderInput(inputId = "c15",
label = "Con5",
value = 2, min = 1, max = 5)
),
box(width = 3, title = "box2",
solidHeader = TRUE, status = "danger",
# Sd slider:
sliderInput(inputId = "c21",
label = "Con1",
value = 2, min = 1, max = 5),
sliderInput(inputId = "c22",
label = "Con2",
value = 3, min = 1, max = 5,step = 1),
sliderInput(inputId = "c23",
label = "Con3",
value = 2, min = 1, max = 5),
sliderInput(inputId = "c24",
label = "Con4",
value = 4, min = 1, max = 5),
sliderInput(inputId = "c25",
label = "Con5",
value = 4, min = 1, max = 5)
)
)
)
# Define server logic required to draw
server <- function(input, output, session) {
observe({
text <- input$caption
updateSliderInput(session, "c11", label =text, value = 3 )
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I'm currently building an application in R-Shiny and having troubles with the location of the graph since I've added tabs to the application. I want to move the graph from the first tab from below the inputs to the right of them. I'm currently getting the following message from R.
bootstrapPage(position =) is deprecated as of shiny 0.10.2.2. The 'position' argument is no longer used with the latest version of Bootstrap. Error in tabsetPanel(position = "right", tabPanel("Drawdown Plot", plotOutput("line"), : argument is missing, with no default
Any help would be greatly appreciated! Code is below
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(position = "right",
tabPanel("Drawdown Plot", plotOutput("line"),
p("This drawdown calculator calculates a potential drawdown outcome")),
tabPanel ("Breakdown of Drawdown Withdrawals",
tableOutput("View")),
))
)
Try this code -
library(shiny)
library(bslib)
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(
tabPanel("Drawdown Plot",
p("This drawdown calculator calculates a potential drawdown outcome"),
tableOutput("View")),
tabPanel("Breakdown of Drawdown Withdrawals",
plotOutput("line"))
))
)
server <- function(input, output) {}
shinyApp(ui, server)
I'm trying show the TableOuput first, according to the user inputs, there are: "media" and "desv_pad". When I click on the button "rodar", the table is showed. After that, I need to delete the output Table "saida" when a press the actionButton "reset", then my interface will be clean to receive new inputs and run again, but my code isn't working.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
numericInput(inputId = "media",
label = "Mean:",
value = 0,
min = 0),
numericInput(inputId = "desv_pad",
label = "Standard Deviation:",
value = 1,
min = 0),
numericInput(inputId = "delta",
label = "Mean Shift:",
value = 0.5,
min = 0,
max = 2,
step = 0.25),
numericInput(inputId = "n",
label = "Size of Samples:",
value = 5,
min = 0,
max = 10,
step = 1),
numericInput(inputId = "alfa",
label = "% alpha",
value = 0.27,
min = 0,
step = 0.1),
numericInput(inputId = "beta",
label = "% beta:",
value = 97,
min = 0,
step = 0.1),
numericInput(inputId = "xb_teo",
label = "%X max:",
value = 10,
min = 0),
actionButton("rodar", "Run")
),
mainPanel(
tags$h4( tableOutput('saida')),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
actionButton("reset", "Reset")
)
)
)
server <- function(input, output)
{
v <- reactiveValues(data = NULL)
observeEvent(input$rodar,{
output$saida <- renderTable({ #resultado,
passo_n <- 0
#Recebendo os inputs:
n <-input$n
Xb_teo <- input$xb_teo# input Xbarra percentual teorico definido pelo usuario
med<- input$media #input da media
desv_pad <- input$desv_pad #input do desvio padrao
alfa <- input$alfa #% determinado pelo usuario
beta <- input$beta #% determinado pelo usuario
delta <- input$delta
v$data <- c(n, Xb_teo,med, desv_pad, alfa, beta, delta)
})
})
observeEvent(input$reset, {
v$data <- NULL
})
output$saida <- renderTable({
if(is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
There are lot of undefined variables in your code. I have replaced them with constants for now.
Put output$saida outside observeEvent. Try this app :
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
numericInput(inputId = "media",
label = "Mean:",
value = 0,
min = 0),
numericInput(inputId = "desv_pad",
label = "Standard Deviation:",
value = 1,
min = 0),
numericInput(inputId = "delta",
label = "Mean Shift:",
value = 0.5,
min = 0,
max = 2,
step = 0.25),
numericInput(inputId = "n",
label = "Size of Samples:",
value = 5,
min = 0,
max = 10,
step = 1),
numericInput(inputId = "alfa",
label = "% alpha",
value = 0.27,
min = 0,
step = 0.1),
numericInput(inputId = "beta",
label = "% beta:",
value = 97,
min = 0,
step = 0.1),
numericInput(inputId = "xb_teo",
label = "%X max:",
value = 10,
min = 0),
actionButton("rodar", "Run")
),
mainPanel(
tags$h4( tableOutput('saida')),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
actionButton("reset", "Reset")
)
)
)
server <- function(input, output)
{
v <- reactiveValues(data = NULL)
observeEvent(input$rodar,{
passo_n <- 0
#Recebendo os inputs:
n <-input$n
Xb_teo <- input$xb_teo# input Xbarra percentual teorico definido pelo usuario
med<- input$media #input da media
desv_pad <- input$desv_pad #input do desvio padrao
alfa <- input$alfa #% determinado pelo usuario
beta <- input$beta #% determinado pelo usuario
delta <- input$delta
v$data <- c(n, Xb_teo,med, desv_pad, alfa, beta, delta)
})
observeEvent(input$reset, {
v$data <- NULL
})
output$saida <- renderTable({
v$data
})
}
shinyApp(ui = ui, server = server)
I have a simple app as shown below. How can I modify the fluidRow statement to include a blank space between A1 and C1 so that all selectors align properly? In this instance, I do not want a 'B1' selector at all.
library(shiny)
inputs <- c("A0", "B0", "C0")
ui <- fluidPage(
fluidRow(column(width = 2, inputs %>% map(~numericInput(.x, .x, min = 1, max = 10, value = 3))),
column(width = 2, numericInput("A1", "A1", min = 1, max = 10, value = 3),
numericInput("C1", "C1", min = 1, max = 10, value = 3)))
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
For this particular case, something like the following works
library(shiny)
library(magrittr)
library(purrr)
inputs <- c("A0", "B0", "C0")
ui <- fluidPage(
fluidRow(column(width = 2, inputs %>% map(~numericInput(.x, .x, min = 1, max = 10, value = 3))),
column(width = 2,
numericInput("A1", "A1", min = 1, max = 10, value = 3),
div(style = "height:73.5px"),
numericInput("C1", "C1", min = 1, max = 10, value = 3))
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
You can modify the height of the div if you want.
However, in my opinion, a better approach is to use a row wise approach to insert the inputs. Something like the following
fluidRow(
column(2, numericInput("A0", "A0", min = 1, max = 10, value = 3)),
column(2, numericInput("A1", "A1", min = 1, max = 10, value = 3))
),
fluidRow(
column(2, numericInput("B0", "B0", min = 1, max = 10, value = 3))
),
fluidRow(
column(2, numericInput("C0", "C0", min = 1, max = 10, value = 3)),
column(2, numericInput("C1", "C1", min = 1, max = 10, value = 3))
)
but as you can see it is not compatible with the map() function as being used now.
I am building a shinydashboard app, and I want to get one box within two rows (see image below).
https://imgur.com/ilNn11M
I tried to mix column and rows, but i didn't manage du get this result.
Here is my ui test :
fluidRow(
box(
width = 3,
title = "Analyses",
dataTableOutput("ind_ana") %>% withSpinner(type = getOption("spinner.type", default = 6))
),
box(
width = 3,
title = "Limites de quantification",
dataTableOutput("ind_lq") %>% withSpinner(type = getOption("spinner.type", default = 6))
),
box(width = 3,
title = "Valeurs de références",
dataTableOutput("tabFnade")
),
box(width = 3,
title = "Seuils",
splitLayout(
numericInput("seuil1", NULL, value = 0, min = 0, max =0),
colourInput("col1", NULL, "blue")
),
splitLayout(
numericInput("seuil2", NULL, value = 0, min = 0, max =0),
colourInput("col2", NULL, "green")
),
splitLayout(
numericInput("seuil3", NULL, value = 0, min = 0, max =0),
colourInput("col3", NULL, "yellow")
),
splitLayout(
numericInput("seuil4", NULL, value = 0, min = 0, max =0),
colourInput("col4", NULL, "orange")
),
splitLayout(
numericInput("seuil5", NULL, value = 0, min = 0, max =0),
colourInput("col5", NULL, "red")
),
splitLayout(
numericInput("seuil6", NULL, value = 0, min = 0, max =0),
colourInput("col6", NULL, "brown")
)
)
Can I make this with shinydashboard, maybe with css ?
I manage to do it with shiny dashboard using two big box slided into 3 columns :
fluidRow(
column(width = 9,
box(
title = "Tab1", width = NULL, height = "200px",
column(width = 4, "Tab1"),
column(width = 4, "Tab2"),
column(width = 4, "Tab3")
),
box(
title = "Tab4", width = NULL, height = "200px"
)
),
column(width = 3,
box(
title = "Tab5", width = NULL, height = "400px"
)
)
)
I am using the 'Add-on package for using the Gridster library with Shiny', (https://github.com/wch/shiny-gridster), which is downloadable by using the below:
devtools::install_github("wch/shiny-gridster")
But I would like the size of the gridster items to be able to vary with the a slider in the sidebar.
Any help would be much appreciated.
One other question I have is how do I adjust the css for the gridsterItems so that they have all a different background, e.g. a blue background.
My ui.R and server.R can be seen below, but the gridster items do not seem to change in size in line with the slider.
First my ui.R file
# ui.R
library(shinyGridster)
library(shinydashboard)
dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput("n1", "gridster_box_size:", min = 50, max = 500, value = 300)
),
dashboardBody(
uiOutput('gg')
)
)
and my server.R file
# sever.R
library(shinyGridster)
shinyServer(function(input, output, session) {
output$myPlot <- renderPlot({plot(1:5)})
output$myText <- renderText(({'hello test text'}))
output$gg <- renderUI({
gridster(width = input$n1, height = input$n1,
gridsterItem(col = 1, row = 1, sizex = 1, sizey = 1,
sliderInput("n", "Input value:", min = 0, max = 50, value = 10)
),
gridsterItem(col = 2, row = 1, sizex = 1, sizey = 1,
textOutput("myText")
),
gridsterItem(col = 1, row = 2, sizex = 2, sizey = 1,
plotOutput("myPlot", height = 200)
)
)
})
}
)
A working version of gridster looks like the below for ui.R :
# ui.R
library(shinyGridster)
library(shinydashboard)
dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput("n1", "gridster_box_size:", min = 50, max = 500, value = 300)
),
dashboardBody(
gridster(width = 300, height = 300,
gridsterItem(col = 1, row = 1, sizex = 1, sizey = 1,
sliderInput("n", "Input value:", min = 0, max = 50, value = 10)
),
gridsterItem(col = 2, row = 1, sizex = 1, sizey = 1,
textOutput("myText")
),
gridsterItem(col = 1, row = 2, sizex = 2, sizey = 1,
plotOutput("myPlot", height = 200)
)
)
)
)
with its complementary server.R
# sever.R
library(shinyGridster)
shinyServer(function(input, output, session) {
output$myPlot <- renderPlot({plot(1:5)})
output$myText <- renderText(({'hello test text'}))
}
)