#!/usr/bin/perl use strict; my @elemente=@ARGV; die "$0 element_a element_b [[[element_d] element_c] ...]\n" if(@elemente<=1); print "Elemente: ".join('; ', @elemente)."\n"; my @liste=(); print "Variantionen A:\n"; @liste=&variants_a(@elemente); for my $ele (@liste) { print " ".join('; ',@{$ele})."\n"; } print "Variantionen B:\n"; @liste=&variants_b(@elemente); for my $ele (@liste) { print " ".join('; ',@{$ele})."\n"; } # Rekursiv Programmiert # Die Funktion ruft sich selber auf, # solange im Array noch Elemnte enthalten sind. # Zurückgeben wird immer ein Array mit anonymen Arrays darin. # # zu bemerken ist, daß die vollständige Liste # aller Variationen erst zur verfügung steht, # wenn die funktion vollstzändig durchgelaufen ist. # Dafür aber ist sie sehr schnell, verbraucht aber auch recht viel Speicher sub variants_a(@) { my (@arr) = @_; # erstes Element entfernen my $first=shift(@arr); # wenn kein Element mehr in der Liste ist, # dann gib ein Array mit zwei anonymen Arrays zurück, # welche jeweils ein Element, groß und kleingeschrieben enhalten return ([lc($first)],[uc($first)]) unless(@arr>0); # sind noch Elemnte enthalten, so rufe die Funktion nochmal auf # und übergebe das restliche Array # gehe die gesammte Rückkabe durch und ersetze jedes anonyme Array durch zwei neue, # vor die jeweils das alte anonyme Array enthalten, # plus der Groß/Kleinschreibvariante es entfernten Elementes return map { ( [lc($first),@{$_}], [uc($first),@{$_}] ) } variants_a(@arr); } # Als binärer Zähler Programmiert # jedes Element wird als "Bit" aufgefasst, # welches Zwei zusände annehmen kann. # Entweder wird es groß geschrieben (1), # oder klein geschrieben (0). # dann wird Hochgezählt. # Ein Beispiel an 3 Elemneten # 0;0;0 # 1;0;0 # 0;1;0 # 1;1;0 # 0;0;1 # 1;0;1 # 0;1;1 # 1;1;1 # # Hier steht zu jedem Zeitpunkt # eine vollständige Liste aller Elemnte # und deren aktuelle Zustände zur verfügung. # Die Funktion ist Speichersparend, # aber auch recht langsam sub variants_b(@) { my (@arr) = @_; my @ret=(); # erstmal alles kleinschreiben # (alle Bits auf 0) for my $i (@arr){ $i=lc($i); } my $lang=@arr; my $i=1; # solange nicht das gesammte Array durchlaufen wurde # weiter machen while($i<$lang) { # Jedes Element im array anstringen for($i=0; $i<$lang; $i++) { # ist ein Element klein geschrieben? (0) if(lc($arr[$i]) eq $arr[$i]) { # Element groß schreiben (1) $arr[$i]=uc($arr[$i]); # for-schleife abbrechen last; } # Element klein schreiben (0) $arr[$i]=lc($arr[$i]); } # Aktuellen Zustand des Array kopieren und als anonymes Array speichern push(@ret,[@arr]); } return @ret; }