How to place 2 barplots next to each other in R Shiny

shiny
,
1

Hi everyone,

I just started learning R to program an experiment for my thesis, so sorry in advance for asking what are probably super basic questions.

I want to build a survey (in German) consisting of multiple pages.

On the page HSVG1 I would like to include two barplots as visualization of options two choose from with corresponding actionButtons, and a sliderInput below (already included).

I am wondering how to add two horizontal barplots to the page in a way that they appear above the action buttons G1A and G1B . I tried adding a vector (10,20) to use for the height of the plot, but it always returned an error (Text to be written must be a length-one character vector).

Pls find the code I came up with so far below.

Help would be much appreciated - I can´t really find a solution on my own!

library(shiny); library(shinyjs)

###################################################
#ui
###################################################

ui <- (htmlOutput("page"))
useShinyjs()

###intro
intro <- function(...) {
  div(class = 'container', id = "intro",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Startseite"),
          p("Platzhalter"),
          br(),
          actionButton("W1", W)
      ))
  
}

###declaration of consent
decl <- function(...) {
  div(class = 'container', id = "decl",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Einwilligung zur Teilnahme"),
          p("Platzhalter"),
          br(),
  radioButtons("Einwilligung",label = NULL, choices = c("Ich stimme zu","Ich stimme nicht zu")),
  actionButton("W2", W)
      ))
  
}

###explanation HSV
expl1 <- function(...) {
  div(class = 'container', id = "expl1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Einleitung Teil 1"),
          p("Platzhalter"),
          br(),
          actionButton("W3", W)
      ))
  
}

###HSV

#G1

HSVG1 <- function(...) {
  div(class = 'container', id = "intro",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Welche Option bevorzugen Sie?"),
          p(G1),
          br(),
          actionButton("G1A", A),
          actionButton("G1B", B),
          actionButton("G1eq", C),
          sliderInput("S1", D, 10, 20, 15, step = 0.1)
      ))
  
}

###conclusive elicitation
concl <- function(...) {
  div(class = 'container', id = "concl",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Abschliessende Erhebung"),
          p("Bitte beantworten Sie zuletzt die folgenden Fragen."),
          br(),
          selectInput("Geschlecht","Mein Geschlecht ist", c("maennlich","weiblich","divers")),
          numericInput("Alter","Mein Alter ist",value = NULL),
          actionButton("W4", W)
      ))
  
}

###outro
outro <- function(...) {
  div(class = 'container', id = "outro",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Abschluss"),
          p("Platzhalter"),
          br(),
          textInput("Email","Email"),
          actionButton("Senden", "Senden"),
          actionButton("end", "Beenden")
      ))

}





render_page <- function(...,f, title = "Test") {
  page <- f(...)
  renderUI({
    fluidPage(page, title = title)
  })
}

###################################################
###server
###################################################
server <- function(input, output){
  
  #intro
  output$page <- render_page(f = intro)
  
  #declaration of consent
  observeEvent(input$W1, {
    output$page <- render_page(f = decl)
  })
  
  #explanation HSV
  observeEvent(input$W2, {
    if (input$Einwilligung == "Ich stimme zu") output$page <- render_page(f = expl1)
  })
  
  #HSV
  observeEvent(input$W3, {
    output$page <- render_page(f = HSVG1)
  })
  
  #outro
  observeEvent(input$W4, {
    output$page <- render_page(f = outro)
  })
  
  #end
  observeEvent(input$end, {
    stopApp()
  })

}



###################################################
###run
###################################################
shinyApp(ui = ui, server = server)
2

Welcome. Your reproducible example is missing W though. Can you define it?

Error in dots_list(...) : object 'W' not found.

3

Hi William, thanks for your reply!

Sorry, a part of my code went missing there. I will post the whole thing again below:

###EQ-5D-5L Dimensions
G1 <-c("")
G2 <-c("")
G3 <-c("")

###instructions

#buttons
W <-c("Weiter")
A <-c("Option A")
B <-c("Option B")
C <-c("Beide Optionen haben den gleichen Wert")

