我正在努力使Flexdashboard中的数据图形变得运行时很亮。
在这里，我将数据导入并进行下线使用：
---
title: "Provider Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
runtime: shiny
---
```{r global, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(tibbletime)
library(scales)
source("S:\\clean_names.R")
source("S:\\optimal_bin_size.R")
df_los <- readr::read_csv(
"G:\\los.csv"
) %>%
clean_names() %>%
filter(ward_cd != "EMER") %>%
filter(med_staff_dept != "?") %>%
filter(med_staff_dept != "Pathology")
df_los$dsch_date <- lubridate::mdy(df_los$dsch_date)
df_los <- as_tbl_time(df_los, index = dsch_date)
df_ra <- readr::read_csv(
"G:\\ra.csv"
) %>%
clean_names() %>%
filter(ward_cd != "EMER") %>%
filter(med_staff_dept != "?") %>%
filter(med_staff_dept != "Pathology")
df_ra <- rename(df_ra, pt_id = "pt_no_num")
df_ra$dsch_date <- lubridate::mdy(df_ra$dsch_date)
df_ra$adm_date <- lubridate::mdy(df_ra$adm_date)
df_ra <- as_tbl_time(df_ra, index = dsch_date)
df_a <- df_los %>%
dplyr::select(
pt_id
, dsch_date
, los
, performance
, z_minus_score
, lihn_service_line
, hosim
, severity_of_illness
, pyr_group2
, med_staff_dept
, ward_cd
)
df_b <- df_ra %>%
dplyr::select(
pt_id
, readmit_count
, readmit_rate_bench
, z_minus_score
)
df_los_ra <- dplyr::inner_join(df_a, df_b, by = "pt_id") %>%
as_tbl_time(index = dsch_date)
这就是我想要做的：
gmc_los_ra <- reactive(
{
df_los_ra %>%
filter(
input$losra_svc_line == "All" | lihn_service_line == input$losra_svc_line
) %>%
filter(
input$losra_hosp_pvt == "All" | hosim == input$losra_hosp_pvt
) %>%
filter(
input$losra_soi == "All" | severity_of_illness == input$losra_soi
) %>%
filter(
input$losra_pyr_cat == "All" | pyr_group2 == input$losra_pyr_cat
) %>%
filter(
input$losra_med_staff == "All" | med_staff_dept == input$losra_med_staff
) %>%
filter(
input$losra_dsch_ward == "All" | ward_cd == input$losra_dsch_ward
) %>%
collapse_by("monthly") %>%
dplyr::group_by(dsch_date, add = T) %>%
dplyr::summarize(
excess_ra = round(mean(readmit_count - readmit_rate_bench), 2)
, excess_los = round(mean(los - performance), 2)
)
}
)
renderPlot({
print(gmc_los_ra())
gmc_los_ra() %>%
ggplot(
aes(
x = excess_los
, y = excess_ra
)
) +
scale_x_continuous(
expand = c(0,0)
# If I uncomment this, an error of Object Not Found excess_los occurs
# , limits = c(
# min(excess_los)
# , max(excess_los)
# )
) +
scale_y_continuous(
expand = c(0,0)
# , limits = c(
# min(excess_ra)
# , max(excess_ra)
# )
) +
ylab("Excess Readmit Rate") +
xlab("Excess LOS")
# labs(
# title = "Gartner Magic Quadrant - Excess LOS vs Excess Readmit Rate"
# , subtitle = "Red Dot Indicates Zero Variance"
# ) +
# theme(
# legend.position = "none"
# , axis.title.x = element_text(
# hjust = 0
# , vjust = 4
# , colour = "darkgrey"
# , size = 10
# , face = "bold"
# )
# , axis.title.y = element_text(
# hjust = 0
# , vjust = 0
# , color = "darkgrey"
# , size = 10
# , face = "bold"
# )
# , axis.ticks = element_blank()
# , panel.border = element_rect(
# colour = "lightgrey"
# , fill = NA
# , size = 4
# )
# ) +
# annotate(
# "rect"
# , xmin = 0
# , xmax = max(excess_los)
# , ymin = 0
# , ymax = max(excess_ra)
# , fill = "#F8F9F9"
# ) +
# annotate(
# "rect"
# , xmin = 0
# , xmax = min(excess_los)
# , ymin = 0
# , ymax = min(excess_ra)
# , fill = "#F8F9F9"
# ) +
# annotate(
# "rect"
# , xmin = 0
# , xmax = min(excess_los)
# , ymin = 0
# , ymax = max(excess_ra)
# , fill = "white"
# ) +
# annotate(
# "rect"
# , xmin = 0
# , xmax = max(excess_los)
# , ymin = 0
# , ymax = min(excess_ra)
# , fill = "white"
# ) +
# geom_hline(
# yintercept = 0
# , color = "lightgrey"
# , size = 1.5
# ) +
# geom_vline(
# xintercept = 0
# , color = "lightgrey"
# , size = 1.5
# ) +
# geom_label(
# aes(
# x = 0.75 * min(excess_los)
# , y = 0.90 * max(excess_ra)
# , label = "High RA"
# )
# , label.padding = unit(2, "mm")
# , fill = "lightgrey"
# , color="black"
# ) +
# geom_label(
# aes(
# x = 0.75 * max(excess_los)
# , y = 0.90 * max(excess_ra)
# , label = "High RA/LOS"
# )
# , label.padding = unit(2, "mm")
# , fill = "lightgrey"
# , color = "black"
# ) +
# geom_label(
# aes(
# x = 0.75 * min(excess_los)
# , y = 0.90 * min(excess_ra)
# , label = "Leader"
# )
# , label.padding = unit(2, "mm")
# , fill = "lightgrey"
# , color = "black"
# ) +
# geom_label(
# aes(
# x = 0.75 * max(excess_los)
# , y = 0.9 * min(excess_ra)
# , label = "High LOS"
# )
# , label.padding = unit(2, "mm")
# , fill = "lightgrey"
# , color = "black"
# ) +
# geom_point(
# color = "#2896BA"
# , size = 2
# ) +
# # where you want to be
# geom_point(
# data = data.frame(x = 0, y = 0)
# , aes(color = 'red')
# , size = 3
# )
})
我取消注释limits命令的scale_x_continuous()部分后，就立即收到Object Not Found: excess_los的错误，尽管上面已经明确定义了该错误并且可以在初始ggplot()中使用代码的一部分。我在这里想念什么吗？如果我将其更改为limits = NA，那么它似乎可以正常工作。我知道它们应该产生相同的结果，但是我的问题是，为什么我的代码不能按原样工作，特别是因为我稍后在绘图中对extra_los和extra_ra调用min / max（）时，所有这些都因相同的错误而失败。
R Markdown控制台确实从代码的过滤器部分获得输出：
# A time tibble: 17 x 3
# Index: dsch_date
dsch_date excess_ra excess_los
<date> <dbl> <dbl>
1 2018-01-31 -0.01 0.1
2 2018-02-28 0.02 -0.21
3 2018-03-31 0 -0.54
4 2018-04-30 0.03 -0.34
5 2018-05-31 0.01 -0.22
6 2018-06-30 -0.03 -0.31
7 2018-07-31 0 -0.8
8 2018-08-31 0.02 -0.32
9 2018-09-30 -0.01 -0.08
10 2018-10-31 -0.01 -0.11
11 2018-11-30 -0.01 -0.32
12 2018-12-31 -0.01 -0.290
13 2019-01-31 0 -0.14
14 2019-02-28 0 -0.290
15 2019-03-31 0.01 -0.06
16 2019-04-30 -0.01 -0.33
17 2019-05-31 -0.03 -0.580
Warning: Error in continuous_scale: object 'excess_los' not found
171: continuous_scale
170: scale_x_continuous
169: renderPlot [<text>#37]
167: func
127: drawPlot
113: <reactive:plotObj>
97: drawReactive
84: origRenderFunc
83: output$outab893253c4e6ccbd
3: <Anonymous>
1: rmarkdown::run
我尝试做类似gmc_los_ra$excess_los的操作，但收到了Error: object of type 'closure' is not subsettable的错误
答案 0 :(得分：0)
我将代码更改为以下内容：
gmc_los_ra <- reactive(
{
df_los_ra %>%
filter(
input$losra_svc_line == "All" | lihn_service_line == input$losra_svc_line
) %>%
filter(
input$losra_hosp_pvt == "All" | hosim == input$losra_hosp_pvt
) %>%
filter(
input$losra_soi == "All" | severity_of_illness == input$losra_soi
) %>%
filter(
input$losra_pyr_cat == "All" | pyr_group2 == input$losra_pyr_cat
) %>%
filter(
input$losra_med_staff == "All" | med_staff_dept == input$losra_med_staff
) %>%
filter(
input$losra_dsch_ward == "All" | ward_cd == input$losra_dsch_ward
) %>%
collapse_by("monthly") %>%
dplyr::group_by(dsch_date, add = T) %>%
dplyr::summarize(
excess_ra = round(mean(readmit_count - readmit_rate_bench), 3) * 10
, excess_los = round(mean(los - performance), 2)
) %>%
as.data.frame()
}
)
x_min <- reactive({min(gmc_los_ra()$excess_los)})
x_max <- reactive({max(gmc_los_ra()$excess_los)})
y_min <- reactive({min(gmc_los_ra()$excess_ra)})
y_max <- reactive({max(gmc_los_ra()$excess_ra)})
renderPlot({
print(gmc_los_ra())
gmc_los_ra() %>%
ggplot(
aes(
x = excess_los
, y = excess_ra
)
) +
scale_x_continuous(
expand = c(0,0)
, limits = c(
x_min()
, x_max()
)
) +
scale_y_continuous(
expand = c(0,0)
, limits = c(
y_min()
, y_max()
)
) +
ylab("Excess Readmit Rate") +
xlab("Excess LOS") +
labs(
title = "Gartner Magic Quadrant - Excess LOS vs Excess Readmit Rate"
, subtitle = "Red Dot Indicates Zero Variance"
) +
theme(
legend.position = "none"
, axis.title.x = element_text(
hjust = 0
, vjust = 4
, colour = "black"
, size = 10
, face = "bold"
)
, axis.title.y = element_text(
hjust = 0
, vjust = 0
, color = "black"
, size = 10
, face = "bold"
)
, axis.ticks = element_blank()
, panel.border = element_rect(
colour = "lightgrey"
, fill = NA
, size = 4
)
) +
annotate(
"rect"
, xmin = 0
, xmax = x_max()
, ymin = 0
, ymax = y_max()
, fill = "#F8F9F9"
) +
annotate(
"rect"
, xmin = 0
, xmax = x_min()
, ymin = 0
, ymax = y_min()
, fill = "#F8F9F9"
) +
annotate(
"rect"
, xmin = 0
, xmax = x_min()
, ymin = 0
, ymax = y_max()
, fill = "white"
) +
annotate(
"rect"
, xmin = 0
, xmax = x_max()
, ymin = 0
, ymax = y_min()
, fill = "white"
) +
geom_hline(
yintercept = 0
, color = "lightgrey"
, size = 1.5
) +
geom_vline(
xintercept = 0
, color = "lightgrey"
, size = 1.5
) +
geom_label(
aes(
x = 0.75 * x_min()
, y = 0.90 * y_max()
, label = "High RA"
)
, label.padding = unit(2, "mm")
, fill = "lightgrey"
, color="black"
) +
geom_label(
aes(
x = 0.75 * x_max()
, y = 0.90 * y_max()
, label = "High RA/LOS"
)
, label.padding = unit(2, "mm")
, fill = "lightgrey"
, color = "black"
) +
geom_label(
aes(
x = 0.75 * x_min()
, y = 0.90 * y_min()
, label = "Leader"
)
, label.padding = unit(2, "mm")
, fill = "lightgrey"
, color = "black"
) +
geom_label(
aes(
x = 0.75 * x_max()
, y = 0.9 * y_min()
, label = "High LOS"
)
, label.padding = unit(2, "mm")
, fill = "lightgrey"
, color = "black"
) +
geom_point(
color = "#2896BA"
, size = 3
) +
# #where you want to be
geom_point(
data = data.frame(x = 0, y = 0)
, mapping = aes(x = x, y = y, color = 'red')
, size = 3
)
})
添加以下内容可以达到目的：
x_min <- reactive({min(gmc_los_ra()$excess_los)})
x_max <- reactive({max(gmc_los_ra()$excess_los)})
y_min <- reactive({min(gmc_los_ra()$excess_ra)})
y_max <- reactive({max(gmc_los_ra()$excess_ra)})