Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 206278

creating a new column based on dynamically changing threshold conditions Shiny

$
0
0

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) 

Viewing all articles
Browse latest Browse all 206278

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>