Использование ввода и выбора диапазона даты на одном графике на блестящей приборной панели - PullRequest
Новая
       5

Использование ввода и выбора диапазона даты на одном графике на блестящей приборной панели

0 голосов
/ 29 июня 2019

Я пытаюсь использовать как ввод данных, так и ввод диапазона дат на одном графике.Первоначально я использовал ввод выбора для выбора различных местоположений для моих данных, и он работал, код выглядит следующим образом: 

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(shinyWidgets)


mydata<- "x  Group.2 Group.1
32.93000 1984-05-22      Chololo
13.44500 1984-07-18      Chololo
14.41667 1984-10-19      Chololo
10.53000 1984-10-29 West.Reserve
22.96750 1984-11-17      Chololo
38.75000 1984-12-05      Chololo
29.58000 1985-01-14      Chololo
30.64000 1985-01-14 West.Reserve
22.70000 1985-01-25 East.Reserve
40.69000 1985-01-25 West.Reserve
16.17667 1985-03-16      Chololo
15.82000 1985-03-16 East.Reserve
34.34000 1985-03-16 West.Reserve
101.53000 1985-05-25 West.Reserve
74.55000 1985-05-26      Chololo
73.49000 1985-05-26 East.Reserve
44.12500 1985-09-05      Chololo
31.43000 1985-09-05 East.Reserve
79.84000 1985-09-05 West.Reserve
22.70000 1985-12-02      Chololo
19.53000 1985-12-02 East.Reserve
34.34000 1985-12-02 West.Reserve
27.25000 1986-01-17 West.Reserve
20.85000 1986-01-30      Chololo
13.18000 1986-01-30 East.Reserve
36.99000 1986-01-30 West.Reserve
15.29500 1986-03-15      Chololo
8.95000 1986-03-15 East.Reserve
19.00000 1986-03-15 West.Reserve
15.56500 1986-04-27      Chololo
13.97500 1986-04-27 East.Reserve
28.52000 1986-04-27 West.Reserve
47.83500 1986-06-16      Chololo
102.90000 1986-06-16 East.Reserve
119.53000 1986-06-16 West.Reserve
82.22000 1986-07-31      Chololo
88.57000 1986-07-31 East.Reserve
95.71000 1986-07-31 West.Reserve
57.88500 1986-09-20      Chololo
45.19000 1986-09-20 East.Reserve"

Data <- read.table(text=mydata, header = TRUE)
Data$Group.2<-as.POSIXct(Data$Group.2,format="%Y-%m-%d")


ui<-shinyUI(
  dashboardPage(skin="red",
              dashboardHeader(title = "Biomass"),  
              dashboardSidebar(id="", width=260, sidebarMenuOutput("sidemenu")),
              dashboardBody(
                tabItems(
                  tabItem(tabName = "Biomass",
                          fluidRow(HTML("<br/>"),
                                   box(width=6, pickerInput("Locations","Select a location:", choices=c("Chololo","Doldol", "East.Reserve", "West.Reserve"),selected = c("Chololo"),options = list(`actions-box` = TRUE),multiple = T)),
                                   box(width= 6, dateRangeInput(inputId = "daterange2", label = "Select the date range:", start = min(Data$Group.2), end = max(Data$Group.2), min = min(Data$Group.2), max = max(Data$Group.2), format = "yyyy/mm/dd", separator = "/"))),
                          fluidRow(
                            box(width = 10, title=" Biomass: Selected location ", background ="blue", plotlyOutput("plot1"), collapsible = TRUE))
                          )
                )
              )

                )

)

Server<- shinyServer(function(input,output, session){
  output$sidemenu<-renderMenu({
    sidebarMenu(
      menuItem("Biomass Data", tabName = "Biomass", icon = icon("chart-line"),selected = TRUE)
    )
  })

  myfilter <- reactive({subset(Data,Data$Group.1 %in% input$Locations|Data, Data$Group.2>=as.POSIXct(input$daterange2[1])& Data$Group.2 <=as.POSIXct(input$daterange2[2]))})

  output$plot1<-renderPlotly({


    p<-ggplot(data= myfilter(),aes(x=myfilter()[,2], y=myfilter()[,1]))+geom_line()+theme_bw()+theme(axis.title = element_text(face="plain", size=20), plot.title = element_text(face="plain",size=25),axis.text=element_text(face="plain",size=20),legend.text=element_text(size=16),legend.title=element_text(size=20))+
      xlab("Year")+ylab("Biomass g/sqm")+ ylim(0,200)
    pp<-ggplotly(p)
    pp
  })

  })

shinyApp(ui=ui, server = Server)

Проблема возникает, когда я пытаюсь добавить входной диапазон даты в реактивную функцию, чтобы обаМесто и дата могут быть выбраны одновременно.Я новичок в r, поэтому, если я задал очевидный вопрос или я не совсем ясно, скажите, пожалуйста.

Я попытался добавить подмножество для ввода даты в эту строку 

myfilter <- reactive({subset(Data,Data$Group.1 %in% input$Locations)})

вроде так 

  myfilter <- reactive({subset(Data,Data$Group.1 %in% input$Locations|Data, Data$Group.2>=as.POSIXct(input$daterange2[1])& Data$Group.2 <=as.POSIXct(input$daterange2[2]))})

