web-dev-qa-db-ja.com

Rのネストされたifelseステートメントの代替

次のデータがあるとします。行は国を表し、列(in05:in09)は、その国が特定の年(2005:2009)に対象のデータベースに存在したかどうかを示します。

id <- c("a", "b", "c", "d")
in05 <- c(1, 0, 0, 1)
in06 <- c(0, 0, 0, 1)
in07 <- c(1, 1, 0, 1)
in08 <- c(0, 1, 1, 1)
in09 <- c(0, 0, 0, 1)
df <- data.frame(id, in05, in06, in07, in08, in09)

その国がデータベースに存在した最初の年を示す変数firstyearを作成したいと思います。今、私は次のことをします:

df$firstyear <- ifelse(df$in05==1,2005,
    ifelse(df$in06==1,2006,
        ifelse(df$in07==1, 2007,
            ifelse(df$in08==1, 2008,
                ifelse(df$in09==1, 2009,
                    0)))))

上記のコードはすでにあまり良いものではなく、私のデータセットにはさらに何年も含まれています。このfirstyear変数を作成するために、*apply関数、ループ、またはその他のものを使用する代替手段はありますか?

27

max.colを使用してベクトル化できます

indx <- names(df)[max.col(df[-1], ties.method = "first") + 1L]
df$firstyear <- as.numeric(sub("in", "20", indx))
df
#   id in05 in06 in07 in08 in09 firstyear
# 1  a    1    0    1    0    0      2005
# 2  b    0    0    1    1    0      2007
# 3  c    0    0    0    1    0      2008
# 4  d    1    1    1    1    1      2005
24
David Arenburg
df$FirstYear <- gsub('in', '20', names(df))[apply(df, 1, match, x=1)]
df
  id in05 in06 in07 in08 in09 FirstYear
1  a    1    0    1    0    0      2005
2  b    0    0    1    1    0      2007
3  c    0    0    0    1    0      2008
4  d    1    1    1    1    1      2005

それを行うには多くの方法があります。指定された値の最初のインスタンスが見つかるため、matchを使用しました。コードの他の部分はプレゼンテーション用です。最初にapplyを使用して行ごとに移動し、namesを使用して列名で年に名前を付けます。割り当て<-およびdf$FirstYearは、結果をデータフレームに追加する方法です。

追加されたクレジット@DavidArenburgは、in列の20FirstYearをサブスクライブすることについてのクールなアイデアを持っています。

21

効率に関するいくつかのメモを含む別の回答(ただし、このQAは速度に関するものではありません)。

まず、「list」-y構造から「matrix」への変換を回避する方がよい場合があります。 「行列」に変換して、「dim」属性を持つ「ベクトル」(つまり「行列」/「配列」)を効率的に処理する関数を使用する価値がある場合もありますが、そうでない場合もあります。両方 max.colapplyは「行列」に変換されます。

第2に、ソリューションに到達するときにすべてのデータをチェックする必要がないこのような状況では、次の反復に進むものを制御するループを備えたソリューションの恩恵を受けることができます。ここで、最初の「1」が見つかったら停止できることがわかります。両方 max.col(およびwhich.max)実際には、最大値を見つけるために1回ループする必要があります。 「max == 1」が利用されていないことがわかっているという事実。

第3に、matchの設定はかなり複雑でコストがかかるため、別の値のベクトルで1つの値のみを検索すると、matchの速度が低下する可能性があります。

x = 5; set.seed(199); tab = sample(1e6)
identical(match(x, tab), which.max(x == tab))
#[1] TRUE
microbenchmark::microbenchmark(match(x, tab), which.max(x == tab), times = 25)
#Unit: milliseconds
#                expr       min        lq    median        uq       max neval
#       match(x, tab) 142.22327 142.50103 142.79737 143.19547 145.37669    25
# which.max(x == tab)  18.91427  18.93728  18.96225  19.58932  38.34253    25

要約すると、「data.frame」の「list」構造を処理し、「1」が見つかったときに計算を停止する方法は、次のようなループになります。

ff = function(x)
{
    x = as.list(x)
    ans = as.integer(x[[1]])
    for(i in 2:length(x)) {
        inds = ans == 0L
        if(!any(inds)) return(ans)
        ans[inds] = i * (x[[i]][inds] == 1)
    }
    return(ans)
}

そして、他の回答の解決策(出力の余分な手順を無視):

david = function(x) max.col(x, "first")
plafort = function(x) apply(x, 1, match, x = 1)

ff(df[-1])
#[1] 1 3 4 1
david(df[-1])
#[1] 1 3 4 1
plafort(df[-1])
#[1] 1 3 4 1

そしていくつかのベンチマーク:

set.seed(007)
DF = data.frame(id = seq_len(1e6),
                "colnames<-"(matrix(sample(0:1, 1e7, T, c(0.25, 0.75)), 1e6), 
                             paste("in", 11:20, sep = "")))
identical(ff(DF[-1]), david(DF[-1]))
#[1] TRUE
identical(ff(DF[-1]), plafort(DF[-1]))
#[1] TRUE
microbenchmark::microbenchmark(ff(DF[-1]), david(DF[-1]), as.matrix(DF[-1]), times = 30)
#Unit: milliseconds
#              expr       min        lq    median        uq       max neval
#        ff(DF[-1])  64.83577  65.45432  67.87486  70.32073  86.72838    30
#     david(DF[-1]) 112.74108 115.12361 120.16118 132.04803 145.45819    30
# as.matrix(DF[-1])  20.87947  22.01819  27.52460  32.60509  45.84561    30

