遍历点的问题

Perlvim

这是一个基本的关于图的算法。思路，
先将路径映射表转换成散列的散列，然后做一个遍历就 OK 了

Perlvim

#!perl

use 5.014;
use YAML qw(Dump);

my @lines = <DATA>;

say Dump(path_to_array(check_path('0', get_node_table(@lines))));

sub get_node_table {
  my @lines = @_;
  my $node_table = {};
  foreach my $line (@lines) {
    chomp $line;
    my ($node, $to) = split /\s+/, $line;
    if (exists $node_table->{$node}) {
      $node_table->{$node}{$to} = 1;
    }
    else {
      $node_table->{$node} = { $to => 1 };
    }
  }
  return $node_table;
}

sub check_path {
  my ($from, $node_table) = @_;
  my $path = { $from => 1 };
  my @nodes = ($from);
  foreach my $node (@nodes) {
    if (exists $node_table->{$node}) {
      my @sub_nodes = keys $node_table->{$node};
      push @nodes, @sub_nodes;
      my $location = $path->{$node};
      foreach my $sub_node (@sub_nodes) {
        $path->{$sub_node} = $location + 1;
      }
    }
  }
  return $path;
}

sub path_to_array {
  my $path = shift;
  my $path_list = {};
  while (my ($node, $depth) = each %$path) {
    # say "nodenode depthdepth";
    if (exists $path_list->{$depth}) {
      push @{$path_list->{$depth}}, $node;
    }
    else {
      $path_list->{$depth} = [$node];
    }
  }
  return $path_list;
}

__DATA__
0 1
0 2
1 3
1 4
2 4
2 5
3 6
4 7
4 8
5 8

Perlvim

网络太慢了，更新个帖子也不行！
在这里更新吧！

输出结果：

1. perl -w get_path.pl
   
2. ---
   
3. -
   
4.   - 0
   
5.   - 1
   
6.   - 4
   
7.   - 8
   
8. -
   
9.   - 0
   
10.   - 1
    
11.   - 4
    
12.   - 7
    
13. -
    
14.   - 0
    
15.   - 1
    
16.   - 3
    
17.   - 6
    
18. -
    
19.   - 0
    
20.   - 2
    
21.   - 4
    
22.   - 8
    
23. -
    
24.   - 0
    
25.   - 2
    
26.   - 4
    
27.   - 7
    
28. -
    
29.   - 0
    
30.   - 2
    
31.   - 5
    
32.   - 8
    
33. 
    
34. >Exit code: 0    Time: 0.547

复制代码

代码如下：

1. #!perl
   
2. 
   
3. use 5.014;
   
4. use YAML qw(Dump);
   
5. 
   
6. my @lines = <DATA>;
   
7. 
   
8. say Dump(check_path('0', get_node_table(@lines)));
   
9. 
   
10. sub get_node_table {
    
11.   my @lines = @_;
    
12.   my $node_table = {};
    
13.   foreach my $line (@lines) {
    
14.     chomp $line;
    
15.     my ($node, $to) = split /\s+/, $line;
    
16.     if (exists $node_table->{$node}) {
    
17.       $node_table->{$node}{$to} = 1;
    
18.     }
    
19.     else {
    
20.       $node_table->{$node} = { $to => 1 };
    
21.     }
    
22.   }
    
23.   return $node_table;
    
24. }
    
25. 
    
26. sub check_path {
    
27.   my ($from, $node_table) = @_;
    
28.   my $max_depth = scalar keys $node_table;
    
29.   my @path = ([$from]);
    
30.   my @end_path;
    
31.   FOREACH:
    
32.   foreach (1 .. $max_depth) {
    
33.     my @all_path = ();
    
34.     my $add_mode = 0;
    
35.     foreach my $node (@path) {
    
36.       my $end_node = $node->[-1];
    
37.       if (exists $node_table->{$end_node}) {
    
38.         $add_mode++;
    
39.         my @sub_nodes = keys $node_table->{$end_node};
    
40.         my @new_path = concat_seq_nodes($node, @sub_nodes);
    
41.         push @all_path, @new_path;
    
42.       }
    
43.       else {
    
44.         push @end_path, $node;
    
45.       }
    
46.     }
    
47.     last FOREACH if ($add_mode == 0);
    
48.     @path = @all_path;
    
49.   }
    
50.   return [@end_path];
    
51. }
    
52. 
    
53. sub concat_seq_nodes {
    
54.   my ($seq, @nodes) = @_;
    
55.   my @path = ();
    
56.   foreach my $node (@nodes) {
    
57.     push @path, [@{$seq}, $node];
    
58.   }
    
59.   return @path;
    
60. }
    
61. 
    
62. __DATA__
    
63. 0 1
    
64. 0 2
    
65. 1 3
    
66. 1 4
    
67. 2 4
    
68. 2 5
    
69. 3 6
    
70. 4 7
    
71. 4 8
    
72. 5 8

复制代码

jason680

回复 1# sinian126

how about this ...

$ perl node.pl
$VAR1 = '0, 1, 3, 6';
$VAR2 = '0, 1, 4, 7';
$VAR3 = '0, 1, 4, 8';
$VAR4 = '0, 2, 4, 7';
$VAR5 = '0, 2, 4, 8';
$VAR6 = '0, 2, 5, 8';


$ cat node.pl
#! /usr/bin/env perl
use strict;
use warnings;
use Data::Dumper qw(Dumper);

my @aData;
while(<DATA>){
  chomp;
  my($sNode, $sNext) = split;
  push @{$aData[$sNode]}, $sNext;
}

print Dumper(node_tree(0));
#print Dumper(node_tree(1));

sub node_tree{
  my($sNode) = @_;
  my @aNode;
  if(!defined @{$aData[$sNode]}){
    return $sNode;
  }
  foreach(@{$aData[$sNode]}){
    foreach my $sNext(node_tree($_)){
      push @aNode, "$sNode, $sNext";
    }
  }
  return @aNode;
}

__DATA__
0 1
0 2
1 3
1 4
2 4
2 5
3 6
4 7
4 8
5 8

   

rubyish

{:3_188:}{:3_188:}

1. #!/usr/bin/perl
   
2. my %world;
   
3. sub hello {
   
4.     my ( $h, $k ) = @_;
   
5.     return [$k] unless defined $h->{$k};
   
6.     map [ $k, @$_ ], map hello( $h->{$k}, $_ ), keys %{ $h->{$k} };
   
7. }
   
8. map { /(\d)\D+(\d)/; $world{$1}{$2} = $world{$2} } reverse <DATA>;
   
9. print join( ' - ', @$_ ) . $/ for hello \%world, 0;
   
10. 
    
11. __DATA__
    
12. 0 1
    
13. 0 2
    
14. 1 3
    
15. 1 4
    
16. 2 4
    
17. 2 5
    
18. 3 6
    
19. 4 7
    
20. 4 8
    
21. 5 8

复制代码

1. 0 - 1 - 4 - 8
   
2. 0 - 1 - 4 - 7
   
3. 0 - 1 - 3 - 6
   
4. 0 - 2 - 4 - 8
   
5. 0 - 2 - 4 - 7
   
6. 0 - 2 - 5 - 8

复制代码