我想用时间序列图创建一个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)
`
这就是输出的样子
答案 0 :(得分：0)
DECLARE @ParentWorkItemLinkTypeSK int;
SET @ParentWorkItemLinkTypeSK = (SELECT [WorkItemLinkTypeSK] FROM [DimWorkItemLinkType] WHERE [LinkID] < 0 AND [ReferenceName] = 'System.LinkTypes.Hierarchy');
DECLARE @ChildWorkItemLinkTypeSK int;
SET @ChildWorkItemLinkTypeSK = (SELECT [WorkItemLinkTypeSK] FROM [DimWorkItemLinkType] WHERE [LinkID] > 0 AND [ReferenceName] = 'System.LinkTypes.Hierarchy');
DECLARE @ProjectName nvarchar(256);
SET @ProjectName = 'DEV'; -- set the team project name
DECLARE @RootNodeIDs TABLE (ID int);
INSERT @RootNodeIDs
-- This is selecting all deliverable workitems
SELECT cwi.[System_Id] AS ID FROM [CurrentWorkItemView] cwi
WHERE cwi.[System_WorkItemType] IN ('Bug', 'Product Backlog Item', 'Requirement')
AND cwi.[ProjectNodeName] = @ProjectName
EXCEPT
-- This is selecting all workitems that have a parent and have not been deleted
SELECT lh.SourceWorkItemID AS ID FROM FactWorkItemLinkHistory lh
JOIN [CurrentWorkItemView] cwi ON cwi.System_Id = lh.TargetWorkItemID
WHERE lh.WorkItemLinkTypeSK = @ParentWorkItemLinkTypeSK
AND cwi.System_WorkItemType IN ('Bug', 'Product Backlog Item', 'Requirement')
AND lh.RemovedDate = CONVERT(DATETIME, '9999', 126)
DECLARE @Hierarchy TABLE (ID int, ParentID int, [Level] int, [Path] nvarchar(4000));
WITH
Hierarchy (ID, ParentID, [Level], [Path]) AS
(
SELECT ID, NULL as ParentID, 0 as [Level], CAST('/' + STR(ID) AS nvarchar(256)) as [Path]
FROM @RootNodeIDs rootId
UNION ALL
SELECT flh.TargetWorkItemID as ID, Parent.ID, parent.Level + 1 as [Level],
CAST(parent.Path + '/' + STR(flh.TargetWorkItemID) AS nvarchar(256)) as [Path]
FROM Hierarchy parent
JOIN FactWorkItemLinkHistory flh
ON flh.WorkItemLinkTypeSK = @ChildWorkItemLinkTypeSK
AND flh.SourceWorkItemID = parent.ID
AND flh.RemovedDate = CONVERT(DATETIME, '9999', 126)
JOIN [CurrentWorkItemView] wi ON flh.TargetWorkItemID = wi.[System_ID]
WHERE parent.Path NOT LIKE CAST('%' + STR(flh.TargetWorkItemID) + '%' AS nvarchar(20)) AND parent.Level < 20
)
INSERT @Hierarchy SELECT * FROM Hierarchy;
-- Hierarchy now contains all the Tasks and their ancestors that we're interested
SELECT hierarchy.ID, ParentID, [Level], [Path], [ProjectNodeName] as Project, [System_State] as [State],
[Microsoft_VSTS_Scheduling_RemainingWork] Remaining,
[Microsoft_VSTS_Scheduling_CompletedWork] Completed,
([Microsoft_VSTS_Scheduling_RemainingWork] + [Microsoft_VSTS_Scheduling_CompletedWork]) Total,
[System_WorkItemType] WIT,
[System_Title] Title,
[AreaPath] AreaPath,
[IterationPath] IterationPath
FROM @Hierarchy hierarchy
INNER JOIN [CurrentWorkItemView] ON hierarchy.ID = [System_ID]
ORDER BY [System_Id]
是范围（两个极值）。如果要包含此范围内的所有年份，请执行input$slider。您可以这样做：
seq(input$slider[1], input$slider[2], by = 1)答案 1 :(得分：0)
非常感谢！它确实为情节工作！但是，我需要通过使用宽数据表创建第二个选项卡集来推进应用程序。是否可以使用范围滑块将年份选择为宽数据表中的列？将不胜感激任何建议。 基于先前的解决方案，我这样写：
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)
}
)
}