Warning: file_get_contents(/data/phpspider/zhask/data//catemap/8/magento/5.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
部署到shinyapps.io时rcdimple出错_Shiny_Rstudio_Shiny Server_Dimple.js - Fatal编程技术网

部署到shinyapps.io时rcdimple出错

部署到shinyapps.io时rcdimple出错,shiny,rstudio,shiny-server,dimple.js,Shiny,Rstudio,Shiny Server,Dimple.js,我有一个在本地运行良好的应用程序,我想将其部署到shinyapps.io。我创建了一个目录(dataviz),应用程序代码位于一个名为app.R的文件中。从RStudio运行deployApp(“dataviz”)时,它开始部署,但到达某个点时失败,并出现以下错误: ** preparing package for lazy loading Error in loadNamespace(i, c(lib.loc, .libPaths()), versionCheck = vI[[i]]) :

我有一个在本地运行良好的应用程序,我想将其部署到shinyapps.io。我创建了一个目录(dataviz),应用程序代码位于一个名为app.R的文件中。从RStudio运行deployApp(“dataviz”)时,它开始部署,但到达某个点时失败,并出现以下错误:

** preparing package for lazy loading
Error in loadNamespace(i, c(lib.loc, .libPaths()), versionCheck = vI[[i]]) : 
there is no package called ‘htmltools’
ERROR: lazy loading failed for package ‘rcdimple’
* removing ‘/usr/local/lib/R/site-library/rcdimple’
################################### End Log ################################### 
Error: Unhandled Exception: Child Task 27328802 failed: Error building image: Error building rcdimple (0.1). Build exited with non-zero status: 1
不知道这里会发生什么,非常感谢您的帮助

app.R也是如此

## app.R ##



library(shinydashboard)
library(shiny)
require(htmltools)
require(htmlwidgets)
library(rcdimple) #devtools::install_github("timelyportfolio/rcdimple")
library(curl)  #devtools::install_github("jeroenooms/curl")
library(plyr)  # for round_any
library(rCharts)
library(ggvis)
library(reshape2)

indicators <- read.csv(curl("https://raw.githubusercontent.com/kilimba/msc-impl-R/master/dataviz/data/testindicators.csv"))
choices <- as.vector(indicators$label)
indicators$label <- as.character(indicators$label)
indicators$file <- paste("",indicators$file,"",sep="")

getHeatMapData <- function(data,indicator){
  df <- data

  if(indicator$rate == "Y"){

    hmap_df <- aggregate(cbind(denominator,numerator) ~ year + agegrp,df,sum)
    hmap_df$rate <- round((hmap_df$numerator/hmap_df$denominator)*indicator$multiplier,2)
    names(hmap_df)

  }else{  
    hmap_df <- aggregate(denominator ~ agegrp + year,df, sum)     
  }

  hmap_df$year <- factor(hmap_df$year)

  # Helps to order the y-axis labels otherwise labels appear in mixed order
  hmap_df$agegrp <- factor(hmap_df$agegrp, levels = rev(as.vector(unique(hmap_df$agegrp))))
  return(hmap_df)

}


getData <- function(startyr,endyear,outcome_data) {
  data <- subset(outcome_data,(year >= startyr & year <= endyear))

  return(data)
} 
getDataByAgeGroup <-function(data,agegrp){  

  d <- data 
  a <- agegrp

  selection <- subset(d,agegrp==a) 
  return(selection)
} 

lineChart <- function(data,agegrp,indicator){ 

  if(indicator$rate == "Y"){

    selection <- data
    selection$rate <- round((selection$numerator/selection$denominator)*indicator$multiplier,2)
    selection$sex <- ifelse(selection$sex == 1, "MALE", "FEMALE")
    max_y <- round_any(max(selection$rate), 10, f = ceiling)   
    min_y <- round_any(min(selection$rate), 10, f = floor)    
    selection <- getDataByAgeGroup(selection,agegrp)

    plot <- nPlot(rate ~ year,
                  data = selection,
                  type = "lineChart",
                  group = "sex",
                  height = 250,
                  width = 450 )    

    # Explicitly set year tick values for every year
    plot$xAxis(tickValues = do.call(seq, c(as.list(range(selection$year)), 1)),rotateLabels= -40,showMaxMin = "true")

    plot$chart(useInteractiveGuideline = "true", transitionDuration = 500)  

    plot$chart(forceY = c(min_y, max_y))
    plot$chart(color = c("steelblue","firebrick"))
    # Add axis labels and format the tooltip
    plot$yAxis(axisLabel = paste("Rate per",indicator$multiplier), width = 62)

    plot$xAxis(axisLabel = "Year")

    return(plot)     


  }else{
    selection <- data
    selection$sex <- ifelse(selection$sex == 1, "MALE", "FEMALE")
    max_y <- round_any(max(selection$denominator), 10, f = ceiling)   
    min_y <- round_any(min(selection$denominator), 10, f = floor)    
    selection <- getDataByAgeGroup(selection,agegrp)

    plot <- nPlot(denominator ~ year,
                  data = selection,
                  type = "lineChart",
                  group = "sex",
                  height = 250,
                  width = 450 )    

    # Explicitly set year tick values for every year
    plot$xAxis(tickValues = do.call(seq, c(as.list(range(selection$year)), 1)),rotateLabels= -40,showMaxMin = "true")

    plot$chart(useInteractiveGuideline = "true", transitionDuration = 500)  

    plot$chart(forceY = c(min_y, max_y))
    plot$chart(color = c("steelblue","firebrick"))
    # Add axis labels and format the tooltip
    plot$yAxis(axisLabel = "Population", width = 62)

    plot$xAxis(axisLabel = "Year")

    return(plot)    
  }    
}
# Heat Map

heatmap <- function(data,indicator){
  dat <- getHeatMapData(data,indicator)

  if(indicator$rate == "Y"){   

    dat <- rename(dat, c("agegrp" = "Age","year" = "Year", "rate" = "Rate"))

    dat %>% 
      ggvis(~Year, ~Age, fill = ~Rate) %>% 
      layer_rects(width = band(), height = band()) %>%
      add_relative_scales() %>%
      set_options(height = 200, width = 410, keep_aspect = TRUE) %>% 
      add_axis("y", title="")%>%
      scale_nominal("x", padding = 0, points = FALSE) %>%
      scale_nominal("y", padding = 0, points = FALSE) %>% 
      scale_numeric("fill",range = c("lightsteelblue","red")) %>% 
      hide_legend("fill") %>%
      add_tooltip(function(d) {
        if(is.null(d)) return(NULL)
        paste0(names(d), ": ", format(d), collapse = "<br />") 
      }         

      ) %>%          
      bind_shiny("heatmap")

  }else{
    dat <- rename(dat, c("agegrp" = "Age","year" = "Year", "denominator" = "Count"))

    dat %>% 
      ggvis(~Year, ~Age, fill = ~Count) %>% 
      layer_rects(width = band(), height = band()) %>%
      add_relative_scales() %>%
      set_options(height = 200, width = 410, keep_aspect = TRUE) %>% 
      add_axis("y", title="")%>%
      scale_nominal("x", padding = 0, points = FALSE) %>%
      scale_nominal("y", padding = 0, points = FALSE) %>% 
      scale_numeric("fill",range = c("lightsteelblue","red")) %>% 
      hide_legend("fill") %>%
      add_tooltip(function(d) {
        if(is.null(d)) return(NULL)
        paste0(names(d), ": ", format(d), collapse = "<br />") 
      }         

      ) %>%          
      bind_shiny("heatmap")
  }

}

# DimpleJS pyramid

dPyramid <- function(startyear, endyear, data, colors=c("steelblue","firebrick"),indicator) {

  dat <- getData(startyear,endyear,data)  

  if(indicator$rate == "Y"){
    dat$denominator <- ifelse(dat$sex == 1, -1 * dat$denominator, 1 * dat$denominator)
    dat$Gender <- ifelse(dat$sex == 1,"Male", "Female")
    dat$Rate <- (dat$numerator/dat$denominator)*indicator$multiplier
    max_x <- round_any(max(dat$Rate), 10, f = ceiling)
    min_x <- round_any(min(dat$Rate), 10, f = floor)  

    dat <- rename(dat, c("agegrp" = "Age"))

    d1 <- dimple(
      x = "Rate", 
      y = "Age", 
      groups = "Gender", 
      data = dat, 
      type = 'bar') 


    d1 <- yAxis(d1, type = "addCategoryAxis", orderRule = "Age")
    d1 <- xAxis(d1,type = "addMeasureAxis")
    # Ensure fixed x-axis independent of year selected
    d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)

    if (!is.null(colors)){
      d1 <- colorAxis(
        d1,
        type = "addColorAxis", 
        colorSeries = "sex", 
        palette = colors
      )
    }

    # For storyboarding
    if (endyear - startyear >= 1) {
      d1 <- tack(d1, options = list( storyboard = "year" ) )    
    }

    return(d1)
  }


  else{
    dat$denominator <- ifelse(dat$sex == 1, -1 * dat$denominator, 1 * dat$denominator)
    dat$Gender <- ifelse(dat$sex == 1,"Male", "Female")
    max_x <- round_any(max(dat$denominator), 10, f = ceiling)
    min_x <- round_any(min(-1*dat$denominator), 10, f = floor)   

    dat <- rename(dat,c("denominator" = "Count","agegrp" = "Age"))

    d1 <- dimple(
      x = "Count", 
      y = "Age", 
      groups = "Gender", 
      data = dat, 
      type = 'bar')


    d1 <- yAxis(d1, type = "addCategoryAxis", orderRule = "Age")
    d1 <- xAxis(d1,type = "addMeasureAxis")
    # Ensure fixed x-axis independent of year selected
    d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)

    if (!is.null(colors)){
      d1 <- colorAxis(
        d1,
        type = "addColorAxis", 
        colorSeries = "sex", 
        palette = colors
      )
    }

    # For storyboarding
    if (endyear - startyear >= 1) {
      d1 <- tack(d1, options = list( storyboard = "year" ) )    
    }

    return(d1)
  }
}

