1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-200/#TASK1
  3 #
  4 # You are given an array of integers.
  5 #
  6 # Write a script to find out all Arithmetic Slices for the given array of integers.
  7 #
  8 ####  An integer array is called arithmetic if it has at least 3 elements and the differences between any three consecutive elements are the same.
  9 #
 10 #
 11 ### Example 1
 12 ###
 13 ### Input: @array = (1,2,3,4)
 14 ### Output: (1,2,3), (2,3,4), (1,2,3,4)
 15 #
 16 ### Example 2
 17 ###
 18 ### Input: @array = (2)
 19 ### Output: () as no slice found.
 20 
 21 ####################################################################
 22 ##
 23 ## discussion
 24 ##
 25 ####################################################################
 26 ##
 27 ## This task contains two parts:
 28 ## - find all slices of a given array with at least 3 elements
 29 ## - for each of those slices, check whether it is arithmetic
 30 ##
 31 ## In order to find all slices, we have multiple possibilities. One would be
 32 ## to walk through the array, creating all possible slices, storing them in
 33 ## an array and returning that. Another one would be to have an iterator:
 34 ## basically a function that "remembers" which slices it has already produced
 35 ## and when being called will just return the next slice. While the former is
 36 ## easier to implement, the latter works better when walking through a huge
 37 ## array where storing all slices at once would require a lot of memory.
 38 ## This also has an performance impact (even though one might argue this
 39 ## doesn't really matter: on my system, the difference of solution 1
 40 ## (1.154261 seconds) to solution 2 (0.632249 seconds) is roughly half a second
 41 ## for all 4 examples (one of which includes 200 elements in the array), but
 42 ## that's also almost a factor of 2 (but much of that is the time printing
 43 ## all of the solutions to the terminal). By removing the printing, this
 44 ## changes to 0.591356 seconds for solution 1 and 0.19912 seconds for solution
 45 ## 2; that is almost a factor of 3 at just 200 elements in the array.
 46 ## Furthermore, I get "deep recursion" warnings when running solution 1 with an
 47 ## array of 200 elements while this doesn't happen with the iterator solution
 48 
 49 use strict;
 50 use warnings;
 51 use Time::HiRes qw(gettimeofday tv_interval);
 52 
 53 my @examples = (
 54    [1, 2, 3, 4],
 55    [2],
 56    [1, 2, 3, 4, 6],
 57    [1..200]
 58 );
 59 
 60 my $t0 = [ gettimeofday() ];
 61 
 62 print "create all slices first, then keep the arithmetic ones\n";
 63 foreach my $array (@examples) {
 64    print "Array: (" . join(",", @$array) . ")\n";
 65    # get all the slices first
 66    my @slices = make_slices(@$array);
 67    # only keep the arithmetic ones
 68    my @result = grep { is_arithmetic($_, 0, scalar(@$_)-1) } @slices;
 69    if(@result) {
 70       my $first = 1;
 71       foreach my $elem (@result) {
 72          print ", " unless $first;
 73          $first = 0;
 74          print "(" . join(",", @$elem) . ")";
 75       }
 76       print "\n";
 77    } else {
 78       print "()\n";
 79    }
 80 }
 81 my $elapsed = tv_interval ( $t0, [gettimeofday()]);
 82 
 83 # given an array, return all slices
 84 sub make_slices {
 85    my @array = @_;
 86    my @result = ();
 87    return () unless $#array >= 2;
 88    # first add all slices that start at position 0
 89    foreach my $i (2..$#array) {
 90       push @result, [ @array[0..$i] ];
 91    }
 92    # then add all slices recursively that start at
 93    # later positions
 94    push @result, make_slices(@array[1..$#array]);
 95    return @result;
 96 }
 97 
 98 $t0 = [ gettimeofday() ];
 99 print "use an iterator\n";
100 # now a solution with an iterator
101 foreach my $array (@examples) {
102    my $found = 0;
103    print "Array: (" . join(",", @$array) . ")\n";
104    # get an iterator. This is a function that returns on
105    # slice on each call until all slices are produced, at
106    # which time it returns undef
107    my $iterator = make_iterator($array);
108    # call the iterator for the first time. It returns a
109    # reference to the array and the index of the first
110    # and last element of the current slice inside this array
111    my ($arr, $first_index, $last_index) = $iterator->();
112    # catch the case of an empty result
113    if($arr) {
114       # while we still get slices out of the iterator:
115       while(@$arr) {
116          # if we have an arithmetic slice, we print it
117          if(is_arithmetic($arr, $first_index, $last_index)) {
118             print ", " if $found;
119             $found++;
120             print "(";
121             foreach my $i ($first_index..$last_index) {
122                print "$arr->[$i]";
123                print "," unless $i == $last_index;
124             }
125             print ")";
126          }
127          # get the next element from the iterator for the next
128          # run of the while loop; since this returns an empty
129          # array once the iterator has produced all slices, the
130          # while loop will terminate
131          ($arr, $first_index, $last_index) = $iterator->();
132       }
133       print "\n";
134    } else {
135       print "()\n";
136    }
137 }
138 
139 my $elapsed2 = tv_interval ( $t0, [gettimeofday()]);
140 
141 print "Solution 1 took $elapsed seconds; solution 2 took $elapsed2 seconds\n";
142 
143 # the iterator generating function. It returns a reference to an
144 # anonymous function the returns the next slice as long as there are
145 # further slices; otherwise it returns an empty array
146 sub make_iterator {
147    my $array = shift;
148    # we declare the necessary variables here. They can be used in
149    # the anonymous function that we return and keep their values between
150    # calls so we can use them to iterate over the indices inside the
151    # array
152    my ($i, $j) = (0, 2);
153    return sub {
154       # once the second index variable reached the end of the array,
155       # restart with the first index variable incremented and the
156       # second index variable starting out two elements later in the
157       # array to produce slices of minumum length 3.
158       if($j >= scalar(@$array)) {
159          $i++;
160          $j=$i+2;
161          # if the second index variable is already higher than the
162          # highest index in the array, we can't produce any more
163          # slices and return the empty array as a result
164          return ([], undef, undef) if $j >= scalar(@$array);
165       }
166       # return the current slice and increment the second index variable
167       # right after that so that it's already in the right place next time
168       # the iterator is being called
169       return ($array, $i, $j++);
170    };
171 }
172 
173 # helper function to check whether a slice of a given array is arithmetic
174 # expects 3 arguments: array ref, first index to consider inside that
175 # array, and last index to consider in that array
176 # the reason we need the first and last index is that the iterator based
177 # solution always hands in the whole array without any copying, so we
178 # need to know where the slice we want to examine starts and where it ends
179 sub is_arithmetic {
180    my ($array, $first_index, $last_index) = @_;
181    return undef if $last_index - $first_index < 2;
182    my $diff = $array->[$first_index+1] - $array->[$first_index];
183    foreach my $i ($first_index..$last_index-1) {
184       if($diff != ($array->[$i+1] - $array->[$i]) ) {
185          return undef;
186       }
187    }
188    return 1;
189 }