问题描述
我有这个功能，它在控制台中运行良好。它在一些数据中使用 l ，然后对其进行处理以在名为 'out' 的变量中给出一些比例表。然后使用 ggplot 包绘制这些表。
library(tidyverse)
### your code
u<- c("D","B","C","A")
l<- list(`0` = structure(list(X70 = "D",X71 = "C",X72 = "C",X73 = "A",X74 = "B",X75 = "C",X76 = "D",X77 = NA_character_,X78 = "B",X79 = "D",X80 = "C",Q = 1),row.names = 32L,class = "data.frame"),`1` = structure(list(X70 = c("D","D","D"),X71 = c("B",NA,"A","C"),X72 = c("A",NA),X73 = c("B",X74 = c("B",X75 = c("C",X76 = c("D","B"),X77 = c("D",X78 = c("B",X79 = c("C",X80 = c("B","A"),Q = c(2,2,1,4,3,1)),row.names = c(8L,10L,12L,17L,25L,27L,28L,33L,35L,38L,45L),`2` = structure(list(X70 = c("D",X71 = c("A",X72 = c("D",X74 = c("D",X75 = c("B",X76 = c("A",X77 = c("B",X78 = c("C",X79 = c("A",X80 = c(NA,row.names = c(4L,5L,6L,11L,15L,16L,21L,22L,26L,37L,39L,43L),`3` = structure(list(X70 = c("A",X72 = c("B",X73 = c(NA,X74 = c(NA,X75 = c(NA,X76 = c(NA,X77 = c(NA,X78 = c(NA,X79 = c(NA,2)),row.names = c(2L,13L,14L,18L,19L,20L,29L,30L,34L,36L,41L,44L),`4` = structure(list(X70 = c("D",X74 = c("C",X79 = c("D",X80 = c("C",4)),row.names = c(1L,3L,7L,9L,23L,24L,31L,40L,42L,46L,47L,48L),class = "data.frame"))
out <- lapply(l,function(dat) asplit(as.data.frame(t(sapply(dat,function(x) proportions(table(factor(unlist(x),levels = u)))))),1) ) %>% transpose %>% map(bind_rows,.id = 'grp')
### plot for each table
plot_list = list()
for(i in 1:length(out)){
# transform data to match prevIoUs example
d = out[[i]] %>% t() %>% as.data.frame() %>% tibble::rownames_to_column(var = "x") %>% janitor::row_to_names(row_number = 1)
# mutate
d = d %>%
data.frame() %>%
pivot_longer(cols = 2:ncol(d)) %>%
group_by(grp) %>%
mutate(name = sub("X","",name) %>% as.numeric(),n = 1:n())
# plot
temp_p = ggplot(data = d) +
geom_path(aes(x = name,y = value,group = factor(grp),color = factor(grp)),size = 0.7) +
geom_point(aes(x = name,size = 2) +
geom_text(data = d %>% filter(n == max(n)),aes(x = name,label = grp,nudge_x = 0.2) +
labs(x = "Group",y = "P") +
theme_bw() +
theme(legend.position = "none")
# append
plot_list = append(plot_list,list(temp_p))
}
plot_list
上面的代码运行良好，但是当我尝试在一个闪亮的应用程序中运行它时，它不显示任何图形。它也不会返回任何错误，所以我对问题所在感到非常困惑：-
library(dplyr)
library(tidyr)
library(purrr)
library(ggplot2)
server<- shinyServer(
function(input,output) {
#1 Dataset l
l<- reactive({
f<- list(`0` = structure(list(X70 = "D",class = "data.frame")) })
#2 Vector u
u <- reactive({
u <- c("D","A")
})
#3 reactive expression to process data
out <- reactive({
l <- l()
u <- u()
lapply(l,function(dat)
asplit(as.data.frame(t(sapply(dat,function(x)
proportions(table(factor(unlist(x),1) ) %>%
transpose %>%
map(bind_rows,.id = 'grp')
})
#4 render plots
output$plots <- renderUI({
plot_list = list()
for(i in 1:length(out())){
# transform data to match prevIoUs example
d = out()[[i]] %>% t() %>% as.data.frame() %>% tibble::rownames_to_column(var = "x") %>% janitor::row_to_names(row_number = 1)
# mutate
d = d %>%
data.frame() %>%
pivot_longer(cols = 2:ncol(d)) %>%
group_by(grp) %>%
mutate(name = sub("X",n = 1:n())
# plot
temp_p = ggplot(data = d) +
geom_path(aes(x = name,size = 0.7) +
geom_point(aes(x = name,size = 2) +
geom_text(data = d %>% filter(n == max(n)),nudge_x = 0.2) +
labs(x = "Group",y = "P") +
theme_bw() +
theme(legend.position = "none")
# append
plot_list = append(plot_list,list(temp_p))
plot_list[[1]]
}
})
} )
ui<- shinyUI(fluidPage(
titlePanel(title = h4("proportion graphs",align="center")),sidebarLayout( sidebarPanel( ),mainPanel(
# create a uIoUtput
uIoUtput("plots")
)
)
))
shinyApp(ui,server)
解决方法
如果我在 ui 和 server 中进行以下更改，代码对我来说效果很好。
在 server 中，将 renderUI 更改为 renderPlot 并在 plot_list[[1]] 循环外返回 for。
output$plots <- renderPlot({
#...
#...
#...
plot_list[[1]]
})
在 ui 中，将 uiOutput("plots") 更改为 plotOutput("plots")。