Shiny 中类似 Excel 的过滤答案

【问题标题】：Excel-like filtering in ShinyShiny 中类似 Excel 的过滤
【发布时间】：2017-12-05 07:14:07
【问题描述】：

我有以下格式的数据：

 流程类类别模板公司
1 A Master Software ZZ Apple
2 B 附录 硬件 AA 三星
3 C 其他硬件 BB 诺基亚
4D大师软件CC Moto
5 E 附录服务 ZZ Mi
6 F 交易服务 AA 一加
7G 大师软件 BB 苹果
8 H Transaction Tele CC 三星
9 I 交易硬件 ZZ 诺基亚
10 J 附录 Tele AA Moto

我的目标是根据 class、category、template 和 company 创建一个包含四个 selectInputs 的列表并使用相同的过滤器处理。

我已经能够动态地进行线性过滤，就像在任何一个指定的方向上一样。例如，在选择 class= "Master" 时，对于 Category 的 selectInput 有选择 = "Software"。

我现在正在尝试创建类似于 Excel 过滤器的东西，我可以在其中以任何顺序选择任何 selectInput，而其余的选择输入应该动态地仅具有反映我之前选择的值。

我的逻辑已关闭，但我在阻止已选择的 selectInputs 由于反应性而重新初始化时遇到了困难。

代码：

 cldcheck_ctd <- reactive({
  if(is.null(input$classdrop))
  {cld <- -1}else if(input$classdrop != 0)
  {cld <- 6}else{cld <- 0}
})

cldcheck_td <- reactive({
  if(is.null(input$classdrop))
  {cld <- -1}else if(input$classdrop != 0)
  {cld <- 6}else{cld <- 0}
})

cldcheck_sd <- reactive({
  if(is.null(input$classdrop))
  {cld <- -1}else if(input$classdrop != 0)
  {cld <- 6}else{cld <- 0}
})

ctdcheck_cld <- reactive({
  if(is.null(input$categorydrop))
  {ctd <- -1}else if(input$categorydrop != 0)
  {ctd <- 6}else{ctd <- 0}

})

ctdcheck_td <- reactive({
  if(is.null(input$categorydrop))
  {ctd <- -1}else if(input$categorydrop != 0)
  {ctd <- 6}else{ctd <- 0}

})

ctdcheck_sd <- reactive({
  if(is.null(input$categorydrop))
  {ctd <- -1}else if(input$categorydrop != 0)
  {ctd <- 6}else{ctd <- 0}

})

tdcheck_cld <- reactive({if(is.null(input$templatedrop))
{td <- -1}else if(input$templatedrop != 0)
{td <- 6}else{td <- 0}

})

tdcheck_ctd <- reactive({if(is.null(input$templatedrop))
{td <- -1}else if(input$templatedrop != 0)
{td <- 6}else{td <- 0}

})

tdcheck_sd <- reactive({if(is.null(input$templatedrop))
{td <- -1}else if(input$templatedrop != 0)
{td <- 6}else{td <- 0}

})

sdcheck_cld <- reactive({if(is.null(input$supplierdrop))
{sd <- -1}else if(input$supplierdrop != 0)
{sd <- 6}else{sd <- 0}

})

sdcheck_ctd <- reactive({if(is.null(input$supplierdrop))
{sd <- -1}else if(input$supplierdrop != 0)
{sd <- 6}else{sd <- 0}

})

sdcheck_td <- reactive({if(is.null(input$supplierdrop))
{sd <- -1}else if(input$supplierdrop != 0)
{sd <- 6}else{sd <- 0}

})

output$class <- renderUI({
  result <- first_search()
  if(ctdcheck_cld() > 0)
  {
    result <- result[result$SCM.Category == input$categorydrop,]
  }

  if(tdcheck_cld() > 0)
  {
    result <- result[result$Contract.Template == input$templatedrop,]
  }

  if(sdcheck_cld() > 0)
  {
    result <- result[result$Emptoris.Supplier.Name == input$supplierdrop,]
  }

  y <- unique(result$Contract.Class)
  dropdown('classdrop', y, value = 0)
})

output$category <- renderUI({
  result <- first_search()

  if(cldcheck_ctd() > 0)
  {
    result <- result[result$Contract.Class == input$classdrop,]
  }

      if(tdcheck_ctd() > 0)
      {
        result <- result[result$Contract.Template == input$templatedrop,]
      }

      if(sdcheck_ctd() > 0)
      {
        result <- result[result$Emptoris.Supplier.Name == input$supplierdrop,]
      }
  y <- unique(result$SCM.Category)
  dropdown('categorydrop', y, value = 0)
})

output$template <- renderUI({
  result <- first_search()

  if(ctdcheck_td() > 0)
  {
    result <- result[result$SCM.Category == input$categorydrop,]
  }

  if(cldcheck_td() > 0)
  {
    result <- result[result$Contract.Class == input$classdrop,]
  }

    if(sdcheck_td() > 0)
    {
      result <- result[result$Emptoris.Supplier.Name == input$supplierdrop,]
    }
  y <- unique(result$Contract.Template)
  dropdown('templatedrop', y, value = 0)
})

