Переписать Perl скрипт на PHP

NeoXidizer · June 22, 2012

практикуюсь в портировании standalone приложений в веб сервисы, имеется следующий perl скрипт:

#!/usr/bin/perl -ws
# jpegrescan by Loren Merritt
# Last updated: 2008-11-29 / 2011-11-01
# This code is public domain.

use File::Slurp;
@ARGV==2 or die "usage: jpegrescan in.jpg out.jpg\ntries various progressive scan orders\n";
$fin = $ARGV[0];
$fout = $ARGV[1];
$ftmp = "$fout-$$.scan";
$jtmp = $fout;
$verbose = $v;
$quiet = $q;
undef $_ for $v,$q;
undef $/;
$|=1;

# convert the input to baseline, just to make all the other conversions faster
# FIXME there's still a bunch of redundant computation in separate calls to jpegtran
open $OLDERR, ">&", STDERR;
open STDERR, ">", $ftmp;
open TRAN, "-|", "./jpegtran", "-v", "-optimize", $fin or die;
write_file($jtmp, <TRAN>);
close TRAN;
open STDERR, ">&", $OLDERR;

$type = read_file($ftmp);
$type =~ /components=(\d+)/ or die;
$rgb = $1==3 ? 1 : $1==1 ? 0 : die "not RGB nor gray\n";

# FIXME optimize order for either progressive transfer or decoding speed
sub canonize {
    my $txt = $prefix.$suffix.shift;
    $txt =~ s/\s*;\s*/;\n/g;
    $txt =~ s/^\s*//;
    $txt =~ s/ +/ /g;
    $txt =~ s/: (\d+) (\d+)/sprintf ": %2d %2d", $1, $2/ge;
    # treat u and v identically. I shouldn't need to do this, but with jpegtran overhead it saves 9% speed. cost: .008% bitrate.
    $txt =~ s/^2:.*\n//gm;
    $txt =~ s/^1:(.+)\n/1:$1\n2:$1\n/gm;
    # dc before ac, coarse before fine
    my @txt = sort {"$a\n$b" =~ /: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/ or die; !$3 <=> !$1 or $4 <=> $2 or $a cmp $b;} split /\n/, $txt;
    return join "\n", @txt;
}

sub try {
    my $txt = canonize(shift);
    return $memo{$txt} if $memo{$txt};
    write_file($ftmp, $txt);
    open TRAN, "-|", "./jpegtran", "-scans", $ftmp, $jtmp or die;
    $data = <TRAN>;
    close TRAN;
    my $s = length $data;
    $s or die;
    $memo{$txt} = $s;
    !$quiet && print $verbose ? "$txt\n$s\n\n" : ".";
    return $s;
}

sub triesn {
    my($bmode, $bsize);
    my ($limit, @modes) = @_;
    my $overshoot = 0;
    for(@modes) {
        my $s = try($_);
        if(!$bsize || $s < $bsize) {
            $bsize = $s;
            $bmode = $_;
            $overshoot = 0;
        } elsif(++$overshoot >= $limit) {
            last;
        }
    }
    return $bmode;
}

sub tries { triesn(99, @_); }

$prefix = "";
$suffix = "";

if($rgb) {
    # 012 helps very little
    # 0/12 and 0/1/2 are pretty evenly matched in frequency, but 0/12 wins in total size if every image had to use the same mode
    # dc refinement passes never help
    $dc = tries("0: 0 0 0 0; 1 2: 0 0 0 0;",
                "0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");
    # jpegtran won't let me omit dc entirely, but I can at least quantize it away to make the rest of the tests faster.
    $prefix = "0 1 2: 0 0 0 9;";
} else {
    $dc = "0: 0 0 0 0;";
    $prefix = "0: 0 0 0 9;";
}

