如何解决R [Shiny]：尝试输出反应模型摘要时出错
我最近一直在使用 gapminder 数据集探索闪亮和闪亮的仪表板，并遇到了我的最新问题，试图输出使用基于用户选择的响应变量和预测变量创建的反应模型的摘要。目的是同时输出 3 个模型（基数、对数和逆）的 EDA 图和摘要，这就是 var_EDA_plots() 有点混乱的原因。返回的错误是：
# Error: argument 1 (type 'list') cannot be handled by 'cat'
与简单线性回归建模相关的代码是：
界面
# LM Page Content
tabItem(tabName = "lm",h2("Simple Linear Regression"),h3(wellPanel(fluidRow(
column(2,"Response Variable:"),column(2,selectInput("response","",colnames(data)[4:6],multiple = FALSE,selected = "lifeExp")),"Predictor Variable: "),selectInput("predictor",selected = "gdpPercap"))))
),tabsetPanel(type = "tabs",tabPanel("Plot",splitLayout(
plotOutput("EDAplotBase"),plotOutput("EDAplotLog"),plotOutput("EDAplotInv"))),tabPanel("Summary",verbatimtextoutput("base.lm")),tabPanel("Table",tableOutput("EDAtable"))
))
服务器
# LINEAR MODELLING ----
# Format Predictor and Response col names
var_EDA_plots <- reactive({
str_col_predictor <- as.character(input$predictor)
str_col_response <- as.character(input$response)
transformed_data <- data %>% select(str_col_response,str_col_predictor,continent,country,year)
transformed_data$predictor_base <- unlist(transformed_data[2])
transformed_data$predictor_log <- unlist(log(transformed_data[2]))
transformed_data$predictor_inv <- unlist(1/transformed_data[2])
transformed_data$response <- unlist(transformed_data[1])
transformed_data %>% select(continent,year,response,predictor_base,predictor_log,predictor_inv)
})
# Build linear models reactively
var_lm_base <- reactive({
fml <- as.formula("response ~ predictor_base")
lm(fml,data = var_EDA_plots())
})
# Base LM Model
output$base.lm <- renderText({
summary(var_lm_base())
})
output$EDAtable <- renderTable({var_EDA_plots()})
下面我将粘贴闪亮仪表板的完整代码，如果它更容易进行整体调试和测试（线性建模部分位于服务器底部）：
library(shiny)
library(tidyverse)
library(shinydashboard)
library(gapminder)
# LOAD DATA ----
data <- gapminder %>% as_tibble() %>% arrange(country,year)
# LINEAR MODELLING ----
set.seed(117)
train <- data %>% slice_sample(prop = 0.8)
test <- data %>% slice_sample(prop = 0.2)
# UI ----
ui <- dashboardPage(
dashboardHeader(title = "Gapminder Dashboard"),dashboardSidebar(
sidebarMenu(id = "tabs",menuItem("Dashboard",tabName = "dashboard",icon = icon("dashboard"),menuSubItem("Life Expectancy",tabName = "life"),menuSubItem("GDP Per Capita",tabName = "gdp")),menuItem("Linear Modelling",icon = icon("th"),tabName = "lm",badgeLabel = "new",badgeColor = "green"),fluidPage(
selectInput("dateStart","Start date:",distinct(data,year),selected = 1952),selectInput("dateEnd","End date:",selected = 2007),selectInput("country1","Select primary country:",country),selected = "Australia"),selectInput("country2","Select secondary country:",selected = "Greece")
))),dashboardBody(
tabItems(
# Life Expectancy Page Content
tabItem(tabName = "life",# Top 5 KPIs
splitLayout(
valueBoxOutput("kpi.top5.life1",width = NULL),valueBoxOutput("kpi.top5.life2",valueBoxOutput("kpi.top5.life3",valueBoxOutput("kpi.top5.life4",valueBoxOutput("kpi.top5.life5",width = NULL)
),# Life Expectancy Histogram
fluidPage(
plotOutput("histLifeExp")
),# Life Expectancy & Population Plots
splitLayout(
plotOutput("lineplotLife"),plotOutput("lineplotPopn")
),# Bottom 5 KPIs
splitLayout(
valueBoxOutput("kpi.btm5.life1",valueBoxOutput("kpi.btm5.life2",valueBoxOutput("kpi.btm5.life3",valueBoxOutput("kpi.btm5.life4",valueBoxOutput("kpi.btm5.life5",width = NULL)
)),# GDP Page Content
tabItem(tabName = "gdp",# Top 5 KPIs
splitLayout(
valueBoxOutput("kpi.top5.gdp1",valueBoxOutput("kpi.top5.gdp2",valueBoxOutput("kpi.top5.gdp3",valueBoxOutput("kpi.top5.gdp4",valueBoxOutput("kpi.top5.gdp5",# GDP Histogram
fluidPage(
plotOutput("histGDP")
),# GDP & Population Plots
splitLayout(
plotOutput("lineplotgdp"),plotOutput("lineplotPopn2")
),# Bottom 5 KPIs
splitLayout(
valueBoxOutput("kpi.btm5.gdp1",valueBoxOutput("kpi.btm5.gdp2",valueBoxOutput("kpi.btm5.gdp3",valueBoxOutput("kpi.btm5.gdp4",valueBoxOutput("kpi.btm5.gdp5",# LM Page Content
tabItem(tabName = "lm",h3(wellPanel(fluidRow(
column(2,selected = "gdpPercap"))))
),splitLayout(
plotOutput("EDAplotBase"),tableOutput("EDAtable"))
))
)
)
)
# SERVER ----
server <- function(input,output) {
# REACTIVE DATA FILTERING ----
# Top 5 Life Exp KPIs - date filtering
var_maxDate_kpi_top5_life <- reactive({
val <- as.integer(input$dateEnd)
data %>% filter(year == val) %>% slice_max(n = 5,order_by = lifeExp)
})
# Bottom 5 Life Exp KPIs - date filtering
var_maxDate_kpi_btm5_life <- reactive({
val <- as.integer(input$dateEnd)
data %>% filter(year == val) %>% slice_min(n = 5,order_by = lifeExp)
})
# Top 5 GDP KPIs - date filtering
var_maxDate_kpi_top5_gdp <- reactive({
val <- as.integer(input$dateEnd)
data %>% filter(year == val) %>% slice_max(n = 5,order_by = gdpPercap)
})
# Bottom 5 GDP KPIs - date filtering
var_maxDate_kpi_btm5_gdp <- reactive({
val <- as.integer(input$dateEnd)
data %>% filter(year == val) %>% slice_min(n = 5,order_by = gdpPercap)
})
# General Life Expectancy Reactive Filtering
var_date_and_country <- reactive({
startVal <- as.integer(input$dateStart)
endVal <- as.integer(input$dateEnd)
country1 <- as.character(input$country1)
country2 <- as.character(input$country2)
data %>% filter(year >= startVal & year <= endVal & country %in% c(country1,country2))
})
# LIFE EXPECTANCY ----
# Value Boxes - Top 5 KPIs | Life Expectancy
output$kpi.top5.life1 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_top5_life()$lifeExp[1],1),"years"),paste(var_maxDate_kpi_top5_life()$country[1]," (",input$dateEnd,")",sep = ""),icon = icon("heart"),color = "green")
})
output$kpi.top5.life2 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_top5_life()$lifeExp[2],paste(var_maxDate_kpi_top5_life()$country[2],color = "green")
})
output$kpi.top5.life3 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_top5_life()$lifeExp[3],paste(var_maxDate_kpi_top5_life()$country[3],color = "green")
})
output$kpi.top5.life4 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_top5_life()$lifeExp[4],paste(var_maxDate_kpi_top5_life()$country[4],color = "green")
})
output$kpi.top5.life5 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_top5_life()$lifeExp[5],paste(var_maxDate_kpi_top5_life()$country[5],color = "green")
})
# GGPLOT - Life Expectancy
output$lineplotLife <- renderPlot({
ggplot(var_date_and_country(),aes(x = year,y = lifeExp,color = country)) +
geom_line(lwd = 1.5) +
theme_grey() +
labs(x = "Year",y = "Life Expectancy",title = paste("Life Expectancy Trend over time (",input$country1," v ",input$country2,sep = ""))
})
output$lineplotPopn <- renderPlot({
ggplot(var_date_and_country(),y = (pop/10^6),y = "Population (Millions)",title = paste("Country Population in millions over time (",sep = ""))
})
output$histLifeExp <- renderPlot({
ggplot(data,aes(x = lifeExp,color = continent,fill = continent)) +
geom_histogram() +
theme_grey() +
labs(x = "Life Expectancy",y = "Frequency",title = "Life Expectancy distribution by Continent")
})
# Value Boxes - Bottom 5 KPIs | Life Expectancy
output$kpi.btm5.life1 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_btm5_life()$lifeExp[1],paste(var_maxDate_kpi_btm5_life()$country[1],color = "red")
})
output$kpi.btm5.life2 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_btm5_life()$lifeExp[2],paste(var_maxDate_kpi_btm5_life()$country[2],color = "red")
})
output$kpi.btm5.life3 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_btm5_life()$lifeExp[3],paste(var_maxDate_kpi_btm5_life()$country[3],color = "red")
})
output$kpi.btm5.life4 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_btm5_life()$lifeExp[4],paste(var_maxDate_kpi_btm5_life()$country[4],color = "red")
})
output$kpi.btm5.life5 <- renderValueBox({
valueBox(paste(round(var_maxDate_kpi_btm5_life()$lifeExp[5],paste(var_maxDate_kpi_btm5_life()$country[5],color = "red")
})
# GDP PER CAPITA ----
# Value Boxes - Top 5 KPIs | GDP Per Capita
output$kpi.top5.gdp1 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_top5_gdp()$gdpPercap[1]/1000,"k"),paste(var_maxDate_kpi_top5_gdp()$country[1],icon = icon("dollar-sign"),color = "green")
})
output$kpi.top5.gdp2 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_top5_gdp()$gdpPercap[2]/1000,paste(var_maxDate_kpi_top5_gdp()$country[2],color = "green")
})
output$kpi.top5.gdp3 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_top5_gdp()$gdpPercap[3]/1000,paste(var_maxDate_kpi_top5_gdp()$country[3],color = "green")
})
output$kpi.top5.gdp4 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_top5_gdp()$gdpPercap[4]/1000,paste(var_maxDate_kpi_top5_gdp()$country[4],color = "green")
})
output$kpi.top5.gdp5 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_top5_gdp()$gdpPercap[5]/1000,paste(var_maxDate_kpi_top5_gdp()$country[5],color = "green")
})
# GGPLOT - GDP Per Capita
output$lineplotgdp <- renderPlot({
ggplot(var_date_and_country(),y = gdpPercap/1000,y = "GDP Per Capita (000's)",title = paste("GDP Per Capita Trend over time (",sep = ""))
})
output$lineplotPopn2 <- renderPlot({
ggplot(var_date_and_country(),sep = ""))
})
output$histGDP <- renderPlot({
ggplot(data,aes(x = gdpPercap,fill = continent)) +
geom_histogram() +
theme_grey() +
labs(x = "GDP Per Capita",title = "GDP Per Capita distribution by Continent")
})
# Value Boxes - Bottom 5 KPIs | GDP Per Capita
output$kpi.btm5.gdp1 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_btm5_gdp()$gdpPercap[1]/1000,paste(var_maxDate_kpi_btm5_gdp()$country[1],color = "red")
})
output$kpi.btm5.gdp2 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_btm5_gdp()$gdpPercap[2]/1000,paste(var_maxDate_kpi_btm5_gdp()$country[2],color = "red")
})
output$kpi.btm5.gdp3 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_btm5_gdp()$gdpPercap[3]/1000,paste(var_maxDate_kpi_btm5_gdp()$country[3],color = "red")
})
output$kpi.btm5.gdp4 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_btm5_gdp()$gdpPercap[4]/1000,paste(var_maxDate_kpi_btm5_gdp()$country[4],color = "red")
})
output$kpi.btm5.gdp5 <- renderValueBox({
valueBox(paste("$",round(var_maxDate_kpi_btm5_gdp()$gdpPercap[5]/1000,paste(var_maxDate_kpi_btm5_gdp()$country[5],color = "red")
})
# LINEAR MODELLING ----
# Format Predictor and Response col names
var_EDA_plots <- reactive({
str_col_predictor <- as.character(input$predictor)
str_col_response <- as.character(input$response)
transformed_data <- data %>% select(str_col_response,year)
transformed_data$predictor_base <- unlist(transformed_data[2])
transformed_data$predictor_log <- unlist(log(transformed_data[2]))
transformed_data$predictor_inv <- unlist(1/transformed_data[2])
transformed_data$response <- unlist(transformed_data[1])
transformed_data %>% select(continent,predictor_inv)
})
# Build linear models reactively
var_lm_base <- reactive({
fml <- as.formula("response ~ predictor_base")
lm(fml,data = var_EDA_plots())
})
# Base EDA Scatter plot
output$EDAplotBase <- renderPlot({
ggplot(var_EDA_plots(),aes(x = predictor_base,y = response)) +
geom_point(aes(color = continent)) +
geom_smooth(method = "lm",se = TRUE) +
theme_grey() +
labs(x = paste(input$predictor,"(Predictor)"),y = paste(input$response,"(Response)"),title = paste(input$predictor,"v",input$response))
})
# Log EDA Scatter plot
output$EDAplotLog <- renderPlot({
ggplot(var_EDA_plots(),aes(x = predictor_log,se = TRUE) +
theme_grey() +
labs(x = paste("log(",input$predictor,") (Predictor)",title = paste("log(",") v ",input$response,sep = ""))
})
# Inv EDA Scatter plot
output$EDAplotInv <- renderPlot({
ggplot(var_EDA_plots(),aes(x = predictor_inv,se = TRUE) +
theme_grey() +
labs(x = paste("1/"," (Predictor)",title = paste("1/",sep = ""))
})
# Base LM Model
output$base.lm <- renderText({
summary(var_lm_base())
})
output$EDAtable <- renderTable({var_EDA_plots()})
}
shinyApp(ui,server)
非常感谢任何帮助，谢谢:)
解决方法
使用 renderPrint 作为摘要输出。
output$base.lm <- renderPrint({
summary(var_lm_base())
})
renderText() 无法处理列表。将 summary 与 lm 对象一起使用将产生长度为 11 的列表。修复它的最简单方法是将渲染函数更改为 renderPrint()。
# Base LM Model
output$base.lm <- renderPrint({
summary(var_lm_base())
})
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
