#!/usr/bin/perl -w
use strict;

# Kann bei $nackt=1 von './mkhtml' aufgerufen werden.

#
# Ermittelt, wieviele verschiedene Varianten es gibt,
# "Das ist das Haus vom Nikolaus" zu zeichnen.
#
# Ergebnisse:
#    - Es gibt 88 Varianten.
#    - Wenn man Spiegelbilder herausrechnet, bleiben von 88 nur 44.
#    - Wenn man Inverse (dieselbe Strecke, aber in umgekehrter Richtung)
#      herausrechnet, bleiben von 88 nur 44.
#    - Das Hinauswerfen der Spiegelbilder hat denselben Effekt wie
#      das Hinauswerfen der Inversen. Beide Methoden nacheinander
#      anzuwenden, bringt keine weitere Reduktion.
#      (Das hatte ich intuitiv nicht erwartet!)
#

### Konfiguration
my $spaltenzahl = 4;
my $verbose = 1;  # Einzelne Phasen ausgeben?
my $nackt = 1;    # Wohlformatiert ausgeben oder einfach untereinander weg?

### Initialisierung
$verbose = $verbose && ! $nackt;
my (@gut, @nachbarn);
foreach (qw/134 0234 13 0124 013/) {push @nachbarn,[split(//,$_)]}
my @umbruch = split(//,"\n".(" "x($spaltenzahl-1)));

### Allgemeine Funktionen
sub raus {
    my $ueberschrift = shift @_;
    if ($nackt) {
        print join("\n",@_)."\n"
    }
    else {
        print "\n";
        print "$ueberschrift:\n" if $verbose;
        my $i = 0;
        foreach (sort @_) {
            printf("%2d %8s |%s",++$i,$_,$umbruch[$i%$spaltenzahl])
        }
        print "\n" if $umbruch[$i%$spaltenzahl] ne "\n";
    }
}

### Erste Stufe: Alle Varianten finden
foreach (0..4) {&weiter($_,"$_",1)}
sub weiter {
    my ($dieser,$bislang) = @_;
    return push @gut,$bislang if 9==length($bislang);
    foreach (@{$nachbarn[$dieser]}) {
        my $jetzt = "$bislang$_";
        next if $jetzt =~ m/$dieser$_./;  # Nicht denselben Weg zweimal gehen
        next if $jetzt =~ m/$_$dieser/;   # Nicht denselben Weg zurueckgehen
        &weiter($_,$jetzt);
    }
}
&raus("Phase 1",@gut) if $verbose;

### Zweite Stufe: Duplikate rauswerfen. Abbruch, wenn welche gefunden werden
my %gut;
foreach (@gut) {$gut{$_}++}
foreach (keys %gut) {die "$_ stritt $gut{$_}mal auf.\n" if $gut{$_}!=1}
print "\nPhase 2:\nAlles gut, keine Duplikate gefunden.\n" if $verbose;

### Dritte Stufe: Inverse rauswerfen
my @gut2;
DREI:
while (@gut) {
    my $dings = reverse(shift @gut);
    foreach (@gut) {next DREI if $dings eq $_}
    push @gut2,$dings;
}
&raus("Phase 3",@gut2) if $verbose;

### Vierte Stufe: Spiegelbilder rauswerfen
my @gut3;
VIER:
while (@gut2) {
    my $dings = sprintf("%09d",444444444 - (shift @gut2));
    foreach (@gut2) {next VIER if $dings eq $_}
    push @gut3,$dings;
}
&raus("Phase 4",@gut3);
print "\n" if !$nackt;