Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re: Reconstructing List Order From Partial Subsets

by ruoso (Curate)
on Jul 26, 2006 at 17:50 UTC ( [id://563847]=note: print w/replies, xml ) Need Help??


in reply to Reconstructing List Order From Partial Subsets

I need an algorithm for determining the order of a list of items, based on their occurrence in a file, without knowing the elements of the list ahead of time.

Well... as you asked to do it without knowing it ahead of time... This is my shot, you can stop feeding it anytime and it will give the order stablished until then.

#!/usr/bin/perl use strict; use warnings; use List::MoreUtils 'first_index'; my @terms = (); # Instructions my @list = (); # AoA my $last = undef; # last read. while (my $line = <STDIN>) { chomp($line); # We need to reprocess all instructions to keep old orders push @terms, $line; foreach my $item (@terms) { if ($item eq 'Start') { # nothing before start. $last = undef; next; } my ($last_position,$item_position); if (defined $last) { ($last_position) = grep { grep { $_ eq $last } + @{$_} } @list; } ($item_position) = grep { grep { $_ eq $item } @{$_} } + @list; if ($last_position && !$item_position) { my $idx = first_index { $_ == $last_position } + @list; $list[$idx+1] ||= []; push @{$list[$idx+1]}, $item; } elsif ($last_position && $item_position) { my $idx = first_index { $_ == $last_position } + @list; my $idx2 = first_index { $_ == $item_position +} @list; if ($idx == $idx2) { # disambiguation my $idx = first_index { $_ == $last_po +sition } @list; @{$last_position} = grep { $_ ne $item + } @{$last_position}; $list[$idx+1] ||= []; push @{$list[$idx+1]}, $item; } elsif ($idx > $idx2) { # complex disambiguation @{$item_position} = grep { $_ ne $item + } @{$item_position}; $list[$idx+1] ||= []; push @{$list[$idx+1]}, $item; } } elsif (!$last_position && !$item_position) { $list[0] ||= []; push @{$list[0]}, $item; } $last = $item; } } my @ambiguous = grep {defined $_->[1]} @list; if (@ambiguous) { warn 'Ambiguous items: '.join ', ', map { join '|', @{$_} } @a +mbiguous; } print join ', ', map { join '|', @{$_} } @list; print "\n";
daniel

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://563847]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (7)
As of 2024-04-18 12:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found