#!/usr/bin/env perl
#
# Generate a string with the longest non-repeating subsequences possible.
# Include overlaps.
#
# Input N, size of the alphabet.
# Input T, tuples (pairs, triples, quadruples, etc.)
#
# Start with all N-length permutations.
# Create a graph of all pairs A(B...Y)Z,
#   such that every pair whose left member ends with B...Y,
#   the right member starts with B...Y (for some length n-1)
# Find an Eulerian path through the permutations (visit every node only once)
# The sequence of starting node, plus each additional ending letter,
#   is the De Bruijn sequence for this alphabet.

use strict;
use warnings;

my $n = (shift or 4);  # N for alphabet size
my $t = (shift or $n); # T for Tuples (pairs, triples, quadruples)
my $n1 = $n - 1;
my $t1 = $t - 1;

my @alphabet = ('A'..'Z','0'..'9','a'..'z');

if (@alphabet < $n) {
    die "Alphabet is smaller than $n\n";
}

# glob character of length 1
my $alphabet = '{' . join(',', @alphabet[0..$n1]) . '}';

# Generate all strings of length $t in the given alphabet
my $glob_string = $alphabet x $t;
my @nodes = glob("$glob_string");

# Generate the graph of all strings that overlap in t-1 characters.
my %graph;
for my $node1 (@nodes) {
    for my $node2 (@nodes) {
        next if $node1 eq $node2;
        # If they overlap, add node2 to the array for node1
        if (substr($node1,1,$t1) eq substr($node2,0,$t1)) {
            push @{$graph{$node1}}, $node2;
        }
    }
}

# String starts with first node's full string.
# Walk through the graph:
#   Delete the node behind
#   Add the last char of next node to string
# Print result

my $node1 = $nodes[0];
my $q = 0;
# print "$q : $node1\n"; # debug
my $string = $node1;
while (scalar keys %graph > 1) {
    my $moved = 0;
    # "reverse" here somehow "does the right thing", and enables an 
    # Eulerian circuit with no added logic.
    for my $node2 (reverse @{$graph{$node1}}) {
        if (exists($graph{$node2})) {
            $string .= substr($node2,$t1,1); # Add last char to string
            delete($graph{$node1});
            $node1 = $node2;
            $moved = 1;
#           print ++$q, " : $node2\n"; # debug
            last;
        }
    }
    # Avoid endless loops on pathological cases
    unless ($moved) {
        warn "Didn't find next node ($node1)\n";
        last;
    }
}

print "$string\n";

exit;