Độ dốc có trọng số là một thuật toán? (chuyển từ Python sang R)

Question

Tôi đã đọc về số Weighted slope one algorithm (và hơn chính thức here (PDF)) được cho là có xếp hạng mục từ những người dùng khác nhau và được cung cấp vector người dùng có ít nhất 1 xếp hạng và 1 giá trị bị thiếu. thiếu xếp hạng.

Tôi đã tìm thấy Python implementation of the algorithm, nhưng tôi đang gặp khó khăn khi chuyển nó sang R (tôi thấy thoải mái hơn). Dưới đây là nỗ lực của tôi. Bất kỳ đề xuất về cách làm cho nó hoạt động?

Xin cảm ơn trước, mọi người.

# 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

Tôi đã sử dụng cùng một tham chiếu (mã Python python của Bryan O'Sullivan) để viết phiên bản R của Độ dốc một lúc trở lại. Tôi đang dán mã dưới đây trong trường hợp nó giúp.

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)