2016-05-22 4 views
2

これはwhichの簡単なアプリケーションであるはずですが、わかりません。私は、与えられた調査波に人が存在していたかどうかを示す行列を持っています。私はベクトルのリスト、行列の行ごとに1つのリスト要素に変換して、人が存在する時間の範囲を示したいと思います。ここで私は何をしようとしているの作業例です:サンプルコードが示すようにどのようにTRUE値のシーケンスをどこで開始し終了するのかを示す値で置き換えますか?

in.wave <- structure(c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, 
FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, 
TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, 
TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, TRUE, TRUE, 
TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE, 
TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, 
TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, 
FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, 
TRUE, TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, 
FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, 
TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, 
TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, 
FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, 
TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, 
TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, 
TRUE), .Dim = c(108L, 4L), .Dimnames = list(NULL, c("wave5", 
"wave6", "wave7", "wave8"))) 

head(in.wave) 
#  wave5 wave6 wave7 wave8 
# [1,] TRUE TRUE FALSE FALSE 
# [2,] TRUE TRUE TRUE FALSE 
# [3,] TRUE TRUE TRUE TRUE 
# [4,] TRUE TRUE TRUE TRUE 
# [5,] TRUE TRUE TRUE TRUE 
# [6,] TRUE TRUE TRUE TRUE 

# Current approach is pure brute force: 
possibilities <- expand.grid(list(c(T, F), c(T, F), c(T, F), c(T, F))) 
output <- list(
    c(5.0, 8.0), 
    c(5.4, 8.0), 
    c(5.0, 5.4, 6.4, 8.0), 
    c(6.4, 8.0), 
    c(5.0, 6.4, 7.4, 8.0), 
    c(5.4, 6.4, 7.4, 8.0), 
    c(5.0, 5.4, 7.4, 8.0), 
    c(7.4, 8.0), 
    c(5.0, 7.4), 
    c(5.4, 7.4), 
    c(5.0, 5.4, 6.4, 7.4), 
    c(6.4, 7.4), 
    c(5.0, 6.4), 
    c(5.4, 6.4), 
    c(5.0, 5.4), 
    c(0) 
) 

desired <- apply(in.wave, 1, function(trial) { 
    output[[which(apply(possibilities, 1, function(x) all(trial == x)))]] 
}) 

head(desired) 
# [[1]] 
# [1] 5.0 6.4 
# 
# [[2]] 
# [1] 5.0 7.4 
# 
# [[3]] 
# [1] 5 8 
# 
# [[4]] 
# [1] 5 8 
# 
# [[5]] 
# [1] 5 8 
# 
# [[6]] 
# [1] 5 8 

、私は現在、ブルートフォースすることによって、これをやっている - 私はすべての2^4の可能性を列挙していますか、何を書き留め出力は、in.waveの各行の正しい出力を参照する必要があります。これを8列に拡大するので、2^8のすべての可能性を書き留めてはいけません。

希望する出力は、偶数長のベクトルのリストです。各要素のペアは、誰かが調査に出入りするときを示します。たとえば、すべての波に現れる人がいる場合、希望の出力はベクトルc(5.0, 8.0)になり、波7に欠けている人がいる場合は、希望の出力はc(5.0, 6.4, 7.4, 8.0)になります。

人が真ん中の波に紛失しないようにするには、rangewhichのようなものを使用して、存在する値を取得します。しかし、複数の呪文を持つことは私を捨てている。これを簡潔に解決する方法は?

+1

私の最初の努力は、 'apply(in.wave、1、rle)'の結果から始まり、番号付けは最初のTRUEで始まるでしょう。 –

+0

@ 42ありがとう!それは良い提案でした - 私はそれを利用する答えを投稿しました。 –

答えて

1

42の提案に続いて、私はrleを利用する機能をまとめました。これは正解ですが、ここの誰かがより洗練されたソリューションを提供してくれることを願っています。

makeJoinLeaveVector <- function(x) { 
    # Recodes a logical vector into a set of paired values indicating when people 
    # enter or leave a population 
    # 
    # Args: 
    # x: a logical vector 
    # 
    # Returns: 
    # A vector of length(rle(x)$values) * 2 with paired values indicating 0.6 
    # before each first value of TRUE in a set of them, and .4 after each last 
    # value of TRUE in a set of them. 
    stopifnot(is.logical(x)) 

    # Get the run length encoding 
    x.rle <- rle(x) 

    # Now save a vector for each of the TRUE values 
    is.true <- which(x.rle$values) 

    out <- c(is.true, is.true + x.rle$lengths[is.true]) - 0.6 
    names(out) <- NULL 

    # Recode first and last possible values 
    out <- ifelse(out == 0.4, 1.0, out) 
    out <- ifelse(out == 4.4, 4.0, out) 

    return(sort(out) + 4) 
} 

desired <- apply(in.wave, 1, makeJoinLeaveVector) 

head(desired) 
# [[1]] 
# [1] 5.0 6.4 
# 
# [[2]] 
# [1] 5.0 7.4 
# 
# [[3]] 
# [1] 5 8 
# 
# [[4]] 
# [1] 5 8 
# 
# [[5]] 
# [1] 5 8 
# 
# [[6]] 
# [1] 5 8 
+1

TRUE、FALSE、TRUE、TRUEなどの組み合わせのエンドポイントをドロップするには、 'append'を使用する必要があるとは思っていましたが、十分にコンパクトであると思われます。 –

0

これはもっとエレガントではありませんが、これを追加したと思いました。 コードの最終ビットは、おそらくもっときれいに書くことができます。

in.wave[, 2:4] - in.wave[, 1:3]を計算する方法は、誰かが調査を終了すると-1になり、誰かが調査に入ると-1になります。

times <- c(5, 5.4, 6.4, 7.4, 8) 

# exiting gives a -1 
# entering gives a 1 
# No change gives a 0 
transitions <- in.wave[, 2:4] - in.wave[, 1:3] 

# Find the entrance and exit points of the survey 
exits <- apply(transitions, 1, function(x) times[which(x == -1) + 1]) 
entrances <- apply(transitions, 1, function(x) times[which(x == 1) + 1]) 


# Combine entrances and exits 
desired <- lapply(seq_len(nrow(in.wave)), function(x) sort(c(entrances[[x]], exits[[x]]))) 

# If no entrances, subject must have been in study from the beginning 
desired <- 
    lapply(seq_len(nrow(in.wave)), function(x) if(length(entrances[[x]]) == 0){ 
               c(times[1], desired[[x]]) 
              } else { 
               desired[[x]] 
              }) 
# If no exits, subject must have remained in study until the end. 
desired <- 
    lapply(seq_len(nrow(in.wave)), function(x) if(length(exits[[x]]) == 0){ 
               c(desired[[x]], times[5]) 
              } else { 
               desired[[x]] 
              }) 
関連する問題