Make every item in a list point to another item in a list, without pointing at itself. The middle part is needed for the special case where everyone has a "partner" except for the last person. In other words, in the list 1-2-3, if 1 points to 2 and 2 points to 1, then nobody can point to 3 so some swapping must be done. Inspired by the Kris Kringle node.
use strict;

my @one = (1..10); ## Sample set

my %point;
my ($x,$y);
my $total=0;
for $x (@one) {
  $total++;
  {
    ## Pick any list element but $x:
    redo while ($y = $one[rand @one]) eq $x;

    ## Special case: nobody left to point to
    if ($total==@one && !$point{$x}) { 
      $total = $point{$y}; ## Recycling $total
      $point{$y}=$x;
      $point{$x}=$total;
      last;
    }

    redo if $point{$y};
    $point{$y}=$x;
  }
}

print "$x => $point{$x}\n" while $x=$one[$x++];

[download]

Replies are listed 'Best First'.
RE: Swap-a-roo
by chromatic (Archbishop) on May 20, 2000 at 07:25 UTC
    Here's another approach. It may not be cleaner, but it's closer to the Fisher-Yates shuffle recommended in the FAQ. 
    #!/usr/bin/perl -w
use strict;

my @set = (1 .. 9);
my %point;
my ($x, $y);

# something for the last element left to point to
my $last = $set[-1];

# prime the pump
$x = pop @set;

while (@set) {
    # grab something that's left
    $y = splice @set, ((rand @set) - 1), 1;
    $point{$x} = $y;
    # do that one next
    $x = $y;
}

# take care of that straggler
$point{$x} = $last;

# and now a demo
foreach my $key (keys %point) {
    print "$key points to ", $point{$key}, "\n";
}

    [download]
[reply]
[d/l]

Back to Cool Uses for Perl