The weekly challenge 220 - Task 2: Squareful

  1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-220/#TASK2
  3 #
  4 # Task 2: Squareful
  5 # =================
  6 #
  7 # You are given an array of integers, @ints.
  8 #
  9 ### An array is squareful if the sum of every pair of adjacent elements is a perfect square.
 10 #
 11 # Write a script to find all the permutations of the given array that are squareful.
 12 #
 13 ## Example 1:
 14 ##
 15 ## Input: @ints = (1, 17, 8)
 16 ## Output: (1, 8, 17), (17, 8, 1)
 17 ##
 18 ## (1, 8, 17) since 1 + 8 => 9, a perfect square and also 8 + 17 => 25 is perfect square too.
 19 ## (17, 8, 1) since 17 + 8 => 25, a perfect square and also 8 + 1 => 9 is perfect square too.
 20 #
 21 ## Example 2:
 22 ##
 23 ## Input: @ints = (2, 2, 2)
 24 ## Output: (2, 2, 2)
 25 ##
 26 ## There is only one permutation possible.
 27 #
 28 ############################################################
 29 ##
 30 ## discussion
 31 ##
 32 ############################################################
 33 #
 34 # This one uses a few helper functions.
 35 # 1. permutations() takes an array of integers and returns all
 36 #    possible permutations of that array as an array of
 37 #    array references
 38 # 2. uniq() takes the output of permutations() and removes
 39 #    all duplicates (which can happen if the same integer is
 40 #    in the original array more often than once)
 41 # 3. not_found() returns 1 if an array reference (given as
 42 #    first arg) doesn't point to an array that has the same
 43 #    contents as one of the following array references, and 0
 44 #    if there is already an array reference that points to an
 45 #    array with the same contents
 46 # 4. is_squareful() checks if a given array of integers is
 47 #    squareful in which case it returns 1 (otherwise 0)
 48 # The rest is easy: push each unique permutation onto the result
 49 # if it is squareful.
 50 use strict;
 51 use warnings;
 52 use Data::Dumper;
 53 
 54 squareful(1, 17, 8);
 55 squareful(2, 2, 2);
 56 
 57 sub squareful {
 58    my @ints = @_;
 59    my @result;
 60    print "Input: (" . join(", ", @ints) . ")\n";
 61    foreach my $permutation (uniq(permutations(@ints))) {
 62       push @result, $permutation if is_squareful(@$permutation);
 63    }
 64    print "Output: ";
 65    my $first = 1;
 66    foreach my $permutation (@result) {
 67       print ", " unless $first;
 68       $first = 0;
 69       print "(" . join(", ", @$permutation) . ")";
 70    }
 71    print "\n";
 72 }
 73 
 74 # We check wether an array of integers is squareful by
 75 # calculating the square root of the sum of two adjacent
 76 # numbers in the array. If that square root is the same
 77 # as it is when rounded to an integer, we have found a square
 78 # which means the array is not squareful if that's not the
 79 # case.
 80 sub is_squareful {
 81    my @ints = @_;
 82    my $result = 1;
 83    foreach my $index (0..$#ints-1) {
 84       my $root = sqrt($ints[$index]+$ints[$index+1]);
 85       return 0 unless $root == int($root);
 86    }
 87    return $result;
 88 }
 89 
 90 # produce all possible permutations recursively:
 91 # pick each element of the array as the first element for a set
 92 # of permutations, then calculate all permutations of the remainder
 93 # of the array, and push each of those with that selected first element
 94 # onto the result set
 95 sub permutations {
 96    my @array = @_;
 97    return () unless @array;
 98    my @result;
 99    foreach my $index (0..$#array) {
100       my @tmp = permutations(@array[0..$index-1], @array[$index+1..$#array]);
101       if(@tmp) {
102          foreach my $permutation (@tmp) {
103             push @result, [ $array[$index], @$permutation ];
104          }
105       } else {
106             push @result, [ $array[$index] ];
107       }
108    }
109    return @result;
110 }
111 
112 # take each array from the input and push it onto the result
113 # set if it isn't already there
114 sub uniq {
115    my @array = @_;
116    my @result = ();
117    foreach my $elem (@array) {
118       if(not_found($elem,@result)) {
119          push @result, $elem;
120       }
121    }
122    return @result;
123 }
124 
125 # if the given first array (given by reference) isn't
126 # already in the found arrays (also given by reference)
127 # we return 1, otherwise 0.
128 sub not_found {
129    my ($array_ref, @found) = @_;
130    my $elems = scalar(@$array_ref) - 1;
131    return 1 unless @found;
132    foreach my $exists (@found) {
133       foreach my $index (0..$elems) {
134          return 1 if $array_ref->[$index] != $exists->[$index];
135       }
136    }
137    return 0;
138 }