summaryrefslogblamecommitdiffstats
path: root/SUFF.pl
blob: f82bbfc990da141a1443bbe67eb16afbf6b6628e (plain) (tree)


















































































                                                                                     
#!/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 "}";
}