2017-01-06 24 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

对不起,您是否问我点击分辨率标记上方的向上箭头?如果是的话,那就完成了,非常感谢你。 –