2017-01-06 22 views
1

我想用group_by命令創建一個閃亮的動態數據框。R閃亮的dplyr GROUP_BY命令缺失條目

所需表格的行數取決於rv $ VAR值。

由於行的數量是CL ==「1」 和CL之間不同==「2」,因爲有些地區(010102,010103,160101) 沒有空置的外殼,這是行不通的。

如何在表格中顯示0的區域以獲得每種房屋的相同行數 ?

這是我的表的一部分:

PC;COUN;DISTRICT;HOUSING;CL 
01:0101; 010101;  01; 1 
01:0101; 010101;  02; 1 
01:0101; 010101;  03; 1 
01:0101; 010101;  04; 2 
01:0101; 010101;  05; 1 
01:0102; 010102;  01; 1 
01:0102; 010102;  02; 1 
01:0102; 010102;  03; 1 
01:0102; 010102;  04; 1 
01:0102; 010102;  05; 1 
01:0103; 010103;  01; 1 
01:0103; 010103;  02; 1 
01:0103; 010103;  03; 1 
01:0103; 010103;  04; 1 
01:0103; 010103;  05; 1 
15:1501; 150101;  01; 1 
15:1501; 150101;  02; 2 
15:1501; 150101;  03; 1 
15:1501; 150101;  04; 1 
15:1501; 150101;  05; 1 
16:1601; 160101;  01; 1 
16:1601; 160101;  02; 1 
16:1601; 160101;  03; 1 
16:1601; 160101;  04; 1 
21:2101; 210101;  01; 1 
21:2101; 210101;  02; 1 
21:2101; 210101;  03; 2 
21:2101; 210101;  04; 1 
21:2101; 210101;  05; 2 
25:2501; 250101;  01; 1 
25:2501; 250101;  02; 1 
25:2501; 250101;  03; 1 

這是我寫的代碼的一部分:

selectionAcc_View <- reactive({ 

if (rv$CHAMP == "DISTRICT") { 

     selectionAccomodations <- reactive({ 
     return(filter(myTable, DISTRICT %in% rv$VAR))}) 

tmp <- selectionAccomodations() 

dfACC <- tmp %>% 
    group_by(DISTRICT) %>% 
    summarize(Accomodations=n()) 

dfMA <- filter(tmp, CL == "1" %>% 
    group_by(DISTRICT) %>% 
    summarize(MA=n()) 

dfVH <- filter(tmp, CL == "2" %>% 
    group_by(DISTRICT) %>% 
    summarize(VH=n()) 

# Create table 
df <- data.frame(

    Total_Accomodations = c(dfACC$Accomodations), # Number of Accomodations 

    Main_Accomodations = c(dfMA$MA), # Number of Main Accomodations 

    Vacant_Housings = c(dfVH$VH) # Number of Vacant Housings 

    ) # end of data.frame 

    } # end of if 

df 

}) # End of selectionAcc_View <- reactive({ 

# Output the table 
output$df <- renderDataTable(selectionAcc_View(),options = list(paging = 
FALSE, ordering = FALSE,searching = FALSE,info = FALSE)) 

}) # End of shinyServer(function(input, output, session) { 

請,你有一個想法?

非常感謝。

回答

2

無論如何,決定看看,因爲我需要一些dply的做法。但事實證明,這需要使用像tidyr(具有功能completespread)的東西來使所有的工作都正確。

核心問題是由於某些組合的原始數據框中沒有記錄,所以一些條目最終丟失。這就像SQL中「完全外部連接」地址的問題,而不是正常的左右連接行爲,而沒有相應的數據記錄可能會出現潛在條目。

complete與因子水平一起使用,當某些摘要記錄因缺失該性質的數據而未顯示時,使輸出「完整」。所以我必須讓DISTRICT和COUN和CL成爲這個工作的因素。

spread將單列中的值分散到多個列中 - 將「長」數據轉換爲「寬」數據。

我做了一個完整的(ish)例子。沒有嚴格測試正確性。

