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)
Related
How do I make numericInput and selectInput next to each other instead of under each other? It is possible?
Executable code below:
library(shiny)
ui <- fluidPage(
column(4,
wellPanel(
numericInput("weight1", label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
selectInput("maxmin", label = h5("Maximize or Minimize"),choices = list("Maximize " = 1, "Minimize" = 2),
selected = ""))),
hr(),
column(8,
tabsetPanel(tabPanel("table1", DTOutput('table1')))))
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
splitLayout can be used to split the space.
wellPanel(
splitLayout(
numericInput("weight1", label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
selectInput("maxmin", label = h4("Maximize or Minimize"),choices = list("Maximize " = 1, "Minimize" = 2),
selected = "")))
The above code will produce equally sized inputs, but there is an optional argument, cellWidths, that can be used to specify the widths if another ratio is preferred. For example, adding cellWidths = c("40%", "60%") will make weight1 take 40% of the available space and maxmin the rest 60%.
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'm trying to use the menuSubItem functions to organize my inputs since I'll have a lot. What I'm finding though is that the conditional Panel is minimizing the whole menuItem and not expanding them. And what I'm also seeing is that the body doesn't change when I click on different tabs. Am I using conditionalPanels right?
library(needs)
needs(
shiny,
ggplot2,
tidyverse,
shinydashboard,
DT,
shinycssloaders,
plotly
)
# Define UI for application that draws a histogram
header = dashboardHeader(
# tags$li(class = "dropdown",
# tags$style(".main-header {max-height: 80px}"),
# tags$style(".main-header .logo {height: 80px}")),
#title = tags$img(src='logo.png',height='100',width='200')
)
sidebar = dashboardSidebar(
sidebarMenu(
id = 'panelsbar',
style = '"overflow-y:auto; max-height: 600px; position:relative;"',
menuItem('Data Input', tabName = 'data'),
conditionalPanel(
condition = "input.panelsbar== 'data'",
fileInput(
"file",
"Upload CSV files",
multiple = TRUE,
accept = ("text/comma")
)
),
menuItem('Simulate',tabName = 'sim_tab',
helpText('Adjust Simulation Parameters'),
menuSubItem('Promotion Parameters', tabName = 'promo'),
useShinyjs(),
div(id = 'sidebar_promo',
conditionalPanel("input.panelsbar==='promo'",
radioButtons('promoType',label = 'Promotion Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.promoType==="Aggregated"',
sliderInput('promoAll','Set promotion rate:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel('input.promoType==="Role Defined"',
helpText('Set Promotion Rates for each role'),
sliderInput(
'promoRole1','Role 1:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole2','Role 2:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole3','Role 3:', value = 25,min = 0, max = 100, step = 5),
sliderInput(
'promoRole4', 'Role 4:', value = 25, min = 0, max = 100,step = 5)
)
)),
menuSubItem('Candidate Slates', tabName = 'hire'),
div(id='sidebar_hire',
conditionalPanel("input.panelsbar==='hire'",
radioButtons('hireType',label = 'Candidate Slate Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.hireType==="Aggregated"',
sliderInput('hireAll','Set candidate slate rates:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel('input.promoType==="Role Defined"',
helpText('Set the Candidate Slate Diversity'),
h5('0 = Females, 100 = Males'),
sliderInput(
'hireRole1',
'Role 1:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole2',
'Role 2:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole3',
'Role 3:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole4',
'Role 4:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole5',
'Role 5:',
value = 25,
min = 0,
max = 100,
step = 5
)
))),
menuSubItem('Turnover Rates', tabName = 'turnover'),
div(id='sidebar_turnover',
conditionalPanel("input.panelsbar==='turnover'",
radioButtons('turnoverType',label = 'Turnover Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.turnoverType==="Aggregated"',
sliderInput('turnoverAll','Set turnover rate:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel(
"input.turnoverType==='Role Defined'",
helpText('Set the turnover rate for each role'),
sliderInput(
'turnoverRole1',
'Role 1:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole2',
'Role 2:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole3',
'Role 3:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole4',
'Role 4:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole5',
'Role 5:',
value = 25,
min = 0,
max = 100,
step = 5
)
))
)),
actionButton('go','Run')
))
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'data',
wellPanel(DT::dataTableOutput('table'))),
tabItem(
tabName = 'sim_tab',
fluidRow(h2('Average of Distribution',align = 'center')),
fluidRow(h5('Below is a table of the average distribution from the simulation',align='center')),
fluidRow(
wellPanel(
DT:::dataTableOutput('simDataTable') %>%
withSpinner(color="#ee1100")
),
fluidRow(h2('Average of Distribution',align = 'center')),
fluidRow(
wellPanel(
plotlyOutput('simPlot')
)
))
)
))
ui = shinydashboard::dashboardPage(header, sidebar, body, skin = 'red',
tags$head(tags$style(
HTML(".sidebar {
height: 90vh; overflow-y: auto;
}")
)))
There is no need to use conditionalPanel for the initial menuItem. You can try this...
shinydashboard::dashboardSidebar(width=300,
useShinyjs(),
sidebarMenu(id = "panelsbar",
#style = '"overflow-y:auto; max-height: 600px; position:relative;"',
menuItem("Home", tabName = "home", icon = icon("home")),
menuItem('Data Input', # tabName = 'data1' ,
#conditionalPanel( condition = "input.panelsbar== 'data'",
menuSubItem(
fileInput(
"file",
"Upload CSV files",
multiple = TRUE,
accept = ("text/comma")
),tabName = 'data' )
),
menuItem("Simulate", tabName = 'sim_tab',
helpText('Adjust Simulation Parameters'),
menuItem("Promotion Parameters", tabName = 'promo' ,
# div(id = 'sidebar_promo',
# conditionalPanel("input.panelsbar==='promo'",
radioButtons('promoType', label = 'Promotion Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.promoType==="Aggregated"',
sliderInput('promoAll','Set promotion rate:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel('input.promoType==="Role Defined"',
helpText('Set Promotion Rates for each role'),
sliderInput(
'promoRole1','Role 1:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole2','Role 2:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole3','Role 3:', value = 25,min = 0, max = 100, step = 5),
sliderInput(
'promoRole4', 'Role 4:', value = 25, min = 0, max = 100,step = 5)
)
#)
#),
), ## new line
menuItem('Candidate Slates', tabName = 'hire'),
...
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)
Within shiny how would I go about updating values within a DT table without it repainting the entire table and thus flickering on each update.
The following example compares both the standard tableOutput with DT::dataTableOutput.
Note the flickering on each update of dataTableOutput.
Is there away to avoid this and have a smoother user interaction? ui.R and server.R example below.
require(shiny);require(DT)
shinyUI(fluidPage(
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput(
"integer", "Integer:",
min = 0, max = 1000, value = 500
),
sliderInput(
"decimal", "Decimal:",
min = 0, max = 1, value = 0.5, step = 0.1
),
sliderInput(
"range", "Range:",
min = 1, max = 1000, value = c(200,500)
),
sliderInput(
"format", "Custom Format:",
min = 0, max = 10000, value = 0, step = 2500,
pre = "$", sep = ",", animate = TRUE
),
sliderInput(
"animation", "Looping Animation:", 1, 2000, 1,
step = 10, animate =
animationOptions(
interval = 300, loop = TRUE,
playButton = "PLAY", pauseButton = "PAUSE"
)
)
),
mainPanel(tableOutput("values"),
DT::dataTableOutput('DTtable'))
)
))
shinyServer(function(input, output) {
sliderValues <- reactive({
data.frame(
Name = c("Integer",
"Decimal",
"Range",
"Custom Format",
"Animation"),
Value = as.character(
c(
input$integer,
input$decimal,
paste(input$range, collapse = ' '),
input$format,
input$animation
)
),
stringsAsFactors = FALSE
)
})
output$values <- renderTable({
sliderValues()
})
output$DTtable = DT::renderDataTable(rownames = FALSE,
{
sliderValues()
},
options = list(processing = FALSE))
})
It looks like the ideal solution would be to implement the reload functionality:
https://datatables.net/reference/api/ajax.reload()
Any advice on how to do this?