我的闪亮应用中遇到问题。所有输入显示来自服务器的正确响应，但是当我选中复选框组中的选项5时，应用程序返回正确的内容。但之后，当我尝试其他输入时，只显示框（dyplot1）的更新，并且其他框（dyplot2和预测）保持静态。这是一个示例代码：
# funciones ----
addDays <- function(data,date,days) {
for(i in 1:days){
data[length(data)+1] <- NA
date[length(date)+1] <- date[length(date)]+1
}
y <- xts(data,order.by = date)
return(y)
}
addDaysForecast <- function(forecast,date,days) {
data <- rep(NA,length(date))
for(i in 1:days){
data[length(data)+1] <- forecast[i]
date[length(date)+1] <- date[length(date)]+1
}
y <- xts(data,order.by = date)
return(y)
}
plotForecast <- function(table,forecast) {
days <-length(forecast)
date <-as.Date(table[,"ENTRYTIME"])
values <- as.numeric(table[,"CLOSINGPRICE"])
series <- addDays(values,date,days)
serieForecast <- addDaysForecast(forecast,date,days)
day1 <- date[length(date)-days*2]
day2 <- date[length(date)]+7
curvas <- cbind(series,serieForecast)
graf <- dygraph(curvas, main = table[1,1]) %>%
dySeries("..1", label = "datos", color = "black") %>%
dySeries("..2", label = " Forecast", stepPlot = TRUE, color = "green") %>%
dyAxis("y", label = "CLOSINGPRICE") %>%
dyCrosshair(direction = "vertical") %>%
dyRangeSelector(dateWindow = c(day1, day2)) %>%
##dyOptions(maxNumberWidth = 20, stackedGraph = FALSE) %>%
dyLegend(width = 400) %>%
dyHighlight(highlightCircleSize = 3,
highlightSeriesBackgroundAlpha = 0.2,
hideOnMouseOut = FALSE) %>%
dyRangeSelector()
return(graf)
}
plotNormal <- function(table,thing) {
date <-as.Date(table[,"ENTRYTIME"])
values <- as.numeric(table[,thing])
series <- xts(values, order.by = date)
ma1 <- xts(runMean(values, n = 6),order.by = date)
ma2 <- xts(runMean(values, n = 12),order.by = date)
ma3 <- xts(runMean(values, n = 20),order.by = date)
mv1 <- xts(runVar(values, n = 6), order.by = date)
mv2 <- xts(runVar(values, n = 12), order.by = date)
mv3 <- xts(runVar(values, n = 20), order.by = date)
ske1 <- xts(movskew(values,6), order.by = date)
ske2 <- xts(movskew(values,12), order.by = date)
ske3 <- xts(movskew(values,20), order.by = date)
curvas <- cbind(series,ma1,ma2,ma3,mv1,mv2,mv3,ske1,ske2,ske3)
graf <- dygraph(curvas, main = table[1,1], group = "ALL") %>%
dySeries("..1", label = "datos", color = "black") %>%
dySeries("..2", label = "Ma6", color = "red") %>%
dySeries("..3", label = "Ma12", color = "blue") %>%
dySeries("..4", label = "Ma20", color = "green") %>%
dySeries("..5", label = "Mv6",strokePattern = "dashed",axis = 'y2', color = "red") %>%
dySeries("..6", label = "Mv12",strokePattern = "dashed",axis = 'y2', color = "blue") %>%
dySeries("..7", label = "Mv20",strokePattern = "dashed",axis = 'y2',color = "green") %>%
dySeries("..8", label = " as 6", stepPlot = TRUE, color = "red") %>%
dySeries("..9", label = " as 12", stepPlot = TRUE, color = "blue") %>%
dySeries("..10", label = " as 20", stepPlot = TRUE, color = "green") %>%
dyAxis("y", label = thing) %>%
dyCrosshair(direction = "vertical") %>%
##dyOptions(maxNumberWidth = 20, stackedGraph = FALSE) %>%
dyLegend(width = 400) %>%
dyHighlight(highlightCircleSize = 3,
highlightSeriesBackgroundAlpha = 0.2,
hideOnMouseOut = FALSE) %>%
dyRangeSelector()
return(graf)
}
status <- function(table,forecast) {
test <- table[nrow(table)-1:nrow(table),]
last <- test[,"CLOSINGPRICE"]
if(length(forecast)==1|| forecast==-1 ){
return(("No se a realizado predicción para este nemo"))
}else if (last<forecast[1]){
return(paste("A la alza con precio de cierre: ",forecast[1]))
}else if(last>forecast[1]){
return(paste("A la baja con precio de cierre: ",forecast[1]))
}
}
##skewness moving
movskew <- function(values,n) {
values2 <- values
for(i in 1:n){
values2[i] <- NA
}
num <- n
for(i in 1:(length(values)-n)){
num <- num + 1
values2[num] <- as.numeric(skewness(values[i:num]))
}
return(values2)
}
whatshow <- function(array) {
showthis <- vector()
for(i in 1:5){
showthis[i] <- any(array==i)
}
return(showthis)
}
getforecast <- function(path) {
url <- paste0("http://192.168.1.9:3169/api/forecast/", path, "?format=json")
response <- jsonlite::fromJSON(url)
if(length(response)>1){
return(response$forecast)
}else{
return(-1)
}
}
whatPlot <- function(table,name,show,thing) {
if(show[5]==TRUE){
fore <- getforecast(name)
plotForecast(table,fore)
}else{
plotNormal(table,thing) %>%
dyVisibility(visibility=c(show[1],
rep(show[2],3),
rep(show[3],3),
rep(show[4],3)))
}
}
dyVisibility <- function (dygraph, visibility = TRUE){
dygraph$x$attrs$visibility <- visibility
dygraph
}
#creando la tabla de prueba
table <- data.frame(matrix(1, nrow = 100, ncol = 18))
nombres <- c("SYMBOL" ,
"BOOKING_REF_ID",
"BIDQTY",
"BIDPRICE",
"OFFERQTY",
"OFFERPRICE",
"TRADEQTY",
"TRADEPRICE",
"OPENINGPRICE",
"CLOSINGPRICE",
"HIGHPRICE",
"LOWPRICE",
"VWAPPRICE",
"IMBALANCE",
"VOLUME",
"AMOUNT",
"TREND",
"ENTRYTIME")
colnames(table) <- nombres
table$ENTRYTIME <-seq.POSIXt(as.POSIXct("2015-01-01", tz="GMT"),
as.POSIXct("2015-4-10", tz="GMT"), by="1 day")
# estructura pagina ----
header <- dashboardHeader(title = "Basic dashboard")
sidebar <- dashboardSidebar( collapsed = TRUE,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
)
body <- dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(width = 9,
box(title = "Grafico 1", status = "primary", width = NULL,
solidHeader = TRUE, collapsible = TRUE,
dygraphOutput("dyPlot1",height = "300px")),
box(title = "Grafico 2", status = "primary", width = NULL,
solidHeader = TRUE, collapsible = TRUE,
dygraphOutput("dyPlot2",height = "300px"))
),
column(width = 3,
box(title = "Inputs", status = "warning", solidHeader = TRUE, width = NULL,
selectInput("var1",
label = "1) variable",
choices = nombres[3:16],
selected = "CLOSINGPRICE"),
selectInput("var2",
label = "2) variable",
choices = nombres[3:16],
selected = "VOLUME"),
checkboxGroupInput("checkGroup", label = h3("Ver:"),
choices = list("Datos" = 1, "Medias" = 2,
"Esperanzas" = 3,"Asimetrias"=4, "Forecast"=5),
selected = 1),
box(title = "Predicción",status = "warning", solidHeader = TRUE, width = NULL,
verbatimTextOutput("prediction"))
)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# app ----
app <- shinyApp(
#UI
ui <- dashboardPage(header,sidebar,body),
server <- function(input, output) {
observeEvent(input$checkGroup, {
#... # do some work
output$prediction <- renderText({
forecast <- getforecast("CAMANCHACA")
status(table,forecast)
})
#... # do some more work
})
output$dyPlot1 <- renderDygraph({
show <- whatshow(input$checkGroup)
whatPlot(table,"CAMANCHACA",show,input$var1)
})
output$dyPlot2 <- renderDygraph({
show <- whatshow(input$checkGroup)
whatPlot(table,"CAMANCHACA",show,input$var2)
})
}
)
# Run the app ----
runApp(app,host="0.0.0.0",port=3838)