Question

我是创建闪亮应用程序的新手，并且遇到了绊脚石。我想显示通过复选框选择的基于数据的因素。我已经尝试了很多方法，但是无法使其正常工作。

我的代码如下。我很容易添加复选框，但是在服务器部分，当我尝试对数据进行子集显示时，会出现错误。我不清楚如何解决该问题。任何帮助，将不胜感激。

#### Shiny app 
library(shiny)
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(rgdal)
library(knitr)
library(rmarkdown)
library(markdown)
library(webshot)
#webshot::install_phantomjs()
library(flexdashboard)
library(randomNames)
library(stringi)


#### Make a data set we can use #####

      ## Read in US boundaries
      #US<-readOGR("US boundaries/cb_2017_us_county_5m.shp")


      for (i in 2000:2018){

        ## Create random points 
        #random.points<-(spsample((US),n=100,type="random"))

        #random.points<-as.data.frame(random.points)
        x<-rnorm(100,-100,10)
        y<-rnorm(100,40,5)
        random.points<-data.frame(cbind(x,y))
        names(random.points)<-c("x","y")

        ## make some random data 
        k<-100
        x <- c(rep("A class",0.1*k),rep("B class",0.2*k),rep("C class",0.65*k),rep("D class",0.05*k))

        random.points$Class <- as.factor(sample(x, k)) 
        random.points$Name<-randomNames(k,gender=sample(1:2,k,replace = TRUE))
        random.points$Notes<-stri_rand_lipsum(k)
        random.points$Age<-round(abs(rnorm(100,40,30)))
        random.points$Year<-i

        ## tie it in ##
        if(i!=2000)
        {out<-rbind(out,random.points)}else{out<-random.points}

      }      
      ## Convert to spatial object
      coordinates(out)<-~x+y


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

  # App title ----
  titlePanel("Survey sample viewer"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Slider for the number of bins ----
      sliderInput(inputId = "year",
                  label = "Year of survey:",
                  min = 2000,
                  max = 2018,
                  value = 2000),

      checkboxGroupInput("ClassInput", "Variables to show:",
                         c("A" = "A class",
                           "B" = "B class",
                           "C" = "C class",
                           "D" = "D class")),
      #tableOutput("data"),



      # Output: Boxplot by class ----
      plotOutput(outputId = "classPlot")

    ),

    # Main panel for displaying outputs ----
    mainPanel(
      h2("Map of survey locations ", align="center"),
      # Output: Map
      leafletOutput("map"),

      # Output: Histogram ----
      plotOutput(outputId = "distPlot")


    )
  )
)

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

  # Histogram of the Old Faithful Geyser Data ----
  # with requested number of bins
  # This expression that generates a histogram is wrapped in a call
  # to renderPlot to indicate that:
  #
  # 1. It is "reactive" and therefore should be automatically
  #    re-executed when inputs (input$bins) change
  # 2. Its output type is a plot


  ## subset the data 
  x <- reactive(out[(out$Year==input$year & out$Class %in% input$ClassInput),])

  output$distPlot <- renderPlot({

    hist(x$Age, breaks = 15, col = "#75AADB", border = "black",
          xlab = "Age of subjects",
         main=paste(c("Ages of respondents"),input$year))

  })

  output$classPlot <- renderPlot({

    #x    <- out$Age[out$Year==input$year] ### note that the data frame exists outside the script. Should be able to call it at the beginning

    boxplot(x~random.points$Class,col = "#75AADB", border = "black",
            xlab = "Age of subjects",
            main = paste(c("Ages of respondents by class "),input$year))

  }


  )

  output$map <- renderLeaflet({


    ## Set size and color of dots 
    size<-3
    color<-c('red')
    out.dat<-subset(out,out$Year==input$year)
    m = leaflet(out.dat) %>% addTiles()
    m<-m %>% addCircleMarkers(radius = ~size, color = ~color, fill = FALSE, 
                              popup = (paste("<b>Name: </b>",out.dat$Name,"<br>",
                                             "<b>Class: </b>",out.dat$Class,"<br>",
                                             "<b>Age: </b>",out.dat$Age,"<br>",
                                             "<b>Notes: </b>",out.dat$Notes,"<hr>")))
    m<-m %>% setView(-98.556061, 39.810492, zoom = 4)
  }) 

}


shinyApp(ui = ui, server = server)

Answer 1

将x<-表达式放在render-Plot函数内部可以绘制图表，请注意，如果要直接在加载时看到图表而不进行任何更改，则必须初始化图表。

output$distPlot <- renderPlot({

x <- out[(out$Year==input$year & out$Class %in% input$ClassInput),]

hist(x$Age, breaks = 15, col = "#75AADB", border = "black",
     xlab = "Age of subjects",
     main=paste(c("Ages of respondents"),input$year))


  })


#initialize at A
ui<-
checkboxGroupInput("ClassInput", "Variables to show:",
                     c("A" = "A class", 
                       "B" = "B class",
                       "C" = "C class",
                       "D" = "D class"),selected="A class"),

使用复选框以闪亮方式显示数据子集

1 个答案: