packages feed

twisty (empty) → 0.1.0

raw patch · 24 files changed

+2548/−0 lines, 24 filesdep +MonadRandomdep +arraydep +basesetup-changed

Dependencies added: MonadRandom, array, base, containers, data-memocombinators, parallel

Files

+ COPYING.txt view
@@ -0,0 +1,202 @@++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Twisty/Cube.hs view
@@ -0,0 +1,189 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Describes a cube in terms of faces, edges, and vertices.+module Twisty.Cube where++import Twisty.Cycles+import Twisty.FaceTwist+import Twisty.Group+import qualified Twisty.Memo as Memo+import Twisty.Polyhedron+import Twisty.Puzzle+import Twisty.Twists+import Twisty.Wreath+import Twisty.Zn++import Data.Char (isUpper, toLower, toUpper)+import Data.Ix (Ix)+import Data.Maybe (listToMaybe, maybeToList)+import GHC.Enum (boundedEnumFrom, boundedEnumFromThen)++-- | The faces of the cube.  The order is such that the opposite face+-- for face X is the same distance from the back of the list as X is+-- from the front.+data Face = U  -- ^ The \"up\" (top) face.+          | F  -- ^ The front face.+          | L  -- ^ The left face.+          | R  -- ^ The right face.+          | B  -- ^ The back face.+          | D  -- ^ The \"down\" (bottom) face.+          deriving (Eq, Ord, Enum, Bounded, Ix)++oppositeFaceNumber :: Int -> Int+oppositeFaceNumber = (5 -)++oppositeFace :: Face -> Face+oppositeFace = toEnum . oppositeFaceNumber . fromEnum++isOpposite f1 f2 = f1 == oppositeFace f2++instance PolyFace Face where++  newtype PolyEdge Face = Edge Int deriving (Eq, Ord, Ix)+  newtype PolyVertex Face = Vertex Int deriving (Eq, Ord, Ix)++  faceNames = [(U, 'u'), (F, 'f'), (L, 'l'),+               (R, 'r'), (B, 'b'), (D, 'd')]++  neighboringFaces = Memo.array nf+    where nf :: Face -> [Face]+          nf f+            | f < R = let n = fromEnum f+                          firstTwo = map toEnum [(n+1)`mod`3, (n+2)`mod`3]+                      in firstTwo ++ map oppositeFace firstTwo+            | otherwise = reverse . nf . oppositeFace $ f++  allEdgesAsFaces = topEdges ++ middleEdges ++ bottomEdges+    where topEdges = faceEdgesAsFaces U+          middleEdges = [[F, L], [F, R], [B, R], [B, L]]+          bottomEdges = faceEdgesAsFaces D++  allVerticesAsFaces = faceNeighborTriples U ++ faceNeighborTriples D+++-- | The generic cube move type.+type CubeMove depth = FaceTwist Face Twist4 depth++-- | Single-layer cube moves: for 2x2, 3x3 cubes.  These show as just the face+-- and the twist.+type CubeMove1 = CubeMove Z1++-- | Double-layer cube moves: for 4x4, 5x5 cubes.  These use upper case for the+-- face name to indicate moving both layers, and lower case for just the outer+-- layer.+type CubeMove2 = CubeMove Z2++-- | Triple-layer cube moves: for 6x6, 7x7 cubes.  These use an upper case face+-- name followed by a caret to mean moving all 3 layers; upper case for the+-- outer 2 layers; and lower case for the outer layer.+type CubeMove3 = CubeMove Z3++instance Show CubeMove1 where+  showsPrec _ (FaceTwist f t _) = shows f . shows t++instance Read CubeMove1 where+  readsPrec _ "" = []+  readsPrec _ (c:s) = maybeToList $ do+    f <- nameToMaybeFace c+    (t, s') <- listToMaybe (reads s)+    return (FaceTwist f t 0, s')++instance Show CubeMove2 where+  showsPrec _ (FaceTwist f t d) = (if d == 0 then shows else showChar.toUpper.faceToName) f . shows t++instance Read CubeMove2 where+  readsPrec _ "" = []+  readsPrec _ (c:s) = maybeToList $ do+    f <- nameToMaybeFace (toLower c)+    (t, s') <- listToMaybe (reads s)+    return (FaceTwist f t (if isUpper c then 1 else 0), s')++instance Show CubeMove3 where+  showsPrec _ (FaceTwist f t d) = showFace d f . shows t+    where showFace 0 = shows+          showFace 1 = showChar . toUpper . faceToName+          showFace 2 = \f -> showFace 1 f . showChar '^'++instance Read CubeMove3 where+  readsPrec _ "" = []+  readsPrec _ (c:s) = maybeToList $ do+    f <- nameToMaybeFace (toLower c)+    let (d, s') = readDepth (isUpper c) s+    (t, s'') <- listToMaybe (reads s')+    return (FaceTwist f t d, s'')+      where readDepth upper s =+              if upper && not (null s) && head s == '^' then (2, tail s)+              else (if upper then 1 else 0, s)+++-- | The generic twist accumulator for cubes.+type CubeTwists depth = CumulativeTwists Face Twist4 depth++type CubeTwists1 = CubeTwists Z1+type CubeTwists2 = CubeTwists Z2+type CubeTwists3 = CubeTwists Z3+++type Edge = PolyEdge Face+type Vertex = PolyVertex Face++instance WreathPermutable Edge where+  type WreathTwist Edge = Flip++instance WreathPermutable Vertex where+  type WreathTwist Vertex = Twist3++instance Show Face where+  showsPrec _ = showChar . faceToName++instance Read Face where+  readsPrec _ = readSFace++instance Enum Edge where+  toEnum = toBoundedEnum Edge+  fromEnum (Edge e) = e+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded Edge where+  minBound = Edge 0+  maxBound = Edge $ length (allEdgesAsFaces::[[Face]]) - 1++instance Show Edge where+  showsPrec _ = showString . edgeName++instance Read Edge where+  readsPrec _ = readSEdge++instance Enum Vertex where+  toEnum = toBoundedEnum Vertex+  fromEnum (Vertex v) = v+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded Vertex where+  minBound = Vertex 0+  maxBound = Vertex $ length (allVerticesAsFaces::[[Face]]) - 1++instance Show Vertex where+  showsPrec _ = showString . vertexName++instance Read Vertex where+  readsPrec _ = readSVertex
+ Twisty/Cube3.hs view
@@ -0,0 +1,57 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies #-}+-- | Defines the basic 3x3 cube puzzle.+module Twisty.Cube3 where++import Twisty.Cycles+import Twisty.Cube+import Twisty.FaceTwist+import Twisty.Group+import qualified Twisty.Memo as Memo+import Twisty.Polyhedron+import Twisty.Puzzle+import Twisty.Twists+import Twisty.Wreath++import Data.List (elemIndex)+import Data.Maybe (fromJust)+import Data.Monoid (Monoid, mappend, mempty)++newtype Cube3 = Cube3 (Wreath Vertex, Wreath Edge) deriving (Eq, Ord)++instance Monoid Cube3 where+  mempty = Cube3 one+  mappend (Cube3 s1) (Cube3 s2) = Cube3 (s1 $* s2)++instance Group Cube3 where+  ginvert (Cube3 s) = Cube3 (ginvert s)++instance Puzzle Cube3 where+  type Move Cube3 = CubeMove1+  fromMove = Memo.array fromMove1+    where fromMove1 :: CubeMove1 -> Cube3+          fromMove1 (FaceTwist f 1 _) = Cube3 (v, e)+            where v = fromCycles [asCycle' f faceVertices vertexFaces]+                  e = fromCycles [asCycle' f faceEdges edgeFaces]+          fromMove1 (FaceTwist f n d) = fromMove (FaceTwist f 1 d) $^ n++instance Show Cube3 where+  showsPrec _ (Cube3 (v, e)) = fromOptCycles $ optShowCycles v $* optShowCycles e++c3 :: String -> Algorithm Cube3+c3 = read
+ Twisty/Cube3a.hs view
@@ -0,0 +1,60 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies #-}++-- | Defines the \"ad-supported\" 3x3 cube puzzle with faces that have a right+-- way up.+module Twisty.Cube3a where++import Twisty.Cycles+import Twisty.Cube+import Twisty.Cube3+import Twisty.FaceTwist+import Twisty.Group+import qualified Twisty.Memo as Memo+import Twisty.Puzzle+import Twisty.Twists+import Twisty.Wreath++import Data.List (elemIndex)+import Data.Maybe (fromJust)+import Data.Monoid (Monoid, mappend, mempty)++instance WreathPermutable Face where+  type WreathTwist Face = Twist4++newtype Cube3a = Cube3a (Cube3, Wreath Face) deriving (Eq, Ord)++instance Monoid Cube3a where+  mempty = Cube3a one+  mappend (Cube3a s1) (Cube3a s2) = Cube3a (s1 $* s2)++instance Group Cube3a where+  ginvert (Cube3a s) = Cube3a (ginvert s)++instance Puzzle Cube3a where+  type Move Cube3a = CubeMove1+  fromMove = Memo.array fromMove1+    where fromMove1 :: CubeMove1 -> Cube3a+          fromMove1 m@(FaceTwist f 1 _) = Cube3a (fromMove m, fromCycles [[Entry (f, 1)]])+          fromMove1 (FaceTwist f n d) = fromMove (FaceTwist f 1 d) $^ n++instance Show Cube3a where+  showsPrec _ (Cube3a (Cube3 (v, e), f)) = fromOptCycles $ optShowCycles v $* optShowCycles e $* optShowCycles f++c3a :: String -> Algorithm Cube3a+c3a = read
+ Twisty/Cube4.hs view
@@ -0,0 +1,186 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies #-}++-- | Defines the 4x4 cube puzzle.+module Twisty.Cube4 where++import Twisty.Cycles+import Twisty.Cube+import Twisty.FaceTwist+import Twisty.Group+import qualified Twisty.Memo as Memo+import Twisty.Polyhedron+import Twisty.Puzzle+import Twisty.Wreath+import Twisty.Twists+import Twisty.Zn++import Control.Monad (mapM)+import Data.Array.IArray ((!), Array, listArray)+import Data.Char (isUpper, toLower, toUpper)+import Data.Ix (Ix)+import Data.List (elemIndex, transpose)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (fromJust, listToMaybe, maybeToList)+import Data.Monoid (Monoid, mappend, mempty)+import GHC.Enum (boundedEnumFrom, boundedEnumFromThen)++newtype Cube4 = Cube4 (Wreath Vertex, Wreath EdgePiece, Wreath FacePiece) deriving (Eq, Ord)++instance Monoid Cube4 where+  mempty = Cube4 one+  mappend (Cube4 s1) (Cube4 s2) = Cube4 (s1 $* s2)++instance Group Cube4 where+  ginvert (Cube4 s) = Cube4 $ ginvert s++-- | The face pieces, four for each of the cube's faces.+newtype FacePiece = FacePiece Int deriving (Eq, Ord, Ix)++-- | The edge pieces, two for each of the cube's edges.+newtype EdgePiece = EdgePiece Int deriving (Eq, Ord, Ix)++instance Enum FacePiece where+  toEnum = toBoundedEnum FacePiece+  fromEnum (FacePiece i) = i+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded FacePiece where+  minBound = FacePiece 0+  maxBound = FacePiece $ length allFacePiecesAsFaces - 1++instance WreathPermutable FacePiece where+  type WreathTwist FacePiece = Twistless++allFacePiecesAsFaces = concat [faceVerticesAsFaces f | f <- [minBound..]]++facePieceFaces :: FacePiece -> [Face]+facePieceFaces = (facesArray !) . fromEnum+  where facesArray = makeFacesArray allFacePiecesAsFaces++facesToMaybeFacePiece :: [Face] -> Maybe FacePiece+facesToMaybeFacePiece (f:fs) = (f, facesIndex fs) `Map.lookup` fpMap+  where fpMap :: Map (Face, Int) FacePiece+        fpMap = Map.fromList [((f, i), fp) | fp <- [minBound..],+                              let (f:fs) = facePieceFaces fp,+                              let i = facesIndex fs]++facesToFacePiece :: [Face] -> FacePiece+facesToFacePiece = fromJust . facesToMaybeFacePiece++facePieceFace :: FacePiece -> Face+facePieceFace = toEnum . (`div` 4) . fromEnum++faceFacePieces :: Face -> [FacePiece]+faceFacePieces = (piecesArray !)+  where piecesArray :: Array Face [FacePiece]+        piecesArray = listArray (minBound, maxBound)+                      [map facesToFacePiece $ faceVerticesAsFaces f | f <- [minBound..]]++instance Show FacePiece where+  showsPrec _ = showString . toString+    where toString fp = let (fn:fns) = map faceToName $ facePieceFaces fp+                        in fn:'.':fns++instance Read FacePiece where+  readsPrec _ (c1:dot:c2:c3:cs)+   | dot == '.' = maybeToList $ do+       fs <- mapM (nameToMaybeFace . toLower) [c1, c2, c3]+       fp <- facesToMaybeFacePiece fs+       return (fp, cs)+  readsPrec _ _ = []++instance Enum EdgePiece where+  toEnum = toBoundedEnum EdgePiece+  fromEnum (EdgePiece i) = i+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded EdgePiece where+  minBound = EdgePiece 0+  maxBound = EdgePiece $ length allEdgePiecesAsFaces - 1++instance WreathPermutable EdgePiece where+  type WreathTwist EdgePiece = Twistless++allEdgePiecesAsFaces = concat [pieces e | e <- [minBound..]]+  where pieces :: Edge -> [[Face]]+        pieces e = let [f, n] = edgeFaces e+                   in [[f, n, previousNeighbor f n], [f, n, nextNeighbor f n]]++edgePieceFaces :: EdgePiece -> [Face]+edgePieceFaces = (facesArray !) . fromEnum+  where facesArray = makeFacesArray allEdgePiecesAsFaces++facesToMaybeEdgePiece :: [Face] -> Maybe EdgePiece+facesToMaybeEdgePiece [f1, f2, f] = (facesIndex [f1, f2], f) `Map.lookup` epMap+  where epMap :: Map (Int, Face) EdgePiece+        epMap = Map.fromList [((i, f), ep) | ep <- [minBound..],+                              let [f1,f2,f] = edgePieceFaces ep,+                              let i = facesIndex [f1,f2]]++facesToEdgePiece :: [Face] -> EdgePiece+facesToEdgePiece = fromJust . facesToMaybeEdgePiece++edgePieceEdge :: EdgePiece -> Edge+edgePieceEdge = toEnum . (`div` 2) . fromEnum++instance Show EdgePiece where+  showsPrec _ = showString . toString+    where toString ep = let (c1:c2:cs) = map faceToName (edgePieceFaces ep)+                        in c1:c2:'.':cs++instance Read EdgePiece where+  readsPrec _ (c1:c2:dot:c3:cs)+   | dot == '.' = maybeToList $ do+       fs <- mapM (nameToMaybeFace . toLower) [c1, c2, c3]+       ep <- facesToMaybeEdgePiece fs+       return (ep, cs)+  readsPrec _ _ = []+++instance Puzzle Cube4 where+  type Move Cube4 = CubeMove2+  fromMove = Memo.array fromMove2+    where fromMove2 :: CubeMove2 -> Cube4+          fromMove2 (FaceTwist f 1 0) = Cube4 (vw, ew, fw)+            where vw = fromCycles [asCycle' f faceVertices vertexFaces]+                  ew = fromCycles $ map edgeCycle edgePieces+                  fw = fromCycles [asSimpleCycle $ faceFacePieces f]+                  edgeCycle eps = asCycle f eps edgePieceFaces+                  edgePieces = transpose $ map (map facesToEdgePiece)+                               [[[f, f2, f3], [f, f3, f2]] | [_, f2, f3] <- faceVerticesAsFaces f]++          fromMove2 (FaceTwist f 1 1) = Cube4 (one, ew, fw) $* fromMove (FaceTwist f 1 0)+            where ew = fromCycles [asCycle f edgePieces edgePieceFaces]+                  fw = fromCycles $ map asSimpleCycle facePieces+                  edgePieces = map facesToEdgePiece+                               [[f2, f3, f] | [_, f2, f3] <- faceVerticesAsFaces f]+                  facePieces = transpose $ map (map facesToFacePiece)+                               [[[f2, f3, f], [f3, f2, f]] | [_, f2, f3] <- faceVerticesAsFaces f]++          fromMove2 (FaceTwist f n d) = fromMove (FaceTwist f 1 d) $^ n+++instance Show Cube4 where+  showsPrec _ (Cube4 (v, e, f)) = fromOptCycles $ optShowCycles v $* optShowCycles e $* optShowCycles f++c4 :: String -> Algorithm Cube4+c4 = read
+ Twisty/CubeExploration.hs view
@@ -0,0 +1,37 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies #-}++-- | Assembles the modules needed to explore cube-based twisty puzzles.+module Twisty.CubeExploration+       ( module Twisty.Cube+       , module Twisty.Cube3+       , module Twisty.Cube3a+       , module Twisty.Cube4+       , module Twisty.CubeSymmetries+       , module Twisty.Group+       , module Twisty.Puzzle+       )+where++import Twisty.Cube+import Twisty.Cube3+import Twisty.Cube3a+import Twisty.Cube4+import Twisty.CubeSymmetries+import Twisty.Group+import Twisty.Puzzle
+ Twisty/CubeSymmetries.hs view
@@ -0,0 +1,145 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++-- | Operators for transforming algorithms of cube-based puzzles according to+-- the symmetries of the cube.+module Twisty.CubeSymmetries where++import Twisty.Cube+import Twisty.FaceTwist+import Twisty.Polyhedron+import Twisty.Puzzle++-- | Transforms a move by rotating it on the cube a quarter turn clockwise+-- around the given face.+rotateMove :: (Ord d) => Face -> CubeMove d -> CubeMove d+rotateMove f m@(FaceTwist f2 t d)+  | f2 `neighbors` f = FaceTwist (nextNeighbor f f2) t d+  | otherwise        = m++-- | Transforms a move by reflecting it on the cube parallel to the given face.+reflectMove :: (Ord d) => Face -> CubeMove d -> CubeMove d+reflectMove f (FaceTwist f2 t d)+  | f2 `neighbors` f = FaceTwist f2 (-t) d+  | otherwise        = FaceTwist (oppositeFace f2) (-t) d++type CubeSymmetry = forall p d. (Puzzle p, Ord d, Move p ~ CubeMove d) => Algorithm p -> Algorithm p++rotU :: CubeSymmetry -- ^ 1/4 turn around UD axis, clockwise according to U.+rotU = morph (rotateMove U)+rotF :: CubeSymmetry -- ^ 1/4 turn around FB axis, clockwise according to F.+rotF = morph (rotateMove F)+rotL :: CubeSymmetry -- ^ 1/4 turn around LR axis, clockwise according to L.+rotL = morph (rotateMove L)+rotR :: CubeSymmetry -- ^ 1/4 turn around LR axis, clockwise according to R.+rotR = morph (rotateMove R)+rotB :: CubeSymmetry -- ^ 1/4 turn around FB axis, clockwise according to B.+rotB = morph (rotateMove B)+rotD :: CubeSymmetry -- ^ 1/4 turn around UD axis, clockwise according to D.+rotD = morph (rotateMove D)++rotUD :: CubeSymmetry -- ^ 1/2 turn around UD axis.+rotUD = rotU . rotU+rotFB :: CubeSymmetry -- ^ 1/2 turn around FB axis.+rotFB = rotF . rotF+rotLR :: CubeSymmetry -- ^ 1/2 turn around LR axis.+rotLR = rotL . rotL++rotFR :: CubeSymmetry -- ^ 1/2 turn around FR edge.+rotFR = rotFB . rotU+rotFL :: CubeSymmetry -- ^ 1/2 turn around FL edge.+rotFL = rotU . rotFB+rotUL :: CubeSymmetry -- ^ 1/2 turn around UL edge.+rotUL = rotUD . rotF+rotUR :: CubeSymmetry -- ^ 1/2 turn around UR edge.+rotUR = rotF . rotUD+rotUB :: CubeSymmetry -- ^ 1/2 turn around UB edge.+rotUB = rotUD . rotL+rotUF :: CubeSymmetry -- ^ 1/2 turn around UF edge.+rotUF = rotL . rotUD++rotURF :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotURF = rotF . rotU+rotUFR :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotUFR = rotD . rotB+rotUFL :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotUFL = rotU . rotF+rotULF :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotULF = rotB . rotD+rotURB :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotURB = rotF . rotD+rotUBR :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotUBR = rotU . rotB+rotUBL :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotUBL = rotD . rotF+rotULB :: CubeSymmetry -- ^ 1/3 turn around diagonal.+rotULB = rotB . rotU++mirUD :: CubeSymmetry -- ^ Reflection across UD axis.+mirUD = morph (reflectMove U)+mirFB :: CubeSymmetry -- ^ Reflection across FB axis.+mirFB = morph (reflectMove F)+mirLR :: CubeSymmetry -- ^ Reflection across LR axis.+mirLR = morph (reflectMove L)++rotMirU :: CubeSymmetry -- ^ 1/4 turn around, and reflection across, UD axis, clockwise according to U.+rotMirU = rotU . mirUD+rotMirF :: CubeSymmetry -- ^ 1/4 turn around, and reflection across, FB axis, clockwise according to F.+rotMirF = rotF . mirFB+rotMirL :: CubeSymmetry -- ^ 1/4 turn around, and reflection across, LR axis, clockwise according to L.+rotMirL = rotL . mirLR+rotMirR :: CubeSymmetry -- ^ 1/4 turn around, and reflection across, UD axis, clockwise according to R.+rotMirR = rotR . mirLR+rotMirB :: CubeSymmetry -- ^ 1/4 turn around, and reflection across, FB axis, clockwise according to B.+rotMirB = rotB . mirFB+rotMirD :: CubeSymmetry -- ^ 1/4 turn around, and reflection across, LR axis, clockwise according to D.+rotMirD = rotD . mirUD++mirUL :: CubeSymmetry -- ^ Reflection across UL edge.+mirUL = rotF . mirUD+mirUR :: CubeSymmetry -- ^ Reflection across UR edge.+mirUR = mirUD . rotF+mirUF :: CubeSymmetry -- ^ Reflection across UF edge.+mirUF = mirUD . rotL+mirUB :: CubeSymmetry -- ^ Reflection across UB edge.+mirUB = rotL . mirUD+mirFL :: CubeSymmetry -- ^ Reflection across FL edge.+mirFL = mirFB . rotU+mirFR :: CubeSymmetry -- ^ Reflection across FR edge.+mirFR = rotU . mirFB++rotMirUFL :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirUFL = rotURF . mirFB+rotMirUBL :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirUBL = mirFB . rotURF+rotMirULB :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirULB = rotUFR . mirFB+rotMirULF :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirULF = mirFB . rotUFR+rotMirURF :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirURF = rotUBL . mirFB+rotMirURB :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirURB = mirFB . rotUBL+rotMirUFR :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirUFR = mirFB . rotULB+rotMirUBR :: CubeSymmetry -- ^ 1/6 turn around, and reflection across, diagonal.+rotMirUBR = rotULB . mirFB++mir :: CubeSymmetry -- ^ Reflection across center of cube.+mir = mirUD . mirFB . mirLR
+ Twisty/Cycles.hs view
@@ -0,0 +1,54 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Twisty.Cycles where++import Twisty.Group+import Twisty.Lists+import Twisty.Wreath++import Data.List (elemIndex)+import Data.Maybe (fromJust)+++-- | Creates a cycle from a face, a list of pieces, and a function that maps a+-- piece to its constituent faces.  Calculates the twist for each piece as the+-- difference in location of the face within each pair of pieces' faces.+asCycle :: forall f a. (Eq f, WreathPermutable a, Num (WreathTwist a)) =>+           f -> [a] -> (a -> [f]) -> [WreathEntry a]+asCycle f as toFs = zipWith toEntry as twists+  where toEntry a t = Entry (a, t)+        indices = map indexIn as+        indexIn a = toInteger $ fromJust $ f `elemIndex` toFs a+        twists = zipWith toTwist indices $ rotate 1 indices+        toTwist i j = fromInteger (i - j)+++-- | A variant of asCycle for when the list of pieces is more readily accessible+-- as a function of the face.+asCycle' :: forall f a. (Eq f, WreathPermutable a, Num (WreathTwist a)) =>+            f -> (f -> [a]) -> (a -> [f]) -> [WreathEntry a]+asCycle' f toAs = asCycle f (toAs f)+++-- | Creates a cycle from a list of pieces, for situations where no twisting is+-- possible.+asSimpleCycle :: forall a. (WreathPermutable a) => [a] -> [WreathEntry a]+asSimpleCycle as = map toEntry as+  where toEntry a = Entry (a, one)
+ Twisty/Dodeca.hs view
@@ -0,0 +1,143 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies, TypeSynonymInstances #-}++-- | Describes a dodecahedron in terms of faces, edges, and vertices.+module Twisty.Dodeca where++import Twisty.Cycles+import Twisty.Group+import Twisty.Lists+import qualified Twisty.Memo as Memo+import Twisty.Polyhedron+import Twisty.Twists+import Twisty.Wreath++import Data.Array.IArray (Ix, (!), Array, listArray)+import Data.List (transpose)+import GHC.Enum (boundedEnumFrom, boundedEnumFromThen)++-- | The faces of the dodecahedron.  The north polar face is An, and+-- the remaining northern hemisphere faces are Xn, X in (B..F).  The+-- opposite face to Xn is Xs.  The order is such that the opposite+-- face for face X is the same distance from the back of the list as X+-- is from the front.+data Face = An | Bn | Cn | Dn | En | Fn | Fs | Es | Ds | Cs | Bs | As+          deriving (Eq, Ord, Enum, Bounded, Ix)++oppositeFaceNumber :: Int -> Int+oppositeFaceNumber = (11 -)++oppositeFace :: Face -> Face+oppositeFace = toEnum . oppositeFaceNumber . fromEnum++isOpposite f1 f2 = f1 == oppositeFace f2++instance PolyFace Face where++  newtype PolyEdge Face = Edge Int deriving (Eq, Ord, Ix)+  newtype PolyVertex Face = Vertex Int deriving (Eq, Ord, Ix)++  faceNames = [(An, 'A'), (Bn, 'B'), (Cn, 'C'), (Dn, 'D'), (En, 'E'), (Fn, 'F'),+               (As, 'a'), (Bs, 'b'), (Cs, 'c'), (Ds, 'd'), (Es, 'e'), (Fs, 'f')]++  neighboringFaces = Memo.array nf+    where nf :: Face -> [Face]+          nf f+            | f == An = [Bn, Cn, Dn, En, Fn]+            | f <= Fn = let same n = toEnum (1 + (fromEnum f - 1 + n) `mod` 5)+                            opp = oppositeFace . same+                      in [An, same(-1), opp 2, opp(-2), same 1]+            | otherwise = map oppositeFace $ reverse . nf . oppositeFace $ f++  -- | The distinguished faces for dodecahedron edges are: the north or south+  -- polar face, for the ten polar edges; and the faces which would move the+  -- edge to a polar face if the face were rotated clockwise (north) or+  -- counterclockwise (south) once or twice, for the ten vertical and ten+  -- equatorial edges.+  allEdgesAsFaces = polarEdges ++ verticalEdges ++ equatorialEdges+    where polarEdges = faceEdgesAsFaces An ++ faceEdgesAsFaces As+          verticalEdges = northVerticalEdges ++ invert northVerticalEdges+          equatorialEdges = northEquatorialEdges ++ invert northEquatorialEdges+          northVerticalEdges = transpose [northNeighbors, rotate 1 northNeighbors]+          northEquatorialEdges = transpose [northNeighbors,+                                            map oppositeFace $ rotate 3 northNeighbors]+          northNeighbors = neighboringFaces An+          invert = map (map oppositeFace)++  -- | The distinguished faces for dodecahedron vertices are: the north or south+  -- polar face, for the ten polar vertices; and the face which would move the+  -- vertex to a polar face if the face were rotated clockwise (north) or+  -- counterclockwise (south), for the ten equatorial vertices.+  allVerticesAsFaces = polarVertices ++ equatorialVertices+    where polarVertices = faceNeighborTriples An ++ faceNeighborTriples As+          equatorialVertices = northEquatorialVertices ++ invert northEquatorialVertices+          northEquatorialVertices = transpose [fs1, fs2, fs3]+            where fs1 = neighboringFaces An+                  fs2 = map oppositeFace $ rotate 3 fs1+                  fs3 = rotate 1 fs1+          invert = map invertFaces+          invertFaces = swapFaces . map oppositeFace+          swapFaces [f1, f2, f3] = [f1, f3, f2]+++type Edge = PolyEdge Face+type Vertex = PolyVertex Face++instance WreathPermutable Edge where+  type WreathTwist Edge = Flip++instance WreathPermutable Vertex where+  type WreathTwist Vertex = Twist3++instance Show Face where+  showsPrec _ = showChar . faceToName++instance Read Face where+  readsPrec _ = readSFace++instance Enum Edge where+  toEnum = toBoundedEnum Edge+  fromEnum (Edge e) = e+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded Edge where+  minBound = Edge 0+  maxBound = Edge $ length (allEdgesAsFaces::[[Face]]) - 1++instance Show Edge where+  showsPrec _ = showString . edgeName++instance Read Edge where+  readsPrec _ = readSEdge++instance Enum Vertex where+  toEnum = toBoundedEnum Vertex+  fromEnum (Vertex v) = v+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded Vertex where+  minBound = Vertex 0+  maxBound = Vertex $ length (allVerticesAsFaces::[[Face]]) - 1++instance Show Vertex where+  showsPrec _ = showString . vertexName++instance Read Vertex where+  readsPrec _ = readSVertex
+ Twisty/FaceTwist.hs view
@@ -0,0 +1,91 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++-- | Defines the 'FaceTwist' type, which describes the possible moves of a+-- twisty puzzle.  Also defines 'CumulativeTwists', a way to characterize+-- algorithms that is useful for finding good algorithms.+module Twisty.FaceTwist+       ( FaceTwist(..)+       , CumulativeTwists+       , emptyTwists+       , updateTwists+       )+where++import Twisty.Group+import qualified Twisty.Memo as Memo+import Twisty.Polyhedron+import Twisty.Puzzle++import Data.Ix (Ix)+import Data.Map (Map)+import qualified Data.Map as Map+--import Data.Maybe (listToMaybe, maybeToList)++-- | Each value has a face to twist, the number of layers to twist, and how far+-- to twist.+data (PolyFace face, Group twist, Ord twist, Ord depth) =>+     FaceTwist face twist depth = FaceTwist face twist depth deriving (Eq, Bounded, Ix)++instance (PolyFace f, Group t, Ord t, Ord d) => Ord (FaceTwist f t d) where+  -- | Larger depths compare as less, to match the normal way of twisting:+  -- deeper moves come before shallower ones.+  compare (FaceTwist f1 t1 d1) (FaceTwist f2 t2 d2) = compare (f1, d2, t1) (f2, d1, t2)++instance (PolyFace f, Group t, Bounded t, Ord t, Ix t, Bounded d, Ord d, Ix d) =>+         PuzzleMove (FaceTwist f t d) where+  undoMove (FaceTwist f t d) = FaceTwist f (ginvert t) d++  joinMoves = table (Memo.array jm)+    where table memo move1 move2 = memo (move1, move2)+          jm (m1@(FaceTwist f1 t1 d1), m2@(FaceTwist f2 t2 d2))+            | f1 == f2 && d1 == d2   = let t = t1 $* t2 in+                                       if t == one then [] else [FaceTwist f1 t d1]+            | f1 `neighbors` f2      = [m1, m2]+            | otherwise              = [max m1 m2, min m1 m2]++  isTrivialMove (FaceTwist _ t _) = t == one++-- These default defs cause overlapping instances:+-- instance (PolyFace f, Show f, Group t, Ord t, Show t, Ord d, Show d) =>+--          Show (FaceTwist f t d) where+--   showsPrec _ (FaceTwist f t d) = shows f . shows d . shows t++-- instance (PolyFace f, Read f, Group t, Ord t, Read t, Ord d, Read d) =>+--          Read (FaceTwist f t d) where+--   readsPrec _ "" = []+--   readsPrec _ (c:s) = maybeToList $ do+--     f <- nameToMaybeFace c+--     (d, s') <- listToMaybe (reads s)+--     (t, s'') <- listToMaybe (reads s')+--     return (FaceTwist f t d, s'')+++-- | Adds up all the twists associated with each (face, depth) pair.+type CumulativeTwists f t d = Map (f, d) t++emptyTwists :: CumulativeTwists f t d+emptyTwists = Map.empty++updateTwists :: (PolyFace f, Group t, Ord t, Ord d) =>+                CumulativeTwists f t d -> FaceTwist f t d -> CumulativeTwists f t d+updateTwists ct (FaceTwist f t d) = Map.alter applyTwist (f, d) ct+  where applyTwist = toMaybe . ($* t) . fromMaybe+        fromMaybe Nothing = one+        fromMaybe (Just t) = t+        toMaybe t+          | t == one  = Nothing+          | otherwise = Just t
+ Twisty/Group.hs view
@@ -0,0 +1,113 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++-- | Defines the 'Group' class as an extension of the standard 'Monoid' class.+-- Extends several of the standard Monoid instances to be Groups.  Defines some+-- synonyms and operators to make it easier to work with monoids and groups.+module Twisty.Group where++import Data.Monoid (Monoid, mappend, mempty, Dual(..), Sum(..))++-- | We extend Monoid to make a group class, by adding an inverse operator.+class (Monoid a) => Group a where+  ginvert :: a -> a+  -- ^ Returns the inverse of the given group element, ie the element that+  -- yields 'mempty' when 'mappend'-ed to the original element.+++-- | This is a synonym for 'mempty', using a common group-theoretic name for the+-- group's identity.+one :: Monoid m => m+one = mempty++-- | This is a synonym for 'mappend', the group's operation.  The mnemonic here+-- is that a group's operation is sort of a cross between multiplication and+-- function application.+($*) :: Monoid m => m -> m -> m+($*) = mappend+infixl 7 $* -- matches (*)++-- | Raises a group element to an integral power, ie applying it to itself n+-- times, where n can also be 0 (returns the identity) or negative (uses the+-- inverse).+($^) :: (Group g, Integral n) => g -> n -> g+infixr 8 $^ -- matches (^)+-- This version of $^ is copied from Data.Group.Combinators.replicate in the+-- "monoids" package.+base $^ exp+  | exp < 0   = ginvert base $^ negate exp+  | exp == 0  = one+  | otherwise = f base exp+    where+      f base exp+        | exp == 1  = base+        | even exp  = f (base $* base) (exp `quot` 2)+        | otherwise = g (base $* base) (exp `quot` 2) base+      g base exp acc+        | exp == 1  = base $* acc+        | even exp  = g (base $* base) (exp `quot` 2) acc+        | otherwise = g (base $* base) (exp `quot` 2) (base $* acc)+++-- Some Group defs corresponding to (some of) the basic Monoid defs:+instance (Group b) => Group (a -> b) where+  ginvert f x = ginvert (f x)++instance Group () where+  ginvert () = ()++instance (Group a, Group b) => Group (a, b) where+  ginvert (a, b) = (ginvert a, ginvert b)++instance (Group a, Group b, Group c) => Group (a, b, c) where+  ginvert (a, b, c) = (ginvert a, ginvert b, ginvert c)++instance (Group a, Group b, Group c, Group d) => Group (a, b, c, d) where+  ginvert (a, b, c, d) = (ginvert a, ginvert b, ginvert c, ginvert d)++instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) where+  ginvert (a, b, c, d, e) = (ginvert a, ginvert b, ginvert c, ginvert d, ginvert e)++instance (Group a) => Group (Dual a) where+  ginvert (Dual x) = Dual (ginvert x)++instance (Num a) => Group (Sum a) where+  ginvert (Sum x) = Sum (negate x)+++-- | The conjugate of y according to x: @x '$*' y $* 'ginvert' x@.+conjugate :: (Group g) => g -- ^ x+             -> g -- ^ y+             -> g+conjugate x y = x $* y $* ginvert x++-- | An operator for conjugate.  Mnemonic: normal group operation on the+-- arguments followed by appending the inverse of the first argument.+($*~) :: (Group g) => g -> g -> g+($*~) = conjugate+infixl 6 $*~    -- matches +, lower than $*++-- | The commutator of x and y: @x '$*' y $* 'ginvert' x $* ginvert y@.+commutator :: (Group g) => g -- ^ x+              -> g -- ^ y+              -> g+commutator x y = x $* y $* ginvert x $* ginvert y++-- | An operator for commutator.  Mnemonic: normal group operation on the+-- arguments followed by appending the inverses of both arguments.+($*~~) :: (Group g) => g -> g -> g+($*~~) = commutator+infixl 6 $*~~   -- matches +
+ Twisty/Lists.hs view
@@ -0,0 +1,21 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++-- | List utilities.+module Twisty.Lists where++-- | Rotates a list by n places.+rotate n xs = drop n xs ++ take n xs
+ Twisty/Memo.hs view
@@ -0,0 +1,28 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE ScopedTypeVariables #-}+-- | Building on Data.MemoCombinators.+module Twisty.Memo (+  module Data.MemoCombinators+  , array+  ) where++import Data.Ix (Ix)+import Data.MemoCombinators++array :: forall a. (Bounded a, Ix a) => Memo a+array = unsafeArrayRange (minBound, maxBound)
+ Twisty/Polyhedron.hs view
@@ -0,0 +1,239 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeFamilies #-}++-- | Defines a type class for polyhedra that ties together its faces, edges, and+-- vertices.+module Twisty.Polyhedron where++import Data.Array.IArray ((!), Array, Ix, array, listArray)+import Data.Bits ((.|.), bit, shiftL)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.List (inits, tails)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (fromJust, maybeToList)+++-- | A class for the faces of polyhedra used as the bases for twisty puzzles;+-- contains associated types for the edges and verrtices.+class (Enum f, Bounded f, Ix f,+       Enum (PolyEdge f), Bounded (PolyEdge f),+       Enum (PolyVertex f), Bounded (PolyVertex f))+      => PolyFace f where+  data PolyEdge f+  data PolyVertex f++  faceNames :: [(f, Char)]+  -- ^ Every face of the polyhedron must be identified by a single character,+  -- and listed here.++  neighboringFaces :: f -> [f]+  -- ^ The faces that touch a given face, in clockwise order.++  allEdgesAsFaces :: [[f]]+  -- ^ All the edges, as length-2 lists of faces with the distinguished face+  -- first.++  allVerticesAsFaces :: [[f]]+  -- ^ All the vertices, as lists of their faces.  The faces must appear in+  -- clockwise order, starting with the vertex's distinguished face.+++-- | A face's single-character name.+faceToName :: (PolyFace f) => f -> Char+faceToName = (nameArray !)+  where nameArray :: (PolyFace f) => Array f Char+        nameArray = array (minBound, maxBound) faceNames++-- | Converts back from a face's name to the face.+nameToFace :: (PolyFace f) => Char -> f+nameToFace = fromJust . nameToMaybeFace++-- | Converts back from a face's name to the face, if it is one.+nameToMaybeFace :: (PolyFace f) => Char -> Maybe f+nameToMaybeFace = flip Map.lookup faceMap+  where faceMap :: (PolyFace f) => Map Char f+        faceMap = Map.fromList $ map (\(f, c) -> (c, f)) faceNames++-- | Converts a list of faces into an int, as a bit set.+facesIndex :: forall f. (PolyFace f) => [f] -> Int+facesIndex [] = 0+facesIndex (f:fs) = toBit f .|. facesIndex fs+  where toBit f = bit $ fromEnum f - fromEnum (minBound::f)++-- | The neighbor just counterclockwise of the given face's given neighbor.+previousNeighbor :: (PolyFace f) => f -> f -> f+previousNeighbor f n = if n == head ns then last ns else prev ns+  where ns = neighboringFaces f+        prev (f:fs@(f2:_)) = if n == f2 then f else prev fs++-- | The neighbor just clockwise of the given face's given neighbor.+nextNeighbor :: (PolyFace f, Show f) => f -> f -> f+nextNeighbor f n = next ns+  where ns = neighboringFaces f+        next (f:fs@(f2:_)) = if n == f then f2 else next fs+        next [f] = if n == f then head ns+                   else error (show n ++ " isn't a neighbor of " ++ show origF)+        origF = f++-- | Tells whether two faces are neighbors.+neighbors :: (PolyFace f) => f -> f -> Bool+neighbors f = flip elem $ neighboringFaces f++-- | The edges of a given face, as length-2 lists of their faces.  The given+-- face appears first.+faceEdgesAsFaces :: (PolyFace f) => f -> [[f]]+faceEdgesAsFaces f = map (\f2 -> [f, f2]) $ neighboringFaces f++-- | The canonical name of an edge.+edgeName :: (PolyFace f) => PolyEdge f -> String+edgeName = map faceToName . edgeFaces++-- | The 2 faces of an edge, in canonical order.+edgeFaces :: (PolyFace f) => PolyEdge f -> [f]+edgeFaces = (facesArray !) . fromEnum+  where facesArray = makeFacesArray allEdgesAsFaces++-- | Converts a string containing 2 face names into the+-- corresponding edge.+nameToEdge :: (PolyFace f) => String -> PolyEdge f+nameToEdge = facesToEdge . map nameToFace++-- | Converts a pair of faces into the corresponding edge.+facesToEdge :: (PolyFace f) => [f] -> PolyEdge f+facesToEdge = fromJust . facesToMaybeEdge++-- | Converts a pair of faces into the corresponding edge, if there is one.+facesToMaybeEdge :: (PolyFace f) => [f] -> Maybe (PolyEdge f)+facesToMaybeEdge = flip IntMap.lookup edgeMap . facesIndex+  where edgeMap = makeFaceBitsetMap edgeFaces++-- | The edges that belong to a given face, in clockwise order.+faceEdges :: (PolyFace f) => f -> [PolyEdge f]+faceEdges = (edgesArray !)+  where edgesArray :: (PolyFace f) => Array f [PolyEdge f]+        edgesArray = listArray (minBound, maxBound)+                     [es f | f <- [minBound..]]+        es :: (PolyFace f) => f -> [PolyEdge f]+        es = map facesToEdge . efs+        efs f = map (\f2 -> [f, f2]) (neighboringFaces f)+++-- | The vertices of a given face, as lists of the faces that meet at each+-- vertex.  The faces for each vertex appear in clockwise order starting with+-- the given face.  And the vertices corresponding to the lists of faces are+-- also in clockwise order.+faceVerticesAsFaces :: forall f. (PolyFace f) => f -> [[f]]+faceVerticesAsFaces f = map vfs $ neighboringFaces f+  where vfs :: f -> [f]+        vfs f2 = (Map.!) facesMap (f, f2)+        facesMap :: Map (f, f) [f]+        facesMap = Map.fromList $ concatMap fvs allVerticesAsFaces+        fvs :: [f] -> [((f, f), [f])]+        fvs = map indexFaces . allRotations+        allRotations :: [f] -> [[f]]+        allRotations fs = map (uncurry (++)) $ tail $ zip (tails fs) (inits fs)+        indexFaces :: [f] -> ((f, f), [f])+        indexFaces fs@(f1:f2:_) = ((f1, f2), fs)++-- | The canonical name of a vertex.+vertexName :: (PolyFace f) => PolyVertex f -> String+vertexName = map faceToName . vertexFaces++-- | The faces of a vertex, in canonical order.+vertexFaces :: (PolyFace f) => PolyVertex f -> [f]+vertexFaces = (facesArray !) . fromEnum+  where facesArray = makeFacesArray allVerticesAsFaces++-- | Converts a string containing face names into the corresponding vertex.+nameToVertex :: (PolyFace f) => String -> PolyVertex f+nameToVertex = facesToVertex . map nameToFace++-- | Converts a list of faces into the corresponding vertex.+facesToVertex :: (PolyFace f) => [f] -> PolyVertex f+facesToVertex = fromJust . facesToMaybeVertex++-- | Converts a list of faces into the corresponding vertex, if there is one.+facesToMaybeVertex :: (PolyFace f) => [f] -> Maybe (PolyVertex f)+facesToMaybeVertex = flip IntMap.lookup vertexMap . facesIndex+  where vertexMap = makeFaceBitsetMap vertexFaces++-- | The vertices that belong to a given face, in clockwise order.+faceVertices :: forall f. (PolyFace f) => f -> [PolyVertex f]+faceVertices = (verticesArray !)+  where verticesArray :: Array f [PolyVertex f]+        verticesArray = listArray (minBound, maxBound)+                        [vs f | f <- [minBound..]]+        vs :: f -> [PolyVertex f]+        vs = map facesToVertex . faceVerticesAsFaces+++-- | A helper to implement edgeFaces and vertexFaces.  Makes an array from a+-- list of lists of faces, such as allVerticesAsFaces and allEdgesAsFaces.+makeFacesArray :: [[f]] -> Array Int [f]+makeFacesArray fss = listArray (0, length fss - 1) fss++-- | A helper to implement facesToMaybeEdge and facesToMaybeVertex.  Makes a map+-- that maps a bit-set of face numbers to either edges or vertices.+makeFaceBitsetMap :: (Enum a, Bounded a, PolyFace f) =>+                     (a -> [f]) -> IntMap a+makeFaceBitsetMap xxFaces =+  IntMap.fromList [(i, a) | a <- [minBound..], let i = facesIndex $ xxFaces a]++-- | A helper to implement the toEnum methods of edge and vertex types.+toBoundedEnum :: forall a. (Bounded a, Enum a) => (Int -> a) -> Int -> a+toBoundedEnum ctor i = if i < fromEnum (minBound::a) || i > fromEnum (maxBound::a)+                       then error "Enum out of bounds"+                       else ctor i++-- | A helper to implement allVerticesAsFaces for polyhedra with 3 faces per+-- vertex.+faceNeighborTriples :: (PolyFace f) => f -> [[f]]+faceNeighborTriples f = vt ns $ tail $ cycle ns+  where ns = neighboringFaces f+        vt [] _ = []+        vt (x:xs) (y:ys) = [f, x, y] : vt xs ys+++-- | A helper to implement Read for face types.+readSFace :: (PolyFace f) => ReadS f+readSFace (c:cs) = maybeToList $ do+  f <- nameToMaybeFace c+  return (f, cs)+readSFace _ = []++-- | A helper to implement Read for edge types.+readSEdge :: (PolyFace f) => ReadS (PolyEdge f)+readSEdge (c1:c2:cs) = maybeToList $ do+  f1 <- nameToMaybeFace c1+  f2 <- nameToMaybeFace c2+  e <- facesToMaybeEdge [f1, f2]+  return (e, cs)+readSEdge _ = []++-- | A helper to implement Read for vertex types (for polyhedra whose vertices+-- have 3 faces).+readSVertex :: (PolyFace f) => ReadS (PolyVertex f)+readSVertex (c1:c2:c3:cs) = maybeToList $ do+  f1 <- nameToMaybeFace c1+  f2 <- nameToMaybeFace c2+  f3 <- nameToMaybeFace c3+  v <- facesToMaybeVertex [f1, f2, f3]+  return (v, cs)+readSVertex _ = []
+ Twisty/Puzzle.hs view
@@ -0,0 +1,177 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Defines types representing twisty puzzles and algorithms for manipulating+-- them.+module Twisty.Puzzle+       ( Puzzle(..)+       , PuzzleMove(..)+       , Algorithm+       , result+       , moves+       , moveCount+       , isNontrivial+       , lastMove+       , foldMoves+       , applyMove+       , morph+       )+where++import Twisty.Group++import Data.List (foldl')+import Data.Maybe (listToMaybe)+import Data.Monoid (Monoid, mappend, mempty)+import Text.ParserCombinators.ReadP+import Text.ParserCombinators.ReadPrec (lift)+import Text.Read hiding ((<++))+++-- | A class for the moves that can be performed on a twisty puzzle.+class Eq m => PuzzleMove m where+  undoMove :: m -> m+  -- ^ The move that undoes the given move.  This means that @joinMoves m+  -- (undoMove m)@ (and vice versa) must equal the empty list.+  --+  -- Also, for any Puzzle instance that uses this move type, @fromMove m $*+  -- fromMove (undoMove m)@ (and vice versa) must equal the Puzzle's @one@.++  joinMoves :: m -> m -> [m]+  -- ^ Combines two moves.  If they are opposites, returns the empty list.  If+  -- they can be combined into a single move, returns a list containing that+  -- single move.  If they do not interact, returns the same two moves but in a+  -- canonical order (ie, passing the same two moves in the opposite order will+  -- return the same list).  And if they do interact, returns the same two moves+  -- in the same order.++  isTrivialMove :: m -> Bool+  -- ^ Tells whether the given move is trivial, ie, is equivalent to not moving.+++-- | A class for twisty puzzle states.+class (Group p, Show p, PuzzleMove (Move p)) => Puzzle p where++  type Move p+  -- ^ The associated move type.  For example, a move for a standard Rubik's+  -- cube might be \"twist the top face a quarter-turn clockwise.\"++  fromMove :: Move p -> p+  -- ^ Converts the given move to the associated puzzle state.+++-- | An Algorithm combines a list of moves with the resulting puzzle state.+data (Puzzle p) => Algorithm p =+  Algorithm+  { rMoves :: [Move p] -- ^ The list of moves, in reverse order (most recent first).+  , result :: p        -- ^ The resulting puzzle state.+  }++-- | Is this a non-trivial algorithm?+isNontrivial :: (Puzzle p) => Algorithm p -> Bool+isNontrivial = not . null . rMoves++-- | For non-trivial algorithms only, the algorithm's last move.  Because+-- Algorithm canonicalizes the order of moves, this could be different from the+-- move you most recently appended.+lastMove :: (Puzzle p) => Algorithm p -> Move p+lastMove = head . rMoves++-- | The list of moves that comprises the algorithm.+moves :: (Puzzle p) => Algorithm p -> [Move p]+moves = reverse . rMoves++-- | The number of moves in an algorithm.+moveCount :: (Puzzle p) => Algorithm p -> Int+moveCount = length . rMoves++-- | Accumulates values over an algorithm's moves, from most recent to oldest+-- move.+foldMoves :: (Puzzle p, Monoid m) => (Move p -> m) -> Algorithm p -> m+foldMoves op = foldl' (\val -> (val $*) . op) one . rMoves++-- | Equality testing for Algorithms.  Just comparing the moves works because we+-- canonicalize their order.+instance (Puzzle p) => Eq (Algorithm p) where+  a == b = rMoves a == rMoves b++-- | Algorithms are groups.+instance (Puzzle p) => Monoid (Algorithm p) where+  mempty = Algorithm [] one+  mappend (Algorithm ms1 s1) (Algorithm ms2 s2) = Algorithm ms (s1 $* s2)+    where ms = foldr prependMove ms1 ms2++-- | Algorithms are groups.+instance (Puzzle p) => Group (Algorithm p) where+  ginvert (Algorithm ms p) = Algorithm ms' (ginvert p)+    where ms' = foldl' (flip (prependMove . undoMove)) [] ms++-- | Adds a move to an algorithm.+applyMove :: (Puzzle p) => Algorithm p -> Move p -> Algorithm p+applyMove a@(Algorithm ms p) m = Algorithm (prependMove m ms) (p $* fromMove m)++-- | Prepends a move to a list of moves, maintaining canonicalization as+-- implemented by 'joinMoves'.+prependMove :: (PuzzleMove m) => m -> [m] -> [m]+prependMove m []+  | isTrivialMove m = []+  | otherwise       = [m]+prependMove m l@(pm:ms)+  | isTrivialMove m = l+  | otherwise       = case joinMoves m pm of+    [] -> ms+    [m'] -> m' : ms+    [m1, m2] -> if m2 == pm then m1 : l+                else m1 : prependMove m2 ms++-- | Transforms an algorithm to a related algorithm by transforming each move in+-- the list.+morph :: forall p. (Puzzle p) => (Move p -> Move p) -> Algorithm p -> Algorithm p+morph f (Algorithm ms _) = foldr g one ms+  where g = flip applyMove . f++-- | Algorithms are displayed as their moves in order, some spaces, and the+-- resulting puzzle state.+instance (Puzzle p, Show (Move p)) => Show (Algorithm p) where+  showsPrec _ (Algorithm ms p) = showMoves ms . showString "    " . shows p+    where showMoves = foldl' op id+          f `op` m = shows m . f++instance (Puzzle p, Read (Move p)) => Read (Algorithm p) where+  readPrec = lift $ readAndApply mempty+    where readAndApply alg =+            do skipSpaces+               m <- readS_to_P reads+               readAndApply (alg `applyMove` m)+            <+++            do optional skipParens+               return alg++          skipParens = do+            skipSpaces+            char '('+            munch (\c -> c /= '(' && c /= ')')+            optional skipParens+            char ')'+            optional skipParens++  readList = readListDefault+  readListPrec = readListPrecDefault
+ Twisty/Searching.hs view
@@ -0,0 +1,89 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE FlexibleContexts #-}++-- | Functions for finding algorithms that satisfy some given conditions.+module Twisty.Searching where++import Twisty.Group+import Twisty.Puzzle++import Control.Monad+import Control.Monad.Random+import Control.Parallel.Strategies+import Data.Set (Set)+import qualified Data.Set as Set+++-- | Given a root node, and a way to calculate the children of a node, does a+-- parallel depth-first walk of the implied tree looking for nodes that satisfy+-- a given predicate.  We wrap the search in a monad, to allow for randomness+-- and I/O in the callbacks.+--+-- Typically the trees in question will be successive algorithms through a+-- twisty puzzle.  We've generalized the types to allow for additional state to+-- be included with the algorithms, for efficiency's sake: this extra state can+-- be maintained incrementally rather than recalculated for each node.+searchTree :: (Monad m) => (a -> Bool -> m [a]) -> (a -> m Bool) -> m a -> m [a]+searchTree calcChildren satisfies root = root >>= st+  where st node = do+          sat <- satisfies node+          let this = [return [node] | sat]+          children <- calcChildren node sat+          let results = this ++ map st children+          concatM results+++concatM :: (Monad m) => [m [a]] -> m [a]+concatM = liftM concat . sequence++-- | For nodes that encapsulate twisty algorithms, produces a list of successor+-- algorithms given a way to generate moves.+generateChildren :: (Monad m, Puzzle p, Ord (Move p)) =>+                    (a -> Algorithm p) -> (a -> m (Move p)) -> Int -> a -> m [Algorithm p]+generateChildren getAlg genMove count node = collect 0 Set.empty []+  where alg = getAlg node+        collect n seen algs+          | n >= count  = return algs+          | otherwise   = do mv <- genMove node+                             if mv `Set.member` seen then collect n seen algs+                               else let alg' = alg `applyMove` mv+                                        seen' = mv `Set.insert` seen+                                    in if isNontrivial alg' && lastMove alg' == mv+                                       then collect (n+1) seen' (alg':algs)+                                       else collect n seen' algs++-- | Stops generating children after reaching algorithms of a particular length.+generateChildrenToLength :: (Monad m, Puzzle p, Ord (Move p)) =>+                            Int -> (a -> Algorithm p) -> (a -> m (Move p)) -> Int -> a -> m [Algorithm p]+generateChildrenToLength len getAlg genMove count node =+  if (moveCount . getAlg) node >= len+  then return []+  else generateChildren getAlg genMove count node+++-- | Returns a stream of deterministic random number generators given a seed.+seededStdGens :: Int -> IO [StdGen]+seededStdGens = return . stdGenToStream . mkStdGen++-- | A stream of random number generators.+stdGenStream :: IO [StdGen]+stdGenStream = fmap stdGenToStream newStdGen++-- | Returns a stream of random number generators given an initial generator.+stdGenToStream :: StdGen -> [StdGen]+stdGenToStream gen = let (g1, g2) = split gen in g1 : stdGenToStream g2
+ Twisty/Strings.hs view
@@ -0,0 +1,31 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++-- | String utilities.+module Twisty.Strings where++import Data.Monoid (Endo(..))++-- | A monoidal optional string showing function.  Combine with mappend.+type OptS = Maybe (Endo String)++-- | Creates an OptS from a show function.+toOptS :: ShowS -> OptS+toOptS f = Just (Endo f)++-- | Converts an OptS to a show function, given a default.+fromOptS :: ShowS -> OptS -> ShowS+fromOptS def = maybe def appEndo
+ Twisty/Tetra.hs view
@@ -0,0 +1,123 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE TypeFamilies, TypeSynonymInstances #-}++-- | Describes a tetrahedron in terms of faces, edges, and vertices.+module Twisty.Tetra where++import Twisty.FaceTwist+import Twisty.Group+import Twisty.Polyhedron+import Twisty.Puzzle+import Twisty.Twists+import Twisty.Wreath+import Twisty.Zn++import Data.Ix (Ix)+import Data.Maybe (listToMaybe, maybeToList)+import GHC.Enum (boundedEnumFrom, boundedEnumFromThen)+++data Face = F | L | R | D deriving (Eq, Ord, Enum, Bounded, Ix)++instance PolyFace Face where++  newtype PolyEdge Face = Edge Int deriving (Eq, Ord, Ix)+  newtype PolyVertex Face = Vertex Int deriving (Eq, Ord, Ix)++  faceNames = [(F, 'f'), (L, 'l'), (R, 'r'), (D, 'd')]++  neighboringFaces = nf+    where nf F = [L, R, D]+          nf L = [F, D, R]+          nf R = [D, F, L]+          nf D = [R, L, F]++  allEdgesAsFaces = faceEdgesAsFaces F ++ [[L, R], [R, D], [D, L]]++  allVerticesAsFaces = faceNeighborTriples F ++ [[D, R, L]]+++-- | The generic tetra move type.+type TetraMove depth = FaceTwist Face Twist3 depth++-- | Single-layer tetra moves: for 3x3 tetrahedra.  These show as just the face+-- and the twist.+type TetraMove1 = TetraMove Z1++instance Show TetraMove1 where+  showsPrec _ (FaceTwist f t _) = shows f . shows t++instance Read TetraMove1 where+  readsPrec _ "" = []+  readsPrec _ (c:s) = maybeToList $ do+    f <- nameToMaybeFace c+    (t, s') <- listToMaybe (reads s)+    return (FaceTwist f t 0, s')++-- | The generic twist accumulator for tetras.+type TetraTwists depth = CumulativeTwists Face Twist3 depth++type TetraTwists1 = TetraTwists Z1+++type Edge = PolyEdge Face+type Vertex = PolyVertex Face++instance WreathPermutable Edge where+  type WreathTwist Edge = Flip++instance WreathPermutable Vertex where+  type WreathTwist Vertex = Twist3++instance Show Face where+  showsPrec _ = showChar . faceToName++instance Read Face where+  readsPrec _ = readSFace++instance Enum Edge where+  toEnum = toBoundedEnum Edge+  fromEnum (Edge e) = e+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded Edge where+  minBound = Edge 0+  maxBound = Edge $ length (allEdgesAsFaces::[[Face]]) - 1++instance Show Edge where+  showsPrec _ = showString . edgeName++instance Read Edge where+  readsPrec _ = readSEdge++instance Enum Vertex where+  toEnum = toBoundedEnum Vertex+  fromEnum (Vertex v) = v+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance Bounded Vertex where+  minBound = Vertex 0+  maxBound = Vertex $ length (allVerticesAsFaces::[[Face]]) - 1++instance Show Vertex where+  showsPrec _ = showString . vertexName++instance Read Vertex where+  readsPrec _ = readSVertex
+ Twisty/Tetra3.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TypeFamilies #-}+-- | Defines the 3x3 tetrahedron puzzle.+module Twisty.Tetra3 where++import Twisty.Cycles+import Twisty.FaceTwist+import Twisty.Group+import qualified Twisty.Memo as Memo+import Twisty.Polyhedron+import Twisty.Puzzle+import Twisty.Tetra+import Twisty.Twists+import Twisty.Wreath++import Data.List (elemIndex)+import Data.Maybe (fromJust)+import Data.Monoid (Monoid, mappend, mempty)++newtype Tetra3 = Tetra3 (Wreath Vertex, Wreath Edge) deriving (Eq, Ord)++instance Monoid Tetra3 where+  mempty = Tetra3 one+  mappend (Tetra3 s1) (Tetra3 s2) = Tetra3 (s1 $* s2)++instance Group Tetra3 where+  ginvert (Tetra3 s) = Tetra3 (ginvert s)++instance Puzzle Tetra3 where+  type Move Tetra3 = TetraMove1+  fromMove = Memo.array fromMove1++fromMove1 :: TetraMove1 -> Tetra3+fromMove1 (FaceTwist f 1 _) = Tetra3 (v, e)+  where v = fromCycles [asCycle' f faceVertices vertexFaces]+        e = fromCycles [asCycle' f faceEdges edgeFaces]+fromMove1 (FaceTwist f n d) = fromMove (FaceTwist f 1 d) $^ n++instance Show Tetra3 where+  showsPrec _ (Tetra3 (v, e)) = fromOptCycles $ optShowCycles v $* optShowCycles e++t3 :: String -> Algorithm Tetra3+t3 = read
+ Twisty/Twists.hs view
@@ -0,0 +1,134 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE EmptyDataDecls #-}++-- | Defines some simple additive group types corresponding to Z1 through Z6+-- (the natural numbers mod 1 through 6).  These can be used to model the twists+-- that the individual pieces of a twisty puzzle undergo.+module Twisty.Twists+       ( Twistless+       , Flip+       , Twist3+       , Twist4+       , Twist5+       , Twist6+       )+where++import Twisty.Zn+++-- | Twist type corresponding to natural number 1.+data Tw1+instance Nat Tw1 where+  toInt _ = 1+instance NatShow Tw1 where+  showsInt _ _ = id+instance NatRead Tw1 where+  readsInt _ s = [(0, s)]++-- | Twist type corresponding to natural number 2.+data Tw2+instance Nat Tw2 where+  toInt _ = 2+instance NatShow Tw2 where+  showsInt _ = showTwist+    where showTwist 0 = id+          showTwist 1 = showChar '+'+instance NatRead Tw2 where+  readsInt _ = readTwist+    where readTwist ('+':s) = [(1, s)]+          readTwist s = [(0, s)]++-- | Twist type corresponding to natural number 3.+data Tw3+instance Nat Tw3 where+  toInt _ = 3+instance NatShow Tw3 where+  showsInt _ = showTwist+    where showTwist 0 = id+          showTwist 1 = showChar '+'+          showTwist 2 = showChar '-'+instance NatRead Tw3 where+  readsInt _ = readTwist+    where readTwist ('+':s) = [(1, s)]+          readTwist ('-':s) = [(2, s)]+          readTwist s = [(0, s)]++-- | Twist type corresponding to natural number 4.+data Tw4+instance Nat Tw4 where+  toInt _ = 4+instance NatShow Tw4 where+  showsInt _ = showTwist+    where showTwist 0 = id+          showTwist 1 = showChar '+'+          showTwist 2 = showChar '='+          showTwist 3 = showChar '-'+instance NatRead Tw4 where+  readsInt _ = readTwist+    where readTwist ('+':s) = [(1, s)]+          readTwist ('=':s) = [(2, s)]+          readTwist ('-':s) = [(3, s)]+          readTwist s = [(0, s)]++-- | Twist type corresponding to natural number 5.+data Tw5+instance Nat Tw5 where+  toInt _ = 5+instance NatShow Tw5 where+  showsInt _ = showTwist+    where showTwist 0 = id+          showTwist 1 = showChar '+'+          showTwist 2 = showString "++"+          showTwist 3 = showString "--"+          showTwist 4 = showChar '-'+instance NatRead Tw5 where+  readsInt _ = readTwist+    where readTwist ('+':'+':s) = [(2, s)]+          readTwist ('+':s) = [(1, s)]+          readTwist ('-':'-':s) = [(3, s)]+          readTwist ('-':s) = [(4, s)]+          readTwist s = [(0, s)]++-- | Twist type corresponding to natural number 6.+data Tw6+instance Nat Tw6 where+  toInt _ = 6+instance NatShow Tw6 where+  showsInt _ = showTwist+    where showTwist 0 = id+          showTwist 1 = showChar '+'+          showTwist 2 = showString "++"+          showTwist 3 = showChar '='+          showTwist 4 = showString "--"+          showTwist 5 = showChar '-'+instance NatRead Tw6 where+  readsInt _ = readTwist+    where readTwist ('+':'+':s) = [(2, s)]+          readTwist ('+':s) = [(1, s)]+          readTwist ('=':s) = [(3, s)]+          readTwist ('-':'-':s) = [(4, s)]+          readTwist ('-':s) = [(5, s)]+          readTwist s = [(0, s)]++type Twistless = Zn Tw1 -- ^ Trivial twist group.+type Flip = Zn Tw2      -- ^ Order-2 twist group.+type Twist3 = Zn Tw3    -- ^ Order-3 twist group.+type Twist4 = Zn Tw4    -- ^ Order-4 twist group.+type Twist5 = Zn Tw5    -- ^ Order-5 twist group.+type Twist6 = Zn Tw6    -- ^ Order-6 twist group.
+ Twisty/Wreath.hs view
@@ -0,0 +1,192 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Defines the 'Wreath' type, which combines a permutation of a bounded enum+-- with a way to twist each enum element as it's permuted.  This embodies the+-- group theoretic notion of \"wreath product.\"++module Twisty.Wreath+       ( Wreath+       , WreathEntry(..)+       , WreathPermutable+       , WreathTwist+       , numIndicesMoved+       , toCycles+       , fromCycles+       , optShowCycles+       , showEmptyParens+       , fromOptCycles+       )+where++import Twisty.Group+import Twisty.Lists+import Twisty.Strings++import Data.Array+import Data.Ix (Ix)+import Data.List (foldl')+import qualified Data.Map as Map+import Data.Monoid (Monoid, mappend, mempty)+import Data.Ord (comparing)+import qualified Data.Set as Set+++-- | A class for types that can be permuted in a 'Wreath'.  Such types must be+-- bounded, indexable enums with equality testing and order.  And they must have+-- a corresponding type for the ways they can be \"twisted.\"+class (Enum a, Bounded a, Ix a, Eq a, Ord a,+       Group (WreathTwist a), Eq (WreathTwist a), Ord (WreathTwist a))+      => WreathPermutable a where+  -- | The twist group that corresponds to the permuted type.+  type WreathTwist a++-- | A wreath product is a way to factor a group into two parts, a permutation+-- and some other subgroup, which we designate the \"twist\" group.  For+-- example, the corner pieces of a Rubik's cube are permuted by each move, but+-- they are also twisted.+newtype (WreathPermutable a) => Wreath a = Wreath (Array a (Entry a))++instance (WreathPermutable a) => Eq (Wreath a) where+  Wreath arr1 == Wreath arr2 = trim arr1 == trim arr2++instance (WreathPermutable a) => Ord (Wreath a) where+  Wreath arr1 `compare` Wreath arr2 = comparing trim arr1 arr2++-- | A WreathEntry combines the target value and the twist for the source value.+newtype (WreathPermutable a) => WreathEntry a = Entry (a, WreathTwist a)++deriving instance (WreathPermutable a) => Eq (WreathEntry a)+deriving instance (WreathPermutable a) => Ord (WreathEntry a)++-- | A short name for internal use.+type Entry = WreathEntry++instance (WreathPermutable a, Show a, Show (WreathTwist a)) => Show (WreathEntry a) where+    showsPrec n (Entry (a, t)) = showsPrec n a . showsPrec n t+++-- | Look up the entry for a value within a wreath.+getEntry :: (WreathPermutable a) => Wreath a -> a -> Entry a+getEntry (Wreath arr) a = if inRange (bounds arr) a then arr!a else Entry (a, one)++-- | Chain an entry through a wreath.+chainEntry :: (WreathPermutable a) => Wreath a -> Entry a -> Entry a+chainEntry w !(Entry (a, t)) = let !(Entry (a', t')) = getEntry w a in Entry (a', t $* t')++-- | The array we use for empty wreaths.+emptyWreathArray :: (WreathPermutable a) => Array a (Entry a)+emptyWreathArray = listArray (maxBound, pred maxBound) []++-- | Wreaths are Monoids: the identity is the identity permutation, and the+-- append operation is composition of permutations.+instance (WreathPermutable a) => Monoid (Wreath a) where+  mempty = Wreath emptyWreathArray+  mappend w1@(Wreath arr1) w2@(Wreath arr2) = Wreath comp+    where comp = listArray nb [chainEntry w2 (getEntry w1 a) | a <- [fst nb..snd nb]]+          nb = bounds arr1 `union` bounds arr2+          union (b11, b12) (b21, b22) = (min b11 b21, max b12 b22)++-- | Trims the bounds of an array of entries so it consists only of those+-- elements that are either moved or twisted.+trim :: (WreathPermutable a) => Array a (Entry a) -> Array a (Entry a)+trim = trimDown . trimUp+  where trimUp arr = subarray arr (minMoved arr, snd (bounds arr))+        trimDown arr = subarray arr (fst (bounds arr), maxMoved arr)+        subarray arr nb@(n1, n2)+          | nb == bounds arr = arr+          | n1 > n2          = emptyWreathArray+          | otherwise        = listArray nb [arr!a | a <- [n1..n2]]+        -- minMoved returns the upper bound if nothing below it moves.+        minMoved arr = let (b1, b2) = bounds arr in mm b1 b2+          where mm b1 b2 = if b1 >= b2 || arr `moves` b1 then b1+                           else mm (succ b1) b2+        -- maxMoved returns the pred of the lower bound if nothing above the+        -- lower bound moves and the lower bound doesn't move either.+        maxMoved arr = let (b1, b2) = bounds arr in mm b1 b2+          where mm b1 b2 = if b2 < b1 || arr `moves` b2 then b2+                           else mm b1 (pred b2)+        moves arr a = arr!a /= Entry (a, one)++-- | Wreaths are Groups: the inverse is the inverse permutation with all the+-- twists also inverted.+instance (WreathPermutable a) => Group (Wreath a) where+  ginvert (Wreath arr) = Wreath (if Map.null invMap then emptyWreathArray else trim inv)+    where invMap = Map.fromList [(tgt, Entry (src, ginvert t)) | (src, Entry (tgt, t)) <- assocs arr]+          inv = listArray (b1, b2) [Map.findWithDefault (Entry (a, one)) a invMap | a <- [b1..b2]]+          (b1, _) = Map.findMin invMap+          (b2, _) = Map.findMax invMap++instance (WreathPermutable a, Show a, Show (WreathTwist a)) => Show (Wreath a) where+    showsPrec _ = fromOptCycles . optShowCycles+++-- | Counts the number of indices that are moved by the given wreath.  Ignores+-- the twists: an index that is twisted in place does not add to the count.+numIndicesMoved :: (WreathPermutable a) => Wreath a -> Int+numIndicesMoved (Wreath arr) = foldl' f 0 (assocs arr)+  where f count (src, Entry (tgt, _))+          | src == tgt = count+          | otherwise  = succ count++-- | Converts a wreath into disjoint cycles.+toCycles :: forall a. (WreathPermutable a) => Wreath a -> [[Entry a]]+toCycles (Wreath arr) =+  let (cs, _) = foldl' findCycle ([], Set.empty) (range (bounds arr)) in reverse cs+  where findCycle (cs, seen) src =+          if src `Set.member` seen then (cs, seen)+          else let e@(Entry (tgt, t)) = arr ! src+               in if tgt == src && t == one then (cs, seen)+                  else let (c, srce, seen') = cycle src e seen in ((srce:c):cs, seen')+        cycle hd e@(Entry (a, t)) seen =+          if a == hd then ([], e, seen)+          else let (c, srce, seen') = cycle hd (arr!a) (Set.insert a seen)+               in (e:c, srce, seen')+++-- | Converts a list of cycles into a wreath.+fromCycles :: (WreathPermutable a) => [[Entry a]] -> Wreath a+fromCycles cs = Wreath (trim arr)+  where arr = base // concatMap fromCycle cs+        base = array (minBound, maxBound) [(a, Entry (a, one)) | a <- [minBound..maxBound]]+        fromCycle es = zip (map getItem es) (rotate 1 es)+        getItem (Entry (a, _)) = a+++-- | Optionally shows a wreath as its disjoint cycles; an empty wreath returns+-- Nothing.+optShowCycles :: (WreathPermutable a, Show a, Show (WreathTwist a)) => Wreath a -> OptS+optShowCycles w = showCycles' (toCycles w)+  where showCycles' [] = Nothing+        showCycles' [c] = toOptS $ showParen True (showEntries c)+        showCycles' (c:cs) = showCycles' [c] $* showCycles' cs+        showEntries [e] = shows e+        showEntries (e:es) = shows e . showChar ' ' . showEntries es++-- | Shows a pair of empty parentheses.+showEmptyParens :: ShowS+showEmptyParens = showString "()"++-- | Converts an OptS of cycles into a ShowS.+fromOptCycles :: OptS -> ShowS+fromOptCycles = fromOptS showEmptyParens
+ Twisty/Zn.hs view
@@ -0,0 +1,154 @@+{-+Copyright 2011 Google Inc.++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+-}++{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Defines the Zn type: integers mod n.  Sometimes known as Z/nZ.  This is a+-- group under addition.+module Twisty.Zn+       (+         -- * The Zn type+         Zn()+         -- * The Nat classes+       , Nat(..)+       , NatShow(..)+       , NatRead(..)+         -- * Some Zn specializations+       , Z1+       , Z2+       , Z3+       , Z4+       )+where++import Twisty.Group++import Data.Ix (Ix(..))+import Data.Monoid (Monoid, mappend, mempty)+import GHC.Enum (boundedEnumFrom, boundedEnumFromThen)+import Numeric (showInt)+++-- | Type class for natural numbers.+class Nat n where+  -- | Produces the integral value associated with the type.  This must be a+  -- non-strict function: Zn will call this with an undefined argument.+  toInt :: Integral i => n -> i++-- | Type class for displaying natural numbers.+class NatShow n where+  -- | Shows an int in a way appropriate for the type.  Non-strict in the first+  -- argument.  Default shows it in the usual way.+  showsInt :: Integral i => n -> i -> ShowS+  showsInt _ = shows++-- | Type class for parsing natural numbers.+class NatRead n where+  -- | Reads an int in a way appropriate for the type.  Non-strict in the first+  -- argument.  Default reads it in the usual way.+  readsInt :: (Integral i, Read i) => n -> ReadS i+  readsInt _ = reads+++-- | The natural numbers mod n.  The type parameter must be an instance of Nat:+-- that is, it must have a natural number n associated with the type.+newtype Zn n = Zn Int deriving (Eq, Ord)++instance (Nat n, NatShow n) => Num (Zn n) where+  Zn x + Zn y = Zn $ (x+y) `mod` toInt (undefined :: n)+  negate (Zn 0) = 0+  negate (Zn x) = Zn $ toInt (undefined :: n) - x+  Zn x * Zn y = Zn $ (x*y) `mod` toInt (undefined :: n)+  fromInteger n = Zn $ fromInteger n `mod` toInt (undefined :: n)+  -- | Not well defined for these types.+  abs = id+  -- | Not well defined for these types.+  signum (Zn 0) = 0+  signum _ = 1++instance NatShow n => Show (Zn n) where+  showsPrec _ (Zn x) = showsInt (undefined::n) x++instance (Nat n, NatShow n, NatRead n) => Read (Zn n) where+  readsPrec _ s = map f $ readsInt (undefined::n) s+    where f (x, s) = (fromInteger x, s)++instance (Nat n, NatShow n) => Real (Zn n) where+  toRational (Zn n) = toRational n++instance (Nat n, NatShow n) => Integral (Zn n) where+  (Zn n1) `quotRem` (Zn n2) = (Zn q, Zn r)+    where (q, r) = n1 `quotRem` n2+  toInteger (Zn n) = toInteger n++instance (Nat n, NatShow n) => Enum (Zn n) where+  toEnum i = Zn $ i `mod` toInt (undefined::n)+  fromEnum (Zn n) = n+  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance (Nat n, NatShow n) => Bounded (Zn n) where+  minBound = 0+  maxBound = Zn $ toInt (undefined::n) - 1++instance (Nat n, NatShow n) => Ix (Zn n) where+  range (l, u) = [l..u]+  index (l, u) e = fromEnum e - fromEnum l+  inRange (l, u) e = e >= l && e <= u++instance (Nat n, NatShow n) => Monoid (Zn n) where+  mempty = 0+  mappend = (+)++instance (Nat n, NatShow n) => Group (Zn n) where+  ginvert = negate+++-- | Type corresponding to natural number 1.+data T1+instance Nat T1 where+  toInt _ = 1+instance NatShow T1+instance NatRead T1++-- | Type corresponding to natural number 2.+data T2+instance Nat T2 where+  toInt _ = 2+instance NatShow T2+instance NatRead T2++-- | Type corresponding to natural number 3.+data T3+instance Nat T3 where+  toInt _ = 3+instance NatShow T3+instance NatRead T3++-- | Type corresponding to natural number 4.+data T4+instance Nat T4 where+  toInt _ = 4+instance NatShow T4+instance NatRead T4++type Z1 = Zn T1 -- ^ Integers mod 1 (trivial type, consisting of 0 only).+type Z2 = Zn T2 -- ^ Integers mod 2.+type Z3 = Zn T3 -- ^ Integers mod 3.+type Z4 = Zn T4 -- ^ Integers mod 4.
+ twisty.cabal view
@@ -0,0 +1,39 @@+Name:           twisty+Version:        0.1.0+Cabal-Version:  >= 1.6+Synopsis:       Simulator of twisty puzzles à la Rubik's Cube+Description:+  Library with tools for simulating Rubik's Cube and similar puzzles.++Build-Type:     Simple+License:        OtherLicense+-- License: Apache-2.0+License-File:   COPYING.txt+Copyright:      Copyright 2011 Google Inc.+Author:         Luke Blanshard+Maintainer:     leadpipe@google.com+Stability:      experimental+Category:       Game+Source-Repository head+  Type:         svn+  Location:     http://eng-chi-haskell.googlecode.com/svn/leadpipe/twisty++Library+  Build-Depends:        base == 4.2.*+                        , array == 0.3.*+                        , containers == 0.3.*+                        , data-memocombinators == 0.4.1.*+                        , MonadRandom == 0.1.6.*+                        , parallel == 3.1.*+  ghc-options:  -O2+  Exposed-Modules:+    -- Various puzzle simulations+    Twisty.CubeExploration, Twisty.Cube, Twisty.Cube3, Twisty.Cube3a, Twisty.Cube4,+    Twisty.Dodeca, Twisty.Tetra, Twisty.Tetra3,+    -- Algebra+    Twisty.Group, Twisty.Zn, Twisty.Twists, Twisty.Wreath, Twisty.Cycles,+    -- Puzzle/geometry+    Twisty.Puzzle, Twisty.Polyhedron, Twisty.FaceTwist, Twisty.CubeSymmetries,+    -- Utilities+    Twisty.Lists, Twisty.Memo, Twisty.Searching, Twisty.Strings+