『集合知プログラミング』を R で

R に翻訳してみた.そういう気分だった.でも,以下のやりかたじゃない別のもっと良い方法があるような気がする.R の神様降ってこい!

critics <- data.frame(matrix(
        #   LW,  SP,  JML, SR,  YMD, TNL
        c(  2.5, 3.5, 3.0, 3.5, 2.5, 3.0, # Lisa Rose
            3.0, 3.5, 1.5, 5.0, 3.5, 3.0, # Gene Seymour
            2.5, 3.0, NA,  3.5, NA,  4.0, # Michael Phillips
            NA,  3.5, 3.0, 4.0, 2.5, 4.5, # Claudia Puig
            3.0, 4.0, 2.0, 3.0, 2.0, 3.0, # Mick LaSalle
            3.0, 4.0, NA,  5.0, 3.5, 3.0, # Jack Matthews
            NA,  4.5, NA,  4.0, 1.0, NA), # Toby
        nrow=7, ncol=6, byrow=TRUE,
        dimnames=list(
            c(  'Lisa.Rose',
                'Gene.Seymour',
                'Michael.Phillips',
                'Claudia.Puig',
                'Mick.LaSalle',
                'Jack.Matthews',
                'Toby'),
            c(  'Lady.in.the.Water',
                'Snakes.on.a.Plane',
                'Just.My.Luck',
                'Superman.Returns',
                'You.Me.and.Dupree',
                'The.Night.Listener'))))

この critics って,やっぱり R だったらデータフレームですよね?他に良いデータ構造あるだろうか・・・

> source('recommendations.r')
> critics['Lisa.Rose','Lady.in.the.Water']
[1] 2.5
> critics['Toby', 'Snakes on a Plane'] <- 4.5
> critics['Toby', ]
     Lady.in.the.Water Snakes.on.a.Plane Just.My.Luck Superman.Returns You.Me.and.Dupree The.Night.Listener
Toby                NA               4.5           NA                4                 1                 NA
>

つづいて距離スコア.

# person1 と person2 の距離を基にした類似性スコアを返す
recommendations.sim_distance <- function (prefs, person1, person2) {
    # 両者が互いに評価しているアイテムのリストを得る
    si <- intersect(which(!is.na(prefs[person1, ])), which(!is.na(prefs[person2, ])))

    # 両者共に評価しているものが一つもなければ 0 を返す
    if (length(si) == 0) { return(0.0) }

    # すべての差の平方を足し合わせる
    sum_of_squares <- sum((prefs[person1, si] - prefs[person2, si])**2)

    return(1.0 / (1.0 + sum_of_squares))
}

実行結果.

> source('recommendations.r')
> recommendations.sim_distance(critics, 'Lisa.Rose', 'Gene.Seymour')
[1] 0.1481481
>

それから Pearson の積率相関係数

# p1 と p2 のピアソン相関係数を返す
recommendations.sim_pearson <- function (prefs, p1, p2) {
    # 両者が互いに評価しているアイテムのリストを得る
    si <- intersect(which(!is.na(prefs[p1, ])), which(!is.na(prefs[p2, ])))

    # 要素の数を調べる
    n <- length(si)

    # 共に評価しているアイテムがなければ 0 を返す
    if (length(si) == 0) { return(0.0) }

    # すべての嗜好を合計する
    sum1 <- sum(prefs[p1, si])
    sum2 <- sum(prefs[p2, si])
    
    # 平方を合計する
    sum1.sq <- sum(prefs[p1, si]**2)
    sum2.sq <- sum(prefs[p2, si]**2)
    
    # 積を合計する
    psum <- sum(prefs[p1, si]*prefs[p2, si])
    
    # ピアソンによるスコアを計算する
    num <- psum - (sum1*sum2/n)
    den <- sqrt((sum1.sq - sum1**2/n)*(sum2.sq - sum2**2/n))
    if (den == 0.0) { return(0.0) }

    return(num / den)
}

実行結果.あたりまえだけど同じになる.

> source('recommendations.r')
> recommendations.sim_pearson(critics, 'Lisa.Rose', 'Gene.Seymour')
[1] 0.396059
>

つぎは topMatches.

# データフレーム prefs から person にもっともマッチするものたちを返す
# 結果の数と類似性関数はオプションのパラメータ
recommendations.top_matches <- function (prefs, person, n=5, similarity=recommendations.sim_distance) {
    scores <- sapply(setdiff(row.names(prefs), person), function (other) { similarity(prefs, person, other) })
    # 高スコアがリストの最初に来るように並び替える
    scores <- rev(sort(scores))
    return(scores[1:n])
}

実行結果:

> source('recommendations.r')
> recommendations.top_matches(critics, 'Toby', n=3, recommendations.sim_pearson)
   Lisa.Rose Mick.LaSalle Claudia.Puig 
   0.9912407    0.9244735    0.8934051 
>

ここまできて時計見て,関数型言語勉強会まであと6時間ちょっとしか無いことに気付きました.寝ます ><