多个动态滤镜更新闪亮

2024-05-19

我希望能够让 UI 输入闪亮,并根据用户之前的选择进行自我更新。因此,在下面的示例中,预期的行为是用户选择cyl, vsor carb那么这将

  1. 过滤数据集mtcars用于创建绘图,即用户根据过滤条件调整绘图并
  2. 更新其他过滤器中的剩余输入选择,以便与基于现有过滤器的剩余选择相对应。

这是我尝试过的:

library(shiny)
library(dplyr)
library(plotly)

data("mtcars")

# create ui
ui <- fluidPage(
  fluidRow(
    box(
      title = "Filter",
      uiOutput(outputId = "cyl_dynamic_input"),
      uiOutput(outputId = "vs_dynamic_input"),
      uiOutput(outputId = "carb_dynamic_input")
    ),
    box(
      title = "Plot of mtcars",
      plotlyOutput("carplot")
    )
  ),
)

# create server
server <- function(input, output, session) {
  # create reactive filters of the mtcars table
  mtcars.reactive <- 
    reactive({
      mtcars %>%
        filter(mpg %in% input$cyl_input_rendered &
                 vs %in% input$vs_input_rendered &
                 carb %in% input$carb_input_rendered
        )})
  ## create rendered inputs
  # for cyl
  output$cyl_dynamic_input <- renderUI({
    pickerInput(inputId = "cyl_input_rendered",
                label = "CYL",
                choices = unique(mtcars$cyl),
                multiple = T,
                selected = mtcars.reactive()$cyl,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} cyl selected"
                ))
  })
  # for vs
  output$vs_dynamic_input <- renderUI({
    pickerInput(inputId = "vs_input_rendered",
                label = "VS",
                choices = unique(mtcars$vs),
                multiple = T,
                selected = mtcars.reactive()$vs,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} vs selected"
                ))
  })
  # for carb
  output$carb_dynamic_input <- renderUI({
    pickerInput(inputId = "carb_input_rendered",
                label = "CARB",
                choices = unique(mtcars$carb),
                multiple = T,
                selected = mtcars.reactive()$carb,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} carb selected"
                ))
  })
  ## create the plot output
  # Start Barplot Emissionen here 
  output$carplot<-
    renderPlotly({
    # create plot
    plot<-ggplot(mtcars.reactive(), aes(wt, mpg))+
      geom_point()
    # convert to plotly
    ggplotly(plot)
  })
  
  
  
}

shinyApp(ui, server)

我的猜测是,这不起作用,因为过滤器mtcars表引用渲染的输入,反之亦然,这会以某种方式创建一个空的信息循环

我已经看过了官方闪亮文档 https://shiny.rstudio.com/articles/dynamic-ui.html这也提供了一些背景信息 https://shiny.rstudio.com/articles/understanding-reactivity.html但整个主题对于初学者来说并不是很直观。这是一个以某种方式类似的问题 https://stackoverflow.com/questions/57515604/renderui-not-evaluated-until-it-is-rendered但它不能完全重现。


以下内容无需层次结构即可完成您想要的操作,但使用pickerInput和条件语句observeEvent陈述。乍一看很复杂,但它做了它应该做的事情。

library(shiny)
library(dplyr)
library(plotly)

data("mtcars")

# create ui
ui <- fluidPage(fluidRow(
  box(
    title = "Filter",
    pickerInput(
      inputId = "cyl_pickerinput",
      label = "CYL",
      choices = levels(as.factor(mtcars$cyl)),
      multiple = T,
      selected = levels(as.factor(mtcars$cyl)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} cyl selected"
      )
    ),
    pickerInput(
      inputId = "vs_pickerinput",
      label = "VS",
      choices = levels(as.factor(mtcars$vs)),
      multiple = T,
      selected = levels(as.factor(mtcars$vs)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} vs selected"
      )
    ),
    pickerInput(
      inputId = "carb_pickerinput",
      label = "CARB",
      choices = levels(as.factor(mtcars$carb)),
      multiple = T,
      selected = levels(as.factor(mtcars$carb)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} carb selected"
      )
    ),
  ),
  box(title = "Plot of mtcars",
      plotlyOutput("carplot"))
),)

