R Shiny - Reactive selectInput data frame column - r
I have got a dashboard that pulls data from Google analytics or a CSV upload and then calculate conversion rate and average order value(for AB testing purpose).
I have been trying to implement filters that allow selecting device category e.g (mobile, tablet or desktop) and product category e.g(card, gift or flowers). The filters should pulled from from the data frame dynamically and then be available for selection in the drop downs.
I have seen a lot of similar example of this forum but for the life of me I haven't been able to make it work. The cases I have seen seem to be using observe ({}) but my issue seem to be coming from the fact that I need to pass the choices out of the reactive function first.
Below is a reproducible, simplified example, with data frame generated as they would appear.
I have commented out #choices= Results()$Devices in the UI so to show you how it looks like before it breaks.
Many thanks in advance
G
require(shiny)
require(shinydashboard)
require(googleVis)
require(dplyr)
ui <- dashboardPage(
skin="blue",
dashboardHeader(
title="Dashboard",
titleWidth = 250
),
dashboardSidebar(
sidebarMenu(
menuItem("Calculator ", tabName = "calculator", icon = icon("calculator"))
)
),
#
dashboardBody(
tabItems(
tabItem(tabName = "calculator",
h1("Calculator"),
fluidRow(
column(width = 1,
selectInput("device","Device:",
#choices= Results()$Devices,
multiple=TRUE, selectize=TRUE)
),
column(width = 1,
selectInput("product","Product:",
#"choices= Results()$Products",
multiple=TRUE, selectize=TRUE)
)
),
fluidRow(
column(width = 6,
box(title="Overall Conversion rate %",status="primary",solidHeader = TRUE,
htmlOutput("CRABCalcl"),width = "100%",height=275)
),
column(width = 6,
box(title="Overall AOV £",status="primary",solidHeader = TRUE,
htmlOutput("AOVABCalcl"),width = "100%",height=275)
)
),
fluidRow(
column(width = 6,
box(title="Ecommerce Conversion rate %",status="primary",solidHeader = TRUE,
htmlOutput("CRABCalclEHC"),width = "100%",height=275)
),
column(width = 6,
box(title="Ecoomerce AOV £",status="primary",solidHeader = TRUE,
htmlOutput("AOVABCalclEHC"),width = "100%",height=275)
)
)
)
)#End of tab Item
) #end of tabItems
)#End of Dashboard body
)#End of dashboardPage
server <- function(input, output,session) {
Results <- reactive({
myDataRAW<-data.frame(
c("mobile","mobile","desktop","desktop","tablet","tablet"),
c("Control","Challenger","Control","Challenger","Control","Challenger"),
c(34355,34917,28577,29534,15337,13854),
c(15011,15427,32190,32548,40299,40858),
c(14636,14990,19609,19702,7214,7785),
c(123273.70,20936.92,45179.05,46359.91,65765.27,92771.36),
c(10370,13403,19241,26965,4468,8796)
)
myDataRAWEHC<-data.frame(
c("desktop","desktop","mobile","mobile","tablet","tablet","desktop","desktop","mobile","mobile","desktop","desktop","mobile","mobile","tablet","tablet","tablet","tablet","desktop","desktop"),
c("Card","Card","Card","Card","Card","Card","Card","Card","Gift","Gift","Gift","Card","Card","Card","Card","Card","Card","Card","Flower","Flower"),
c("Standard","Standard","Standard","Standard","Standard","Standard","Large","Large","Large","Large","Square","Square","Square","Square","Large","Large","Square","Square","Flowers","Flowers"),
c("Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger"),
c(8767,18072,5729,13017,2908,7086,1655,2971,1008,2177,984,2369,599,1422,449,1052,402,1001,233,355),
c(9055,18624,5908,13302,3015,7288,1691,3000,1013,2192,1009,2455,623,1450,455,1068,413,1017,233,356),
c(21699.60,44480.95,14464.85,32590.30,7232.47,17483.35,8309.85,14684.68,5024.92,10844.67,2405.07,5826.83,1529.16,3556.38,2220.21,5192.92,992.14,2447.78,5196.08,8021.95)
)
names(myDataRAW)<-c("Device.Category","Segment","Users","Sessions","Transactions","Revenue","Quantity")
names(myDataRAWEHC)<-c("Device.Category","Product.Category..Enhanced.Ecommerce.","Product.Variant","Segment","Unique.Purchases","Quantity","Product.Revenue")
Devices<-myDataRAW$Device.Category
Products<-unique(myDataRAWEHC$Product.Category..Enhanced.Ecommerce.)
# DeviceFilter<-input$device
# ProductFilter<-input$product
#the below is replacing the above input to act as filters
DeviceFilter<-c("desktop","mobile")
ProductFilter<-c("Flower","Gift")
myData<-myDataRAW %>% filter(Device.Category %in% DeviceFilter)
myDataEHC<-myDataRAWEHC %>% filter(Device.Category %in% DeviceFilter) %>% filter(`Product.Category..Enhanced.Ecommerce.` %in% ProductFilter)
myData<-bind_rows(myData,myData %>% group_by(Device.Category="All",Segment) %>% summarise(Users=sum(Users),Sessions=sum(Sessions),Transactions=sum(Transactions),Revenue=sum(Revenue),Quantity=sum(Quantity)))
myDataEHC<-rbind(myDataEHC %>% group_by(Device.Category,Segment) %>% summarise(Transactions=sum(Unique.Purchases),Quantity=sum(Quantity),Revenue=sum(Product.Revenue)),
myDataEHC %>% group_by(Device.Category="All",Segment) %>% summarise(Transactions=sum(Unique.Purchases),Quantity=sum(Quantity),Revenue=sum(Product.Revenue)) )
myDataEHC<-left_join(myDataEHC,myData %>% select(Segment,Device.Category,Users,Sessions))
myData$Analysis<-"Overall"
myDataEHC$Analysis<-"Ecommerce"
myDataForAnalysis<-rbind(as.data.frame(myData),as.data.frame(myDataEHC))
myDataForAnalysis$CVR<-myDataForAnalysis$Transactions/myDataForAnalysis$Sessions
myDataForAnalysis$AOV<-myDataForAnalysis$Revenue/myDataForAnalysis$Transactions
DisplayResultsEHC<-myDataForAnalysis %>% filter(Analysis %in% "Ecommerce")
DisplayResults<-myDataForAnalysis %>% filter(Analysis %in% "Overall")
list(DisplayResultsEHC=DisplayResultsEHC,DisplayResults=DisplayResults,Devices=Devices,Products=Products)
})
output$CRABCalcl <- renderGvis({
DataABCalcl<-Results()$DisplayResults
F<-cast(DataABCalcl, Device.Category~Segment, value = 'CVR')
X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))
})
output$AOVABCalcl <- renderGvis({
DataABCalcl<-Results()$DisplayResults
F<-cast(DataABCalcl, Device.Category~Segment, value = 'AOV')
X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))
})
output$CRABCalclEHC <- renderGvis({
DataABCalcl<-Results()$DisplayResultsEHC
F<-cast(DataABCalcl, Device.Category~Segment, value = 'CVR')
X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))
})
output$AOVABCalclEHC <- renderGvis({
DataABCalcl<-Results()$DisplayResultsEHC
F<-cast(DataABCalcl, Device.Category~Segment, value = 'AOV')
X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))
})
}
shinyApp(ui, server)
From what I see a good start would be to create a global.R file containing (and remove from server.R):
global.R
myDataRAW<-data.frame(
c("mobile","mobile","desktop","desktop","tablet","tablet"),
c("Control","Challenger","Control","Challenger","Control","Challenger"),
c(34355,34917,28577,29534,15337,13854),
c(15011,15427,32190,32548,40299,40858),
c(14636,14990,19609,19702,7214,7785),
c(123273.70,20936.92,45179.05,46359.91,65765.27,92771.36),
c(10370,13403,19241,26965,4468,8796)
)
myDataRAWEHC<-data.frame(
c("desktop","desktop","mobile","mobile","tablet","tablet","desktop","desktop","mobile","mobile","desktop","desktop","mobile","mobile","tablet","tablet","tablet","tablet","desktop","desktop"),
c("Card","Card","Card","Card","Card","Card","Card","Card","Gift","Gift","Gift","Card","Card","Card","Card","Card","Card","Card","Flower","Flower"),
c("Standard","Standard","Standard","Standard","Standard","Standard","Large","Large","Large","Large","Square","Square","Square","Square","Large","Large","Square","Square","Flowers","Flowers"),
c("Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger"),
c(8767,18072,5729,13017,2908,7086,1655,2971,1008,2177,984,2369,599,1422,449,1052,402,1001,233,355),
c(9055,18624,5908,13302,3015,7288,1691,3000,1013,2192,1009,2455,623,1450,455,1068,413,1017,233,356),
c(21699.60,44480.95,14464.85,32590.30,7232.47,17483.35,8309.85,14684.68,5024.92,10844.67,2405.07,5826.83,1529.16,3556.38,2220.21,5192.92,992.14,2447.78,5196.08,8021.95)
)
names(myDataRAW)<-c("Device.Category","Segment","Users","Sessions","Transactions","Revenue","Quantity")
names(myDataRAWEHC)<-c("Device.Category","Product.Category..Enhanced.Ecommerce.","Product.Variant","Segment","Unique.Purchases","Quantity","Product.Revenue")
This allows you to access myDataRAW and myDataRAWEHC from ui.R. Modify the ui.R accordingly:
fluidRow(
column(width = 3,
selectInput("device","Device:",
choices= levels(myDataRAW$Device.Category),
multiple=TRUE, selectize=TRUE)
),
column(width = 3,
selectInput("product","Product:",
choices= unique(levels(myDataRAWEHC$Product.Category..Enhanced.Ecommerce.)),
multiple=TRUE, selectize=TRUE)
)
),
after that you still have some work left to rearrange the server.R part.
Related
How to reactively filter which columns of a datatable are displayed?
I am trying to build an interactive data table that changes the displayed columns based on filters chosen by the user. The aim is to have a user select the columns they want to see via a dropdown, which will then cause the datatable to display those columns only.
library(shinyWidgets)
library(DT)
ui <-
fluidPage(
fluidRow(
box(width = 4,
pickerInput(inputId = "index_picker",
label = "Select index/indices",
choices = c("RPI", "RPIX", "CPI", "GDP Deflator"),
selected = "RPI",
multiple = T
)
)
)
fluidRow(
box(DT::dataTableOutput("index_table"), title = "Historic Inflation Indices", width = 12,
solidHeader = T, status = "primary")
)
)
server <- function(input, output, session) {
df_filt <- reactive({
if({
input$index_picker == "RPI" &
!is.null()
})
df_index %>%
select(Period, RPI.YOY, RPI.INDEX)
else if({
input$index_picker == "RPIX"
})
df_index %>%
select(Period, RPIX.YOY, RPIX.INDEX)
})
output$index_table <- renderDataTable({
DT::datatable(df_filt(),
options =
list(dom = "itB",
fixedHeader = T
),
rownames = F
)
})
}
I have similar code to the above that filters based on the row instead, and this works just fine, however, for this column filtering I am getting this error:
Warning in if ({ : the condition has length > 1 and only the first element will be used
I understand that I'm passing a vector to the if statement, but not sure how to recode - would anyone be able to help?
Why the selectInput() does not work correctly when multipe = TRUE?
I want to get the items that were selected from selectInput(). However, it seems only the first item could be transferred to server().
The UI:
sidebarLayout(
sidebarPanel(width = 4,
selectInput("cell_marker_density_surv", "Cell type", choices = cell_list,
selected = colnames(density)[1:3], multiple = TRUE),
textOutput("warning_density_roc_1"),
),
mainPanel(width = 8,
)
)
The server()
warning_density_roc_1_output <- reactive({
a = input$cell_marker_density_surv
paste0(input$cell_marker_density_surv, collapse = ",")
})
output$warning_density_roc_1 <- renderText(warning_density_roc_1_output())
As we can see, only the first item showed, even in the default situation.
enter image description here
I have realized that there are many questions related to these problems, but I do not know how to solve it. Is it caused by the selectInput() function itself? In fact, I want to give back a warning when the selected inputs are more than five, so I need to know how many items were selected. Could you help me? Thank you!
The following is the code modified based on the first answers:
library(shiny)
mpg <- ggplot2::mpg
library(shinyFeedback)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 4,
textOutput("warning_density_roc_1"),
selectInput("cell_marker_density_surv", "Cell type",
choices = names(mpg),
selected = names(mpg)[1:6], multiple = TRUE
)
),
mainPanel(width = 8, )
)
)
server <- function(input, output, session) {
warning_density_roc_1_output <- reactive({
print(length(input$cell_marker_density_surv))
num_input_density_roc <- if(length(input$cell_marker_density_surv) > 5) {
print("TRUE")
TRUE
} else {
print("FALSE")
FALSE
}
num_input_density_roc
feedbackWarning("cell_marker_density_surv", num_input_density_roc, "Warning, more than five items selected.")
})
output$warning_density_roc_1 <- renderText(warning_density_roc_1_output())
}
shinyApp(ui, server)
However, the feedbackWarning() could not work correctly.
Edit: Using shinyFeedback::feedbackWarning().
library(shiny)
library(shinyFeedback)
mpg <- ggplot2::mpg
ui <- fluidPage(
shinyFeedback::useShinyFeedback(),
sidebarLayout(
sidebarPanel(
width = 4,
# textOutput("warning_density_roc_1"),
selectInput("cell_marker_density_surv", "Cell type",
choices = names(mpg),
selected = names(mpg)[1:6], multiple = TRUE
)
),
mainPanel(width = 8, )
)
)
server <- function(input, output, session) {
observeEvent(input$cell_marker_density_surv, {
shinyFeedback::feedbackWarning(
"cell_marker_density_surv",
length(input$cell_marker_density_surv) > 5,
"Warning, more than five items selected."
)
})
}
shinyApp(ui, server)
Old answer:
Maybe this can help, I used mpg dataset as dummy data.
library(shiny)
mpg <- ggplot2::mpg
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 4,
textOutput("warning_density_roc_1"),
selectInput("cell_marker_density_surv", "Cell type",
choices = names(mpg),
selected = names(mpg)[1:6], multiple = TRUE
)
),
mainPanel(width = 8, )
)
)
server <- function(input, output, session) {
warning_density_roc_1_output <- reactive({
if (length(input$cell_marker_density_surv) > 5) {
"Warning, more than five items selected."
}
})
output$warning_density_roc_1 <- renderText(warning_density_roc_1_output())
}
shinyApp(ui, server)
R Shiny filtering
What i want to achieve that user can flexiblely disable/enable 2nd level filters id2('Resource') and id3('Case'):
id2('Resource') and id3('Case') enabled: program show relevant result based on id1, id2 and id3 filters
id2('Resource') and id3('Case') disabled: program ONLY show level 1 id1('ThrouputTime') filtered result.
I implement (pheusdo) code below, the program will fetch result based on these 3 filtered at SAMETIME, but can not achieve 2nd situation mentioned above. Any suggestion?
ui <- dashboardPage(
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
box(
title = "ThrouputTime",
width = 3,
sliderInput(inputId="id1", label="ThrouputTime", ...)
)
),
fluidRow(
box(
title = "Resource",
width = 3,
selectInput(inputId="id2", label="resource", ...)
),
box(
title = "Case",
width = 3,
selectInput(inputId="id3", label="case", ...)
)
)
)
)
)
server <- function(input, output, session){
observe({
output$process <- renderProcessanimater(expr = {
filtered_event <- newevent %>%
filter_throughput_time(interval = c(input$throughput[1], input$throughput[2])) %>%
filter_resource(input$id2) %>%
filter_case(input$id3, reverse = F)
#.... generate a workflow graph based on 'filtered_event' from above
})
})
}
graph <- shinyApp(ui, server)
runApp(graph, host = "0.0.0.0", port = 5050)
How to align different input fields in Shiny (vertical offset/padding/alignment)?
New to shiny. I'm creating a data exploration app for some experimental data.
I first select a variable to subset by and then use sliders to select a range for the said variables (shown in image). The subsetted data is overlaid on the original plot in red.
I want the sliderInput to be aligned at the same level as the selectInput. What's the best way to do that? I also want to add a checkbox or radio button for these variables which if selected would add a secondary plot (or secondary axis - I know, not recommended but that's what is desired). I haven't implemented that yet but putting that here since that would require the same aligning.
CODE
The arguments of sliderInput and selectInput have been removed for brevity. zdat() is a reactive data.table.
UI
fluidRow(
column(4,
uiOutput("subsetZoomPlot_x"), # Select x-axis for SortZoomPlot
uiOutput("subsetZoomPlot_y"), # Select y-axis for SortZoomPlot
uiOutput("subsetZoomPlot_var1"), # Subset data by var1
uiOutput("subsetZoomPlot_var2"), # Subset data by var2
uiOutput("subsetZoomPlot_var3") # Subset zoomplot data by var3
),
column(4,
uiOutput("subsetZoomPlot_var1_slider"), # range for subsetZoomPlot_var1 (slider input)
uiOutput("subsetZoomPlot_var2_slider"), # range for subsetZoomPlot_var1 (slider input)
uiOutput("subsetZoomPlot_var3_slider") # range for subsetZoomPlot_var1 (slider input)
)
),
fluidRow(
plotOutput("subsetZoomPlot")
)
SERVER
output$subsetZoomPlot_x <- renderUI({
selectInput(inputId = "subsetZoomPlot_x", ...)
})
output$subsetZoomPlot_y <- renderUI({
selectInput(inputId = "subsetZoomPlot_y", ...)
})
output$subsetZoomPlot_var1 <- renderUI({
selectInput(inputId = "subsetZoomPlot_var1", ...)
})
output$subsetZoomPlot_var2 <- renderUI({
selectInput(inputId = "subsetZoomPlot_var2", ...)
})
output$subsetZoomPlot_var3 <- renderUI({
selectInput(inputId = "subsetZoomPlot_var3", ...)
})
output$subsetZoomPlot_var1_slider <- renderUI({
vmin <- floor(min(zdat()[, get(input$subsetZoomPlot_var1)]))
vmax <- ceiling(max(zdat()[, get(input$subsetZoomPlot_var1)]))
sliderInput(...)
})
output$subsetZoomPlot_var2_slider <- renderUI({
vmin <- floor(min(zdat()[, get(input$subsetZoomPlot_var2)]))
vmax <- ceiling(max(zdat()[, get(input$subsetZoomPlot_var2)]))
sliderInput(...)
})
output$subsetZoomPlot_var3_slider <- renderUI({
vmin <- floor(min(zdat()[, get(input$subsetZoomPlot_var3)]))
vmax <- ceiling(max(zdat()[, get(input$subsetZoomPlot_var3)]))
sliderInput(...)
})
EDIT:
I added my current code for the UI section. It already has fluidrow(column(), column()) for the layout. My problem is that I want the slider for var1 (rh in the screenshot) to be aligned at the same level as the dropdown where rh is selected (selectInput) and the same for the other two variables. This means the second column needs to be vertically displaced. Is the only way to do this using multiple fluidrow statements for each combination of selectInput and sliderInput?
All of the layout issues are things that need to be addressed in the UI section of your shiny app code.
From what I can tell it looks like the code you've included with your question is in the server section since it seems that you have dynamic inputs in your app.
Here is some simple UI code that aligns a select input with a slider input
library(shiny)
ui <- fluidPage(title = 'Example',
fixedRow(
column(width = 2,
selectInput('input1_choice', 'Select Plot variable 1',
choices = letters[11:20])),
column(width = 2,
sliderInput('input1_val', 'Select Variable 1 Value',
0, 10, 5)
)
),
fixedRow(
column(width = 2,
selectInput('input2_choice', 'Select Plot variable 2',
choices = letters[1:10])
),
column(width = 2,
sliderInput('input2_val', 'Select Varaible 2 Value',
0, 10, 5)
)
)
)
shinyApp(ui, server = function(input, output) { })
So each fixedRow call creates a row in the UI, and each column call within a fixedRow call creates a column in that row to fill with a UI object.
As you change the types of UI objects the height of that row can change but it won't overlap or bleed into another row demonstrated here:
library(shiny)
ui <- fluidPage(title = 'Example',
fixedRow(
column(width = 2,
selectInput('input1_choice', 'Select Plot Variable 1',
choices = letters[11:20])),
column(width = 2,
radioButtons('input1_val', 'Select Variable 1 Value',
choices = LETTERS[11:20])
)
),
fixedRow(
column(width = 2,
selectInput('input2_choice', 'Select Plot Variable 2',
choices = letters[1:10])
)
),
fixedRow(
column(width = 2,
selectInput('input3_choice', 'Select Plot Variable 3',
choices = letters[1:10])
),
column(width = 2,
sliderInput('input3_val', 'Select Variable 3 Value',
0, 10, 5)
)
)
)
shinyApp(ui, server = function(input, output) { })
The only difference between these examples and what you'll need is to replace the explicit UI object calls I've made (selectInput for example) with uiOutput calls.
Like some comments have said there's documentation out there. I've found https://shiny.rstudio.com/reference/shiny/latest/ to be especially useful.
Not sure it is the best solution, but you can use columns in your UI :
fluidRow(
column(4,selectInput("select_x", "Select X Axis", ...)),
column(8),
column(4,selectInput("select_y", "Select Y Axis", ...)),
column(8)
column(4, selectInput("subsetZoomPlot_var1", ...)),
column(4, sliderInput(...)),
column(4),
column(4, selectInput("subsetZoomPlot_var2", ...)),
column(4, sliderInput(...)),
column(4),
...
)
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.