File Coverage

lib/Tangle/Tangle.pm
Criterion Covered Total %
statement 110 154 71.4
branch 15 20 75.0
condition 3 4 75.0
subroutine 24 61 39.3
pod 9 54 16.6
total 161 293 54.9


line stmt bran cond sub pod time code
1             #
2             # Tangle.pm - A quantum state machine
3             #
4             # reference: https://youtu.be/F_Riqjdh2oM
5             #
6              
7              
8             package Tangle;
9 1     1   54489 use base qw(CayleyDickson);
  1         10  
  1         326  
10 1     1   498 use utf8;
  1         11  
  1         4  
11 1     1   25 use strict;
  1         2  
  1         32  
12 1     1   4 use constant HR => sqrt(1/2);
  1         2  
  1         43  
13 1     1   4 use constant LONG_NAMES => 0;
  1         1  
  1         1620  
14             our $VERSION = 0.03;
15              
16              
17             #
18             # CNOT: A⊗ B = (a,b)⊗ (c,d) = (ac,ad,bc,bd)
19             #
20             sub cnot {
21 10     10 1 39 my ( $control, $target ) = @_;
22              
23 10         24 my $tensor = $control->tensor($target);
24              
25 10         19 my $q1 = HR * Tangle->new(1,1,1,1);
26 10         27 my $cnot = 1 / $q1 * $tensor * $q1;
27              
28 10         37 $target->_extend;
29 10         20 my @cf = $cnot->flat;
30 10         25 $target->_gate(Tangle->new(@cf[0,1,3,2]));
31 10         20 my @tt = $target->tips;
32              
33 10         12 my @ct;
34 10         16 _extend($control) while (@ct = $control->tips) < @tt;
35              
36             #$control->_gate(Tangle->new(@tt[0,2,3,1]));
37 10         12 ${$ct[0]} = ${$tt[0]};
  10         13  
  10         10  
38 10         10 ${$ct[1]} = ${$tt[2]};
  10         11  
  10         9  
39 10         9 ${$ct[2]} = ${$tt[3]};
  10         11  
  10         21  
40 10         9 ${$ct[3]} = ${$tt[1]};
  10         11  
  10         7  
41 10         37 $target
42             }
43              
44              
45             #
46             # swap: (a,b) => (b,a)
47             #
48             # TODO: Change this into a gate. I think
49             #
50             sub swap {
51 2     2 0 7 my $m = shift;
52              
53             # swap target ends...
54 2         3 my $a = $m->[0];
55 2         3 my $b = $m->[1];
56 2         3 $m->[1] = $a;
57 2         4 $m->[0] = $b;
58 2         3 $m
59             }
60              
61              
62              
63             #
64             # _extend: replace the ends containing numbers with new objects containing two numbers
65             # this effectively doubles the dimensions of your Cayley Dickson number
66             #
67             sub _extend {
68 20     20   24 my $m = shift;
69              
70 20 50       28 if ($m->is_qbit) {
71 20         63 $${$m->[0]} = \((ref $m)->new((my $u = $m->a), 0));
  20         26  
72 20         35 $${$m->[1]} = \((ref $m)->new((my $u = $m->b), 0));
  20         29  
73             }
74             else {
75 0         0 _extend($m->a);
76 0         0 _extend($m->b);
77             }
78 20         30 $m
79             }
80              
81              
82              
83             #
84             # gate functions ...
85             #
86 29     29 0 30 sub x { my $m = shift; $m->_gate( (ref $m)->new( 0, 1 ) / $m) }
  29         49  
87 1     1 0 2 sub y { my $m = shift; $m->_gate( (ref $m)->new( 0, -1 ) / $m) }
  1         3  
88 0     0 0 0 sub z { my $m = shift; $m->_gate( (ref $m)->new( -1, 0 ) / $m) }
  0         0  
89 0     0 0 0 sub i { my $m = shift; $m->_gate( (ref $m)->new( 1, 0 ) / $m) }
  0         0  
90 38     38 0 40 sub h { my $m = shift; $m->_gate(HR * (ref $m)->new( 1, 1 ) / $m) }
  38         67  
