Question

我有以下格式的数据：

   Process       Class Category Template Company
1        A      Master Software       ZZ   Apple
2        B    Addendum Hardware       AA Samsung
3        C       Other Hardware       BB   Nokia
4        D      Master Software       CC    Moto
5        E    Addendum Services       ZZ      Mi
6        F Transaction Services       AA OnePlus
7        G      Master Software       BB   Apple
8        H Transaction     Tele       CC Samsung
9        I Transaction Hardware       ZZ   Nokia
10       J    Addendum     Tele       AA    Moto

我的目标是根据类，类别，模板和公司创建四个selectInput的列表并使用相同的方法过滤进程。

我能够在任何一个指定的方向上动态地进行线性过滤。例如，选择class =＆＃34; Master＆＃34;，selectInput for Category有选择=＆＃34;软件＆＃34;。

我现在尝试创建类似于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（）是一个以上述格式返回表的函数。

下拉列表是一个Semantic-UI小部件，其工作方式与selectInput完全相同。 value = 0 表示窗口小部件的初始值为0。

谢谢！

Answer 1

使用全局变量。

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

关于上述问题， server.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（与selected的{{1}}完全相同）更改为全局变量，我就能够实现Excel - 就像过滤一样。
这种方法需要注意的是，必须有一个重置按钮，将所有全局变量设置为初始状态。

对于任何挣扎于反应性的人，我强烈建议使用selectInput来理解闪亮应用的反应流。

干杯！

类似Excel的过滤在Shiny中

1 个答案: