ACFUN上经常有一些考验暂停党的图集视频，内含各种哔哔和◯◯，但是对于反射弧比较长，暂停苦手的人们来说，只得反复折腾得肉牛满面。而我这种暂停四级考试完全不合格的人更是鸭梨很大。于是想到求助perl , imgseek mplayer 视频分帧 )，再用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
8 Comments »
专门针对某 验证码写了个识别脚本，当然不是光为识别验证码而识别的咯，至于拿来干什么“坏事”，再说吧。识别验证码也算挑战大自然了，当年百度复赛那道验证码识别就让无数人肉牛满面，所幸这需要识别的验证码只有数字，而且字迹工整，颜色统一，格式规范，背景简单。识别脚本利用基于ImageMagick 的Image::Magick 处理验证码，分离出每个数字的二值图像，然后利用基于ImgSeek 的Image::Seek 通过相似度比较识别验证码。
todigits是将验证码图像文件转换成每个数字的二值图像的函数。首先将验证码转为灰度图，再选择合适的阀值，将图像二值化。最后把每个数字裁剪出来并去掉白边。硬编码万岁！
# todigits.pl
use strict;
use Image::Magick;
sub todigits {
my ($n, $threshold, $w, $h, $x, $y) = /该信息已被绿坝屏蔽/;
my $filename = shift @_;
my @retval = ();
my $image = Image::Magick->new;
$image->Read($filename);
$image->Quantize(colorspace => 'gray');
$image->Threshold(threshold => $threshold, channel => 'All');
for (my $i = 0; $i < $n; ++$i) {
my $digit = $image->Clone();
$digit->Crop(width => $w, height => $h, x => $x + $i * $w, y => $y);
$digit->Trim();
push @retval, $digit;
}
return @retval;
}
1;
准备足够多的验证码，用脚本测试一下todigits，同时也生成了ImgSeek所需的所有数字的二值图像样本。
19 Comments »
Posted by watashi in work , tags: a+b , haskell , javascripy , plugin , ProjectEuler , SPOJ , syntax , SyntaxHighlighter , utility , wordpress
As I cannot find any appropriate haskell brushes for SyntaxHighlighter , I developed one by myself. You can download it here , I do hope it will be helpful. If you find any bugs or have any suggestions, please comment here or email me .
SyntaxHighlighter提供了大多流行语言的Brush，但是相对而言支持的语言还是比较少的。如果你需要的某种语言不幸不在支持列表内，那么你还可以求助于第三方Brush，这里 有一个更加丰富语言列表，不过不是所有的语言都有对应的Brush。更不幸的是，我需要的Haskell语言甚至都不在这个列表里。google了一下还是看到有别人写的Brush，不过功能实在有点弱，所以我开始按照Handy Custom Brushes Development Guide 自己写一个Haskell Brush。
在Guide的指导下，在参考着其他语言的Brush和其他平台下Haskell的高亮配置文件，我自己的shBrushHaskell.js也有模有样的完成了。最后要做的就是把它加到wordpress的plugin里，参照Adding A New Brush (Language) 便能很容易完成。事实上在在我使用的SyntaxHighlighter Evolved里只要先把shBrushHaskell.js上传到合适的位置，比如$plugin_dir/watashi-no-brushes，再对syntaxhighlighter.php做两处修改就好了：
在一堆wp_register_script中间插入一句
/* register my brush */
wp_register_script('syntaxhighlighter-brush-haskell', plugins_url('syntaxhighlighter/watashi-no-brushes/shBrushHaskell.js'), array('syntaxhighlighter-core'), '20091224'); // ADD_THIS_LINE
再添加映射
$this->brushes = (array) apply_filters( 'syntaxhighlighter_brushes', array(
/* ... */
'haskell' => 'haskell', // ADD_THIS_LINE
) );
大功告成。
首先拿A + B Problem做个测试：
main = do
input <- getContents
putStr $ unlines $ map show $ doEMP $ map read $ words input
doEMP [] = []
doEMP (a:b:o) = a + b : doEMP o
再加两个demo，第一个是ProjectEuler 的41：
3 Comments »
Entries (RSS)