# # Copyright (c) 2013-2019 Christian Jaeger, copying@christianjaeger.ch # # This is free software, offered under either the same terms as perl 5 # or the terms of the Artistic License version 2 or the terms of the # MIT License (Expat version). See the file COPYING.md that came # bundled with this file. # =head1 NAME FP::Array - pure functions to work with native Perl arrays =head1 SYNOPSIS use FP::List; use FP::Equal 'is_equal'; use FP::Div 'inc'; use FP::Array ':all'; is_equal array_map(*inc, [3, 4, 6]), [4, 5, 7]; is_equal list([], [3,4], [9])->map(*array_length), list(0, 2, 1); =head1 DESCRIPTION To disambiguate from similarly named functions for `FP::List`, they are prefixed with `array_`. These are also used as methods for `FP::PureArray` objects. =head1 SEE ALSO L, L =head1 NOTE This is alpha software! Read the status section in the package README or on the L. =cut package FP::Array; @ISA="Exporter"; require Exporter; @EXPORT=qw(); @EXPORT_OK=qw(array array_equal array_first array_maybe_first array_rest array_maybe_rest array_first_and_rest array_maybe_first_and_rest array_second array_ref array_ref array_length array_is_null array_set array_update array_push array_pop array_shift array_unshift array_sub array_take array_take_while array_drop array_drop_while array_append array_reverse array_xone array_perhaps_one array_hashing_uniq array_zip2 array_for_each array_map array_map_with_i array_map_with_islast array_to_hash_map array_filter array_zip array_fold array_fold_right array_join array_strings_join array_every array_any array_sum array_last array_to_hash_group_by ); %EXPORT_TAGS=(all=>[@EXPORT,@EXPORT_OK]); use strict; use warnings; use warnings FATAL => 'uninitialized'; use Carp; use Chj::TEST; use FP::Div qw(min); use FP::Ops 'add'; use FP::Equal 'equal'; sub array { [@_] } sub array_equal { my ($a, $b)= @_; @$a == @$b and do { my $len= @$a; for (my $i=0; $i< $len; $i++) { equal($$a[$i], $$b[$i]) or return 0; } 1 } } sub array_maybe_first ($) { $_[0][0] } sub array_perhaps_first ($) { my ($a)= @_; @$a ? $$a[0] : () } sub array_first ($) { my ($a)= @_; @$a or die "can't take the first of an empty array"; $$a[0] } sub array_maybe_rest ($) { my ($a)= @_; @$a ? [ @$a[1..$#$a] ] : undef } sub array_perhaps_rest ($) { my ($a)= @_; @$a ? [ @$a[1..$#$a] ] : () } sub array_rest ($) { my ($a)= @_; @$a or die "can't take the rest of an empty array"; [ @$a[1..$#$a] ] } sub array_maybe_first_and_rest ($) { my ($a)= @_; @$a ? (array_first $a, array_rest $a) : undef } sub array_first_and_rest ($) { my ($a)= @_; (array_first $a, array_rest $a) } sub array_second ($) { $_[0][1] } sub array_maybe_ref ($$) { my ($a,$i)=@_; $$a[$i] } sub array_ref ($$) { my ($a,$i)=@_; # XX also check that $i is integer? ($i >= 0 and $i < @$a) or croak "index out of bounds: $i"; $$a[$i] } TEST_EXCEPTION { array_ref [], 0 } "index out of bounds: 0"; TEST { array_ref [5], 0 } 5; TEST_EXCEPTION { array_ref [5], 1 } "index out of bounds: 1"; TEST_EXCEPTION { array_ref [5], -1 } "index out of bounds: -1"; sub array_length ($) { scalar @{$_[0]} } sub array_is_null ($) { @{$_[0]}==0 } # functional updates sub array_set ($$$) { @_==3 or croak "wrong number of arguments"; my ($a,$i,$v)=@_; my $a2= [@$a]; $$a2[$i]= $v; $a2 } sub array_update ($$$) { @_==3 or croak "wrong number of arguments"; my ($a,$i,$fn)=@_; my $a2= [@$a]; $$a2[$i]= &$fn ($$a2[$i]); $a2 } sub array_push { my $a=shift; my $a2= [@$a]; push @$a2, @_; $a2 } sub array_pop ($) { my ($a)= @_; my $a2= [@$a]; my $v= pop @$a2; ($v, $a2) } sub array_shift ($) { my ($a)= @_; my $a2= [@$a]; my $v= shift @$a2; ($v, $a2) } sub array_unshift { my $a=shift; my $a2= [@$a]; unshift @$a2, @_; $a2 } sub array_sub { my ($a,$from,$to)=@_; # incl $from, excl $to (0 <= $from and $from <= @$a) or die "from out of range: $from"; (0 <= $to and $to <= @$a) or die "to out of range: $to"; bless [@$a[$from..$to-1]], ref $a } sub array_take ($$) { my ($a,$n)= @_; array_sub $a, 0, $n } sub array_drop ($$) { my ($a,$n)= @_; array_sub $a, $n, array_length $a } sub array_take_while ($$) { my ($pred,$s)=@_; my $i=0; my $len= @$s; while (!($i>= $len) and &$pred($$s[$i])) { $i++ } [ @$s[0..$i-1] ] } sub array_drop_while ($ $) { my ($pred,$s)=@_; my $i=0; my $len= @$s; while (!($i>= $len) and &$pred($$s[$i])) { $i++ } [ @$s[$i..$#$s] ] } # various sub array_append { [ map { # @$_ nope, that's totally unsafe, will open up array-based # objects, like for example cons cells... # evil inlined `is_array` if (defined $_[0] and ref ($_[0]) eq "ARRAY") { @$_ } else { $_->values } } @_ ] } sub array_reverse ($) { my ($v)=@_; [ reverse @$v ] } sub array_xone ($) { my ($a)=@_; @$a==1 or croak "expecting 1 element, got ".@$a; $$a[0] } sub array_perhaps_one ($) { my ($a)=@_; if (@$a==1) { $$a[0] } else { () } } sub array_hashing_uniq ($;$ ) { my ($ary,$maybe_warn)=@_; my %seen; [ grep { my $s= $seen{$_}; if ($s and $maybe_warn) { &$maybe_warn($_) }; $seen{$_}=1; not $s } @$ary ] } sub array_zip2 ($$); sub array_zip2 ($$) { my ($l,$m)=@_; my @res; my $len= min(scalar @$l, scalar @$m); for (my $i=0; $i<$len; $i++) { $res[$i]= [ $$l[$i], $$m[$i] ]; } \@res } sub array_for_each ($$) { my ($fn,$v)=@_; for my $a (@$v) { &$fn ($a) } } sub array_map { @_>1 or croak "wrong number of arguments"; my $fn=shift; my $len= min (map { scalar @$_ } @_); my @res; for (my $i=0; $i<$len; $i++) { $res[$i]= &$fn (map { $$_[$i] } @_); } \@res } TEST{ array_map sub { $_[0]+1}, [1,2,20] } [ 2,3,21 ]; TEST{ array_map sub { $_[0]+$_[1]}, [1,2,20], [-1,4] } [ 0,6 ]; # (should one use multi-arg stream_map with stream_iota instead?..) sub array_map_with_i { @_>1 or croak "wrong number of arguments"; my $fn=shift; my $len= min (map { scalar @$_ } @_); my @res; for (my $i=0; $i<$len; $i++) { $res[$i]= &$fn ($i, map { $$_[$i] } @_); } \@res } TEST{ array_map_with_i sub {[@_]}, [qw(a b)], [20..40] } [[0,"a",20], [1,"b",21]]; sub array_map_with_islast { @_>1 or croak "wrong number of arguments"; my $fn=shift; my $len= min (map { scalar @$_ } @_); my $last= $len - 1; my @res; for (my $i=0; $i<$len; $i++) { $res[$i]= &$fn ($i == $last, map { $$_[$i] } @_); } \@res } TEST{ array_map_with_islast sub { $_[0] }, [1,2,20] } [ '','',1 ]; TEST{ array_map_with_islast sub { [@_] }, [1,2,20], ["b","c"] } [ ['', 1, "b"], [1, 2, "c"] ]; sub array_to_hash_map { @_>1 or croak "wrong number of arguments"; my $fn=shift; my $len= min (map { scalar @$_ } @_); my %res; for (my $i=0; $i<$len; $i++) { my @v= &$fn (map { $$_[$i] } @_); @v==2 or croak "wrong number of return values: ".show (\@v); $res{$v[0]}= $v[1]; } \%res } TEST { array_to_hash_map(sub { my($x,$a)=@_; $a=> $x*$x }, [2,3,4,5], ["a","b","c"]) } +{ 'a' => 4, 'b' => 9, 'c' => 16 }; sub array_filter ($$) { @_==2 or croak "wrong number of arguments"; my ($fn,$v)=@_; [ grep { &$fn($_) } @$v ] } sub even { not ($_[0] % 2) } TEST { array_filter \&even, [qw(1 7 4 9 -5 0)] } [ 4, 0 ]; sub array_zip { array_map \&array, @_ } TEST { array_zip [3,4], [qw(a b c)] } [[3,"a"], [4,"b"]]; # see discussion for `stream_fold` in `FP::Stream` for the reasoning # behind the argument order of $fn sub array_fold ($$$) { my ($fn,$start,$ary)=@_; for (@$ary) { $start= &$fn($_,$start); } $start } TEST{ array_fold sub{[@_]}, 's', [3,4] } [4, [3,'s']]; TEST{ require FP::List; array_fold (\&FP::List::cons, &FP::List::null, array (1,2))->array } [2,1]; sub array_fold_right ($$$) { @_==3 or croak "wrong number of arguments"; my ($fn,$tail,$a)=@_; my $i= @$a - 1; while ($i >= 0) { $tail= &$fn($$a[$i], $tail); $i--; } $tail } TEST{ require FP::List; FP::List::list_to_array (array_fold_right (\&FP::List::cons, &FP::List::null, [1,2,3])) } [1,2,3]; sub array_join ($$) { my ($ary,$val)=@_; my @res; for (@$ary) { push @res, $_, $val } pop @res; \@res } TEST{ array_join [1,2,3],"a" } [ 1, 'a', 2, 'a', 3 ]; TEST{ array_join [],"a" } []; sub array_strings_join ($$) { @_==2 or croak "wrong number of arguments"; my ($ary,$val)=@_; join $val, @$ary } TEST{ array_strings_join [1,2,3], "-" } "1-2-3"; sub array_every ($$) { my ($fn,$ary)=@_; for (@$ary) { return 0 unless &$fn($_); } 1 } TEST{ array_every sub { ($_[0] % 2) == 0 }, [ 1, 2, 3 ] } 0; TEST{ array_every sub { ($_[0] % 2) == 0 }, [ 2, 4, -6 ] } 1; TEST{ array_every sub { ($_[0] % 2) == 0 }, [ ] } 1; sub array_any ($$) { my ($fn,$ary)=@_; for (@$ary) { return 1 if &$fn($_); } 0 } TEST{ array_any sub { $_[0] % 2 }, [2,4,8] } 0; TEST{ array_any sub { $_[0] % 2 }, [] } 0; TEST{ array_any sub { $_[0] % 2 }, [2,5,8]} 1; TEST{ array_any sub { $_[0] % 2 }, [7] } 1; sub array_sum ($) { array_fold \&add, 0, $_[0] } sub array_last ($) { my ($a)= @_; $$a[-1] } sub array_to_hash_group_by ($$) { my ($ary,$on)=@_; my %res; for (@$ary) { push @{$res{&$on ($_)}}, $_ } \%res } # adapted from FP::List sub array_perhaps_find_tail ($$) { @_==2 or die "wrong number of arguments"; my ($fn, $s, )=@_; my $len= @$s; my $i= 0; LP: { if ($i >= $len) { () } else { #my ($v,$l1)= $s->first_and_rest; # ^ with efficient slice we could do it ! my $v= $$s[$i]; if (&$fn ($v)) { # $s # hmmm $s->drop($i) } else { # $s= $s1; $i++; redo LP } } } } sub array_perhaps_find ($$) { @_==2 or die "wrong number of arguments"; my ($fn, $l)=@_; if (my ($l)= array_perhaps_find_tail ($fn, $l)) { $l->first } else { () } } 1