时间戳

首页 > 解决方案 > 使用 lapply 时强制表格具有相同的尺寸

r - 使用 lapply 时强制表格具有相同的尺寸

问题描述

我正在尝试绘制 150 个人的频率与状态之间转换的数量。为此，使用 lapply 来为每个人生成转换表。但是，由于有些人只有很少的转换或根本没有转换，因此生成的表在行/列数上彼此不同。因此，当我尝试提取转换的数量以绘制它们时，我会收到“维度数不正确”的错误。我看过这个帖子，但我没有成功地将解决方案应用于我的案例。

这是我当前的代码：

n_STATEs <- 4

data <- read.csv("transitiondata.csv")
transitions <- by(data,data$ID,
                  function(xx)data.frame(ID=head(xx$ID,-1),
                                         TIME=tail(xx$TIME,-1),
                                         FROM=head(xx$STATE,-1),
                                         TO=tail(xx$STATE,-1)))
transition_table <- lapply(transitions,function(xx)with(xx,table(FROM,TO)))
min_n_transitions <- min(unlist(transition_table))
max_n_transitions <- max(unlist(transition_table))
max_freq <- 150  

par(mfrow=rep(n_STATEs,2),mai=c(.4,.4,.4,.1))
for ( from in 1:n_STATEs ) {
  for ( to in 1:n_STATEs ) {
    sapply(transition_table,"[",from,to)
    hist(foo,freq=TRUE,
         xlim=c(min_n_transitions,max_n_transitions),
         ylim=c(0,max_freq),xlab="",ylab="",
         main=paste("From",from,"to",to),las=1,col="lightgray")
  }
}

这是数据集。我也尝试在不使用 lapply 的情况下获取转换数（请参阅我之前的帖子中的答案），但是这种方法也计算了一个人中最后一个时间点和第一个时间点之间的转换，这没有任何意义。

先感谢您！

编辑：代码已修复。

另一种方法是this one。错误消息消失了，但是，可能由于行和列的排序不同，转换计数显然是错误的。当前代码如下所示：

n_STATEs <- 4

    data <- read.csv("transitiondata.csv")
    transitions <- by(data,data$ID,
                      function(xx)data.frame(ID=head(xx$ID,-1),
                                             TIME=tail(xx$TIME,-1),
                                             FROM=head(xx$STATE,-1),
                                             TO=tail(xx$STATE,-1)))
    transition_table <- lapply(transitions,function(xx)with(xx,table(FROM,TO)))
cols <- unique(unlist(sapply(transition_table, colnames)))
rows <- unique(unlist(sapply(transition_table, rownames)))
result <- lapply(transition_table, function(m) {
  missingrows <- setdiff(rows, rownames(m))
  missingcols <- setdiff(cols, colnames(m))
  rbind(cbind(m,
              structure(matrix(0, nrow=nrow(m), ncol=length(missingcols)),
                        dimnames=list(NULL, missingcols))),
        structure(matrix(0, nrow=length(missingrows), ncol=length(cols)),
                  dimnames=list(missingrows)))
})
min_n_transitions <- min(unlist(result))
    max_n_transitions <- max(unlist(result))
    max_freq <- 150  

    par(mfrow=rep(n_STATEs,2),mai=c(.4,.4,.4,.1))
    for ( from in 1:n_STATEs ) {
      for ( to in 1:n_STATEs ) {
        sapply(result,"[",from,to)
        hist(foo,freq=TRUE,
             xlim=c(min_n_transitions,max_n_transitions),
             ylim=c(0,max_freq),xlab="",ylab="",
             main=paste("From",from,"to",to),las=1,col="lightgray")
      }
    }

还有其他可能吗？

标签： rhistogramdata-visualizationtransitionlapply

解决方案

我找到了替代解决方案。使用此代码，我还获得了一个 ID 内最后一个时间点和第一个时间点之间的转换计数。但是，有了arrange和subset我就可以摆脱这种奇怪的行为。当前代码如下所示：

transitions <-  data.frame(ID=head(data$ID,-1),
                           TIME=tail(data$TIME, -1),FROM=head(data$STATE,-1),
                           TO=tail(data$STATE,-1))

tran1<-arrange(transitions, ID, TIME)
tran2<-subset(tran1, TIME!=0)
transition_table <- with(tran2,table(FROM,TO,ID))
min_n_transitions <- min(unlist(transition_table))
max_n_transitions <- max(unlist(transition_table))
max_freq <- 150 
bins <- c(-0.5, 0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5)
par(mfrow=rep(4,2),mai=c(.3,.3,.3,.1))
for ( from in 1:4 ) {
  for ( to in 1:4 ) {
    foo <- transition_table[from,to,]
    hist(foo,freq=TRUE,
         breaks=bins,
         xlim=c(-.5,max_n_transitions),
         ylim=c(0,max_freq),xlab="",ylab="",
         main=paste("From",from,"to",to),las=1,col="lightgray")
    mtext('Number of transitions', side = 1, outer = TRUE, line = 2)
    mtext('Frequency', side = 2, outer = TRUE, line = 1.5)

  }
}

推荐阅读