Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Re^2: Looking for the first item in the chain

by vagabonding electron (Curate)
on Aug 10, 2014 at 12:37 UTC ( #1096907=note: print w/replies, xml ) Need Help??

in reply to Re: Looking for the first item in the chain
in thread Looking for the first item in the chain

Thank you Laurent_R ! However the raw data does not exists as "chains". It is in a table where each row presents the number and the previous number. I just showed the chains in the commented lines to illustrate the problem. The chain building is very interesting itself however and can be useful in this project too. Cristoforo shows an example below. Thank you for the idea.

  • Comment on Re^2: Looking for the first item in the chain

Replies are listed 'Best First'.
Re^3: Looking for the first item in the chain
by Laurent_R (Canon) on Aug 10, 2014 at 14:02 UTC
    OK, vagabonding electron, sorry that I misunderstood your requirement, I thought the chains were the input. This a quick (probably not optimal) way to do it with your actual source data:
    use strict; use warnings; use Data::Dumper; my %predec; while (<DATA>) { chomp; my ($succ, $pred) = split /;/, $_; $pred = $succ if $pred eq ''; push @{$predec{$pred}}, $succ; } my $continue = 1; while ($continue) { $continue = 0; for my $pred (keys %predec) { my $succ = @{$predec{$pred}}[-1]; if (defined $succ and exists $predec{$succ} and scalar @{$pred +ec{$succ}} != 0) { next if $succ eq $pred; push @{$predec{$pred}}, @{$predec{$succ}}; delete $predec{$succ}; $continue = 1; } $succ = @{$predec{$pred}}[0]; if (defined $succ and exists $predec{$succ} and scalar @{$pred +ec{$succ}} != 0) { unshift @{$predec{$pred}}, @{$predec{$succ}}; delete $predec{$succ}; $continue = 1; } } } print "Data structure: \n", Dumper \%predec; print "\n\nResult:\n\n"; for my $key (keys %predec) { next if scalar @{$predec{$key}} == 0; print "$key => $key\n" and next if $key eq @{$predec{$key}}[0]; print "$key => $key\n"; print "$_ => $key\n" for @{$predec{$key}}; } __DATA__ 567;456 456;345 345;234 234;123 339;228 228;117 131; 435;324 324;213 372;
    This will print the following:
    $ perl Data structure: $VAR1 = { '123' => [ '234', '345', '456', '567' ], '131' => [ '131' ], '234' => [], '213' => [ '324', '435' ], '345' => [], '324' => [], '372' => [ '372' ], '117' => [ '228', '339' ] }; Result: 123 => 123 234 => 123 345 => 123 456 => 123 567 => 123 131 => 131 213 => 213 324 => 213 435 => 213 372 => 372 117 => 117 228 => 117 339 => 117
    This seems to be what you want, except that the lines are not printed out in the same order as your example. If the order matters, it should be quite simple to sort the lines in the desired order.

      Thank you very much Laurent_R , now I need a bit time to study your code, especially to internalize the flag system with $continue. I like the idea to instantly make the chains with push @{$predec{$pred}}, $succ; Thank you for your time.

        The $continue variable is just there to control the while loop. The idea is that you have to iterate on a data structure an unknown number of times. So long as you make a change, it means that further changes might be needed. But it you did not need to make any change, then you are guaranteed that you will not need to make any further changes. So you set $continue to true (1) before the loop, to make sure you enter the loop at least once. Then, you immediately set it to false (0). And, if you had to make any change, you set it to true (1), because you might have to iterate once more. But if you didn't need to make any change, then you are done, all the required changes have been done.

        Another monk previously called the same variable "changes" in another answer to this thread, but $changes and $continue have essentially the same purpose.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2022-12-03 23:29 GMT
Find Nodes?
    Voting Booth?

    No recent polls found