8

準備: この質問はほとんどが教育的価値があり、アプローチが完全に最適ではない場合でも、目前の実際のタスクは完了しています。私の質問は、以下のコードを速度のために最適化したり、よりエレガントに実装したりできるかどうかです。おそらく、plyr や reshape などの追加のパッケージを使用します。元の行の一部には NA しか含まれておらず、追加のチェックを行う必要があるため、実際のデータで実行すると、シミュレートされたデータよりもはるかに長い約 140 秒かかります。比較すると、シミュレートされたデータは約 30 秒で処理されます。

条件: データセットには 360 個の変数が含まれており、12 個のセットの 30 倍です。名前を V1_1、V1_2... (最初のセット)、V2_1、V2_2 ... (2 番目のセット) などとしましょう。12 個の変数の各セットには、二分法 (はい/いいえ) の応答が含まれており、実際にはキャリア ステータスに対応しています。たとえば、仕事(はい/いいえ)、勉強(はい/いいえ)など、合計12のステータスを30回繰り返します。

タスク: 当面のタスクは、12 の二分変数の各セットを、12 の応答カテゴリ (仕事、勉強など) を持つ単一の変数に再コード化することです。最終的に、それぞれ 12 の応答カテゴリを持つ 30 の変数を取得する必要があります。

データ: 実際のデータセットを投稿することはできませんが、シミュレートされた近似値は次のとおりです。

randomRow <- function() {
  # make a row with a single 1 and some NA's
  sample(x=c(rep(0,9),1,NA,NA),size=12,replace=F) 
}

# create a data frame with 12 variables and 1500 cases
makeDf <- function() {
  data <- matrix(NA,ncol=12,nrow=1500)
  for (i in 1:1500) {
    data[i,] <- randomRow()
  }
  return(data)
}

mydata <- NULL

# combine 30 of these dataframes horizontally
for (i in 1:30) {
  mydata <- cbind(mydata,makeDf())
}
mydata <- as.data.frame(mydata) # example data ready

私の解決策

# Divide the dataset into a list with 30 dataframes, each with 12 variables
S1 <- lapply(1:30,function(i) {
  Z <- rep(1:30,each=12) # define selection vector
  mydata[Z==i]           # use selection vector to get groups of variables (x12)
})

recodeDf <- function(df) {
  result <- as.numeric(apply(df,1,function(x) {
    if (any(!is.na(df))) which(x == 1) else NA # return the position of "1" per row
  }))                                          # the if/else check is for the real data
  return(result)
}
# Combine individual position vectors into a dataframe
final.df <- as.data.frame(do.call(cbind,lapply(S1,recodeDf)))

全体として、2 つの *apply 関数があり、1 つはリスト全体、もう 1 つはデータフレーム行全体です。これにより、少し遅くなります。助言がありますか?前もって感謝します。

4

4 に答える 4

5

これは基本的に瞬間的なアプローチです。(system.time = 0.1 秒)

set。columnMatch コンポーネントはデータによって異なりますが、12 列ごとであれば、次のように動作します。

MYD <- data.table(mydata)
# a new data.table (changed to numeric : Arun)
newDT <- as.data.table(replicate(30, numeric(nrow(MYD)),simplify = FALSE))
# for each column, which values equal 1
whiches <- lapply(MYD, function(x) which(x == 1))
# create a list of column matches (those you wish to aggregate)
columnMatch <- split(names(mydata), rep(1:30,each = 12))
setattr(columnMatch, 'names', names(newDT))

# cycle through all new columns
# and assign the the rows in the new data.table
## Arun: had to generate numeric indices for 
## cycling through 1:12, 13:24 in whiches[[.]]. That was the problem.
for(jj in seq_along(columnMatch)) {
 for(ii in seq_along(columnMatch[[jj]])) {
  set(newDT, j = jj, i = whiches[[ii + 12 * (jj-1)]], value = ii)
 }
}

これは、元の参照によって列を追加するのと同じように機能します。

メモも同様setに機能しdata.framesます....

于 2013-04-11T00:15:14.243 に答える
4

ベース R でこれを行う別の方法は、単純に新しい行列に入れたい値を取得し、それらを行列インデックスで直接埋めることです。

