Update three different inputs based on sum of values R shiny - r

I have four user inputs in my ShinyApp such that:
The first input (total_price) is always present
Optional input for rrsp which allows users to input a value (max 35,000)
Optional input for fthbi which allows users to select a value up to 10%
Other payment for cash which allows user to input a value
In my code, total_input and cash are numericInput, rrsp and fthbi are checkBoxInput + conditionalPanel
total_price is independent of the other three. However, the other other three summed up and can not exceed 20% of total_price i.e. rrsp + fthbi * total_price + cash <= total_price*0.2. How can I achieve this - basically as any of the inputs change, the limits of the remaining inputs (in the order mentioned above) should change as well.
CODE
ui <- fluidPage(
titlePanel(
'My App'
),
sidebarLayout(
sidebarPanel = sidebarPanel(
numericInput(
inputId = 'total_price',
label = 'Total Price',
value = 200000,
min = 200000
),
# Use RRSP for down-payment
checkboxInput(
inputId = 'use_rrsp',
label = 'Use RRSP?',
value = F
),
# If using RRSP, select amount to use
conditionalPanel(
condition = "input.use_rrsp == true",
numericInput(
inputId = 'rrsp', label = 'RRSP Amount?',value = 25000, min = 0, 35000
)
),
# Use first time home buyer incentive?
checkboxInput(
inputId = 'use_fthbi',
label = 'Use FTHBI?',
value = F
),
# If using FTHBI, select % to use
conditionalPanel(
condition = "input.use_fthbi == true",
sliderInput(
inputId = 'fthbi', label = 'FTHBI Percent',
step = 1, min = 0, max = 10, value = 0, post = '%'
)
),
# Cash Downpayment
numericInput(
inputId = 'cash', label = 'Cash Payment', value = 0, min = 0, max = 40000
)
),
mainPanel = mainPanel(
textOutput('main_text')
)
)
)
server <- function(input, output, session){
output$main_text <- renderText({
sprintf('Sample Text')
})
}
shinyApp(ui, server)
I've tried playing around with updateSliderInput and reactiveUI but haven't been successful..
Update
Here's the logic:
by default rrsp and ftbhi are not selected, so cash can be set to 20% of total_price
Once rrsp is selected, it should begin with a default value of 25000. The max. value for rrsp is 35000 which is less than 20% of the min. allowable total_value. If some value for cash is selected that would bring rrsp + cash > total_price, the cash value should be updated such taht the total is 20% max.
Once ftbhi is selected, the default value should be zero (updated code now). The max. value for this should be updated based on the rrsp value (if already selected) else it should be 10%.
cash should get updated as other values are selected, input.

Aou are on the right track in using the update* functions. I am not going to implement the complete logic yet the snippet below should point you in the right direction:
# Basic usage
library("shiny")
library(shinyWidgets)
ui <- fluidPage(
titlePanel(
'My App'
),
sidebarLayout(
sidebarPanel = sidebarPanel(
numericInput(
inputId = 'total_price',
label = 'Total Price',
value = 200000,
min = 200000
),
# Use RRSP for down-payment
checkboxInput(
inputId = 'use_rrsp',
label = 'Use RRSP?',
value = F
),
# If using RRSP, select amount to use
conditionalPanel(
condition = "input.use_rrsp == true",
numericInput(
inputId = 'rrsp', label = 'RRSP Amount?',value = 25000, min = 0, 35000
)
),
# Use first time home buyer incentive?
checkboxInput(
inputId = 'use_fthbi',
label = 'Use FTHBI?',
value = F
),
# If using FTHBI, select % to use
conditionalPanel(
condition = "input.use_fthbi == true",
sliderInput(
inputId = 'fthbi', label = 'FTHBI Percent',
step = 1, min = 0, max = 10, value = 0, post = '%'
)
),
# Cash Downpayment
numericInput(
inputId = 'cash', label = 'Cash Payment', value = 0, min = 0, max = 40000
)
),
mainPanel = mainPanel(
textOutput('main_text')
)
)
)
server <- function(input, output, session){
output$main_text <- renderText({
sprintf('Sample Text')
})
observe({
# check that the input exists, is not null etc. check ?req()
req(input$cash)
if(input$cash > 0)
updateSliderInput(session = session,
inputId = 'fthbi',
max = round(40000 / input$cash))
})
}
shinyApp(ui, server)
Just wrap your update function inside of observe. However, you should be carefull that you do not implement a infinite loop. In this case it is an option to determine each value, safe it in reactiveValues and use these to update your inputs.

