r闪亮的代码 - 带因子变量的selectInput

时间:2017-10-24 21:21:36

标签: r shiny radio-button histogram

我正在构建一个闪亮的应用程序。在下拉菜单中,我有一个因子变量的类别。我认为问题出在服务器上,但我不知道如何修复它。

另外,我希望在选择的颜色为黄色时在15处的直方图中添加垂直,而在直方图中选择的颜色为20时的垂直线为20。你能帮我解决一下我的代码吗? 感谢

library(shiny)

# Creating a fake data frame
categories <- c("A", "B", "c")
values <- c(12, 15, 20)
data <- merge(categories, values)

# Define UI for application 
ui <- shinyUI(fluidPage(

# Title panel
titlePanel(title = h1("Title", align = "center")),
sidebarLayout(

# Sidebar panel 
sidebarPanel(

# Options
 selectInput(inputId = "xcol", label = "Select", choices = levels(data$x)),
 br(),
 #Colours histogram
 radioButtons(inputId = "colour", label = strong("Select the colour of 
 histogram"), choices = c("Yellow", "Red"), selected = "Yellow"),
 br(),
 #Bins for histogram
 sliderInput(inputId = "bins", label = "Select the number of Bins for the 
histogram", min=5, max = 25, value = 15),
  br(),
 #Density curve
  checkboxInput(inputId = "density", label = strong("Show Density Curve"), 
value = FALSE),

  # Display this only if the density is shown
  conditionalPanel(condition = "input.density ==true",
                   sliderInput(inputId = "bw_adjust",
                               label = "Bandwidth adjustment:",
                               min = 0.2, max = 3, value = 1, step = 0.2))


  ),

  # Main Panel
  mainPanel(
  #plot histogram
  plotOutput("plot"),

  # Output: Verbatim text for data summary
  verbatimTextOutput("summary"))

  )))

# Define server logic 
server <- shinyServer(function(input, output) {

output$plot <-renderPlot({
hist(data[input$xcol, data$x], breaks = seq(0, max(data[input$xcol, 
data$x]), l= input$bins+1), col = "lightblue", 
     probability = TRUE, xlab = "Values", main = "")
abline(v = mean(data[input$xcol, data$x]), col = "red", lty = 2)
title(main = levels(data$x[input$xcol]))

if (input$density) {
  dens <- density(data[input$xcol, data$x], adjust = input$bw_adjust)
  lines(dens, col = "blue", lwd = 1)
}
# Generate the summary
output$summary <- renderPrint({
  xcol <- xcolInput()
  summary(xcol)
})
})
})

# Run the application 
shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:0)

您似乎错误地将data分组。我为数据子集创建了一个反应式表达式:data2(),并用它来绘制输出。我还使用if(){...}else{...}语句添加了您提到的垂直线。

library(shiny)

# Creating a fake data frame
categories <- c("A", "B", "c")
values <- c(12, 15, 20)
data <- merge(categories, values)

# Define UI for application 
ui <- shinyUI(fluidPage(

  # Title panel
  titlePanel(title = h1("Title", align = "center")),
  sidebarLayout(

    # Sidebar panel 
    sidebarPanel(

      # Options
      selectInput(inputId = "xcol", label = "Select", choices = levels(data$x)),
      br(),
      #Colours histogram
      radioButtons(inputId = "colour", label = strong("Select the colour of 
                                                      histogram"), choices = c("Yellow", "Red"), selected = "Yellow"),
      br(),
      #Bins for histogram
      sliderInput(inputId = "bins", label = "Select the number of Bins for the 
                  histogram", min=5, max = 25, value = 15),
      br(),
      #Density curve
      checkboxInput(inputId = "density", label = strong("Show Density Curve"), 
                    value = FALSE),

      # Display this only if the density is shown
      conditionalPanel(condition = "input.density ==true",
                       sliderInput(inputId = "bw_adjust",
                                   label = "Bandwidth adjustment:",
                                   min = 0.2, max = 3, value = 1, step = 0.2))


      ),

    # Main Panel
    mainPanel(
      #plot histogram
      plotOutput("plot"),

      # Output: Verbatim text for data summary
      verbatimTextOutput("summary"))

      )))

# Define server logic 
server <- shinyServer(function(input, output) {
  data2 <- reactive({data[as.character(data$x)==input$xcol, "y"]})

  output$plot <-renderPlot({
    hist(data2(), breaks = seq(0, max(c(1, data2()), na.rm=TRUE), l= input$bins+1), col = input$colour, 
         probability = TRUE, xlab = "Values", main = "")
    abline(v = mean(data2()), col = "red", lty = 2)
    title(main = input$xcol)

    if (input$density) {
      dens <- density(data2(), adjust = input$bw_adjust)
      lines(dens, col = "blue", lwd = 1)
    }
    if(input$colour=="Red"){
      abline(v=20)}else{abline(v=15)}
    # Generate the summary
    output$summary <- renderPrint({
      #xcol <- xcolInput()
      summary(data2())
    })
  })
})

# Run the application 
shinyApp(ui = ui, server = server)