问题描述
这是我第一个部署到Shinyapp IO云服务器上的闪亮Web应用程序，该应用程序在本地运行良好，没有任何问题。但是当我部署它时，它不能正常工作。如果有人解决我的代码中确切缺少的内容，那将是很好的。以下是Shinyapps云链接deployed app link
下面是r代码。
rm(list=ls())
# load library
library(dplyr)
library(data.table)
library(stringr)
library(ggplot2)
library(shiny)
library(plotly)
library(shinythemes)
library(shinyjs)
library(DT)
library(shinyWidgets)
library(tidyverse)
library(DBI)
library(readxl)
# css customization
css <- "
#download_data {
/* Change the background color of the download button to orange. */
background: orange;
/* Change the text size to 20 pixels. */
font-size: 20px;
}
#data_tbl {
/* Change the text color of the table to red. */
color: black;
}
"
url <-
"http://example.com/CSISAMS/exportdata/getdata?Format=CSV&QueryID=488461&loginid=2368702"
dt_raw <- data.frame(
`Fiscal Year` = c("FY20","FY20","FY20"),`Calendar Month` = c(201911L,201911L,201911L),`RS Subregion1` = c("LATIN AMERICA REGION","LATIN AMERICA REGION","LATIN AMERICA REGION"),`Product Sub Group` = c("APS","CP","CS","AP"),`NDP USD` = c(10200.18,373695.04,34637.79,347602.63),Qty = c(323.91,15023.17,1033.09,17666.96),`AtNet USD` = c(111748.95,5182993.65,356416.05,6095101.2),`ASP USD` = c(10023.88,464914.53,31970.52,546730.58),)
dt <- dt_raw
ggplt_data <- (dt)
names(ggplt_data) <- gsub(" ","_",names(ggplt_data))
ui_queryid <- str_remove(str_split(url,'&')[[1]][2],'QueryID=')
region_names <-
data.table(
'RegionName' = c('AMS','EMEA','APJ','WW'),'CSISRegionName' = c('CSISAMS','webquery','csisapj','WW')
)
region <-
region_names[str_detect(url,c('CSISAMS','WW')),RegionName]
measure_list <-
data.frame(
Reportdisplay = c("NDP USD","Qty","AtNet USD","ASP USD"),Region = c("AMS","AMS","AMS"),NumberFormat = c("Dollar","Number","Dollar","Dollar")
)
clean_measure_list <-
measure_list %>% filter(Region == region) %>% mutate(clean_reportdisplay = str_replace_all(Reportdisplay,"[:punct:]|[:space:]",'.')) %>%
filter(clean_reportdisplay %in% str_replace_all(colnames(dt),'.')) %>% select (clean_reportdisplay)
list_attr <-
data.table('attr_name' = names(ggplt_data)) %>%
mutate(
measure_type = case_when(
str_detect(
attr_name,regex(clean_measure_list$clean_reportdisplay,ignore_case = TRUE)
) ~ "Measure",attr_name %in% clean_measure_list$clean_reportdisplay ~ "Measure",TRUE ~ "Filter"
)
)
#convert functions
convert_units_fun <- function(x,arth_operator,value) {
if (arth_operator == "+") {
round(x + value,2)
} else if (arth_operator == "-") {
round(x - value,2)
} else if (arth_operator == "*") {
round(x * value,2)
} else {
round(x / value,2)
}
}
# Scatter & Jitter plot function
# func_ggplt_scatter_jitter (xAxis="distributor_Total_Quantity",yAxis="distributor_Total_Quantity",graph_type="geom_point",se=TRUE,# theme="theme_gray",size = 5,shape = 21)
func_ggplt_scatter_jitter <-
function(xAxis,yAxis,aes_color = NULL,graph_type,title = NULL,xAxis_label = NULL,yAxis_label = NULL,shape = NULL,size = NULL,theme = NULL,se,xlim_min = NA,xlim_max = NA,ylim_min = NA,ylim_max = NA,x_log = NULL,y_log = NULL) {
ggplt_data %>% ggplot(aes_string(xAxis,color = aes_color)) +
get(graph_type)(shape = shape,size = size) +
geom_smooth(se = se) + ggtitle(title) + xlab(xAxis_label) + ylab(yAxis_label) +
get(theme)() + scale_x_continuous(limits = c(xlim_min,xlim_max)) +
scale_y_continuous(limits = c(ylim_min,ylim_max)) +
(if (is.null(x_log) == TRUE) {
NULL
} else {
get(x_log)()
}) +
(if (is.null(y_log) == TRUE) {
NULL
} else {
get(y_log)()
})
}
func_ggplt_col <-
function(xAxis,aes_color,position = "dodge",summary_type = "n") {
if (aes_color == "NULL") {
ggplt_data %>% mutate(xAxis_factor = as.factor(get(xAxis))) %>%
group_by (xAxis_factor) %>%
summarise(n = n(),s = sum(get(yAxis))) %>%
ggplot(aes(x = xAxis_factor,y = get(summary_type))) +
get(graph_type)() +
get(theme)() + ggtitle(title) + xlab(xAxis_label) + ylab(yAxis_label) +
scale_fill_brewer(palette = "Set1") +
theme(axis.text.x = element_text(
angle = 90,vjust = 1,hjust = 1
)) +
geom_text(
aes(label = get(summary_type)),size = 3,hjust = 0.5,position = position_stack(vjust = 0.5)
)
} else {
ggplt_data %>% mutate(
xAxis_factor = as.factor(get(xAxis)),yAxis_factor = get(yAxis),aes_color_factor = as.factor(get(aes_color))
) %>%
group_by (xAxis_factor,aes_color_factor) %>% summarise(n = n(),s = sum(get(yAxis))) %>%
ggplot(aes(
x = xAxis_factor,y = get(summary_type),fill = aes_color_factor
)) +
get(graph_type)(position = position) +
get(theme)() + ggtitle(title) + xlab(xAxis_label) + ylab(yAxis_label) +
scale_fill_brewer(palette = "Set1") +
theme(axis.text.x = element_text(
angle = 90,position = position_stack(vjust = 0.5)
)
}
}
func_ggplt_line_area <-
function(xAxis,theme = NULL) {
if (aes_color == "NULL") {
ggplt_data %>%
ggplot(aes(x = as.factor(get(xAxis)),y = get(yAxis))) +
get(graph_type)() +
theme(axis.text.x = element_text(
angle = 90,hjust = 1
))
} else {
ggplt_data %>%
ggplot(aes(
x = as.factor(get(xAxis)),y = get(yAxis),color = get(aes_color),group = get(aes_color),fill = get(aes_color)
)) +
get(graph_type)() +
get(theme)() + ggtitle(title) + xlab(xAxis_label) + ylab(yAxis_label) +
theme(axis.text.x = element_text(
angle = 90,hjust = 1
)) +
geom_text(aes(label = get(yAxis)),vjust = 0.25)
}
}
list_graph <-
data.table(
'geom_name' = c(
'geom_point','geom_jitter','geom_col','geom_line','geom_area'
),'geom_ui_name' = c('Scatter Plot','Jitter Plot','Col Plot','Line Plot','Area Plot')
)
list_theme <-
data.table(
'theme_name' = c('theme_gray','theme_bw','theme_classic','theme_void'),'theme_ui_name' = c(
'Gray(default)','BW(transparency)','Classic(Traditional)','nothing'
)
)
summary_type <-
data.table(
'summary_type_name' = c('s','n'),'summary_type_ui_name' = c('sum','count')
)
# UI
ui <- fluidPage(
h4(
paste0(
"QueryID: ",ui_queryid,",Total No Rows: ",nrow(dt),Total Selected Columns: ",ncol(dt)
)
),#shinythemes::themeSelector(),# use this code to change theme of app
theme = shinythemes::shinytheme("simplex"),tags$style(css),sidebarLayout(
sidebarPanel(
useShinyjs(),radioGroupButtons(
inputId = "Id0001",label = "",choices = c("Readme","Customization","Aggregations","Exploration"),status = "info",justified = TRUE
),uIoUtput("selectId0002"),uIoUtput("selectId0009"),uIoUtput("selectId0010"),uIoUtput("selectId0011"),useShinyjs(),uIoUtput("selectId0008"),uIoUtput("selectId0003"),uIoUtput("selectId0004"),uIoUtput("selectId0005"),div(style = "float:left",uIoUtput("selectId0006")),div(style = "float:right",uIoUtput("selectId0007")),uIoUtput("selectgraph"),uIoUtput("selectxAxis"),uIoUtput("selectsummary_type"),uIoUtput("selectyAxis"),uIoUtput("selectColor"),uIoUtput("selectTitle"),uIoUtput("selectxLabel"),uIoUtput("selectyLabel"),uIoUtput("selectTheme"),uIoUtput("selectadvanceopts"),uIoUtput("selectSe"),uIoUtput("selectposition"),uIoUtput("selectxlog10"),uIoUtput("selectylog10"),uIoUtput("selectXlimmin"),uIoUtput("selectXlimmax"),uIoUtput("selectYlimmin"),uIoUtput("selectYlimmax"),uIoUtput("selectshowgraph"),width = 3
),mainPanel(
fluidRow(
conditionalPanel(condition = "input.Id0001 == 'Readme'",textoutput("mark")),conditionalPanel(condition = "input.Id0001 == 'Customization'",DT::DTOutput("Customization_data_tbl")),conditionalPanel(condition = "input.Id0001 == 'Aggregations'",DT::DTOutput("Aggregations_data_tbl")),conditionalPanel(condition = "input.Id0001 == 'Exploration'",plotly::plotlyOutput("plot")),DT::DTOutput("plot_data_tbl")),conditionalPanel(condition = "input.Id0001 %in% ('Customization','Aggregations','Exploration')",uIoUtput("enable_download_button"))
),width = 9
)
)
)
#SERVER
server <- function(input,output,session) {
output$mark <- renderText("Please click desired tab for analysis")
output$selectgraph <-
renderUI(selectInput(
inputId = "graph",label = "Select graph Type",choices = unique(list_graph$geom_ui_name)
))
output$selectxAxis <-
renderUI(selectInput("xAxis","Select X Axis value",unique(list_attr$attr_name)))
output$selectsummary_type <-
renderUI(selectInput(
"summary_type","Select Summary Type:",choices = unique(summary_type$summary_type_ui_name)
))
output$selectyAxis <-
renderUI(selectInput("yAxis","Select Y Axis value",unique(list_attr$attr_name)))
output$selectColor <-
renderUI(selectInput("color","Select color value",c("NULL",unique(
list_attr$attr_name[list_attr$measure_type == 'Filter']
))))
output$selectTitle <-
renderUI(textInput("title","Enter title here",placeholder = "title is optional"))
output$selectxLabel <-
renderUI(
textInput("xAxis_label","X-Label:",placeholder = "something is better than nothing")
)
output$selectyLabel <-
renderUI(
textInput("yAxis_label","Y-Label:",placeholder = "something is better than nothing")
)
output$selectTheme <-
renderUI(selectInput("theme","select theme",choices = unique(list_theme$theme_ui_name)))
output$selectSe <-
renderUI(checkBoxInput("se","Show confidence interval",FALSE))
output$selectxlog10 <-
renderUI(checkBoxInput("xlog10","scale_x_log10",FALSE))
output$selectylog10 <-
renderUI(checkBoxInput("ylog10","scale_y_log10",FALSE))
output$selectXlimmin <-
renderUI(textInput("xlimmin","X-lim Min:",value = NA,width = 60))
output$selectXlimmax <-
renderUI(textInput("xlimmax","X-lim Max:",width = 60))
output$selectYlimmin <-
renderUI(textInput("ylimmin","Y-lim Min:",width = 60))
output$selectYlimmax <-
renderUI(textInput("ylimmax","Y-lim Max:",width = 60))
output$selectposition <-
renderUI(radioButtons(
"position","Select position:",choices = c("stack","fill","dodge"),inline = TRUE
))
output$selectadvanceopts <-
renderUI(checkBoxInput("advanceopts","Advanced Options",FALSE))
output$selectshowgraph <-
renderUI(fluidRow(actionButton("showgraph","Show Plot")))
output$selectId0002 <-
renderUI(textInput("Id0002","",placeholder = "enter new column name"))
output$selectId0003 <-
renderUI(pickerInput(
"Id0003","enter Custom Formula",choices = unique(names(dt)),options = list(`live-search` = TRUE)
))
output$selectId0004 <-
renderUI(
textInput("Id0004","enter arithmetic operators",placeholder = "only symbols please...")
)
output$selectId0005 <-
renderUI(numericInput("Id0005","enter value",1,min = 0.01,max = 1000000000))
output$selectId0006 <-
renderUI(actionButton("Id0006","add new column "))
output$selectId0007 <-
renderUI(actionButton("Id0007","clear selection",class = "btn-danger"))
output$selectId0008 <-
renderUI(materialSwitch("Id0008","Show arithmetic operators",FALSE,status = "primary"))
output$selectId0009 <-
renderUI(
pickerInput(
"Id0009","group by attributes",multiple = TRUE,options = list(`live-search` = TRUE)
)
)
output$selectId0010 <-
renderUI(
pickerInput(
"Id0010","summary attributes",options = list(`live-search` = TRUE)
)
)
output$selectId0011 <-
renderUI(actionButton("Id0011","show data"))
shiny::observeEvent(input$Id0001,{
shinyjs::toggle("selectId0002",condition = input$Id0001 %in% c("Customization"))
shinyjs::toggle("selectId0006",condition = input$Id0001 %in% c("Customization"))
shinyjs::toggle("selectId0007",condition = input$Id0001 %in% c("Customization"))
shinyjs::toggle("selectId0008",condition = input$Id0001 %in% c("Customization"))
shiny::observeEvent(input$Id0008,{
shinyjs::toggle("selectId0003",condition = input$Id0001 == c("Customization") &&
input$Id0008 == TRUE)
shinyjs::toggle("selectId0004",condition = input$Id0001 == c("Customization") &&
input$Id0008 == TRUE)
shinyjs::toggle("selectId0005",condition = input$Id0001 == c("Customization") &&
input$Id0008 == TRUE)
})
})
shiny::observeEvent(input$Id0001,{
shinyjs::toggle("selectId0009",condition = input$Id0001 %in% c("Aggregations"))
shinyjs::toggle("selectId0010",condition = input$Id0001 %in% c("Aggregations"))
shinyjs::toggle("selectId0011",condition = input$Id0001 %in% c("Aggregations"))
})
shiny::observeEvent(input$Id0001,{
shinyjs::toggle("selectgraph",condition = input$Id0001 == "Exploration")
shinyjs::toggle("selectTheme",condition = input$Id0001 == "Exploration")
shinyjs::toggle("selectadvanceopts",condition = input$Id0001 == "Exploration")
shinyjs::toggle("selectshowgraph",condition = input$Id0001 == "Exploration")
shiny::observeEvent(input$graph,{
shinyjs::toggle(
"selectxAxis",condition = input$Id0001 == "Exploration" &&
input$graph %in% c(
"Scatter Plot","Jitter Plot","Col Plot",'Area Plot'
)
)
shinyjs::toggle(
"selectyAxis",'Area Plot'
)
)
shinyjs::toggle(
"selectColor",'Area Plot'
)
)
shinyjs::toggle(
"selectTitle",'Area Plot'
)
)
shinyjs::toggle(
"selectxLabel",'Area Plot'
)
)
shinyjs::toggle(
"selectyLabel",'Area Plot'
)
)
shinyjs::toggle(
"selectsummary_type",condition = input$Id0001 == "Exploration" &&
input$graph %in% c("Col Plot")
)
})
shiny::observeEvent(input$summary_type,{
shinyjs::toggle(
"selectyAxis",condition = input$Id0001 == "Exploration" &&
input$summary_type %in% c('sum')
)
})
shiny::observeEvent(input$advanceopts,{
shinyjs::toggle(
"selectSe",condition = input$Id0001 == "Exploration" &&
input$advanceopts == TRUE &&
input$graph %in% c("Scatter Plot","Jitter Plot")
)
shinyjs::toggle(
"selectxlog10","Jitter Plot")
)
shinyjs::toggle(
"selectylog10","Jitter Plot")
)
shinyjs::toggle(
"selectXlimmin","Jitter Plot")
)
shinyjs::toggle(
"selectXlimmax","Jitter Plot")
)
shinyjs::toggle(
"selectYlimmin","Jitter Plot")
)
shinyjs::toggle(
"selectYlimmax","Jitter Plot")
)
shinyjs::toggle(
"selectposition",condition = input$Id0001 == "Exploration" &&
input$advanceopts == TRUE &&
input$graph %in% c("Col Plot")
)
})
})
observeEvent(input$Id0007,{
updatePickerInput(session,"Id0003","Enter Custom Formula",choices = unique(names(dt)))
updateTextInput(session,"Id0002",value = "")
updateTextInput(session,"Id0004",value = "",placeholder = "only symbols allowed (+,-,*,/)")
updateNumericInput(session,"Id0005",1)
updateMaterialSwitch(session,inputId = "Id0008",value = FALSE)
})
reactive_arithmetic <- eventReactive(input$Id0006,{
if (input$Id0002 != "" &&
!is.null(input$Id0002) && input$Id0006 > 0) {
newcol <-
apply(
dt[,input$Id0003,drop = F],convert_units_fun,arth_operator = input$Id0004,value = input$Id0005
)
cn <- colnames(dt)
dt <<- data.frame(dt,newcol)
colnames(dt) <<- c(cn,input$Id0002)
}
dt
})
reactive_Aggregations <- eventReactive(input$Id0011,{
if (input$Id0011 > 0) {
dt_agg <<- dt %>%
group_by(across(all_of(input$Id0009))) %>%
summarise(across(all_of(input$Id0010),.fns = list(sum = sum,n = ~ n())))
}
dt_agg
})
observeEvent(input$graph,{
reset("advanceopts")
reset("se")
reset("xlog10")
reset("ylog10")
reset("xlimmin")
reset("xlimmax")
reset("ylimmin")
reset("ylimmax")
})
#render out of plot data in table
reactive_plottable <- eventReactive(input$showgraph,{
if (input$color == "NULL") {
ggplt_data %>% select(input$xAxis,input$yAxis)
} else
{
ggplt_data %>% select(input$xAxis,input$yAxis,input$color)
}
})
#render out of the plot
reactive_string <-
eventReactive(input$showgraph,{
if (input$graph == "Col Plot") {
func_ggplt_col (
xAxis = input$xAxis,yAxis = input$yAxis,aes_color = input$color,graph_type = (list_graph[geom_ui_name == input$graph,geom_name]),title = input$title,xAxis_label = input$xAxis_label,yAxis_label = input$yAxis_label,theme = (list_theme[theme_ui_name == input$theme,theme_name]),summary_type = (summary_type[summary_type_ui_name == input$summary_type,summary_type_name]),position = input$position
)
} else if (input$graph %in% c("Line Plot","Area Plot")) {
func_ggplt_line_area (
xAxis = input$xAxis,theme_name])
)
} else {
func_ggplt_scatter_jitter(
graph_type = (list_graph[geom_ui_name == input$graph,xAxis = input$xAxis,shape = 'circle',size = '3',se = input$se,xlim_min = as.numeric(input$xlimmin),xlim_max = as.numeric(input$xlimmax),ylim_min = as.numeric(input$ylimmin),ylim_max = as.numeric(input$ylimmax),x_log = (if (input$xlog10 == FALSE) {
NULL
} else {
"scale_x_log10"
}),y_log = (if (input$ylog10 == FALSE) {
NULL
} else {
"scale_y_log10"
})
)
}
})
output$Customization_data_tbl <-
DT::renderDT({
reactive_arithmetic()
})
output$Aggregations_data_tbl <-
DT::renderDT({
reactive_Aggregations()
})
output$plot <-
plotly::renderPlotly({
reactive_string2 <- reactive_string()
})
output$plot_data_tbl <- DT::renderDT({
reactive_plottable()
})
output$enable_download_button <-
renderUI({
if (input$Id0001 == "Customization" && input$Id0006 > 0) {
downloadButton('download_data',label = 'save in csv')
} else if (input$Id0001 == "Aggregations" &&
input$Id0011 > 0) {
downloadButton('download_data',label = 'save in csv')
} else if (input$Id0001 == "Exploration" &&
input$showgraph > 0) {
downloadButton('download_data',label = 'save in csv')
}
})
# Create a download handler
output$download_data <- downloadHandler(
filename = function() {
paste("test.csv")
},content = function(file) {
write.csv(reactive_Aggregations(),file,row.names = FALSE)
}
)
}
#Run the Shiny App to display Webpage
shinyApp(ui = ui,server = server)
#runapp<- shinyApp(ui = ui,server = server)
#runApp(runapp,launch.browser=TRUE)
解决方法
找到了根本原因，以下代码对应用程序造成了麻烦，并且已更正。一切正常。
问题代码：-
output$enable_download_button <-
renderUI({
if (input$Id0001 == "Customization" && input$Id0006 > 0) {
downloadButton('download_data',label = 'save in csv')
} else if (input$Id0001 == "Aggregations" &&
input$Id0011 > 0) {
downloadButton('download_data',label = 'save in csv')
} else if (input$Id0001 == "Exploration" &&
input$showgraph > 0) {
downloadButton('download_data',label = 'save in csv')
}
})
更正的代码：-
output$enable_download_button <-
renderUI({
if (input$Id0001 == "Customization" && input$Id0006 != 0) {
downloadButton('download_data',label = 'save in csv')
} else if (input$Id0001 == "Aggregations" &&
input$Id0011 != 0) {
downloadButton('download_data',label = 'save in csv')
} else if (input$Id0001 == "Exploration" &&
input$showgraph != 0) {
downloadButton('download_data',label = 'save in csv')
}
})