I'm trying to create a shiny app where the user selects a variable from a drop down box, e.g. dose or supp in the toothgrowth dataset, then a slider from 1 to 100 for each unique element in the variable is available, e.g 0.5, 1, 2 if dose is selected. Based on the variable selected and selected values on the slider I want to create another binary variable, e.g. sufficient_length, that is:
if (input$group == "supp"){
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="VC"& ToothGrowth$len > input$VC)]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="VC"& ToothGrowth$len <= input$VC)]<-0
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="OJ"& ToothGrowth$len > input$OJ)]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="OJ"& ToothGrowth$len <= input$OJ)]<-0
} else if (input$group == "dose"){
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="0.5"& ToothGrowth$len > input$"0.5")]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="0.5"& ToothGrowth$len <= input$"0.5")]<-0
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="1"& ToothGrowth$len > input$"1")]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="1"& ToothGrowth$len <= input$"1")]<-0
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="2"& ToothGrowth$len > input$"2")]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="2"& ToothGrowth$len <= input$"2")]<-0
}
Is there a way of doing this without having to hard code all the possibilities as once I get this working I will apply it to a much larger dataset than toothgroup
where there are many variables and more unique elements within those variables?
The full code for the shinny app so far is:
library(shiny)
library(ggplot2)
data("ToothGrowth")
ui<-shinyUI(
fluidPage(
fluidRow(
column(width = 4,
selectInput("group", "Group:",
c("Supp" = "supp",
"Dose" = "dose")),
uiOutput("sliders"),
tableOutput("summary")
),
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot")
)
)
)
)
server <- shinyServer( function(input, output) {
dat<-reactive({
as.character(unique(ToothGrowth[,input$group]))
})
#reactive code for referrals based on the slider for threshold----
dat2 <- reactive({
req(ToothGrowth)
ToothGrowth$sufficient_length<-rep(0,nrow(ToothGrowth))
if (input$group == "supp"){
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="VC"& ToothGrowth$len > input$VC)]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="VC"& ToothGrowth$len <= input$VC)]<-0
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="OJ"& ToothGrowth$len > input$OJ)]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$supp=="OJ"& ToothGrowth$len <= input$OJ)]<-0
} else if (input$group == "dose"){
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="0.5"& ToothGrowth$len > input$"0.5")]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="0.5"& ToothGrowth$len <= input$"0.5")]<-0
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="1"& ToothGrowth$len > input$"1")]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="1"& ToothGrowth$len <= input$"1")]<-0
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="2"& ToothGrowth$len > input$"2")]<-1
ToothGrowth$sufficient_length[which(ToothGrowth$dose=="2"& ToothGrowth$len <= input$"2")]<-0
}
return(ToothGrowth)
})
#Render the sliders
output$sliders <- renderUI({
# First, create a list of sliders each with a different name
sliders <- lapply(1:length(dat()), function(i) {
inputName <- dat()[i]
sliderInput(inputName, inputName, min=0, max=100, value=10)
})
# Create a tagList of sliders (this is important)
do.call(tagList, sliders)
})
output$distPlot <- renderPlot({
ggplot(dat2(),aes(len,fill = as.factor(sufficient_length)))+
geom_histogram(bins=20)
})
})
shinyApp(ui, server)