R闪亮动作按钮影响反应控制

时间:2016-04-09 01:50:22

标签: r shiny

我想绘制一个步骤数据的直方图,该数据在首次运行应用程序时显示,该位正在运行。箱子的变化和绘图密度的颜色也是如此。我想要包括的功能之一是用户能够单击actionButton或其他一些动作切换以覆盖直方图上的dnorm-line。打开或关闭会更好。

但是,我此时只能获取一次绘制覆盖线的代码。我尝试使用'隔离'从这个想法here开始,但无法在我的代码中找出实现。

理想情况下,情节看起来像(忽略更精细的情节控制点)用户点击"切换"添加或删除曲线:

w<-rnorm(1000) 
hist(w,col="red",freq=F,xlim=c(-5,5))
curve(dnorm,-5,5,add=T,col="blue")

ui.R

    library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

  # Application title
  titlePanel("Data Products - Final Project"),

  # Sidebar with a slider input for the number of bins
  sidebarLayout(
    sidebarPanel(
      helpText("Select some of the features of the histogram."),

      sliderInput("bins", label = h4("Number of bins: ")
                  , min = 5
                  , max = 50
                  , value = 10),
      radioButtons("radio-color", helpText("Select a color for density plot."),
                   choices = list("Salmon" = "salmon", "Black" = "black"
                                  ,"Red" = "red", "Dark Blue" = "darkblue"
                                  , "Dark Grey" = "darkgrey")
                   ,selected = "salmon"),
      actionButton("hist-dnorm", label = "Add Curve")
    ),#end sideBarPanel

    # Show a plot of the generated distribution
    mainPanel(
      h1("Lorem Ipsum", align = "left"),
      p("Some paragraph text", align = "left"),
      plotOutput("histPlot"),
      plotOutput("histLine")
    )#End mainPanel
    )#End sidebarLayout
  )#End fluidPage
)#End ShinyUI

server.R

希望您可以看到我的刮痕代码,其曲线的元素当前已被注释掉,因为我无法弄清楚如何在代码中实现它们。是(m,s,xfit,yfit,yfit2和hline)

library(shiny)
library(caret)
library(ggplot2)
library(dplyr)
library(lubridate)

dat <- read.csv("data/fitbit_data.csv", stringsAsFactors = FALSE)
dat$Day <- weekdays(x = as.Date(dat$Date, "%m/%d/%Y", label = TRUE, abbr = FALSE))
dat$Steps <- as.numeric(sub(",","",dat$Steps))
dat$Steps[dat$Steps == 0 & is.numeric(dat$Steps)] <- NA
dat$Calories.Burned <- as.numeric(sub(",","",dat$Calories.Burned))
dat$Calories.Burned[dat$Calories.Burned == 0 
                    & is.numeric(dat$Calories.Burned)] <- NA
dat$Minutes.Sedentary <- as.numeric(sub(",","",dat$Minutes.Sedentary))
dat$Minutes.Sedentary[dat$Minutes.Sedentary == 0 
                      & is.numeric(dat$Minutes.Sedentary)] <- NA
dat$Activity.Calories <- as.numeric(sub(",","",dat$Activity.Calories))
dat$Activity.Calories[dat$Activity.Calories == 0 
                      & is.numeric(dat$Activity.Calories)] <- NA

# Define server logic required to draw a histogram
shinyServer(function(input, output) {

  output$histPlot <- renderPlot({
    steps <- dat$Steps
    bins <- seq(min(steps, na.rm = TRUE), max(steps, na.rm = TRUE)
                , length.out = input$bins + 1)
    h <- hist(dat$Steps, breaks = bins, density = 10, col = input$`radio-color`
         , xlim = c(500, 25000)
         , xlab = "# of Steps"
         , ylab = "Frequency"
         , main = "Histogram of Steps")
    isolate(
      output$histLine <- renderPlot({
        m <- mean(dat$Steps, na.rm = TRUE)
        s <- sqrt(var(dat$Steps, na.rm = TRUE))
        xfit <- seq(min(dat$Steps, na.rm = TRUE)
                    , max(dat$Steps, na.rm = TRUE), length = 40)
        yfit <- dnorm(xfit, mean = m, sd = s)
        yfit2 <- yfit*diff(h$mids[1:2])*length(dat$Steps)
        lines(xfit, yfit2, col = "darkblue", lwd = 2)
      })
    )
  })

   #end isolate


})#end shinyServer

问题

  1. 如何在ui.R中实现允许用户切换的切换     在server.R中计算的dnorm曲线的叠加(开或关;     默认情况下关闭)?
  2. 前几行代码中的所有数据子集都可以     你有任何建议,以便更好地清理干净     那个?
  3. 感谢您的时间和考虑

1 个答案:

答案 0 :(得分:2)

这是一个概念证明。

library(shiny)

# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(

   # Application title
   titlePanel("Toggle line"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
        actionButton("button", "Toggle line")
      ),

      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("distPlot")
      )
   )
))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
   w<-rnorm(1000) 
   output$distPlot <- renderPlot({
     hist(w,col="red",freq=F,xlim=c(-5,5))
     if (input$button%%2 == 0) {
      curve(dnorm,-5,5,add=T,col="blue")
     }
   })
})

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