حل کردن سودوکو با پرل

سودوکو بازی فکری محبوبی بین مردم است ولی برنامه نویسان تنبل همه چیز را به عنوان مساله ای می بینند که باید یکبار برای همیشه آن را از میان بردارند! در این پست قصد داریم برنامه ای بنویسیم که سودوکوی حل نشده را به آن بدهیم و سودوکوی حل شده را تحویل بگیریم !

سودوکو جدولی است 9x9 با 81 خانه که تعدادی از این خانه ها با اعدادی پر شده اند و تعدادی دیگر نیز خالی می باشند . بازیکن می بایست کلیه خانه های خالی را با اعداد 1 تا 9 طبق قوانین زیر پر کند :

1. هر عدد در یک سطر ، فقط می بایست یکبار تکرار شده باشد.
2. هر عدد در یک ستون ، می بایست فقط یکبار تکرار شده باشد.
3. هر عدد در مربعات 3x3 کنار هم می بایست فقط یکبار تکرار شده باشد.

به مثال زیر توجه کنید . جدول سمت چپ سودکوی حل نشده با تعدادی جای خالی و جدول سمت راست حل شده آن است . سعی کنید سه قانون فوق را در این مثال بررسی کنید :

+---+---+---+			    +---+---+---+
|4..|...|8.5|			    |417|369|825|
|.3.|...|...|			    |632|158|947|
|...|7..|...|			    |958|724|316|
+---+---+---+			    +---+---+---+
|.2.|...|.6.|			    |825|437|169|
|...|.8.|4..|			    |791|586|432|
|...|.1.|...|			    |346|912|758|
+---+---+---+			    +---+---+---+
|...|6.3|.7.|			    |289|643|571|
|5..|2..|...|			    |573|291|684|
|1.4|...|...|			    |164|875|293|
+---+---+---+			    +---+---+---+

در مثال بالا ، چهار گوشه ی هر مربع 3x3 یک علامت + قرار گرفته است . سطر ها و ستون ها نیز کاملا مشخص می باشند.

این برنامه به مانند اکثر برنامه های دیگر ما می بایست مطابق با استاندارد یونیکس باشد ؛ یعنی در صورت فراهم شدن نام فایل در خط فرمان هنگام فراخوانی ، برنامه باید محتوای مورد نیاز خود را از این فایل ها بخواند و در غیر این صورت می بایست منتظر ورود محتوا از « ورودی استاندارد » بماند .

توجه داشته باشید : برنامه ای که بتواند از ورودی استاندارد بخواند می تواند از pipe هم بخواند و برنامه ای که در خروجی استاندارد بنویسد می تواند در pipe هم بنویسد . این قانون باعث توانایی برنامه جهت  ارتباط با سایر برنامه ها می شود.

شکل ورودی مورد نیاز حل کننده ی سودوکوی ما باید به صورت رشته ای 81 کاراکتری از اعداد و  . (دات) به عنوان جای خالی باشد. برنامه می بایست توانایی حل بی نهایت سودوکو در هر فراخوانی را داشته باشد ، بنابر این هر خط حاوی یک سودوکو می باشد و خط بعدی سودوکوی دیگری است . یک نمونه از ورودی برنامه می تواند حاوی سه خط زیر باشد که نشان دهنده سه سودوکو متفاوت می باشد :

.6.5.4.3.1...9...8.........9...5...6.4.6.2.7.7...4...5.........4...8...1.5.2.3.4.
7.....4...2..7..8...3..8.799..5..3...6..2..9...1.97..6...3..9...3..4..6...9..1.35
....7..2.8.......6.1.2.5...9.54....8.........3....85.1...3.2.8.4.......9.7..6....

این سه خط نشان دهنده سه سودوکو به شکل زیر می باشند :

+---+---+---+		+---+---+---+		+---+---+---+
|.6.|5.4|.3.|		|7..|...|4..|		|...|.7.|.2.|
|1..|.9.|..8|		|.2.|.7.|.8.|		|8..|...|..6|
|...|...|...|		|..3|..8|.79|		|.1.|2.5|...|
+---+---+---+		+---+---+---+		+---+---+---+
|9..|.5.|..6|		|9..|5..|3..|		|9.5|4..|..8|
|.4.|6.2|.7.|		|.6.|.2.|.9.|		|...|...|...|
|7..|.4.|..5|		|..1|.97|..6|		|3..|..8|5.1|
+---+---+---+		+---+---+---+		+---+---+---+
|...|...|...|		|...|3..|9..|		|...|3.2|.8.|
|4..|.8.|..1|		|.3.|.4.|.6.|		|4..|...|..9|
|.5.|2.3|.4.|		|..9|..1|.35|		|.7.|.6.|...|
+---+---+---+		+---+---+---+		+---+---+---+

برنامه تا جای ممکن پاکسازی و بهینه سازی شده است . اساس کار آن به این شکل است که ابتدا به ازای هر خانه خالی لیست اعداد ممکن برای آن خانه را به دست می آورد. سودوکوی زیر و لیست اعداد ممکن برای هر خانه آن را ببینید :

+---+---+---+
|...|.7.|.2.|
|8..|...|..6|
|.1.|2.5|...|
+---+---+---+
|9.5|4..|..8|
|...|...|...|
|3..|..8|5.1|
+---+---+---+
|...|3.2|.8.|
|4..|...|..9|
|.7.|.6.|...|
+---+---+---+
+-----------------------------+-----------------------------+-----------------------------+
|    56   |  34569  |   3469  |   1689  |    7    |  13469  |  13489  |    2    |   345   |
|    8    |  23459  |  23479  |    19   |   1349  |   1349  |  13479  |  134579 |    6    |
|    67   |    1    |  34679  |    2    |   3489  |    5    |  34789  |   3479  |   347   |
+-----------------------------+-----------------------------+-----------------------------+
|    9    |    26   |    5    |    4    |   123   |   1367  |   2367  |   367   |    8    |
|   1267  |   2468  |  124678 |  15679  |  12359  |  13679  |  234679 |  34679  |   2347  |
|    3    |   246   |   2467  |   679   |    29   |    8    |    5    |   4679  |    1    |
+-----------------------------+-----------------------------+-----------------------------+
|   156   |   569   |   169   |    3    |   1459  |    2    |   1467  |    8    |   457   |
|    4    |  23568  |  12368  |   1578  |   158   |    17   |  12367  |  13567  |    9    |
|   125   |    7    |  12389  |   1589  |    6    |   149   |   1234  |   1345  |   2345  |
+-----------------------------+-----------------------------+-----------------------------+

به عنوان مثال برای اولین خانه در بالا سمت چپ فقط اعداد 5 و 6 می توانند جز جواب باشند و دیگر اعداد به هیچ وجه نمی توانند در این خانه قرار بگیرند. مثال بالا خروجی دو تابع print_sudoku و display را نشان می دهد.

