swap columns in a 2-dim array

[davidj]

Fellow monks,

The following question may sound like homework, but I assure you, it is not.

I have a situation where I need to swap columnar data in a 2-dimensional array. There are 3 conditions to the swap:
1) entire columns must be swapped (not just particular elements).
2) each column must be swapped at least once.
3) a column cannot be swapped with itself.

Here is the algorithm I am using:
1) fisher-yates an array of size equal to the number of columns.
2) in an outer loop, interate over each row in the array.
3) in an inner loop, use the two halves of the fisher-yated ( is that even a word? ) to determine the elements to swap. That is, if the fisher-yated array looks like [3,5,4,6,2,1], then effectively, col 3 and col 6 are swapped, col 5 and col 2 are swapped, and col 4 and col 1 are swapped.

What I do not like about what I have is the element-by-element swapping in the inner loop. I am concerned about the efficiency of the algorithm and whether there is a more efficient way to accomplish what I need.

code using a simple 12x12 matrix as an example:

#!/usr/bin/perl

my @cols = qw/0 1 2 3 4 5 6 7 8 9 10 11/;
fys( \@cols );

my @nums = ( [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
             [qw/01 02 03 04 05 06 07 08 09 10 11 12/],
           );
for( my $i = 0; $i < 12; $i++) {
    for( my $j = 0; $j < 6; $j++) {
        ($nums[$i][ $cols[$j] ], $nums[$i][ $cols[$j+6] ]) = ($nums[$i
+][ $cols[$j+6] ], $nums[$i][ $cols[$j] ]);
    }
}

&printit;

sub printit() {
    for( my $i = 0; $i < 12; $i++) {
        print "@{ $nums[$i] } ";
        print "\n";
    }
}

sub fys {
    my $arr = shift;
    my $i;
    for( $i = @{ $arr }; $i--;) {
        my $j = int rand ($i + 1);
        next if $i == $j;
        @$arr[$i,$j] = @$arr[$j,$i];
    }
}

output:

03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10
03 04 01 02 11 08 09 06 07 12 05 10

As always, thank you for your input,

davidj

[tlm]

You can easily modify your shuffling procedure to give you a shuffle in which no position remains fixed (this is called a derangement):

sub fys {
    my $arr = shift;
    my $i = @{ $arr };
    while ( $i ) {
        my $j = int rand $i;
        @$arr[$i,$j] = @$arr[$j,$i];
        --$i;
    }
}

With this change, then all you need to shuffle the columns is this:

@nums = map [ @{$_}[@cols] ], @nums;

The problem with this simple solution is that it cannot generate all possible derangements. For example, the modified FY misses the derangment 1,0,3,2 of 0,1,2,3.

I looked online for algorithms to fairly sample the space of all derangments of an input list, and the best I found was based on using the standard FY until a derangement is found (i.e. a rejection method). If you need to randomly sample from the space of all possible derangements of the columns, then keep your original FY procedure, but modify the creation of @cols to this:

my @cols = 0..11;
do {
  fys( \@cols );
} until is_deranged( \@cols );

where

sub is_deranged {
  my $arr = shift;
  $arr->[ $_ ] == $_ and return for 0..$#$arr;
  return 1;
}

The probability of getting a derangement from a random sample of permutations is ≈ 1/e (i.e. about three trials required per derangement, on average). Moreover, one can optimize the FY procedure around this problem (by having it automatically restart when it encounters a "trivial" swap, i.e. $i == $j), which obviates the need to have a specific rejection step. Therefore this approach has essentially the same time and space growth properties as FY.

Update: Added the stuff about fair sampling, and the rejection method for obtaining a random derangement.

[bart]

Silly idea, perhaps: swapping rows an AoA is dead easy. So, perhaps you could transpose your matrix, swap the rows, and transpose it back.

[tlm]

Update: Like the saying goes: problems worthy of attack prove their worth by biting back. Immediately after I posted the scheme below I realized that it too fails to sample all the derangements. The decomposition of a derangement I give in the description of the algorithms is incorrect. For example, it does not describe the derangement 1,2,3,0 of 0,1,2,3. The moral of the story: do the math before doing the coding :) . I am beginning to see why my (admittedly very superficial) online searches for a derangement sampling algorithm turned up nothing cleverer than a rejection method.

---

OK, below I give a first pass at a function to generate a random derangement. I think it samples all derangements fairly, but I have not verified this:

my @cols = 0..11;
randomly_derange( \@cols );
@nums = map [ @{$_}[@cols] ], @nums;

sub randomly_derange {
  my $arr = shift();
  my @i = 0..$#$arr;
  while ( @i ) {
    my @swap = map splice( @i, rand( @i ), 1 ), 1, 2;
    @{ $arr }[ @swap ] = @{ $arr }[ @swap[ 1, 0 ] ];
    last if @i == 3;
  }
  if ( @i ) {
    my @j = rand() < 0.5 ? @i[ 1, 2, 0 ] : @i[ 2, 0, 1 ];
    @{ $arr }[ @i ] = @{ $arr }[ @j ];
  }
}

