/* CU: Symbolic algebra cube This program is by Dave Eaton, 1994 . It is not associated with IBM. It derived from a C program by . Representation and certain routines converted to be able to use REXX translate() for speed. commandline syntax examples: CU L2R2U' CU L2(R2U')12 CU $R2U2D2 the dollar sign means to show internal value System migration notes: Watch out for the vertical bar character (|) Watch out for the square brackets characters ([]) All of the rest of this block comment is future possibilities... CU X=R2U2D2 defines move named 'X' and saves it in file CU LX'L'X you can use new move X like any other CU LIST lists user-defined moves CU HOME resets cube to "home"/"solved" state CU .FR2F'R2 the dot means to compute this without applying it to the current state files: cubestat current cube state cubelib library of named moves */ /* ----- Define moves ----- p. the cubie movements c. the corner cubie twists e. the edge cubie flips (a '4' prefix is just a position holder) Because of the naming of the elements in this array, do not use any one character names for simple variables--or it will mess up the references to these compound variables. */ numeric digits 22 /* allow for the length-20 twist addition */ p.I = 'ABCDEFGHIJKLMNOPQRST' c.I= '400000000' e.I= '4000000000000' p.U = 'BCDAEFGHIJKLNOPMQRST' c.U= '400000000' e.U= '4000000000000' p.D = 'ABCDEFGHLIJKMNOPTQRS' c.D= '400000000' e.D= '4000000000000' p.L = 'AFCDEJBHIGKLMRNPQSOT' c.L= '402100120' e.L= '4010001100100' p.R = 'ABCHDFGLIJKEPNOTMRSQ' c.R= '410022001' e.R= '4000110010001' p.F = 'EBCDIAGHFJKLQMOPRNST' c.F= '421001200' e.F= '4000000000000' p.B = 'ABGDEFKCIJHLMNSOQRTP' c.B= '400210012' e.B= '4000000000000' /* Future moves to define: H, V, and C are the horizontal, vertical, and center slices \\ not yet defined--just identity for now. need centers. E transforms cube into another universe by flipping one edge (uf) \\ define singmaster's universal moves, monotwists, etc. \\ need moves that rotate the whole cube...but then we need to keep track of the centers. (which would also be good for playing with the supergroup of rotatable-centers.) */ I = 'ABCDEFGHIJKLMNOPQRST' IC= '400000000' IE= '4000000000000' I = 'ABCDEFGHIJKLMNOPQRST' IC= '400000000' IE= '4000000000000' I = 'ABCDEFGHIJKLMNOPQRST' IC= '400000000' IE= '4000000000000' I = 'ABCDEFGHIJKLMNOPQRST' IC= '400000000' IE= '4000000000000' I = 'ABCDEFGHIJKLMNOPQRST' IC= '400000000' IE= '4000000000000' names = '', 'uf ul ub ur fr fl bl br df dl db dr urf ulf ulb urb drf dlf dlb drb' /* main: */ signal on novalue arg op showint?=0 if left(op,1)='$' then do showint?=1 op=substr(op,2) end permtwist = seq2perm(op) /* do moves */ if showint? then say permtwist call PrintCycles permtwist /* print result */ exit /*----- F U N C T I O N S -----*/ seq2perm: procedure expose p. c. e. /* recursive */ arg seq /* step pointer p thru seq, building running state (rp,rc,re) */ /* init running state as identity */ rp = p.I rc = c.I re = e.I if seq='' then return rp rc re do pos=1 to length(seq) ch = substr(seq,pos,1) /* get name of move or move sequence and convert to p/c/e */ select when ch=' ' then iterate when ch='(' then do qpos=pos cnt=1 do pos=pos+1 to length(seq) /* find matching parenthesis */ if substr(seq,pos,1)='(' then cnt=cnt+1 if substr(seq,pos,1)=')' then cnt=cnt-1 if cnt=0 then leave end if cnt<>0 then call Error 'Unpaired parentheses.' /* within parens */ parse value Seq2Perm(substr(seq,qpos+1,pos-qpos-1)) with ap ac ae end when datatype(ch,'U') then do if symbol('p.ch')<>'VAR' then call Error "Unknown move '"ch"'." ap = p.ch ac = c.ch ae = e.ch end otherwise call Error "Cannot understand <"ch"> at position" pos "in <"seq">." end /* 'pos' is the last position in 'op' examined. "ap ac ae" is the "p c e" of the move or paren-seq. if next char(s) are digits, raise permtwist to that power. if next char is apostrophe, invert permtwist. */ select when pos=length(seq) then nop when datatype( substr(seq,pos+1,1) ,'N') then do /* POWER */ /* extract n from input */ num='' do pos = pos to length(seq)-1 if datatype( substr(seq,pos+1,1) ,'N')=0 then leave num = num || substr(seq,pos+1,1) end parse value Power(ap ac ae,num) with ap ac ae end when substr(seq,pos+1,1) = "'" then do pos=pos+1 parse value Invert(ap ac ae) with ap ac ae end otherwise nop end /* Apply move to running state */ parse value Compose(rp rc re,ap ac ae) with rp rc re end /* pos thru seq */ return rp rc re Invert: procedure expose p. c. e. arg ap ac ae rp = translate(p.I,p.I,ap) /* perm */ /* twist... */ at = substr(ae,2)||substr(ac,2) /* form twist array */ tt = translate(ap,at,p.I) /* permute twists */ rc = translate('4'right(tt,8) , '21', '12') /* invert corners */ re = '4'left(tt,12) /* invert edges */ /*say 'compose....' time('E')*/ return rp rc re Compose: procedure expose p. c. e. numeric digits 22 arg ap ac ae, bp bc be rp = translate(ap,bp,p.I) /* perm */ /* twist... */ bt = substr(be,2)||substr(bc,2) /* drop the '4' prefix */ tt = translate(ap,bt,p.I) /* apply a's perm to b's twist */ /* \\ or is it?... tt = translate(bt,ap,p.I) */ rc = translate(ac + ('4'right(tt,8)) , '014', '348') /* add twists */ re = translate(ae + ('4'left(tt,12)) , '04' , '28' ) /* add flips */ /* say 'Compose: ' ap ac ae say ' ' bp bc be say ' ' rp rc re */ /*say 'compose....' time('E')*/ return rp rc re Power: procedure expose p. c. e. z=time('R') arg aa, num bb = p.I c.I e.I ss = aa do while num>0 if num//2=1 then do /* is right most bit on? */ tt = Compose(bb,ss) bb = tt end tt = Compose(ss,ss) ss = tt num = num%2 /* binary shift right */ end /*say 'power....' time('E')*/ return bb PrintCycles: procedure expose p. c. e. names arg ap ac ae at = right(ae,12) || right(ac,8) /* drop the '4' placeholders */ line = '' shown?. = 0 order=0 do cubie=1 to 20 if shown?.cubie then iterate /* already shown? */ shown?.cubie=1 if substr(ap,cubie,1)=substr(p.I,cubie,1) & substr(at,cubie,1)=0 then iterate /* home cubicle? */ line = line'('word(names,cubie) tcubie = cubie tsum=0 len=1 tcubie = pos(substr(ap,tcubie,1),p.I) /* lookup then convert to number */ do while tcubie<>cubie /* follow this cycle chain */ line = line word(names,tcubie) shown?.tcubie = 1 tsum = tsum + substr(at,tcubie,1) len = len + 1 tcubie = pos(substr(ap,tcubie,1),p.I) end line = line')' tsum = tsum + substr(at,tcubie,1) if tcubie<12 then do tsum = tsum//2 if tsum<>0 then do line = line'+ ' len = len*2 end end else do tsum = tsum//3 if tsum<>0 then do if tsum=1 then line = line'+' else line = line'-' len = len*3 end end line = line' ' if order=0 then order=len else order = (order*len) / GCD(len, order) end if order=0 then say 'Identity' else say line '['order']' return GCD: procedure /* Euclid's algorithm */ arg n, m if m>n then do r = m//n m = r end do while m>0 r = n//m n = m m = r end return n Error: parse arg op say op exit