но я получаю эту ошибку "Внимание: ошибка в Ops.POSIXt: '|'не определено для "POSIXt" объектов "

Я пытался посмотреть на другие вопросы здесь, но я не могу найти подобный вопрос.То, что я сделал, возможно, неточно, поэтому, если я смогу получить какие-либо идеи о том, как заставить график реагировать как на вход сборщика, так и на ввод диапазона дат, я буду благодарен

1 Ответ

0 голосов
/ 29 июня 2019

Посмотрите на Тидиверс и особенно ДПЛЫР. Делает это намного проще: -).

Обновлен код, поэтому, когда вы отменили выбор всех стран, вы не получите сообщение об ошибке, но хорошее предупреждение. 

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(shinyWidgets)
library(dplyr)

mydata<- "x  Group.2 Group.1
32.93000 1984-05-22      Chololo
13.44500 1984-07-18      Chololo
14.41667 1984-10-19      Chololo
10.53000 1984-10-29 West.Reserve
22.96750 1984-11-17      Chololo
38.75000 1984-12-05      Chololo
29.58000 1985-01-14      Chololo
30.64000 1985-01-14 West.Reserve
22.70000 1985-01-25 East.Reserve
40.69000 1985-01-25 West.Reserve
16.17667 1985-03-16      Chololo
15.82000 1985-03-16 East.Reserve
34.34000 1985-03-16 West.Reserve
101.53000 1985-05-25 West.Reserve
74.55000 1985-05-26      Chololo
73.49000 1985-05-26 East.Reserve
44.12500 1985-09-05      Chololo
31.43000 1985-09-05 East.Reserve
79.84000 1985-09-05 West.Reserve
22.70000 1985-12-02      Chololo
19.53000 1985-12-02 East.Reserve
34.34000 1985-12-02 West.Reserve
27.25000 1986-01-17 West.Reserve
20.85000 1986-01-30      Chololo
13.18000 1986-01-30 East.Reserve
36.99000 1986-01-30 West.Reserve
15.29500 1986-03-15      Chololo
8.95000 1986-03-15 East.Reserve
19.00000 1986-03-15 West.Reserve
15.56500 1986-04-27      Chololo
13.97500 1986-04-27 East.Reserve
28.52000 1986-04-27 West.Reserve
47.83500 1986-06-16      Chololo
102.90000 1986-06-16 East.Reserve
119.53000 1986-06-16 West.Reserve
82.22000 1986-07-31      Chololo
88.57000 1986-07-31 East.Reserve
95.71000 1986-07-31 West.Reserve
57.88500 1986-09-20      Chololo
45.19000 1986-09-20 East.Reserve"

Data <- read.table(text=mydata, header = TRUE)
Data$Group.2<-as.POSIXct(Data$Group.2,format="%Y-%m-%d")


ui<-shinyUI(
    dashboardPage(skin="red",
                  dashboardHeader(title = "Biomass"),  
                  dashboardSidebar(id="", width=260, sidebarMenuOutput("sidemenu")),
                  dashboardBody(
                      tabItems(
                          tabItem(tabName = "Biomass",
                                  fluidRow(HTML("<br/>"),
                                           box(width=6, pickerInput("Locations","Select a location:", choices=c("Chololo","Doldol", "East.Reserve", "West.Reserve"),selected = c("Chololo"),options = list(`actions-box` = TRUE),multiple = T)),
                                           box(width= 6, dateRangeInput(inputId = "daterange2", label = "Select the date range:", start = min(Data$Group.2), end = max(Data$Group.2), min = min(Data$Group.2), max = max(Data$Group.2), format = "yyyy/mm/dd", separator = "/"))),
                                  fluidRow(
                                      box(width = 10, title=" Biomass: Selected location ", background ="blue", uiOutput("plot1"), collapsible = TRUE))
                          )
                      )
                  )

    )

)

Server<- shinyServer(function(input,output, session){
    output$sidemenu<-renderMenu({
        sidebarMenu(
            menuItem("Biomass Data", tabName = "Biomass", icon = icon("chart-line"),selected = TRUE)
        )
    })

    myfilter <- reactive({

        result <- Data %>%
            dplyr::filter(Group.1 %in% input$Locations & (Group.2>=as.POSIXct(input$daterange2[1]) & Group.2 <=as.POSIXct(input$daterange2[2])))
        print(result)
        result
        })


    output$plot1 <- renderUI({
        if(nrow(myfilter()) == 0) {
            return(
                HTML("No data selected. Please choose at least one location.")
            )
        } else {

            output$plot<-renderPlotly({


                p<-ggplot(data= myfilter(),aes(x=myfilter()[,2], y=myfilter()[,1]))+geom_line()+theme_bw()+theme(axis.title = element_text(face="plain", size=20), plot.title = element_text(face="plain",size=25),axis.text=element_text(face="plain",size=20),legend.text=element_text(size=16),legend.title=element_text(size=20))+
                    xlab("Year")+ylab("Biomass g/sqm")+ ylim(0,200)
                pp<-ggplotly(p)
                pp
            })

            plotlyOutput("plot")

        }
    })



})

shinyApp(ui=ui, server = Server)
...