Я совершенно новичок в shiny, который я пытаюсь выучить, построив этот простой app.
В настоящее время он печатает два разных ggplots на основе указанных c input -значений после нажатия actionButton(). Тем не менее, я считаю, что график c немного отключается, когда два графика печатаются рядом друг с другом.
Вопрос: как интегрировать Tabset, который печатает только при нажатии actionButton()? Вкладка должна содержать две вкладки - по одной на каждом графике.
Мое приложение в настоящее время выглядит следующим образом
, который печатает два графика при нажатии actionButton():
Я хотел бы напечатать что-то вроде этого:
и
В ui я пробовал несколько вариантов:
tabsetPanel(type = "tabs",
tabPanel("Plot1", plotOutput("surv_plot")), .....
Без намеченного выхода.
Мой shinyapp написан с (общие комментарии и улучшения скрипта приветствуются):
library(shiny)
library(shinyjs)
library(survminer)
library(shinycustomloader)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
br(),
titlePanel(
h1("Text", align="center")
),
br(),
div(HTML("Text, <em>et al.</em>: <strong>Text</strong>" )),
div(HTML("DOI: " )),
br(), br(),
fluidRow(
column(
3,
wellPanel(
style = "height:150px",
sliderInput("n_fjernet", "Lymph Nodal Yield",
min = 2, max = 120, value = 40)
)
),
column(
3,
wellPanel(
style = "height:150px",
sliderInput("n_sygdom", "Number of positive lymph nodes",
min = 0, max = 40, value = 0)
)
),
column(
3,
wellPanel(
style = "height:150px",
radioButtons("ecs", "Extracapsular extension", c("No","Yes"))
)
),
column(
3,
wellPanel(
style = "height:150px",
radioButtons("contra_pos", "Neck involvement", c("Contra.","Ipsi."))
)
)
),
fluidRow(align="center", br(), actionBttn("do", "Submit", style = "material-flat")),
br(), br(),
h3(textOutput("starttext"), align="center"),
tags$head(tags$style("#starttext{color: grey20;
font-size: 20px;
font-style: plain;
}"
)
),
fluidRow(br(),
column(12, align="center",
withLoader(plotOutput("load_plot", width = "1%", height="10px"),
type="html", loader="dnaspin")
),
column(6, align="center",
textOutput("nomtext"),
tags$head(tags$style("#nomtext{color: grey20;
font-size: 40px;
font-style: plain;
}"
)
),
plotOutput("surv_nom", width = "105%", height="600px")
),
column(6, align="center",
textOutput("survtext"),
tags$head(tags$style("#survtext{color: grey20;
font-size: 40px;
font-style: plain;
}"
)
),
plotOutput("surv_plot", width = "95%", height="600px")
)
)
)
server <- function(input, output, session) {
observeEvent(input[["n_sygdom"]], {
if(input[["n_sygdom"]] < 1){
disable("ecs")
disable("contra_pos")
}else{
enable("ecs")
enable("contra_pos")
}
})
rvs <- reactiveValues(n_sygdom = 0)
observeEvent(input$n_sygdom, {
if ((input$n_sygdom == 0)) {
updateRadioButtons(session, "ecs", selected = "No")
updateRadioButtons(session, "contra_pos", selected = "Contra.")
}
rvs$n_sygdom <- input$n_sygdom
})
observe(
updateSliderInput(
session = session,
inputId = "n_sygdom",
max = min(40, input$n_fjernet),
value = min(input$n_fjernet, input$n_sygdom)
)
)
reactive_nom_text <- eventReactive(input$do, {
paste0("Individualized pN-score")
})
output$nomtext <- renderText({
reactive_nom_text()
})
reactive_surv_text <- eventReactive(input$do, {
paste0("Survival probability")
})
output$survtext <- renderText({
reactive_surv_text()
})
reactive_start <- eventReactive(input$do, {
paste0("Such patient yield a pN-score of ")
})
output$starttext <- renderText({
reactive_start()
})
reactive_surv_plot <- eventReactive(input$do, {
set.seed(1)
df <- data.frame(y=sample(1:17,1000, replace=TRUE), x=sample(0:100, 1000, replace=TRUE))
ggplot(df, aes(x=x, y=y))
})
output$surv_plot <- renderPlot({
reactive_surv_plot()
})
reactive_surv_nom <- eventReactive(input$do, {
set.seed(1)
df <- data.frame(y=sample(1:17,1000, replace=TRUE), x=sample(0:100, 1000, replace=TRUE))
ggplot(df, aes(x=x, y=y))
})
output$surv_nom <- renderPlot({
reactive_surv_nom()
})
reactive_load <- eventReactive(input$do, {
set.seed(1)
df <- data.frame(y=sample(1:17,1000, replace=TRUE), x=sample(0:100, 1000, replace=TRUE))
ggplot(df, aes(x=x, y=y))
})
output$load_plot <- renderPlot({
reactive_load()
})
}
shinyApp(ui, server)