r - shinydashboard 中的仪表板

Question

我是第一次使用 shinydashboard，它很棒。但是我陷入了一个奇怪的问题。我有以下代码在我的浏览器上运行。然而，当部署在 shinyapps.io 上时，它只是拒绝工作。我提供了下面的代码。仪表板旨在做 3 件事:
1.可视化因变量
2.自动用红色垂直线在图表上用日期虚拟标记尖峰
3.查看选择的自变量和虚拟变量

这是 shinyapps.io 中应用程序的链接 http://rajarshibhadra.shinyapps.io/Test_Doubts

代码如下

ui.R
library(shiny)
library(shinydashboard)
library(dygraphs)
dashboardPage(
  dashboardHeader(title="Dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard",tabName="dashboard",icon=icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
              fluidRow(
                column(12,
                       box(title = "Plot Dependant", status = "primary", solidHeader = TRUE,
                           collapsible = TRUE,
                           dygraphOutput("final_plot",width = "100%", height = "300px"),width=8),
                       box(title="Model Specifications",status="warning",solidHeader= TRUE,
                           collapsible= TRUE,
                           uiOutput("mg"),width=4
                       )),
                column(12,
                       tabBox(title="Independants and Dummies",
                              tabPanel("Independants",verbatimTextOutput("modelvars")),
                              tabPanel("Dummies",verbatimTextOutput("modeldummies")),width=8
                       ),
                       box(title = "Inputs", status = "warning", solidHeader = TRUE,
                           collapsible = TRUE,
                           uiOutput("dependant"),
                           uiOutput("independant"),
                           uiOutput("dummies"),
                           sliderInput("spikes","Magnitude of strictness of crtiteria for spike",min=1,max=5,value=3,step=1),
                           sliderInput("dips","Magnitude of strictness of crtiteria for dips",min=1,max=5,value=3,step=1),width=4)

                ))

      )

    )
  ))


server.R

library(shiny)
library(stats)
library(dplyr)
library(dygraphs)

