我正在寻找一种方法将两个滑块并排放在dashboardBody中，并且还将两个绘图并排放在与相应滑块相同的列中。对于如何做到这一点，我尝试了一下列函数。我想两栏是可行的。
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)
试试这个
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)