ACFUN上经常有一些考验暂停党的图集视频,内含各种哔哔和◯◯,但是对于反射弧比较长,暂停苦手的人们来说,只得反复折腾得肉牛满面。而我这种暂停四级考试完全不合格的人更是鸭梨很大。于是想到求助perl, imgseek和mplayer,把视频中的所有图片提取出来。思路很简单,就是首先用mplayer将视频内容转为一帧一帧的png或jpg图片(视频分帧),再用Image::Seek来通过图片内容的相似度比较去除重复图片。写了一段简单的perl代码(wapauser.pl):
#!/usr/bin/perl use strict; use constant SCORE => -30; use File::Temp qw(tempfile tempdir); use Image::Imlib2; use Image::Seek qw(loaddb cleardb add_image query_id remove_id); use POSIX ':sys_wait_h'; our ($id, $db, $dir); sub init { $id = 0; $dir = tempdir('wapauserXXXX', CLEANUP => 1, DIR => '.'); $db = tempfile('wapauserXXXX', DIE => $dir, SUFFIX => 'db'); loaddb($db); cleardb(); } sub gao { my $file = shift; my $img = Image::Imlib2->load($file); add_image($img, $id); my @result = query_id($id, 2); if (!$id || $result[1]->[1] > SCORE) { ++$id; link $file, sprintf './output/%04d.png', $id; # or `cp` } else { remove_id($id); # important } } sub wapauser { my ($file, @args) = @_; init(); if (my $pid = fork) { wait; opendir(my $dh, $dir); my @pngs = grep {/\.png/} readdir($dh); closedir($dh); for my $png (sort @pngs) { gao("$dir/$png"); } } else { chomp(my $path = `which mplayer`); unshift @args, '-vo', "png:outdir=$dir", '-nosound'; print STDERR "path = $path\nfile = $file\n", join(" ", @args), "\n"; close STDOUT; close STDERR; exec $path, $file, @args; } } wapauser(@ARGV);
拿某个长度4min的flv视频测试了一下,第一步和第二部分别花了4min的时间,最后从6000多帧中提取了70多张不同的图片。实验表明,SCORE的阀值大概取到-25~-30比较合适,具体的值还是要反复尝试。大多数相同的图结果都在-35以上,但也有可能只有-31。不同的图通常区别都在-15以内,但是只有一些小区别的几张图(你们懂的)之间的区别可能有负的二十多。总的来说还有以下问题:
- 视频分帧结束后才开始图片去重,实际上两步可以同时进行,分步的结果就是得先消耗很大的临时空间来存储成千上万帧的图片,上面的测试就吃掉了4G的硬盘;
- 生成的图片是非常大png,这也是为什么会吃掉那么多磁盘的原因,当然这可以通过设置参数z=<0-9>改成压缩较高的png,或者用参数-vo jpeg,并设置参数quality=<0-100>改成较小的jpg;
- 这种方法只能处理完全静态的图集视频,对其它视频要么无能为力,要么作用很有限;
- 生成的图片质量取决的视频质量,所有除非是高清视频,否则图片质量不会太好;
- SCORE阀值的设置……凡是涉及到阀值的问题总是很头疼的,稍微高点低点,效果可能就差很多,这就像调试蓝田的热水一般(典故见附件)。
附件:我刚进浙大不久时的一篇文章《走进浙大—揭开蓝田浴室之谜》,想起来当时我们一看见校医院的救护车从蓝田方向开来就会说“又有人洗澡被烫伤了”……
发信人: botanyh (botany), 信区: Joke
标 题: 走进浙大—揭开蓝田浴室之谜ZZ
发信站: 缥缈水云间 (Mon Oct 30 11:33:02 2006), 站内