File Coverage

blib/lib/DoubleBlind.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	9	10	90.0
condition	4	5	80.0
subroutine	6	6	100.0
pod	1	3	33.3
total	60	64	93.7

package DoubleBlind;

use 5.005;
use strict;

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use DoubleBlind ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(

) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(

);

$VERSION = '0.01';

# Preloaded methods go here.

sub shuffle ($;$) {
  my ($n, $s) = (shift, shift);
  defined $s or $s = 1;
  my @out = ($s .. $s+$n-1);
  while ($n) {	# Unshuffled stuff is at indices 0..$n-1
    my $pick = int rand $n--;
    @out[$n, $pick] = @out[$pick, $n];
  }
  \@out;
}

# A good number is: square between 3000000 and 9999999, it has no zeros,
# digits (up to 0.001) are repeated no more than twice,
# last N digits of the square are as requested, fractional part of the
# square is between 0.2 and 0.8 (to avoid rounding errors)

sub good_number ($;$) {
  my ($targ, $N) = (shift, shift);
  defined $N or $N = 1;
  my $s = 1 + int sqrt 3000000;
  my $e = int sqrt 9699999;
  my $R = int(0.5 + 10**$N);
 picking:
  { my $pick = sprintf '%.3f', $s + rand $e - $s;
    redo if $pick =~ /0/;
    my $a = $pick**2;
    my $f = $a - int $a;
    redo if $f < 0.2 or $f > 0.8;
    #warn "T $pick ==> $a\n";
    my $ai = int $a;
    redo unless $ai - $R*int($ai/$R) == $targ;
    #warn "Try $pick ==> $a\n";
    my %seen;
    ++$seen{$_} <= 2 or redo picking for split //, $pick;
    #warn "Got $pick ==> $a\n";
    return $pick;
  }
}

sub process_shuffled ($$$) {
  my ($callback, $c, $start) = (shift,shift,shift);
  #defined $start or $start = ($c =~ /^10+$/ ? 0 : 1);
  my $len = length($start + $c - 1);
  my $l = shuffle $c, $start;
  for my $n (0..$#$l) {
    my $label = good_number $l->[$n], $len;
    $callback->($n+1, $l->[$n], $label);
  }
  $l = $start + $c - 1;
  <
$c items generated.  Each item numbers has a "secret" id ($start to $l),
and a "public" label (which is a number about 2000 with 3 digits after
the decimal dot - or the decimal comma).  To extract the id from the label,
calculate the square of the label, and take the last $len digits before the
decimal dot (or the decimal comma).
EOD
}


1;
__END__