在 R 中的 Shiny 上繪制密度圖； 得到“錯誤：數學函數的非數字參數”

Question

我正在構建一個 shiny 應用程序，它的一個功能涉及使用密度圖來查看數值數據的分布。 問題是，當應用程序運行時，當我嘗試 plot 時收到此錯誤消息：-

Error: non-numeric argument to mathematical function

這是一些模擬數據：-

outcome<-c("Answered","Abandoned","Engaged")
Duration_A<-floor(runif(300,min=1,max = 2000))
Duration_A
Duration_B<-floor(runif(300,min=200,max = 5000))
Duration_B
Duration_C<-floor(runif(300,min=400,max = 8000))
Duration_C
Center<-c("Center A","Center B","Center C","Center D","Center E","Center F")

df<-as.data.frame(cbind(outcome,Center,Duration_A,Duration_B,Duration_C))
df$Duration_A<-as.numeric(df$Duration_A)
df$Duration_B<-as.numeric(df$Duration_B)
df$Duration_C<-as.numeric(df$Duration_C)


df$Date<-structure(c(18191, 17659, 17592, 18392, 17799, 17781, 18398, 
                     17636, 17719, 18085, 18505, 18494, 17580, 18507, 18270, 17613, 
                     17559, 17731, 17619, 17578, 17678, 18434, 18265, 18210, 18380, 
                     17696, 17617, 17755, 18246, 17684, 18424, 17701, 18236, 17567, 
                     18416, 18222, 18293, 18136, 18315, 17762, 17999, 17824, 17715, 
                     18487, 18398, 17702, 18428, 18478, 18178, 18110, 18042, 18029, 
                     17559, 18281, 18025, 17769, 18160, 17665, 17589, 17867, 18065, 
                     18357, 18154, 18483, 18021, 17902, 18527, 17966, 18249, 17751, 
                     17971, 18177, 17959, 18522, 18068, 17566, 17973, 18127, 18265, 
                     17552, 17889, 18395, 17812, 17898, 18357, 18442, 18454, 17659, 
                     17644, 18519, 18547, 17591, 18095, 17847, 17700, 17584, 17745, 
                     18182, 18246, 18102, 17689, 17822, 17804, 17597, 18159, 17555, 
                     17566, 17770, 17572, 17720, 17753, 18237, 18308, 18410, 17805, 
                     17579, 17857, 17698, 17865, 18342, 18338, 17998, 17817, 18128, 
                     18249, 18104, 17731, 18418, 17796, 18477, 17824, 17939, 17546, 
                     18059, 18496, 18056, 18488, 18394, 18526, 17945, 17998, 18402, 
                     17882, 18325, 17744, 18422, 18300, 17601, 18451, 17852, 17560, 
                     18238, 17923, 18267, 17593, 18342, 18021, 18075, 18243, 17688, 
                     18519, 17737, 17786, 17648, 17705, 18221, 17680, 17631, 17601, 
                     17612, 18043, 17534, 17881, 17783, 17716, 17665, 18260, 17918, 
                     17805, 18155, 18423, 17688, 17642, 17890, 17953, 17772, 18315, 
                     18389, 18167, 18463, 18294, 17773, 18215, 17999, 18520, 17687, 
                     17961, 17955, 17955, 17758, 18029, 18055, 17769, 17975, 18556, 
                     17745, 17883, 18500, 17812, 18448, 18121, 17740, 18082, 17613, 
                     17761, 18030, 18321, 17755, 18047, 18180, 17848, 17756, 17784, 
                     18401, 17634, 17823, 18458, 18159, 17753, 17813, 17822, 17685, 
                     18374, 18505, 18104, 18501, 17856, 17932, 18246, 18465, 18098, 
                     17934, 17737, 17731, 18471, 17899, 18342, 18077, 18317, 17639, 
                     17540, 17971, 17798, 17827, 18121, 17641, 18469, 17686, 18239, 
                     18309, 18081, 17908, 17897, 18092, 18510, 18551, 17822, 18557, 
                     17904, 18170, 18246, 18382, 17766, 18511, 18105, 18381, 18369, 
                     17952, 18274, 17709, 18403, 17686, 18401, 17700, 17954, 18217, 
                     17935, 17811, 17719, 17885, 17771, 17735, 17555, 17555, 18446, 
                     17928, 17748, 17547, 18487, 18221), class = "Date")

