diff options
| -rw-r--r-- | challenge-086/wanderdoc/perl/ch-1.pl | 53 | ||||
| -rw-r--r-- | challenge-086/wanderdoc/perl/ch-2.pl | 134 |
2 files changed, 187 insertions, 0 deletions
diff --git a/challenge-086/wanderdoc/perl/ch-1.pl b/challenge-086/wanderdoc/perl/ch-1.pl new file mode 100644 index 0000000000..26340a638a --- /dev/null +++ b/challenge-086/wanderdoc/perl/ch-1.pl @@ -0,0 +1,53 @@ +#!perl +use strict; +use warnings FATAL => qw(all); + +=prompt +You are given an array of integers @N and an integer $A. Write a script to find find if there exists a pair of elements in the array whose difference is $A. Print 1 if exists otherwise 0. +Example 1: Input: @N = (10, 8, 12, 15, 5) and $A = 7 Output: 1 as 15 - 8 = 7 +Example 2: Input: @N = (1, 5, 2, 9, 7) and $A = 6 Output: 1 as 7 - 1 = 6 +Example 3: Input: @N = (10, 30, 20, 50, 40) and $A = 15 Output: 0 +=cut + + + + + + +use Test::More; + +sub pair_diff +{ + my ($aref, $num) = @_; + @$aref = sort {$a <=> $b} @$aref; + + + my $i = 0; + + my $j = 1; + while ( $i <= $#$aref and $j <= $#$aref ) + { + if ( $aref->[$j] - $aref->[$i] == $num ) + { + return 1; + } + elsif ( $aref->[$j] - $aref->[$i] < $num or $j == $i) + { + $j++; + } + + + + else + { + $i++; + } + } + return 0; +} + + +is(pair_diff([10, 8, 12, 15, 5], 7), 1, 'Example 1'); +is(pair_diff([ 1, 5, 2, 9, 7], 6), 1, 'Example 2'); +is(pair_diff([10, 30, 20, 50, 40], 15), 0, 'Example 3'); +done_testing();
\ No newline at end of file diff --git a/challenge-086/wanderdoc/perl/ch-2.pl b/challenge-086/wanderdoc/perl/ch-2.pl new file mode 100644 index 0000000000..cc0fc64629 --- /dev/null +++ b/challenge-086/wanderdoc/perl/ch-2.pl @@ -0,0 +1,134 @@ +#!/perl +use strict; +use warnings FATAL => qw(all); + +=prompt +You are given Sudoku puzzle (9x9). +Write a script to complete the puzzle and must respect the following rules: +a) Each row must have the numbers 1-9 occuring just once. +b) Each column must have the numbers 1-9 occuring just once. +c) The numbers 1-9 must occur just once in each of the 9 sub-boxes (3x3) of the grid. +=cut + + + + + + + +use List::Util qw(first); + +my @DIGITS = (1 .. 9); +my $table; +for my $line ( <DATA> ) +{ + chomp($line); + + $line =~ tr/_/0/; + push @$table, [split(/\s/,$line,9)]; +} + +print_table($table); + +my @SOLS; +solve($table); +for my $t ( @SOLS) +{ + print_table($t); +} + + +sub solve +{ + my ($solution) = @_; + + my $nulls = first{ my $r = "@$_"; $r =~ tr/0/0/; } @$solution; + if ( !$nulls ) + { + my $s = deep_copy($solution); + + push @SOLS, $s; + } + for my $row ( 0 .. $#$solution ) + { + for my $col ( 0 .. $#{$solution->[$row]} ) + { + next unless $solution->[$row][$col] == 0; + + + for my $n ( @DIGITS ) + { + if ( allowed( $solution, $row, $col, $n ) ) + { + $solution->[$row][$col] = $n; + if ( solve( $solution ) != 0 ) + { + return $solution; + + } + $solution->[$row][$col] = 0; + } + } + return 0; + } + } +} + +sub allowed +{ + my ( $sol, $r, $c, $n ) = @_; + my $matrix_row = int($r / 3) * 3; + my $matrix_col = int($c / 3) * 3; + + return not ( + first { $_ == $n } @{$sol->[$r]} + + or + first { $_ == $n } map { $sol->[$_ - 1][$c] } @DIGITS + or + first { $_ == $n } + map { @{$_}[$matrix_col .. $matrix_col + 2] } + @{$sol}[$matrix_row .. $matrix_row + 2] + ); +} + +sub print_table +{ + my ($aoa) = @_; + for my $row ( 0 .. @$aoa ) + { + for my $col ( 0 .. $#{$aoa->[$row]} ) + { + print "$aoa->[$row][$col] "; + + + print "| " + if ( not ( ($col + 1) % 3 ) and ( ($col + 1) % 9 )); + } + print $/; + print '-' x 21, $/ + if ( not ( ($row + 1) % 3 ) and ( ($row + 1) % 9 )); + } + print $/; + +} + +sub deep_copy +{ + my $aref = shift; + my @arr; + push @arr, [@$_] for @$aref; + return [@arr]; +} + + +__DATA__ +_ _ _ 2 6 _ 7 _ 1 +6 8 _ _ 7 _ _ 9 _ +1 9 _ _ _ 4 5 _ _ +8 2 _ 1 _ _ _ 4 _ +_ _ 4 6 _ 2 9 _ _ +_ 5 _ _ _ 3 _ 2 8 +_ _ 9 3 _ _ _ 7 4 +_ 4 _ _ 5 _ _ 3 6 +7 _ 3 _ 1 8 _ _ _ |