# create server
server <- function(input, output, session) {
  #(1) Create PickerInput Updates
  observeEvent(
    # define pickerinputs to be observed
    c(
      input$vs_pickerinput,
      input$carb_pickerinput,
      input$cyl_pickerinput
    ),
    {
      ## filter the data based on the pickerinputs
      # include an ifelse condition first to check wheter at least one value is choosen in all of the filters.
      mtcars2 <-
        if (!is.null(input$cyl_pickerinput) &
            !is.null(input$vs_pickerinput) &
            !is.null(input$carb_pickerinput)) {
          mtcars %>%
            filter(cyl %in% input$cyl_pickerinput) %>% # filters
            filter(vs %in% input$vs_pickerinput) %>%
            filter(carb %in% input$carb_pickerinput)
        } 
      else{
           mtcars
         }

      ## update PickerInput based on a condition that requires the user to choose at least one input, else reset all filters
      # for cyl 
      if (!is.null(input$cyl_pickerinput)) {
        updatePickerInput(
          session,
          "cyl_pickerinput",
          choices = levels(factor(mtcars$cyl)),
          selected = unique(mtcars2$cyl))
      } else{
      }
      # for carb
      if (!is.null(input$carb_pickerinput)) {
        updatePickerInput(
          session,
          "carb_pickerinput",
          choices = levels(factor(mtcars$carb)),
          selected = unique(mtcars2$carb)
        )
      } 
      # for vs 
      if (!is.null(input$vs_pickerinput)) {
        updatePickerInput(
          session,
          "vs_pickerinput",
          choices = levels(factor(mtcars$vs)),
          selected  = unique(mtcars2$vs)
        )
      } 
    },
    ignoreInit = TRUE,
    ignoreNULL = F
  )
  
  # (2) Create reactive object with filtered data
  # update mtcars table based on filters
  mtcars.reactive <-
    reactive({
      if (!is.null(input$vs_pickerinput))
        # one condition should be enough.
      {
        mtcars %>% # filters
          filter(
            cyl %in% input$cyl_pickerinput &
              vs %in% input$vs_pickerinput &
              carb %in% input$carb_pickerinput
          )
      } else
      {
        mtcars
      }
    })
  
  # (3) create the plot output
  output$carplot <-
    renderPlotly({
      # create plot
      plot <- ggplot(mtcars.reactive()) +
        geom_point(aes(wt, mpg, color = factor(vs)))
      # convert to plotly
      ggplotly(plot)
    })
  
  
  
}

shinyApp(ui, server)
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