這是用戶界面：-

ui<-fluidPage(
  titlePanel('Minimal example'),
  tabsetPanel(
    tabPanel("Duration analysis",
             sidebarLayout(
               sidebarPanel(width = 4,
                            dateRangeInput("duration_daterange","Select date range", format="yyyy-mm-dd",
                                           start=min(df$Date),
                                           end=max(df$Date)),
                            pickerInput("duration_col", "Select duration column",
                                        choices = c("Duration_A",
                                                    "Duration_B",
                                                    "Duration_C")),
                            pickerInput("contactoutcome", "Select contact outcome",
                                        choices=c("Answered", "Abandoned", "Engaged")),
                            pickerInput("center_choice", "Select centers",
                                        choices = c("Do not specify",
                                                    "Center A",
                                                    "Center B",
                                                    "Center C",
                                                    "Center D",
                                                    "Center E",
                                                    "Center F"),options = list('actions-box'=TRUE, 'live-search'=TRUE), multiple = T),
                            actionButton("runduration", "Run analysis")
                            
                 
                 
               ),
               
               mainPanel(
                 column(width = 8, box("Plot", plotOutput("densityplot"), width = "100%"))
               )
             )
             
             
             
      
      
      
    )
    
    
    
  ))#end of fluidpage

還有我的服務器：-

  server<-function(input,output,session){
    
    observeEvent(input$runduration,{
      
      outcome<-as.character(input$contactoutcome)
      durationcolumn<-as.character(input$duration_col)
      
      
      
        
        reactiveDF<-reactive({
          
        if(input$center_choice=="Do not specify"){
          
          df%>%
            filter(Date>=input$duration_daterange[1] & Date<=input$duration_daterange[2])
            
        }  else
          if(input$center_choice!="Do not specify"){
            
            df%>%
              filter(Date>=input$duration_daterange[1] & Date<=input$duration_daterange[2])%>%
              filter(Center %in% input$center_choice)
            
          }
      
          
        })
      
      
       
      output$densityplot<-renderPlot({
      
  
          
        
        
      ggplot(reactiveDF(), aes(x=input$duration_col))+
        geom_density()+scale_x_log10()
        
      })
      
    })
    
  }

  
  shinyApp(ui,server)  

注意：如果我想對 select 所有中心進行分析，我希望通過在pickerInput中聲明“不指定”來執行它。 我確定我在某個地方犯了一個簡單的錯誤，但對我來說並不是那么明顯。 任何幫助將不勝感激：）

Answer 1

也許你應該試試這個

server<-function(input,output,session){
  
  observeEvent(input$runduration,{
    
    outcome<-as.character(input$contactoutcome)
    durationcolumn<-as.character(input$duration_col)
    
    reactiveDF <- reactive({
      if (is.null(input$center_choice)) {
        data <- NULL
      }else if(length(input$center_choice)==1 &  input$center_choice=="Do not specify") {
        
        data <- df %>% filter(Date>=input$duration_daterange[1] & Date<=input$duration_daterange[2])
        
      }else {
          
        data <- df %>% filter(Date>=input$duration_daterange[1] & Date<=input$duration_daterange[2])%>%
                       filter(Center %in% input$center_choice)
          
        }
      return(data)
      
    })
    
    
    
    output$densityplot<-renderPlot({
      
      ggplot(data=req(reactiveDF()), aes(x=as.numeric(.data[[as.name(input$duration_col)]]))) +
        geom_density()+scale_x_log10()
      
    })
    
  })
  
}