#!/usr/bin/perl -l # http://perlmonks.org/?node_id=1188292 use strict; use warnings; my $n = shift // 3; # alphabet size my $t = shift // $n; # size of tuples my @alphabet = ('A'..'Z', '0'..'9', 'a'..'z'); my %next; @next{'', @alphabet} = @alphabet; $_ = $alphabet[0] x $t; # start of string my $over = $alphabet[$n]; # outside of alphabet my $wantedlength = $n ** $t + $t - 1; while( length $_ >= $t ) { if( /^(?=(.{$t})).+\1/ ) { s/^./$next{$&}/; } elsif( s/$over(.)/$next{$1}/ ) { } elsif( $wantedlength == length $_ ) { print; # prove it is correct my %all; $all{$1}++ while /(?=(.{$t}))/g; my $count = keys %all; print "want @{[ $n ** $t ]} unique strings, have $count"; die "duplicate string" if grep $_ > 1, values %all; exit; } else { $_ = $alphabet[0] . $_; } }