Materializing an indirect sort using only swap

[ctcgag]

Good day, all.

I have a object which has sub-objects. The object only provides
one way to re-order sub-objects: a somewhat expensive swap operation.

I have code that does an indirect sort of the sub-objects:

my @x;
foreach my $i (1..$o->nofSub()) {
push @x, compute_value($o,$i);
};
my @idx = "dummy", sort {$x[$a]<=>$x[$b]} 0..$#x;

Now, I merely have to use @idx as a translation table so that I can access
sub-objects as if they were sorted. Works great for the most part, but
I've reached a point where that isn't good enough and I need to materialize
the sort into the object itself. So I'm trying to use the transformation
implied in @idx to apply a proper series of $o->swap($foo,$bar) operations
to put the sub-objects in order.

All the easy solutions I've come up with are about equivalent to selection
sort (O(N) swaps, O(N**2) comparisons). In this case, that will work
(because the nofSub never gets more than a few hundred), but its inelegance
and poor scaling offend me.

One solution is to add hooks into the object code to allow more efficient
re-organization, but I know that there must be a better, elegant way to do
it with just @idx and swap(). Any clues?

Thanks,

Xho

 

[Jeff 'japhy' Pinyan]

my @idx = "dummy", sort {$x[$a]<=>$x[$b]} 0..$#x;

Now, I merely have to use @idx as a translation table so that I can access
sub-objects as if they were sorted. Works great for the most part, but
I've reached a point where that isn't good enough and I need to materialize
the sort into the object itself. So I'm trying to use the transformation
implied in @idx to apply a proper series of $o->swap($foo,$bar) operations
to put the sub-objects in order.

So you basically want to take an array like

('this', 'little', 'piggie', 'went', 'to', 'market')

and use only a swap(@array, $x, $y) function to produce the same array as
if the indices were in the order (3,5,1,2,0,4)?

That is:

my @array = qw( this little piggie went to market );
my @order = qw( 3 5 1 2 0 4 );
my @new = multi_swap(\@array, \@order);
# expect: (went market little piggie this to)

Where the multi_swap() function applies a series of swap()s... is that
right? If so, let me know... I think I can work up an algorithm.

--
Jeff "japhy" Pinyan % How can we ever be the sold short or
RPI Acacia Brother #734 % the cheated, we who for every service
RPI Corporation Secretary % have long ago been overpaid?
http://japhy.perlmonk.org/ %
http://www.perlmonks.org/ % -- Meister Eckhart

 

[ctcgag]

my @idx = "dummy", sort {$x[$a]<=>$x[$b]} 0..$#x;

Now, I merely have to use @idx as a translation table so that I can
access sub-objects as if they were sorted. Works great for the most
part, but I've reached a point where that isn't good enough and I need
to materialize the sort into the object itself. So I'm trying to use
the transformation implied in @idx to apply a proper series of
$o->swap($foo,$bar) operations to put the sub-objects in order.

So you basically want to take an array like

('this', 'little', 'piggie', 'went', 'to', 'market')

and use only a swap(@array, $x, $y) function to produce the same array as
if the indices were in the order (3,5,1,2,0,4)?

That is:

my @array = qw( this little piggie went to market );
my @order = qw( 3 5 1 2 0 4 );
my @new = multi_swap(\@array, \@order);
# expect: (went market little piggie this to)

Where the multi_swap() function applies a series of swap()s... is that
right? If so, let me know... I think I can work up an algorithm.

Yes, precisely correct.

Xho

 

[Anno Siegel]

Good day, all.

I have a object which has sub-objects. The object only provides
one way to re-order sub-objects: a somewhat expensive swap operation.

I have code that does an indirect sort of the sub-objects:

my @x;
foreach my $i (1..$o->nofSub()) {
push @x, compute_value($o,$i);
};
my @idx = "dummy", sort {$x[$a]<=>$x[$b]} 0..$#x;

Now, I merely have to use @idx as a translation table so that I can access
sub-objects as if they were sorted. Works great for the most part, but
I've reached a point where that isn't good enough and I need to materialize
the sort into the object itself. So I'm trying to use the transformation
implied in @idx to apply a proper series of $o->swap($foo,$bar) operations
to put the sub-objects in order.

All the easy solutions I've come up with are about equivalent to selection
sort (O(N) swaps, O(N**2) comparisons). In this case, that will work
(because the nofSub never gets more than a few hundred), but its inelegance
and poor scaling offend me.

One solution is to add hooks into the object code to allow more efficient
re-organization, but I know that there must be a better, elegant way to do
it with just @idx and swap(). Any clues?

@idx is a permutation of the sub-object. For an optimal sequence of
swap operations, resolve the permutation into disjunct cycles.
Each cycle describes a sequence of swap operations which together
realize the permutation.

I'll bet that the algorithm Japhy has announced will amount to
exactly this.

Anno

Anno

 

[Anno Siegel]

Good day, all.

I have a object which has sub-objects. The object only provides
one way to re-order sub-objects: a somewhat expensive swap operation.

I have code that does an indirect sort of the sub-objects:

my @x;
foreach my $i (1..$o->nofSub()) {
push @x, compute_value($o,$i);
};
my @idx = "dummy", sort {$x[$a]<=>$x[$b]} 0..$#x;

Now, I merely have to use @idx as a translation table so that I can access
sub-objects as if they were sorted. Works great for the most part, but
I've reached a point where that isn't good enough and I need to materialize
the sort into the object itself. So I'm trying to use the transformation
implied in @idx to apply a proper series of $o->swap($foo,$bar) operations
to put the sub-objects in order.

