Взвешенный наклон одного алгоритма? (портирование с Python на R)

Question

Я читал о Weighted slope one algorithm (и более формально here (PDF)), который должен брать рейтинги позиций от разных пользователей и, учитывая вектор пользователя, содержащий не менее 1 рейтинга и 1 пропущенное значение, предскажите отсутствующие рейтинги.

Я нашел 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

Я использовал ту же ссылку (Python кода Брайана О'Салливэна), чтобы написать версию R наклона One некоторое время назад. Я вставляю код ниже, если это помогает.

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)