如何更改 Flexdashboard 中的向上箭头(绿色)或向下箭头(红色)或破折号(黑色)

I_m*_*que 6 r shiny flexdashboard

我有以下 R 中的 flexdashbard 示例代码:

---
title: "My Dashboard"
runtime: shiny
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
always_allow_html: yes
---

```{r init, include=FALSE, echo=FALSE}
gc()

```


```{r setup1, include = FALSE}
library(flexdashboard)
library(thematic)
library(ggplot2)
library(bslib)
library(shiny)
library(plotly)
library(tidyverse)
library(dplyr)
library(htmltools)

```


Home {data-icon="fa-home" .main}
=====================================   

```{r, include=FALSE}

theme_set(theme_bw(base_size = 20))

```


Row
-----------------------------------------------------------------------

### Heading 1

```{r}
valueBox(1, icon = "fa-pencil", color="success")
```

### Heading 2

```{r}

valueBox(2, icon = "fa-file-text-o", color="info")

```

### Heading 3

```{r}
valueBox(3, icon = "fa-database", color = "danger")
```

Row
-------------------------------------------



Screen 2 {data-icon="fa-signal"}
==========================================================================

Sidebar {.sidebar data-width=350}
-------------------------------------

<h3>Selection Area</h3>

```{r}

hr(style = "border-top: 1px solid #000000;")

sliderInput("contact_rate", "Set contact rate", value = 91, min = 0, max = 100)

hr()

numericInput(inputId="my_input", "Enter a number:", 4, min = 0)

actionButton("submit", "Submit")


```


Value Boxes 
-------------------------------------

### Primary

```{r}

observeEvent(input$submit, {
  arrow_icon_temp <- ifelse(input$my_input > 3, icon("fa-arrow-up", class = "text-success"), 
                            icon("fa-arrow-down", class = "text-danger"))
  output$arrow <- renderValueBox({
    valueBox(
      input$my_input, caption = "Days", 
      color = "white",
      icon = arrow_icon_temp
    )
  })
})


renderValueBox({
  valueBoxOutput("arrow")
})

```

### Info

```{r}

valueBox(2, caption = "Weeks", color = "red", icon = "fa-chart-line")

```

### Success

```{r}

valueBox(3, caption = "Weeks", color = "green", icon = "fa-chart-line")

```



Gauges 
-------------------------------------

### Success Rate

```{r}

renderGauge({
  gauge(input$contact_rate, min = 0, max = 100, symbol = '%', 
        sectors = gaugeSectors( danger = c(0, 20), warning = c(20, 80), success = c(80, 100)))
  })

```

### Warning metric

```{r}

renderGauge({
  gauge(input$contact_rate, min = 0, max = 100, symbol = '%', 
        sectors = gaugeSectors( danger = c(0, 20), warning = c(20, 80), success = c(80, 100)))
  })

```

### Danger!

```{r}

renderGauge({
  gauge(input$contact_rate, min = 0, max = 100, symbol = '%', 
        sectors = gaugeSectors( danger = c(0, 20), warning = c(20, 80), success = c(80, 100)))
  })


```
Run Code Online (Sandbox Code Playgroud)

仪表板看起来像这样:

在此输入图像描述

我正在尝试反应性地更改第一个 valueBox 中的向上箭头(绿色)或向下箭头(红色)或破折号(黑色),这意味着,当我在 NumericInput(侧栏中)中提供数字时,然后单击在提交按钮上,则仅应根据上述代码中应用的条件,与向上或向下箭头图标(如图所示)一起反映 valueBox 中的更改。

但后来我在这里遇到了两个问题:

  1. 第一次,当我启动仪表板(运行应用程序)时,我需要提供输入的数字,然后单击“提交”按钮,然后只有 valueBox 显示我刚刚输入的数字。
  2. 但是,当我第二次更改号码时,即使没有单击“提交”按钮,号码也会立即显示在 valueBoax 上,但情况不应如此。
  3. 箭头(红色、向下或绿色、向上)仍未显示

我在这里做错了什么?有什么建议吗?

Dav*_*era 3

  1. 首先,要格式化您的样式,icons您需要将此块保存csswww文件夹内的styles.css文件中:
     .value-box .icon i.fa.fa-arrow-up{
      position: absolute;
      top: 15px;
      right: 15px;
      font-size: 80px;
      color: rgba(0, 153, 0);
    }
    
    .value-box .icon i.fa.fa-arrow-down{
      position: absolute;
      top: 15px;
      right: 15px;
      font-size: 80px;
      color: rgba(255, 0, 0);
    }
Run Code Online (Sandbox Code Playgroud)
  1. 请记住将此文件包含在 yaml 中:
---
title: "My Dashboard"
runtime: shiny
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
always_allow_html: yes
css: www/styles.css 
---
Run Code Online (Sandbox Code Playgroud)
  1. 您需要打破对 的依赖关系renderValueBox,因为只有在单击时才input$my_input需要这样做。是这样的功能:它暂停内部输入或反应对象的反应动作,并且仅当链接到其环境的另一个输入或反应对象发生更改时才进行评估。因此,经过一些修改,你的块现在是这样的:renderValueBoxinput$submitisolate
### Primary

```{r}

observeEvent(input$submit, {
  
  output$arrow <- renderValueBox({
    
    valueBox(
      ifelse(input$submit == 0, "Select number of days", isolate(input$my_input)), caption = "Days", 
      color = "white",
      icon = ifelse(isolate(input$my_input) > 3, "fa-arrow-up", "fa-arrow-down"))
    
  })
}, ignoreNULL = FALSE)


renderValueBox({
  valueBoxOutput("arrow")
})

Run Code Online (Sandbox Code Playgroud)

编辑:回答我是否还可以在显示的数字和箭头之间包含一个文本框,例如“错误:”?

这意味着将value参数更改valueBoxshiny::tagList包含所需元素的参数。这些元素需要位于同一行;在不同的列中。现在你的valueBox样子是这样的:

valueBox(
      value = tagList(tags$div(class = "parent",
                       tags$div(class = "column", ifelse(input$submit == 0, "Select number of days", isolate(input$my_input))),
                       tags$div(class = "column", tags$h5("Error:")))), 
      caption = "Days", 
      color = "white",
      icon = ifelse(isolate(input$my_input) > 3, "fa-arrow-up", "fa-arrow-down"))
Run Code Online (Sandbox Code Playgroud)

并且您的styles.css文件需要包含以下行:

     .value-box .icon i.fa.fa-arrow-up{
      position: absolute;
      top: 15px;
      right: 15px;
      font-size: 80px;
      color: rgba(0, 153, 0);
    }
    
    .value-box .icon i.fa.fa-arrow-down{
      position: absolute;
      top: 15px;
      right: 15px;
      font-size: 80px;
      color: rgba(255, 0, 0);
    }
Run Code Online (Sandbox Code Playgroud)