Chciałbym utworzyć błyszczącą aplikację z wykresem serii czasu, gdzie osi X (lata) opiera się na wejściu zasięgu suwaka, a oś Y jest zmienną (również oparta na wejściu Wybierz). Jednakże, gdy wytwarzam działkę, tylko wartości ekstremalne (MIN i MAX) są odzwierciedlone na działce, wydaje się, że lata w przedziale lat wydają się być pominięte.

Kod działa idealnie, gdy nie używam suwaka przez lata, fabuła wytwarza wiarygodną tendencję czasu. Jednak muszę jednak wdrożyć z suwakiem i doceniłbym wiele propozycji.

Oto mój kod.

UI

 `
    library(shiny)
    library(ggplot2)
    library(readxl)
    library(plotly)
    library(dplyr)

dat <<- read_excel("~/R/data.xlsx")

ui <- fluidPage(

  titlePanel("Data, 1990-2017"),

  sidebarLayout(
   # Inputs
      sidebarPanel(

  h3("Select Variable"),    
  # Select variable for y-axis
  selectInput(inputId = "y", 
              label = "Y-axis:",
              choices = c("Estimate", "Male", "Female"), 
              selected = "Estimate"),

  hr(),

  h3("Subset by Region"),    

  # Select which types of movies to plot
  selectInput(inputId = "Region",
              label = "Select Region:",
              choices = c("Africa", "Americas", "Asia", "Europe", "Oceania", "World"),
              selected = "World"), 

  hr(),

  h3("Year range"),    

  sliderInput(inputId = "slider", 
              label = "Years",
              min = 1990, 
              max = 2017, 
              sep = "",
              step = 1,
              value = c(1990, 2017))

),



mainPanel(

  tabsetPanel(type = "tabs",
              id = "tabsetpanel",
              tabPanel(title = "Plot", 
                       plotlyOutput(outputId = "tsplot"),
                       br(),
                       h5(textOutput("description")))
   )
  )
 )
)

`

Serwer

`
server <- function(input, output) {

     regions <- reactive({
     req(input$Region)
     req(input$slider) 

dat %>%
  filter(Region_Name %in% input$Region 
         & Year %in% input$slider) 


})


   output$tsplot <- renderPlotly({
    p <-  ggplot(data = regions(), 
                 aes_string(x = input$slider, y = input$y))+
          geom_line() +
          geom_point()+
          theme(legend.position='none') 

    ggplotly(p)
  })
}


shinyApp(ui = ui, server = server)

`

Tak wygląda wyjście

Wyjście aplikacji.

0
Karen Avanesyan 28 luty 2019, 13:52

2 odpowiedzi

Najlepsza odpowiedź

input$slider jest zakresem (dwie wartości ekstremalne). Jeśli chcesz, wszystkie lata zawarte w tym zakresie, zrób seq(input$slider[1], input$slider[2], by = 1). Możesz to zrobić:

server <- function(input, output) {

  years <- reactive({
    seq(input$slider[1], input$slider[2], by = 1)
  })

  regions <- reactive({
    # req(input$Region)  these two req are not necessary
    # req(input$slider) 

    dat %>%
      filter(Region_Name %in% input$Region & Year %in% years()) 
  })

   output$tsplot <- renderPlotly({
    p <-  ggplot(data = regions(), 
                 aes_string(x = Year, y = input$y)) +
          geom_line() +
          geom_point() +
          theme(legend.position='none') 

    ggplotly(p)
  })
}
0
Stéphane Laurent 28 luty 2019, 16:33

Wielkie dzięki! Pracowała na działkę! Musiałem jednak rozwijać aplikację, tworząc drugi tablet z szeroką tabelą danych. Czy jest możliwe, aby użyć suwaka zasięgu do wyboru lat jako kolumny w szerokiej tabeli danych? Doceniłoby wszelkie propozycje. Na podstawie poprzedniego rozwiązania napisałem to:

dat <<- read_excel("~/R/World estimates.xlsx")

datwide <<- read.csv("~/R/selected shiny.csv", check.names=FALSE)

ui <- fluidPage(
   pageWithSidebar(

headerPanel("Data, 1990-2017"),

sidebarPanel(



  conditionalPanel(
    condition = "input.theTabs == 'firstTab' ",

    h3('Time Series Plot '),
    selectInput(inputId = "y", 
                label = "Y-axis:",
                choices = c("Estimate", "Male", "Female"), 
                selected = "Estimate"),

    # Select which types of movies to plot
    selectInput(inputId = "Region",
                label = "Select Region:",
                choices = c("Africa", "Americas", "Asia", "Europe", "Oceania", "World"),
                multiple = TRUE,
                selected = "World")
    ,

    h3("Year range"),    # Third level header: Years

    sliderInput(inputId = "slider", 
                label = "Years",
                min = 1990, 
                max = 2017, 
                sep = "",
                step = 1,
                value = c(1990, 2017))
    ),


    conditionalPanel(
      condition = "input.theTabs == 'secondTab' ",
      h3('Data Table'),
      selectInput(inputId = "Region1",
                  label = "Select Region:",
                  choices = c("Africa", "Americas", "Asia", "Europe", "Oceania", "World"),
                  multiple = TRUE,
                  selected = "World"), 

      selectInput(inputId = "Indicator",
                  label = "Select Indicator(s):",
                  choices = c("Estimated Count", "Estimated male", "Estimated 
                  female"),
                  multiple = TRUE,
                  selected = "Estimated Count"),

      sliderInput(inputId = "sliderData", 
                  label = "Years",
                  min = 1990, 
                  max = 2017, 
                  sep = "",
                  step = 1,
                  value = c(2007, 2017)),

       downloadButton(outputId = "download_data", 
                      label = "Download Selected Data")

       ),

    conditionalPanel(
      condition = "input.theTabs == 'thirdTab' ",
      h3("Maps")

  )

  ),

  mainPanel(
    tabsetPanel(
      tabPanel( "Time series", plotlyOutput("timeSeries"),  
                value = "firstTab"),
      tabPanel( "Data", DT::dataTableOutput("datatab"),
                value = "secondTab"),
      tabPanel( "Maps", plotOutput("map"),
                value = "thirdTab"),
      id = "theTabs"
    )
   )
  )
 ) 

I dla serwera:

   server <- function(input, output) {

   years <- reactive({
    seq(input$slider[1], input$slider[2], by = 1)
    })

 regions <- reactive({

dat %>%
  filter(Region_Name %in% input$Region & Year %in% years()) 
 }) 


output$timeSeries <- renderPlotly({

p <- ggplot(data = regions(), aes_string( x = 'Year', y = input$y))+
  geom_line(aes(color = Region_Name)) +
  geom_point()


ggplotly(p)
})

years2 <- reactive({
  seq(input$sliderData[1], input$sliderData[2], by = 1)
}) 

output$datatab  <- DT::renderDataTable({


d <-   
 datwide %>%
 filter(Region %in% input$Region1 &
          Variable %in% input$Indicator) %>% 
  select(Region, Variable, years2 %in% input$sliderData)

 d
 })

# Create a download handler
output$download_data <- downloadHandler(

filename = "selected_data.csv",
content = function(file) {

  datwide %>%
 filter(Region %in% input$Region1 &
          Variable %in% input$Indicator) %>% 
  select(Region, Variable, years2 %in% input$sliderData)

  d 
  # Write the filtered data into a CSV file
  write.csv(d, file, row.names = FALSE)
   }
  )
 }
0
Karen Avanesyan 1 marzec 2019, 22:37