Less Brutal Insanity

In Brute Force Insanity I described writing code to solve the  Instant Insanity puzzle. The code given there was bodged together quickly, and it shows. The example below has numerous improvements:

  1. It handles a variable number of cubes by taking advantage of recursion. This actually slowed it down a little, but the alternative nested loops was too ugly to consider.
  2. It has several significant optimizations. Fifteen cubes is probably reasonable. The theoretical maximum is 26, but that would be roughly 10^35 possibilities, and none of my optimizations will address that entirely.
  3. Cleaned up what it was doing overall, and added comments.
  4. Re-wrote the code to take a more-manageable format for the cube definitions: a straight line of six characters.
  5. Made numerous trade-offs where doing more efficiently was  less readable than the slightly less efficient method.

One of the optimizations is interesting. I realized that it’s possible to rule out numerous options based solely on the number of colors they contribute, rather than their actual orientation. Reworking to take advantage of this wasn’t simple. First, it means checking through all the possible combinations and keeping track. There are three “loop”s for each cube, so for six cubes the number of possibilities could be as high as 3^n, where n is the number of cubes.

After figuring out which paths (potentially) work, it’s necessary to go check them in detail. The data on which ones need to be checked must be stored, and the checking code re-written to follow the combination already determined to be a possibility.


local cubeCount -- the number of cubes being solved
local stringList -- an array of the strings possible for each cube
local pathArray -- an array of the paths the solution can take
local loopColorCounts -- an array of how many faces of each color each loop contains

on setupStrings cubeList
   -- given a list of cubes
   -- get the permutations
   -- and store them in the local variable stringList
   put 0 into cubeCount
   repeat for each line L in cubeList
      add 1 to cubeCount
      -- dontPermute the first cube. it doesn't need to 
      -- flip or rotate since all the subsequent cubes can
      -- flip and rotate together
      put stringsFrom(L,cubeCount=1) into stringList[cubeCount]
   end repeat
end setupStrings

function pathsFor cubeList
   -- given a list of cubes
   -- each cube has three possible loops
   -- add the faces and discard any combinations 
   -- that have too many/too few of a color
   -- return the list of paths that have the
   -- right color total, although they might
   -- not be configurable to make the colors 
   -- work by column.
   -- first, set up the array with counts
   delete variable loopColorCounts
   repeat with theLevel = 1 to cubeCount
      put 1 into theBranch
      repeat for each char C in stringList[theLevel][0]
         -- [0] is the de-duped list of
         -- the three possible loops
         if C is cr then 
            add 1 to theBranch 
            add 1 to loopColorCounts[theLevel][theBranch][C]
            put 0 into colorArray[C]
         end if
      end repeat
   end repeat
   return pathsAtLevel(1,"",colorArray)
end pathsFor

function pathsAtLevel theLevel,thePath,colorCounts
   -- this is the recursing function
   -- for getting paths
   -- check for success
   if theLevel > cubeCount then return thePath & cr
   -- otherwise add another step to the path
   put empty into theReturn
   repeat for each key theBranch in loopColorCounts[theLevel]
      -- add the branch colors & check for > 4
      put colorCounts + loopColorCounts[theLevel][theBranch] into colorCountsX
      if max(colorCountsX) > 4 then next repeat
      put pathsAtLevel((theLevel + 1),(thePath & theBranch),colorCountsX) after theReturn
   end repeat
   return theReturn 
end pathsAtLevel

on makePathArray X
   -- put the list of possible paths
   -- into an array for easy reference
   delete variable pathArray
   repeat for each line L in X
      put 0 into tPath
      repeat with i = 1 to cubeCount
         if char i of L is not among the lines of pathArray[tPath] then put char i of L & cr after pathArray[tPath]
         put char i of L after tPath
      end repeat
   end repeat
end makePathArray

function solutionsFor cubeList
   -- takes a list of cubes and returns a list of all possible solutions
   -- configure the permutations of the cubes and the paths that might work
   setupStrings cubeList
   get pathsFor(cubeList)
   --return it
   if it is empty then return 0 & cr
   put the number of lines of it into pathCount
   makePathArray it
   -- pathArray[0] contains all the valid starting points
   repeat for each line L in pathArray[0]
      -- starting path:
      put "0" & L into thePath
      -- build the candidate list
      -- first four items are the colors used so far
      -- items 5- are the actual colors from each cube
      put empty into candidateList
      repeat for each line cubeLoop in stringList[1][L]
         repeat for each char C in cubeLoop
            put C & comma after candidateList
         end repeat
         put cubeLoop & cr after candidateList
      end repeat
      -- for each branch in the path:
      repeat for each line theBranch in pathArray[thePath]
         -- actual start of recursion:
         put solutionsAtLevel(2,thePath,theBranch,candidateList) after resultList
      end repeat
   end repeat
   if resultList is empty then return 0 & tab & pathCount & cr
   -- Remove the four items at the start of each solution
   -- that stored the tally of colors in each column
   put 0 into LC
   repeat for each line L in resultList
      add 1 to LC
      delete item 1 to 4 of L
      put L & cr after theReturn
   end repeat
   -- return the number of solutions
   -- the number of paths (this was for optimization)
   -- and the solutions themselves
   return LC & tab & pathCount & cr & theReturn