Related

Calculations in RShiny

I’m super new to RShiny and I’m trying to create an app that will calculate the total meters players will run during practice. I have a csv file in which I have meters per minute for each drill and I want this app to calculate the total based on the drills selected and the time selected.
And I don’t know how to pull the data from the csv file for the specific drill selected and multiply it by the number of minutes selected.
This is what I have right now but it doesn’t work.
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
numericInput("num", h3("Number of Drills"), value = 1)
),
mainPanel(
selectInput("DrillName",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider11",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
conditionalPanel(
condition = "input.num > '1'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '2'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '3'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '4'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
conditionalPanel(
condition = "input.num > '5'",
selectInput("Drill Name",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0)),
textOutput("MpM1")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$MpM1 <- renderText({
chosendrill <- (input$DrillName)
MpM <- unique.data.frame(MyData$MetersPerMinute)
MpM1 <- (MpM[[chosendrill]]) * (input$slider11)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
I'm not certain of a lot of details of what you are looking for, and I don't have your data set, but I think I was able to come up with a relatively simple update of your app to hopefully show how to make it work. First, I made a test dataset, which I just used mtcars and renamed some columns to match yours. Then I wrote the file, then read it in, so that way I can show how one can read data for a shiny app. Otherwise, if you are looking to have more dynamic read in of data, refer to #r2evans comment on shiny::fileInput, or maybe even a reactiveFileReader.
The next thing I did was update the inputId of many of your inputs, as you used the same name for different inputs. As I expect you want each input to do something different, a different inputId is needed. Additionally, I put a new textOutput for each conditionalPanel, so that each can display their own data. I also added some spacing for visual clarity with br().
For the server side, I changed a couple of things. First, I have never used unique.data.frame, but I have used distinct from dplyr, so I used that instead. Then, I changed your MpM_text, I'm nto really certain what exactly you wanted to happen, but this shows how to use rows that match the input and to use them to multiply against something else. This was then output in a paste0.
I also did a repeat of this for the other 5 drills that were in the conditionalPanel, just as a little show of how you can repeat the calculations with different inputs/outputs. Again, I'm not sure what the precise nature of your program/data, but hopefully this helps to point you in the right direction. If you are posting on stack in the future, I'd suggest making your code as simple as possible that will show whatever error you are seeing, including any necessary data so that the viewers can easily recreate your issue. Best of luck, shiny can be a pain sometimes to figure out, but I've really enjoyed using it over the years and so I hope you have success yourself!
library(shiny)
library(dplyr)
MyData<-mtcars%>% #Since I don't have your dataset, I made my own using mtcars
rename(Drill = cyl, #Renaming column names to match yours
MetersPerMinute = mpg)
write.table(MyData, "Test.csv") #Writing it into a csv so I can demonstrate how to read and use the data from a csv
MyData<-read.table("Test.csv") #reading the csv
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
numericInput("num", h3("Number of Drills"), value = 1)
),
mainPanel(
selectInput("DrillName",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider11",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM1"),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '1'",
selectInput("DrillName1", #name of the select input should differ if expecting to be used separately, changed to `DrillName1`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM2")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '2'",
selectInput("DrillName2", #name of the select input should differ if expecting to be used separately, changed to `DrillName2`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider2", #name of the sliderinput should differ if expecting to be used separately, changed to 2
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM3")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '3'",
selectInput("DrillName3", #name of the select input should differ if expecting to be used separately, changed to `DrillName3`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider3", #name of the sliderinput should differ if expecting to be used separately, changed to 3
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM4")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '4'",
selectInput("DrillName4", #name of the select input should differ if expecting to be used separately, changed to `DrillName4`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider4", #name of the sliderinput should differ if expecting to be used separately, changed to 4
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM5")),
br(), #Spacing for clarity
conditionalPanel(
condition = "input.num > '5'",
selectInput("DrillName5", #name of the select input should differ if expecting to be used separately, changed to `DrillName5`
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider5", #name of the sliderinput should differ if expecting to be used separately, changed to 5
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM6"))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$MpM1 <- renderText({
chosendrill <- (input$DrillName)
# MpM <- unique.data.frame(MyData$MetersPerMinute) #This doesn't work for me. I've never used unique.data.frame though.
# Instead I'll use distinct from dplyr, which is considerably faster, according to dplyr!
MpM <- MyData%>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input$slider11)
#I'm not certain what the data looks like, or what the result you want should look like
# In the mtcars dataset I used for example, it has multiple matches to each cyl, or "Drill", so this will put multiple outputs
paste0("Drill Meters per minute * slider: ", paste0(MpM_text, collapse = " "))
})
lapply(2:6, function(x) { #This is just showing how to repeat the calculations for multiple sliders
output[[paste0("MpM", x)]] <- renderText({
chosendrill <- input[[paste0("DrillName",x-1)]]
MpM <- MyData%>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input[[paste0("slider",x-1)]])
paste0("Drill Meters per minute * slider: ", paste0(MpM_text, collapse = " "))
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

ConditionalPanel does not work as expected

I'm making an app for some tax calculations and want to show a sliderInput based on another user input (input$use_fthbi). Here's my code:
checkboxInput(
inputId = 'use_fthbi',
label = 'Use First-time Home Buyer Incentive?',
value = F
),
conditionalPanel(
condition = "input.use_fthbi == 'true'",
sliderInput(
inputId = 'fthbi',
label = 'FTHBI Percent',
min = 0,
max = 10,
value = 5,
post = '%'
)
)
I expect to see the sliderInput appear only when use_fthbi is selected but it shows up regardless. Checking or unchecking the input has no impact on the UI.
I've tried spelling true as True or even T both with and without quotes around it but with no change to the UI. Following the example here: https://shiny.rstudio.com/articles/dynamic-ui.html
I've seen other similar questions on SO but they either relate to updating something using the server or just deal with typos.
EDIT
It appears to work with radiobuttons:
radioButtons(
inputId = 'use_fthbi',
label = 'Use First-time Home Buyer Incentive?',
choices = c('Yes', 'No'),
selected = 'No',
inline = T
),
conditionalPanel(
condition = "input.use_fthbi == 'Yes'",
sliderInput(
inputId = 'fthbi',
label = 'FTHBI Percent',
min = 0,
max = 10,
value = 5,
post = '%'
)
)
You were close. The trick is to not use any quotes around true:
checkboxInput(
inputId = 'use_fthbi',
label = 'Use First-time Home Buyer Incentive?',
value = F
),
conditionalPanel(
condition = "input.use_fthbi == true",
sliderInput(
inputId = 'fthbi',
label = 'FTHBI Percent',
min = 0,
max = 10,
value = 5,
post = '%'
)
)
This works for me with shiny 1.5.0 and R 4.0.2

R and shiny: How to pass a list of lists (instead of a list of values) in choiceValues in the various input controls of shiny, like the radio buttons

I try to build a small shinyapp with two inputs. The second input should use values from the first input. This works fine if "single" values are passed. In the following examples, the slideinput takes the values from the radio buttons, either 1, 5 or 10 year and then adjusts the sliderinput going back 1, 5, 10 years respectively. So far so.
library(shiny)
library(lubridate)
ui = fluidPage(
titlePanel("Changing the values of inputs"),
fluidRow(
radioButtons("control_num",
"Choose time span:",
choiceNames = list("10 years",
"5 years",
"1 year"),
choiceValues = list(10,
5,
3 ),
inline = T),
sliderInput(inputId = "inSlider2",
label = "timeline:",
min = as.Date("2001-01-01") ,
max = as.Date("2016-12-31"),
value = c(as.Date( "2011-01-01") , as.Date("2013-01-01" ) ),
step = 1,
width = "90%"
)
)
)
server = function(input, output, session) {
observe({
c_num <- as.numeric( input$control_num )
c_num1 <- as.Date("2016-12-31") - years( c_num )
c_num2 <- as.Date("2016-12-31")
# Slider range input
updateSliderInput(session, "inSlider2",
value = c(c_num1 , c_num2) )
})
}
shinyApp(ui = ui, server = server)
However, if I want to pass a list of lists, e.g. several date ranges, say calendar year 2015, 2014 and 2013. Each of these consists of a list of two dates: start date (1st Jan) and end date (31st Dec).
The problems shows up when I try to pass this list of lists in "choiceValues" instead of a list of values.
library(shiny)
library(lubridate)
ui = fluidPage(
titlePanel("Changing the values of inputs from the server"),
fluidRow(
radioButtons("control_num2",
"Choose time span:",
choiceNames = list("2015",
"2014",
"2013"),
choiceValues = list(c(as.Date("2015-01-01" ), as.Date("2015-12-31") ),
c(as.Date("2014-01-01" ), as.Date("2014-12-31") ),
c(as.Date("2013-01-01" ), as.Date("2013-12-31") )
),
inline = T),
sliderInput(inputId = "inSlider2",
label = "timeliner:",
min = as.Date("2001-01-01") ,
max = as.Date("2016-12-31"),
value = c(as.Date( "2011-01-01") , as.Date("2013-01-01" ) ),
step = 1,
width = "90%"
)
)
)
server = function(input, output, session) {
observe({
c_num <- input$control_num2
c_num1 <- as.list(input$control_num2 )
# used to check the structure of the input variable
updateNumericInput(session, "control_num2",
label = paste("Input ", c_num,
"Input as list: ", c_num1,
"First element of list: ", c_num1[1] ),
value = c_num)
# Slider range input
updateSliderInput(session, "inSlider2",
value = c_num )
})
}
shinyApp(ui = ui, server = server)
When the parameters is evaluated in the observe part of the code, the "input$conrol_num" is always taken as a list of character with length of one.
I had some warnings along these lines.
So I guess there is no possiblity to pass a list of lists here. What would be an elegant way to solve the problem?
I don't thinks it's possible to have lists or vectors as values in an input. Try having a unique id string for each value, pass that on to the server, then look up the value in a named list. e.g.
# in UI
radioButtons("control_num2",
"Choose time span:",
choiceNames = c("2015","2014","2013"),
choiceValues = c("year2015", "year2014", "year2015")
inline = T)
# in server
idmap <- list("year2015" = c(as.Date("2015-01-01" ), as.Date("2015-12-31") ),
"year2014" = c(as.Date("2014-01-01" ), as.Date("2014-12-31") ),
"year2013" = c(as.Date("2013-01-01" ), as.Date("2013-12-31") ))
observe({
req(input$control_num2)
c_num <- idmap[[input$control_num2]]
# Slider range input
updateSliderInput(session, "inSlider2",
value = c_num )
})
[edit] sorry, there was a typo in updateSliderInput. Complete working version:
library(shiny)
library(lubridate)
ui = fluidPage(
titlePanel("Changing the values of inputs from the server"),
fluidRow(
radioButtons("control_num2",
"Choose time span:",
choices=c("2015"="year2015", "2014"="year2014", "2013"="year2013"),
inline = T),
sliderInput(inputId = "inSlider2",
label = "timeliner:",
min = as.Date("2001-01-01") ,
max = as.Date("2016-12-31"),
value = c(as.Date( "2011-01-01") , as.Date("2013-01-01" ) ),
step = 1,
width = "90%")))
server = function(input, output, session) {
idmap <- list("year2015" = c(as.Date("2015-01-01" ), as.Date("2015-12-31") ),
"year2014" = c(as.Date("2014-01-01" ), as.Date("2014-12-31") ),
"year2013" = c(as.Date("2013-01-01" ), as.Date("2013-12-31") ))
observe({
req(input$control_num2)
c_num <- idmap[[input$control_num2]]
# Slider range input
updateSliderInput(session, "inSlider2",
value = c_num )
})
}
shinyApp(ui = ui, server = server)

Shiny/R: Outputs not displaying

so I'm trying to make a tax calculation app. In the sidebar I'm using tabsetPanel to display two panels with different inputs relating to the individual and then tax rates.
The mainPanel will also be using tabsetPanel where I plan to plot graphs etc. I have an update button that doesn't seem to be working.
ui.R
Looks like this:
shinyUI(fluidPage(
titlePanel("flatTax"),
sidebarLayout(
sidebarPanel(
h1("Flat Tax Calculator"),
helpText("Input your information below and see how a flat tax could
affect your tax bill."),
#Individual Specific Variables
tabsetPanel(
tabPanel("You",
numericInput(inputId = "incomeNum",
label = "Your annual income:",
value = 0
),
textInput(inputId = "testText",
label = "Test Input"
),
),
tabPanel("Tax Settings",
sliderInput(inputId = "basicIncome",
label = "Choose a monthly basic income",
value = 600, min = 0, max = 1200, step = 50
),
sliderInput(inputId = "taxFree",
label = "Choose a tax free allowance",
value = 10000, min = 0, max = 20000, step = 250
),
sliderInput(inputId = "flatIncomeTax",
label = "Choose a flat tax rate",
value = 50, min = 0, max = 100, step = 1
),
sliderInput(inputId = "flatPropertyTax",
label = "Choose a land value tax rate",
value = 1, min = 0, max = 100, step = 1
)),
# Action Button
actionButton(inputId = "updateButton",
label = "Update"),
plotOutput("text")
)
),
mainPanel(
tabsetPanel(
tabPanel("Summary",
h3("Test Output", textOutput("test"),
h3("Your new income tax bill is:", textOutput("incomeFT")),
h3("Your new property tax bill is:", textOutput("propertyFT")),
textOutput("annualBasicIncome")
)
),
tabPanel("Graphs",
h3("Placeholder"),
h3("Holding the place"),
h3("Plaice holster")
)
)
)
)
))
server.R
Looks like this:
shinyServer(
function(input, output) {
#action button stuff
incomeFT <- eventReactive(input$updateButton, {
((input$incomeNum-input$taxFree)/100*input$flatIncomeTax)
})
output$incomeFT <- renderPrint({
incomeFT()
})
propertyFT <- eventReactive(input$updateButton, {
input$propertyNum/100*input$flatPropertyTax
})
output$propertyFT <- renderPrint({
propertyFT()
})
annualBasicIncome <- eventReactive(input$updateButton, {
switch(as.numeric(input$relStat),
return((input$basicIncome*12)+((input$basicIncome*12)*input$childNum)),
return((2*(input$basicIncome*12))+((input$basicIncome*12)*input$childNum))
)
})
output$annualBasicIncome <- renderPrint({
annualBasicIncome()
})
test <- eventReactive(input$updateButton, {
input$testText
})
output$test <- renderText({
test()
})
})
Without reactivity it seems to work, but the button makes it less distracting to use. I've tried using verbatimTextOutput instead of textOutput but grey bars are sent across the main panel with not outputs in.
Help please?
For some reason, the actionButton does not work inside the tabsetPanel. If you put it outside it (and inside sidebarPanel) it will work. I suggest you try to use one actionButton for each tabPanel. I haven't try it, but I believe it should work. Please, if you try it, let me know the results.
Cheers.

renderUI+lapply: trying to build a better code

I'm building a new Shiny app and I although it works, the code is too extensive and it is not as reactive as I wanted. Right now I have at server.R
dayData <- reactive({...})
pday <- function(data){...}
output$distPlotday <- renderPlot(function() {print(pday(dayData)) })
and at ui.R
plotOutput("distPlotday")
for each variable in
checkboxGroupInput("checkGroup", "Dataset Features:",
choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
But I wish I could do something more fancy like this:
shinyServer(function(input, output, session) {
...
output$sliders <- renderUI({
lapply(input$checkGroup, function(i) {
fluidRow(
column(4,
selectInput(paste0('trans',i), i,
choices = c('linear','quadratic','sine')) ,
conditionalPanel(
condition = "input[[paste0('trans',i)]]== 'sine'",
withMathJax(),
h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
textInput3(paste0('trans',i,'a'), h5('A:'),
value = 10),
textInput3(paste0('trans',i,'b'), h5('C:'),
value = 1),
textInput3(paste0('trans',i,'c'), h5('D:'),
value = 0.1),
helpText("Note: B has already been picked up")
),
plotOutput(paste0('distPlot',i))
))
})
})
...
}))
.
shinyUI(navbarPage("",
tabPanel("Data",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkGroup", label = h5("Dataset Features:"),
choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
),
mainPanel(
numericInput("obs", label = h5("Number of observations to view"), 15, min = 10, max = 20, step = 1),
tableOutput("view")
)
)
),
tabPanel("Variable transformation", uiOutput(outputId = "sliders"))
))
Using lapply and renderUI. But
plotOutput(paste0('distPlot',i))
is not ploting anything, and the
conditionalPanel(condition = "input[[paste0('trans',i)]]== 'sine'",...)
don't show up conditionally, instead it's always there.
Any suggestions? Thanks for the help!
I wasn't sure what you wanted to do with the plotOutput call, since as far as I can tell there wasn't any example code included that linked to it. However, I managed to put together a working example for dynamically showing/hiding the selection boxes and text fields for the sine parameters.
I found it easier to implement by moving the ui generation from the server into the ui. This gets around the problem of conditions being evaluated for input that doesn't exist yet, since on the ui side the functions are just writing html.
An additional benefit is that this way the input fields don't get re-rendered every time the checkbox input changes - this means that their values persist through toggling them on and off, and that enabling or disabling a single variable won't cause the others' values to reset.
The code:
library(shiny)
vars <- c("day","hour","source","service","relevancy",
"tollfree","distance","similarity")
ui <- shinyUI(navbarPage("",
tabPanel("Data",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkGroup", label = h5("Dataset Features:"),
choices = c("day","hour","source","service","relevancy",
"tollfree","distance","similarity"), inline = F,
selected = c("day", "hour","source","service","relevancy",
"tollfree","distance","similarity")
)
),
mainPanel(
numericInput("obs", label = h5("Number of observations to view"),
value = 15, min = 10, max = 20, step = 1),
tableOutput("view")
)
)
),
tabPanel("Variable transformation",
fluidRow(
column(4,
lapply(vars, function(i) {
div(
conditionalPanel(
condition =
# javascript expression to check that the box for
# variable i is checked in the input
paste0("input['checkGroup'].indexOf('", i,"') != -1"),
selectInput(paste0('trans',i), i,
choices = c('linear','quadratic','sine'))
),
conditionalPanel(
condition =
paste0("input['trans", i, "'] == 'sine' ",
" && input['checkGroup'].indexOf('", i,"') != -1"),
withMathJax(),
h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
textInput(paste0('trans',i,'a'), h5('A:'), value = 10),
textInput(paste0('trans',i,'b'), h5('C:'), value = 1),
textInput(paste0('trans',i,'c'), h5('D:'), value = 0.1),
helpText("Note: B has already been picked up")
)
)
})
)
)
)
))
server <- shinyServer(function(input, output, session) {})
shinyApp(ui, server)
PS. For dynamically showing/hiding or enabling/disabling objects, the package shinyjs by Dean Attali (link) has some nice tools that allow you to call basic javascript by using only R syntax.

Resources