使用 `ftable` 的属性来提取数据 [英] Using attributes of `ftable` for extracting data
问题描述
我有时使用 ftable 函数纯粹是为了显示分层类别.但是，有时，当表很大时，我想在使用它之前进一步对表进行子集化.
I sometimes use the ftable function purely for its presentation of hierarchical categories. However, sometimes, when the table is large, I would like to further subset the table before using it.
假设我们从以下开始:
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"值.
Because there are no dimnames, I can't extract data in the same way that I would with an object that has dimnames. For instance, there's no way for me to directly extract all the "Child" values from the "1st" and "3rd" classes.
我目前的方法是将其转换为table，进行提取，然后将其转换回ftable.
My current approach is to convert it to a table, do the extraction, and then convert it back to an 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
但是，我不喜欢这种方法，因为如果您不小心，整体布局有时会发生变化.与下面的比较，删除了对独生子女进行子集化的要求，并增加了仅对未幸存者进行子集化的要求:
However, I don't like this approach because the overall layout sometimes changes if you're not careful. Compare it with the following, which removes the requirement of subsetting only children and adds the requirement of subsetting only those who did not survive:
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 来维护维度:
I don't like that the overall layout of rows and columns has changed. That's a classic case of having to remember to use drop = FALSE to maintain dimensions when a single column is extracted:
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，但是对于这个问题，让我们假设这是不可能的.
I know there are many ways to get the data that I want, starting with subsetting from the raw data and then making my ftable, but for this question, let's assume that's not possible.
最终目标是有一种方法可以让我从 ftable 中提取保留嵌套行"层次结构的显示格式.
The end goal is to have an approach that lets me extract from an ftable preserving the display format of the nested "row" hierarchy.
是否有其他解决方案?我们可以利用 row.vars 和 col.vars 属性从 ftable 中提取数据并保留其格式吗?
Are there other solutions to this? Can we make use of the row.vars and col.vars attributes to extract data from an ftable and retain its formatting?
我目前的方法也不适用于分层列，所以我希望提议的解决方案也可以处理这些情况.
My current approach also doesn't work for hierarchical columns, so I'm hoping that the proposed solution can also handle those cases.
示例:
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"的嵌套.
Note the nesting of "Age" and "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
我可以回到我想要的状态:
I can get back to what I want with:
ftable(as.table(tab2)[c("1st", "3rd"), , , , drop = FALSE], row.vars = 1:2, col.vars = 3:4)
但我希望有更直接的东西.
But I'm hoping for something more direct.
推荐答案
Here's what I was able to sort of hack together, with some help from 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
这篇关于使用 `ftable` 的属性来提取数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
