Hi all, I read this on the J -programming forum http://www.jsoftware.com/pipermail/programming/2007-June/007004.html Maybe of interest, especially the part of generating the subgroup or composing a more intelligent solver. quote I found an interesting game, as found on Andrew Nikitin's MSX-BASIC page http://nsg.upor.net/msx/basic/basic.htm , and I am not sure if its solver has been given as a puzzle. Here it goes. 1D Rubik's Cube is a line of 6 numbers with original position: 1 2 3 4 5 6 which can be rotated in 3 different ways in groups of four: _______ _______ (1 2 3 4)5 6 --(0)-> (4 3 2 1)5 6 _______ _______ 1(2 3 4 5)6 --(1)-> 1(5 4 3 2)6 _______ _______ 1 2(3 4 5 6) --(2)-> 1 2(6 5 4 3) Given a scrambled line, return the shortest sequence of rotations to restore the original position. Examples: solve 1 3 2 6 5 4 1 2 1 solve 5 6 2 1 4 3 0 2 solve 6 5 4 1 2 3 0 1 2 end quote What follows is a kind of emulation (in the sense of the nature of the J-program) of the solution of Roger Hui. see http://www.jsoftware.com/pipermail/programming/2007-June/007006.html Remarks: Rewards for me are learning and understanding J programming and programming a Haskell solution for the same problem, plus a bit of group theory. Roger Hui says that for his solution it's not guaranteed that the rotation-sequence is the shortest one --------------------- PROGRAM -------------------------------------------- -- subgroup generators -- all rotations are permutations of order 2 because they leave 2 elements in place -- f.e. [3,2,1,0,4,5] has cycle product (1 4)(2 3) rotaties :: [[Int]] rotaties = [[3,2,1,0,4,5],[0,4,3,2,1,5],[0,1,5,4,3,2]] ident :: [Int] ident = [1..6] rotix :: [[Int]] rotix = [ [e] | e <- [0..2]] -- flip consecutive part of the 1d-rubik ds `roteer` d = map (ds !!) d -- number of misplacements -- equivalent to the parity-function of permutations or the order of a permutation -- it seemed that only even order permutations are solvable, indeed the subgroup generated -- contains only even permutations mispl = sum . map (\[a,b] -> if b-a > 0 then 0 else 1) . combinationsOf 2 -- equivalent to J's : rotaties , ,/{"1/~ rotaties -- to keep in order with the J program I had to change 'map (roteer x)' to 'map (flip roteer x)' rotzelf xs = concat $ xs : [ map (flip roteer x) xs | x <- xs ] -- rotseqs equivalent to J-program line: q , , ,&.>/~ q rotseqs xs = xs ++ (map concat $ [ [x,y] | x <- xs, y <- xs ]) -- mark duplicates function equivalent to J's ~: p -- boolean array where a '0' marks a duplicate markdups = domark [] domark _ [] = [] domark ys (x:xs) | x `elem` ys = 0 : domark (x:ys) xs | otherwise = 1 : domark (x:ys) xs -- b <select> a -- selects elements from array 'a' according to bool array 'b' -- equivalent to J's m#n [] `boolsel` _ = [] (b:bs) `boolsel` (x:xs) | b==1 = x: bs `boolsel` xs | otherwise = bs `boolsel` xs -- after 5 iterations no further change occurs -- the number of elements then reaches the order of the subgroup = 360 (subg, rseqs) = head . drop 4 . iterate tab $ (rotaties, rotix) -- or : head . dropWhile ((/=360) . length . fst) . iterate tab $ (rotaties, rotix) tab (ps , qs) = (bs `boolsel` rs, bs `boolsel` ts) where rs = rotzelf ps ts = rotseqs qs bs = markdups rs solve :: [Int] -> [Int] solve rs | odd . mispl $ rs = error " no solution possible...." | rs == ident = [] -- identity of the subgroup | otherwise = as where rs' = map (flip (-) 1) rs is = fromJust $ elemIndex rs' subg as = rseqs !! is test = map solve [[1,3,2,6,5,4],[5,6,2,1,4,3],[6,5,4,1,2,3],[6,4,2,5,3,1]] greetings @@i = Aai