r - R highcharter，valuebox，eventreactive 不能在闪亮中一起工作

问题描述

我想通过shinydashboard这样的工作来构建一个应用程序：

textInput
actionbutton根据输入文本提交以更新值框
valuebox（显示输入文本）
Tabbox与 5tabpanel
每个tabpanel都有不同数据的直方图，并由 Highcharter 渲染
VerbatimTextOutput指定选择了哪个选项卡面板

这是我的代码：

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)

问题：

价值盒消失
高图没有出现

我只制作了 1 个直方图，其中包含保存效率的条件。但看起来效果不佳。

这就是结果的样子

请帮帮我

标签： rhighchartsshinyshinydashboard

解决方案

id问题是UI 和服务器端之间的绑定必须是唯一的。但是，在您的仪表板中id="hist"，在 UI 中出现了不止一次，即您有一个重复的绑定。

这可以通过以下方式看到：1. 在浏览器中打开仪表板，2. 打开开发工具 3. 查看显示 JS 错误消息“id hist 的重复绑定”的控制台输出。

不确定您的最终结果，但要解决此问题，您可以例如highchartOutput为每个面板添加一个。为此：

我已将绘图代码放在单独的函数中make_hc
为您的每个面板或数据集添加了一个highchartOutput，例如

output$hist1 <- renderHighchart({ 
    make_hc("Extraversion", update_unicode()) 
})

这样我们就可以得到 5 个带有唯一ids 的输出，这些输出可以放在 UI 的各个面板中。

完整的可重现代码：

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)

r - R highcharter，valuebox，eventreactive 不能在闪亮中一起工作

问题描述

解决方案

推荐阅读