system.time(plafort(DF[-1]))
#   user  system elapsed 
#  4.117   0.000   4.125 

実際には黙示録ではありませんが、単純で直接的なアルゴリズムのアプローチは、問題に応じて同等に優れているか、さらに優れていることが証明できることを確認する価値があります。明らかに、(ほとんどの)他の時間のRでのループは面倒な場合があります。

8
alexis_laz

別のオプションは次のとおりです。

years <- as.integer(substr(names(df[-1]), 3, 4)) + 2000L
cbind(df, yr=do.call(pmin.int, Map(`/`, years, df[-1])))

生産:

  id in05 in06 in07 in08 in09   yr
1  a    1    0    1    0    0 2005
2  b    0    0    1    1    0 2007
3  c    0    0    0    1    0 2008
4  d    1    1    1    1    1 2005

そして速いです。ここでは、Alexisのデータを使用して最小年ステップを見つけるタイミングのみを示しています。

Unit: milliseconds
                                       expr       min       lq   median       uq      max neval
 do.call(pmin.int, Map(`/`, 11:20, DF[-1])) 178.46993 194.3760 219.8898 229.1597 307.1120    10
                                 ff(DF[-1]) 416.07297 434.0792 439.1970 452.8345 496.2048    10
                   max.col(DF[-1], "first")  99.71936 138.2285 175.2334 207.6365 239.6519    10

奇妙なことに、これはAlexisのタイミングを再現せず、Davidが最速であることを示しています。これはR3.1.2にあります。


[〜#〜] edit [〜#〜]:フランクとの会話に基づいて、R3.1.2との互換性を高めるためにAlexis関数を更新しました。

ff2 = function(x) {
  ans = as.integer(x[[1]])
  for(i in 2:length(x)) {
      inds = which(ans == 0L)
      if(!length(inds)) return(ans)
      ans[inds] = i * (x[[i]][inds] == 1)
  }
  return(ans)
}

そして、これは元の結果に近づきます。

Unit: milliseconds
        expr       min        lq    median        uq      max neval
  ff(DF[-1]) 407.92699 415.11716 421.18274 428.02092 462.2474    10
 ff2(DF[-1])  64.20484  72.74729  79.85748  81.29153 148.6439    10
4
BrodieG

このツイート に示されているメソッドの行に沿って、dplyr::mutate()内でdplyr::case_whenを使用できます。

# Using version 0.5.0.
# Dev version may work without `with()`.    
df %>%
      mutate(., firstyear = with(., case_when(
        in05 == 1 ~ 2005,
        in06 == 1 ~ 2006,
        in07 == 1 ~ 2007,
        in08 == 1 ~ 2008,
        in09 == 1 ~ 2009,
        TRUE ~ 0
)))
3
seasmith

私はいつも整頓されたデータで作業することを好みます。最初の方法は、cumsumsをフィルタリングします

# Tidy
df <- df %>% 
  gather(year, present.or.not, -id) 

# Create df of first instances
first.df <- df %>% 
  group_by(id, present.or.not) %>% 
  mutate(ranky = rank(cumsum(present.or.not)), 
         first.year = year) %>% 
  filter(ranky == 1)

# Prepare for join
first.df <- first.df[,c('id', 'first.year')]

# Join with original
df <- left_join(df,first.df)

# Spread
spread(df, year, present.or.not)

または、整理した後、配置されたグループから最初の行をスライスするこの代替手段。

df %>% 
  gather(year, present_or_not, -id) %>% 
  filter(present_or_not==1) %>% 
  group_by(id) %>% 
  arrange(id, year) %>% 
  slice(1) %>% 
  mutate(year = str_replace(year, "in", "20")) %>% 
  select(1:2) %>% 
  right_join(df)`
2
Nettle

他の厄介な選択肢:

library(tidyr)
library(sqldf)
    newdf <- gather(df, year, code, -id)
    df$firstyear <- sqldf('SELECT min(rowid) rowid, id, year as firstyear
                            FROM newdf 
                            WHERE code = 1
                            GROUP BY id')[3]
library(tidyr)
df2 <- gather(df, year, code, -id)
df2 <- df2[df2$code == 1, 1:2]
df2 <- df2[!duplicated(df2$id), ]
merge(df, df2)
library(tidyr)
library(dplyr)
    newdf <- gather(df, year, code, -id)
    df$firstyear <- (newdf %>% 
                      filter(code==1) %>%
                      select(id, year) %>%
                      group_by(id) %>%
                      summarise(first = first(year)))[2]

出力:

  id in05 in06 in07 in08 in09 year
1  a    1    0    1    0    0 in05
2  b    0    0    1    1    0 in07
3  c    0    0    0    1    0 in08
4  d    1    1    1    1    1 in05

よりクリーンなソリューション plafortsソリューションとalexises_lazの組み合わせは次のとおりです。

names(df) <- c("id", 2005, 2006, 2007, 2008, 2009)
df$firstyear <- names(df[-1])[apply(df[-1], 1, which.max)] 

  id 2005 2006 2007 2008 2009 firstyear
1  a    1    0    1    0    0      2005
2  b    0    0    1    1    0      2007
3  c    0    0    0    1    0      2008
4  d    1    1    1    1    1      2005

元の列名を保持したい場合は、@ DavidArenburgによって提供された名前変更を使用できます。

df$firstYear <- gsub('in', '20', names(df[-1]))[apply(df[-1], 1, which.max)]

  id in05 in06 in07 in08 in09 firstYear
1  a    1    0    1    0    0      2005
2  b    0    0    1    1    0      2007
3  c    0    0    0    1    0      2008
4  d    1    1    1    1    1      2005
0
mpalanco