suppressMessages(
  singleton(
    addResourcePath(
      get_lib("nvd3")$name
      ,get_lib("nvd3")$url
    )
  )
)



ui <- dashboardPage(

  dashboardHeader(title = "HealthData Viz"),

  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Presentations", tabName = "widgets", icon = icon("file-powerpoint-o"))
    ),
    tags$br(),
    tags$fieldset(checkboxInput("doAnimate", "Animate Pyramid",value = TRUE),
                  tags$p("(Uncheck to select specific year)")),
    conditionalPanel(
      condition = "input.doAnimate == false",
    uiOutput("choose_year")

    ),

    uiOutput("choose_agegrp")
    ,

    uiOutput("choose_dataset")
  ),
  dashboardBody(
    tags$head(get_assets_shiny(get_lib("nvd3"))[-3]),
    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",
              fluidRow(
                box(dimpleOutput("distPlot", height = 250)),

                box(showOutput("distPlot2","nvd3",add_lib=F))
              ),
              fluidRow(
                #box(infoBoxOutput("informationBox")),
                infoBox("About", textOutput("caption"), icon = icon("info-circle"),width = 6),

                (
                  #uiOutput("ggvis_ui"),
                  box(ggvisOutput("heatmap"))
                )
              )                    
      ),

      # Second tab content
      tabItem(tabName = "widgets",
              h2("Links to interactive scientific presentations will go here...")
      )
    )
  )
)


