R highcharter, valuebox, eventreactive didn't work together in shiny - r

Question

I want to build an app by shinydashboard that work like this:
textInput
Submit actionbutton to update value box based in input text
valuebox (to show input text)
Tabbox with 5 tabpanel
Each tabpanel has histogram with different data and rendered by Highcharter
VerbatimTextOutput to indivate which tabpanel chosen
This is my code:
library(shiny)
library(shinydashboard)
library(highcharter)
### Data ================================================
set.seed(1)
Ext <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(2)
Con <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(3)
Agr <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(4)
Emo <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(5)
Int <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
### Apps Atribut ========================================
header <- dashboardHeader(
title = "IPIP-BFM-50"
)
sidebar <- dashboardSidebar()
body <- dashboardBody(
fluidRow(
box(
textInput(
"unicode",
"Your Unique ID:",
placeholder = "Input your unique ID here"
),
actionButton(
"ab1_unicode",
"Submit"
),
width = 6
),
tags$head(tags$style(HTML(".small-box {height: 130px}"))),
valueBoxOutput(
"vbox1_unicode",
width = 6
)
),
fluidRow(
tabBox(
title = "Dimensi Big-Five Marker",
id = "tabset1",
height = "500px",
width = 12,
tabPanel(
"Extraversion",
"This is Extraversion",
highchartOutput(
"hist"
)
),
tabPanel(
"Conscientiousness",
"This is Conscientiousness",
highchartOutput(
"hist"
)
),
tabPanel(
"Agreeableness",
"This is Agreeableness",
highchartOutput(
"hist"
)
),
tabPanel(
"Emotional Stability",
"This is Emotional Stability",
highchartOutput(
"hist"
)
),
tabPanel(
"Intelligent",
"This is Intelligent",
highchartOutput(
"hist"
)
)
)
),
fluidRow(
box(
"Personality in a nutshell", br(),
"Second row of personality explanation",
verbatimTextOutput(
"tabset1selected"
),
width = 12,
height = "250px"
)
)
)
### Atribut server
### Apps ================================================
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output){
update_unicode <- eventReactive(input$ab1_unicode,{
input$unicode
}, ignoreNULL = F)
output$vbox1_unicode <- renderValueBox({
valueBox(
update_unicode(),
"Your Unique ID",
icon = icon("fingerprint")
)
})
dimension <- function(dim){
if(dim == "Extraversion"){
Ext
} else if(dim == "Conscientiousness"){
Con
} else if(dim == "Agreeableness"){
Agr
} else if(dim == "Emotional Stability"){
Emo
} else if(dim == "Intelligent"){
Int
}
}
output$hist <- renderHighchart({
hchart(
dimension(input$tabset1)
) %>%
hc_xAxis(
list(
title = list(
text = "Data"
),
plotBands = list(
color = '#3ac9ad',
from = update_unicode,
to = update_unicode,
label = list(
text = "Your Score",
color = "#9e9e9e",
align = ifelse(update_unicode>30,"right","left"),
x = ifelse(update_unicode>30,-10,+10)
)
)
)
)
})
output$tabset1selected <- renderText({
input$tabset1
})
}
shinyApp(ui = ui,server = server)
Problems:
valuebox dissapear
highchart didn't appear
I made only 1 histogram with conditions to save the efeciency. but it looks didn't work well.
This is what the result looked like
Please help me guys

Answer 1

The issue is that the the binding between an id in the UI and on the server side has to be unique. However, in your dashboard the id="hist" appears more than once in the UI, i.e. you have a duplicated binding.
This could be seen by 1. opening the dashboard in the Browser, 2. opening the dev tools 3. having a look the console output which shows a JS error message "Duplicate binding for id hist".
Not sure about your final result but to solve this issue you could e.g. add one highchartOutput per panel. To this end:
I have put the plotting code in a separate function make_hc
Added an highchartOutput for each of your panels or datasets, e.g.
output$hist1 <- renderHighchart({
make_hc("Extraversion", update_unicode())
})
This way we get 5 outputs with unique ids which could be put inside the respective panels in the UI.
Full reproducible code:
library(shiny)
library(shinydashboard)
library(highcharter)
### Data ================================================
set.seed(1)
Ext <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(2)
Con <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(3)
Agr <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(4)
Emo <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
set.seed(5)
Int <- round(rnorm(500,runif(1,25,35),runif(1,4,12)))
### Apps Atribut ========================================
header <- dashboardHeader(
title = "IPIP-BFM-50"
)
sidebar <- dashboardSidebar()
body <- dashboardBody(
fluidRow(
box(
textInput(
"unicode",
"Your Unique ID:",
placeholder = "Input your unique ID here"
),
actionButton(
"ab1_unicode",
"Submit"
),
width = 6
),
tags$head(tags$style(HTML(".small-box {height: 130px}"))),
valueBoxOutput(
"vbox1_unicode",
width = 6
)
),
fluidRow(
tabBox(
title = "Dimensi Big-Five Marker",
id = "tabset1",
height = "500px",
width = 12,
tabPanel(
"Extraversion",
"This is Extraversion",
highchartOutput(
"hist1"
)
),
tabPanel(
"Conscientiousness",
"This is Conscientiousness",
highchartOutput(
"hist2"
)
),
tabPanel(
"Agreeableness",
"This is Agreeableness",
highchartOutput(
"hist3"
)
),
tabPanel(
"Emotional Stability",
"This is Emotional Stability",
highchartOutput(
"hist4"
)
),
tabPanel(
"Intelligent",
"This is Intelligent",
highchartOutput(
"hist5"
)
)
)
),
fluidRow(
box(
"Personality in a nutshell", br(),
"Second row of personality explanation",
verbatimTextOutput(
"tabset1selected"
),
width = 12,
height = "250px"
)
)
)
### Atribut server
### Apps ================================================
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output){
update_unicode <- eventReactive(input$ab1_unicode,{
input$unicode
}, ignoreNULL = F)
output$vbox1_unicode <- renderValueBox({
valueBox(
update_unicode(),
"Your Unique ID",
icon = icon("fingerprint")
)
})
dimension <- function(dim){
if(dim == "Extraversion"){
Ext
} else if(dim == "Conscientiousness"){
Con
} else if(dim == "Agreeableness"){
Agr
} else if(dim == "Emotional Stability"){
Emo
} else if(dim == "Intelligent"){
Int
}
}
make_hc <- function(x, update_unicode) {
hchart(
dimension(x)
) %>%
hc_xAxis(
list(
title = list(
text = "Data"
),
plotBands = list(
color = '#3ac9ad',
from = update_unicode,
to = update_unicode,
label = list(
text = "Your Score",
color = "#9e9e9e",
align = ifelse(update_unicode>30,"right","left"),
x = ifelse(update_unicode>30,-10,+10)
)
)
)
)
}
output$hist1 <- renderHighchart({
make_hc("Extraversion", update_unicode())
})
output$hist2 <- renderHighchart({
make_hc("Conscientiousness", update_unicode())
})
output$hist3 <- renderHighchart({
make_hc("Agreeableness", update_unicode())
})
output$hist4 <- renderHighchart({
make_hc("Emotional Stability", update_unicode())
})
output$hist5 <- renderHighchart({
make_hc("Intelligent", update_unicode())
})
output$tabset1selected <- renderText({
input$tabset1
})
}
shinyApp(ui = ui,server = server)