91 0     0 0 0 sub xx { die 'incomplete function placeholder' }
92 0     0 0 0 sub yy { die 'incomplete function placeholder' }
93 0     0 0 0 sub zz { die 'incomplete function placeholder' }
94 0     0 0 0 sub u { die 'incomplete function placeholder' }
95 0     0 0 0 sub d { die 'incomplete function placeholder' }
96 0     0 0 0 sub cx { die 'incomplete function placeholder' }
97 0     0 0 0 sub cy { die 'incomplete function placeholder' }
98 0     0 0 0 sub cz { die 'incomplete function placeholder' }
99 0     0 0 0 sub cs { die 'incomplete function placeholder' }
100 0     0 0 0 sub not { die 'incomplete function placeholder' }
101 0     0 0 0 sub rswap { die 'incomplete function placeholder' }
102 0     0 0 0 sub rnot { die 'incomplete function placeholder' }
103 0     0 0 0 sub ccnot { die 'incomplete function placeholder' }
104              
105             # DONT USE THE method name "shift" !!!
106             #sub shift { die 'incomplete function placeholder' }
107              
108              
109             #
110             # optional long form function naming ..,
111             #
112 0     0 0 0 sub phase_shift { shift->shift(@_) }
113 0     0 0 0 sub detsch { shift->d(@_) }
114 38     38 0 128 sub hadamard { shift->h(@_) }
115 0     0 0 0 sub i_gate { shift->i(@_) }
116 0     0 0 0 sub pauli_i { shift->i(@_) }
117 0     0 0 0 sub identity { shift->i(@_) }
118 0     0 0 0 sub universal { shift->u(@_) }
119 29     29 0 95 sub x_gate { shift->x(@_) }
120 0     0 0 0 sub pauli_x { shift->x(@_) }
121 1     1 0 6 sub y_gate { shift->y(@_) }
122 0     0 0 0 sub pauli_y { shift->y(@_) }
123 0     0 0 0 sub z_gate { shift->z(@_) }
124 0     0 0 0 sub pauli_z { shift->z(@_) }
125 0     0 0 0 sub cswap { shift->cs(@_) }
126 0     0 0 0 sub fredkin { shift->cs(@_) }
127 0     0 0 0 sub xnot { shift->cx(@_) }
128 0     0 0 0 sub ynot { shift->cy(@_) }
129 0     0 0 0 sub znot { shift->cz(@_) }
130 0     0 0 0 sub ising_xx { shift->xx(@_) }
131 0     0 0 0 sub ising_yy { shift->yy(@_) }
132 0     0 0 0 sub ising_zz { shift->zz(@_) }
133 0     0 0 0 sub root_not { shift->rnot(@_) }
134 0     0 0 0 sub root_swap { shift->rswap(@_) }
135 0     0 0 0 sub toffoli { shift->ccnot(@_) }
136             # end long form function naming
137              
138              
139             #
140             # create a new object
141             # expects 2 (or 2^n) parameters of numbers of objects
142             #
143             sub new {
144 1315     1315 1 4981 my $c = shift;
145 1315         1507 my @values = @_;
146 1315         1141 my $elements = scalar @values;
147 1315         1151 my ($a, $b);
148 1315 100       1439 if ($elements > 2) {
149 25         67 $a = $c->new(@values[ 0 .. $elements/2 - 1 ]);
150 25         54 $b = $c->new(@values[ $elements/2 .. $elements - 1 ]);
151             }
152             else {
153 1290         1169 $a = $values[0];
154 1290         1048 $b = $values[1];
155             }
156 1315         3545 bless [ \\\$a, \\\$b ] => $c
157             }
158              
159              
160              
161             #
162             # hold the left number/object in a and the right number/object in b.
163             #
164 183714     183714 1 143111 sub a { $$${ (shift)->[0] } }
  183714         297427  
165 61781     61781 1 48257 sub b { $$${ (shift)->[1] } }
  61781         108595  