library(shiny) 
library(dplyr) 
library(tidyr) 
myTable <- read.csv(sep=";",text= 
'PC;COUN;DISTRICT;HOUSING;CL 
01;0101; 010101;  01; 1 
01;0101; 010101;  02; 1 
01;0101; 010101;  03; 1 
01;0101; 010101;  04; 2 
01;0101; 010101;  05; 1 
01;0102; 010102;  01; 1 
01;0102; 010102;  02; 1 
01;0102; 010102;  03; 1 
01;0102; 010102;  04; 1 
01;0102; 010102;  05; 1 
01;0103; 010103;  01; 1 
01;0103; 010103;  02; 1 
01;0103; 010103;  03; 1 
01;0103; 010103;  04; 1 
01;0103; 010103;  05; 1 
15;1501; 150101;  01; 1 
15;1501; 150101;  02; 2 
15;1501; 150101;  03; 1 
15;1501; 150101;  04; 1 
15;1501; 150101;  05; 1 
16;1601; 160101;  01; 1 
16;1601; 160101;  02; 1 
16;1601; 160101;  03; 1 
16;1601; 160101;  04; 1 
21;2101; 210101;  01; 1 
21;2101; 210101;  02; 1 
21;2101; 210101;  03; 2 
21;2101; 210101;  04; 1 
21;2101; 210101;  05; 2 
25;2501; 250101;  01; 1 
25;2501; 250101;  02; 1 
25;2501; 250101;  03; 1') 
myTable$DISTRICT <- as.factor(myTable$DISTRICT) 
myTable$COUN <- as.factor(myTable$COUN) 
myTable$CL <- as.factor(myTable$CL) 

u <- shinyUI(fluidPage(
    titlePanel("Housing Statistics"), 
    sidebarLayout(position = "left", 
      sidebarPanel(h3("sidebar panel"), 
         selectInput("champmode","CHAMP Mode",c("DISTRICT","COUNTY")), 
         uiOutput("uivarselect") 
         ), 
      mainPanel(h3("main panel"), 
        dataTableOutput('outdf') 
        ) 
      ))) 

s <- shinyServer(function(input,output) { 

    rv <- reactiveValues(VAR = NULL,CHAMP = NULL) 

    observeEvent(input$champmode,{ rv$CHAMP = input$champmode }) 
    observeEvent(input$varmode,{ rv$VAR = input$varmode }) 

    output$uivarselect <- renderUI({ 
    req(input$champmode) 
    if (rv$CHAMP == "DISTRICT") { 
     vals <- unique(as.character(myTable$DISTRICT)) 
    } else { 
     vals <- unique(as.character(myTable$COUN)) 
    } 
    selectInput("varmode","VAR Mode",vals) 
    }) 


    selectionAccomodations <- reactive({ 
     if (rv$CHAMP == "DISTRICT") { 
     return(filter(myTable,DISTRICT %in% rv$VAR)) 
     } else { 
     return(filter(myTable,COUN %in% rv$VAR)) 
     } 
    }) 

    selectionAcc_View <- reactive({ 
     tmp <- selectionAccomodations() 
     if (nrow(tmp)==0) return(tmp) # don't process empty dataframe, just display 
     tmp <- group_by(tmp,DISTRICT,COUN,CL) %>% summarize(cn = n()) %>% complete(CL) 
     tmp[is.na(tmp)] <- 0 # replace NAs with zero 
     df <- spread(tmp,CL,cn) 
     names(df) <- c("DISTRICT","COUN","Main_Accomodations","Vacant_Housings") 
     df$Total_Accomodations <- df$Main_Accomodations + df$Vacant_Housings; 
     return(df) 
    }) 

    # Output the table 
    output$outdf <- renderDataTable({ 
     req(input$varmode) # keep from display before we are set up 
     selectionAcc_View() 
     },options = list(paging = F,ordering = F,searching = F,info = F)) 
    } 
) 
shinyApp(ui=u,server=s) 

產量:

enter image description here

+0

太偉大了!我印象深刻,這正是我想要做的。我將調整你的代碼到我的程序中。非常感謝Mike。 –

+1

好的。也會讚賞upvote。 –

+0

對不起,您是否問我點擊分辨率標記上方的向上箭頭?如果是的話,那就完成了,非常感謝你。 –