Do you have a question? Post it now! No Registration Necessary. Now with pictures!
- Subject
- Posted on
posted on
August 17, 2004, 2:40 am
August 17, 2004, 2:40 am
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 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
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
Re: Materializing an indirect sort using only swap
>my @idx = "dummy", sort 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
Re: Materializing an indirect sort using only swap
>
> >my @idx = "dummy", sort 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
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
Re: Materializing an indirect sort using only swap
On 16 Aug 2004 ctcgag@hotmail.com wrote:
>
>> 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.
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
>
>> 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.
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
Re: Materializing an indirect sort using only swap
>
> 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).
Bowsayge also tried it. It's just like you said, a b****.
This program creates a sorted array of indexes. Then it
swaps based on those indexes. It should never require more
than N swaps.
Here is the program:
if (1) {
# my (@array) = qw(16 22 5 33 45 1 9 25 45 37 26 47
# 40 48 42 30 45 33 17 26);
my @array = map int(rand(60)), (1..21);
my $cmpfn = sub { $_[0] <=> $_[1] };
print "array: @array\n";
my $cnt = sort_index_swap(\@array, $cmpfn);
print "array: @array\n";
print "swap count: $cnt\n";
}
sub sort_index_swap {
local *::objs = shift @_;
our @objs;
my $cmpfn = $_[0];
my @sortidx = sort {
$cmpfn->($objs[$a], $objs[$b])
} (0..$#objs);
my $swapcnt = 0;
foreach ($[..$#sortidx) {
my ($pri, $sec) = ($_, $sortidx[$_]);
if ($pri == $sec) { next }
($objs[$sec], $objs[$pri]) = ($objs[$pri], $objs[$sec]);
foreach (@sortidx[$pri+1..$#sortidx]) {
$_ = $sec if ($_ == $pri);
}
$swapcnt++;
}
$swapcnt;
}
--
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";
Re: Materializing an indirect sort using only swap
> 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
Re: Materializing an indirect sort using only swap
Anno Siegel said to us:
[...]
> Since @ndx is a permutation of 0 .. 24, that is the same as
>
> @arr[ @ndx] = @str;
[...]
What what d-ya-know, it works!
Thanks.
--
my (@str) = split //,'eitrhbe ta.Jw eonerl snpu';
my (@ndx, @arr) = qw(19 22 3 15 9 21 14 17 8 5 24 0 20
4 23 7 18 10 11 16 12 2 6 13 1);
@arr[ @ndx ] = @str; print @arr, "\n";
[...]
> Since @ndx is a permutation of 0 .. 24, that is the same as
>
> @arr[ @ndx] = @str;
[...]
What what d-ya-know, it works!
Thanks.
--
my (@str) = split //,'eitrhbe ta.Jw eonerl snpu';
my (@ndx, @arr) = qw(19 22 3 15 9 21 14 17 8 5 24 0 20
4 23 7 18 10 11 16 12 2 6 13 1);
@arr[ @ndx ] = @str; print @arr, "\n";
Re: Materializing an indirect sort using only swap
> 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
Re: Materializing an indirect sort using only swap
> 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 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
>
> 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 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
Re: Materializing an indirect sort using only swap
> 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 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
>
> 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 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
Re: Materializing an indirect sort using only swap
> > 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 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]
}
> >
> > 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 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]
}
Site Timeline
- » FAQ 1.3 Which version of Perl should I use?
- — Next thread in » PERL Discussions
- » Is GD library independent?
- — Previous thread in » PERL Discussions
- » s suffix question
- — Newest thread in » PERL Discussions
- » Anyone Using ESET NOD32??
- — The site's Newest Thread. Posted in » Anti-Virus Software