r - 将滑块和图像并排放在dashboardBody上

Question

我正在寻找一种将两个滑块并排放置在仪表板主体中的方法，并将两个图并排放置在与相应滑块相同的列中。任何想法如何做到这一点，我尝试了一下列功能。我想制作两列是方法。

data_prep.miRNA.complete.plot  <- structure(list(miRNA = c("hsa-let-7a-3p", "hsa-let-7a-3p", "URS0000681820-snRNA", 
"URS0000681820-snRNA"), ID = c("86", "175", "9873", "9989"), 
    value = c(6.11215002618037, 5.03074511800067, 8.5907457800894, 
    2.25990049836193), Alder = c(75L, 68L, 69L, 55L), Kjonn = c("Mann", 
    "Mann", "Mann", "Kvinne"), BoneDisease = c("utenBD", "BD", 
    "utenBD", "BD"), ISS_Stadium_inndeling_Dec2018 = c("3", "1", 
    "3", "3"), ProgessionDate = c("12/12/2019", "17/06/2014", 
    "29/12/2017", "14/11/2019"), Progression = c(0L, 1L, 1L, 
    1L), DeadTimepoints = c("2015-11-24", "2014-10-06", "2018-02-04", 
    "2020-09-01"), Status = c(1L, 1L, 1L, 1L), TimeDiff = c(71.0416666666667, 
    601.958333333333, 2796.04166666667, 1903), Relapse = c("2019-12-12", 
    "2014-06-17", "2017-12-29", "2019-11-14"), TimeDiffRelapse = c(1550.04166666667, 
    490.958333333333, 2759.04166666667, 1611.04166666667), RNAType = c("MicroRNA", 
    "MicroRNA", "snRNA", "snRNA")), row.names = c(NA, -4L), class = c("tbl_df", 
"tbl", "data.frame"))



types <- c("T", "F")



ui.miRNA <- dashboardPage(
  # Application title
  dashboardHeader(title=h4(HTML("Plot"))),
  dashboardSidebar(
    selectInput(
      "MicroRNA", "MicroRNA",
      choices = data_prep.miRNA.complete.plot %>% filter(RNAType == "MicroRNA") %>% distinct(miRNA) %>% pull(miRNA)
    ),
    selectInput(
      "snRNA", "Other sncRNA",
      choices = data_prep.miRNA.complete.plot %>% filter(RNAType == "snRNA") %>% distinct(miRNA) %>% pull(miRNA)
    ),
    materialSwitch(inputId = "pval1", label = "MicroRNA P-value"),
    materialSwitch(inputId = "pval2", label = "Other sncRNA P-value"),
    materialSwitch(inputId = "risk1", label = "MicroRNA Risk table"),
    materialSwitch(inputId = "risk2", label = "Other sncRNA Risk table")
    
  ),
  dashboardBody(
    sliderInput("obs1", "Quantiles MicroRNA",
                min = 0, max = 1, value = c(0.5, 1)
    ),
    sliderInput("obs2", "Quantiles other sncRNA",
                min = 0, max = 1, value = c(0.5, 1)
    ),
    tabsetPanel(
      tabPanel("Plot",
               plotOutput("myplot1", width = "400px", height = "400px"),
               plotOutput("myplot2", width = "400px", height = "400px"))
    )
  )
)



