【发布时间】：2020-08-09 18:40:32
【问题描述】：
我对@987654329@ 完全陌生，我正在尝试通过构建这个简单的app 来学习它。
当前，在单击actionButton() 后，它会根据特定的input 值打印两个不同的ggplots。但是，当两个图彼此相邻打印时，我发现图形有点偏离。
问题：我怎样才能集成一个Tabset，当actionButton() 被点击时 打印？选项卡集应包含两个选项卡 - 每个绘图一个。
我的应用目前看起来像这样
点击actionButton() 时会打印两个图：
我想打印这样的东西：
和
在ui，我尝试了多种变体：
tabsetPanel(type = "tabs",
tabPanel("Plot1", plotOutput("surv_plot")), .....
没有预期的输出。
我的shinyapp 是用（欢迎一般 cmets 和脚本改进）：
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)
【问题讨论】：
标签： r plot shiny tabs shinyapps