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)
`
这就是输出的样子
答案
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仅绘制滑块范围的极值的主要内容,如果未能解决你的问题,请参考以下文章