Shiny R仅绘制滑块范围的极值

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了Shiny R仅绘制滑块范围的极值相关的知识,希望对你有一定的参考价值。

我想用时间序列图创建一个Shiny应用程序,其中x轴(年)基于滑块范围输入,y轴是变量(也基于选择输入)。但是,当我生成绘图时,只有极端(最小和最大)值反映在绘图上,似乎省略了年间间隔内的年份。

当我多年不使用滑块时,代码工作正常,该情节产生了合理的时间趋势。但是,我需要使用滑块来实现它,并且会很感激任何提议。

这是我的代码。

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")))
   )
  )
 )
)

`

服务器

`
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)

`

这就是输出的样子

app output

答案

input$slider是范围(两个极端值)。如果你想要包含在这个范围内的所有年份,请做seq(input$slider[1], input$slider[2], by = 1)。你可以做:

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)
  })
}
另一答案

非常感谢!它确实适用于情节!但是,我需要通过创建带有宽数据表的第二个tabset来推进应用程序。是否可以使用范围滑块选择年份作为宽数据表中的列?不胜感激。根据以前的解决方案,我写了这个:

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"
    )
   )
  )
 ) 

而对于服务器:

   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)
   }
  )
 }

以上是关于Shiny R仅绘制滑块范围的极值的主要内容,如果未能解决你的问题,请参考以下文章

R Shiny server.R 反应式时间/日期滑块,轴变化

R shiny:在交互式 3d 图中结合选择和滑块

R闪亮:如何将滑块和单选按钮链接到ggplot

在R Shiny中如何分离滑块输入值并使用它们进行过滤

使用Shiny滑块控制ggplot上的输出

R: Shiny - 更新 dateRangeInput 开始和结束