R闪亮部署在shinyApps.io上

Question

我正在研究 Shiny，但在部署 ShinyApps.io 时遇到了一些问题。当我在 R studio IDE 中运行该应用程序时完全正常，但无法在 shinyApps.io 上运行并显示：

ERROR: cannot open the connection

我已经将三个文件（ui、server、data.csv）发布到 shinyApps.io，但仍然无法工作。我认为是因为我在shinyApps.io上查看日志时无法读取数据，显示：

cannot open file 'C:\Users\User\Downloads\Category_dashboard\ads_test\rawdash.csv': No such file or directory

有人可以帮忙解决这个问题吗？

用户界面：

# package
library(shiny)
library(shinydashboard)
library(devtools)
library(xts)
library(dplyr)
library(ggplot2)
library(dplyr)
library(DT)
library(readxl)
# graphic
library(streamgraph)
library(treemap)
library(bubbles)
library(googleVis)
library(dygraphs)
# share to server
library(rsconnect)
library(RJSONIO)

# read data
dash_path <- file.path("C:\\Users\\User\\Downloads\\Category_dashboard\\ads_test\\rawdash.csv")
dash <- read.csv(dash_path,
                 colClasses = c("character","character","character","character","character","character","numeric","numeric"))

# app
ui <- dashboardPage(skin="black", 
                    dashboardHeader(title = "Segment Dashboard", titleWidth = 300),

                    dashboardSidebar(selectInput("c1_input", label = "Segment", 
                                                 choices = c(unique(dash$c1)), multiple = TRUE),
                                     selectInput("c2_input", label = "Sub-segment", 
                                                 choices = c("All", unique(dash$c2)), multiple = TRUE),
                                     selectInput("c3_input", label = "Sub-sub-segment", 
                                                 choices = c("All", unique(dash$c3)), multiple = TRUE),
                                     selectInput("geo_input", label = "Country", 
                                                 choices = c("All", unique(dash$geo)), multiple = TRUE),
                                     selectInput("d1_input", label = "Device", 
                                                 choices = c("All", unique(dash$device)), multiple = TRUE)
                                     #uiOutput("c1_output"),
                                     #uiOutput("c2_output"),
                                     #uiOutput("c3_output"),
                                     #uiOutput("geo_output"),
                                     #uiOutput("d1_output")
                    ),
                    dashboardBody(fluidRow(valueBoxOutput("UserBox"),
                                           valueBoxOutput("SessionBox"),
                                           downloadButton("download_data", "Download")),
                                  br(),
                                  plotOutput("bar", height = 250, width = 925),
                                  br(),
                                  DT::dataTableOutput("table")
                    )
)

服务器