#questions
D <-c("Platzhalter")
E <-c("Platzhalter")
H <-c("Platzhalter")
I <-c("Platzhalter")

#texts
IntroText   <-c("Platzhalter")
ExplHSVText <-c("Platzhalter")
ExplPTText  <-c("Platzhalter")
ExplValText <-c("Platzhalter")
DeclText    <-c("Platzhalter")
OutroText   <-c("Platzhalter")

###TTO input
tx <- 10
ty <- 20

library(shiny); library(shinyjs)

###################################################
#ui
###################################################

ui <- (htmlOutput("page"))
useShinyjs()

###intro
intro <- function(...) {
  div(class = 'container', id = "intro",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Startseite"),
          p("Platzhalter"),
          br(),
          actionButton("W1", W)
      ))
  
}

###declaration of consent
decl <- function(...) {
  div(class = 'container', id = "decl",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Einwilligung zur Teilnahme"),
          p("Platzhalter"),
          br(),
  radioButtons("Einwilligung",label = NULL, choices = c("Ich stimme zu","Ich stimme nicht zu")),
  actionButton("W2", W)
      ))
  
}

###explanation HSV
expl1 <- function(...) {
  div(class = 'container', id = "expl1",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Einleitung Teil 1"),
          p("Platzhalter"),
          br(),
          actionButton("W3", W)
      ))
  
}

###HSV

#G1

HSVG1 <- function(...) {
  div(class = 'container', id = "intro",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Welche Option bevorzugen Sie?"),
          p(G1),
          br(),
          actionButton("G1A", A),
          actionButton("G1B", B),
          actionButton("G1eq", C),
          sliderInput("S1", D, 10, 20, 15, step = 0.1)
      ))
  
}

###conclusive elicitation
concl <- function(...) {
  div(class = 'container', id = "concl",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Abschliessende Erhebung"),
          p("Bitte beantworten Sie zuletzt die folgenden Fragen."),
          br(),
          selectInput("Geschlecht","Mein Geschlecht ist", c("maennlich","weiblich","divers")),
          numericInput("Alter","Mein Alter ist",value = NULL),
          actionButton("W4", W)
      ))
  
}

###outro
outro <- function(...) {
  div(class = 'container', id = "outro",
      div(class = 'col-sm-2'),
      div(class = 'col-sm-8',
          h1("Abschluss"),
          p("Platzhalter"),
          br(),
          textInput("Email","Email"),
          actionButton("Senden", "Senden"),
          actionButton("end", "Beenden")
      ))

}





render_page <- function(...,f, title = "Test") {
  page <- f(...)
  renderUI({
    fluidPage(page, title = title)
  })
}

###################################################
###server
###################################################
server <- function(input, output){
  
  #intro
  output$page <- render_page(f = intro)
  
  #declaration of consent
  observeEvent(input$W1, {
    output$page <- render_page(f = decl)
  })
  
  #explanation HSV
  observeEvent(input$W2, {
    if (input$Einwilligung == "Ich stimme zu") output$page <- render_page(f = expl1)
  })
  
  #HSV
  observeEvent(input$W3, {
    output$page <- render_page(f = HSVG1)
  })
  
  #outro
  observeEvent(input$W4, {
    output$page <- render_page(f = outro)
  })
  
  #end
  observeEvent(input$end, {
    stopApp()
  })

}



###################################################
###run
###################################################
shinyApp(ui = ui, server = server)

Thanks a lot :slight_smile:

4

two side by side plots

library(shiny)

ui <- fluidPage(
  div(style="display:flex;",
    plotOutput("p1",width = "25vw"),
    plotOutput("p2",width = "25vw")
  )
)

server <- function(input, output, session) {
  
  output$p1 <- renderPlot({
    hist(iris$Sepal.Length)
  })
  output$p2 <- renderPlot({
    hist(iris$Petal.Length)
  })
}

shinyApp(ui, server)
2 Likes
5

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.