R блестяще реагирует на листовки - PullRequest
0 голосов
/ 20 января 2019

Итак, я только начал использовать R и пытаюсь создать приложение для листовок, которое реагирует на мой пользовательский ввод в ползунках. Я попытался установить подмножество данных, которые я использую, используя входные данные с моего ползунка, но он не работает. Я получаю сообщение об ошибке «неверный тип» (список) аргумента ».

Я приложил свой код ниже:


  titlePanel("Hello Shiny!"),

  sidebarLayout(

    sidebarPanel(

      selectizeInput(inputId = 'lsoa', 
                     label = 'Choose your lsoa', 
                     choices = c('Ealing' = 'ealing', 
                                 'Camden' = 'camden') , 
                     selected = 'camden', multiple = TRUE),

      uiOutput(outputId = 'time_var'),

      sliderInput("Date_of_year",
                  "Dates",
                  min = as.Date("2017-09-01","%Y-%m-%d"),
                  max = as.Date("2018-07-31","%Y-%m-%d"),
                  value=as.Date("2017-09-01"),
                  timeFormat="%Y-%m-%d"),
      uiOutput(outputId = 'datevar'),


      sliderInput("slider_hours", "Hours:", min=0, max=23, value=0, step = 1),

      uiOutput(outputId = 'hour_var')

      # sliderInput("slider_mins", "Mins:",min = 0, max = 45, value = 0, step = 15),
      # 
      # uiOutput(outputId = 'min_var')


    ),


    mainPanel(

      leafletOutput(outputId = "map")

    )
  )
)


server <- function(input, output) {

  output$map <- renderLeaflet({
    m <- leaflet() %>% 

      addTiles()%>%
      setView(lng = -0.1911, lat = 51.5371, zoom = 11)%>%
      addMarkers(data = subset(noise_sample, hour_time == input$slider_hours ),
        lng = ~longitude, 
        lat = ~latitude, 
        popup = ~as.character(lpaeq_T), 
        label = ~as.character(lsoa11nm))%>%
      addPolygons(data = subset(main_shape, grepl(paste(input$lsoa, collapse = '|'), 
                                                  tolower(lsoa11nm))), 
                  color = "#444444", 
                  weight = 1, 
                  smoothFactor = 0.5,
                  opacity = 1.0, 
                  fillOpacity = 0.5)
   m
  })
}

shinyApp(ui, server)

Здесь 'hour_time' - это имя столбца в моих данных noise_sample. Он должен просто дать номер, который должен совпадать с выбранным моим slider_hours.

1 Ответ

0 голосов
/ 21 января 2019

Это работает, но вы можете добавить функцию проверки в серверной части, если ваш выбор пуст:

noise_sample <- tibble("longitude" = c(-0.1914,-0.1943), "latitude"= c(51.5371,51.6),
                   "lpaeq_T"= c("toto","tata"), "lsoa11nm"= c("toto","tata"),
                   "hour_time" = c(1,2))
ui <- fluidPage(
     titlePanel("Hello Shiny!"),
 sidebarLayout(
 sidebarPanel(
selectizeInput(inputId = 'lsoa', 
               label = 'Choose your lsoa', 
               choices = c('Ealing' = 'ealing', 
                           'Camden' = 'camden') , 
               selected = 'camden', multiple = TRUE),
uiOutput(outputId = 'time_var'),
sliderInput("Date_of_year",
            "Dates",
            min = as.Date("2017-09-01","%Y-%m-%d"),
            max = as.Date("2018-07-31","%Y-%m-%d"),
            value=as.Date("2017-09-01"),
            timeFormat="%Y-%m-%d"),
uiOutput(outputId = 'datevar'),
sliderInput("slider_hours", "Hours:", min=0, max=23, value=1, step = 1),
uiOutput(outputId = 'hour_var')
# sliderInput("slider_mins", "Mins:",min = 0, max = 45, value = 0, step = 15),
# 
# uiOutput(outputId = 'min_var')
),
 mainPanel(
     leafletOutput(outputId = "map")
 )
)
)

server <- function(input, output) {
  output$map <- renderLeaflet({

  data1 <- subset(noise_sample, hour_time == input$slider_hours)

validate(
  need(dim(data1)[1] >0, "No data")
)

 m <- leaflet() %>% 
  addTiles()%>%
  setView(lng = -0.1911, lat = 51.5371, zoom = 11)%>%
  addMarkers(data = data1,
             lng = ~longitude, 
             lat = ~latitude, 
             popup = ~as.character(lpaeq_T), 
             label = ~as.character(lsoa11nm))
# %>%
#   addPolygons(data = subset(main_shape, grepl(paste(input$lsoa, collapse = '|'), 
#                                               tolower(lsoa11nm))), 
#               color = "#444444", 
#               weight = 1, 
#               smoothFactor = 0.5,
#               opacity = 1.0, 
#               fillOpacity = 0.5)
m
  })
}

shinyApp(ui, server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...