وقتی لیست اعداد ممکن  برای تمام خانه ها را پیدا کردیم ، این  لیست را به ترتیب خانه هایی که کمترین امکان را دارند مرتب می کنیم و سپس خانه ابتدای این لیست را با اولین عدد ممکن برای آن خانه پر می کنیم و  دوباره لیست اعداد ممکن برای هر خانه را پیدا می کنیم و سپس دوباره اقدام به پر کردن خانه خالی دیگری می کنیم . اگر به جایی برسیم که برای یک خانه هیچ عدد ممکنی وجود نداشته باشد به این معنی است که مسیر را اشتباه رفته ایم . پس از آخرین حرکت rollback می کنیم و برای آن خانه عدد ممکن دیگری را انتخاب می کنیم. این کار را تا زمانی انجام می دهیم که لیست اعداد ممکن ما خالی شود ، یعنی تمام خانه ها با یک عدد پر شده اند و خانه خالی وجود ندارد.

بعد از پر کردن هر خانه باید لیست اعداد ممکن هر خانه را دوباره محاسبه کنیم ولی با کمی دقت متوجه می شویم که نیازی به این کار نیست و فقط باید لیست اعداد ممکن خانه های مجاور آخرین خانه پر شده را دوباره محاسبه کنیم ، چون آخرین حرکت فقط ممکنات سطر و ستون و مربع خودش را تغییر می دهد و در انتخابهای بقیه خانه ها تاثیری ندارند. این کار باعث می شود برنامه ی ما تا حدود بسیار زیادی سریعتر عمل کند.

نکاتی در مورد کد نوشته شده ی برنامه :

1. لیست اعداد سودوکو در آرایه ای به نام parray نگهداری می شود. اندیس این آرایه از 0 تا 80 می باشد و مقدار هر خانه نشان دهنده عدد محاسبه شده برای آن خانه تا آن لحظه است . خانه های خالی سودوکو با صفر پر می شوند و یک سودوکو زمانی حل شده است که هیچ خانه ای با مقدار صفر در آرایه parray وجود نداشته باشد .
2. possibility_hash یک hash می باشد ( دیکشنری در زبان پایتون یا associative array در زبان هایی مثل PHP ) . اندیس های این hash شماره خانه خالی و مقدار آن یک reference به لیستی حاوی کلیه اعداد ممکن برای آن خانه می باشد.  خانه هایی از سودوکو که مقدار آن معلوم شده است از possibility_hash حذف می شوند ، لذا وقتی possibility_hash خالی شود به این معناست که سودوکوی ما حل شده است.
3. adjacent یک  hash می باشد با تعداد 81 عضو که اندیس هر عضو شماره  خانه سودوکو است  و مقدار آن یک reference به لیستی حاوی شماره کلیه خانه های مجاور آن خانه ( خانه های قرار گرفته در همان سطر و ستون و مربع ) می باشد .  زمانی که یک خانه خالی را با یک عدد مقدار دهی کردیم طبیعتا این عدد می بایست از لیست اعداد ممکن برای خانه های آن سطر و ستون و مربع حذف شود . لیست خانه های موجود در آن سطر و ستون و مربع از adjacent استخراج می شود.
4. تابع print_sudoku جدول 9x9 سودوکو را نمایش می دهد. اگر این تابع قبل از حل کامل برنامه فراخوانی شود خانه های خالی با . (دات) پر می شوند.(مثال در اینجا )
5. تابع display همانند تابع print_sudoku جدول 9x9 سودوکو را نمایش می دهد با این تفاوت که به جای نمایش خانه های خالی با . (دات) لیست اعداد ممکن برای آن خانه را نمایش می دهد. (مثال در اینجا)
   
6. تابع find_possibilities اگر با مقدار 1- فراخوانی شود کلیه مقادیر ممکن برای هر خانه خالی را محاسبه می کند و در possibility_hash% قرار می دهد . در غیر این صورت باید با شماره یک خانه فراخوانی شود. تابع find_possibilities خانه های مجاور این خانه را پیدا می کند و لیست اعداد ممکن برای هر خانه را آپدیت می کند . در صورتی که یک خانه با یک مقدار به خصوص پر شده باشد از این hash حذف می شود.
7. rollback آخرین خانه ای که پر کرده ایم را خالی می کند ( مقدار آن خانه را صفر می کند ) و شماره آن خانه و مقدارش را بر می گرداند.
8. تابع find_best_move بر اساس متغیر possibility_hash% بهترین حرکت ممکن در آن لحظه را انجام می دهد و یک خانه را پر می کند. بهترین حرکت در الگوریتم مورد استفاده ما عبارتست از پر کردن خانه ای که کمترین لیست اعداد ممکن را دارد. اگر دو متغیر spot_be$ و must_not_be$ با مقادیری بزرگتر از 1- ست شده باشند می بایست مقداری برای خانه spot_be$ انتخاب کنیم که مقدارش بزرگتر از must_not_be$ باشد. این حالت بعد از یک rollback اتفاق می افتد.
9. لیست حرکت های انجام شده در آرایه ای به نام moves ذخیره می شود. هر عنصر این آرایه یک reference به لیستی حاوی دو عنصر می باشد: شماره خانه پر شده و مقدار استفاده شده برای پر کردن آن خانه. از این آرایه در تابع rollback استفاده می شود.
   

سورس کامل حل کننده سودوکو نوشته شده به زبان Perl به صورت زیر است . این برنامه بدون احتساب خط های خالی و کامنتها حدود 170 خط کد است .

#!/usr/local/bin/perl
#
# Another sudoku solver with Perl!
#
# Programmer : Mohsen Safari
# Email      : [e-mail]
# Weblog     : sutal.blog.ir
#ا 
# read sudoku tables from named file provided at command line
# or read it from standard input.
# each line has one sudoku challenge!
# blank entries must be specified with .(dot) or 0(zero).
# Examples:
#
# 4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......
# 52...6.........7.13...........4..8..6......5...........418.........3..2...87.....
# 6.....8.3.4.7.................5.4.7.3..2.....1.6.......2.....5.....8.6......1....
# 48.3............71.2.......7.5....6....2..8.............1.76...3.....4......5....
# ....14....3....2...7..........9...3.6.1.............8.2.....1.4....5.6.....7.8...
#
# Usage:
# $ echo 4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4...... | perl sudoku-solver.pl
# $ perl sudoku-solver.pl file
#
 
use warnings;
use strict;

my (@parray, @moves, @adjacent, %possibility_hash);
#
# A little house keeping! calculate each row, column, and sqaure indexs
# and finally calculate all adjacent of each entry.
#
{
	my (@rindex, @cindex, @sqindex);
	my (@r, @c, @sq);
	my ($r, $c, $sq);
	my (%hash, $j);
	# first index of each sqaure.
	my @sq_start = (0, 3, 6, 27, 30, 33, 54, 57, 60); 

	foreach(0 .. 8) {
		my @arr;
		for(my $iter = $_; $iter <= 80; $iter += 9){
			push @arr, $iter;
		}
		# fill indexes of each column.
		$cindex[$_] = [@arr];

		# Calculate indexes of each row.
		$rindex[$_] = [$_ * 9 .. $_ * 9 + 8];
		
		$j = $sq_start[$_];
		# fill indexes of each square
		$sqindex[$_] = [$j, $j+1,$j+2,$j+9,$j+10,$j+11,$j+18,$j+19,$j+20];
	}

	foreach(0 .. 80) {
		$r = int($_ / 9);
		$c = $_ % 9;

		if ($r <= 2) {
			if($c <= 2) { $sq = 0 } elsif ($c <= 5) { $sq = 1 } else { $sq = 2}
		}
		elsif ($r <= 5) {
			if($c <= 2) { $sq = 3 } elsif ($c <= 5) { $sq = 4 } else { $sq = 5}
		}
		else {
			if($c <= 2) { $sq = 6 } elsif ($c <= 5) { $sq = 7 } else { $sq = 8}
		} 	

		@r  = @{$rindex[$r]};
		@c  = @{$cindex[$c]};
		@sq = @{$sqindex[$sq]};
		%hash = ();

		foreach my $j ((@r, @c, @sq)) {
			$hash{$j}++;
		}
		# fill adjacent indexes of each entry.
		$adjacent[$_] = [sort {$a <=> $b} keys %hash];
	}
}

