Поиск элемента в массиве
Процедура Linear-Search(A, n, x)
Вход:
- A - массив
- n - кол-во элементов массива A, среди которых выполняется поиск
- x - искомое значение
Выход: либо индекс i, для которого A[i] = x, либо -1 - элемент не найден
1. Установить значение answer равным 'not found'
2. Для каждого i, от 0 до n
2.1. Если A[i] = x, установить answer равным i
3. Вернуть answer
Пример
use uni::perl qw| :dumper |;
use List::Util qw| shuffle |;
my $item = 189;
my @arr = shuffle (0..9999);
my $length = scalar @arr;
my $index = linear_search(\@arr, $length, $item);
print $index eq 'not found' ? "$index\n" : "Item = $item, index = $index, chech = $arr[$index]\n";
sub linear_search {
my ( $array, $length, $item ) = @_;
my $answer = 'not found';
for (my $i = 0; $i < $length; $i++) {
$answer = $i if $array->[$i] == $item;
}
return $answer;
}
$ perl script.pl
Item = 189, index = 1525, chech = 189
Процедура Better-Linear-Search(A, n, x)
Вход и Выход: теже что и в Linear-Search
1. Для i = 0 до n
1.1. Если A[i] = x, вернуть i
2. Вернуть 'not found'
Пример
my $item = 1;
my @arr = shuffle (0..9999);
my $length = scalar @arr;
my $index = better_linear_search(\@arr, $length, $item);
print $index eq 'not found' ? "$index\n" : "Item = $item, index = $index, chech = $arr[$index]\n";
sub better_linear_search {
my ( $array, $length, $item ) = @_;
for (my $i = 0; $i < $length; $i++){
return $i if $array->[$i] == $item;
}
return 'not found';
}
$ perl script.pl
Item = 1, index = 9227, chech = 1
Процедура Sentinel-Linear-Search(A, n, x)
Вход и выход: теже что и у Linear-Search
1. Если A[n-1] = x, то вернуть n-1
2. Поместить x в A[n-1]
3. Установить i = 0
4. Пока A[i] != x:
4.1. Увеличить i на 1
5. Если i < n-1, вернуть i
6. В противном случае, вернуть 'not found'
Пример
my $item = 2;
my @arr = shuffle (0..9999);
my $length = scalar @arr;
my $index = sentinel_linear_search(\@arr, $length, $item);
print $index eq 'not found' ? "$index\n" : "Item = $item, index = $index, chech = $arr[$index]\n";
sub sentinel_linear_search {
my ( $array, $length, $item ) = @_;
return $length - 1 if $array->[$length - 1] == $item;
$array->[$length - 1] = $item;
my $index = 0;
while ( $array->[$index] != $item ){
$index++;
}
return $index if $index < $length - 1;
return 'not found';
}
$ perl script.pl
Item = 2, index = 9328, chech = 2
Benchmark
Benchmark всех трех алгоритмов
use Benchmark;
my ( $shuffle, $check, $size ) = (1, 0, 999999);
my @array = $shuffle ? shuffle (0..$size) : (0..$size);
my $length = scalar(@array);
timethese(0, {
'linear' => sub {
my $item = int rand @array;
my $index = MySearch::linear_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
'better' => sub {
my $item = int rand @array;
my $index = MySearch::better_linear_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
'sentinel' => sub {
my $item = int rand @array;
my $index = MySearch::sentinel_linear_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
});
done_testing() if $check;
$ perl benchmark.pl
Benchmark: running better, linear, sentinel for at least 3 CPU seconds...
better: 4 wallclock secs ( 3.68 usr + 0.00 sys = 3.68 CPU) @ 22.28/s (n=82)
linear: 3 wallclock secs ( 3.11 usr + 0.01 sys = 3.12 CPU) @ 12.18/s (n=38)
sentinel: 3 wallclock secs ( 3.36 usr + 0.01 sys = 3.37 CPU) @ 21.36/s (n=72)
$ perl benchmark.pl
Benchmark: timing 100 iterations of better, linear, sentinel...
better: 5 wallclock secs ( 4.54 usr + 0.01 sys = 4.55 CPU) @ 21.98/s (n=100)
linear: 8 wallclock secs ( 8.29 usr + 0.00 sys = 8.29 CPU) @ 12.06/s (n=100)
sentinel: 4 wallclock secs ( 4.08 usr + 0.06 sys = 4.14 CPU) @ 24.15/s (n=100)
Рекурсия
Канонический пример рекурсии. Вычисление n!
Процедура Factorial(n)
Вход: целое число n >= 0 Выход: значение n!
1. Если n = 0, вернуть 1
2. В противном случае вернуть n * Factorial(n - 1)
Пример
print factorial(5) . "\n\n";
sub factorial {
my $n = shift;
return ( $n == 0 ? 1 : $n * factorial( $n - 1 ) ) ;
}
$ perl script.pl
120
Процедура Recursive-Linear-Search(A, n, i, x)
Вход: теже что и у Linear-Search, но с доп. параметром i - откуда начинать искать Выход: тотже
1. Если i > n, вернуть 'not found'
2. В противном случае (i <= n), если A[i] = x, вернуть i
3. В противном случае (i <= n и A[i] != x), вернуть Recursive-Linear-Search(A, n, i + 1, x)
Пример
sub recursive_linear_search {
my ( $array, $length, $index, $item ) = @_;
return 'not found' if $index > $length;
return $index if $array->[$index] == $item;
return recursive_linear_search($array, $length, ++$index, $item);
}
$ perl script.pl
Item = 1, index = 618, chech = 1
Самый медленный поиск - рекурсивный
my ( $shuffle, $check, $size ) = (1, 0, 999999);
my @array = $shuffle ? shuffle (0..$size) : (0..$size);
my $length = scalar(@array);
timethese(0, {
'linear' => sub {
my $item = int rand @array;
my $index = MySearch::linear_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
'better' => sub {
my $item = int rand @array;
my $index = MySearch::better_linear_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
'sentinel' => sub {
my $item = int rand @array;
my $index = MySearch::sentinel_linear_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
'reqursive' => sub {
my $item = int rand @array;
my $index = MySearch::recursive_linear_search( \@array, $length, 0, $item );
ok( $item == $array[$index] ) if $check;
},
});
$ perl benchmark.pl
Benchmark: running better, linear, reqursive, sentinel for at least 3 CPU seconds...
better: 4 wallclock secs ( 3.21 usr + 0.00 sys = 3.21 CPU) @ 25.23/s (n=81)
linear: 3 wallclock secs ( 3.11 usr + 0.00 sys = 3.11 CPU) @ 11.90/s (n=37)
reqursive: 3 wallclock secs ( 3.30 usr + 0.00 sys = 3.30 CPU) @ 3.64/s (n=12)
sentinel: 3 wallclock secs ( 3.14 usr + 0.00 sys = 3.14 CPU) @ 23.57/s (n=74)
$ perl benchmark.pl
Benchmark: timing 100 iterations of better, linear, reqursive, sentinel...
better: 5 wallclock secs ( 4.13 usr + 0.02 sys = 4.15 CPU) @ 24.10/s (n=100)
linear: 8 wallclock secs ( 8.18 usr + 0.01 sys = 8.19 CPU) @ 12.21/s (n=100)
reqursive: 22 wallclock secs (20.86 usr + 0.20 sys = 21.06 CPU) @ 4.75/s (n=100)
sentinel: 5 wallclock secs ( 4.52 usr + 0.01 sys = 4.53 CPU) @ 22.08/s (n=100)
Сортировка
Бинарный поиск
Ключевая особенность - массив должен быть отсортирован. Время работы алгоритма O(lgn)
TODO: тут еще можно много чего придумать. Например в статье - https://habr.com/post/146228/
ищется в зависимости от того в какую сторону сортирован массив
Процедура Binary-Search(A, n, x)
Вход и выход: теже что и у Linear-Search
То что написано в книге, у меня не взлетело… Вечно вылетало в бесконечный цикл поэтому я решил немного подправить
1. Установить left = 0, а right = n
2. Пока left <= right:
2.1. Установить middle = (left + right)/2
2.2. Если A[middle] = x, вернуть middle
2.3. В противном случае (A[q] != x), если A[q] > x, установить right = middle
2.4. В противном случае (A[q] < x), установить left = middle - 1
3. Вернуть значение 'not found'
Пример
my ( $shuffle, $check, $size ) = (0, 1, 999999);
my @array = $shuffle ? shuffle (0..$size) : (0..$size);
my $length = scalar(@array);
my $item = int rand @array;
my $index = MySearch::binary_search( \@array, $length, $item );
warn "item = $item; index = $index; check = $array[$index]" if $check;
ok( $item == $array[$index] ) if $check;
done_testing() if $check;
sub binary_search {
my ( $array, $length, $item ) = @_;
my ( $left, $right ) = ( 0, $length );
while ( $left <= $right ){
my $middle = int ( ($right + $left) / 2 );
return $middle if $array->[$middle] == $item;
$array->[$middle] > $item ? $right = $middle : $left = $middle++;
}
return 'not found';
}
$ perl script.pl
item = 431667; index = 431667; check = 431667 at script.pl line 18.
ok 1
benchmark, пока что самые лучшие результаты
my ( $shuffle, $check, $size ) = (0, 0, 999999);
my @array = $shuffle ? shuffle (0..$size) : (0..$size);
my $length = scalar(@array);
timethese(0, {
'binary' => sub {
my $item = int rand @array;
my $index = MySearch::binary_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
});
done_testing() if $check;
$ perl benchmark.pl
Benchmark: running binary for at least 3 CPU seconds...
binary: 3 wallclock secs ( 3.21 usr + 0.01 sys = 3.22 CPU) @ 58165.22/s (n=187292)
$ perl benchmark.pl
Benchmark: timing 100 iterations of binary...
binary: 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)
(warning: too few iterations for a reliable count)
Процедура Recursive-Binary-Search(A, p, r, x)
Вход и выход: теже что и у Linear-Search. Параметры p и r - подмассив A[p..r]
1. Если p > r, вернуть 'not found'
2. В противном случае (p <= r), установить q = ( p + r )/2
3. Если A[q] = x, вернуть q
4. В противном случае (A[q] != x), если A[q] > x, вернуть Recursive-Binary-Search(A, q, r, x)
5. В противном случае (A[q] <= x) вернуть Recursive-Binary-Search(A, p, q - 1, x)
Пример
my ( $shuffle, $check, $size ) = (0, 1, 99);
my @array = $shuffle ? shuffle (0..$size) : (0..$size);
my $length = scalar(@array);
my $item = int rand @array;
my $index = MySearch::recursive_binary_search( \@array, 0, $length, $item );
warn "item = $item; index = $index; check = $array[$index]" if $check;
ok( $item == $array[$index] ) if $check;
done_testing() if $check;
sub recursive_binary_search {
my ($array, $left, $right, $item) = @_;
return 'not found' if ( $left > $right );
my $middle = int ( ( $left + $right ) / 2 );
return $middle if ( $array->[$middle] == $item );
if ($array->[$middle] > $item){
recursive_binary_search($array, $left, $middle, $item);
} else {
recursive_binary_search($array, $middle, $right, $item);
}
}
$ perl script.pl
item = 85; index = 85; check = 85 at script.pl line 19.
ok 1
1..1
benchmark
По производительности немного уступает итеративному варианту
my ( $shuffle, $check, $size ) = (0, 0, 999999);
my @array = $shuffle ? shuffle (0..$size) : (0..$size);
my $length = scalar(@array);
timethese(0, {
'binary' => sub {
my $item = int rand @array;
my $index = MySearch::binary_search( \@array, $length, $item );
ok( $item == $array[$index] ) if $check;
},
'rec_binary' => sub {
my $item = int rand @array;
my $index = MySearch::recursive_binary_search( \@array, 0, $length, $item );
ok( $item == $array[$index] ) if $check;
},
});
done_testing() if $check;
$ perl benchmark.pl
Benchmark: running binary, rec_binary for at least 3 CPU seconds...
binary: 3 wallclock secs ( 3.10 usr + 0.00 sys = 3.10 CPU) @ 57728.71/s (n=178959)
rec_binary: 4 wallclock secs ( 3.06 usr + 0.00 sys = 3.06 CPU) @ 48827.12/s (n=149411)
Процедура Selection-Sort(A, n) - Сортировка выбором
Вход:
- A - сортируемый массив
- n - кол-во эл. массива
Выход: Сортированный массив в возростающем порядке
1. Для i = 0 до n-1
A. Установить значение small = i
B. Для j = i+1 до n-1
i. Если A[j] < A[small], присвоить small = j
C. Поменять меставми A[i] <=> A[small]
Пример
my $check = 1;
my @origin_array = (0..10);
my @shuffle_array = shuffle @origin_array;
my $length = scalar(@shuffle_array);
my @sort_array = MySort::selection_sort(\@shuffle_array, $length);
if ( $check ){
foreach my $i ( 0..$length - 1 ){
die "Array is different! origin_array = $origin_array[$i]; != $sort_array[$i]" if ( $origin_array[$i] != $sort_array[$i] );
}
}
sub selection_sort {
my ( $array, $size ) = @_;
for (my $i = 0; $i < $size; $i++) {
my $small = $i;
for (my $j = $i + 1; $j < $size; $j++) {
$small = $j if ( $array->[$j] < $array->[$small] );
}
( $array->[$i], $array->[$small] ) = ( $array->[$small], $array->[$i] );
}
return @{ $array || [] };
}
benchmark
По стравнению с обычным sort, selection_sort сильно отстает по производительности
100 итераций с 999999 массивом, я так и не дождался...
my ( $check, $size) = ( 0, 9999 );
my @origin_array = (0..$size);
my $length = scalar(@origin_array);
timethese(100, {
'selection_sort' => sub {
my @shuffle_array = shuffle @origin_array;
my @sort_array = MySort::selection_sort(\@shuffle_array, $length);
check_sort(\@sort_array, \@origin_array) if $check;
},
'origin_sort' => sub {
my @shuffle_array = shuffle @origin_array;
my @sort_array = sort { $a <=> $b } @shuffle_array;
check_sort(\@sort_array, \@origin_array);
}
});
sub check_sort {
my ( $origin_array, $sort_array ) = @_;
foreach my $i ( 0..$length - 1 ){
die "Array is different! origin_array = $origin_array->[$i]; sort_array = $sort_array->[$i]; "
if ( $origin_array->[$i] != $sort_array->[$i] );
}
}
$ perl benchmark.pl
Benchmark: running origin_sort, selection_sort for at least 3 CPU seconds...
origin_sort: 3 wallclock secs ( 3.18 usr + 0.00 sys = 3.18 CPU) @ 245.91/s (n=782)
selection_sort: 11 wallclock secs (10.78 usr + 0.00 sys = 10.78 CPU) @ 0.09/s (n=1)
(warning: too few iterations for a reliable count)
Процедура Insertion-Sort(A, n) - Сортировка вставкой
Вход и выход: такие же что и у Selection-Sort
1. Для i = 1 до n-1
A. Установить key = A[i], а j = i-1
B. Пока j > 0 и A[j] > key
i. Присвоить A[j+1] = A[j]
ii. Уменьшить j на еденицу
C. Присвоить A[j+1] = key
Пример
my $check = 1;
my @origin_array = (0..999);
my @shuffle_array = shuffle @origin_array;
my $length = scalar(@shuffle_array);
my @sort_array = MySort::insertion_sort(\@shuffle_array, $length);
if ( $check ){
foreach my $i ( 0..$length - 1 ){
die "Array is different! origin_array = $origin_array[$i]; != $sort_array[$i]" if ( $origin_array[$i] != $sort_array[$i] );
}
}
sub insertion_sort {
my ( $array, $length ) = @_;
for (my $i = 1; $i < $length; $i++) {
my $tmp = $array->[$i];
my $j = $i - 1;
while ( $j >= 0 && $array->[$j] > $tmp ){
$array->[$j + 1] = $array->[$j];
$j--;
}
$array->[$j + 1] = $tmp;
}
return @{ $array || [] };
}
benchmark
Сортировка 10 000 записей пока что лидирует обычный sort
За 3 сек. процессорного времени, обычный sort делает ~800 сортировок, а "вставка" и "выборка" только по одному...
my ( $check, $size) = ( 1, 9999 );
my @origin_array = (0..$size);
my $length = scalar(@origin_array);
timethese(1, {
'insertion' => sub {
my @shuffle_array = shuffle @origin_array;
my @sort_array = MySort::insertion_sort(\@shuffle_array, $length);
check_sort(\@sort_array, \@origin_array) if $check;
},
'selection' => sub {
my @shuffle_array = shuffle @origin_array;
my @sort_array = MySort::selection_sort(\@shuffle_array, $length);
check_sort(\@sort_array, \@origin_array) if $check;
},
'origin' => sub {
my @shuffle_array = shuffle @origin_array;
my @sort_array = sort { $a <=> $b } @shuffle_array;
check_sort(\@sort_array, \@origin_array);
}
});
$ perl benchmark.pl
Benchmark: timing 1 iterations of insertion, origin, selection...
insertion: 8 wallclock secs ( 7.46 usr + 0.00 sys = 7.46 CPU) @ 0.13/s (n=1)
(warning: too few iterations for a reliable count)
origin: 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)
(warning: too few iterations for a reliable count)
selection: 11 wallclock secs (11.04 usr + 0.01 sys = 11.05 CPU) @ 0.09/s (n=1)
(warning: too few iterations for a reliable count)
$ perl benchmark.pl
Benchmark: running insertion, origin, selection for at least 3 CPU seconds...
insertion: 7 wallclock secs ( 7.51 usr + 0.01 sys = 7.52 CPU) @ 0.13/s (n=1)
(warning: too few iterations for a reliable count)
origin: 3 wallclock secs ( 3.16 usr + 0.00 sys = 3.16 CPU) @ 239.56/s (n=757)
selection: 11 wallclock secs (10.84 usr + 0.00 sys = 10.84 CPU) @ 0.09/s (n=1)
(warning: too few iterations for a reliable count)
Сортировка слиянием
То что в книге, вообще не получилось :(
content
Процедура Merge-Sort(A)
Вход:
- A - неотсортированный массив
Результат: массив A отсортирован в возростающем порядке
1. Если кол-во элементов в массиве меньше или всего один элемент, вернуть его
2. В противном случае:
A. Вычислить середину массива: кол-во эл. / 2
B. Вызвать Merge-Sort( A[0, middle - 1] ) и записать результат в массив left
С. Вызвать Merge-Sort( A[middle, длина массива - 1] ) и записать результат в массив right
D. Вызвать Merge(right, left)
Процедура Merge(right, left)
Вход:
- два отсортированных массива
Результат: один отсортированный массив
1. Установить значение i и j равным нулю
3. Обьявить пустой массив tmp
2. Пока i меньше кол-ва эл. массива left и j меньше кол-ва эл. right
A. Если left[$i] < right[j], добавить эл. left[$i] во временный массив tmp и увеличить i на 1
B. В противном случае(left[$i] > right[j]), добавить эл. right[$j] во временный массив tmp и увеличить j на 1
3. Если кол-во эл. в массиве left меньше i, то добавить их в массив tmp
4. Если кол-во эл. в массиве right меньше j, то добавить их в массив tmp
5. Вернуть получившийся массив
Пример
my @origin_array = (12, 9, 7, 7, 10, 5, 7);
my @sort_array = MySort::merge_sort(@origin_array);
warn "result = @sort_array";
sub merge_sort {
my @array = @_;
my $lenght = @array;
return @array if ( $lenght <= 1 );
my $mid = int ( $lenght / 2 );
my @left = merge_sort( @array[0..$mid - 1] );
my @right = merge_sort( @array[$mid..$lenght - 1] );
merge(\@left, \@right);
}
sub merge {
my ($left, $right) = @_;
my @a1 = @{ $left || [] };
my @a2 = @{ $right || [] };
my @tmp;
my ($i, $j) = (0, 0);
while ( $i < @a1 && $j < @a2 ){
push @tmp, ( $a1[$i] < $a2[$j] ? $a1[$i++] : $a2[$j++] );
}
push @tmp, @a1[$i..$#a1] if ( $i < @a1 );
push @tmp, @a2[$j..$#a2] if ( $j < @a2 );
@tmp;
}
$ perl script.pl
result = 5 7 7 7 9 10 12 at script.pl line 20.
Если с debug:
$ perl script.pl
origin array = 12 9 7 7 10 5 7
origin array = 12 9 7
origin array = 12
left = 12
origin array = 9 7
origin array = 9
left = 9
origin array = 7
right = 7
i = 0; j = 0
7 9
right = 7 9
i = 0; j = 0
i = 0; j = 1
7 9 12
left = 7 9 12
origin array = 7 10 5 7
origin array = 7 10
origin array = 7
left = 7
origin array = 10
right = 10
i = 0; j = 0
7 10
left = 7 10
origin array = 5 7
origin array = 5
left = 5
origin array = 7
right = 7
i = 0; j = 0
5 7
right = 5 7
i = 0; j = 0
i = 0; j = 1
5 7 7 10
right = 5 7 7 10
i = 0; j = 0
i = 0; j = 1
i = 0; j = 2
i = 0; j = 3
i = 1; j = 3
i = 2; j = 3
5 7 7 7 9 10 12
result = 5 7 7 7 9 10 12 at script.pl line 20.