如何在ShinyDashboard R中显示年初至今数据？ [英] How to display Year to Date data in ShinyDashboard R?
问题描述
下面是数据集。该数据集与特定年份中特定位置的仪器使用情况有关。当前下面的代码根据 SideBar 面板中的选定选项显示结果，即，当用户选择 Loc1和Year 2018时，它将过滤并显示数据。图表和表格形式的 mainpanel 。接下来，我想在选择最新年份时在 mainpanel 中显示YTD（年至今）结果。在这种情况下，当用户选择Loc1和Year 2019时， mainpanel 中的输出应显示2018和2019年的数据。但是，在这种情况下，当用户选择去年的数据时，那么它只会显示2018年数据。
Below is the dataset. This dataset is about instrument usage at specific location in specific year. currently below code is displaying the results according to the selected option from SideBar Panel i.e when user selects "Loc1" and Year "2018", it will filter and display the data in the mainpanel in the form of Chart as well as table. Next, I would like to display YTD(Year-to-Date) results in the mainpanel when latest year is selected. In this case when user selects Loc1 and Year 2019, the output in mainpanel should display data that is from 2018 and 2019. However, when user selects last year's data in this case 2018, then it shud only display 2018 data.
当前问题：根据Ben和Ronak的建议，我能够根据需要过滤2018年和2019年的数据。即，当用户选择2019时，它将显示2019、2018和0的数据。当用户选择2018时，将显示2018和0年的数据。但是，当我选择0作为年份时，所有年份的数据都显示在仪表板的 mainpanel 中。所有需要的是在特定位置显示0年的数据。不确定是什么问题
Current Issue: After Suggestion from Ben and Ronak, I was able to filter the data for the year 2018 and 2019 as I needed. i.e , when User selects 2019, it display data for the year 2019,2018 and 0. When user selects 2018, the data for the year 2018 and 0 year got displayed.However, When I selected 0 for the year, the data for all the years got displayed in mainpanel of Dashboard. All is need is to display data for the year 0 at specific location.Not sure what is the issue with the code in "Code after Suggestion from Ben and Ronak Shah" section.
提供解释并提供代码。
数据集：
structure(list(Systems = c("Sys1", "Sys1", "Sys2", "Sys3", "Sys4",
"Sys6", "Sys7"), Locations = c("loc1", "loc1", "loc1", "loc2",
"loc2", "loc3", "loc1"), year = structure(c(2L, 1L, 1L, 1L, 1L,
3L, 3L), .Label = c("2019", "2018", "0"), class = "factor"),
frequency = c(1L, 2L, 1L, 1L, 1L, 0L, 0L), freq_cal = c(33.33,
66.67, 100, 100, 100, 0, 0), label = c("33.33%", "66.67%",
"100.00%", "100.00%", "100.00%", "0.00%", "0.00%")), row.names = c(NA,
-7L), class = "data.frame")
Ben和Ronak建议之前的代码：
library(shiny)
library(shinydashboard)
library(plotly)
resetForm<-function(session){
updateSelectInput(session,"slct1",selected = ' ')
}
ui<-dashboardPage(
dashboardHeader(title="System Tracker"),
dashboardSidebar(
selectInput('slct1',"Select Location",choices = c(" ",d$Locations)),
selectInput('slct2',"Select Year",choices = d$year),
actionButton('clear',"Reset Form"),
h4("Powered by:"),
tags$img(src='baka.png',height=50,width=50)
),
dashboardBody(
#fluidRow(
# box( DT::dataTableOutput("mytable")),
# box(plotlyOutput('out'))
conditionalPanel(
#Uses a Javascript formatted condition
condition="input.slct1 !== ' '",
#box(DT::dataTableOutput("mytable"),background = "maroon"),
tags$style(HTML("
.box.box-solid.box-primary>.box-header {
color:#fff;
background:##00C5CD
}
.box.box-solid.box-primary{
border-bottom-color:##00C5CD;
border-left-color:##00C5CD;
border-right-color:##00C5CD;
border-top-color:##00C5CD;
}")),
uiOutput("mytable"),
uiOutput("placeholder")
)
)
)
server<-function(input, output,session) {
output$mytable=renderUI({
box(title = paste("Selected Location: ",input$slct1),
output$aa<-DT::renderDataTable({
req(input$slct1)
d %>%
filter(Locations==input$slct1)%>%
filter(year==input$slct2)
}),status = "primary",solidHeader = T)
})
output$placeholder = renderUI({
req(input$slct1)
box(title = paste("Selected Location: ",input$slct1),plotlyOutput('out'),status = 'primary',solidHeader = T)
})
# output$mytable = DT::renderDataTable({
# req(input$slct1)
#d %>%
# filter(Locations==input$slct1)
#})
output$out<-renderPlotly({
req(input$slct1)
data_filter<-d %>%
filter(Locations==input$slct1)%>%
filter(year==input$slct2)
req(nrow(data_filter)>0)
ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=year)) +
geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))#+
#facet_grid(.~Locations, space= "free_x", scales = "free_x"))
})
observeEvent(input$clear,{
req(input$slct1)
updateSelectInput(session,"slct1",selected = ' ')
})
}
shinyApp(ui, server)
Ronak Shah
Code after Suggestion from Ben and Ronak Shah
library(shiny)
library(shinydashboard)
library(plotly)
d$year<-as.numeric(as.character(d$year))
resetForm<-function(session){
updateSelectInput(session,"slct1",selected = ' ')
}
ui<-dashboardPage(
dashboardHeader(title="System Tracker"),
dashboardSidebar(
selectInput('slct1',"Select Location",choices = c(" ",d$Locations)),
selectInput('slct2',"Select Year",choices = c("2018"="2018","2019"="2019","0"="No Use")),
actionButton('clear',"Reset Form"),
h4("Powered by:"),
tags$img(src='baka.png',height=50,width=50)
),
dashboardBody(
#fluidRow(
# box( DT::dataTableOutput("mytable")),
# box(plotlyOutput('out'))
conditionalPanel(
#Uses a Javascript formatted condition
condition="input.slct1 !== ' '",
#box(DT::dataTableOutput("mytable"),background = "maroon"),
tags$style(HTML("
.box.box-solid.box-primary>.box-header {
color:#fff;
background:##00C5CD
}
.box.box-solid.box-primary{
border-bottom-color:##00C5CD;
border-left-color:##00C5CD;
border-right-color:##00C5CD;
border-top-color:##00C5CD;
}")),
uiOutput("mytable"),
uiOutput("placeholder")
)
)
)
server<-function(input, output,session) {
output$mytable=renderUI({
box(title = paste("Selected Location: ",input$slct1),
output$aa<-DT::renderDataTable({
req(input$slct1)
# d %>%
# filter(Locations==input$slct1)%>%
#filter(year<=input$slct2)
data_filter<-function(d,loc,num) {
d %>%
filter(Locations==loc)%>%
filter(year <= num)
}
data_filter(d,input$slct1,input$slct2)
}),status = "primary",solidHeader = T)
})
output$placeholder = renderUI({
req(input$slct1)
box(title = paste("Selected Location: ",input$slct1),plotlyOutput('out'),status = 'primary',solidHeader = T)
})
output$out<-renderPlotly({
req(input$slct1)
# data_filter<-d %>%
# filter(Locations==input$slct1)%>%
# filter(year<=input$slct2)
data_filter<- function(d,loc, num) {
d %>%
filter(Locations==loc)%>%
filter(year <= num)
}
data_filter<-data_filter(d,input$slct1,input$slct2)
req(nrow(data_filter)>0)
ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=as.factor(year))) +
geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))#+
#facet_grid(.~Locations, space= "free_x", scales = "free_x"))
})
observeEvent(input$clear,{
req(input$slct1)
updateSelectInput(session,"slct1",selected = ' ')
})
}
shinyApp(ui, server)
推荐答案
根据您最近的代码，看来您想将d $ year与选中的输入（选择Year）进行比较。 d $ year是数字，而selectInput提供了一个字符串。如果在selectInput语句中包含数字值，似乎应该可以（让我知道）：
Based on your more recent code, it seems you want to compare d$year with the selected input (Select Year) in shiny. d$year is numeric, while selectInput provides a string. If you include numeric values in your selectInput statement, it seems it should work (let me know):
selectInput('slct2',"Select Year",choices = c("2018"=2018,"2019"=2019,"0"=0))
注意：如果您打算将Year = 0的选项读为 No Use，那么在selectInput中应将其设置为 No Use = 0：
Note: if you intended an option to read "No Use" for Year = 0, then it should be "No Use" = 0 in your selectInput:
selectInput('slct2',"Select Year",choices = c("2018"=2018,"2019"=2019,"No Use"=0))
编辑：根据我们的聊天记录，如果所选年份和位置的任何数据都存在。例如，如果选择 loc3和 2018，则不会显示任何数据，因为没有匹配该确切组合的行（即使存在 0年的数据）。但是，如果选择 loc3和 0，则会显示一行数据，因为有一行与 loc3和Year 0匹配。
Edit: Based on our chat, we only want to include prior years if any data exists for the selected year and location. For example, if select 'loc3' and '2018' it won't show any data, since there are no rows that match that exact combination (even though data exists for year '0'). However, if select 'loc3' and '0' then one row of data will be shown, as there is one row that matches 'loc3' and year 0.
data_filter方法在这里更新。它首先检查与位置和年份都匹配的数据。如果有数据，则它将返回该年和前几年的所有数据。如果没有数据，则它将返回NULL。 （或者，您可以返回一个空数据框，并使用无可用数据消息保留相同的变量---只需使用return（d [0，]）而不是NULL）。
The data_filter method is updated here. It first checks for data that match both location and year. If there is data, then it will return all data for that year and previous years. If there is no data, then it will return NULL. (Or, you can return an empty data frame, and keep same variables with message of 'no data available' --- just use return (d[0,]) instead of NULL).
也将只使用一个data_filter方法，而不是两个（在服务器<-函数（输入，输出，会话）声明之后的开头处）。
Also, would use only one data_filter method instead of two (put at the beginning right after your server <- function(input, output, session) declaration.
data_filter <- function (d,loc,num) {
if (nrow(d %>% filter(Locations == loc, year == num)) > 0) {
return (d %>% filter(Locations == loc, year <= num))
} else {
return (NULL)
}
}
让我知道这是否是您的想法和逻辑这是正确的完整服务器方法，其中d [0，]的返回值是无可用数据：
Let me know if this is what you had in mind and the logic is correct. Here is the full server method with d[0, ] returned for 'no data available':
server<-function(input, output,session) {
data_filter <- function (d,loc,num) {
if (nrow(d %>% filter(Locations == loc, year == num)) > 0) {
return (d %>% filter(Locations == loc, year <= num))
} else {
return (d[0,])
}
}
output$mytable=renderUI({
box(title = paste("Selected Location: ",input$slct1),
output$aa<-DT::renderDataTable({
req(input$slct1)
data_filter(d, input$slct1, input$slct2)
}),status = "primary",solidHeader = T)
})
output$placeholder = renderUI({
req(input$slct1)
box(title = paste("Selected Location: ",input$slct1),plotlyOutput('out'),status = 'primary',solidHeader = T)
})
output$out<-renderPlotly({
req(input$slct1)
data_filter<-data_filter(d,input$slct1,input$slct2)
req(nrow(data_filter)>0)
ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=as.factor(year))) +
geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))
})
observeEvent(input$clear,{
req(input$slct1)
updateSelectInput(session,"slct1",selected = ' ')
})
}
这篇关于如何在ShinyDashboard R中显示年初至今数据？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