#
# print sudoku table is a readable and familar format
#
sub print_sudoku {
	print "+---+---+---+", "\n";
	for (my $i = 0; $i <= $#parray; $i++) {
		if ( $i % 3 == 0) {
			print "|";
		}
		print $parray[$i] != 0 ? $parray[$i] : ".";
		print "|\n" if ( ($i + 1) % 9 == 0);

		if ( ($i + 1) % 27 == 0) {
			print "+---+---+---+", "\n";
		}
	}
}

#
# Print sudoku table. each entry that has not a specified value
# will be filled with its possible values.
#
sub display {
	find_possibilities(-1);
	print "+-----------------------------+-----------------------------+-----------------------------+" , "\n";
	for (my $i = 0; $i <= $#parray; $i++) {
		if ( $i % 9 == 0) {
			print "|";
		}
		if ($parray[$i] != 0) {
			print "    $parray[$i]    |";
		}
		else {
			my $b = $possibility_hash{$i};
			my $s = "";
			$s .= $_ foreach (@{$b});
			$s = " " . $s . " " while length $s < 9;
			$s = substr($s, 0, length($s) - 1) if length $s > 9;
			print $s, "|";
		}

		print "\n" if ( ($i + 1) % 9 == 0);

		if ( ($i + 1) % 27 == 0) {
			print "+-----------------------------+-----------------------------+-----------------------------+" , "\n";
		}
	}
}

#
# when no progress is available we would rollback to previous move
#
sub rollback {
	if (!@moves) {
		print STDERR "Moves array is empty!\n";
		exit 1;
	}

	my $r = pop @moves;
	$parray[$r->[0]] = 0;
	return ($r->[0], $r->[1]);
}

#
# find possibilities of each no valued entries.
#
sub find_possibilities {
	my (%hash, @arr, @tmp);
	my @iterate =  $_[0] == -1 ? (0 .. 80) : @{$adjacent[$_[0]]};

	delete @possibility_hash{@iterate};
	foreach my $i (@iterate) {
		next if $parray[$i] != 0;
		%hash = ();
		@arr = ();

		@tmp = @parray[@{$adjacent[$i]}];
		$hash{$_}++ foreach((@tmp));
		foreach (1..9) {
			push @arr, $_ if not exists $hash{$_};
		}		
		return -1 if !@arr;
		$possibility_hash{$i} = [@arr];
	}
	return 1;
}

#
# find best move at current position
#
sub find_best_move {
	my $spot_be = shift;
	my $must_not_be = shift;

	my (@su, @tmp);
 	if ($spot_be >= 0) {
		foreach(@{$possibility_hash{$spot_be}}) {
			return ($spot_be, $_) if $_ > $must_not_be;
		}
		return (-1, -1); 
	}

	for(my $i = 0; $i <= $#parray; $i++) {
		next if $parray[$i] != 0;
		push @su, "$i @{$possibility_hash{$i}}";
	}
	@su = sort { length $a <=> length $b } @su;

	foreach my $i (@su){
		@tmp = split " ", $i;
		for (my $j = 1; $j <= $#tmp; $j++) {
			return ($tmp[0], $tmp[$j]) if $tmp[$j] != $must_not_be; 
		}
	}
	# if no move is available return (-1, -1) to rollback
	return (-1, -1);
}

my ($spot, $value, $try, $last);
my ($spot_be, $must_not_be) = (-1, -1);

#
# while there is a line at standard input or named file...
# each line is a sudoku.
#
while (<>) {
	chomp;
	if (length != 81) {
		print STDERR "Invalid sudoku entry!\n";
		next;
	}	
	s/\./0/g;
	@parray = split "";
	print_sudoku;
	display;
	$try = 0;
	$last = -1;
	while (1) {
		if (find_possibilities($last) == -1) {
			($spot_be, $must_not_be) = rollback;
			$last = $spot_be;
			next;
		}
		last if !keys %possibility_hash;

		($spot, $value) = find_best_move $spot_be, $must_not_be;
		if ($spot == -1 and $value == -1) {
			($spot_be, $must_not_be) = rollback;
			$last = $spot_be;
			next;
		}
		$parray[$spot] = $value;
		push @moves, [$spot, $value];
		$spot_be = $must_not_be = -1;
		$try = $try + 1;
		$last = $spot;
	}
	print "Moves: $try\n";
	print_sudoku;
	print "@" x 13, "\n" if !eof();
}

نمونه کاربرد برنامه را ببینید :

# head -n 1 top95.txt
4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......
# head -n 1 top95.txt | perl sudoku-solver
+---+---+---+
|4..|...|8.5|
|.3.|...|...|
|...|7..|...|
+---+---+---+
|.2.|...|.6.|
|...|.8.|4..|
|...|.1.|...|
+---+---+---+
|...|6.3|.7.|
|5..|2..|...|
|1.4|...|...|
+---+---+---+
+-----------------------------+-----------------------------+-----------------------------+
|    4    |   1679  |  12679  |   139   |   2369  |   1269  |    8    |   1239  |    5    |
|  26789  |    3    | 1256789 |  14589  |  24569  | 1245689 |  12679  |   1249  |  124679 |
|   2689  |  15689  |  125689 |    7    |  234569 | 1245689 |  12369  |  12349  |  123469 |
+-----------------------------+-----------------------------+-----------------------------+
|   3789  |    2    |  135789 |   3459  |  34579  |   4579  |  13579  |    6    |  13789  |
|   3679  |  15679  |  135679 |   359   |    8    |  25679  |    4    |  12359  |  12379  |
|  36789  |  456789 |  356789 |   3459  |    1    |  245679 |  23579  |  23589  |  23789  |
+-----------------------------+-----------------------------+-----------------------------+
|   289   |    89   |   289   |    6    |   459   |    3    |   1259  |    7    |  12489  |
|    5    |   6789  |  36789  |    2    |   479   |  14789  |   1369  |  13489  |  134689 |
|    1    |   6789  |    4    |   589   |   579   |   5789  |  23569  |  23589  |  23689  |
+-----------------------------+-----------------------------+-----------------------------+
Moves: 481
+---+---+---+
|417|369|825|
|632|158|947|
|958|724|316|
+---+---+---+
|825|437|169|
|791|586|432|
|346|912|758|
+---+---+---+
|289|643|571|
|573|291|684|
|164|875|293|
+---+---+---+

