Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{
"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
}
}
#! /usr/bin/perl
use strict;
use warnings;
use JSON;
use LWP::UserAgent;
use URI::Escape;
use utf8;
use Encode;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use MyRecommendations;
# Popular bookmarkを取得する関数
sub get_popular {
my ($tag, $count) = @_;
# Popular bookmarksをJSON形式で取得 from Delicious
my $tagd = uri_escape(encode('utf-8', $tag)); # URLエンコード
my $base = "http://feeds.delicious.com/v2/json/popular";
my $url = sprintf("%s/%s?count=%d", $base, $tagd, $count);
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new('GET', $url);
my $res = $ua->request($req); # ハッシュを要素に持つ配列が得られる
unless( $res->is_success ) {
die "Request failed : $url";
}
else {
my $r = decode_json(decode_utf8($res->content));
return $r; # 配列のリファレンス
}
}
# Recent bookmark for a URLを取得する関数
sub get_urlposts {
my $urls = shift;
# Recent Bookmars for a URL
my $base = "http://feeds.delicious.com/v2/json/url";
my $count = @{$urls};
my $url;
my $ua = LWP::UserAgent->new;
my $req;
my $res;
my %rb = ();
for( my $i=0; $i<$count; $i++) {
# Request
$url = sprintf("%s/%s", $base, md5_hex($urls->[$i]->{'u'}));
$req = HTTP::Request->new('GET', $url);
$res = $ua->request($req); # ハッシュを要素に持つ配列が得られる
unless( $res->is_success ) {
die "Request failed : $url";
}
else {
my $r = decode_json(decode_utf8($res->content));
$rb{$urls->[$i]->{'u'}} = $r;
}
}
return \%rb;
}
# Popular bookmarkをブックマークしたユーザリスト(user dict)を作成する関数
sub initializeUserDict {
my ($tag, $count) = @_;
# Popular Bookmarksを取得
my $pb = get_popular($tag, $count);
# Recent bookmark for a URLを取得
my $rb = get_urlposts(\%{$pb});
# ユーザをキーにしたハッシュ(user dict)を作成
my %ud = ();
foreach my $key (keys %{$rb}) {
my $loop = @{$rb->{$key}};
for(my $i=0; $i<$loop; $i++) {
$ud{$rb->{$key}->[$i]->{'a'}} = ();
}
}
return \%ud;
}
# user dictに評価値を埋める関数
sub fillItems {
my $ud = shift;
# bookmark for specific user
my $base = "http://feeds.delicious.com/v2/json";
my $url;
my $ua = LWP::UserAgent->new;
my $req;
my $res;
my $r;
my $count;
my %all_items = ();
foreach my $user (keys %{ $ud }) {
$url = sprintf("%s/%s", $base, $user);
$req = HTTP::Request->new('GET', $url);
$res = $ua->request($req);
unless( $res->is_success ) {
warn "Request Failed : " . $url . "\n";
}
else {
$r = decode_json(decode_utf8($res->content));
}
# userがブックマークしているurlは1を埋める
$count = @{$r};
for(my $i=0; $i<$count; $i++) {
$ud->{$user}->{$r->[$i]->{'u'}} = 1.0;
$all_items{$r->[$i]->{'u'}} = 1;
}
}
# userがブックマークしていないurlは0を埋める
foreach my $user (keys %{$ud}) {
foreach my $key (keys %all_items) {
# keyが存在しなければ新たに追加
if( not exists $ud->{$user}->{$key} ) {
$ud->{$user}->{$key} = 0.0;
}
}
}
}
##
## メイン
##
my $tag = 'perl';
my $count = 5;
my $udict = initializeUserDict($tag, $count);
fillItems($udict);
# データセット表示(一部)
my $c1 = 0;
my $c2 = 0;
foreach my $user (keys %{$udict}) {
print "$user : \n";
foreach my $key (keys %{ $udict->{$user} }) {
if( $udict->{$user}->{$key} == 1.0 and $c1 < 2 ) {
print "\t" . $key . ":" . $udict->{$user}->{$key} . "\n";
$c1++;
}
elsif( $udict->{$user}->{$key} == 0.0 and $c2 < 3 ) {
print "\t" . $key . ":" . $udict->{$user}->{$key} . "\n";
$c2++;
}
}
last;
}
my @users = keys(%{$udict});
my $unum = @users;
my $num = int(rand($unum));
my $n = 5;
# Similar User
print "Similar user for $users[$num] :\n";
my @match_users = topMatches($udict, $users[$num], $n, \&sim_pearson);
for (my $i=0; $i<$n; $i++) {
foreach my $key (keys %{ $match_users[$i] }) {
print "\t" . "$key\t : $match_users[$i]{$key}\n";
}
}
# リンクを推薦
print "Recommendations for $users[$num] :\n";
my @recommendations = getRecommendations($udict, $users[$num], \&sim_pearson);
for(my $i=0; $i<$n; $i++) {
foreach my $key (keys %{ $recommendations[$i] }) {
print "\t" . uri_unescape($key) . "\t : $recommendations[$i]{$key}\n";
}
}
# my $i = 0;
# foreach my $key (keys %{ $udict->{$user} }) {
# print $i . " : " . $key . ":" . $udict->{$user}->{$key} . "\n";
# $i++;
# }
# foreach my $key (keys %$udict) {
# print $key . "\n";
# }
#my $r = sim_distance($udict, 'HSN', 'ShelteringTheSky');
#my $r = sim_pearson($udict, 'hayajo', 'kanisan');
#print $r . "\n";
# my $user = 'ftnk';
#my $r = sim_pearson($udict, 'zjape', 'yosshi');
# foreach my $key (keys %{$udict}) {
# print $key . "\n";
# }
#! /usr/bin/perl
use strict;
use warnings;
use JSON;
# 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のピアソン相関係数を返す
sub sim_pearson {
my ($prefs, $person1, $person2) = @_;
# 二人共評価しているアイテムのリストを得る
my %si = ();
foreach my $item (keys %{ $prefs->{$person1} }) {
if ( $prefs->{$person2}->{$item} ) {
$si{$item} = 1;
}
}
# 共に評価しているものが一つもなければ0を返す
my $n = keys %si;
if ($n == 0) { return 0; }
# person1とperson2の評価の平均を求める
my $p1ave = 0.0;
my $p2ave = 0.0;
foreach my $item (keys %si) {
$p1ave += $prefs->{$person1}->{$item};
$p2ave += $prefs->{$person2}->{$item};
}
$p1ave = $p1ave / $n;
$p2ave = $p2ave / $n;
# 偏差の二乗和、偏差積の和を求める
my $Sp1p1 = 0.0;
my $Sp2p2 = 0.0;
my $Sp1p2 = 0.0;
foreach my $item (keys %si) {
$Sp1p1 += (($prefs->{$person1}->{$item} - $p1ave)**2);
$Sp2p2 += (($prefs->{$person2}->{$item} - $p2ave)**2);
$Sp1p2 += (($prefs->{$person1}->{$item} - $p1ave) *
($prefs->{$person2}->{$item} - $p2ave));
}
# 相関係数を求める
my $r = $Sp1p2 / sqrt( $Sp1p1 * $Sp2p2 );
}
# personに最もマッチするトップn人を返す
sub topMatches {
my ($prefs, $person, $n, $similarity) = @_;
# person以外のユーザとのスコア算出
my %scores = ();
foreach my $user (keys %$prefs) {
if ($user ne $person) {
$scores{$user} = &$similarity($prefs, $person, $user);
}
}
# スコアが高い順にソートする
my @sortedscores = ();
foreach my $user (sort {$scores{$b} <=> $scores{$a}} keys %scores) {
my $h = {
$user => $scores{$user}
};
push(@sortedscores, $h);
}
# トップn人を返す
my @result = ();
for (my $i=0; $i<$n; $i++) {
push(@result, $sortedscores[$i]);
}
return \@result;
}
# personへ推薦するアイテムを返す
sub getRecommendations {
my ($prefs, $person, $similarity) = @_;
# ユーザ間の類似性スコアとアイテムの評価点から、対象ユーザが評価していないアイテムの評価値を計算
# 評価値を全ユーザの類似性スコアを合計した値で割った重み付き平均を計算し、値の高い順にソートしてランキングを作成
my %totals = ();
my %simSums = ();
foreach my $user (keys %$prefs) {
next if ($user eq $person);
# ユーザ間の類似性スコア算出
my $score;
$score = &$similarity($prefs, $person, $user);
# 0以下のスコアは無視する
next if ($score <= 0);
# 対象ユーザが評価していないアイテムについて評価値を計算
foreach my $item (keys %{ $prefs->{$user} }) {
if ((not exists $prefs->{$person}->{$item}) || ($prefs->{$person}->{$item} == 0)) {
# 評価値
$totals{$item} += $prefs->{$user}->{$item} * $score;
# 類似性スコアの合計値
$simSums{$item} += $score;
}
}
}
# 重み付き平均の算出
my %li = ();
foreach my $item (keys %totals) {
$li{$item} = $totals{$item} / $simSums{$item};
}
# 値の高い順にソートする
my @rankings = ();
foreach my $item (sort {$li{$b} <=> $li{$a}} keys %li) {
my $h = {
$item => $li{$item}
};
push(@rankings, $h);
}
return \@rankings;
}
# データのitemとpersonを入れ替える
sub transformPrefs {
my ($prefs) = @_;
my %result = ();
foreach my $person (keys %{$prefs}) {
foreach my $item (keys %{ $prefs->{$person} }) {
$result{$item}{$person} = $prefs->{$person}->{$item};
}
}
return %result;
}
# JSON形式をperlデータに変換
sub conv_json2perl {
my $json_file = shift;
# ファイルのオープン
my $json_text;
open(my $fh, "<", $json_file) or die "$!";
{
# ファイル全体を読み込む
local $/ = undef;
$json_text = <$fh>;
}
close $fh;
# decode_json
my $perl_data = decode_json($json_text);
# ハッシュのリファレンスを返す
return $perl_data;
}
# 各アイテムに似ているアイテムのリストを作成する
sub calculateSimilarItems {
my ($prefs, $n, $similarity) = @_;
# ユーザベースのデータをアイテムベースに入れ替える
my %itemPrefs = transformPrefs($prefs);
# リスト作成
my %result = ();
my $c = 0;
foreach my $item (keys %itemPrefs) {
# 巨大なデータセットのときはステータス表示
$c += 1;
if( ($c % 100) == 0 ) {
printf("%d / %d\n", $c, scalar(keys %itemPrefs));
}
# アイテムに似ているアイテムを探す
my $scores = topMatches(\%itemPrefs, $item, $n, $similarity);
$result{$item} = $scores;
}
return \%result;
}
# アイテムベースのレコメンドを行う
sub getRecommendedItems {
my ($prefs, $itemMatch, $user) = @_;
# あるユーザの評価したアイテムと点数へのリファレンス
my $userRatings = $prefs->{$user};
my %scores = ();
my %totalSim = ();
# $userに評価されたアイテムをループする
foreach my $item (keys %{ $userRatings }) {
# そのアイテムの点数
my $rating = $userRatings->{$item};
# アイテム間類似度データの中でこのアイテムに似ているアイテムについて処理
# これはcalculateSimilarItemsで作られたデータでハッシュの配列のハッシュ
my $cnt = @{$itemMatch->{$item}};
for( my $i=0; $i<$cnt; $i++) {
foreach my $item2 (keys %{ $itemMatch->{$item}->[$i] }) {
my $similarity = $itemMatch->{$item}->[$i]{$item2};
# このアイテムに対してユーザが既に評価を行っていたら無視する
if( exists $userRatings->{$item2} ) { last; }
# 点数と類似度を掛けあわせたものの合計で重み付けする
$scores{$item2} += ($similarity * $rating);
# すべての類似度の合計
$totalSim{$item2} += $similarity;
}
}
}
# 類似度の合計で正規化
my %normScores = ();
foreach my $item (keys %scores) {
$normScores{$item} = $scores{$item} / $totalSim{$item};
}
# 降順に並べたランキングを返す
my @rankings = ();
foreach my $key (sort {$normScores{$b} <=> $normScores{$a}} keys %normScores) {
my $h = {
$key => $normScores{$key}
};
push(@rankings, $h);
}
return \@rankings;
}
# MovieLensのデータセットを読み込む関数
sub loadMovieLens {
my $data = "u.item";
my $data2 = "u.data";
# 映画のタイトルを得る
my %movies = ();
open(my $fh, "<", $data) or die "$!";
while(<$fh>) {
chomp;
my @fields = split /\|/, $_;
my $movieid = $fields[0];
my $title = $fields[1];
$movies{$movieid} = $title; # 最初がmovieidで次がタイトル
}
close $fh;
# ユーザ毎の映画への評価値を得る
my %prefs = ();
open($fh, "<", $data2) or die "$!";
while(<$fh>) {
chomp;
# user|movieid|rating|ts
my @fields = split /\s+/, $_;
my $user = $fields[0];
my $movieid = $fields[1];
my $rating = $fields[2];
$prefs{$user}{$movies{$movieid}} = $rating;
}
close $fh;
return \%prefs;
}
#
# 推薦を行うメイン
#
my $u = '87';
my $cnt = 30;
my $t1 = (times)[0];
my $prefs = loadMovieLens(); # データのロード
my $t2 = (times)[0];
my $load_time = $t2 - $t1;
$t1 = (times)[0];
my $urankings = getRecommendations($prefs, $u, \&sim_distance);
$t2 = (times)[0];
my $urank_time = $t2 - $t1;
print "User-based Recommendations:\n";
for(my $i=0; $i<$cnt; $i++) {
foreach my $item (keys %{ $urankings->[$i] }) {
print "\t" . $item . " " . $urankings->[$i]->{$item} . "\n";
}
}
$t1 = (times)[0];
my $itemSim = calculateSimilarItems($prefs, $cnt, \&sim_distance);
$t2 = (times)[0];
my $conv_time = $t2 - $t1;
$t1 = (times)[0];
my $irankings = getRecommendedItems($prefs, $itemSim, $u);
$t2 = (times)[0];
my $irank_time = $t2 - $t1;
print "Item-based Recommendations:\n";
for(my $i=0; $i<$cnt; $i++) {
foreach my $item (keys %{ $irankings->[$i] }) {
print "\t" . $item . " " . $irankings->[$i]->{$item} . "\n";
}
}
print "Processed time:\n";
print "\t" . "load time = " . $load_time . "\n";
print "\t" . "urank time = " . $urank_time . "\n";
print "\t" . "conv time = " . $conv_time . "\n";
print "\t" . "irank time = " . $irank_time . "\n";
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment