这个问题让我很困惑。我希望data3在data3c为2017且input$SelectedYear为“4月”且input$SelectedMon与data3相关联时data31为observe()链接
我想使用library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Data"),
# Sidebar with a slider input for number of bins
selectInput("SelectedYear", "Choose a Year:",
choices =
c(2009, 2010,2015,2016,2016,2017)),
uiOutput("selectionMon"),
uiOutput("selectionFY"),
# Show a plot of the generated distribution
mainPanel(
tableOutput("distPlot")
)
)
)
函数来实现它，但代码无效。
ui.r：
library(shiny)
## data31 (Historical data)
PeriodYear<-c(2009, 2010,2015,2016,2016,2017,2017,2017,2017,2017)
PeriodMon<-c("Jan","Apr","Jul","Sep","Dec","Jan","Feb","Mar","Apr","Apr")
YARD_ID<-c(33,25,47,13,64,24,26,36,34,89)
Value<-c(1,3,6,2,4,6,7,2,3,1)
dataall<-data.frame(PeriodYear,PeriodMon,YARD_ID,Value)
dataall$PeriodMon<-as.character(dataall$PeriodMon)
data31<-dataall[which(dataall$PeriodYear!=2017 | dataall$PeriodMon!="Apr"),]
## data3c (current month)
data3c<-dataall[which(dataall$PeriodYear==2017 & dataall$PeriodMon=="Apr"),]
data3<-data31
current_year<-2017
current_mon<-"Apr"
# data3<-data31
# Define server logic required to draw a histogram
shinyServer(function(input, output,session) {
observe({
data3<-data31
if (!is.null(data3)) {
if (length(data3) > 0) {
if (!is.null(input$SelectedYear) & !is.null(input$SelectedMon) ) {
if ( (input$SelectedYear > 0) & (input$SelectedMon > 0 ) ){
Year_input <- isolate(input$SelectedYear)
Mon_input <- isolate(input$SelectedMon)
Id.Year <- which(current_year == Year_input)
Id.Mon <- which(current_mon == Mon_input)
if (length(Id.Year) > 0 & length( Id.Mon) > 0 ) {
data3<-data3c
}
}
}
}
}
})
output$distPlot <- renderTable({
head(dataselect())
})
######## UI input of month #####
output$selectionMon<-renderUI({
Mondata1<-data3[which(data3$PeriodYear==input$SelectedYear),]
selectInput("SelectedMon", "Choose a Month:",
choices = names(table(data.frame(Mondata1$PeriodMon))))
})
##### End of input of month ####
######## UI input of FeedYard #####
output$selectionFY<-renderUI({
FYdata<-data3[which(data3$PeriodYear==input$SelectedYear &
data3$PeriodMon==input$SelectedMon),]
selectInput("SelectedFY", "Choose a ID:",
choices =names(table(data.frame(FYdata$YARD_ID))))
})
dataselect<-reactive({
data3[which(data3$PeriodYear==input$SelectedYear &
data3$PeriodMon==input$SelectedMon & data3$YARD_ID==input$SelectedFY),]
})
#####
})
server.r：
data3其他一切正常，只有data31在2017年4月选择时没有切换（data3c}到{{1}}。
我感谢任何回复！
谢谢！
答案 0 :(得分：1)
看看下面的代码，那种工作。
不幸的是，由于我处于完全＆＃34;调试模式＆＃34;，在我进行实验时，我对代码做了更多修改而不是合理的。
例如，我在过去发生在我身上的一个典型问题上浪费了很多时间。
当你有一个选择器时，总是很好的做法是＆＃34;派生＆＃34;他们来自实时数据。例如，一年选择器可能来自您data31选择unique(data31$PeriodYear)或类似的东西。
实际上我浪费了时间，因为数据中没有多年没有，这显然不被应用程序所喜欢。我的坏！
另一个类似的建议是，在进行子集化之前检查所选年份（在此示例中）是否实际 数据（特别是当您有大量过滤器时很容易对发生的事情进行了松散的跟踪。）
还有一个问题：observeEvent据我所知，主要是针对一种被动状态（我不确定这一点，我可能会在闪亮的邮件列表上发布一个问题，看看我是否可以得到任何确认）。为了避免半支持解决方案，我决定恢复旧观察，在那里你可以拥有任意数量的被动触发器。如果我找到不同的东西，我会通知你。
library(shiny)
rm(list=ls())
## data31 (Historical data)
PeriodYear<-c(2009, 2010,2015,2016,2016,2017,2017,2017,2017,2017)
PeriodMon<-c("Jan","Apr","Jul","Sep","Dec","Jan","Feb","Mar","Apr","Apr")
YARD_ID<-c(33,25,47,13,64,24,26,36,34,89)
Value<-c(1,3,6,2,4,6,7,2,3,1)
dataall <- data.frame(PeriodYear,PeriodMon,YARD_ID,Value,
stringsAsFactors = F)
# dataall$PeriodMon<-as.character(dataall$PeriodMon)
data31<-dataall[which(dataall$PeriodYear!=2017 | dataall$PeriodMon!="Apr"),]
## data3c (current month)
data3c<-dataall[which(dataall$PeriodYear==2017 & dataall$PeriodMon=="Apr"),]
data3<-data31
current_year<-2017
current_mon<-"Apr"
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Data"),
column(4,
# Sidebar with a slider input for number of bins
selectInput("SelectedYear", "Choose a Year:",
choices =
c(2009,2010,2015,2016,2017))
,uiOutput("selectionMon"),
uiOutput("selectionFY")
),
column(8,
# Show a plot of the generated distribution
mainPanel(
tableOutput("distPlot")
)
) )
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
if (length(input$SelectedYear) == 0 | is.null(input$SelectedMon) ) return()
if(input$SelectedMon == "" ) return()
data3 <<- data3 <- data31
if (is.null(data3) | length(data3) == 0) return()
isolate({
Year_input <- input$SelectedYear
Mon_input <- input$SelectedMon
Id.Year <- which(current_year == Year_input)
Id.Mon <- which(current_mon == Mon_input)
if (length(Id.Year) > 0 & length( Id.Mon) > 0 ) data3<<-data3c
}) # end isolate
})
output$distPlot <- renderTable({
head(dataselect())
})
######## UI input of month #####
output$selectionMon<-renderUI({
if (length(input$SelectedYear) == 0 ) return()
Mondata1<-data3[which(data3$PeriodYear==input$SelectedYear),]
selectInput("SelectedMon", "Choose a Month:",
choices = names(table(data.frame(Mondata1$PeriodMon))))
})
##### End of input of month ####
######## UI input of FeedYard #####
output$selectionFY<-renderUI({
if(length(input$SelectedYear) ==0 | length(input$SelectedMon) == 0 ) return()
FYdata<-data3[which(data3$PeriodYear==input$SelectedYear &
data3$PeriodMon==input$SelectedMon),]
selectInput("SelectedFY", "Choose a ID:",
choices =names(table(data.frame(FYdata$YARD_ID))))
})
dataselect<-reactive({
if(length(input$SelectedYear) ==0 | length(input$SelectedMon) == 0 |
length(input$SelectedFY) == 0) return()
isolate({
data3[which(data3$PeriodYear==input$SelectedYear &
data3$PeriodMon==input$SelectedMon & data3$YARD_ID==input$SelectedFY),]
}) #end isolate
})
#####
}
shinyApp(ui = ui, server = server)
如果这对你有用，请告诉我。