سه سودوکوی زیر جز سخت ترین سودوکوهای طراحی شده می باشند که برنامه نوشته شده به خوبی یک پاسخ صحیح برای آنها می یابد. می توانید عملکرد برنامه را بر روی این سه سودوکو بررسی کنید :

# cat hardest
8..........36......7..9.2...5...7.......457.....1...3...1....68.85...1...9....4..
..53.....8......2..7..1.5..4....53...1..7...6..32...8..6.5....9..4....3......97..
85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.

پیدا کردن 13 عدد متوالی یک لیست که بیشترین حاصلضرب را دارند.

عدد 1000 رقمی زیر را در نظر بگیرید :

73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450

می خواهیم ترکیب 13 عدد پشت سر هم را پیدا کنیم که حاصلضرب این اعداد در هم از حاصلضرب تمامی توالی های 13 رقمی دیگر بزرگتر باشد. برای مثال بزرگترین حاصلضرب 4 عدد متوالی این لیست به صورت زیر است :

9 × 9 × 8 × 9 = 5832

یعنی هیچ دنباله 4 عددی دیگری در لیست وجود ندارد که حاصلضرب آنها بیشتر از 5832 شود و ارقام این دنباله 9989 می باشد .

با چه زبان برنامه نویسی شروع به نوشتن این برنامه کنیم ؟ نیازی به هیچ زبان برنامه نویسی نیست ، فقط باید قادر باشیم تا از ابزارهای موجود در سیستم های شبه یونیکس به خوبی استفاده کنیم .

ابتدا عدد بالا را در یک فایل مثلا به نام b کپی کنید. توجه داشته باشید که محتوای فایل یک عدد و یک خط نیست بلکه 20 عدد و 20 خط است لذا ابتدا باید آن را تبدیل به یک عدد کامل کنیم :

# cat b | tr -d "\n"

دستور فوق در خط فرمان کلیه کاراکترهای New line را حذف می کند و عدد را به صورت کامل و پشت سر هم در خروجی استاندارد چاپ می کند.

در مرحله بعد نیاز داریم که کلیه ترکیبهای ممکن 13 رقمی این عدد را داشته باشیم . رقم سیزدهم این لیست را در نظر بگیرید . این رقم در ترکیب اول رقم سیزدهم و در ترکیب دوم رقم دوازدهم و در ترکیب سوم رقم یازدهم و .... در ترکیب سیزدهم رقم اول می باشد . برای یافتن تمامی این ترکیبات از awk استفاده می کنیم . کد زیر به زبان awk و برای این منظور نوشته شده است. این کد را در فایلی به نام b.awk ذخیره می کنیم.

#!/usr/bin/awk -f
NR == 1 { 
	for (i=1;i<=length($0);i++) {
		s = substr($0, i, 13);
		if (length(s) == 13)
			print s;
	}
}

برای تست برنامه در خط فرمان دستور زیر را اجرا می کنیم . به علت زیاد بودن تعداد ترکیبات 13 رقمی تعداد آن ها را به 14 عدد محدود می کنیم:

# cat b | tr -d "\n" | awk -f b.awk | head -n 14
7316717653133
3167176531330
1671765313306
6717653133062
7176531330624
1765313306249
7653133062491
6531330624919
5313306249192
3133062491922
1330624919225
3306249192251
3062491922511
0624919225119

تا اینجای کار به نظر می رسد برنامه awk ما ترکیبات 13 رقمی را به درستی پیدا می کند . لیست اعداد تولید شده را با عدد 1000 رقمی مقایسه کنید به عنوان مثال جایگاه رقم سیزدهم عدد 1000 رقمی یا همان 3 را در لیست ترکیبات تولید شده مشاهده کنید. در اولین ترکیب 3 آخرین رقم است. در دومین ترکیب یکی مانده به آخر و ... در سیزدهمین ترکیب عدد اول و در چهاردمین ترکیب از لیست خارج شده است .

در مرحله بعد نیاز داریم تا شکل ترکیبات را عوض کنیم و میان هر عدد یک علامت ضرب * قرار دهیم تا کار برای محاسبات بعدی آماده شود . کل مراحل بالا تا اینجا در دستور خط فرمان زیر نمایش داده شده است . برای کاهش تعداد خروجی ، تعداد خروجی ها را به 10 خط محدود می کنیم:

# cat b | tr -d "\n" | awk -f b.awk | sed 's/\(.\)/\1\*/g;s/\*$//' | head
7*3*1*6*7*1*7*6*5*3*1*3*3
3*1*6*7*1*7*6*5*3*1*3*3*0
1*6*7*1*7*6*5*3*1*3*3*0*6
6*7*1*7*6*5*3*1*3*3*0*6*2
7*1*7*6*5*3*1*3*3*0*6*2*4
1*7*6*5*3*1*3*3*0*6*2*4*9
7*6*5*3*1*3*3*0*6*2*4*9*1
6*5*3*1*3*3*0*6*2*4*9*1*9
5*3*1*3*3*0*6*2*4*9*1*9*2
3*1*3*3*0*6*2*4*9*1*9*2*2

خوب! دیتای ما آماده است و می باید ضرب ها را انجام داده و سپس خروجی را بر مبنای نتیجه حاصلضرب به صورت نزولی سورت کنیم و بزرگترین حاصلضرب ، اولین رکورد چاپ شده در خروجی می باشد . کد کامل مراحل بالا و این قسمت به شرح زیر است :

# cat b | tr -d "\n" | awk -f b.awk | sed 's/\(.\)/\1\*/g;s/\*$//' | while read line; do echo $line"="$[line]; done | sort -t"=" -k2,2nr | head
5*5*7*6*6*8*9*6*6*4*8*9*5=23514624000
3*5*5*7*6*6*8*9*6*6*4*8*9=14108774400
9*7*5*3*6*9*7*8*1*7*9*7*7=8821658160
7*5*3*6*9*7*8*1*7*9*7*7*8=7841473920
4*3*5*5*7*6*6*8*9*6*6*4*8=6270566400
3*6*9*7*8*1*7*9*7*7*8*4*6=5377010688
5*3*6*9*7*8*1*7*9*7*7*8*4=4480842240
3*9*7*5*3*6*9*7*8*1*7*9*7=3780710640
4*7*6*5*4*5*6*8*2*8*4*8*9=3715891200
9*4*7*6*5*4*5*6*8*2*8*4*8=3715891200

بزرگترین حاصلضرب 13 عدد متوالی برابر است با 23514624000 و حاصل از توالی [5576689664895] می باشد. بخشی از این اعداد در خط چهارم و بخشی دیگر از آن در خط پنجم فایل b که همان عدد 1000 رقمی ماست قرار گرفته است.

ملاحظه می فرمایید که تنها با استفاده از خط فرمان و دستورات cat و tr و  awk و sed و sort و head و ساختار کنترلی while توانستیم این مساله را بدون نیاز به صرف وقت برای برنامه نویسی و تست برنامه انجام دهیم .

نمایش لیست اعداد اول - پیدا کردن 10001 مین عدد اول