Even if it is correct, I am sure that there is plenty of room for optimizing randomly_derange.

The idea behind it is this. Every derangement of a list having an even number of elements can be represented as a series of pairwise swaps. When the list has an odd number of elements, every derangement can be represented as a series of pairwise swaps, plus a 3-way derangement (consisting of a 1-rotation, left or right, of some 3-sublist of the original list). randomly_derange picks random swaps uniformly. When the list has an even number of elements, that's all there is to it. When the list has an odd number of elements, then at the end it performs one of two possible 3-way rotation of the three remaining unshuffled elements.

[BrowserUk]

Update: This matches the OPs algorithm:

#! perl -slw
use strict;
use List::Util qw[ shuffle ];

my @cols = shuffle qw/0 1 2 3 4 5 6 7 8 9 10 11/;
my @nums = map { [qw/01 02 03 04 05 06 07 08 09 10 11 12/], } 1 .. 12;
my @swapped = map{
    [ @{ $_ }[ @cols[ 6 .. 11 ] ], @{ $_ }[ @cols[ 0 ..  5 ] ] ]
} @nums;

print "@$_" for @swapped;

__END__
P:\test>467617
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09

Update2: And that can be improved (made clearer (IMO)):

#! perl -slw
use strict;
use List::Util qw[ shuffle ];

my @cols = shuffle 0 .. 11;
my @nums = map { [ '01' .. '12' ] } 1 .. 12;
my @swapped = map{
    [ @{ $_ }[ @cols[ 6 .. 11 ] ], @{ $_ }[ @cols[ 0 .. 5 ] ] ]
} @nums;

print "@$_" for @swapped;

__END__
P:\test>467617
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09
07 04 08 05 03 02 12 10 01 11 06 09

Don't!

Read more... (1312 Bytes)

[polettix]

Neither your nor my solution would meet that criteria.

OP's solution meets the criterium you're de-obfuscating (only for an even number of columns, BTW, but the example assumes this). OP performs pair swapping, assuring that each column is swapped exactly once with a peer column. I think this is also the reason why OP is speaking C-ish: s?he needs to keep control over the indexes in @cols.

[BrowserUk]

I meant my alternative reading of the criteria. That of "No column will end up in the same place". Unless I am reading his code wrong, it is possible that a given column could be swapped twice and end up in it's original position.

Indeed, if his Fischer-Yates shuffle is correct, this has to be a possibility in order to meet the fairness criteria. All possible outcomes, including a resultant where the output is in the same ordering as the input have to have equal chance.

I realise that by his original reading, swapping the order of a column twice, so that it ends up back in its original position, meets that criteria. However, the phraseology of the criteria is such, and the nature of the F_Y shuffle such, that explicitely noting it as a criteria made me consider the possibility that my alternative reading might be the true intent.

[Forsaken]

I know you're using the term "swapping" in the original post, but if the main criterium is simply that in the end not a single column is where it originally was, wouldn't a really simply approach be to move all the columns 1 to the right, where the last one folds back to become the first one? This would also account for uneven numbers of columns. If you want to make thing more interesting an option would be to create a fresh AoA, where every element is placed in column (X + amount of columns) to the right where (X + amount of columns to the right) needs to be checked against (total number of columns) and should it be greater than be reduced by (total number of columns).

[TedPride]

If you know there's going to be a large number of swaps, why not make a set of array subscripts and swap those around, then output in whatever the final order is?

use strict;
use warnings;

my (@nums, @index, $x, $y);

# CREATE MATRIX
push @nums, [1..12] for 1..12;
# CREATE INDEX
@index = (0..11);
# PERFORM RANDOM SWAPS
for (1..20) {
    $x = int rand 12;
    $y = int rand 12;
    swap(\@index, $x, $y);
}
# OUTPUT IN FINAL ORDER
for $x (0..$#nums) {
    print $nums[$y][$_].' ' for (@index);
    print "\n";
}

sub swap {
    my ($p, $x, $y) = @_;
    my $t = $p->[$y];
    $p->[$y] = $p->[$x];
    $p->[$x] = $t;
}

[polettix]

In case you don't actually need to do a shuffle (your three constraints do not mention it, only your implementation) you can consider a simple rotation (untested, perl not available at the moment, some parentheses or corrections may be needed):

push @$_, shift @$_ for @nums;

OTOH, if you actually need shuffling, note that your approach only works for an even number of columns, so you should at least arrange for a final swap between the element whose index is the last in @cols and, say, the first column. Another question that popped to my mind is why you do that half-slicing, instead of considering adjacent elements.