Perl、515 + -2922 + 0 + -2571 = -4978
別のアプローチ。今回は、サイズ64xHのタイルに画像を保存しようとしています。これは仕様によると問題ありませんが、一部のソフトウェアでは最初のタイルまたはアニメーションのみが表示される場合があります。タイルは、より局所的な局所性のため、よりよく圧縮されます。私は2番目の画像に対しても通常の圧縮を行い、短くなったものを選択します。これにより画像が2回圧縮されるため、以前のソリューションと比較して2倍遅くなります。
#!perl -n0
sub r{$r.=1&"@_">>$_ for 0..log(@d|256)/log 2}
@k=/(\d+) (\d+)/;
@l=map{$$_||=(push(@t,split$"),++$i)}/\d+ \d+ \d+/g;
print+GIF89a,pack(vvCxxC768,@k,~8,@t);
sub v{($w,$h)=@_;for$k(0.."@k"/$w-1){
$k*=$w;$r='';@d=();@p=grep+($z++-$k)%"@k"<$w,@l;
$"=' ';$_="@p ";$"='|';while(/./){
r 256;%d=map{($_,$_-1)}@d=1..256;
$d{$&}=@d+2,r$d{$1},unshift@d,$&while@d<4095&&s/^(@d) (\d*)/$2/}
r 257;$_=pack"b*",$r;
$h.=pack"Cv4n(C/a)*",44,$k,0,$w,$k[1],8,/.{0,255}/gs
}$b=$h if!$b||length$b>length$h}
"@k"%64||v 64;v"@k";print"$b;"
Perl、354 + 12 + 0 + -1 = 365 418 9521 51168 56639
私のコードにいくつかのバグがあるか、わずかな変更がサイズを参照に正確に縮小したため、2番目のイメージが特定のエンコーダー用に最適化されています。画像ごとに約30〜60秒かかります。
ゴルフ版。
#!perl -n0
sub r{$r.=1&"@_">>$_ for 0..log(@d|256)/log 2}
@k=/(\d+) (\d+)/;
@p=map{$$_||=(push(@t,split$"),++$i)}/\d+ \d+ \d+/g;
$_="@p ";$"='|';while(/./){
r 256;%d=map{($_,$_-1)}@d=1..256;
$d{$&}=@d+2,r$d{$1},unshift@d,$&while@d<4095&&s/^(@d) (\d*)/$2/}
r 257;$_=pack"b*",$r;
print+GIF89a,pack(vvCxxC768,@k,~8,@t),
pack("Cx4vvn(C/a)*",44,@k,8,/.{0,255}/gs),';'
GIFコンプレッサーが行える唯一の決定は、LZW辞書をリセットするタイミングです。一般に、このタスクの画像がどのように選択されたかにより、そうするのに最適な瞬間は、辞書がオーバーフローする瞬間である各4096コードです。このような制限により、辞書がオーバーフローすることはなく、実装で数バイトを節約できます。詳細は次のとおりです。
#!perl -n0
# function to add one codeword to the output stream @r.
# the current codeword length is based on the dictionary size/
sub r{push@r,map"@_">>$_,0..log(@d|256)/log 2}
# get the dimensions into @k
@k=/(\d+) (\d+)/;
# get pixel indexes to @p and palette to @t
@p=map{$$_||=(push(@t,split$"),++$i)}/\d+ \d+ \d+/g;
# convert index table into space separated string
$_="@p ";$"='|';
# LZW encoder; while something to encode
while(/\S/){
# output reset code
r 256;
# reset code dictionary $d is the last code number,
# %d is the map of codes and @d list of codes
$d=257;%d=map{($_,$_-1)}@d=1..256;
# find codes using regexp, stop at dictionary overflow
while($d<4096&&s/^(@d) (\d*)/$2/){
unshift@d,$&;$d{$&}=++$d;r$d{$1}}}
# end LZW encoder; output end code
r 257;
# convert bit string @r to bytes $f
vec($f,$j++,1)=$_ for@r;
# output header up to the color table
print+GIF89a,pack(vvCvC768,@k,~8,0,@t),
# output rest of the header
pack(Cv4CC,44,0,0,@k,0,8),
# output the LZW compressed data $f slicing into sub-blocks
$f=~s/.{0,255}/chr(length$&).$&/egsr,';'
Perl、394 + -8 + 0 + -12 = 374
リセットポイントを推測するヒューリスティックを追加すると、圧縮が少し向上しますが、追加のコードを正当化するには不十分です。
#!perl -n0
sub r{$r.=1&"@_">>$_ for 0..log(@d|256)/log 2}
@k=/(\d+) (\d+)/;
@p=map{$$_||=(push(@t,split$"),++$i)}/\d+ \d+ \d+/g;
$_="@p ";$"='|';while(/./){
r 256;%d=map{($_,$_-1)}@d=1..256;
$d{$&}=@d+2,r$d{$1},unshift@d,$&while
(@d<4001||(/((@d) ){11}/,$&=~y/ //>12))&@d<4095&&s/^(@d) (\d*)/$2/}
r 257;$_=pack"b*",$r;
print+GIF89a,pack(vvCxxC768,@k,~8,@t),
pack("Cx4vvn(C/a)*",44,@k,8,/.{0,255}/gs),';'