Принуждение таблиц иметь одинаковые размеры при использовании lapply - PullRequest
Новая
       43

Принуждение таблиц иметь одинаковые размеры при использовании lapply

0 голосов
/ 27 февраля 2019

Я пытаюсь построить график зависимости частоты от числа переходов между состояниями для 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 (см. Ответ в моей предыдущей теме), но этот подход также учитывает переход между последним и первым моментом времени в одном человеке, который не имеет никакого смысла.

Заранее спасибо!

РЕДАКТИРОВАТЬ: Код исправлен.

Другой подход этот .Сообщение об ошибке пропало, но, возможно, из-за разной сортировки строк и столбцов число переходов явно неверно.Текущий код выглядит следующим образом: 

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")
      }
    }

Есть ли другие возможности?

1 Ответ

0 голосов
/ 03 марта 2019

Я нашел альтернативное решение.Используя этот код, я также получил количество переходов между последним и первым моментом времени в пределах одного идентификатора.Однако, с 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)

  }
}
...