闪亮的反应功能未按预期更新

时间：2014-12-18 03:19:48

标签： r datatable shiny

此处发布原始问题： Shiny reactive Unexpected Behavior
这个问题正在重新发布，试图改进之前在上面提供的链接中发布的原始问题，因为我无法获得任何帮助。

目标：简而言之，此应用的目的是允许用户根据提供的各种输入执行搜索，过滤，切片和切块数据，这些数据来自数据框。给用户。

作为server函数的一部分，已定义名为index的反应函数来查找与用户输入相对应的索引。反应函数index使用grep和which函数来定位数据框df中的相应索引。

我已经包含了可重现的代码，并尝试在适当的时候包含注释。

有关代码的进一步说明：
这个问题的标题只是我自己的推测，它基于index中的代码是正确的假设。 index中的代码可能存在基本问题，而index函数的反应性也不一定。为了测试这一点，作为server函数的一部分，我添加了一个函数printIndex，以打印index的结果，以确保它正常工作。

我个人尝试单独打印ind.j，ind.c，ind.l，ind.d，ind.s和ind.all的结果到控制台，他们似乎都产生了正确的结果。但是，当我测试ind的结果时，它并不是我所期望的，所以我想知道这是反应性还是代码行是有问题的。 ind打算做的是获取存储在ind.all中的所有查找索引的列表，并递归应用intersect函数以查找所有子列表中的公共元素在ind.all。

正如我上面提到的，index函数适用于各个过滤器。但是，当我输入所有索引的值时，作为用户，该函数不会按预期更新到正确的索引列表。例如，您可以尝试在作业 textInput中输入“应用程序”，在公司 selectizeInput中输入“Gas Drive Global”，在位置<中输入“Calgary” / strong> textInput同时点击搜索！。您将看到数据表未返回任何结果，而这明显对应于数据框df的第1行。

#Load required packages
ListofPackages= c('shiny','ggplot2','scales')
lapply(ListofPackages,require,character.only=TRUE)

#Define the dataframe on which the search will be performed
df <- data.frame(Job=c('Applications Engineer ââ¬â Gas Drive',
                       'Engineer, Operations',
                       'Project Engineer',
                       'Project Engineer (Oil & Gas)',
                       'Project Engineer',
                       'Junior Engineer',
                       'Engineer, Operations',
                       'Research and Development (R&D) Junior Engineer',
                       'JUNIOR QUALITY ENGINEER',
                       'Junior Systems Design and Support Engineer',
                       'Mechanical Engineer Calgary, AB',
                       'Applications Engineer',
                       'Project Engineer',
                       'Pipeline Engineer',
                       'Development Engineer',
                       'Specialist Engineering Finance',
                       'Mechanical Engineer - Sudbury',
                       'Project Cost Analyst (12 month term)',
                       'Project Controls Functional Analyst',
                       'Project Controls Professionals'),
             Company=c('Gas Drive Global',
                       'Agrium Wholesale',
                       'City of Calgary',
                       'Stantec',
                       'Shell',
                       'Canadian National Railway',
                       'Pembina Pipeline Corporation',
                       'Velan Inc.',
                       'G.W. Goudreau Personnel Services Ltd',
                       'Stratified Automotive Controls',
                       'Pason Systems Corp.',
                       'Howden',
                       'Plains Midstream Canada',
                       'Amec Foster Wheeler',
                       'Red Bend Software',
                       'Canadian Pacific',
                       'GENIVAR',
                       'Thales',
                       'AltaGas Ltd.','BEMAC Construction Corp.'),
            Location=c('Calgary',
                      'Redwater',
                      'Calgary',
                      'Edmonton',
                      'Sarnia',
                      'Montréal',
                      'Calgary',
                      'Montréal',
                      'Windsor',
                      'Vancouver',
                      'Calgary',
                      'Winnipeg',
                      'Calgary',
                      'Calgary',
                      'Engineer',
                      'Calgary',
                      'Greater Sudbury',
                      'Ottawa',
                      'Calgary',
                      'Calgary'),
              Posted=c(1,
                       1,
                       1,
                       2,
                       2,
                       1,
                       4,
                       5,
                       6,
                       4,
                       1,
                       5,
                       5,
                       3,
                       1,
                       1,
                       15,
                       1,
                       1,
                       13),
             Source=c('Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed',
                      'Indeed'),
                url=c('http://ca.indeed.com/rc/clk?jk=2371e16aab902f84',
                      'http://ca.indeed.com/rc/clk?jk=428facb738edd397',
                      'http://ca.indeed.com/rc/clk?jk=e15d8fe4d362279b',
                      'http://ca.indeed.com/rc/clk?jk=28c1464fd4e28b24',
                      'http://ca.indeed.com/rc/clk?jk=736ec57bf6902b93',
                      'http://ca.indeed.com/rc/clk?jk=bdc9999eae922645',
                      'http://ca.indeed.com/rc/clk?jk=3a4588fca0e600b1',
                      'http://ca.indeed.com/rc/clk?jk=71f1abcd100850c6',
                      'http://ca.indeed.com/cmp/G.W.Goudreau-Personnel-Services-Ltd/jobs/Junior-Quality-Engineer-3237601a1f3d3abc?r=1',
                      'http://ca.indeed.com/cmp/Stratified-Automotive-Controls/jobs/Junior-System-Design-Support-Engineer-1d916a435e69b8ce?r=1',
                      'http://ca.indeed.com/rc/clk?jk=fca9a784a37ece8a',
                      'http://ca.indeed.com/rc/clk?jk=b2d0975c638c03a8',
                      'http://ca.indeed.com/rc/clk?jk=c92725272c5f9ced',
                      'http://ca.indeed.com/rc/clk?jk=cd97c050df64787c',
                      'http://ca.indeed.com/rc/clk?jk=e6e278ed52532f73',
                      'http://ca.indeed.com/rc/clk?jk=a1f14d52c7798d7b',
                      'http://ca.indeed.com/rc/clk?jk=112350d5e020241f',
                      'http://ca.indeed.com/rc/clk?jk=a324c2dcade7dc5c',
                      'http://ca.indeed.com/rc/clk?jk=77895efdf28ad6fa',
                      'http://ca.indeed.com/cmp/BEMAC-Construction-Corp./jobs/Project-Control-Professional-90796e764f064a51?r=1'))