قصد پیدا کردن 10001 مین عدد اول را داریم . می توانیم از همان ابتدا شروع به نوشتن برنامه ای کنیم که محاسبات لازم را انجام می دهد و هنگامی که عدد مورد نظر را پیدا کرد آن را نمایش بدهد و برنامه خاتمه پیدا کند . چنین برنامه ای به احتمال بسیار زیاد هرگز دوباره به کار نخواهد آمد . بهتر اینست که برنامه ای بنویسیم که تا زمانی که آن را نکشته ایم ( kill کردن با فشردن همزمان دگمه های CTRL+C ) لیست کلیه اعداد اول را در خروجی استاندارد چاپ کند . سپس با استفاده از برنامه های موجود در سیستم های شبه یونیکس اقدام به پیدا کردن عدد 10001 کنیم . احتمال به کار آمدن این برنامه در آینده به مراتب بیشتر از برنامه اول است که فقط 10001 مین عدد اول را پیدا می کرد.

کد برنامه نمایش دهنده اعداد اول به شرح زیر است :

#!/usr/local/bin/perl
#
# Print prime numbers on standard input
#
use strict;
use warnings;

my ($i, $j) = (2, 2);

print "2\n";
# named block; used here for beautiful coding!
START: while ($i++) {
	$j = 2;

	while ($j <= int(sqrt($i) + 1)) {
		next START if $i % $j == 0;	
		++$j;
	}

	print $i, "\n";
}

نمونه خروجی این برنامه به گونه زیر است. تعداد خروجی برنامه را به نمایش 10 عدد محدود کرده ایم.

# perl prime.pl | head
2
3
5
7
11
13
17
19
23
29

حال برای یافتن 10001 مین عدد این لیست ، کد زیر را در خط فرمان اجرا می کنیم :

# perl prime.pl | sed -n '10001 {p;q;}'
104743

همانگونه مشاهده می کنیم 10001 مین عدد اول 104743 می باشد!

ولی کد بالا چگونه عمل می کند؟ perl prime.pl خروجی خود را در پایپ می ریزد و دستور sed محتوایی که باید بر روی آن کار کند را از پایپ می خواند. سوییچ n- به این معناست که sed نباید هیچ خروجی را بر روی صفحه نمایش چاپ کند .

'10001 {p;q;}'

یعنی هر وقت به خط 10001 رسیدی بلاک داده شده را اجرا کن . p یعنی محتوای خط را چاپ کن و q یعنی برنامه sed را Terminate کن . q و p دستورات برنامه sed هستند .

پیدا کردن کوچکترین مضرب مشترک بین اعداد یک تا بیست

می خواهیم کوچکترین مضرب مشترک بین اعداد یک تا بیست را پیدا کنیم . ساده ترین کار نوشتن برنامه ای است که در دو حلقه کار می کند . حلقه اول یکی یکی عدد را افزایش می دهد و حلقه دوم عدد ایجاد شده را به ترتیب بر 2 تا 20 تقسیم می کند و چنانچه باقیمانده همه تقسیم ها صفر شد به جواب مورد نظر دست یافته ایم . کد زیر این شیوه را پیاده سازی کرده است :

#!/usr/local/bin/perl
use strict;
use warnings;

my ($i, $div, $fl, $wl) = (0, 1, 0, 0);
my @list = (1..20);

while (1) {
	$i = $i + 1;
	$div = 1;
	$wl = $wl + 1;
	foreach my $j (@list) {
		# foreach loop counter
		$fl = $fl + 1;
		if ($i % $j != 0) {
			$div = 0;
			last;
		}
	}
	last if $div == 1;
}

print "The result is:$i\n";
print "=====================\n";
print "while loop counter: $wl\n";
print "foreach loop counter: $fl\n";

متغیر wl$ تعداد اعداد انتخاب شده جهت بررسی اینکه مضرب مشترک هستند یا نه را نشان می دهد و متغیر fl$  تعداد تقسیم های انجام گرفته جهت یافتن مضرب مشترک را نگهداری می کند.

عملکرد برنامه را به صورت زیر بررسی می کنیم:

# time perl maz.pl
The result is:232792560
=====================
while loop counter: 232792560
foreach loop counter: 648974546

real    7m9.363s
user    7m8.156s
sys     0m0.000s

مشاهده می کنید که برای رسیدن به جواب 232792560 عدد انتخاب شده و تعداد 648974546 تقسیم نیز صورت گرفته است . زمان اجرای این تکه کد 7 دقیقه است که به هیچ وجه قابل قبول نیست .

چگونه زمان اجرای برنامه را کمتر کنیم ؟

برنامه بالا بسیار ابتدایی و ساده است . اعداد را تک تک اضافه می کند و سپس اقدام به تقسیم عدد ایجاد شده بر اعداد 1 تا 20 می کند. نکات ساده زیر را در نظر بگیرید :

1. عددی بر 2 بخش پذیر است که رقم سمت راست آن زوج باشد یعنی می توانیم هنگام انتخاب عدد از روی اعداد فرد پرش کنیم و تعداد اعداد انتخابی تا جواب را نصف کنیم!
2. عددی بر 5 بخش پذیر است که رقم سمت راست آن 5 یا 0 باشد.  از انجایی که اعداد ما باید بر 2 هم بخش پذیر باشند یعنی زوج باشد پس سمت راست عدد ما می بایست منحصرا 0 باشد لذا می توانیم از روی 9 عدد پرش کنیم و مضرب بعدی 10 را انتخاب کنیم.
   
3. عددی بر 20 بخش پذیر است که سمت راست آن 00 یا 20 یا 40 یا 60 یا 80 باشد. لذا می توانیم هنگام انتخاب عدد به جای پرش از روی 9 عدد از روی 19 عدد عبور کنیم و مضرب بعدی 20 را انتخاب کنیم.

از روی نکته 3 تصمیم می گیریم اعداد را 20 تا 20 تا اضافه کنیم ولی چند مورد دیگر:

1. عددی که بر 20 بخش پذیر باشد بر 1 و  2 و 4 و 5 و 10 نیز بخش پذیر است . لذا چون عدد انتخابی ما قطعا مضرب 20 است پس مضرب این اعداد نیز می باشد. لذا این اعداد را از لیست تقسیم حذف می کنیم.
2. عددی که بر 14 بخش پذیر باشد بر 7 نیز بخش پذیر است لذا 7 را نیز از لیست تقسیم حذف می کنیم.
3. عددی که بر 16 بخش پذیر باشد بر 8 نیز بخش پذیر است لذا 8 را از لیست اعداد حذف می کنیم.
   
4. عددی که بر 18 بخش پذیر باشد بر 3 و 6 و 9 نیز بخش پذیر است. لذا این سه عدد را نیز از لیست تقسیم حذف می کنیم.

پس اعدادی که عدد مورد نظر ما باید بر آن ها بخش پذیر باشد عبارتند از:

11 12 13 14 15 16 17 18 19 20

کد برنامه را باز نویسی می کنیم :

#!/usr/local/bin/perl
use strict;
use warnings;

my ($i, $div, $fl, $wl) = (0, 1, 0, 0);
my @list = (11..19);