server <- function(input, output) {

  output$choose_dataset <- renderUI({
    selectInput("outcome", "Select Outcome", choices, selected="Population Structure",width="95%")
  })

  output$choose_agegrp <- renderUI({
    selectInput("agegrp", "Select Age Group", 
                choices = c("00-04","05-09","10-14","15-19","20-24","25-29",
                            "30-34","35-39","40-44","45-49","50-54",
                            "55-59","60-64","65-69","70-74","75-79",
                            "80-84","85+"), selected="00-04",width="95%")
  })
  #############################################################
  # PYRAMID
  #############################################################

  observe({
    if(!is.null(input$outcome)){
      selected_outcome <- input$outcome          
      selected_indicator <- subset(indicators,indicators$label == selected_outcome)

      outcome_data <- reactive({
        read.csv(curl(as.character(selected_indicator$file)))
      })

      d <- reactive({outcome_data()})

      minYear <- reactive({min(d()$year)})
      maxYear <- reactive({max(d()$year)})

      observe({
        if(input$doAnimate){
          output$distPlot <- renderDimple({
            dPyramid(minYear(), maxYear(),data = outcome_data(), indicator = selected_indicator)
          })

        }else{
          years <- as.vector(unique(outcome_data()$year))
          output$choose_year <- renderUI({
            selectInput("startyr", "Select Pyramid Year", years, width="95%")
          })

          output$distPlot <- renderDimple({            

            if(!is.null(input$startyr)){

              startyear <- as.numeric(input$startyr) 
              # Start year and end year are equal we only want cross-sectional pyramid
              # for a single selected year
              dPyramid(startyear, startyear, data = outcome_data(),indicator = selected_indicator)
            }

          })    
        }
      })




    }

  })
  ###############################################

  observe({

    if(!is.null(input$outcome)
       & !is.null(input$agegrp)){     


      selected_outcome <- input$outcome 
      selected_indicator <- subset(indicators,indicators$label == selected_outcome)

      outcome_data <- reactive({
        read.csv(curl(as.character(selected_indicator$file)))
      })

      d <- reactive({outcome_data()})

      output$caption <- renderText({
        return(paste("You are currently viewing",
                     ifelse(selected_indicator$rate=="N",paste(input$outcome,".\n",selected_indicator$description),
                            paste(input$outcome,"(per",selected_indicator$multiplier,"population).\n",selected_indicator$description))))
      })
      ################################################
      # Line chart
      ################################################
      output$distPlot2 <- renderChart2({    
        lineChart(outcome_data(),input$agegrp,selected_indicator)    
      })

      #################################################
      # HEATMAP 
      #################################################

      heatmap(outcome_data(),selected_indicator)      

    }

  })


}

shinyApp(ui, server)
##app.R##
图书馆(shinydashboard)
图书馆(闪亮)
需要(htmltools)
require(htmlwidgets)
库(rcdimple)#开发工具::安装_github(“timelyportfolio/rcdimple”)
library(curl)#devtools::install_github(“jeroenooms/curl”)
图书馆(plyr)#供任何人参观
图书馆(艺术)
图书馆(ggvis)
图书馆(E2)

指标@timelyportfolio-似乎
rcdimple
包的描述文件中没有列出对
htmltools
的依赖关系。从
https://github.com/timelyportfolio/rcdimple
并将依赖项添加到描述文件(
https://github.com/kilimba/rcdimple
)。现在可以部署一个闪亮的应用程序,它使用
rcdimple
包部署到
shinayapps.io
。已向master branch发出拉取请求

可能会help@timelyportfolio谢谢,从这个链接来看,似乎需要对代码库进行依赖声明/更改?我已经记录了一个问题,当我从那里得到响应时,它会更新你和这个线程。