use strict; use warnings; my @ary1 = qw( X0 X1 X2 Y0 Y1 Y2 ); my @ary2 = qw( X0 X1 Y0 Y1 Y2 Y3 ); my @ary3 = qw( X0 X1 X2 X3 Y0 Y1 ); my @ary4 = qw( X0 Y0 Y1 Y2 Y3 Y4 ); my @ary5 = qw( X0 X1 X2 X3 X4 Y0 ); my @buk1 = qw( X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 Y0 Y1 Y2 Y3 Y4 Y5 Y6 Y7 ); my @buk2 = qw( X0 X1 X2 X3 X4 X5 X6 X7 Y0 Y1 Y2 Y3 Y4 Y5 Y6 Y7 Y8 Y9 ); swap( \@ary1, 3 ); # aref, offset of Y0 swap( \@ary2, 2 ); swap( \@ary3, 4 ); swap( \@ary4, 1 ); swap( \@ary5, 5 ); swap( \@buk1, 10 ); swap( \@buk2, 8 ); sub swap { my ( $ary, $offset ) = @_; my $swaps = do_swaps( $ary, 0, $offset, 0 ); show( $ary, $swaps ); } sub do_swaps { my ( $ary, $offset_x, $offset_y, $swaps ) = @_; return $swaps if $offset_y == @$ary; my ( $x, $y ) = ( $offset_x, $offset_y ); my $temp; for ( $offset_x .. ( $offset_y - 1 ) ) { $y = $offset_y if $y == @$ary; $temp = $ary->[$x]; $ary->[$x] = $ary->[$y]; $ary->[$y] = $temp; $x += 1; $y += 1; $swaps += 1; } return do_swaps( $ary, $x, $y, $swaps ); } sub show { my ( $ary, $swaps ) = @_; printf "%2d swaps => %s\n", $swaps, join ' ', @$ary; } #### 3 swaps => Y0 Y1 Y2 X0 X1 X2 4 swaps => Y0 Y1 Y2 Y3 X0 X1 4 swaps => Y0 Y1 X0 X1 X2 X3 5 swaps => Y0 Y1 Y2 Y3 Y4 X0 5 swaps => Y0 X0 X1 X2 X3 X4 16 swaps => Y0 Y1 Y2 Y3 Y4 Y5 Y6 Y7 X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 16 swaps => Y0 Y1 Y2 Y3 Y4 Y5 Y6 Y7 Y8 Y9 X0 X1 X2 X3 X4 X5 X6 X7