使用`ftable`属性提取数据

Question

我有时ftable纯粹使用该函数来表示层次类别.但是,有时候,当表很大时,我想在使用它之前进一步对表进行子集化.

假设我们从以下开始:

mytable <- ftable(Titanic, row.vars = 1:3)
mytable
##                    Survived  No Yes
## Class Sex    Age                   
## 1st   Male   Child            0   5
##              Adult          118  57
##       Female Child            0   1
##              Adult            4 140
## 2nd   Male   Child            0  11
##              Adult          154  14
##       Female Child            0  13
##              Adult           13  80
## 3rd   Male   Child           35  13
##              Adult          387  75
##       Female Child           17  14
##              Adult           89  76
## Crew  Male   Child            0   0
##              Adult          670 192
##       Female Child            0   0
##              Adult            3  20

str(mytable)
##  ftable [1:16, 1:2] 0 118 0 4 0 154 0 13 35 387 ...
##  - attr(*, "row.vars")=List of 3
##   ..$ Class: chr [1:4] "1st" "2nd" "3rd" "Crew"
##   ..$ Sex  : chr [1:2] "Male" "Female"
##   ..$ Age  : chr [1:2] "Child" "Adult"
##  - attr(*, "col.vars")=List of 1
##   ..$ Survived: chr [1:2] "No" "Yes"
## NULL

因为没有dimnames,我无法以与拥有对象相同的方式提取数据dimnames.例如,我无法直接从"1st"和"3rd"类中提取所有"Child"值.

我目前的方法是将其转换为a table,进行提取,然后将其转换回ftable.

例:

mytable[c("1st", "3rd"), , "Child", ]
## Error: incorrect number of dimensions

## Only the underlying data are seen as having dims
dim(mytable)
## [1] 16  2

## I'm OK with the "Age" column being dropped in this case....
ftable(as.table(mytable)[c("1st", "3rd"), , "Child", ])
##              Survived No Yes
## Class Sex                   
## 1st   Male             0   5
##       Female           0   1
## 3rd   Male            35  13
##       Female          17  14

但是,我不喜欢这种方法,因为如果你不小心,整体布局有时会改变.将其与以下内容进行比较,从而消除了仅对子集进行子集化的要求,并添加了仅对未生存的子集进行子集化的要求:

ftable(as.table(mytable)[c("1st", "3rd"), , , "No"])
##              Age Child Adult
## Class Sex                   
## 1st   Male           0   118
##       Female         0     4
## 3rd   Male          35   387
##       Female        17    89

我不喜欢行和列的整体布局已经改变.这是一个经典案例,必须记住在drop = FALSE提取单个列时使用维度维度:

ftable(as.table(mytable)[c("1st", "3rd"), , , "No", drop = FALSE])
##                    Survived  No
## Class Sex    Age               
## 1st   Male   Child            0
##              Adult          118
##       Female Child            0
##              Adult            4
## 3rd   Male   Child           35
##              Adult          387
##       Female Child           17
##              Adult           89

我知道有很多方法可以获得我想要的数据,从原始数据的子集开始然后制作我的数据ftable,但对于这个问题,我们假设这是不可能的.

最终目标是让我从ftable保留嵌套"行"层次结构的显示格式中提取一种方法.

还有其他解决方案吗？我们可以使用row.vars和col.vars属性从中提取数据ftable并保留其格式吗？

---

我目前的方法也不适用于分层列,所以我希望提出的解决方案也可以处理这些情况.

例:

tab2 <- ftable(Titanic, row.vars = 1:2, col.vars = 3:4)
tab2
##              Age      Child     Adult    
##              Survived    No Yes    No Yes
## Class Sex                                
## 1st   Male                0   5   118  57
##       Female              0   1     4 140
## 2nd   Male                0  11   154  14
##       Female              0  13    13  80
## 3rd   Male               35  13   387  75
##       Female             17  14    89  76
## Crew  Male                0   0   670 192
##       Female              0   0     3  20

注意"Age"和"Survived"的嵌套.

试试我目前的做法:

ftable(as.table(tab2)[c("1st", "3rd"), , , , drop = FALSE])
##                    Survived  No Yes
## Class Sex    Age                   
## 1st   Male   Child            0   5
##              Adult          118  57
##       Female Child            0   1
##              Adult            4 140
## 3rd   Male   Child           35  13
##              Adult          387  75
##       Female Child           17  14
##              Adult           89  76

我可以回到我想要的东西:

ftable(as.table(tab2)[c("1st", "3rd"), , , , drop = FALSE], row.vars = 1:2, col.vars = 3:4)

但我希望有更直接的东西.

Answer 1

在Axeman的帮助下,这就是我能够一起破解的方式:

replace_empty_arguments <- function(a) {
  empty_symbols <- vapply(a, function(x) {
    is.symbol(x) && identical("", as.character(x)), 0)
  } 
  a[!!empty_symbols] <- 0
  lapply(a, eval)
}

`[.ftable` <- function (inftable, ...) {
  if (!class(inftable) %in% "ftable") stop("input is not an ftable")
  tblatr <- attributes(inftable)[c("row.vars", "col.vars")]
  valslist <- replace_empty_arguments(as.list(match.call()[-(1:2)]))
  x <- sapply(valslist, function(x) identical(x, 0))
  TAB <- as.table(inftable)
  valslist[x] <- dimnames(TAB)[x]
  temp <- as.matrix(expand.grid(valslist))
  out <- ftable(
    `dimnames<-`(`dim<-`(TAB[temp], lengths(valslist)), valslist),
    row.vars = seq_along(tblatr[["row.vars"]]),
    col.vars = seq_along(tblatr[["col.vars"]]) + length(tblatr[["row.vars"]]))
  names(attributes(out)[["row.vars"]]) <- names(tblatr[["row.vars"]])
  names(attributes(out)[["col.vars"]]) <- names(tblatr[["col.vars"]])
  out
}

尝试使用问题中的示例:

mytable[c("1st", "3rd"), , "Child", ]
##                    Survived No Yes
## Class Sex    Age                  
## 1st   Male   Child           0   5
##       Female Child           0   1
## 3rd   Male   Child          35  13
##       Female Child          17  14

mytable[c("1st", "3rd"), , , "No"]
##                    Survived  No
## Class Sex    Age               
## 1st   Male   Child            0
##              Adult          118
##       Female Child            0
##              Adult            4
## 3rd   Male   Child           35
##              Adult          387
##       Female Child           17
##              Adult           89

tab2[c("1st", "3rd"), , , ]
##              Age      Child     Adult    
##              Survived    No Yes    No Yes
## Class Sex                                
## 1st   Male                0   5   118  57
##       Female              0   1     4 140
## 3rd   Male               35  13   387  75
##       Female             17  14    89  76