Shiny R：情节显示不佳
Posted
技术标签:
【中文标题】Shiny R：情节显示不佳【英文标题】：Shiny R: bad display of plots in plotly 【发布时间】：2021-08-12 07:36:57 【问题描述】：我在显示绘图时遇到了一些问题。它们是动态添加的：选择的变量越多，绘制的图就越多。问题是没有空间尊重。
这是代码：
dades <- iris
binary_variable <- factor(sample(x = c(0, 1), size = nrow(dades), replace = TRUE))
dades <- cbind(iris, binary_variable)
ui <- fluidPage(
column(2, ),
column(8,
fluidRow(
column(4,
selectInput("resposta", "Dependent variable", choices = names(dades))
),
column(4,
textInput("explicatives", "Independent variables")
),
column(4,
actionButton("executar", "Run")
)
),
fluidRow(align = "center",
verbatimTextOutput("resultat"),
uiOutput("grafics")
)
),
column(2, )
)
server <- function(input, output, session)
model <- reactive(
if(input$executar == 0)
return(invisible(NULL))
else
isolate(
resposta2 <- factor(dades[, input$resposta])
etiquetes <- levels(resposta2)
levels(resposta2) <- c(0, 1)
resposta2 <- factor(resposta2, levels = c(0, 1), labels = etiquetes)
f <- as.formula(paste0("resposta2 ~ ", input$explicatives))
glm(formula = f, family = binomial, data = dades)
)
)
output$resultat <- renderPrint(
if(input$executar == 0)
return(invisible(NULL))
else
isolate(
summary(model())
)
)
observe(
if(input$executar == 0)
return(invisible(NULL))
else
lapply(names(model()$model)[-1], function(par)
if (is.factor(model()$model[, par]) || is.character(model()$model[, par]) || is.integer(model()$model[, par]))
taula <- as.data.frame(table(model()$model$resposta2, model()$model[, par]))
p <- plot_ly(taula, x = ~ Var1, y = ~Freq, color = ~Var2, type = "bar") %>%
layout(title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), height = 500, width = 500, inline = TRUE)
output[[paste("plot", par, sep = "_")]] <- renderPlotly(
p
)
else if (is.numeric(model()$model[, par]))
p <- plot_ly(model()$model, y = ~model()$model[, par], color = ~resposta2, type = "box") %>%
layout(title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), height = 500, width = 500, inline = TRUE)
output[[paste("plot", par, sep = "_")]] <- renderPlotly(
p
)
)
)
output$grafics <- renderUI(
if(input$executar == 0)
return(invisible(NULL))
else
plot_output_list <- lapply(names(model()$model)[-1], function(par)
plotname <- paste("plot", par, sep = "_")
plotlyOutput(plotname)
)
do.call(flowLayout, plot_output_list)
)
shinyApp(ui, server)
在“因变量”输入中，您必须选择“binary_variable”并在“自变量”中输入类似“Sepal.Length + Sepal.Width + Species”的内容。问题是情节就像叠加，就像它们之间没有足够的空间一样。我该如何解决这个问题？
【问题讨论】：
【参考方案1】：虽然您不能在layout() 中指定width 和height，但您可以让它autosize。此外，最好将图例放在底部，因为水平显示多个图。试试这个
ui <- fluidPage(
column(2, ),
column(8,
fluidRow(
column(4,
selectInput("resposta", "Dependent variable", choices = names(dades))
),
column(4,
textInput("explicatives", "Independent variables")
),
column(4,
actionButton("executar", "Run")
)
),
fluidRow(# align = "center",
column(12, verbatimTextOutput("resultat")),
column(12, uiOutput("grafics"))
)
),
column(2, )
)
server <- function(input, output, session)
model <- reactive(
if(input$executar == 0)
return(invisible(NULL))
else
isolate(
resposta2 <- factor(dades[, input$resposta])
etiquetes <- levels(resposta2)
levels(resposta2) <- c(0, 1)
resposta2 <- factor(resposta2, levels = c(0, 1), labels = etiquetes)
f <- as.formula(paste0("resposta2 ~ ", input$explicatives))
glm(formula = f, family = binomial, data = dades)
)
)
output$resultat <- renderPrint(
if(input$executar == 0)
return(invisible(NULL))
else
isolate(
summary(model())
)
)
observe(
if(input$executar == 0)
return(invisible(NULL))
else
lapply(names(model()$model)[-1], function(par)
if (is.factor(model()$model[, par]) || is.character(model()$model[, par]) || is.integer(model()$model[, par]))
taula <- as.data.frame(table(model()$model$resposta2, model()$model[, par]))
p <- plot_ly(taula, x = ~ Var1, y = ~Freq, color = ~Var2, type = "bar") %>%
layout(legend = list(orientation = "h"), title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), autosize=TRUE )
output[[paste("plot", par, sep = "_")]] <- renderPlotly(
p
)
else if (is.numeric(model()$model[, par]))
p <- plot_ly(model()$model, y = ~model()$model[, par], color = ~resposta2, type = "box") %>%
layout(legend = list(orientation = "h"), title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), autosize=TRUE )
output[[paste("plot", par, sep = "_")]] <- renderPlotly(
p
)
)
)
output$grafics <- renderUI(
if(input$executar == 0)
return(invisible(NULL))
else
plot_output_list <- lapply(names(model()$model)[-1], function(par)
plotname <- paste("plot", par, sep = "_")
plotlyOutput(plotname)
)
do.call(flowLayout, plot_output_list)
)
shinyApp(ui, server)
【讨论】：
以上是关于Shiny R：情节显示不佳的主要内容，如果未能解决你的问题，请参考以下文章
在 R 中的 Shiny 中部署 dataTableOutput 和绘图； “整理” dataTableOutput