166              
167              
168              
169             #
170             # is_qbit: a conceptual renaming of the method is_complex()
171             #
172 120648     120648 0 137185 sub is_qbit { shift->is_complex }
173              
174              
175              
176             #
177             # flatten object ends into arrays for easy manipulations ...
178             #
179             sub flat {
180 167     167 1 150 my $m = shift;
181              
182 167 100       171 $m->is_qbit ? $m->a : $m->a->flat,
    100          
183             $m->is_qbit ? $m->b : $m->b->flat
184             }
185              
186              
187              
188             #
189             # return ordered coefficients as an array ...
190             #
191             sub tips {
192 294     294 0 246 my $m = shift;
193              
194 294 100       287 $m->is_qbit ? @$m : ( $m->a->tips, $m->b->tips )
195             }
196              
197              
198              
199             #
200             # _gate: copy the content from @to to @tm ...
201             #
202             sub _gate {
203 78     78   99 my ( $m, $o ) = @_;
204              
205 78         93 my @origin = $m->tips;
206 78         97 my @replace = $o->tips;
207              
208 78         134 foreach my $i (0 .. $#replace) {
209 190         167 $${ $origin[$i] } = \($$${ $replace[$i] })
  190         220  
  190         195  
210             }
211             $m
212 78         128 }
213              
214              
215              
216             #
217             # state: actual probability states being the quadrance or the square of the magnitude of the values ...
218             #
219             sub state {
220 60000     60000 1 48394 my $m = shift;
221              
222             [
223 10000         10748 ( $m->is_qbit ? abs $m->a ** 2 : @{ $m->a->state } ),
224 60000 100       56859 ( $m->is_qbit ? abs $m->b ** 2 : @{ $m->b->state } )
  10000 100       10138  
225             ]
226             }
227              
228              
229              
230             #
231             # raw_state: state as an array reference ...
232             #
233             sub raw_state {
234 0     0 1 0 my $m = shift;
235              
236             [
237 0         0 ( $m->is_qbit ? $m->a : @{ $m->a->raw_state } ),
238 0 0       0 ( $m->is_qbit ? $m->b : @{ $m->b->raw_state } )
  0 0       0  
239             ]
240             }
241              
242              
243              
244             #
245             # measure: a singular measure ...
246             #
247             sub measure {
248 40000     40000 1 34046 my $m = shift;
249              
250 40000         38447 my $s = $m->state;
251 40000         36746 my $n = 0;
252 40000         35140 my $r = rand 1;
253 40000         39518 foreach my $p (@$s) {
254 69867         57139 $r -= $p;
255 69867 100       81625 last if $r < 0;
256 29867         25311 $n ++
257             }
258             $n
259 40000         43280 }
260              
261              
262              
263             #
264             # measures: a repeated collection of measures for a specified number of runs
265             # returns a hash reference: { measured_value => count_of_runs_matching_this_value, ...}
266             #
267             sub measures {
268 4     4 1 19 my ( $my, $count ) = @_;
269 4   50     8 $count ||= 1;
270              
271 4         3 my %list;
272 4         11 foreach (1 .. $count) {
273 40000         41751 my $measure = $my->measure;
274 40000   100     51947 $list{ $measure } ||= 0;
275 40000         37776 $list{ $measure } ++
276             }
277              
278 4         31 foreach my $key (keys %list) {
279 8         16 $list{ $key } = $list{ $key } / $count
280             }
281 4         24 \%list
282             }
283              
284             =encoding utf8
285              
286             =pod
287              
288             =head1 NAME
289              
290             Tangle - a quantum state machine
291              
292             =head1 SYNOPSIS
293              
294             =over 4
295              
296             use Tangle;
297             my $q1 = Tangle->new(1,0);
298             print "q1 = $q1\n";
299             $q1->x_gate;
300             print "X(q1) = $q1\n";
301             $q1->hadamard;
302             print "H(X(q1)) = $q1\n";
303              
304             my $q2 = Tangle->new(1,0);
305             print "q2 = $q2\n";
306              
307             # perform CNOT($q1 ⊗ $q2)
308             $q1->cnot($q2);
309              
310             print "q1 = $q1\n";
311             print "q2 = $q2\n";
312              
313             $q1->x_gate;
314             print "X(q1) = $q1\n";
315             print "entanglement causes q2 to automatically changed: $q2\n";
316              
317             =back
318              
319             =head1 DESCRIPTION
320              
321             =over 3
322              
323             Create quantum probability states in classic memory.
324             Preform quantum gate manipulations and measure the results.
325             Ideal for testing, simulating and understanding quantum programming concepts.
326              
327             =back
328              
329             =head1 USAGE
330              
331              
332             =head2 new()
333              
334             =over 3
335              
336             # create a new Tangle object in the |0> state ...
337             my $q1 = Tangle->new(0,1);
338              
339             =back
340              
341             =head2 cnot()
342              
343             =over 3
344              
345             # tensors this object onto the given one and flip the second half accordingly ...
346             my $q2 = Tangle->new(0,1);
347              
348             # q1 ⊗ q2
349             $q2->cnot($q1);
350              
351             # both $q and $q2 are now sharing memory so that changes to one will effect the other.
352              
353             =back
354              
355             =head2 *_gate()
356              
357             =over 3
358              
359             * functioning gates are x, y, z, i and sometimes cnot.
360            
361             # unitary gate functions ...
362            
363             $q->x; # x-gate
364             $q->y; # y-gate
365             $q->z; # z-gate
366             $q->i; # identity
367              
368             # partially operational gates ...
369            
370             $q->cnot;
371             $q->swap;
372              
373             # other common gates ...
374             # context: https://en.wikipedia.org/wiki/Quantum_logic_gate
375            
376             $q->h; # hadamard
377             $q->xx; # isling (xx) coupling gate
378             $q->yy; # isling (yy) coupling gate
379             $q->zz; # isling (zz) coupling gate
380             $q->u; # universal gate... quantum cheating
381             $q->d; # deutsch gate ... not in the real world yet.
382             $q->cx; # controlled x-not = cnot() gate
383             $q->cy; # controlled y-not
384             $q->cz; # controlled z-not
385             $q->cs; # controlled swap gate
386             $q->rswap; # root swap
387             $q->rnot; # root not
388             $q->ccnot; # toffoli gate
389              
390             =back
391              
392             =head2 state()
393              
394             =over 3
395              
396             # square of the coefficients of this number.
397             # or ... the probability states as percentages for each outcome (seeing a 1 in that location if you looked).
398            
399             my $i = 0;
400             print "chance of outcome:\n";
401             foreach my $percent (@{$q->state}) {
402             $i++;
403             print "$i: $percent%%\n";
404             }
405              
406             =back
407              
408             =head2 raw_state()
409              
410             =over 3
411              
412             # state of raw amplitudes as an array reference ...
413             printf "The coefficients of q: [%s]\n", join(', ', @{$q->state};
414              
415             =back
416              
417             =head2 measure()
418              
419             =over 3
420              
421             # a singular measure based on the current probability state.
422             printf "The answer is: %s\n", $q->measure
423              
424             =back
425              
426             =head2 measures()
427              
428             =over 3
429              
430             # a set of singular measures returned as a hash
431             # the keys match the actual measurements found
432             # and the values of those keys is the number of times that measure was found in the set
433             # first parameter is the number of measures you want to preform ...
434            
435             foreach my $measured ( keys %{$q->measures(1000)} ) {
436             printf "Measured '%d': %d times\n", $measured, $q->{measures}->{ $measured };
437             }
438              
439             =back
440              
441             =head1 SUMMARY
442              
443             =over 3
444              
445             The goal of this project is to provide a minimal universal quantum emulator for coders.
446              
447             Conceptually, things are numbers or objects. Every objects contains two numbers or two objects.
448              
449             If an object contains two numbers it must be complex. If an object contains four numbers it must contain two more objects where each sub-object contains 2 numbers, so that your original number has 4 numbers deeper within it. If an object contains more numbers it must contain more depth and pairs of objects contain pair of objects and so on and so on.
450              
451             Objects of any size can add, multiply, subtract and divide with one another.
452              
453             Objects can be tensored which is similar to storing the products of associative multiplication without completing the summation.
454             ie: real number multiplication: (a+b) × (c+d) = ac + ad + bc + bd
455             tensor product: (a,b) ⊗ (c,d) = ac, ad, bc, bd
456              
457             A gate is a rotational transformation. Rotation transformations are represented by invertible matrix which are there own inverse and can be represented by a Cayley Dickson number.
458              
459             Objects contain Cayley Dickson number representations, so gates are Tangle objects as well.
460              
461             Using a gate with 2 or more inputs will put your state into superposition, so that we can not gleen the individual qbit states from the given probability distribution.
462              
463              
464             Output from binary gates will be objects with 4 numbers, which are attached to the output in a manner which represents lesser and greater binary control over its future changes.
465              
466             We cannot determine the individual states of the input qbits to set them after the gate transformation, we need to attach the input qbits to the gate output so that they each share the same output in different ways.
467              
468             Quantum gates are laid out in series, one after the other. Shared memory from the output of one gate needs to be maintained when an entangled qbit is subsequently put through another gate. This is done by taking the partial products of the gate and its inputs and then stitching that output back to the ends of the existing input ends.
469              
470             A qbit and its gate have no way of knowing whether another variable is sharing its memory, there is no way to update the one without destroying the connection to the other. Since the existing ends could be shared already with existing entangled qbits, the connection between an objects and number needs to be expanded. In this code we preform this by having 3 pointer references between each object and number. This allows two entangled variables to remain entanglment after one of them is put through a gate and its value is changed accordingly.
471              
472             An object is an array containing a pair triple references to either another object or to a number. This represents a Cayley Dickson number which is used to represent the probability state of a quantum computer. The square of the coefficient (number) in each dimension of this object is the probability of seeing a 1 there if you measured in that state. The probabilities of a quantum computer can be thought of as rotations in high dimensions. Cayley Disckson numbers rotate in high dimension by multiplying together.
473              
474             Quantum gates can be represented by static Cayley Dickson numbers and multiplied by existing states in order to produce outputs. In other words, the object used to store your quantum probability state is the same object used to represent quantum gates. ie: this object. Binary quantum gates produce unreduced outputs that are stitched back onto the ends of the inputs with links that share those numbers in different orders. There is seperation between objects and numbers so a number be split into two numbers and all other qbits previously sharing the original number will also automatically share the two new numbers as well.
475            
476              
477             # Sample quantum program:
478             #
479             # This simple example will result in a measurement of |00> or |11> showing entanglement
480             # where the measure of one qbit will always equal the second.
481              
482             my $q1 = Tangle->new(1,0);
483             my $q2 = Tangle->new(1,0);
484             $q1->hadamard;
485             $q1->tensor($q2);
486             printf "measured: %d\n", $q2->measure;
487              
488             =back
489              
490             =head1 AUTHOR
491              
492             Jeff Anderson
493             truejeffanderson@gmail.com
494              
495             =cut
496              
497              
498             1;
499              
500             __END__