# luma can make use of up to 3 refinement passes.
# chroma can make use of up to 2 refinement passes.
# refinement passes have some chance of being split (luma: 4%,4%,4%. chroma: 20%,8%) but the total bit gain is negligible.
# msb pass should almost always be split (luma: 87%, chroma: 81%).
# I have no theoretical reason for this list of split positions, they're just the most common in practice.
# splitting into 3 ections is often slightly better, but the total number of bits saved is negligible.
# FIXME: penalize lots of refinement passes because it's slower to decode. if so, then also force overwrite if bigger than the input.
sub try_splits {
    my $str = shift;
    my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18;
    my $mode = triesn(2, "$c: 1 63 $str;", @n{2,8,5});
    return $mode if $mode ne $n{8};
    return triesn(1, $mode, @n{12,18});
}

foreach $c (0..$rgb) {
    my @modes;
    my $ml = "";
    for(0..($c?2:3)) {
        push @modes, "$c: 1 8 0 $_; $c: 9 63 0 $_;".$ml;
        $ml .= sprintf("$c: 1 63 %d %d;", $_+1, $_);
    }
    my $refine = triesn(1, @modes);
    $refine =~ s/.* (0 \d);//;
    $ac .= $refine . try_splits($1);
}

$prefix = "";
undef %memo;
$mode = canonize($dc.$ac);
try($mode);
$size = $memo{$mode};
!$quiet && print "\n$mode\n$size\n";
$old_size = -s $fin;
if($size < $old_size) {
	write_file($fout, $data);
}
unlink $ftmp;

за незнанием синтаксиса Perl'а, прошу помочь составить алгоритм, которому следует данный скрипт, если этот скрипт вообще возможно повторить на PHP