while (1) {
	$i = $i + 20;
	$div = 1;
	$wl = $wl + 1;

	foreach my $j (@list) {
		# foreach loop counter
		$fl = $fl + 1;
		if ($i % $j != 0) {
			$div = 0;
			last;
		}
	}
	last if $div == 1;
}

print "The result is:$i\n";
print "=====================\n";
print "while loop counter: $wl\n";
print "foreach loop counter: $fl\n";

و تست عملکرد برنامه جدید :

# time perl maz.pl
The result is:232792560
=====================
while loop counter: 11639628
foreach loop counter: 13086422

real    0m15.769s
user    0m15.724s
sys     0m0.000s

ملاحظه می فرمایید که زمان اجرای برنامه از 7 دقیقه به 15 ثانیه کاهش پیدا کرده است که فوق العاده خوب است . می توان باز هم به همین شیوه عملکرد برنامه را بهبود بخشید. مثلا اولین مضرب مشترک بین 15 و 18 عدد 90 است لذا می توان اعداد را به صورت مضارب 90 انتخاب کرد و دو عدد 15 و 18 را از لیست تقسیم حذف کرد . این عمل بر روی سیستم من زمان محاسبه را به 3 ثانیه تقلیل می دهد !

شاید بازی با اعداد به ما کمک کند تا رابطه های دیگری نیز بین این اعداد پیدا کنیم و محاسبه خود را سریعتر انجام دهیم ولی در حال حاضر من در چنین سطحی از ریاضیات قرار ندارم و احتمال بسیار زیاد هرگز نیز قرار نخواهم گرفت ! پس بهتر است برای حل مساله شیوه دیگری را نیز امتحان کنم !

جواب مساله ما قطعا مضربی از 20 می باشد لذا اعداد را 20 تا 20 تا اضافه می کنیم و بررسی می کنیم تا عدد انتخاب شده بر دو عدد اول لیست تقسیم بخش پذیر باشند . لیست تقسیم ما به صورت زیر است :

[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]

اولین عدد انتخابی ما 20 است که اتفاقا بر دو عدد اول لیست تقسیم ، بخش پذیر است . پس اولین عددی را پیدا کرده ایم که هم بر 20 و هم بر 1 و هم 2 بخش پذیر است لذا هر عدد دیگری که بر 1 و 2 و 20 بخش پذیر باشد می بایست مضربی از عدد انتخاب شده یعنی 20 باشند لذا هر سه عدد را از لیست حذف می کنیم و عدد انتخاب شده یعنی 20 را به آخر لیست تقسیم اضافه می کنیم . نسخه جدید لیست تقسیم به صورت زیر است :

[3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]

ملاحظه می کنید که لیست تقسیم ما به اندازه دو عدد کوچکتر شده است . بار دیگر آخرین عنصر لیست تقسیم ( در اینجا 20 ) را در نظر می گیریم و به دنبال اولین مضربی از آن می گردیم که بر دو عدد اول لیست تقسیم ( در اینجا 3 و   4 ) بخش پذیر باشد . عدد 60 اولین مضرب 20 است که هم بر 3 و هم بر 4 بخش پذیر است . لذا هر عدد دیگری که هم بر 3 و هم بر 4 و هم بر 20 بخش پذیر باشد می بایست مضربی از عدد 60 باشد . پس هر 3 عدد 3 و  4 و 20 را از لیست خارج می کنیم و عدد 60 را به آخر لیست اضافه می کنیم. نسخه جدید لیست تقسیم به صورت زیر است :

[5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 60]

باز هم ملاحظه می کنید که لیست تقسیم به اندازه دو عدد کوچتر شده است . همین کار را تا زمانی که در لیست تقسیم تنها یک عدد وجود داشته باشد انجام می دهیم . آن یک عدد جواب مساله ماست .

چرا عدد پیدا شده ی جدید را در بالای لیست اضافه می کنیم ؟ در هر مرحله عدد مورد نظرمان را از انتهای لیست انتخاب می کنیم و سپس اقدام به یافتن مضربی از آن عدد می کنیم که بر دو عنصر اول لیست بخش پذیر باشند . مضربی که دارای این خصوصیت باشد طبیعتا از هر سه عدد اول و دوم و آخر لیست ( و طبیعتا تمام عناصر لیست تقسیم ) بزرگتر است . لذا بعد از حذف سه عدد نامبرده شده ( اعداد اول و دوم و آخر لیست تقسیم ) ، این عدد را به عنوان آخرین عنصر لیست تقسیم اضافه می کنیم تا در مرحله بعد مضارب این عدد مورد بررسی قرار بگیرند . این کار باعث پیشروی سریعتر ما به سمت جواب خواهد شد.

مراحل کامل تغییرات لیست تقسیم تا رسیدن به جواب در زیر نشان داده شده است :

[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]
[3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]
[5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 60]
[7 8 9 10 11 12 13 14 15 16 17 18 19 60]
[9 10 11 12 13 14 15 16 17 18 19 840]
[11 12 13 14 15 16 17 18 19 2520]
[13 14 15 16 17 18 19 27720]
[15 16 17 18 19 360360]
[17 18 19 720720]
[19 12252240]
[232792560]

تکه کد پرل زیر این عملیات را پیاده سازی می کند :

#!/usr/local/bin/perl
#
# Find smallest multiple of 1 to 20
#
use strict;
use warnings;

my @arr = (1..20);

# loop counters: $owl, $iwl, $fl
my ($owl, $iwl, $fl, $i) = (0, 0, 0, 0);

print "[@arr]\n";

