Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

swap columns in a 2-dim array

by davidj (Priest)
on Jun 17, 2005 at 08:35 UTC ( #467617=perlquestion: print w/ replies, xml ) Need Help??
davidj has asked for the wisdom of the Perl Monks concerning the following question:

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

Comment on swap columns in a 2-dim array
Select or Download Code
Re: swap columns in a 2-dim array
by tlm (Prior) on Jun 17, 2005 at 08:59 UTC

    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.

    the lowliest monk

Re: swap columns in a 2-dim array
by bart (Canon) on Jun 17, 2005 at 09:45 UTC
    Silly idea, perhaps: swapping rows an AoA is dead easy. So, perhaps you could transpose your matrix, swap the rows, and transpose it back.
Re: swap columns in a 2-dim array
by BrowserUk (Pope) on Jun 17, 2005 at 10:16 UTC

    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!


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
      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.

      Flavio (perl -e 'print(scalar(reverse("\nti.xittelop\@oivalf")))')

      Don't fool yourself.

        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.


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
        "Science is about questioning the status quo. Questioning authority".
        The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
Re: swap columns in a 2-dim array
by polettix (Vicar) on Jun 17, 2005 at 10:36 UTC
    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.

    Flavio (perl -e 'print(scalar(reverse("\nti.xittelop\@oivalf")))')

    Don't fool yourself.
Re: swap columns in a 2-dim array
by tlm (Prior) on Jun 17, 2005 at 10:47 UTC

    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.

    the lowliest monk

Re: swap columns in a 2-dim array
by Forsaken (Friar) on Jun 17, 2005 at 12:03 UTC
    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).


    Remember rule one...
Re: swap columns in a 2-dim array
by TedPride (Priest) on Jun 17, 2005 at 16:21 UTC
    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; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://467617]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (11)
As of 2014-07-22 12:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (113 votes), past polls