server <- function(input,output,session){

    #Server-side search for the choices argument of selectizeInput in ui.R
    updateSelectizeInput(session, 'c', choices = as.character(df$Company), server = TRUE)

    #Create a reactive function to look up the indices correponding to the user's inputs
    index <- reactive({
        ind.j <- if(input$j=='') NULL else grep(input$j,df[,'Job'],ignore.case = T)
        ind.c <- {tmp<-lapply(input$c, function(x) {which(df[,'Company']==x)}); Reduce(union,tmp)}
        ind.l <- if(input$l=='') NULL else grep(input$l,df[,'Location'],ignore.case = T)
        ind.d <- which(df[,'Posted']<=input$d)
        ind.s <- {tmp<-lapply(input$s, function(x) {which(df[,'Source']==x)}); Reduce(union,tmp)}
        ind.all <- list(ind.j,ind.c,ind.l,ind.d,ind.s)
        ind <- if(is.null(ind.s)) NULL else {ind.null<- which(lapply(ind.all,is.null)==TRUE) ;Reduce(intersect,ind.all[-ind.null])}

    })

    #Create a reactive function to return the search results by returning the indices looked up in the index function above
    search <- reactive({

              df[index(),]

    })

    #Print the results of the index function above to test if it works properly
    output$printIndex <- renderUI({
           list(index())
    })

    #Send the searchresult table to ui.R to print the results of the search function above
    output$searchresult <- renderDataTable({
        input$action6   #triggered only when button is pressed
        if(input$action6==0) return() 
        else{isolate({
            transformed <- transform(search(), Link = paste('<a href = ', shQuote(url), '>', 'Click</a>'))
            transformed <- transformed[,c(1:3,5,7,4,6)] #Rearrange columns
            transformed[-7] #Remove last column
        })
        }
    }, option=list(autoWidth=FALSE,pageLength=100,
                   columnDefs = list(list(targets =c(5,6) -1, searchable = FALSE),list(sWidth=c("100px")))))


}

ui <- shinyUI(fluidPage(

    #Display datatable filters on top
    tags$head(tags$style("tfoot {display: table-header-group;}")),        

    #Add a title
    h1('Power Search'),

    #Use the Sidebar layout
    sidebarLayout(
        sidebarPanel(

            #Add various fields for the user in order to search the dataframe  
                     h5('Note: Running the app takes a little while at startup.'),
                     helpText('Job:'),
                     textInput('j',''),
                     helpText('Company:'),
                     selectizeInput('c','',choices=NULL,multiple=T),
                     helpText('Location:'),
                     textInput('l',''),
                     sliderInput('d','Posted (days ago)',min = 0,max = 60,step = 5,value = 60),
                     checkboxGroupInput('s','',choices = c('Indeed','Glassdoor'),selected = c('Indeed','Glassdoor')),
                     actionButton('action6','Search!')
        ),


        mainPanel(

            #Display results
            htmlOutput('printIndex'),
            dataTableOutput('searchresult')
        )      

    )
))

shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分：3)

问题在于which功能：

> which(rep(FALSE, 5))
integer(0)

您可以更改：

ind <- if(is.null(ind.s)){
  NULL
}else{
  ind.null<- which(lapply(ind.all,is.null)==TRUE)
  Reduce(intersect,ind.all[-ind.null])
}

到

ind <- if(is.null(ind.s)){
  NULL
}else{
  Reduce(intersect,ind.all[!sapply(ind.all,is.null)])
}

enter image description here

相关问题
最新问题