Re^2: Functional shuffle

I've tried to make this excruciatingly functional. Have I got it right?

#!perl -l
use strict;
use warnings;

# Return the array, with the first and Nth elements swapped
sub swapcar {
    my ($arr, $n, $between) = @_;
    return (@$between, @$arr) if (@$arr <= 1 or $n == 0);
    my ($car1, $car2, @cdr) = @$arr;
    return (($n == 1)
           ? ($car2, @$between, $car1, @cdr)
           : swapcar([$car1, @cdr], $n-1, [@$between, $car2])
    );
}

sub FY_tail {
  my ($car, @cdr) = @_;
  return unless @cdr;
  ($car, functional_FY(@cdr));
}

sub functional_FY {
  my ($car, @cdr) = @_;
  return @cdr ? FY_tail(swapcar([@_], int rand @_, [])) : ($car);
}

print join ', ', functional_FY(my @foo = qw(a k q j 10)) for (1..5);
[download]

Some things are definitely not more intuitive in functional programming.

Update: Screwed up my swapcar horribly. Also had algorithm inverted. I think this is correct for Fisher-Yates.

Caution: Contents may have been coded under pressure.

Comment on Re^2: Functional shuffle Download Code

Replies are listed 'Best First'.
Re^3: Functional shuffle by tlm (Prior) on Apr 02, 2005 at 02:37 UTC
I think the key is to get a random element in the first position, and repeat the process (recursively) with the rest of the list. IMO the easiest way to do this without side effects is simply to do a random "cut" of the array, and generate a new array from the swapped portions: `sub maybe_functional { return unless @_; my $n = int rand @_; my @arr = ( @_[$n .. $#_], @_[0 .. $n - 1] ); return ( $arr[ 0 ], maybe_functional( @arr[ 1 .. $#arr ] ) ); }` [download] the lowliest monk	[reply] [d/l]

Replies are listed 'Best First'.

Re^3: Functional shuffle
by tlm (Prior) on Apr 02, 2005 at 02:37 UTC

I think the key is to get a random element in the first position, and repeat the process (recursively) with the rest of the list. IMO the easiest way to do this without side effects is simply to do a random "cut" of the array, and generate a new array from the swapped portions:

sub maybe_functional {
  return unless @_;
  my $n = int rand @_;
  my @arr = ( @_[$n .. $#_], @_[0 .. $n - 1] );
  return ( $arr[ 0 ], maybe_functional( @arr[ 1 .. $#arr ] ) );
}
[download]

the lowliest monk

[reply]
[d/l]