多个动态滤镜更新闪亮 的相关文章

  • 使用 pracma::findpeaks 识别持续峰值

    我的语法有问题peakpat内的选项findpeaks内的函数pramcaR 包 v 2 1 1 我使用的是 R 3 4 3 x64 Windows 我希望该函数能够识别可能有两个重复值的峰值 并且我相信该选项peakpat这就是我能做到的
  • 多功能测试仪替代 system.time

    我已经看到 我认为是这样 使用了类似于 system time 的函数 它可以同时评估多个函数的时间并输出一个输出 我不记得它是什么 并且用我正在使用的术语进行互联网搜索并没有得到我想要的响应 有人知道我正在谈论的功能的名称 位置吗 你想要
  • 将数据框中的每个 x 个字符拆分为字符串

    我知道这里有一些关于每隔一段时间分割一个字符串的答案nth字符 例如this one https stackoverflow com questions 23208490 split each character in r and this
  • Dendextend:关于如何根据定义的组为树状图的标签着色

    我正在尝试使用一个名为 dendextend 的很棒的 R 包来绘制树状图并根据一组先前定义的组为其分支和标签着色 我已阅读您在 Stack Overflow 中的答案以及 dendextend vignette 的常见问题解答 但我仍然不
  • 在 R 中绘制 Likert 变量的堆积条形图

    假设我有一个如下所示的数据框 P Q1 Q2 1 1 4 1 2 2 3 4 3 1 1 4 其中的列告诉我哪个人相应地回答了问题 q1 q2 中的哪一个 这些问题需要按照 4 分李克特量表进行回答 例如 批准 表示 1 稍微批准 表示 2
  • Purrr::map_df() 删除 NULL 行

    使用时purrr map df 我偶尔会传递一个数据框列表 其中一些项目是NULL 当我做 map df 返回行数少于原始列表的数据框 我想发生的事情是这样的map df calls dplyr bind rows 它忽略了NULL价值观
  • 将每列的值乘以 R 中另一个 data.frame 中的权重

    我有两个data frames df and weights 代码如下 df看起来像这样 id a b d EE f 1 this 0 23421153 0 02324956 0 5457353 0 73068586 0 5642554 2
  • 在 R 中使用 lapply 绘制多个数据帧

    我正在尝试使用 lapply 函数绘制多个数据帧 每个数据帧一个图 但是尽管有关此主题的所有帖子我都找不到答案 因为我不断收到错误 图的输出列表为空 我的数据结构如下 df1 lt mtcars gt group by cyl gt tal
  • 朴素贝叶斯分类器仅基于先验概率做出决策

    我试图根据推文的情绪将推文分为三类 买入 持有 卖出 我正在使用 R 和包 e1071 我有两个数据框 一个训练集和一组需要预测情绪的新推文 训练集数据框 text sentiment this stock is a good buy Bu
  • 将阴影区域添加到五分位数之间的直方图中

    All 我有一个包含 2 个直方图的图表 其中我还绘制了代表第 20 40 60 和 80 个百分位数的线条 下面的代码使用虚拟数据重现了类似的图表 data lt rbind data frame x rnorm 1000 0 1 g o
  • 使用 ggmap 截断密度多边形

    我在使用 R ggmap 绘制密度图时遇到问题 我的数据如下所示 gt head W date lat lon dist 1 2010 01 01 31 942 86 659 292 415 2 2010 01 10 32 970 84 1
  • R:如何获取该月的周数

    我是 R 新手 我想要该日期所属月份的周数 通过使用以下代码 gt CurrentDate lt Sys Date gt Week Number lt format CurrentDate format U gt Week Number 3
  • 如何从 R 读取 PDF 元数据

    我们很好奇 有没有一种方法可以从 R 读取 PDF 元数据 例如下面显示的信息 通过搜索我对此无能为力 r pdf metadata在当前的问题库中 非常欢迎任何指点 我想不出纯 R 的方法来执行此操作 但您可能可以安装您最喜欢的 PDF
  • R“错误:“}”中出现意外的“}”[重复]

    这个问题在这里已经有答案了 我有一个字符串变量 对于缺少数据的情况 它具有 空值 我想将 空值 重新编码为缺失 而不是说 空值 我正在尝试编写一个循环来删除这些 空值 条目 但我不断收到错误 错误 中出现意外的 for row in dat
  • 以编程方式将字符串宽度值插入到 sprintf() 中

    我正在尝试以编程方式将字符串宽度值插入到sprintf 格式 期望的结果是 sprintf 20s hello 1 hello 但我想插入20在同一通话中即时进行 因此它可以是任何号码 我努力了 sprintf ds 20 hello 1
  • 条件字体颜色 R Markdown

    我无法找到一种方法来根据变量的值 gt 0 0 或 r setup include FALSE x lt 4 This is an R Markdown document r if x gt 0 textcolor red Markdown
  • 任意列中包含字符串的子集行

    我有一个如下所示的数据集 Col1 Col2 Col3 abckel NA 7 jdmelw njabc NA 8 jdken jdne 如何对数据集进行子集化 使其仅保留包含字符串 abc 的行 最终预期输出 Col1 Col2 Col3
  • 如何使用 tidymodels 和工作流集在同一数据集上拟合多个不同的线性模型

    我想评估同一数据集上多个 主要是 线性回归模型的性能 我想也许使用tidymodels包连同workflowsets workflow set 可能会起作用 我按照这个例子here https workflowsets tidymodels
  • 如何将plot中的单变量列表图表转换为ggplot2格式?

    我正在搜索 但仍然找不到一个非常简单的问题的答案 我们如何使用 R 中的 ggplot2 生成一个变量的简单线图 我正在分析时间序列数据 并且想要对图表进行更复杂的操作 我认为如果我使用 ggplot2 代替会更好plot It works
  • 如何使用 dplyr 独立过滤每列的行

    我有以下内容 library tidyverse df lt tibble tribble gene colB colC a 1 2 b 2 3 c 3 4 d 1 1 df gt A tibble 4 x 3 gt gene colB c

随机推荐