Quantum-Superpositions-2.03/0002755000200000020030000000000013320472147015073 5ustar lembarkdevQuantum-Superpositions-2.03/demo/0002755000200000020030000000000013320472147016017 5ustar lembarkdevQuantum-Superpositions-2.03/demo/demo_Max.pl0000755000200000020000000000044307603000352020733 0ustar lembarklembark#!/usr/local/bin/perl -sw use Quantum::Superpositions; my @nums = (1..10); print "min: ", (any(@nums) <= all(@nums)), "\n"; print "max: ", any(@nums) >= all(@nums), "\n"; print "New max: ", eigenstates (any(@nums) >= all @nums), "\n"; print "New min: ", (any(@nums) <= all @nums), "\n"; Quantum-Superpositions-2.03/demo/demo_Primes.pl0000755000200000020000000000207307645144365021471 0ustar lembarklembark#!/usr/local/bin/perl -w use Quantum::Superpositions; use Benchmark; my $count = shift || 1000; print "\nTiming prime generated for primes from 1..$count."; print "\nTimings are displayed for groups of 10 primes."; print "\nVERSION = $Quantum::Superpositions::VERSION"; my $numprime = 0; my $last = Benchmark->new; # primes are either the number 2 or any value with # all the values in the range range of (2..sqrt(number)+1) # all having a module with the number. # # for example, 29 is prime because 29 % all(2..6) != 0 is # true. # # or: 29 % 2, 29 % 3 ... 29 % 6 all have a remainder. sub is_prime { $_[0]==2 || $_[0] % all(2..sqrt($_[0])+1) != 0 } # print the time to generate every 10th prime. # cumulative times help average out fluctuations # due to clustering of primes. for( 1..$count ) { next unless is_prime( $_ ); next if ++$numprime % 10; # recycling $this avoids benchmarking the print # and Benchmark calls. my $this = Benchmark->new; print "\n$_\t$numprime\t", timestr( timediff($this, $last) ); $last = $this; } print "\n\n"; 0 __END__ Quantum-Superpositions-2.03/demo/demo_Odder.pl0000755000200000020000000000026307603000352021243 0ustar lembarklembarksub odder { grep($_%2, split "", $_[0]) > grep($_%2, split "", $_[1]); } use Quantum::Superpositions BINARY_LOGICAL => ['main::odder']; print odder(any(1234,2468), 666), "\n"; Quantum-Superpositions-2.03/demo/demo_Index.pl0000755000200000020000000000022607603000352021254 0ustar lembarklembarkuse Quantum::Superpositions BINARY => ["CORE::index"]; print index(any("opts","tops","spot"),"o"), "\n"; print index("stop",any("p","s")), "\n"; Quantum-Superpositions-2.03/demo/demo_Factors.pl0000755000200000020000000000040307603000352021603 0ustar lembarklembark#! /usr/local/bin/perl -w use Quantum::Superpositions UNARY => ['CORE::int']; sub factors { eigenstates (int($_[0] / any(2..$_[0]-1)) == ($_[0] / any(2..$_[0]-1))); } while (<>) { print int($_), "\n"; print "factors: ", join(",", factors($_)), "\n"; } Quantum-Superpositions-2.03/demo/demo_GCD.pl0000755000200000020000000000077307643737374020642 0ustar lembarklembark#! /usr/local/bin/perl use Quantum::Superpositions ( UNARY => ['CORE::int'] ); sub factors { eigenstates (int($_[0] / any(2..$_[0]-1)) == ($_[0] / any(2..$_[0]-1))); } sub GCD { my ($x, $y) = @_; my $common = all(any(factors($x)), any(factors($y))); any(eigenstates $common) >= all(eigenstates $common); } while (<>) { chomp; my ($x,$y) = split; print "factors($x): ", join(",",factors($x)), "\n"; print "factors($y): ", join(",",factors($y)), "\n"; print "GCD($x,$y): ", GCD($x,$y), "\n"; } Quantum-Superpositions-2.03/demo/diskfree0000755000200000020000000000556507651342727020420 0ustar lembarklembark#!/usr/local/bin/perl -w ######################################################################## # (C) 2001, Workhorse Computing # All rights reserved. # This code is released under the same terms as Perl, see the # Artistic License for a complete definition. ######################################################################## ######################################################################## # housekeeping ######################################################################## # matches the file name: diskfrie.pm local $/; use Parse::RecDescent; use Quantum::Superpositions; { package Quantum::Duality; use overload q{""} => sub { $_[0] }, q{+0} => sub { $_[1] }, q{cmp} => sub { $_[2] ? $_[1]->[0] cmp $_[0] : $_[0]->[0] cmp $_[1] }, q{<=>} => sub { $_[2] ? $_[1]->[1] <=> $_[0] : $_[0]->[1] <=> $_[1] }, ; } ######################################################################## # real work begins here ######################################################################## # generate a parser from the __DATA__ section of this # file (see below) then call its "input" rule passing # it the result of running "df -k" on the system. the # parser hands back a reference to an array of blessed # disk informatin. my $mountz = Parse::RecDescent->new( )->input( qx(df -k) ) or die "Roadkill: bad data"; # display df on the mount points that are over the threshold. if( my $overz = any( @$mountz ) > 90 ) { print "\n", qx(df -k @$overz), "\n"; } # keep the shell happy 0 __DATA__ ######################################################################## # # df -k on a bsd system looks like: # # Filesystem kbytes used avail capacity Mounted on # /proc 0 0 0 0% /proc # /dev/md/dsk/d2 1987399 1034737 893041 54% / # fd 0 0 0 0% /dev/fd # /dev/md/dsk/d11 3009327 55418 2893723 2% /var # # on a linux box with devfs it might look like: # # Filesystem 1k-blocks Used Available Use% Mounted on # /dev/scsi/host0/bus0/target0/lun0/part2 # 323536 179936 127216 59% /var # /dev/scsi/host0/bus0/target0/lun0/part3 # 2070736 309308 1656572 16% /scratch # /lvm/vg00/lvol1 486344 418760 43008 91% /opt/src # /lvm/vg00/lvol2 258832 2060 243668 1% /backup # # # problem is to figure out which drives are over the threshold # and need to be reported. # ######################################################################## { $::HD_HINT = $::HD_TRACE = 1 if $^P } input : input : line(s) { $return = \@dir } line : path number(s) '%' path { push @dir, bless [ $item[-1], $item{number}->[-1] ], 'Quantum::Duality' } | /.+/ { 1 } path : m{/\S+} { $return = $item[1] } number : /\d+/ { $return = $item[1] } Quantum-Superpositions-2.03/test.pl0000755000200000020000000000430707643741774017270 0ustar lembarklembark#!/usr/local/bin/perl -sw print "1..42\n"; use Quantum::Superpositions UNARY => ['CORE::int']; print "ok 1\n"; my $test = 2; sub TEST { my ($got, $expected, $true) = (@_,0); unless ("$got" eq "$expected") { print "\tline ", (caller)[2], "\n"; print "\texpected: "; print $expected; print "\n"; print "\tbut got: "; print $got; print "\n"; print "not "; } print "ok ", $test++, "\n"; unless (($got?1:0) == ($true?1:0)) { print "\tline ", (caller)[2], "\n"; print "\texpected: "; print $true ? "true" : "false"; print "\n"; print "\tbut got: "; print $got ? "true" : "false"; print "\n"; print "not "; } print "ok ", $test++, "\n"; } TEST all(1,2,3) != all(4,5,6), all(1,2,3), "true"; TEST all(1,2,3) < any(1,2,3), all(); TEST any(1,2,3) > all(1,2,3), any(); TEST all(1,2,3) < any(1,2,3,4), all(1,2,3), "true"; TEST any(1,2,3,4) > all(1,2,3), any(4), "true"; TEST all(1,2,3) != all(4,5,6), all(1,2,3), "true"; TEST all(1,2,3) < any(1,2,3), all(); TEST any(1,2,3) > all(1,2,3), any(); TEST all(2,3,4) > any(1,2,3), all(2,3,4), "true"; TEST any(1,2,3) < all(2,3,4), any(1), "true"; TEST all(2,3,4) > any(1,2,3,4), all(2,3,4), "true"; TEST all(1,2,3,4)*all(2,3,4) < any(10,11,12), all(); TEST all(1,2,3)*any(1,2,3), all(any(1,2,3),any(2,4,6),any(3,6,9)); sub factors { eigenstates (int($_[0] / any(2..$_[0]-1)) == ($_[0] / any(2..$_[0]-1))); } my $val = 60; my @factors = factors($val); foreach (@factors) { print "not " and last unless 60%$_ == 0 } print "ok ", $test++, "\n"; use Quantum::Superpositions BINARY => ["CORE::index"]; TEST index(any("opts","tops","spot"),"o"), any(0,1,2), "true"; TEST index("stop",any("p","s")), any(0,3), "true"; TEST index(any("opts","tops","spot","stop"),any("o","p")), any(0,1,2,3), "true"; sub odder { grep($_%2, split "", $_[0]) > grep($_%2, split "", $_[1]); } use Quantum::Superpositions BINARY_LOGICAL => ['main::odder']; TEST odder(any(1234,2468), 666), any(1234), "true"; TEST odder(any(1234,2468), 666), 1234, "true"; if ($] >= 5.006) { TEST any(sub{1 . shift()}, sub{pop() . 2})->("a", "z"), any("1a","z2"), "true"; TEST all(sub{1 . shift()}, sub{pop() . 2})->("z", "a"), all("1z","a2"); } else { TEST 1,1,1 for (1..2); } Quantum-Superpositions-2.03/MANIFEST0000755000200000020030000000055213320472147016227 0ustar lembarkdevChanges MANIFEST Makefile.PL lib/Quantum/Superpositions.pm test.pl demo/demo_Factors.pl demo/demo_GCD.pl demo/demo_Index.pl demo/demo_Max.pl demo/demo_Odder.pl demo/demo_Primes.pl demo/diskfree META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Quantum-Superpositions-2.03/lib/0002755000200000020030000000000013320472147015641 5ustar lembarkdevQuantum-Superpositions-2.03/lib/Quantum/0002755000200000020030000000000013320472147017273 5ustar lembarkdevQuantum-Superpositions-2.03/lib/Quantum/Superpositions.pm0000755000200000020000000007626013320472030023536 0ustar lembarklembark package Quantum::Superpositions; ######################################################################## # housekeeping ######################################################################## use strict; use Carp; use Class::Multimethods; our $VERSION = '2.03'; sub import { { my $caller = caller; no strict 'refs'; *{ $caller . '::' . $_ } = __PACKAGE__->can( $_ ) for qw( all any eigenstates ); } my ($class, %quantized) = @_; quantize_unary($_,'quop') for @{$quantized{UNARY}}; quantize_unary($_,'qulop') for @{$quantized{UNARY_LOGICAL}}; quantize_binary($_,'qbop') for @{$quantized{BINARY}}; quantize_binary($_,'qblop') for @{$quantized{BINARY_LOGICAL}}; 1 } ######################################################################## # utility subroutines and package variables # # these are small enough to get lost in the shuffle. easier to put them # up here than loose 'em... ######################################################################## # used to print intermediate results if $debug is true. my $debug = 0; sub debug { print +(caller(1))[3], "("; print +overload::StrVal($_), "," for @_; print ")\n"; } # cleans up overloaded calls. sub swap { $_[2] ? @_[1,0] : @_[0,1] } # eigencache tracks objects results. destructor has to clean # out the cache. due to overloading this cannot simply use # the $hash{$referent} trick. my %eigencache; sub DESTROY { delete $eigencache{overload::StrVal($_[0])}; } # replaces the cartesian product with an iterator. normal use is # something like: # # my ( $n, $sub ) = iterator \@list1, \@list2 # # my @result = map { somefunc @$sub->() } (1..$n ); # # note the limit check on $j: this returns an empty list # after the process has iterated once. this allows for # while( @pair = $iter->() ){ ... } and gracefully handles # (0..$count) also. sub iterator { my ( $a, $b ) = ( shift, shift ); my ( $i, $j ) = ( -1, -1 ); # caller gets back ( iterator count, closure ). # the $j test also allows for while or for(;;) # loops testing the return. ( @$a * @$b, sub { $i = ++$i % @$a; ++$j unless $i; $j < @$b ? [ $a->[$i], $b->[$j] ] : () } ) } ######################################################################## # what users call. the rest of this stuff is generally called # indirectly via multimethods on the contents of the objects. sub any { bless [@_], 'Quantum::Superpositions::Disj' } sub all { bless [@_], 'Quantum::Superpositions::Conj' } sub all_true { bless [@_], 'Quantum::Superpositions::Conj::True' } ######################################################################## # what the hell do these really do? sub quantize_unary { my ($fullsubname, $type) = @_; my ($package,$subname) = m/(.+)::(.+)$/; my $caller = caller; my $original = "CORE::$subname"; if( $package ne 'CORE' ) { $original = "Quantum::Superpositions::Quantized::$fullsubname"; no strict; *{$original} = \&$fullsubname; } else { $package = 'CORE::GLOBAL'; } eval qq{ package $package; use subs '$subname'; use Class::Multimethods '$type'; local \$SIG{__WARN__} = sub{}; no strict 'refs'; *{"${package}::$subname"} = sub { local \$^W; return \$_[0]->$type(sub{$original(\$_[0])}) if UNIVERSAL::isa(\$_[0],'Quantum::Superpositions') || UNIVERSAL::isa(\$_[1],'Quantum::Superpositions'); no strict 'refs'; return $original(\$_[0]); }; } || croak "Internal error: $@"; } sub quantize_binary { my ($fullsubname, $type) = @_; my ($package,$subname) = m/(.*)::(.*)/; my $caller = caller; my $original = "CORE::$subname"; if ($package ne 'CORE') { $original = "Quantum::Superpositions::Quantized::$fullsubname"; no strict; *{$original} = \&$fullsubname; } else { $package = 'CORE::GLOBAL'; } eval qq{ package $package; use subs '$subname'; use Class::Multimethods '$type'; local \$SIG{__WARN__} = sub{}; no strict 'refs'; *{"${package}::$subname"} = sub { local \$^W; return $type(\@_[0,1],sub{$original(\$_[0],\$_[1])}) if UNIVERSAL::isa(\$_[0],'Quantum::Superpositions') || UNIVERSAL::isa(\$_[1],'Quantum::Superpositions'); no strict 'refs'; return $original(\$_[0],\$_[1]); }; } || croak "Internal error: $@"; } ######################################################################## # assign the multimethods operations for various types multimethod qbop => ( qw( Quantum::Superpositions::Conj Quantum::Superpositions::Conj CODE ) ) => sub { my ( $count, $iter ) = iterator @_[0,1]; all map { qbop(@{$iter->()}, $_[2]) } (1..$count); }; multimethod qbop => ( qw( Quantum::Superpositions::Disj Quantum::Superpositions::Disj CODE ) ) => sub { my ( $count, $iter ) = iterator( @_[0,1] ); any map { qbop(@{$iter->()}, $_[2]) } (1..$count); }; multimethod qbop => ( qw( Quantum::Superpositions::Conj Quantum::Superpositions::Disj CODE ) ) => sub { all map { qbop($_, $_[1], $_[2]) } @{$_[0]}; }; multimethod qbop => ( qw( Quantum::Superpositions::Disj Quantum::Superpositions::Conj CODE ) ) => sub { any map { qbop($_, $_[1], $_[2]) } @{$_[0]} }; multimethod qbop => ( qw( Quantum::Superpositions::Conj * CODE ) ) => sub { all map { qbop($_, $_[1], $_[2]) } @{$_[0]} }; multimethod qbop => ( qw( Quantum::Superpositions::Disj * CODE ) ) => sub { any map { qbop($_, $_[1], $_[2]) } @{$_[0]} }; multimethod qbop => ( qw( * Quantum::Superpositions::Disj CODE ) ) => sub { any map { qbop($_[0], $_, $_[2]) } @{$_[1]} }; multimethod qbop => ( qw( * Quantum::Superpositions::Conj CODE ) ) => sub { all map { qbop($_[0], $_, $_[2]) } @{$_[1]} }; multimethod qbop => ( qw( * * CODE ) ) => sub { $_[2]->(@_[0..1]) }; multimethod qblop => ( qw( Quantum::Superpositions::Conj Quantum::Superpositions::Conj CODE ) ) => sub { &debug if $debug; return all() unless @{$_[0]} && @{$_[1]}; my ( $count, $iter ) = iterator @_[0,1]; istrue( qblop(@{$iter->()}, $_[2]) ) || return all() for (1..$count); all_true @{$_[0]}; }; multimethod qblop => ( qw( Quantum::Superpositions::Conj Quantum::Superpositions::Disj CODE ) ) => sub { &debug if $debug; return all() unless @{$_[0]} && @{$_[1]}; my @cstates = @{$_[0]}; my @matchstates; my $okay = 0; for my $cstate ( @cstates ) { for my $dstate ( @{$_[1]} ) { ++$okay && last if istrue(qblop($cstate, $dstate, $_[2])); } } return all() unless $okay == @cstates; return all_true @{$_[0]}; }; multimethod qblop => ( qw( Quantum::Superpositions::Disj Quantum::Superpositions::Conj CODE ) ) => sub { &debug if $debug; return any() unless @{$_[0]} && @{$_[1]}; my @dstates = @{$_[0]}; my @cstates = @{$_[1]}; my @dokay = (0) x @dstates; for my $cstate ( @cstates ) { my $matched; for my $d ( 0..$#dstates ) { $matched = ++$dokay[$d] if istrue(qblop($dstates[$d], $cstate, $_[2])); } return any() unless $matched; } return any @dstates[grep { $dokay[$_] == @cstates } (0..$#dstates)]; }; multimethod qblop => ( qw( Quantum::Superpositions::Conj * CODE ) ) => sub { &debug if $debug; return all() unless @{$_[0]}; istrue(qblop($_, $_[1], $_[2])) || return all() for @{$_[0]}; return all_true @{$_[0]}; }; multimethod qblop => ( qw( * Quantum::Superpositions::Conj CODE ) ) => sub { &debug if $debug; return all() unless @{$_[1]}; istrue(qblop($_[0], $_, $_[2])) || return all() for @{$_[1]}; return all_true $_[0]; }; multimethod qblop => ( qw( Quantum::Superpositions::Disj * CODE ) ) => sub { &debug if $debug; return any() unless @{$_[0]}; return any grep { istrue(qblop($_, $_[1], $_[2])) } @{$_[0]}; }; multimethod qblop => ( qw( * Quantum::Superpositions::Disj CODE ) ) => sub { &debug if $debug; return any() unless @{$_[1]}; return any grep { istrue(qblop($_[0], $_, $_[2])) } @{$_[1]}; }; multimethod qblop => ( qw( Quantum::Superpositions::Disj Quantum::Superpositions::Disj CODE ) ) => sub { &debug if $debug; return any() unless @{$_[0]} && @{$_[1]}; return any grep { istrue(qblop($_[0], $_, $_[2])) } @{$_[1]}; }; multimethod qblop => ( qw( * * CODE ) ) => sub { &debug if $debug; return qbop(@_) ? $_[0] : (); }; ######################################################################## # overload everything possible into appropraite multimethods. # this is where the limitation for regexen hits. use overload q{+} => sub { qbop(swap(@_), sub { $_[0] + $_[1] })}, q{-} => sub { qbop(swap(@_), sub { $_[0] - $_[1] })}, q{*} => sub { qbop(swap(@_), sub { $_[0] * $_[1] })}, q{/} => sub { qbop(swap(@_), sub { $_[0] / $_[1] })}, q{%} => sub { qbop(swap(@_), sub { $_[0] % $_[1] })}, q{**} => sub { qbop(swap(@_), sub { $_[0] ** $_[1] })}, q{<<} => sub { qbop(swap(@_), sub { $_[0] << $_[1] })}, q{>>} => sub { qbop(swap(@_), sub { $_[0] >> $_[1] })}, q{x} => sub { qbop(swap(@_), sub { $_[0] x $_[1] })}, q{.} => sub { qbop(swap(@_), sub { $_[0] . $_[1] })}, q{&} => sub { qbop(swap(@_), sub { $_[0] & $_[1] })}, q{^} => sub { qbop(swap(@_), sub { $_[0] ^ $_[1] })}, q{|} => sub { qbop(swap(@_), sub { $_[0] | $_[1] })}, q{atan2}=> sub { qbop(swap(@_), sub { atan2($_[0],$_[1]) })}, q{<} => sub { qblop(swap(@_), sub { $_[0] < $_[1] })}, q{<=} => sub { qblop(swap(@_), sub { $_[0] <= $_[1] })}, q{>} => sub { qblop(swap(@_), sub { $_[0] > $_[1] })}, q{>=} => sub { qblop(swap(@_), sub { $_[0] >= $_[1] })}, q{==} => sub { qblop(swap(@_), sub { $_[0] == $_[1] })}, q{!=} => sub { qblop(swap(@_), sub { $_[0] != $_[1] })}, q{<=>} => sub { qblop(swap(@_), sub { $_[0] <=> $_[1] })}, q{lt} => sub { qblop(swap(@_), sub { $_[0] lt $_[1] })}, q{le} => sub { qblop(swap(@_), sub { $_[0] le $_[1] })}, q{gt} => sub { qblop(swap(@_), sub { $_[0] gt $_[1] })}, q{ge} => sub { qblop(swap(@_), sub { $_[0] ge $_[1] })}, q{eq} => sub { qblop(swap(@_), sub { $_[0] eq $_[1] })}, q{ne} => sub { qblop(swap(@_), sub { $_[0] ne $_[1] })}, q{cmp} => sub { qblop(swap(@_), sub { $_[0] cmp $_[1] })}, q{cos} => sub { $_[0]->quop(sub { cos $_[0] })}, q{sin} => sub { $_[0]->quop(sub { sin $_[0] })}, q{exp} => sub { $_[0]->quop(sub { exp $_[0] })}, q{abs} => sub { $_[0]->quop(sub { abs $_[0] })}, q{sqrt} => sub { $_[0]->quop(sub { sqrt $_[0] })}, q{log} => sub { $_[0]->quop(sub { log $_[0] })}, q{neg} => sub { $_[0]->quop(sub { -$_[0] })}, q{~} => sub { $_[0]->quop(sub { ~$_[0] })}, q{&{}} => sub { my $s = shift; return sub { bless [map {$_->(@_)} @$s], ref $s } }, q{!} => sub { $_[0]->qulop(sub { !$_[0] })}, q{bool} => 'qbool', q{""} => 'qstr', q{0+} => 'qnum', ; ######################################################################## # extract results from the Q::S objects. multimethod collapse => ( 'Quantum::Superpositions' ) => sub { return map { collapse($_) } @{$_[0]} }; multimethod collapse => ( '*' ) => sub { return $_[0] }; sub eigenstates($) { my ($self) = @_; my $eigencache_id = overload::StrVal($self); return @{$eigencache{$eigencache_id}} if defined $eigencache{$eigencache_id}; my %uniq; @uniq{collapse($self)} = (); local $^W=1; return @{$eigencache{$eigencache_id}} = grep { my $okay=1; local $SIG{__WARN__} = sub {$okay=0}; istrue($self eq $_) || istrue($self == $_) && $okay } keys %uniq; } multimethod istrue => ( 'Quantum::Superpositions::Disj' ) => sub { my @states = @{$_[0]} || return 0; istrue($_) && return 1 for @states; return 0; }; multimethod istrue => ( 'Quantum::Superpositions::Conj::True' ) => sub { return 1; }; multimethod istrue => ( 'Quantum::Superpositions::Conj' ) => sub { my @states = @{$_[0]} || return 0; istrue($_) || return 0 for @states; return 1; }; multimethod istrue => ( '*' ) => sub { return defined $_[0]; }; multimethod istrue => () => sub { return 0; }; sub qbool { $_[0]->eigenstates ? 1 : 0; } sub qnum { my @states = $_[0]->eigenstates; return $states[rand @states] } ######################################################################## ######################################################################## # embedded classes. # # these are what the constructors bless things into. ######################################################################## package Quantum::Superpositions::Disj; use base 'Quantum::Superpositions'; use Carp; sub qstr { my @eigenstates = $_[0]->eigenstates; return "@eigenstates" if @eigenstates == 1; return "any(".join(",",@eigenstates).")" } sub quop { Quantum::Superpositions::any(map { $_[1]->($_) } @{$_[0]}) } sub qulop { Quantum::Superpositions::any(grep { $_[1]->($_) } @{$_[0]}) } package Quantum::Superpositions::Conj; use base 'Quantum::Superpositions'; use Carp; sub qstr { my @eigenstate = $_[0]->eigenstates; @eigenstate ? "@eigenstate" : "all(".join(",",@{$_[0]}).")" } sub quop { return Quantum::Superpositions::all(map { $_[1]->($_) } @{$_[0]}) } sub qulop { $_[1]->($_) || return Quantum::Superpositions::all() for @{$_[0]}; Quantum::Superpositions::all(@{$_[0]}) } package Quantum::Superpositions::Conj::True; use base 'Quantum::Superpositions::Conj'; sub qbool { 1 } 1; __END__ =head1 NAME Quantum::Superpositions - QM-like superpositions in Perl =head1 VERSION This document describes version 1.03 of Quantum::Superpositions, released August 11, 2000. =head1 SYNOPSIS use Quantum::Superpositions; if ($x == any($a, $b, $c)) { ... } while ($nextval < all(@thresholds)) { ... } $max = any(@value) < all(@values); use Quantum::Superpositions BINARY => [ CORE::index ]; print index( any("opts","tops","spot"), "o" ); print index( "stop", any("p","s") ); =head1 BACKGROUND Under the standard interpretation of quantum mechanics, until they are observed, particles exist only as a discontinuous probability function. Under the Cophenhagen Interpretation, this situation is often visualized by imagining the state of an unobserved particle to be a ghostly overlay of all its possible observable states simultaneously. For example, a particle that might be observed in state A, B, or C may be considered to be in a pseudo-state where it is simultaneously in states A, B, and C. Such a particle is said to be in a superposition of states. Research into applying particle superposition in construction of computer hardware is already well advanced. The aim of such research is to develop reliable quantum memories, in which an individual bit is stored as some measurable property of a quantised particle (a qubit). Because the particle can be physically coerced into a superposition of states, it can store bits that are simultaneously 1 and 0. Specific processes based on the interactions of one or more qubits (such as interference, entanglement, or additional superposition) are then be used to construct quantum logic gates. Such gates can in turn be employed to perform logical operations on qubits, allowing logical and mathematical operations to be executed in parallel. Unfortunately, the math required to design and use quantum algorithms on quantum computers is painfully hard. The Quantum::Superpositions module offers another approach, based on the superposition of entire scalar values (rather than individual qubits). =head1 DESCRIPTION The Quantum::Superpositions module adds two new operators to Perl: C and C. Each of these operators takes a list of values (states) and superimposes them into a single scalar value (a superposition), which can then be stored in a standard scalar variable. The C and C operators produce two distinct kinds of superposition. The C operator produces a disjunctive superposition, which may (notionally) be in any one of its states at any time, according to the needs of the algorithm that uses it. In contrast, the C operator creates a conjunctive superposition, which is always in every one of its states simultaneously. Superpositions are scalar values and hence can participate in arithmetic and logical operations just like any other type of scalar. However, when an operation is applied to a superposition, it is applied (notionally) in parallel to each of the states in that superposition. For example, if a superposition of states 1, 2, and 3 is multiplied by 2: $result = any(1,2,3) * 2; the result is a superposition of states 2, 4, and 6. If that result is then compared with the value 4: if ($result == 4) { print "fore!" } then the comparison also returns a superposition: one that is both true and false (since the equality is true for one of the states of C<$result> and false for the other two). Of course, a value that is both true and false is of no use in an C statement, so some mechanism is needed to decide which superimposed boolean state should take precedence. This mechanism is provided by the two types of superposition available. A disjunctive superposition is true if any of its states is true, whereas a conjunctive superposition is true only if all of its states are true. Thus the previous example does print "fore!", since the C condition is equivalent to: if (any(2,4,6) == 4)... It suffices that any one of 2, 4, or 6 is equal to 4, so the condition is true and the C block executes. On the other hand, had the control statement been: if (all(2,4,6) == 4)... the condition would fail, since it is not true that all of 2, 4, and 6 are equal to 4. Operations are also possible between two superpositions: if (all(1,2,3)*any(5,6) < 21) { print "no alcohol"; } if (all(1,2,3)*any(5,6) < 18) { print "no entry"; } if (any(1,2,3)*all(5,6) < 18) { print "under-age" } In this example, the string "no alcohol" is printed because the superposition produced by the multiplication is the Cartesian product of the respective states of the two operands: C. Since all of these resultant states are less that 21, the condition is true. In contrast, the string "no entry" is not printed, because not all the product's states are less than 18. Note that the type of the first operand determines the type of the result of an operation. Hence the third string -- "underage" -- is printed, because multiplying a disjunctive superposition by a conjunctive superposition produces a result that is disjunctive: C. The condition of the C statement asks whether any of these values is less than 18, which is true. =head2 Composite Superpositions The states of a superposition may be any kind of scalar value -- a number, a string, or a reference: $wanted = any("Mr","Ms").any(@names); if ($name eq $wanted) { print "Reward!"; } $okay = all(\&check1,\&check2); die unless $okay->(); my $large = all( BigNum->new($centillion), BigNum->new($googol), BigNum->new($SkewesNum) ); @huge = grep {$_ > $large} @nums; More interestingly, since the individual states of a superposition are scalar values and a superposition is itself a scalar value, a superposition may have states that are themselves superpositions: $ideal = any( all("tall", "rich", "handsome"), all("rich", "old"), all("smart","Australian","rich") ); Operations involving such a composite superposition operate recursively and in parallel on each its states individually and then recompose the result. For example: while (@features = get_description) { if (any(@features) eq $ideal) { print "True love"; } } The C equality is true if the input characteristics collectively match any of the three superimposed conjunctive superpositions. That is, if the characteristics collectively equate to each of "tall" and "rich" and "handsome", or to both "rich" and "old", or to all three of "smart" and "Australian" and "rich". =head2 Eigenstates It is useful to be able to determine the list of states that a given superposition represents. In fact, it is not the I per se, but the values to which the states may collapse -- the I that are useful. In programming terms this is the set of values C<@ev> for a given superposition C<$s> such that C or C. This list is provided by the C operator, which may be called on any superposition: print "The factor was: ", eigenstates($factor); print "Don't use any of:", eigenstates($badpasswds); =head2 Boolean evaluation of superpositions The examples shown above assume the same meta-semantics for both arithmetic and boolean operations, namely that a binary operator is applied to the Cartesian product of the states of its two operands, regardless of whether the operation is arithmetic or logical. Thus the comparison of two superpositions produces a superposition of 1's and 0's, representing any (or all) possible comparisons between the individual states of the two operands. The drawback of applying arithmetic metasemantics to logical operations is that it causes useful information to be lost. Specifically, which states were responsible for the success of the comparison. For example, it is possible to determine if any number in the array C<@newnums> is less than all those in the array C<@oldnums> with: if (any(@newnums) < @all(oldnums)) { print "New minimum detected"; } But this is almost certainly unsatisfactory, because it does not reveal which element(s) of C<@newnum> caused the condition to be true. It is, however, possible to define a different meta-semantics for logical operations between superpositions; one that preserves the intuitive logic of comparisons but also gives limited access to the states that cause those comparisons to succeed. The key is to deviate from the arithmetic view of superpositional comparison (namely, that a compared superposition yields a superposition of compared state combinations). Instead, the various comparison operators are redefined so that they form a superposition of those eigenstates of the left operand that cause the operation to be true. In other words, the old meta-semantics superimposed the result of each parallel comparison, whilst the new meta-semantics superimposes the left operands of each parallel comparison that succeeds. For example, under the original semantics, the comparisons: all(7,8,9) <= any(5,6,7) #A all(5,6,7) <= any(7,8,9) #B any(6,7,8) <= all(7,8,9) #C would yield: all(0,0,1,0,0,0,0,0,0) #A (false) all(1,1,1,1,1,1,1,1,1) #B (true) any(1,1,1,1,1,1,0,1,1) #C (true) Under the new semantics they would yield: all(7) #A (false) all(5,6,7) #B (true) any(6,7) #C (true) The success of the comparison (the truth of the result) is no longer determined by the I of the resulting states, but by the I of states in the resulting superposition. The Quantum::Superpositions module treats logical operations and boolean conversions in exactly this way. Under these meta-semantics, it is possible to check a comparison and also determine which eigenstates of the left operand were responsible for its success: $newmins = any(@newnums) < all(@oldnums); if ($newmins) { print "New minima found:", eigenstates($newmins); } Thus, these semantics provide a mechanism to conduct parallel searches for minima and maxima : sub min { eigenstates( any(@_) <= all(@_) ) } sub max { eigenstates( any(@_) >= all(@_) ) } These definitions are also quite intuitive, almost declarative: the minimum is any value that is less-than-or-equal-to all of the other values; the maximum is any value that is greater-than-or-equal to all of them. =head2 String evaluation of superpositions Converting a superposition to a string produces a string that encode the simplest set of eigenstates equivalent to the original superposition. If there is only one eigenstate, the stringification of that state is the string representation. This eliminates the need to explicitly apply the C operator when only a single resultant state is possible. For example: print "lexicographically first: ", any(@words) le all(@words); In all other cases, superpositions are stringified in the format: C<"all(I)"> or C<"any(I)">. =head2 Numerical evaluation of superpositions Providing an implicit conversion to numeric (for situations where superpositions are used as operands to an arithmetic operation, or as array indices) is more challenging than stringification, since there is no mechanism to capture the entire state of a superposition in a single non-superimposed number. Again, if the superposition has a single eigenstate, the conversion is just the standard conversion for that value. For instance, to output the value in an array element with the smallest index in the set of indices @i: print "The smallest element is: ", $array[any(@i)<=all(@i)]; If the superposition has no eigenstates, there is no numerical value to which it could collapse, so the result is C. If a disjunctive superposition has more than one eigenstate, that superposition could collapse to any of those values. And it is convenient to allow it to do exactly that -- collapse (pseudo-)randomly to one of its eigenstates. Indeed, doing so provides a useful notation for random selection from a list: print "And the winner is...", $entrant[any(0..$#entrant)]; =head2 Superpositions as subroutine arguments When a superposition is used as a subroutine argument, that subroutine is applied in parallel to each state of the superposition and the results re-superimposed to form the same type of superposition. For example, given: $n1 = any(1,4,9); $r1 = sqrt($n1); $n2 = all(1,4,9); $r2 = pow($n2,3); $r3 = pow($n1,$r1); then $r1 contains the disjunctive superposition C, C<$r2> contains the conjunctive superposition C, and <$r3 > contains the conjunctive superposition C. Because the built-in C and C functions don't know about superpositions, the module provides a mechanism for informing them that their arguments may be superimposed. If the call to C is given an argument list, that list specifies which functions should be rewritten to handle superpositions. Unary functions and subroutine can be "quantized" like so: sub incr { $_[0]+1 } sub numeric { $_[0]+0 eq $_[0] } use Quantum::Superpositions UNARY => ["CORE::int", "main::incr"], UNARY_LOGICAL => ["main::numeric"]; For binary functions and subroutines use: sub max { $_[0] < $_[1] ? $_[1] : $_[0] } sub same { my $failed; $IG{__WARN__}=sub{$failed=1}; return $_[0] eq $_[1] || $_[0]==$_[1] && !$failed; } use Quantum::Superpositions BINARY => ['main::max', 'CORE::index'], BINARY_LOGICAL => ['main::same']; =head1 EXAMPLES =head2 Primality testing The power of programming with scalar superpositions is perhaps best seen by returning the quantum computing's favourite adversary: prime numbers. Here, for example is an O(1) prime-number tester, based on naive trial division: sub is_prime { my ($n) = @_; return $n % all(2..sqrt($n)+1) != 0 } The subroutine takes a single argument (C<$n>) and computes (in parallel) its modulus with respect to every integer between 2 and C. This produces a conjunctive superposition of moduli, which is then compared with zero. That comparison will only be true if all the moduli are not zero, which is precisely the requirement for an integer to be prime. Because C takes a single scalar argument, it can also be passed a superposition. For example, here is a constant-time filter for detecting whether a number is part of a pair of twin primes: sub has_twin { my ($n) = @_; return is_prime($n) && is_prime($n+any(+2,-2); } =head2 Set membership and intersection Set operations are particularly easy to perform using superimposable scalars. For example, given an array of values C<@elems>, representing the elements of a set, the value C<$v> is an element of that set if: $v == any(@elems) Note that this is equivalent to the definition of an eigenstate. That equivalence can be used to compute set intersections. Given two disjunctive superpositions, C<$s1=any(@elems1)> and C<$s2=any(@elems2)>, representing two sets, the values that constitute the intersection of those sets must be eigenstates of both <$s1> and C<$s2>. Hence: @intersection = eigenstates(all($s1, $s2)); This result can be extended to extract the common elements from an arbitrary number of arrays in parallel: @common = eigenstates( all( any(@list1), any(@list2), any(@list3), any(@list4), ) ); =head2 Factoring Factoring numbers is also trivial using superpositions. The factors of an integer N are all the quotients q of N/n (for all positive integers n < N) that are also integral. A positive number q is integral if floor(q)==q. Hence the factors of a given number are computed by: sub factors { my ($n) = @_; my $q = $n / any(2..$n-1); return eigenstates(floor($q)==$q); } =head2 Query processing Superpositions can also be used to perform text searches. For example, to determine whether a given string ($target) appears in a collection of strings (@db): use Quantum::Superpositions BINARY => ["CORE::index"]; $found = index(any(@db), $target) >= 0; To determine which of the database strings contain the target: sub contains_str { return $dbstr if (index($dbstr, $target) >= 0; } $found = contains_str(any(@db), $target); @matches = eigenstates $found; It is also possible to superimpose the target string, rather than the database, so as to search a single string for any of a set of targets: sub contains_targ { if (index($dbstr, $target) >= 0) { return $target; } } $found = contains_targ($string, any(@targets)); @matches = eigenstates $found; or in every target simultaneously: $found = contains_targ($string, all(@targets)); @matches = eigenstates $found; =head1 AUTHOR Damian Conway (damian@conway.org) Now maintainted by Steven Lembark (lembark@wrkhors.com) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in code this funky :-) Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 1998-2002, Damian Conway. Copyright (c) 2002, Steven Lembark All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the stame terms as Perl-5.6.1 (or later) (see http://www.perl.com/perl/misc/Artistic.html). Quantum-Superpositions-2.03/Makefile.PL0000755000200000020000000000051613320472067017705 0ustar lembarklembark use ExtUtils::MakeMaker; WriteMakefile ( NAME => 'Quantum::Superpositions', VERSION_FROM => 'lib/Quantum/Superpositions.pm', ABSTRACT => 'Superpositional logic in a single universe', PREREQ_PM => { Carp => 0, # standard distribution strict => 0, # ditto Class::Multimethods => 0, # nonstandard, at best... }, ); Quantum-Superpositions-2.03/Changes0000755000200000020000000000231613320472005017216 0ustar lembarklembarkRevision history for Perl extension Quantum::Superpositions. 0.01 Wed Sep 10 10:34:42 1997 - original version; created by h2xs 1.18 1.01 Thu Aug 10 09:28:34 2000 - Fixed pod bug (=haed2 -> =head2) - Added Makefile.pm PREREQ_PM for Class::Multimethods [Still working on 5.6.0 compatibility] 1.02 Thu Aug 10 10:19:30 2000 - Fixed 5.6.0 compatibility - Added ability to superimpose subroutine references. 1.03 Fri Aug 11 05:49:28 2000 - Fixed argument passing to superimposed subroutines. 1.04 1.05 - Doc bugs, change ownership. 2.00 Sat Apr 5 23:41:39 CST 2003 - Replaced the cross product with an iterator. this means that any(@these) != all(@those) does not need to generate the full cartesian product up front. The prime sieve (demo/demo_Primes) now runs in reasonable time/memory. - Added comments to the code. - Shuffled a bit of the code so that globals are defined towards the top of the code. This is a maintinence issue only. - Turned on my friend and yours: strict. - Replaced naked strings with qw's necessary to accomodate strict. 2.01 Tue Apr 22 17:45:31 CDT 2003 - Added diskfree to the demos. 2.0.2 Sun Jul 8 15:28:31 CDT 2018 - POD, thanks for Florian Schlichting Quantum-Superpositions-2.03/META.yml0000664000200000020030000000111713320472147016344 0ustar lembarkdev--- abstract: 'Superpositional logic in a single universe' author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Quantum-Superpositions no_index: directory: - t - inc requires: Carp: '0' Class::Multimethods: '0' strict: '0' version: '2.03' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Quantum-Superpositions-2.03/META.json0000664000200000020030000000175113320472147016520 0ustar lembarkdev{ "abstract" : "Superpositional logic in a single universe", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Quantum-Superpositions", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Class::Multimethods" : "0", "strict" : "0" } } }, "release_status" : "stable", "version" : "2.03", "x_serialization_backend" : "JSON::PP version 2.27400_02" }