#!/usr/bin/perl -w
use strict;
# This code written by Mark Jason Dominus (mjd@plover.com) on
# 2001-11-05 08:18:26 PST in his reply to my newsgroup post "Help with a
# tough algorithm" on comp.lang.perl.misc (the usenet thread in its entirety
# is included below this code for your reference)
# Thanks Mark :O)
sub make_strings {
my @alphabet = split //, shift();
my $length = shift;
my @odometer = (0) x $length;
my $FINISHED = 0;
return sub {
return if $FINISHED;
my $string = join '', @alphabet[@odometer];
my $i;
for ($i = $#odometer; $i >= 0; --$i) {
++$odometer[$i];
if ($odometer[$i] > $#alphabet) {
$odometer[$i] = 0;
} else {
last;
}
}
if ($i < 0) {
$FINISHED = 1;
}
return $string;
}
}
# This function manufactures an iterator object:
my $obj = make_strings('abcd', 3); # 3 is the length
# The iterator object will produce a different string each time you call it:
my $next_string = $obj->(); # that's how you get the next string
for (1.. 10) {
print $obj->(); # print ten more strings
}
# get all the rest of the strings
while (defined(my $s = $obj->())) {
# do something with $s
}
# -----==// QUOTED NEWSGROUP THREAD FOLLOWS //==--------------------------
__END__
From: comp.lang.perl.misc@atrixnet.com (Tommy Butler)
Newsgroups: comp.lang.perl.misc
Subject: Help with a tough algorithm
Date: 31 Oct 2001 20:12:13 -0800
Organization: http://groups.google.com/
Lines: 43
Message-ID: <22bcd918.0110312012.15416541@posting.google.com>
NNTP-Posting-Host: 216.138.80.23
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: 8bit
X-Trace: posting.google.com 1004587933 7160 127.0.0.1 (1 Nov 2001 04:12:13 GMT)
X-Complaints-To: groups-abuse@google.com
NNTP-Posting-Date: 1 Nov 2001 04:12:13 GMT
Can somebody help me out with an algo?
I'm trying to get a six-character string *in stepped sequence* from the array of
possible unique six-character strings for the character class of [a-zA-Z0-9_].
I need to make sure that I don't skip over any possibilities in the array of
possibilities, so I think that once the stepped sequence of the algo has reached
the last possible index before @#possibilities (<-- Perl syntax meaning the last
array element in my list of possible strings) it needs to recognize that the
next element to be retrieved from the array is the value of its incremented step
plus one. (Maybe the shift isn't necessary if the array length is a uneven
number?)
Obviously this means that the algo must keep track of its its current position
in the array, and make sure not to use any previously retrieved elements by
noting its current index, the length of the array, and the value of its
incremented step. At this point that shift over the array elements of (step+1)
must occur.
I can't just start popping or splicing elements out of the array to do this with
a simple process of elimination (unless I keep track of the indices of all the
elements that got spliced out of the array, I guess). Keep in mind that this
retrieval of unique 6-char strings must occur between non-persistent
cgi-sessions in order to assign website visitors one of these unique numbers as
a product serial number.
The way I've been planning to track the current position of the algorithm in the
array between sessions is to use a simple flat-file database containing only the
integer representative of the array index where the algo left off after the
previous cgi-session ended.
Any ideas? I thought it would be a fun brain buster to toss out for
everyone :o)
- Tommy Butler,
Internet Strategies, Inc. º ° º Everything is Possible.
web http://istrat.com
email mailto:tommy@istrat.com
tel 2 1 4 . 3 9 3 . 1 0 0 0 ext207
fax 8 0 0 . 3 0 7 . 8 1 0 5
2200 North Lamar, Suite 307 º ° º Dallas, TX 75202
From: trammell@haqq.hypersloth.invalid (John J. Trammell)
Newsgroups: comp.lang.perl.misc
Subject: Re: Help with a tough algorithm
References: <22bcd918.0110312012.15416541@posting.google.com>
Message-ID: <slrn9u1pun.qd3.trammell@haqq.el-swifto.com>
User-Agent: slrn/0.9.6.2 (Linux)
Date: Wed, 31 Oct 2001 23:24:20 -0600
Lines: 14
NNTP-Posting-Host: 13ba096e.news.real-time.com
X-Trace: 1004595206 gemini.real-time.com 436 65.165.41.161
X-Complaints-To: abuse@real-time.com
On 31 Oct 2001 20:12:13 -0800, Tommy Butler wrote:
> I'm trying to get a six-character string *in stepped sequence*
> from the array of possible unique six-character strings for the
> character class of [a-zA-Z0-9_].
Booya!
#!/usr/bin/perl -lp
BEGIN {use integer;@f=('A'..'Z','a'..'z',0..9,"_");
sub x{!(caller(5))&&($_[0]%@f,x($_[0]/@f))}}
s/$_/reverse map($f[$_],x($_))/e;
Anybody got any more of that sweet sweet sweet Halloween candy? :-)
From: Kirk Herlitz <kherlitz@mindcast.com>
Newsgroups: comp.lang.perl.misc
Subject: Re: Help with a tough algorithm
Date: Thu, 01 Nov 2001 10:41:42 -0800
Organization: Mindcast
Message-ID: <3BE19766.F7304FBC@mindcast.com>
X-Mailer: Mozilla 4.78 [en] (X11; U; Linux 2.4.8-26mdk i686)
X-Accept-Language: en
MIME-Version: 1.0
References: <22bcd918.0110312012.15416541@posting.google.com>
<slrn9u1pun.qd3.trammell@haqq.el-swifto.com>
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Complaints-To: newsabuse@supernews.com
Lines: 20
Yeah, I was gonna say that it sounded like a perfect scenario for
recursion, but I don't know if I could have come up with a short and
sweet solution... Very nice...
"John J. Trammell" wrote:
>
> On 31 Oct 2001 20:12:13 -0800, Tommy Butler wrote:
> > I'm trying to get a six-character string *in stepped sequence*
> > from the array of possible unique six-character strings for the
> > character class of [a-zA-Z0-9_].
>
> Booya!
>
> #!/usr/bin/perl -lp
> BEGIN {use integer;@f=('A'..'Z','a'..'z',0..9,"_");
> sub x{!(caller(5))&&($_[0]%@f,x($_[0]/@f))}}
> s/$_/reverse map($f[$_],x($_))/e;
>
> Anybody got any more of that sweet sweet sweet Halloween candy? :-)
Newsgroups: comp.lang.perl.misc
Subject: Re: Help with a tough algorithm
References: <22bcd918.0110312012.15416541@posting.google.com>
<slrn9u1pun.qd3.trammell@haqq.el-swifto.com>
Organization: Plover Systems Co.
From: mjd@plover.com (Mark Jason Dominus)
Message-ID: <3be6bbcd.638b$9b@news.op.net>
X-OpNet-Trace: news1.op.net 1004977101 25483.155 plover.com i/quentin c/local
Lines: 72
Date: Mon, 05 Nov 2001 16:18:22 GMT
NNTP-Posting-Host: 207.29.195.22
X-Complaints-To: Abuse Role <abuse@op.net>, We Care <abuse@newsread.com>
X-Trace: newshog.newsread.com 1004977102 207.29.195.22 (Mon, 05 Nov 2001 11:18:22 EST)
NNTP-Posting-Date: Mon, 05 Nov 2001 11:18:22 EST
In article <slrn9u1pun.qd3.trammell@haqq.el-swifto.com>,
John J. Trammell <trammell@haqq.hypersloth.invalid> wrote:
>On 31 Oct 2001 20:12:13 -0800, Tommy Butler wrote:
>> I'm trying to get a six-character string *in stepped sequence*
>> from the array of possible unique six-character strings for the
>> character class of [a-zA-Z0-9_].
>
>Booya!
>
>#!/usr/bin/perl -lp
>BEGIN {use integer;@f=('A'..'Z','a'..'z',0..9,"_");
>sub x{!(caller(5))&&($_[0]%@f,x($_[0]/@f))}}
>s/$_/reverse map($f[$_],x($_))/e;
Yow! 62523502209 lines of printed output. I know *I'm* scared.
Try this:
sub make_strings {
my @alphabet = split //, shift();
my $length = shift;
my @odometer = (0) x $length;
my $FINISHED = 0;
return sub {
return if $FINISHED;
my $string = join '', @alphabet[@odometer];
my $i;
for ($i = $#odometer; $i >= 0; --$i) {
++$odometer[$i];
if ($odometer[$i] > $#alphabet) {
$odometer[$i] = 0;
} else {
last;
}
}
if ($i < 0) {
$FINISHED = 1;
}
return $string;
}
}
This function manufactures an iterator object:
my $obj = make_strings('abcd', 3); # 3 is the length
The iterator object will produce a different string each time you call it:
my $next_string = $obj->(); # that's how you get the next string
for (1.. 10) {
print $obj->(); # print ten more strings
}
# get all the rest of the strings
while (defined(my $s = $obj->())) {
# do something with $s
}
Since you can't possibly use 62.5 billion strings, this is the only
method that makes sense. Any method that tries to generate all the
62523502209 strings in advance is doomed.
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
From: Benjamin Goldberg <goldbb2@earthlink.net>
Newsgroups: comp.lang.perl.misc
Subject: Re: Help with a tough algorithm
Date: Tue, 06 Nov 2001 19:27:21 -0500
Lines: 57
Message-ID: <3BE87FE8.6AB06D0E@earthlink.net>
References: <22bcd918.0110312012.15416541@posting.google.com>
NNTP-Posting-Host: dialup-209.246.72.159.dial1.newyork1.level3.net (209.246.72.159)
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Trace: fu-berlin.de 1005092621 35457855 209.246.72.159 (16 [87109])
X-Mailer: Mozilla 4.04 [en] (Win95; I)
Tommy Butler wrote:
>
> Can somebody help me out with an algo?
>
> I'm trying to get a six-character string *in stepped sequence* from
> the array of possible unique six-character strings for the character
> class of [a-zA-Z0-9_].
[snip]
> The way I've been planning to track the current position of the
> algorithm in the array between sessions is to use a simple flat-file
> database containing only the integer representative of the array index
> where the algo left off after the previous cgi-session ended.
Your problem statement is a bit confusing. I *think* you are asking us
how to do one of two things [I'm not sure which you're asking].
Possibility one:
How do I count, in base 63, from aaaaaa to ______ [that is, in decimal
from 0..63**6-1, but outputting in base 63]... that is, unique meaning
that no number is printed twice.
This is relatively simple.
use Fcntl qw(:flock);
open( my($counter), "<+", "counter" ) or die $!;
flock $counter, LOCK_EX or die $!;
$_ = read( $counter, (my $buffer = "\0" x 6), 6 );
$_ == 0 || $_ == 6 or die $!;
seek( $counter, 0, 0 ) or die $!;
for( 0..5 ) {
last if ++vec( $buffer, $_, 8 ) < 63;
vec( $buffer, $_, 8 ) = 0;
}
print $counter $buffer or die $!;
close $counter or die $!;
$buffer =~ tr/\000-\076/a-zA-Z0-9_/;
print scalar(reverse($buffer)), "\n";
Possibility two:
Like the above, but with the requirement that no digits be repeated
within any 6-digit string.
for( 0..5 ) {
last if ++vec( $buffer, $_, 8 ) < (63-$_);
vec( $buffer, $_, 8 ) = 0;
}
print $counter $buffer or die $!;
close $counter or die $!;
my @x = ('A'..'Z','a'..'z',0..9,"_");
print reverse map splice(@x, vec($buffer, $_, 8), 1), 0..5;
print "\n";
NB: This code is untested.
If I'm misinterpreting 'unique' in your requirements, please say so.
--
Klein bottle for rent - inquire within.