while (1) {
	last if $#arr == 0;
	$i = 0;
	$owl++;

	while (1) {
		$i += $arr[$#arr];
		$iwl++;
		my $div = 1;

		foreach my $j (@arr[0..1]) {
			$fl++;
			if ($i % $j != 0) {
				$div = 0;
				last;
			}
		}
		if ($div) {
			pop @arr;
			shift @arr;
			shift @arr;
			push @arr, $i;
			last;
		}
	}
	print "[@arr]\n";
}

print "=" x 52, "\nThe result is:@arr\n";
print "=======SUMMARY", "=" x 38 , "\n";
print "$owl  Times: Outer while loop\n";
print "$iwl  Times: Inner while loop\n";
print "$fl  Times: Foreach loop\n";

نتیجه اجرای این کد را ببینید :

# time perl maz2.pl
[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]
[3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]
[5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 60]
[7 8 9 10 11 12 13 14 15 16 17 18 19 60]
[9 10 11 12 13 14 15 16 17 18 19 840]
[11 12 13 14 15 16 17 18 19 2520]
[13 14 15 16 17 18 19 27720]
[15 16 17 18 19 360360]
[17 18 19 720720]
[19 12252240]
[232792560]
====================================================
The result is:232792560
=======SUMMARY======================================
10  Times: Outer while loop
84  Times: Inner while loop
96  Times: Foreach loop

real    0m0.008s
user    0m0.000s
sys     0m0.009s

ملاحظه می فرمایید که زمان اجرای برنامه به هشت هزارم ثانیه کاهش پیدا کرده است  . تعداد کل اعداد انتخاب شده جهت بررسی 84 عدد و تعداد تقسیم های صورت پذیرفته نیز 96 عدد می باشد که رقم بسیار کوچکتری نسبت به نسخه های اولیه برنامه می باشد .

نکته کوچک آنکه ابتدا برنامه perl را نوشتم و سپس اقدام به فلسفه بافی جهت توضیح برنامه کردم !

پیدا کردن بزرگترین عدد پالیندروم حاصل از ضرب دو عدد سه رقمی

همانگونه که می دانیم کلمه ای پالیندروم نامیده می شود چنانچه از ابتدا و انتها به یک صورت خوانده شود . کلماتی مثل radar و level و 9009 و hallah نمونه هایی از کلمات پالیندروم هستند .

در این پست می خواهیم بزرگترین عدد پالیندروم حاصل از ضرب دو عدد سه رقمی را پیدا کنیم . قبل از اینکه شروع به نوشتن برنامه کنیم قانونی اساسی در سیستم عامل یونیکس را به یاد بیاورید:

هر برنامه می بایست یک کار اصلی انجام دهد و حل یک مساله عبارتست از ترکیب برنامه های مختلف از طریق ارتباط ورودی/خروجی های آن ها با هم از طریق pipe و یا طرق دیگر.

برای حل مساله ابتدا برنامه ای به زبان پرل می نویسیم که کلیه اعداد 3 رقمی را در هم ضرب کند و هر حاصلضرب را در یک خط از خروجی استاندارد چاپ کند. اسم این برنامه را multiply.pl می گذاریم.

#!/usr/local/bin/perl
use strict;
use warnings;

for (my $i = 999; $i >= 100; $i--) {
	for(my $j = 999; $j >= 100; $j--) {
		print $i * $j , "\n";
	}
}

به خاطر بیاورید که قبلا برنامه ای نوشته بودیم که لیستی از کلمات را از ورودی استاندارد می خواند و سپس کلمات پالیندروم را در خروجی استاندارد چاپ می کرد ( اینجا ) . فرض کنید این برنامه را به نام pal.pl در دایرکتوری multiply.pl ذخیره کرده ایم . با استفاده از این برنامه می توانیم اعداد پالیندروم حاصل از ضرب دو عدد سه رقمی را به صورت زیر پیدا کنیم . برای جلوگیری از زیاد شدن خروجی با استفاده از دستور head تعداد نتایج را به 10 عدد محدود می کنیم .

# perl multiply.pl | perl pal.pl | head
580085
514415
906609
119911
282282
141141
853358
650056
601106
592295

اما برنامه مورد نیاز ما نکته ظریف دیگری نیز دارد. ما بزرگترین عدد پالیندروم را می خواهیم . لذا ابتدا می بایست اعداد حاصل از ضرب را به صورت نزولی سورت کنیم و سپس اقدام به یافتن بزگترین عدد پالیندروم کنیم . دستور زیر این کار را انجام می دهد.

# perl multiply.pl | sort -nr | perl pal.pl | head
906609
906609
888888
888888
886688
886688
861168
861168
855558
855558

عدد مورد نظر ما 906609 هست که بزرگترین عدد پالیندروم حاصل از ضرب دو عدد سه رقمی است.

همانطوری که مشاهده می کنید در بسیاری موارد نیازی به نوشتن برنامه برای انجام یک کار بخصوص نداریم و تنها باید قادر باشیم از برنامه های نوشته شده به خوبی استفاده کنیم.

نوشتن اعداد بر اساس حاصلضرب فاکتورهای اول آن

هر عددی را می توان بر اساس حاصلضرب مقسوم علیه های اول آن عدد نوشت . به مثالهای زیر توجه کنید :

589: 19 31
255700: 2 2 5 5 2557

می خواهیم برنامه ای بنویسیم که اعداد را از ورودی استاندارد یا از آرگومانهای فراهم شده در خط فرمان بخواند و مقسوم علیه های اول آن را پیدا کرده و خروجی به مانند بالا تولید کند . این برنامه عملیات دستور factor در سیستم های شبه یونیکس را پیاده می کند.

نکته مهم اینست که تابع find_next_prime که عدد اول بعدی را بر می گرداند علیرغم تلاش برای کاهش تعداد محاسبات هنوز کارآمد نیست . شما می توانید با داشتن دانش ریاضی و مطالعه الگوریتم های یافتن اعداد اول در اینترنت این تابع را بهینه سازی کنید .

#!/usr/local/bin/perl
#
# Mimic factor command in unix like systems :
# returns prime factors of any provided numbers
# on command line arguments or on standard input.
#
use strict;
use warnings;

# Global variable contain current prime number
# used by find_next_prime() function.
my $current_prime_number = 1;

# Find next prime number equal or greater that given number.
# Note this function is not efficient enoughly .  
sub find_next_prime {
	my $i = $current_prime_number + 1;
	my $prime;

	while (1) {
		# We assume that $i is prime number at beggining of the loop.
		$prime = 1;

		#
		# For test that a number is prime or not we must check for 
		# factors of that number in range of 2 .. sqrt(that number).
		# Obviously there are more efficient algorithmes too.
		#
		my $max = int (sqrt $i) + 1;

		# First we must find next prime number!
		for (my $j = 2; $j < $max; $j++) {
			if ($i % $j == 0) {
				# if $i % $j == 0 then $i is not prime then ...
				$prime = 0;
				last;
			}
		}
		if ($prime) {
			# $i is prime then update $current_prime_number
			$current_prime_number = $i;
			return $i;
		}

		$i++;
	}
}

sub find_factor {
	# Array to store prime factors to it.
	my @arr;
	# $number is the number we check for its prime factors.
	my $number = shift;

	# Reset $current_prime_number
	$current_prime_number = 1;
	while (1) {
		# find next prime number, it will bestored globally in $current_prime_number. 
		find_next_prime();
		# check $current_prime_number can divide $number ...
		while ($number % $current_prime_number == 0) {
			# if so push the $current_prime_number to array of calculated prime factors...
			push @arr, $current_prime_number;	
			# and update $number by dividing it to $current_prime_number.
			$number /= $current_prime_number;
		}

		# If the $number is 1 this is all done.
		last if $number == 1;
	}

	# Return the prime factors array.
	return @arr;
}

sub calc_and_print {
	my $number = shift;
	chomp $number;
	my @res = find_factor $number;
	print "$number: @res\n";
}

if (@ARGV) {
	# There is numbers provided as command line argumnets.
	while (my $c = shift) {
		calc_and_print $c;
	}
}
else {
	# No command line arguments. We must read from standard input.
	while(<STDIN>) {
		calc_and_print $_;
	}
}

نمونه استفاده از این برنامه را ببینید :

# perl fact.pl 500 9965 2588741
500: 2 2 5 5 5
9965: 5 1993
2588741: 1103 2347
# cat numbers
26541
98822214
23654141
# cat numbers | perl fact.pl
26541: 3 3 3 983
98822214: 2 3 3 3 23 251 317
23654141: 7 919 3677

مجموع عناصر زوج سری فیبوناچی کوچکتر از 4 میلیون

سری فیبوناچی دنباله ای از اعداد می باشد که با اعداد 1 و 2 شروع می شود و سپس عدد بعدی از جمع دو عدد قبل آن ایجاد می شود . دنباله اعداد زیر اولین اعداد سری فیبوناچی می باشند :

1  2  3  5  8  13  21  34  55  89  144  233

برنامه ای می نویسیم که مجموع اعداد زوج سری فیبوناچی را به شرطی که آخرین عدد حاصله کوچکتر از 4000000 باشد را بر گرداند .

#!/usr/local/bin/perl
use strict;
use warnings;

my $a = 1;
my $b = 2; 
my $c = 0;
my $sum = 2;

while (1) {
	$c  = $a + $b;
	last if ($c > 4000000);

	($a, $b) = ($b, $c);
	$sum += $c if $c % 2 == 0;
}

print "Sum of even values of Fibonacci ",
		"bellow 4000000 is: $sum\n";

خروجی برنامه به صورت زیر می باشد :

# ./fibo
Sum of even values of Fibonacci bellow 4000000 is: 4613732

پیدا کردن مجموع مضارب اعداد 3 و 5 کوچکتر از 1000

تنها نکته این برنامه اینست که اعدادی که هم مضرب 3 هستند و هم مضرب 5 می بایست تنها یکبار محاسبه شوند.

#!/usr/local/bin/perl
use strict;
use warnings;

my $i = 3;
my $s = 0;

while($i < 1000) {
	($i % 3 == 0 or $i % 5 == 0) and $s += $i;
	$i++;
}

print "Sum of multiplies of 3 and 5 bellow 1000 is: $s\n";

خروجی برنامه به صورت زیر است :

# ./3-5.pl
Sum of multiplies of 3 and 5 bellow 1000 is: 233168

فریم بندی کردن محتوای فراهم شده از فایل یا ورودی استاندارد

می خواهیم برنامه ای بنویسیم که محتوای یک یا چند فایل را بخواند و آن را به صورت فریم شده مانند زیر نمایش دهد . اگر هیچ فایل ورودی برای برنامه فراهم نشده باشد ، برنامه می بایست محتوا را از ورودی استاندارد (standard input) بخواند و همین عمل را انجام دهد .

نمونه خروجی می بایست به این صورت باشد :

**************************************************************
* total 36                                                   *
* drwxr-xr-x  2 mohsen  wheel   512B Nov 27 12:24 ./         *
* drwxr-xr-x  6 mohsen  wheel   512B Nov 25 12:45 ../        *
* -rw-r--r--  1 mohsen  wheel    30B Nov 26 21:22 b          *
* -rwxr-xr-x  1 mohsen  wheel   1.4k Nov 27 11:20 format.pl* *
* -rw-r--r--  1 mohsen  wheel   277B Nov 25 22:11 l1.pl      *
* -rw-r--r--  1 mohsen  wheel   284B Nov 25 22:50 l2.pl      *
* -rw-r--r--  1 mohsen  wheel   606B Nov 26 10:34 l3.pl      *
* -rw-r--r--  1 mohsen  wheel   348B Nov 26 12:02 l4.pl      *
* -rw-r--r--  1 mohsen  wheel   256B Nov 26 12:23 l5.pl      *
**************************************************************

تکه کد زیر این عملیات را انجام می دهد :

#!/usr/local/bin/perl
use strict;
use warnings;

# maximum length of all lines.
my $max = 0;
# store @ARGV to @arr for restoring after first traverse over @ARGV with <>.
my @arr = @ARGV;
# temp file to store data will be read from standard input.
# if no named file are provided at command line.
my $tmp_name = "$$.txt";

# if !@arr then we are reading from standard input.
# then we must open a file for writing our lines.
if (!@arr) {
	open HANDLE, ">$tmp_name" or die "Could not open temp file: $!\n";
}

while(<>) {
	chomp;
	# convert each tab character to 4 space character.
	s/\t/    /g;
	if (length > $max) {
		$max = length;
	}

	if (!@arr) {
		# Store each line in opened temporary file. 
		# We are reading from standard input.
		print HANDLE $_, "\n";
	}
}

# if !@ARGV close the opened File Handle and store
# the temporary file name in @arr to next to be restored in @ARGV;
if (!@arr) {
	close HANDLE;
	push @arr, "$tmp_name";
}

# restore @arr to @ARGV
@ARGV = @arr;
# our formating pattern require 4 more character that longest line. 
$max += 4;

# beginning to write formatted lines on standard output.
print "*" x $max, "\n";
while (<>) {
	chomp;
	# convert each tab character to 4 space character.
	s/\t/    /g;
	my $length = length;
	my $remain = $max - $length - 3;
	print "* $_";
	print " " x $remain;
	print "*\n";
}
print "*" x $max, "\n";

# if temporary file exists then delete it!
if (-e $tmp_name) {
	unlink $tmp_name or die "$!\n";
}

برنامه به صورت کامل مستند شده است . شیوه استفاده از برنامه به صورت زیر است :

# cat b
man
too
ooo
radr
baba
nan
dad
# ./format.pl b
********
* man  *
* too  *
* ooo  *
* radr *
* baba *
* nan  *
* dad  *
********
# date | ./format.pl
*********************************
* Thu Nov 27 12:41:09 IRST 2014 *
*********************************

یافتن کلمات palindrome

palindrome کلمه ایست که از ابتدا و انتها به یک صورت خوانده شود . به عنوان مثال radar و یا nan .

تکه کد زیر کلمات را از ورودی استاندارد می خواند و سپس کلمه های palindrome را در خروجی استاندارد چاپ می کند . با استفاده از سوییچ v- می توانید کلمات غیر palindrome را در خروجی استاندارد چاپ کنید .

#!/usr/local/bin/perl
#
# Read from standard input and check for
# palinrome. use -v option to check
# for non-palindrome words.
# Enter one word per line.
#
use strict;
use warnings;

# check for non-palinrome words.`
my $vflag = 0;
my $prog_name = __FILE__;

sub palindrome {
	$_ = shift @_;
	my @arr = split "", $_;

	return 0 if @arr <= 1;

	my ($i, $j) = (0, $#arr);
	
	while ($i < $j) {
		return 0 if $arr[$i] ne $arr[$j];
		$i++;
		$j--;
	}
	
	return 1;
}

#
# Usage function. Never returns.
#
sub usage {
	print STDERR "usage: $prog_name [-h -v]\n",
				"-h:show this help\n",
				"-v:show non-palindrome words\n",
				"Note: -->Read words from standard input<--\n";
	exit 1;
}

foreach (@ARGV) {
	if ($_ eq "-h") {
		usage();
		# Unreachable!
	}
	elsif ($_ eq "-v") {
		$vflag = 1;
		shift;
	}
}

my $result;
while (<STDIN>) {
	chomp;
	$result = palindrome $_;
	if ($vflag) {	
		print "$_\n" if !$result;
	}
	else {
		print "$_\n" if $result;
	}
}

 نمونه تست برنامه را مشاهده کنید :

# cat file1
man
too
ooo
radr
baba
nan
dad
# cat file1 | ./pal.pl
ooo
nan
dad
# cat file1 | ./pal.pl -v
man
too
radr
baba