加重スロープ1アルゴリズム？ （PythonからRへの移植）

Question

私は、異なるユーザーから項目評価を受け取り、少なくとも1つの評価と1つの欠損値を含むユーザー・ベクトルが与えられたと想定されるWeighted slope one algorithm（さらには という形式でhere (PDF)）について読んでいました。不足している評価。

私はPython implementation of the algorithmを見つけましたが、それはRに移植するのが苦労しています（これは私がより快適です）。以下は私の試みです。どのようにそれを動作させるための任意の提案？

ありがとうございます。

# take a 'training' set, tr.set and a vector with some missing ratings, d 
pred=function(tr.set,d) { 
    tr.set=rbind(tr.set,d) 
    n.items=ncol(tr.set) 

    # tally frequencies to use as weights 
    freqs=sapply(1:n.items, function(i) { 
     unlist(lapply(1:n.items, function(j) { 
      sum(!(i==j)&!is.na(tr.set[,i])&!is.na(tr.set[,j])) })) }) 

    # estimate product-by-product mean differences in ratings 
    diffs=array(NA, dim=c(n.items,n.items)) 
    diffs=sapply(1:n.items, function(i) { 
     unlist(lapply(1:n.items, function(j) { 
      diffs[j,i]=mean(tr.set[,i]-tr.set[,j],na.rm=T) })) }) 

    # create an output vector with NAs for all the items the user has already rated 
    pred.out=as.numeric(is.na(d)) 
    pred.out[!is.na(d)]=NA 

    a=which(!is.na(pred.out)) 
    b=which(is.na(pred.out)) 

    # calculated the weighted slope one estimate 
    pred.out[a]=sapply(a, function(i) { 
     sum(unlist(lapply(b,function (j) { 
      sum((d[j]+diffs[j,i])*freqs[j,i])/rowSums(freqs)[i] }))) }) 

    names(pred.out)=colnames(tr.set) 
    return(pred.out) } 
# end function 

# test, using example from [3] 
alice=c(squid=1.0, octopus=0.2, cuttlefish=0.5, nautilus=NA) 
bob=c(squid=1.0, octopus=0.5, cuttlefish=NA, nautilus=0.2) 
carole=c(squid=0.2, octopus=1.0, cuttlefish=0.4, nautilus=0.4) 
dave=c(squid=NA, octopus=0.4, cuttlefish=0.9, nautilus=0.5) 
tr.set2=rbind(alice,bob,carole,dave) 
lucy2=c(squid=0.4, octopus=NA, cuttlefish=NA, nautilus=NA) 
pred(tr.set2,lucy2) 
# not correct 
# correct(?): {'nautilus': 0.10, 'octopus': 0.23, 'cuttlefish': 0.25} 

Answer 1

私は同じリファレンス（Bryan O'Sullivanのpythonコード）を使って、Slope OneのR版をしばらく前に書きました。それが役に立つ場合は、以下のコードを貼り付けています。

predict <- function(userprefs, data.freqs, data.diffs) { 
    seen <- names(userprefs) 

    preds <- sweep(data.diffs[ , seen, drop=FALSE], 2, userprefs, '+') 
    preds <- preds * data.freqs[ , seen] 
    preds <- apply(preds, 1, sum) 

    freqs <- apply(data.freqs[ , seen, drop=FALSE], 1, sum) 

    unseen <- setdiff(names(preds), seen) 
    result <- preds[unseen]/freqs[unseen] 
    return(result[is.finite(result)]) 
} 

update <- function(userdata, freqs, diffs) { 
    for (ratings in userdata) { 
     items <- names(ratings) 
     n <- length(ratings) 

     ratdiff <- rep(ratings, n) - rep(ratings, rep(n, n)) 
     diffs[items, items] <- diffs[items, items] + ratdiff 

     freqs[items, items] <- freqs[items, items] + 1 
    } 
    diffs <- diffs/freqs 
    return(list(freqs=freqs, diffs=diffs)) 
} 


userdata <- list(alice=c(squid=1.0, cuttlefish=0.5, octopus=0.2), 
       bob=c(squid=1.0, octopus=0.5, nautilus=0.2), 
       carole=c(squid=0.2, octopus=1.0, cuttlefish=0.4, nautilus=0.4), 
       dave=c(cuttlefish=0.9, octopus=0.4, nautilus=0.5)) 

items <- c('squid', 'cuttlefish', 'nautilus', 'octopus') 
n.items <- length(items) 
freqs <- diffs <- matrix(0, nrow=n.items, ncol=n.items, dimnames=list(items, items)) 

result <- update(userdata, freqs, diffs) 
print(result$freqs) 
print(result$diffs) 

userprefs <- c(squid=.4) 
predresult <- predict(userprefs, result$freqs, result$diffs) 
print(predresult)