perl de 集合知プログラミング（１）

集合知プログラミングを題材に、機械学習とperlを学んでいこうと思っています。

ユークリッド距離を基にした類似性判定

今回は、2章の協調フィルタリングの中の2.3.1節をperlで実装してみました。pythonのサンプルコードをそのままperlにしただけです。

#! /usr/bin/perl

use strict;
use warnings;

my %critics = (
    'Lisa Rose' =>  {
	'Lady in the Water' => 2.5, 
	'Snakes on a Plane' => 3.5, 
	'Just My Luck' => 3.0, 
	'Superman Returns' => 3.5, 
	'You, Me and Dupree' => 2.5,
	'The Night Listener' => 3.0
    },
    'Gene Seymour' =>  {
	'Lady in the Water' => 3.0, 
	'Snakes on a Plane' => 3.5, 
	'Just My Luck' => 1.5, 
	'Superman Returns' => 5.0, 
	'The Night Listener' => 3.0,
	'You, Me and Dupree' => 3.5
    },
    'Michael Phillips' =>  {
	'Lady in the Water' => 2.5, 
	'Snakes on a Plane' => 3.0, 
	'Superman Returns' => 3.5, 
	'The Night Listener' => 4.0
    },
    'Claudia Puig' =>  {
	'Snakes on a Plane' => 3.5, 
	'Just My Luck' => 3.0, 
	'The Night Listener' => 4.5,
	'Superman Returns' => 4.0, 
	'You, Me and Dupree' => 2.5
    },
    'Mick LaSalle' =>  {
	'Lady in the Water' => 3.0, 
	'Snakes on a Plane' => 4.0,  
	'Just My Luck' => 2.0, 
	'Superman Returns' => 3.0, 
	'The Night Listener' => 3.0, 
	'You, Me and Dupree' => 2.0
    },
    'Jack Matthews' =>  {
	'Lady in the Water' => 3.0, 
	'Snakes on a Plane' => 4.0, 
	'The Night Listener' => 3.0, 
	'Superman Returns' => 5.0, 
	'You, Me and Dupree' => 3.5
    },
    'Toby' =>  {
	'Snakes on a Plane' => 4.5, 
	'Superman Returns' => 4.0, 
	'You, Me and Dupree' => 1.0
    }
    );

# person1とperson2のユークリッド距離を基にした類似性スコアを返す
sub sim_distance {
    my ($prefs, $person1, $person2) = @_;

    # 二人とも評価しているアイテムのリストを得る
    my %si = ();
    foreach my $key (keys %{ $prefs->{$person1} } ) {
	if ($prefs->{$person2}->{$key}) {
	    $si{$key} = 1;
	}
    }

    # 両者ともに評価しているものが一つもなければ0を返す
    my $n = keys %si;
    if ($n == 0) { return 0; }

    # すべての差の平方を足し合わせる
    my $sum_of_squares;
    foreach my $key (keys %{ $prefs->{$person1} } ) {
	if ($prefs->{$person2}->{$key}) {
	    $sum_of_squares += ( ($prefs->{$person1}->{$key} - $prefs->{$person2}->{$key}) ** 2 );
	}
    }

    return (1 / (1 + $sum_of_squares));
}

# person1とperson2のスコアを求める
print "List of Persons:\n";
foreach my $user (keys %critics) {
    print "\t";
    print $user . "\n";
}

print "Enter person1 ==> ";
my $person1 = <STDIN>; 
chomp($person1);

print "Enter person2 ==> ";
my $person2 = <STDIN>;
chomp($person2);

my $sim_score = sim_distance(\%critics, $person1, $person2);

print "Similarity Score == $sim_score" . "\n";

映画を評価したユーザと、各映画への評価スコアのデータセットをハッシュで記述して、あとはユークリッド距離を用いた類似性スコアを返すサブルーチンは本の中と同じです。標準入力から類似性を判定したいユーザを取得する部分は追加してます。

実行すると、

List of Persons:
	Toby
	Michael Phillips
	Gene Seymour
	Lisa Rose
	Claudia Puig
	Mick LaSalle
	Jack Matthews
Enter person1 ==> 

となるのでperson1を入力、続いてperson2の入力も促されるのでそれも同じように入力すると、類似性スコアが出力されます。

Enter person1 ==> Lisa Rose
Enter person2 ==> Gene Seymour
Similarity Score == 0.148148148148148

なんとか動くものがかけてほっとしました。