output$supplier <- renderUI({
  result <- first_search()

  if(ctdcheck_sd() > 0)
  {
    result <- result[result$SCM.Category == input$categorydrop,]
  }

  if(tdcheck_sd() > 0)
  {
    result <- result[result$Contract.Template == input$templatedrop,]
  }

  if(cldcheck_sd() > 0)
  {
    result <- result[result$Contract.Class == input$classdrop,]
  }
  y <- unique(result$Emptoris.Supplier.Name)
  dropdown('supplierdrop', y, value = 0)
})

first_search() 是一个函数，它以如上所示的格式返回表格。

dropdown 是一个语义 UI 小部件，其工作方式与 selectInput 完全相同。 value = 0 表示小部件初始化为 0。

谢谢！

【问题讨论】：

要了解如何动态更新 selectInput，请在此处查看我的答案：stackoverflow.com/questions/47641901/… 和此处：stackoverflow.com/questions/47493062/…
谢谢！我通过使用全局变量解决了它:)

标签： r shiny

【解决方案1】：

使用全局变量。

假设您有一个带有 id = 'classdrop' 的 selectInput，请创建一个全局变量 classdropvalue 并在反应函数中将其设置为 input$classdrop。

关于上面的问题，服务器.R：

cldvalue <- 0
ctdvalue <- 0
tdvalue <- 0
sdvalue <- 0
server <- function(input, output){
  cld <- 0 
  ctd <- 0
  td <- 0
  sd <- 0

  cldcheck <- reactive({
    if(is.null(input$classdrop))
    {cld <- 0}else if(input$classdrop != 0)
    {cld <- 6 
    cldvalue <<- input$classdrop
    return(cld)}else{cld <- 0}
  })

  ctdcheck <- reactive({
    if(is.null(input$categorydrop))
    {ctd <- 0}else if(input$categorydrop != 0)
    {ctd <- 6
     ctdvalue <<- input$categorydrop
     return(ctd)}else{ctd <- 0}

  })

  tdcheck <- reactive({if(is.null(input$templatedrop))
  {td <- 0}else if(input$templatedrop != 0)
  {td <- 6
   tdvalue <<- input$templatedrop
   return(td)}else{td <- 0}

  })

  sdcheck <- reactive({if(is.null(input$supplierdrop))
  {sd <- 0}else if(input$supplierdrop != 0)
  {sd <- 6
   sdvalue <<- input$supplierdrop
   return(sd)}else{sd <- 0}

  })
#   
#   output$filter <- renderText({
#     paste(cldcheck(), ctdcheck(), tdcheck(), sdcheck())})


  output$class <- renderUI({input$clear
    result <- first_search()
        if(ctdcheck() != 0)
        {
          result <- result[result$SCM.Category == input$categorydrop,]
        }

        if(tdcheck() != 0)
        {
          result <- result[result$Contract.Template == input$templatedrop,]
        }

        if(sdcheck() != 0)
        {
          result <- result[result$Emptoris.Supplier.Name == input$supplierdrop,]
        }

    y <- unique(result$Contract.Class)
    dropdown('classdrop', y, value = cldvalue)
  })

  output$category <- renderUI({input$clear
    result <- first_search()

    if(cldcheck() != 0)
    {
      result <- result[result$Contract.Class == input$classdrop,]
    }

        if(tdcheck() != 0)
        {
          result <- result[result$Contract.Template == input$templatedrop,]
        }

        if(sdcheck() != 0)
        {
          result <- result[result$Emptoris.Supplier.Name == input$supplierdrop,]
        }
    y <- unique(result$SCM.Category)
    dropdown('categorydrop', y, value = ctdvalue)
  })

  output$template <- renderUI({input$clear
    result <- first_search()

    if(ctdcheck() != 0)
    {
      result <- result[result$SCM.Category == input$categorydrop,]
    }

    if(cldcheck() != 0)
    {
      result <- result[result$Contract.Class == input$classdrop,]
    }

      if(sdcheck() != 0)
      {
        result <- result[result$Emptoris.Supplier.Name == input$supplierdrop,]
      }
    y <- unique(result$Contract.Template)
    dropdown('templatedrop', y, value = tdvalue)
  })

  output$supplier <- renderUI({input$clear
    result <- first_search()

    if(ctdcheck() != 0)
    {
      result <- result[result$SCM.Category == input$categorydrop,]
    }

    if(tdcheck() != 0)
    {
      result <- result[result$Contract.Template == input$templatedrop,]
    }

    if(cldcheck() != 0)
    {
      result <- result[result$Contract.Class == input$classdrop,]
    }
    y <- unique(result$Emptoris.Supplier.Name)
    dropdown('supplierdrop', y, value = sdvalue)
  })
  }

仅通过将value（与selectInput 的selected 完全相同）更改为全局变量，我就能够实现类似Excel 的过滤。
这种方法需要注意的是必须是一个重置按钮才能将所有全局变量设置为其初始状态。

对于任何为反应而苦恼的人，我强烈建议使用shiny.reactlog 来了解闪亮应用程序的反应流程。

干杯！

【讨论】：