All the easy solutions I've come up with are about equivalent to selection
sort (O(N) swaps, O(N**2) comparisons). In this case, that will work
(because the nofSub never gets more than a few hundred), but its inelegance
and poor scaling offend me.

One solution is to add hooks into the object code to allow more efficient
re-organization, but I know that there must be a better, elegant way to do
it with just @idx and swap(). Any clues?

@idx is a permutation of the numbers 0 .. n. For an optimal sequence of
swap operations, resolve the permutation into disjunct cycles.
Each cycle describes a sequence of swap operations which together
realize the permutation.

I'll bet that the algorithm Japhy has announced will amount to
exactly this.

Anno

 

[Anno Siegel]

Good day, all.

I have a object which has sub-objects. The object only provides
one way to re-order sub-objects: a somewhat expensive swap operation.

I have code that does an indirect sort of the sub-objects:

my @x;
foreach my $i (1..$o->nofSub()) {
push @x, compute_value($o,$i);
};
my @idx = "dummy", sort {$x[$a]<=>$x[$b]} 0..$#x;

Now, I merely have to use @idx as a translation table so that I can access
sub-objects as if they were sorted. Works great for the most part, but
I've reached a point where that isn't good enough and I need to materialize
the sort into the object itself. So I'm trying to use the transformation
implied in @idx to apply a proper series of $o->swap($foo,$bar) operations
to put the sub-objects in order.

All the easy solutions I've come up with are about equivalent to selection
sort (O(N) swaps, O(N**2) comparisons). In this case, that will work
(because the nofSub never gets more than a few hundred), but its inelegance
and poor scaling offend me.

One solution is to add hooks into the object code to allow more efficient
re-organization, but I know that there must be a better, elegant way to do
it with just @idx and swap(). Any clues?

@idx is a permutation of the numbers 0 .. n. For an optimal sequence of
swap operations, resolve the permutation into disjunct cycles.
Each cycle describes a sequence of swap operations which together
realize the permutation.

I'll bet that the algorithm Japhy has announced will amount to
exactly this.

Okay, here is my approach:

my @perm = qw( 3 5 1 2 0 4 ); # this is a single cycle
# my @perm = qw( 1 2 0 4 5 3 ); # two cycles
print "perm: @perm\n\n";

my @cycles;
while ( 1 ) {
pop @perm while @perm and $perm[ -1] == $#perm; # remove fix points
last unless @perm;
my @cyc = $#perm;
while ( ( my $el = $perm[ $cyc[ -1]]) != $cyc[ 0] ) {
push @cyc, $el;
}
$perm[ $_] = $_ for @cyc; # make these fix points
push @cycles, \ @cyc;
}
print "cycle: @$_\n" for @cycles;

This is to see if it worked:

my @array = 0 .. 5;
for my $cyc ( @cycles ) {
for ( 0 .. $#$cyc - 1 ) {
swap( \ @array, $cyc->[ $_], $cyc->[ $_ + 1]);
}
}

print "reconst: @array\n";
exit;

sub swap {
my ( $a, $i, $k) = @_;
@$a[ $i, $k] = @$a[ $k, $i]
}

 

[Jeff 'japhy' Pinyan]

Yes, precisely correct.

Sorry this took so damn long. I couldn't figure out where I was going
wrong until I realized I needed two additional arrays, not just one:

# use like so:
multi_swap($the_object, \@new_indices);

sub multi_swap {
my ($object, $o) = @_;
my @P = my @R = 0 .. $#$o;

for (0 .. $#$o) {
next if $P[$$o[$_]] == $_;
swap($object, $P[$$o[$_]], $_);
(@P[$R[$_], $$o[$_]], @R[$P[$$o[$_]], $_ ]) =
(@P[$$o[$_], $R[$_] ], @R[$_, $P[$$o[$_]]]);
}
}

# replace this as you see fit
sub swap {
my ($a, $x, $y) = @_;
@$a[$x,$y] = @$a[$y,$x];
}

I think I can explain the algorithm, but it's a bitch. It does it in one
pass, making it O(N).

--
Jeff "japhy" Pinyan % How can we ever be the sold short or
RPI Acacia Brother #734 % the cheated, we who for every service
RPI Corporation Secretary % have long ago been overpaid?
http://japhy.perlmonk.org/ %
http://www.perlmonks.org/ % -- Meister Eckhart

 

[Anno Siegel]

my (@str) = split //,'wle.oertahruenenp bits J';
my (@ndx, @arr) = qw(20 16 23 24 7 10 15 3 5 9 11 1 14
18 19 6 13 12 4 21 22 8 2 17 0);
$arr[$ndx[$_]] = $str[$_] for (@ndx); print @arr, "\n";

The first statement on the last line is the same as

@arr[ @ndx[ @ndx]] = @str[ @ndx];

Since @ndx is a permutation of 0 .. 24, that is the same as

@arr[ @ndx] = @str;

Of course, this is a Japh, so the normal rules of programming don't
necessarily apply.

Anno

Anno

 

[Anno Siegel]

my (@str) = split //,'wle.oertahruenenp bits J';
my (@ndx, @arr) = qw(20 16 23 24 7 10 15 3 5 9 11 1 14
18 19 6 13 12 4 21 22 8 2 17 0);
$arr[$ndx[$_]] = $str[$_] for (@ndx); print @arr, "\n";

The first statement on the last line is the same as

@arr[ @ndx[ @ndx]] = @str[ @ndx];

Since @ndx is a permutation of 0 .. 24, that is the same as

@arr[ @ndx] = @str;

Of course, this is a Japh, so the normal rules of programming don't
necessarily apply.

Anno