server <- function(input, output, session) {
  
  output$myplot1 <- renderPlot({
    req(input$MicroRNA)
    df.t.sub <- data_prep.miRNA.complete.plot %>% filter(RNAType == "MicroRNA" & miRNA %in% input$MicroRNA)
    lower_value <- input$obs1[1]
    upper_value <- input$obs1[2]
    fitSurv <-   survfit(Surv(TimeDiff, Status) ~ cut(value, quantile(value, probs = c(0, lower_value, upper_value)), include.lowest=TRUE),data = df.t.sub)
    new_env <- environment()
    new_env$value <- df.t.sub$value
    new_env$TimeDiff <- df.t.sub$TimeDiff
    new_env$Status <- df.t.sub$Status
    new_env$lower_value <- lower_value
    new_env$upper_value <- upper_value
    ggsurvplot(fitSurv, 
               new_env,
               title="MicroRNA", xlab="Time (Yrs)",ylab="Survival prbability",
               font.main = 8,font.x =  8,font.y = 8,font.tickslab = 8,font.legend=8,pval.size = 3,
               font.title = c(16, "bold"),pval.coord = c(1000,1),size=0.4,legend = "right",
               censor.size=2,break.time.by = 365,pval =input$pval1,fontsize =2,
               palette = c("blue", "red"),ggtheme = theme_bw(),risk.table = input$risk1,xscale=365.25,
               xlim=c(0,7*365),legend.title = "Expression",legend.labs = c("Low","High"))
    
  })
  
  output$myplot2 <- renderPlot({
    req(input$snRNA)
    df.t.sub <- data_prep.miRNA.complete.plot %>% filter(RNAType == "snRNA" & miRNA %in% input$snRNA)
    lower_value <- input$obs2[1]
    upper_value <- input$obs2[2]
    fitSurv <-   survfit(Surv(TimeDiff, Status) ~ cut(value, quantile(value, probs = c(0, lower_value, upper_value)), include.lowest=TRUE),data = df.t.sub)
    new_env <- environment()
    new_env$value <- df.t.sub$value
    new_env$TimeDiff <- df.t.sub$TimeDiff
    new_env$Status <- df.t.sub$Status
    new_env$lower_value <- lower_value
    new_env$upper_value <- upper_value
    ggsurvplot(fitSurv, 
               new_env,
               title="sRNA", xlab="Time (Yrs)",ylab="Survival prbability",
               font.main = 8,font.x =  8,font.y = 8,font.tickslab = 8,font.legend=8,pval.size = 3,
               font.title = c(16, "bold"),pval.coord = c(1000,1),size=0.4,legend = "right",
               censor.size=2,break.time.by = 365,pval =input$pval2,fontsize =2,
               palette = c("blue", "red"),ggtheme = theme_bw(),risk.table = input$risk2,xscale=365.25,
               xlim=c(0,7*365),legend.title = "Expression",legend.labs = c("Low","High"))
    
  })
  
}

shinyApp(ui.miRNA, server)

标签： rshiny

Answer 1

试试这个

ui.miRNA <- dashboardPage(
  # Application title
  dashboardHeader(title=h4(HTML("Plot"))),
  dashboardSidebar(
    # selectInput(
    #   "MicroRNA", "MicroRNA",
    #   choices = data_prep.miRNA.complete.plot %>% filter(RNAType == "MicroRNA") %>% distinct(miRNA) %>% pull(miRNA)
    # ),
    # selectInput(
    #   "snRNA", "Other sncRNA",
    #   choices = data_prep.miRNA.complete.plot %>% filter(RNAType == "snRNA") %>% distinct(miRNA) %>% pull(miRNA)
    # ),
    # materialSwitch(inputId = "pval1", label = "MicroRNA P-value"),
    # materialSwitch(inputId = "pval2", label = "Other sncRNA P-value"),
    # materialSwitch(inputId = "risk1", label = "MicroRNA Risk table"),
    # materialSwitch(inputId = "risk2", label = "Other sncRNA Risk table")
    
  ),
  dashboardBody(
    fluidRow(
      column(5, sliderInput("obs1", "Quantiles MicroRNA", min = 0, max = 1, value = c(0.5, 1))),
      column(5, sliderInput("obs2", "Quantiles other sncRNA", min = 0, max = 1, value = c(0.5, 1)))
    ),
    tabsetPanel(
      tabPanel("Plot", fluidRow(column(5, plotOutput("myplot1", width = "400px", height = "400px")),
                                column(5, plotOutput("myplot2", width = "400px", height = "400px"))
                                )
      )
    )
  )
)

server <- function(input, output, session){
  output$myplot1<-renderPlot({plot(cars)})
  output$myplot2<-renderPlot({plot(pressure)})
}

shinyApp(ui=ui.miRNA, server = server)