end solutionsFor

function solutionsAtLevel theLevel,thePath,theBranch,candidateList
   put empty into newCandidateList
   repeat for each line L in stringList[theLevel][theBranch]
      repeat for each line C in candidateList
         put checkit(C,L) after newCandidateList
      end repeat
   end repeat
   -- if the path is complete or all paths failed, return now
   if theLevel = cubeCount or newCandidateList is empty then return newCandidateList
   -- add the branch to the path, find the next branches, and call again
   put theBranch after thePath
   repeat for each line theBranch in pathArray[thePath]
      -- next step in the recursion
      put solutionsAtLevel(theLevel+1,thePath,theBranch,newCandidateList) after theReturn
   end repeat
   return theReturn
end solutionsAtLevel

function stringsFrom cubeFaces,dontPermute
   -- Takes a six-character representation of the faces of a cube
   -- and returns the unique loops of four sides (could be up to 24)
   -- The string 123456 represents this unfolding of the cube:
   --   1
   -- 623
   --   4
   --   5
   -- That translates to these four loops:
   -- 1245
   -- 1346
   -- 2356
   -- Each of those can be reversed ( x2 ) and rotated ( x4 )
   -- 3 x 2 x 4 = 24 possibilities
   -- Data is returned in an array:
   -- Z[0] is the three unique loops themselves
   -- Z[1] is up to eight loops based on 1245
   -- Z[2] is up to eight loops based on 1346
   -- Z[3] is up to eight loops based on 2356
   -- Start with a string representing all the patterns, with 7s for the CRs for convenience
   put "124574215721547154275421724517451275124713467613473461746137" \
         & "43167316471643764317235673265726537653276235753267356275623" into R
   -- Use replace to get the cube faces in place and to replace the 7s with CRs
   put cr after cubeFaces
   repeat with i = 1 to 7
      replace i with char i of cubeFaces in R
   end repeat
   -- Remove dupes from the entire list, but leave the empty lines so paths can work
   put sparseDeDupe(R) into R
   -- set up Z[0]
   put line 1 of R & cr & line 9 of R & cr & line 17 of R into Z[0]
   -- set up Z[1] through Z[3]
   put 0 into branchID
   repeat with i = 1 to 3
      if line i of Z[0] is empty then next repeat
      add 1 to branchID
      if dontPermute then
         put line i of Z[0] into Z[branchID]
         put deDupe(line 8 * i - 7 to 8 * i of R)  into Z[branchID]
      end if
   end repeat
   put deDupe(Z[0]) into Z[0]
   return Z
end stringsFrom

function deDupe X
   -- remove any duplicate lines in X

   repeat for each line L in X
      if L is empty or L is among the lines of R then next repeat else put L & cr after R
   end repeat
   return R
end deDupe

function sparseDeDupe X
   -- make any duplicate lines in X blank
   -- no lines are deleted, so remaining data stays in the same line

   repeat for each line L in X
      if L is among the lines of R then put cr after R else put L & cr after R
   end repeat
   return R
end sparseDeDupe

function checkit X,Y
   -- Return X,Y & cr if it won't duplicate any colors
   -- items 1-4 of X are the total of the solution-in-progress
   repeat with i = 1 to 4
      -- Check colors in Y against items in X
      -- Fail if it already exists, add it if it doesn't
      if item i of X contains char i of Y then return empty
      put char i of Y after item i of X
   end repeat
   -- success. return X with Y added
   return X,Y & cr
end checkit

function randomCubes N
   -- a utility function, returns a set of N randomly colored cubes
   if N is empty then put 4 into N
   repeat with i = 1 to N
      repeat 9
         put char i of "ABCDEFGHIJKLMNOPQRSTUVWXYZ" after S
      end repeat
   end repeat
   repeat N
      repeat 6
         get random(length(S))
         put char it of S after R
         delete char it of S
      end repeat
      put cr after R
   end repeat
   return char 1 to -2 of R
end randomCubes


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s