YouTube Schene Thumbnailer (Perl & R)

youtube.pl

# YouTubeの動画のダイジェスト画像集を自動的に作成
use GD;
use WWW::YouTube::Download;
use FFmpeg::Thumbnail;
use Statistics::R;

sub p { print STDERR $_[0]; }

my $video_id=shift or die "Usage: $0 video_id [ouput_dir] [skip] [threashold]";
my $out_dir=shift or $out_dir='.';
$out_dir=$` if (m|/$|);

goto R if (shift);

my $client = WWW::YouTube::Download->new;

p("downloading from youtube...");

$client->download($video_id);
my $title = $client->get_title($video_id);     # maybe encoded utf8 string.

p("OK. \ntitle=$title\n");
p("capturing image from video\n");

my $rate=4;

my $foo=FFmpeg::Thumbnail->new({video=>"$video_id.flv"});
my $len=$foo->duration;
my $n_img=$len*$rate;

my @files;
for (my $i=1; $i<=$n_img; $i++) {
    my $c=$i/$rate;
    p(" $c\t/ $len [sec]\n");
    my $file=sprintf('cut%d.png',$i);
    $foo->create_thumbnail($c,$file);
    push @files,$file;
}

p("OK. capturing complete.\n");
p("calculating color entropy..\n");

open(F,">$video_id.dat");
my $counter=0;
foreach my $file (@files) {
    open(F1,">$file.hist");
    my $im=new GD::Image($file);
    my ($w,$h)=$im->getBounds();
    my %colors;
    foreach my $y (1..$h) {
	foreach my $x (1..$w) {
	    my $index=$im->getPixel($x,$y);
	    my @rgb=$im->rgb($index);
	    $colors{join('.',@rgb)}++;
	}
    }
    my $size=$w*$h;
    my $entropy;
    while (my ($rgb,$num)=each(%colors)) {
	print F1 "$rgb $num\n";
	my $p=$colors{$rgb}/$size;
	$entropy-=$p*log($p);
    }
    p("$file = $entropy\n");

    my $score=$n_img*$entropy/exp(1);
    $counter++;
    print F "$counter $entropy\n";
    close(F1);
}
close(F);
p("OK.\n");


R:;

my $threashold=shift;
$threashold=0.5 unless($threashold);

p("analyzing clusters..\n");
my $R=Statistics::R->new();

$R->startR();

my $vec='c('.join(',',@es).')';
$R->send('library(bcp)');
$R->send("df<-read.table('$video_id.dat')");
$R->send('p<-bcp(df$V2)');
$R->send('which(p$posterior.prob>'."$threashold)");
my @items=split(/\s+/,$R->read());
$R->stopR();

shift @items;

my $params=join(' ',map {"cut$_.png"} @items);
system("zip $out_dir/cut$$.zip $params");

print "output ==> $out_dir/cut$$.zip\n";