私の距離関数を高速化する必要があります。

私は距離行列を計算して、いくつかのクラスタリングに使用します。距離行列のサイズは4.6GBになりますので、計算するためには非常に高速なコードが必要です。私の距離関数を高速化する必要があります。

これを行う最善の方法は私の関数を "ベクトル化"することですが、私はRでプログラミングするのはあまりよくありません.2つの入れ子になったループ！

距離関数は、入力として2点の地理的座標と2つの文字列をとり、次のように距離を計算します。

require(Imap) 

mydist <- function (lat1,lon1,lingua1,lat2,lon2,lingua2,DT){ 
    delta=0.1 
    gamma=3 
    d=sqrt(delta*gdist(lon1,lat1,lon2,lat2)^2 + gamma*(DT[language1 %in% lingua1 & language2 %in%lingua2]$distance)^2) 
}

それは私が保存されているdata.table DTからの私の二つの文字列の距離を読み込み、私の文字列のすべての可能な距離

行列を割り当て機能は次のとおりです。私が働いている：

require(bigmemory) 

distmatrix <- function(twit2,DT){ 
    N=dim(twit2)[1] 
    distmat = big.matrix(N,N) 
    for(i in 1:N){ 
    for(j in 1:N){ 
     distmat[i,j]=mydist(twit2[i,]$longitude,twit2[i,]$latitude,twit2[i,]$language,twit2[j,]$longitude,twit2[j,]$latitude,twit2[j,]$language,DT) 
    } 
    } 
    return(distmat) 
}

EDIT測地線距離計算も

のベクトルバージョンを実装したライブラリ（化石）を使用することです別の方法は、私は今、正方行列であるDT2にDTを移動した

library(fossil) 

lingdist <- function(lang1,lang2, DT2){ 
    list=colnames(DT2) 
    i=which(list==lang1) 
    j=which(list==lang2) 
    return(DT2[i,j]) 
} 

distmatrix <- function(twit2,DT2){ 
    N=dim(twit2)[1] 
    long<-as.vector(twit2$longitude) 
    lat <-as.vector(twit2$latitude) 
    lang<-as.vector(twit2$language) 
    distmat = t(as.matrix(earth.dist(as.matrix(cbind(long,lat))))) 
    for(i in 1:N) { 
    for (j in i:N) { 
     distmat[i,j]=sqrt(distmat[i,j]*distmat[i,j] + lingdist(lang[i],lang[j],DT2)) 
    } 
    } 
    return(distmat) 
}

この（5k行まで）で、20倍のスピードアップを達成しましたが、データフレーム全体（24k行）にdistmatを割り当てることができませんでした。

解決方法はありますか？

EDIT2：ここでは私のデータベースの小さなバージョンは、これははるかに私がdata.tableに基づいて、見つけた最速の代替である

dput(DT2[1:5,1:5]) 
structure(c(0, 0.808204378308, 0.873223132147, 0.885209298235, 
0.849854297278, 0.808204378308, 0, 0.881177373275, 0.854352223232, 
0.854317529225, 0.873223132147, 0.881177373275, 0, 0.834454614055, 
0.861541199715, 0.885209298235, 0.854352223232, 0.834454614055, 
0, 0.76583938666, 0.849854297278, 0.854317529225, 0.861541199715, 
0.76583938666, 0), .Dim = c(5L, 5L), .Dimnames = list(c("1", 
"2", "3", "4", "5"), c("AA.SEMITIC.ARABIC_GULF_SPOKEN", "Alt.TURKIC.TURKISH", 
"An.MESO-PHILIPPINE.TAGALOG", "IE.BALTIC.LITHUANIAN", "IE.CELTIC.WELSH" 
))) 

dput(twit4[1:40,]) 
structure(list(day = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), nil = c(28L, 
28L, 28L, 28L, 28L, 28L, 28L, 28L, 28L, 28L, 28L, 28L, 71L, 71L, 
20L, 5L, 24L, 49L, 50L, 28L, 28L, 22L, 22L, 21L, 21L, 24L, 20L, 
20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 24L 
), longitude = c(9.2235078, 9.22355903, 9.22362504, 9.22318987, 
9.22355654, 9.22361992, 9.22348964, 9.22366317, 9.22383346, 9.2238841, 
9.22374533, 9.22351081, 9.1361611, 9.1361805, 9.2144687, 9.1871549, 
9.2504309, 9.14652258, 9.16928, 9.22321188, 9.22387642, 9.2237509, 
9.22372656, 9.22278207, 9.2225214, 9.2470243, 9.22405217, 9.22404052, 
9.22405638, 9.22396956, 9.22402622, 9.2239671, 9.2239646, 9.22400299, 
9.22400299, 9.22403204, 9.22396816, 9.22404027, 9.22407831, 9.246786 
), latitude = c(45.45206021, 45.45202558, 45.4523043, 45.45211746, 
45.45204048, 45.45232425, 45.45207132, 45.45205533, 45.45218499, 
45.45216514, 45.45220716, 45.45214255, 45.5053803, 45.5053559, 
45.4871762, 45.4539539, 45.4660934, 45.45278042, 45.455855, 45.45882439, 
45.46055371, 45.47414199, 45.47947343, 45.48080458, 45.48119442, 
45.4658805, 45.49167007, 45.49168084, 45.49160813, 45.49164877, 
45.49165014, 45.49163468, 45.49165405, 45.49169004, 45.49169004, 
45.49160814, 45.49164155, 45.49161845, 45.49160889, 45.4660437 
), language = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 4L, 4L, 1L, 8L, 4L, 4L, 8L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("AA.SEMITIC.ARABIC_GULF_SPOKEN", 
"AA.SEMITIC.HEBREW", "Alt.TURKIC.TURKISH", "An.MESO-PHILIPPINE.TAGALOG", 
"AuA.VIET-MUONG.VIETNAMESE", "IE.ARMENIAN.EASTERN_ARMENIAN", 
"IE.BALTIC.LATVIAN", "IE.BALTIC.LITHUANIAN", "IE.CELTIC.WELSH", 
"IE.GERMANIC.DANISH", "IE.GERMANIC.DUTCH", "IE.GERMANIC.ICELANDIC", 
"IE.GERMANIC.NORWEGIAN_BOKMAAL", "IE.GERMANIC.STANDARD_GERMAN", 
"IE.GERMANIC.SWEDISH", "IE.GREEK.GREEK", "IE.INDIC.HINDI", "IE.IRANIAN.PERSIAN", 
"IE.ROMANCE.FRENCH", "IE.ROMANCE.PORTUGUESE", "IE.ROMANCE.ROMANIAN", 
"IE.ROMANCE.SPANISH", "IE.SLAVIC.BOSNIAN", "IE.SLAVIC.BULGARIAN", 
"IE.SLAVIC.CROATIAN", "IE.SLAVIC.POLISH", "IE.SLAVIC.RUSSIAN", 
"IE.SLAVIC.SERBOCROATIAN", "IE.SLAVIC.SLOVAK", "IE.SLAVIC.SLOVENIAN", 
"IE.SLAVIC.UKRAINIAN", "Jap.JAPANESE.JAPANESE", "Kor.KOREAN.KOREAN", 
"Krt.KARTVELIAN.GEORGIAN", "Oth.CREOLES_AND_PIDGINS.HAITIAN_CREOLE", 
"ST.CHINESE.CANTONESE", "TK.KAM-TAI.THAI", "Ura.FINNIC.ESTONIAN", 
"Ura.FINNIC.FINNISH", "Ura.UGRIC.HUNGARIAN"), class = "factor")), .Names = c("day", 
"nil", "longitude", "latitude", "language"), row.names = c("2", 
"6", "7", "8", "13", "15", "16", "20", "25", "29", "30", "32", 
"84", "86", "195", "266", "322", "467", "495", "521", "524", 
"534", "542", "546", "550", "580", "624", "640", "668", "676", 
"679", "699", "742", "751", "754", "768", "779", "800", "803", 
"857"), class = "data.frame")

出典

2016-06-20 user5609462

1つのハックは、単に上三角行列を使用することになります。ポイント（AとB）とポイント（BとA）の間の距離を実際に計算する必要はありません。これを実現するには 'for（j in 1：N）'を 'for（j in i：N）'に変更するだけでよいでしょう。 – abhiieor

ループの外側でdata.frameサブセットを実行する必要があります（たとえば、 'long < - twit2 $ longitude'）。そして、ループの中で' long [i] 'を使用します。しかし、おそらく、十分な速度は、例えばRcppを用いてコンパイルされたコードでのみ達成することができる。 – Roland

あなたは[post]（http://stackoverflow.com/questions/2908822/speed-up-the-loop-operation-in-r）を知っていますか？ – Christoph

です。データセット内の各行が原点（lat long）と宛先（lat long）の組み合わせを持つように、データを長い形式で編成する必要があります。

4簡単な手順

# load library 
library(geosphere) 
library(data.table) 

### STEP 1. reshape your matrix with languange distances to long format 
setDT(DT)[, language := names(DT)] 
DT_long <- melt.data.table(DT, id.vars="language", variable.name = "language2", value.name = "lingdist") 


### STEP 2. Get all possible combinations of origin and destination in long format 
df <- expand.grid.df(twit4, twit4) 
names(df)[c(3,4,5,8,9,10)] <- c("long_orig", "lat_orig", "language", "long_dest", "lat_dest","language2") 


### STEP 3. Efficiently merge the two datasets 
setkey(DT_long, "language", "language2") 
setkey(df, "language", "language2") 
df <- df[DT_long, nomatch=0] 


### STEP 4. Calculate distances 
df[ , dist := lingdist + distGeo(matrix(c(long_orig, lat_orig), ncol = 2), 
           matrix(c(long_dest, lat_dest), ncol = 2))/1000]

このソリューションは、比較的高速である必要があります。ここでのボトルネックは、expand.grid.df操作です。これはおそらく、大量のデータセットを扱う場合に特に時間がかかるコードの一部です。私は確かにexpand.grid.dfへのより速い選択肢がなければならないと確信しています。私はこの答えを見つけたら更新します。

出典

2016-06-20 23:18:55

それは非常に興味深い解決策ですが、2つの問題があります： 1）私の距離の定義が違う、ティは "言語距離"の部分も持っているから// 2）大きなデータフレームで私はできませんprocess expand.grid.df – user5609462

操作の言語的距離を組み込むために私の答えを更新しました。 2つのタイプの距離を合計したいですか？あなたのポイント2に関しては、 'expand.grid.df'は実際ここでのボトルネックですが、私はそれに速い代替手段がなければならないと確信しています –

私の距離関数を高速化する必要があります。

答えて

関連する問題