模块化闪亮应用程序中的ggplots对齐

debugcn 发表于 Dev

琼·普格

我有一个模块化的闪亮应用程序，可以实时显示4个变量。监视模块将一个大数据帧作为输入，并显示分配的信号。这4个模块在ui中堆叠在一起：

    tabBox(id = "monitoring_tabBox",
           height = monitor_height_px,
           width = "500px",
           tabPanel(id = "layout1",
             title = "Layout 1",
             monitorModuleUI("sbto2"),
             monitorModuleUI("icp"),
             monitorModuleUI("map"),
             monitorModuleUI("ptio2")
           )
    ),

问题如下：各个模块之间的图不完全对齐。主要是因为y ticks值具有不同的范围（请参阅icp和ptio2的对齐方式，因为两个信号均为两位数，没有小数位）

我已经看到了几种对齐ggplots的技术，但是您需要将4个绘图作为输入，然后将它们全部合并到一个绘图/渲染中。我想避免此步骤，以保持应用程序的模块化结构。

我有什么方法可以对齐这些图而不必将它们拼接在一起吗？（即通过限制y刻度的长度）

先感谢您！

屏幕截图：

屏幕截图，显示了4个模块和未对准问题

可重现的示例：

library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)


# Sample Data

df <- data.frame(timestamp = seq(as.POSIXct("2020-06-01 10:00:00"), as.POSIXct("2020-06-01 12:00:00"), "1 min"),
                 sbto2 = round(10000*rnorm(121, 0, 2), 1),
                 map = round(100*rnorm(121, 0, 2), 1),
                 icp = round(10*rnorm(121, 0, 1.5), 1),
                 ptio2 = round(1000*rnorm(121, 0, 1.2), 1))

# monitorModule

monitorModuleUI <- function(id){

  ns <- NS(id)

  fluidRow(
    column(8,
           plotOutput(ns("monitoring_plot"),
                      height = "150px")     
    ),
    column(2,
           uiOutput(ns("monitoring_text"))
    )
  )




}

monitorModule <- function(input, output, server, variable_name, df){

  output$monitoring_plot <- renderPlot({
    p()
  })

  p <- reactive({
    df %>%
      gather("var", "value",seq(2,5)) %>%
      filter(var == variable_name) %>%
      ggplot(aes(x = timestamp, y = value)) + geom_line() -> p

    return(p)
  })

  output$monitoring_text <- renderUI({
    value <- p()$data$value[nrow(p()$data)]
    h1(strong(paste(value)), style = "font-size:90;")
  })

}

# APP

ui <- shinyServer(fluidPage(

  monitorModuleUI("sbto2"),
  monitorModuleUI("icp"),
  monitorModuleUI("ptio2"),
  monitorModuleUI("map")

))


server <- shinyServer(function(input, output, session){

  callModule(monitorModule, "sbto2", "sbto2", df)
  callModule(monitorModule, "icp", "icp", df)
  callModule(monitorModule, "ptio2", "ptio2", df)
  callModule(monitorModule, "map", "map", df)

})

shinyApp(ui=ui,server=server)

布雷泰夫

一种选择是从每个模块返回一个反应图，然后将其与包一起组织{patchwork}。

这是一个例子：

library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)
library(patchwork)

# Sample Data

df <- data.frame(timestamp = seq(as.POSIXct("2020-06-01 10:00:00"), as.POSIXct("2020-06-01 12:00:00"), "1 min"),
                 sbto2 = round(10000*rnorm(121, 0, 2), 1),
                 map = round(100*rnorm(121, 0, 2), 1),

                              icp = round(10*rnorm(121, 0, 1.5), 1),
                 ptio2 = round(1000*rnorm(121, 0, 1.2), 1))

# monitorModule

monitorModuleUI <- function(id){
  # ns <- NS(id)
  # plotOutput(ns("monitoring_plot"),
  #            height = "150px")
}

monitorModule <- function(input, output, server, variable_name, df){

  test <- reactive({
    df %>%
      gather("var", "value",seq(2,5)) %>%
      filter(var == variable_name) %>%
      ggplot(aes(x = timestamp, y = value)) + geom_line() -> p

    return(p)
  })

}

# APP

ui <- fluidPage(

  monitorModuleUI("sbto2"),
  monitorModuleUI("icp"),
  monitorModuleUI("ptio2"),
  monitorModuleUI("map"),

  plotOutput("all_plots")

)


server <- function(input, output, session){

  plot_1 <- callModule(monitorModule, "sbto2", "sbto2", df)
  plot_2 <- callModule(monitorModule, "icp", "icp", df)
  plot_3 <- callModule(monitorModule, "ptio2", "ptio2", df)
  plot_4 <- callModule(monitorModule, "map", "map", df)

  output$all_plots <- renderPlot({
    plot_1() / plot_2() / plot_3() / plot_4()
 })

}

shinyApp(ui=ui,server=server)

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。