server <- function(input, output, session){
  # load data
  dash_path <- file.path("C:\\Users\\User\\Downloads\\Category_dashboard\\ads_test\\rawdash.csv")
  dash <- read.csv(dash_path,
                   colClasses = c("character","character","character","character","character","character","numeric","numeric"))  

  # total user
  output$UserBox <- renderValueBox({valueBox(format(sum(dash$nb_user)),
                                             "Total User", icon = icon("area-chart"), color = "green")
  })
  # filtered user
  output$SessionBox <- renderValueBox({valueBox(format(sum((filtered()$nb_user))),
                                                "Segment User", icon = icon("shopping-cart"), color = "green")
  })

  # download output
  output$download_data <- downloadHandler(
    filename <- function(){
      sprintf("download.csv", Sys.Date())
    },
    content <- function(filename){
      dash <- filtered()
      write.csv(dash, file = filename, row.names = FALSE)
    }
  )

  ## UI
  #output$c1_output <- renderUI({
  #selectInput("c1_input", label = "Segment", choices = c("All" = "", unique(dash$c1)), multiple = TRUE)})
  #output$c2_output <- renderUI({
  #selectInput("c2_input", label = "Sub-segment", choices = c("All" = "", unique(filtered()$c2)), multiple = TRUE)})
  #output$c3_output <- renderUI({
  #selectInput("c3_input", label = "Sub-sub-segment", choices = c("All" = "", unique(filtered()$c3)), multiple = TRUE)})
  #output$geo_output <- renderUI({
  #selectInput("geo_input", label = "Country", choices = c("All" = "", unique(filtered()$geo)), multiple = TRUE)})
  #output$d1_output <- renderUI({
  #selectInput("d1_input", label = "Device", choices = c("All" = "", unique(filtered()$device)), multiple = TRUE)})
  #output$d2_output <- renderUI({
  #selectInput("d2_input", label = "Device Type", choices = c("All" = "", unique(filtered()$sub_device)), multiple = TRUE)})

  ## update selection  
  observe({
    c2_input <- if (is.null(input$c1_input)) character(0) else {
      filter(dash, c1 %in% input$c1_input) %>%
        `$`('c2') %>%
        unique() %>%
        sort()
    }
    stillSelected <- isolate(input$c2_input[input$c2_input %in% c2_input])
    updateSelectInput(session, "c2_input", choices = c2_input, selected = stillSelected)
  })

  observe({
    c3_input <- if (is.null(input$c1_input)) character(0) else {
      dash %>%
        filter(c1 %in% input$c1_input,
               c2 %in% input$c2_input) %>%
        `$`('c3') %>%
        unique() %>%
        sort()
    }
    stillSelected <- isolate(input$c3_input[input$c3_input %in% c3_input])
    updateSelectInput(session, "c3_input", choices = c3_input, selected = stillSelected)
  })

  observe({
    geo_input <- if (is.null(input$c1_input)) character(0) else {
      dash %>%
        filter(c1 %in% input$c1_input,
               c2 %in% input$c2_input,
               c3 %in% input$c3_input) %>%
        `$`('geo') %>%
        unique() %>%
        sort()
    }
    stillSelected <- isolate(input$geo_input[input$geo_input %in% geo_input])
    updateSelectInput(session, "geo_input", choices = geo_input, selected = stillSelected)
  })

  observe({
    d1_input <- if (is.null(input$d1_input)) character(0) else {
      dash %>%
        filter(c1 %in% input$c1_input,
               c2 %in% input$c2_input,
               c3 %in% input$c3_input,
               deo %in% input$deo_input) %>%
        `$`('device') %>%
        unique() %>%
        sort()
    }
    stillSelected <- isolate(input$d1_input[input$d1_input %in% d1_input])
    updateSelectInput(session, "d1_input", choices = d1_input, selected = stillSelected)
  })

  ## data for filtered user and download
  filtered <- reactive({
    subset(dash, c1 == input$c1_input)
  })

  ## plot
  output$bar <- renderPlot({
    p <- ggplot(filtered()) +
      geom_bar(aes(x = c1, y = nb_user, fill = c1), position="dodge", stat= "identity") +
      theme(legend.position="top", legend.title=element_blank()) + 
      theme(axis.ticks = element_blank(), axis.title.x = element_blank(), axis.line = element_blank()) +
      theme(axis.text.x= element_text(face= "bold", size= 10), axis.text.y= element_text(face= "bold", size= 10)) +
      theme(strip.background = element_blank(), strip.text = element_blank()) +
      labs(x= "", y= "", title= "")
    print(p)
  })


  ## table
  #output$table <- renderUI({
  output$table <- DT::renderDataTable({
    filtered <- dash %>%
      filter(c1 %in% input$c1_input,
             c2 %in% input$c2_input,
             c3 %in% input$c3_input,
             geo %in% input$geo_input)
    DT::datatable(filtered, escape = FALSE)
  })

  #if (input$c1_input != "All") {
  #  dash <- dash[dash$c1 == input$c1_input,]
  #  }
  #if (input$c2_input != "All") {
  #  dash <- dash[dash$c2 == input$c2_input,]
  #  }
  #if (input$c3_input != "All") {
  #  dash <- dash[dash$c3 == input$c3_input,]
  #  }
  #dash
  #})
}

Answer 1

问题在于您引用的是文件位置，因为它位于本地计算机上。服务器上不存在此文件路径。解决方案是使用文件位置中的相对路径。

Answer 2

应用程序无法运行，因为您的文件路径设置为 shinyapps.io 服务器上不存在的路径。在工作目录之外创建一个子目录，用于存放您要包含的文件的位置。如果您不确定工作目录是什么，请使用getwd() 来获取它。将您的文件放在该目录中。在本例中，我们将使用名称“directoryname”，但可以使用您喜欢的任何名称。将路径行更改为：dash_path <- file.path("directoryname\rawdash.csv") 此外，尽管它可能有效，但出于效率和可用性的原因，在闪亮的输出中创建函数通常是不好的做法。例如，如果您希望所有会话都可以使用函数，则它们需要在闪亮的server() 调用之外运行。