问题
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.
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.
Provide explanation with code.
Dataset:
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")
Code before Suggestion by Ben and 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)
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)
回答1:
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))
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))
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.
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).
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)
}
}
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 = ' ')
})
}
来源：https://stackoverflow.com/questions/57438355/how-to-display-year-to-date-data-in-shinydashboard-r