##
library(shinydashboard)
function(input, output) {

  raw_init<-data.frame(wek_end_fri=c("06Jul2012","13Jul2012","20Jul2012","27Jul2012","03Aug2012","06Jul2012","13Jul2012","20Jul2012","27Jul2012","03Aug2012"),
             Var1=c(468.9,507.1,447.1,477.1,452.6,883113.7,814778.0,780691.2,793416.6,833959.6),
             Var2=c(538672.6,628451.4,628451.4,628451.4,359115.8,54508.8,56036.1,57481.0,58510.0,59016.7),       
             MG= c("Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat1","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2","Cat2")
             )


  #Select Category
  output$mg<-renderUI({
    selectInput("Category","Select Category",c("Cat1","Cat2"))
  })
  raw_init_filter<-reactive({
    filter(raw_init,MG == input$Category)
  })

  #Interpret Date
  raw_init_date<-reactive({
    mutate(raw_init_filter(),wek_end_fri=as.Date(wek_end_fri,"%d%b%Y"))
  })

  #Get variable Names
  Variable_list<-reactive({
    colnames(raw_init_date())
  })
  #Get potential dummy list
  Dummy_List<-reactive({
    raw_init_date()$wek_end_fri
  })
  #Load dependant
  output$dependant<-renderUI({
    selectInput("deplist","Select Dependant Variable",Variable_list(),selected="Var1")
  })
  #load independant
  output$independant<-renderUI({
    selectInput("indeplist","Select Independant Variable",Variable_list(),multiple=TRUE)
  })
  #Sepereate out Dependant
  dep<-reactive({
    raw_init_date()[input$deplist]
  })

  #Spike detection
  plot_data<-reactive({
    data.frame(Time=raw_init_date()$wek_end_fri,dep())
  })
  plot_data_mut<-reactive({
    f <- plot_data()
    colnames(f)[colnames(f)==input$deplist] <- "Volume"
    f
  })
  dep_vec<-reactive({
    as.vector(plot_data_mut()$Volume)
  })
  #Calculating mean
  dep_mean<-reactive({
    mean(dep_vec())
  })
  dep_sd<-reactive({
    sd(dep_vec())
  })
  transformed_column<-reactive({
    (dep_vec()-dep_mean())/dep_sd()
  })
  detected_index_spike<-reactive({
    which(transformed_column()>input$spikes/2)
  })
  detected_index_trough<-reactive({
    which(transformed_column()<(input$dips/(-2)))
  })
  detected_index<-reactive({
    c(detected_index_spike(),detected_index_trough())
  })
  detected_dates<-reactive({
    raw_init_date()$wek_end_fri[detected_index()]
  })

  output$dummies<-renderUI({
    validate(
      need(raw_init, 'Upload Data to see controls and results')
    )
    selectInput("dummies","Suggested Dummy Variable",as.character(Dummy_List()),selected=as.character(detected_dates()),multiple=TRUE)
  })
  indlist<-reactive({
    data.frame(Independant_Variables=input$indeplist)
  })
  output$modelvars<-renderPrint({
    indlist()
  })
  dumlist<-reactive({
    data.frame(Dummies=paste("Dummy_",as.character(format(as.Date(input$dummies,"%Y-%b-%d"),"%d%b%y")),sep=""))
  })
  output$modeldummies<-renderPrint({
    dumlist()
  })



  #-----------------------------------------------------------------------------------------#
  library(xts)
  plot_data_xts<-reactive({
    xts(dep(),order.by=as.Date(raw_init_filter()$wek_end_fri,"%d%b%Y"))
  })

  ##
  getDates <- reactive({
    as.character(input$dummies)
  })
  addEvent <- function(x,y) {
    dyEvent(
      dygraph=x,
      date=y,
      "", 
      labelLoc = "bottom",
      color = "red", 
      strokePattern = "dashed")
  }
  basePlot <- reactive({ 
    if (length(getDates()) < 1) {
      dygraph(
        plot_data_xts(),
        main="Initial Visualization and dummy detection") %>%
        dyAxis(
          "y", 
          label = "Volume") %>%
        dyOptions(
          axisLabelColor = "Black",
          digitsAfterDecimal = 2,
          drawGrid = FALSE)
    } else {
      dygraph(
        plot_data_xts(),
        main="Initial Visualization and dummy detection") %>%
        dyAxis(
          "y", 
          label = "Volume") %>%
        dyOptions(
          axisLabelColor = "Black",
          digitsAfterDecimal = 2,
          drawGrid = FALSE) %>%
        dyEvent(
          dygraph=.,
          date=getDates()[1],
          "", 
          labelLoc = "bottom",
          color = "red", 
          strokePattern = "dashed")
    }
  })
  ##

  output$final_plot <- renderDygraph({

    res <- basePlot()
    more_dates <- getDates()
    if (length(more_dates) < 2) {
      res
    } else {
      Reduce(function(i,z){
        i %>% addEvent(x=.,y=z)
      }, more_dates[-1], init=res)
    }

  })






}

Answer 1

您的应用 https://rajarshibhadra.shinyapps.io/Test_Doubts/在“Plot Dependant”框中显示以下错误消息:

Error: can not calculate periodicity of 1 observation

我已加载您的脚本并在本地运行应用程序:我能够重现它并获得相同的错误消息。

这是由于 as.Date 转换:%b 未转换导致 xts 和 dygraph 包中的 NA。这是由于语言环境(请参阅 here 和 here )。

通过使用更常见的日期规范(例如“%d/%m/%Y”)可以轻松修复:

  raw_init<-data.frame(wek_end_fri=c("06/07/2012","13/07/2012","20/07/2012","27/07/2012","03/08/2012","06/07/2012","13/07/2012","20/07/2012","27/07/2012","03/08/2012"),

和

 #Interpret Date
  raw_init_date<-reactive({
    mutate(raw_init_filter(),wek_end_fri=as.Date(wek_end_fri,"%d/%m/%Y"))
  })

和

  dumlist<-reactive({
    data.frame(Dummies=paste("Dummy_",as.character(format(as.Date(input$dummies,"%d/%m/%Y"),"%d/%m/%Y")),sep=""))
  })
  output$modeldummies<-renderPrint({
    dumlist()
  })

#-----------------------------------------------------------------------------------------#

  library(xts)
  plot_data_xts<-reactive({
    xts(dep(),order.by=as.Date(raw_init_filter()$wek_end_fri,"%d/%m/%Y"))
  })

生成的应用程序在这里:https://faidherbard.shinyapps.io/Test_Doubts/