我在Ubuntu服务器上有一个闪亮的仪表板，它连接到'本地'PostgreSQL数据库以收集数据。当我从R-Studio环境（在同一台服务器上）启动仪表板时，它运行得非常好，但当我将其作为闪亮服务器仪表板访问时，仪表板无法加载。每个其他仪表板都运行良好，所以我知道闪亮的服务器功能。这是唯一连接到potgres数据库的仪表板。
我设法弄清楚它是创建错误的dbConnect函数。当我将其注释掉（以及依赖于它的所有）时，仪表板会加载（显然是一个骨架）。
当我通过{{3}}访问闪亮服务器仪表板时，出现以下错误：
ERROR: An error has occurred. Check your logs or contact the app author for clarification.
这是日志文件：
Error in ans[!test & ok] <- rep(no, length.out = length(ans))[!test &:
replacement has length zero
Calls: <Anonymous> -> ifelse
In addition: Warning message:
In rep(no, length.out = length(ans)) :
'x' is NULL so the result will be NULL
Execution halted
我怀疑闪亮的服务器无法访问postgres数据库，即使root可以。有没有人以前遇到过这个问题？
谢谢
编辑：添加部分代码。这只是最重要的一点，但你明白了。当我注释掉dbDriver和src_postgres函数
ui.R
library(shiny)
library(dplyr)
library(RPostgreSQL)
library(magrittr)
library(leaflet)
library(tidyr)
drv <- dbDriver("PostgreSQL")
con <- src_postgres(dbname = "sandtonrelocation")
travelEventTransactional <- tbl(con, "travel_event_transactional")
# for the next two connections, the inner join section is to only
select the latest entry
employeeData <-
tbl(con, "employee_data") %>%
inner_join(tbl(con, "employee_data") %>%
group_by(employee_id) %>%
summarise(date_added = max(date_added)),
by = c("employee_id", "date_added"))
employeeAddressData <-
tbl(con, "employee_address_data") %>%
inner_join(tbl(con, "employee_address_data") %>%
group_by(employee_id) %>%
summarise(date_added = max(date_added)),
by = c("employee_id", "date_added"))
# UI start ====
shinyUI(fluidPage(
# title ====
titlePanel("Sandton relocation impact study"),
# sidebar ====
sidebarLayout(
sidebarPanel(
selectInput(inputId = "businessUnitId",
label = "Select business unit",
choices = c("All", employeeData %>%
select(business_unit) %>%
distinct %>%
arrange(business_unit) %>%
collect %$%
business_unit),
selected = "CPS"),
等等
server.R
library(shiny)
library(dplyr)
library(RPostgreSQL)
library(magrittr)
library(leaflet)
library(leaflet.extras)
library(ggplot2)
library(rlang)
source('./lib/mulitplot.R')
source('./lib/compareScenarios.R')
source('./lib/maritalStatus.R')
source('./lib/extra_dfs.R')
## connect to DB =====
drv <- dbDriver("PostgreSQL")
con <- src_postgres(dbname = "sandtonrelocation")
travelEventTransactional <- tbl(con, "travel_event_transactional")
# for the next two connections, the inner join section is to only select the
# latest entry
employeeData <-
tbl(con, "employee_data") %>%
inner_join(tbl(con, "employee_data") %>%
group_by(employee_id) %>%
summarise(date_added = max(date_added)),
by = c("employee_id", "date_added"))
employeeAddressData <-
tbl(con, "employee_address_data") %>%
inner_join(tbl(con, "employee_address_data") %>%
group_by(employee_id) %>%
summarise(date_added = max(date_added)),
by = c("employee_id", "date_added"))
## leaflet map object ====
gautrainIcon <- makeIcon(
iconUrl = "./images/Gautrain.png",
iconWidth = 10, iconHeight = 10
)
mmiIcon <- makeIcon(
iconUrl = "./images/Map-Icons-02.png",
iconWidth = 22.5, iconHeight = 22.5
)
m <-
leaflet() %>%
fitBounds(
lng1 = 27.8,
lat1 = -26.3,
lng2 = 28.42,
lat2 = -25.66
) %>%
addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>%
addMarkers(lat = -25.8537801, lng = 28.1919999,
labelOptions = labelOptions(noHide = T, textOnly = TRUE,
style = list(color = 'red')),
icon=mmiIcon) %>%
addMarkers(lat = -26.10306, lng = 28.060131,
labelOptions = labelOptions(noHide = T, textOnly = TRUE,
style = list(color = 'red')),
icon=mmiIcon)
## Shiny server start ====
shinyServer(function(input, output) {
# DF deltaTravelReactive ====
deltaTravelReactive <- reactive({
travelEventTransactionalScenario <-
if(input$selectScenario == "Everyone relocates") {
travelEventTransactional %>% collect() %>%
filter(work_location %in% c("current", "MARC"))
} else {
travelEventTransactional %>%
collect() %>%
left_join(read.csv(paste("./scenarios/",
input$selectScenario,
".csv",
sep = "")),
by = c("employee_id" = "Employee.ID"), copy = T) %>%
mutate(Future.occupancy = ifelse(Future.occupancy == "Sandton", "MARC",
ifelse(Future.occupancy == "Centurion", "Centurion Main Building"))) %>%
filter((work_location == "current") |
work_location == Future.occupancy) %>%
select(-Future.occupancy) %>%
ungroup
}
travelEventTransactionalSubset <-
travelEventTransactionalScenario %>%
left_join(employeeData %>%
select(employee_id,
age, gender,
business_unit,
children,
marital_status,
rem_bin),
by = 'employee_id', copy = T) %>%
filter(if(input$businessUnitId == "All") {event_id > 0} else {
business_unit == input$businessUnitId
}) %$%
mutate(.,
marital_status = sapply(marital_status,
function(x) mapMaritalStatus(x)),
children = sapply(children,
function(x) if(x == T | x > 0) T else F))
# cheap escape, fix this later on
if(length(travelEventTransactionalSubset$work_location %>% unique) == 1) {
-1
} else {
compareScenarios(travelEventTransactionalSubset,
"travel_time_car") %>%
left_join(compareScenarios(travelEventTransactionalSubset,
"travel_cost_car"),
by = c("employee_id", "children", "marital_status")) %>%
left_join(compareScenarios(travelEventTransactionalSubset,
"travel_time_gautrain"),
by = c("employee_id", "children", "marital_status")) %>%
left_join(compareScenarios(travelEventTransactionalSubset,
"travel_cost_gautrain"),
by = c("employee_id", "children", "marital_status")) %>%
left_join(employeeData %>% select(employee_id,rem_bin), copy = T,
by = "employee_id") %>%
mutate(current_train_faster = current_travel_time_car > current_travel_time_gautrain &
current_travel_time_gautrain != 0,
current_train_cheaper = current_travel_cost_car > current_travel_cost_gautrain &
current_travel_time_gautrain != 0,
future_train_faster = future_travel_time_car > future_travel_time_gautrain &
future_travel_time_gautrain != 0,
future_train_cheaper = future_travel_cost_car > future_travel_cost_gautrain &
future_travel_time_gautrain != 0,
delta_cost_car = future_travel_cost_car - current_travel_cost_car,
delta_time_car = future_travel_time_car - current_travel_time_car)
}
})
# PLOT deltaDriveTime ====
output$deltaDriveTime <- renderPlot({
deltaTravel <- deltaTravelReactive()
if(deltaTravel == -1) {
ggplot() +
geom_text(aes(x = 0, y = 0,
label = paste('No change for', input$businessUnitId)), col = 'dodgerblue3', size = 9) +
theme_minimal() %+replace%
theme(axis.text = element_blank(),
axis.title = element_blank())
} else {
deltaTravel%>%
mutate(deltaTimeCar = future_travel_time_car - current_travel_time_car) %>%
ggplot() +
geom_histogram(aes(x = deltaTimeCar), binwidth = input$binSizeTime,
fill = 'dodgerblue',col = 'dodgerblue',
alpha = .85) +
stat_bin(aes(x = deltaTimeCar,
label = scales::percent(..count../sum(..count..))),
geom = 'text', binwidth = input$binSizeTime, size = 3, vjust = -1) +
theme_minimal() %+replace%
theme(plot.title = element_text(size = 12),
axis.title.y = element_blank(),
axis.text.y = element_blank()) +
xlab("Time") +
ggtitle("Increase in travel time after moving to MARC")
}
})
答案 0 :(得分：0)
似乎这是权利问题。 Shiny-server不以root身份连接到psql，而是以闪亮的方式连接。
我所要做的就是将闪亮的角色添加到psql并赋予它登录权限。
create role shiny;
alter user shiny with login;
问题解决了:)