Вкратце - скрипт принимает в качестве входных аргументов [путь_к_программе] [входной_jpeg_файл] [выходной_файл] и ищет оптимальный способ оптимизации (параметров для запуска программы из аргумента[0]

Лишний код, типа перенаправление потоков STDERR (и других) можно пропускать

либо помочь сделать так, чтобы вывод не блокировался, и был виден весь прогресс работы

Мой набросок:

Объявление переменных

#Комментарий - конвертирование файла в baseline, чтобы ускорить все остальные конвертации
jpegtran -v -optimize $file

объявление $type, не знаю, что это, скорее всего определения формата - baseline или progressive
объявление $rgb - цветового пространства (color space), проверяет, является ли формат файла RGB, либо BW, CMYK не пропускает

#FIXME
sub canonize, месиво из регулярок(help)
sub try, запуск jpegtran с параметром -scans file
sub triesn, не понять
sub tries { triesn(99, @_); } - ?

if($rgb) {
какая-то магия, очевидно запуск функции tries с заданными параметрами
$dc = tries("0: 0 0 0 0; 1 2: 0 0 0 0;",
                "0: 0 0 0 0; 1: 0 0 0 0; 2: 0 0 0 0;");
} else не интересует

# комментарий
# с упоминанием
# о дальнейшей работе с битами
не понятный мне код

Предпологаю, что поняв смысл всего этого месева из работы с битами и регулярками, можно написать легкий код на PHP (благо есть встроенные функции для вычисления color space, mode, etc

сильно может помочь это http://www.cs.wcupa.edu/~rkline/perl2php/

либо, если кто-то найдет онлайн трянслятор, буду благодарен, даже если будет на половину не рабочим

MiksIr · June 22, 2012

Регулярки фактически должны 1 в 1 работать в preg_match/preg_replace

// или m// - это match, возвращает в скалярном контексте число совпадений

s/a/b/ - это preg_replace('/a/', 'b') результат не возвращает, а меняет переменную,

Модификатор g - это "заменять все" т.е. нативное поведеление preg_replace

т.е. $txt =~ s/a/b/g; - это $txt = preg_replace('/a/', 'b', $txt);

К переменным регулярки применяется через =~

Т.е. $txt =~ /\s/ - ищет регулярку по $txt, а вот $txt = /\s/ - ищет регулярку по дефолтной переменной и возвращает результат в $txt - можно записать иначе как $txt = ($_ =~ /\s/);

Ну и $1 $2 $3 и т.д. - это скобочки в последней выполненной регулярке, т.е. аналог параметра $matches

sort работает аналогично php sort - внутри {} callback функция где $a и $b - пара

В перле есть такая штука - дефолтная переменная $_ (и дефолтный массив @_), если что-то типа цикла по массиву не указывает куда класть каждый элемент - кладем в $_

т.е. for(@modes) проходит по элементам массива и каждый из них в $_

Внутри функции @_ - это массив параметров

Например, my ($limit, @modes) = @_; - в $limit первый параметр, в @modes - все остальное, ибо массив

Ну соответственно sub tries { triesn(99, @_); } - это вывзов triesn куда передаются параметры вызова tries

Например, $var = shift; - shift это аналог array_shift, но так как параметра нет - используем дефольный @_, а так как мы внутри функции - это параметры функции, т.е. в $var - первый параметр функции

Про эту строчку my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18;

map - это аналог array_map, возвращает новый массив

в данном случае делает это в виде ассоциативного массива (в перле называется "хеш"), о чем так же говорит %n

Т.е. в %n будет хеш вида

2 => строка

5 => строка

и т.д.

Да, в перле, в отличии от пхп, все переменные глобальные если не сказано, что они локальные (my). Т.е. там ниже есть цикл с определениием $c и вызовом функции, где это $c используется напрямую.

К слову, локальность переменных можно определять не только внутри функции, но внутри любого блока (циклы, например)

Вроде все... будут вопросы - спрашивай =)

Edited June 22, 2012 by MiksIr

NeoXidizer · June 23, 2012

спасибо, потихоньку продвигаюсь, насколько работа sprintf в перле соотвествует sprintf в PHP?

и что означает

$|=1;

в самом начале?

Edited June 23, 2012 by NeoXidizer

MiksIr · June 23, 2012

sprintf должен быть такой же, у них корни одни - из Сишного sprintf

$| = 1 - это отключение буферизации вывода, насколько я помню

NeoXidizer · June 23, 2012

sub canonize {
    my $txt = $prefix.$suffix.shift;
    print "\n prefix - $prefix \n suffix - $suffix \n";
}
sub try {
    my $txt = canonize(shift);
}
sub triesn {
    ...
    for(@modes) {
        my $s = try($_);
    ...
}
my $refine = triesn(1, @modes);

строка: my $txt = $prefix.$suffix.shift;

почему shift применяется два раза?, еще в строке у my $txt = canonize(shift);

Edited June 23, 2012 by NeoXidizer

MiksIr · June 23, 2012

shift возвращает первый элемент массива и удаляет его (сдвигает массив). Так как параметр не указан, массив берется @_, т.е. параметры функции (той функции, внутри которой был вызов)

sub test2 {

my $second_param_of_test_function = shift;

}

sub test {

my $first_param = shift;

test2(shift); # равно my $second_param = shift; test2($second_param);

}

test($first, $second);

NeoXidizer · June 24, 2012

да, с этим разобрался

еще вопрос:

Perl

	print "————————————-";
	my @txt = split /\n/, $txt;
	#print "\nВХОД: $txt ///\n";
	my @txt = sort {
		print "\n a - $a\nb - $b\n";
		"$a\n$b" =~ /: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/ or die;
		!$3 <=> !$1 or $4 <=> $2 or $a cmp $b;
	} @txt;
	print "————————————-";

PHP:

		function cmp($a, $ {
			if ($a == $
				return 0;
			return ($a < $ ? -1 : 1;
		}

		$txt = explode("\n", trim($txt));
		usort($txt, function($a, $ {
					preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die("a - $a, b - $b");
					print "a - " . $a . "\n";
					print "b - " . $b . "\n";
					return cmp(!$matches[3], !$matches[1]) || cmp($matches[4], $matches[2]) || strcmp($a, $;
				}
		);
		print_r($txt);

на вход в сортировку идет: (проверял как в PHP, так и в Perl)

0: 0 0 0 9;

0: 1 8 0 0;

0: 9 63 0 0;

Вывод в Perl:

————————————
a - 0:  0  0 0 9;
b - 0:  1  8 0 0;

a - 0:  0  0 0 9;
b - 0:  9 63 0 0;

a - 0:  9 63 0 0;
b - 0:  1  8 0 0;
————————————-

вывод в PHP:

a - 0:  1  8 0 0;
b - 0:  0  0 0 9;
a - 0:  9 63 0 0;
b - 0:  1  8 0 0;

———————————— добавил для достоверности, что сортировка запускается лишь раз, а не в процессе цикла

почему в perl скрипте $a и $b - больше значений? разные алгоритмы сортировки?

и правильно ли я написал return у function c?

вроде все работает, спрашиваю для саморазвития

Edited June 24, 2012 by NeoXidizer

MiksIr · June 24, 2012

Да вроде верно.

В PHP http://en.wikipedia.org/wiki/Quicksort (по данным www.php.net/sort)

В Perl

Perl 5.6 and earlier used a quicksort algorithm to implement sort. That algorithm was not stable, so could go quadratic. (A stable sort preserves the input order of elements that compare equal. Although quicksort's run time is O(NlogN) when averaged over all arrays of length N, the time can be O(N**2), quadratic behavior, for some inputs.) In 5.7, the quicksort implementation was replaced with a stable mergesort algorithm whose worst-case behavior is O(NlogN). But benchmarks indicated that for some inputs, on some platforms, the original quicksort was faster. 5.8 has a sort pragma for limited control of the sort.

NeoXidizer · June 24, 2012

for(@modes), аналог в PHP - foreach? или ($i = 0, $count = count($modes); $i < $count; ++$i)

Edited June 24, 2012 by NeoXidizer

NeoXidizer · June 24, 2012

дурная регулярка, то работает, то нет...

добавьте кнопку "удалить сообщение" >__<

Edited June 24, 2012 by NeoXidizer

MiksIr · June 24, 2012

В перле for и foreach синонимы и работают в зависимости от параметров. В данном случае аналог PHP-ного foreach. Перл "выдумывает" только $_ (ну и @_), больше переменных никаких он не выдумывает (т.е. $i неоткуда взяться).

NeoXidizer · June 24, 2012

похоже, скрипт не работает из-за алгоритма сортировки. Perl:

	print "BEFORE:\n$txt<<<\n\n";
   my @txt = sort {
	"$a\n$b" =~ /: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/ or die;
	print "a = $a and b = $b\n";
	$test = !$3 <=> !$1;
	print "returns $test\n";
	print "0 - $0\n";
	print "1 - $1\n";
	print "2 - $2\n";
	print "3 - $3\n";
	print "4 - $4\n";
	!$3 <=> !$1 or $4 <=> $2 or $a cmp $b; } split /\n/, $txt;

	$txt = join "\n", @txt;
	print "||||||||\n\n\n\n\n";

PHP:

function cmp($a, $ {
	if ($a == $
		return 0;
	return ($a < $ ? -1 : 1;
}
print "BEFORE:\n$txt<<<\n\n";
$txt = explode("\n", trim($txt));
usort($txt, function($a, $ {
		$str = $a."\n".$b;
		preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", $str, $matches) or die();
		print "a = $a and b = $b\n";
		$test = cmp(!$matches[3], !$matches[1]);
		print "returns $test\n";
		print "0 - $matches[0]\n";
		print "1 - $matches[1]\n";
		print "2 - $matches[2]\n";
		print "3 - $matches[3]\n";
		print "4 - $matches[4]4\n";
		return cmp(!$matches[3], !$matches[1]) || ($matches[4], $matches[2]) || ($a, $;
	}
);
$txt = join("\n", $txt);
print "||||||||\n\n\n\n\n";

вывод скриптов таков: Perl:

BEFORE:
0:  0  0 0 9;
0:  1  8 0 0;
0:  9 63 0 0;
 <<<

a = 0:  0  0 0 9; and b = 0:  1  8 0 0;
returns -1
0 - jpegrescan.pl
1 - 0
2 - 9
3 - 1
4 - 0
a = 0:  0  0 0 9; and b = 0:  9 63 0 0;
returns -1
0 - jpegrescan.pl
1 - 0
2 - 9
3 - 9
4 - 0
a = 0:  9 63 0 0; and b = 0:  1  8 0 0;
returns 0
0 - jpegrescan.pl
1 - 9
2 - 0
3 - 1
4 - 0
||||||||

PHP:

BEFORE:
0:  0  0 0 9;
0:  1  8 0 0;
0:  9 63 0 0;
<<<

a = 0:  1  8 0 0; and b = 0:  0  0 0 9;
returns 1
0 >>:  1  8 0 0;
0:  0  0 0 9;<<
1 - 1
2 - 0
3 - 0
4 - 94
a = 0:  9 63 0 0; and b = 0:  1  8 0 0;
returns 0
0 >>:  9 63 0 0;
0:  1  8 0 0;<<
1 - 9
2 - 0
3 - 1
4 - 04
||||||||

Краткое заключение:

1. Input одинаков (регулярки работают).

2. $a и $b не соотвествуют друг-другу (они поменялись между собой местами в PHP по сравнению с Perl'ом)

3. Алгоритм сортировки у Perl совершает большей итераций, чем PHP (особенно видно при других входных значениях)

4. Совпадения у preg_match сильно отличаются от тех, что выходят в Perl, поэтому в return идут не те значения.

5. Данный Input после сортировки каким-то образом остается таким же, каким был в оригинале, а в Perl'е с ним тоже ничего не происходит, поэтому изначально я не замечал ошибку, тестировав на одном входящем значении.

Но когда я начал тестировать дальше, подав на input другую строку, то вышло следующее, в PHP строка

0: 0 0 0 9;
0: 1 8 0 1;
0: 9 63 0 1;
0: 1 63 1 0;

превращается в

0:  9 63 0 1;
0:  0  0 0 9;
0:  1  8 0 1;
0:  1 63 1 0;

а в Perlе:

0:  0  0 0 9;
0:  1  8 0 1;
0:  9 63 0 1;
0:  1 63 1 0;

проще для сравнения:

0: 0 0 0 9; 0: 1 8 0 1; 0: 9 63 0 1; 0: 1 63 1 0; // оригинал
0: 9 63 0 1; 0: 0 0 0 9; 0: 1 8 0 1; 0: 1 63 1 0; // PHP
0: 0 0 0 9; 0: 1 8 0 1; 0: 9 63 0 1; 0: 1 63 1 0; //Perl

дело в том, что сортировка применяется в 3 случаях из 12, либо в 12 случаях из 23 (в зависимости от типа изображения, которое я подаю на съедение программе)

а из-за того, что в PHP сортировка не работает, не работает весь скрипт..

Какие-нибудь идеи?

вот пример работы сортировки через перл:

||OLD|| 0:  0  0 0 9; 0:  1  8 0 2; 0:  9 63 0 2; 0:  1 63 1 0; 0:  1 63 2 1; ||OLD||
||NEW|| 0:  0  0 0 9; 0:  1  8 0 2; 0:  9 63 0 2; 0:  1 63 2 1; 0:  1 63 1 0; ||NEW||

||OLD|| 0:  0  0 0 9; 0:  1  8 0 3; 0:  9 63 0 3; 0:  1 63 1 0; 0:  1 63 2 1; 0:  1 63 3 2; ||OLD||
||NEW|| 0:  0  0 0 9; 0:  1  8 0 3; 0:  9 63 0 3; 0:  1 63 3 2; 0:  1 63 2 1; 0:  1 63 1 0; ||NEW||

||OLD|| 0:  0  0 0 0; 0:  1 63 1 0; 0:  1 63 2 1; 0:  1 63 3 2; 0:  1  8 0 3; 0:  9 63 0 3; ||OLD||
||NEW|| 0:  0  0 0 0; 0:  1  8 0 3; 0:  9 63 0 3; 0:  1 63 3 2; 0:  1 63 2 1; 0:  1 63 1 0; ||NEW||

хотя сомневаюсь, что кто-то здесь поможет, всем будет лень читать весь этот код, а уж темболее думать над сортировкой

Edited June 24, 2012 by NeoXidizer

NeoXidizer · June 24, 2012

хотя на самом деле легко

нужно просто разобраться с регуляркой "/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/"

MiksIr · June 24, 2012

Скажи, а ты там не напутал с регистром $b переменной? В PHP переменные регистрозависимые и $B и $b - разные переменные.

NeoXidizer · June 24, 2012

Скажи, а ты там не напутал с регистром $b переменной? В PHP переменные регистрозависимые и $B и $b - разные переменные.

я увидел с самого начала и перепроверил, все верно

		$txt = explode("\n", trim($txt));
		usort($txt, function($a, $ {
					preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die();
					return self::cmp(!$matches[3], !$matches[1]) || self::cmp($matches[4], $matches[2]) || strcmp($b, $a);
				}
		);

MiksIr · June 24, 2012

usort($txt, function($a, $ { - вот здесь заглавная почему?

В PHP используются те две переменные, которые как параметры функции указаны. Т.е. $a и $B. А дальше при сравнении используется $b маленькая "$a\n$b"

Edited June 24, 2012 by MiksIr

NeoXidizer · June 24, 2012

честное слово, форум сам заменяет

http://savepic.su/2166257.png

MiksIr · June 24, 2012

Щас убегаю, проверять некогда, но мне кажется, проблема в логических операциях.

В перле они возвращают значение, а PHP - булевое. Т.е. в перле -1 || 1 вернет -1 (первый операнд - правда, его и возвращаем, второй вообще не трогаем), 0 || -1 вернет -1 (первый - false, возвращаем второй).

На этом, кстати, там очень удобные назначения дефолтных значений основаны, типа

$var = $var || 'default var';

В PHP же это дает булевы true (т.е. 1).

Из-за этого сортировка путается.

NeoXidizer · June 24, 2012

<?php
// Входной массив
$txt = "0:  0  0 0 9;\n0:  1  8 0 0;\n0:  9 63 0 0;\n0:  1 63 1 0;\n";
$old_txt = $txt;
echo 'Input:<br>';
print($txt);echo'<br>';

$txt = explode("\n", trim($txt));
echo 'После explode:<br>';
print_r($txt);echo'<br>';echo'<br>';


function cmp($a, $ {
	if ($a == $
		return 0;
	return ($a < $ ? -1 : 1;
}
usort($txt, function($a, $ {
		preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die('died');
		echo "<br> a = $a<br>b = $b<br>";
		$return = (int) ( (int)cmp(!$matches[3], !$matches[1]) || (int)cmp($matches[4], $matches[2]) || (int)strcmp($b, $a) );
		echo "sorting returns: $return <br>";
		return (int) ( (int)cmp(!$matches[3], !$matches[1]) || (int)cmp($matches[4], $matches[2]) || (int)strcmp($b, $a) );
	}
);


echo '<br><br>Output<br>';
print_r($txt);echo'<br>';

$txt = join("\n", $txt);
echo 'После implode:<br>';
echo $txt.'<br><br>';

// Сравнение
echo 'Сравнение:<br>';
echo $txt.'<br>';
echo $old_txt.'<br>';

запуск в браузере:

Input:
0: 0 0 0 9; 0: 1 8 0 0; 0: 9 63 0 0; 0: 1 63 1 0; 
После explode:
Array ( [0] => 0: 0 0 0 9; [1] => 0: 1 8 0 0; [2] => 0: 9 63 0 0; [3] => 0: 1 63 1 0; ) 


a = 0: 1 8 0 0;
b = 0: 0 0 0 9;
sorting returns: 1 

a = 0: 1 8 0 0;
b = 0: 9 63 0 0;
sorting returns: 1 

a = 0: 1 63 1 0;
b = 0: 1 8 0 0;
sorting returns: 1 

a = 0: 0 0 0 9;
b = 0: 9 63 0 0;
sorting returns: 1 


Output
Array ( [0] => 0: 9 63 0 0; [1] => 0: 0 0 0 9; [2] => 0: 1 8 0 0; [3] => 0: 1 63 1 0; ) 
После implode:
0: 9 63 0 0; 0: 0 0 0 9; 0: 1 8 0 0; 0: 1 63 1 0;

Сравнение:
0: 9 63 0 0; 0: 0 0 0 9; 0: 1 8 0 0; 0: 1 63 1 0;
0: 0 0 0 9; 0: 1 8 0 0; 0: 9 63 0 0; 0: 1 63 1 0;

не думаю, что usort путается темболее echo gettype(cmp(!$matches[3], !$matches[1])); отдает integer

если делать вручную

usort($txt, function($a, $ {
		preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die('died');
		return 0; // или 1
	}
);

конечный результат все равно искажается (сортируется), скорее потому что в перле return зависит от результата сравнений

если вывести все $matches:

usort($txt, function($b, $a) {
		preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die('died');
		echo "<br> a = $a<br>b = $b<br>";
		$return = (int) ( (int)cmp(!$matches[3], !$matches[1]) || (int)cmp($matches[4], $matches[2]) || (int)strcmp($b, $a) );
		echo '<br>0 - <b>'.$matches[0].'</b>';
		echo '<br>1 - <b>'.$matches[1].'</b>';
		echo '<br>2 - <b>'.$matches[2].'</b>';
		echo '<br>3 - <b>'.$matches[3].'</b>';
		echo '<br>4 - <b>'.$matches[4].'</b>';
		echo "<br>sorting returns: $return<br>";
		return $return;
	}
);

то будет такой вывод:

a = 0: 0 0 0 9;
b = 0: 1 8 0 0;

0 - : 0 0 0 9; 0: 1 8 0 0;
1 - 0
2 - 9
3 - 1
4 - 0
sorting returns: 1

a = 0: 1 8 0 0;
b = 0: 1 63 1 0;

0 - : 1 8 0 0; 0: 1 63 1 0;
1 - 1
2 - 0
3 - 1
4 - 0
sorting returns: 1

a = 0: 1 8 0 0;
b = 0: 9 63 0 0;

0 - : 1 8 0 0; 0: 9 63 0 0;
1 - 1
2 - 0
3 - 9
4 - 0
sorting returns: 1

a = 0: 9 63 0 0;
b = 0: 1 63 1 0;

0 - : 9 63 0 0; 0: 1 63 1 0;
1 - 9
2 - 0
3 - 1
4 - 0
sorting returns: 1

напоминаю результаты регулярки по перлу:

returns -1
1 - 0
2 - 9
3 - 1
4 - 0
returns -1
1 - 0
2 - 9
3 - 9
4 - 0
returns 0
1 - 9
2 - 0
3 - 1
4 - 0

результаты регулярки сходятся только на первой итерации и на последней, да и всего у php получается 4 итерации, а не 3

Edited June 24, 2012 by NeoXidizer

MiksIr · June 24, 2012

Дело не в том, что булево нужно конвертнуть в int.

В каждой итерации сорта должно быть 1 или 0 или -1.

return -1 || 0 || 0 даст в перле -1, а в php - true или (int)true = 1

Нужно переписывать как-то так:


return ($ret = self::cmp(!$matches[3], !$matches[1])) ? 
          $ret :
          ( ($ret = self::cmp($matches[4], $matches[2])) ?
                $ret :
                strcmp($b, $a)
          );

NeoXidizer · June 25, 2012

получилось, спасибо большое

Edited June 25, 2012 by NeoXidizer

NeoXidizer · June 25, 2012

и честно говоря, не понимаю записи

return ($ret = self::cmp(!$matches[3], !$matches[1])) ? 
          $ret :
          ( ($ret = self::cmp($matches[4], $matches[2])) ?
                $ret :
                strcmp($b, $a)
          );

непонимание начинается со второй строки

а так же:

$refine =~ s/.* (0 \d);//;

здесь выполняется preg_match (судя по обращению к найденному в следующей строчке) и preg_replace одновременно. Возможно ли в php такое? Выполнить preg_replace и обратится к тому, что было найдено, не используя preg_match и preg_replace поочереди

и вообще, как определить, что =~ выполняет? Ведь может производиться как и просто поиск по шаблону, так и замена, правильно ли я понял? или всегда и поиск и замена?

если второе, то это

preg_match("/: *(\d+) .* (\d);\n.*: *(\d+) .* (\d);/", "$a\n$b", $matches) or die('AAA');

не совсем совпадает с тем, что делает perl

Edited June 25, 2012 by NeoXidizer

MiksIr · June 25, 2012

> непонимание начинается со второй строки

Да ладно? Это простые тенарные операторы $var = $a ? $b : c, просто вложенные друг в друга. А если ты про $ret - то мы туда присваиваем вызов функции, и если он true - это значение и возвращаем. Можно записать так


if ($ret = self::cmp(!$matches[3], !$matches[1])) {
  return $ret;
} else {
   if ($ret = self::cmp($matches[4], $matches[2])) {
      return $ret;
   } else {
      return strcmp($b, $a);
   }
}

> здесь выполняется preg_match (судя по обращению к найденному в следующей строчке) и preg_replace одновременно

Да, в perl-е при replace операции скобки все-равно попадают в $1 ...

В PHP видимо это нужно в 2 операции делать, сначала preg_match, что бы получить $matches, а потом preg_replace

> и вообще, как определить, что =~ выполняет?

Так я это писал в первом сообщении. Буква перед патерном. s - замена, m или пусто - поиск

s/// - замена, m// или просто // - поиск. Разделителями, как и в пхп, может быть что угодно, т.е. s### и m## тоже работает (но m тут уже обязательно)

NeoXidizer · June 25, 2012

я понимаю, что это тернарные операции, просто не встречался со вложенностью, немного запутало

с примером разобрался вроде как, проверка:

if ($a == $
	return 0;
return ($a < $ ? -1 : 1;

==

return ($a == $ ? 0 : (( $a < $ ? -1 : 1);

?

и с =~ разобрался

P.S. форум явно делает латинскую b заглавной

Edited June 25, 2012 by NeoXidizer

NeoXidizer · June 25, 2012

   my %n = map {$_ => sprintf "$c: 1 %d $str; $c: %d 63 $str;", $_, $_+1} 2,5,8,12,18;
	while ( my ($key, $value) = each(%n) ) {
        print "$key => $value\n";
    }

вывод:

8 => 0: 1 8 0 3; 0: 9 63 0 3;
18 => 0: 1 18 0 3; 0: 19 63 0 3;
12 => 0: 1 12 0 3; 0: 13 63 0 3;
2 => 0: 1 2 0 3; 0: 3 63 0 3;
5 => 0: 1 5 0 3; 0: 6 63 0 3;

почему не по порядку?

и насколько я понял, в этом случае нет разницы между array_map и array_walk?

MiksIr · June 25, 2012

Это особенность хеша. В общем именно по-этому это называется хешом, а не массивом. Способ хранения хеша не сохраняет порядок ключей при переборе.

Sign In

Переписать Perl скрипт на PHP

Question

Link to comment

Share on other sites

42 answers to this question

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Обсуждения

Important Information