idx <- which(mydata==1, arr.ind=TRUE)   # get indices of 1's
i <- idx[,2] %% 12                      # get column that was 1
idx[,2] <- ((idx[,2] - 1) %/% 12) + 1   # get "group" and put in "col" of idx
out <- array(NA, dim=c(1500,30))        # make empty matrix
out[idx] <- i                           # and fill it in!
于 2013-04-11T01:54:47.193 に答える
4

私は@Arunの行列乗算のアイデアが本当に好きです。興味深いことに、いくつかの OpenBLAS ライブラリに対して R をコンパイルすると、これを並行して動作させることができます。

ただし、元のパターンを使用するが、実装よりもはるかに高速な別の、おそらく行列乗算よりも遅いソリューションを提供したかったのです。

# Match is usually faster than which, because it only returns the first match 
# (and therefore won't fail on multiple matches)
# It also neatly handles your *all NA* case
recodeDf2 <- function(df) apply(df,1,match,x=1) 
# You can split your data.frame by column with split.default
# (Using split on data.frame will split-by-row)
S2<-split.default(mydata,rep(1:30,each=12))
final.df2<-lapply(S2,recodeDf2)

非常に大きなデータ フレームと多くのプロセッサがある場合は、この操作を次のように並列化することを検討できます。

library(parallel)
final.df2<-mclapply(S2,recodeDf2,mc.cores=numcores) 
# Where numcores is your number of processors.

@Arun と @mnel を読んで、配列への強制を回避し、行ごとではなく列ごとに処理することで、この関数を改善する方法について多くのことを学びましたdata.frame。ここで答えを「盗む」つもりはありません。OPは、チェックボックスを@mnelの回答に切り替えることを検討する必要があります。

data.tableただし、を使用せず、回避するソリューションを共有したかったのforです。ただし、わずかではありますが、@mnelのソリューションよりもまだ遅いです。

nograpes2<-function(mydata) {
  test<-function(df) {
    l<-lapply(df,function(x) which(x==1))
    lens<-lapply(l,length)
    rep.int(seq.int(l),times=lens)[order(unlist(l))]
  }
  S2<-split.default(mydata,rep(1:30,each=12))
  data.frame(lapply(S2,test))
}

また、@Aaron のアプローチを追加したいとwhich思いarr.ind=TRUEます。a への強制は、関数の残りの部分よりも遅くなります。速度が問題になる場合は、最初にデータを行列として読み取ることを検討する価値があります。mydatamatrixdata.framematrix

于 2013-04-10T20:11:59.393 に答える
4

IIUC さん、112 列に 1 列しかありません。残りは 0 または NA です。もしそうなら、このアイデアによって操作ははるかに高速に実行できます。

アイデア:各行を調べて の位置を求める代わりに、各行がちょうど である1次元の行列を使用できます。あれは:1500 * 121:12

mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)

ここで、この行列を各サブセットdata.frame(同じ次元、ここでは 1500*12) で乗算し、それらの "rowSums" (ベクトル化されたもの) をna.rm = TRUE. これは、1 がある行を直接与えるだけです (1 は 1 から 12 までの対応する値で乗算されるため)。


data.table の実装:ここではdata.table、アイデアを説明するために使用します。参照によって列を作成するため、現在のコードを大幅に高速化する必要がありますが、同じアイデアを a で使用するdata.frameと少し遅くなると思います。

require(data.table)
DT <- data.table(mydata)
ids <- seq(1, ncol(DT), by=12)

# for multiplying with each subset and taking rowSums to get position of 1
mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)

for (i in ids) {
    sdcols <- i:(i+12-1)
    # keep appending the new columns by reference to the original data
    DT[, paste0("R", i %/% 12 + 1) := rowSums(.SD * mul.mat, 
                     na.rm = TRUE), .SDcols = sdcols]
}
# delete all original 360 columns by reference from the original data
DT[, grep("V", names(DT), value=TRUE) := NULL]

これで、1 の位置に対応する 30 列が残ります。私のシステムでは、これには約 0.4 秒かかります。

all(unlist(final.df) == unlist(DT)) # not a fan of `identical`
# [1] TRUE
于 2013-04-10T19:34:23.680 に答える