1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
#!/usr/bin/env perl
use strict;
use warnings;
use 5.016;
use constant DEBUG => 0;
chomp(my $str = <>);
my @suffixes = map { substr($str, $_ - 1) } 1..length($str);
my %nodes = (
node1 => {
str => '',
children => [],
},
);
my $i = 1;
my $step = 1;
SUFFIX: for my $suffix (@suffixes) {
insert($suffix, 'node1');
render_as_dot(\%nodes, $step++) if DEBUG;
}
delete $nodes{node1};
say for map { $_->{str} } values %nodes;
sub insert {
my ($str, $root) = @_;
return unless length($str);
for my $child (@{ $nodes{$root}{children} }) {
my $child_str = $nodes{$child}{str};
my @prefixes = reverse map { substr($child_str, 0, $_) }
1..length($child_str);
for my $prefix (@prefixes) {
if ($str =~ s/^\Q$prefix//) {
$child_str =~ s/^\Q$prefix//;
$nodes{$child}{str} = $prefix;
if (@{ $nodes{$child}{children} } && length($child_str)) {
my $new_node = 'node' . ++$i;
$nodes{$new_node} = {
str => $child_str,
children => $nodes{$child}{children},
parent => $child,
};
$nodes{$child}{children} = [$new_node];
$nodes{$_}{parent} = $new_node
for @{ $nodes{$new_node}{children} };
}
else {
insert($child_str, $child);
}
insert($str, $child);
return;
}
}
}
my $new_node = 'node' . ++$i;
push @{ $nodes{$root}{children} }, $new_node;
$nodes{$new_node} = {
str => $str,
children => [],
parent => $root,
};
}
sub render_as_dot {
my ($graph, $step) = @_;
open my $fh, '>', "step$step.dot" or die "Couldn't open step$step.dot: $!";
say $fh "graph step$step {";
for my $node (keys %$graph) {
next unless $nodes{$node}{parent};
say $fh " $nodes{$node}{parent} -- $node [label=\"$nodes{$node}{str}\"];";
}
say $fh "}";
}
|