Grid Subdivisions - A Diary

[Home]   [Puzzles & Projects]    [Delphi Techniques]   [Math topics]   [Library]   [Utilities]

 

Search

Search WWW

Search DelphiForFun.org

As of October, 2016, Embarcadero is offering a free release of Delphi (Delphi 10.1 Berlin Starter Edition ).     There are a few restrictions, but it is a welcome step toward making more programmers aware of the joys of Delphi.  They do say "Offer may be withdrawn at any time", so don't delay if you want to check it out.  Please use the feedback link to let me know if the link stops working.

 

Support DFF - Shop

 If you shop at Amazon anyway,  consider using this link. We receive a few cents from each purchase.   Thanks.


Support DFF - Donate

 If you benefit from the website,  in terms of knowledge, entertainment value, or something otherwise useful, consider making a donation via PayPal  to help defray the costs.  (No PayPal account necessary to donate via credit card.)  Transaction is secure.

Contact

Feedback:  Send an e-mail with your comments about this program (or anything else).

Search DelphiForFun.org only

 

 

Problem Description

Here’s a first attempt at documenting the thought processes involved in creating a program to solve a puzzle problem, a Mensa Calendar puzzle in this case.  Here’s the puzzle:

From the October 7, 2016 Mensa Puzzle calendar:  “Place stars in six cells of the grid so that every row, every column, and every outlined region contains exactly one star.  Stars must never be located in adjacent cells, not even diagonally.“

 

 

Background & Techniques

Getting Started:

First order of business is to study the puzzle and guess how it might be solved.  If you remember learning about the "Scientific Method" from High School,  this is the "Data Collection" phase.  For me, this usually means searching my internal experience "data bank" and the web. 

“Trial and error” comes to mind here as a likely approach for this puzzle, since no shortcut way is obvious.   A more technical name for “Trial and Error” is “Depth First Search with Backtracking”  In this case the method would require us to start placing stars, one per figure,  in some systematic manner until we get stuck and then backtracking to the previous star and trying the next , againlocation backing up star by star far as necessary and going forward at each step until the solution is found.  Computers are much better at this approach than humans.  I know how to code “recursive” functions that implement this technique by calling themselves, so we don’t need separate code for each figure.  We'll call our function  "PlaceNext" (Star).

"PlaceNext" Recursive Function:

Within the “PlaceNext” function we’ll try placing a star each cell within a  given figure (passed to the function as a parameter) in some systematic way that does not violate any of the rules:  i.e. no other star in the candidate column or row or adjacent diagonal cells that are in a different figure.  We won’t need to check diagonals in the current figure because we are only trying them one star at a time.  If this placement is OK, place the star temporarily (in such a way that we can remove it later) and call PlaceNext with the next figure number.  Set the return function to the return value of the PlaceNext call.  If the return value is False, remove the star and place it in the next untried location.  If all locations have been tried without success, set return value to False, and exit. If we enter PlaceNext with the 7th star position, we're done so we just set the Result value to True and exit.

That’s it.  This code should be able to step through all possible arrangements of six stars in all valid positions.  If the very first call returns true , we have a solution.  Since there are 9, 8, 5, 5, 3, and 5 cells in the six figures, the product of these numbers (27,000) represents the maximum of trial star sets to check if there is no solution.  From past experience, I predict that it will only take a few milliseconds at most to find the solution, even if we keep searching after the first solution is found to prove that the solution is unique.   Problem solved – in theory - just the details to fill in now.

Divide and Conquer

I always try the “Divide and Conquer” technique from here on.  Break the large problem into smaller easier-to-solve problems.   The sub-problems I see for now (with likely solution concepts) are:

bullet

 How to model the grid : Use a 6x6 StringGrid control with row and column heights to draw square cells.

bullet

How to keep track of where the stars are currently placed:  Grid cells will probably contain a “figure number” from “1” to “6”, Stars could be indicated by appending a character (S maybe?) to the cell figure number. 

bullet

Finding where to place the stars in the grid: Use the PlaceNext function described above.

bullet

How to draw or otherwise present the solution(s).  The OnDrawCell event exit  for the grid can also insert a Star figure while drawing the figure outline.

 

Time to start coding.

 

Program Version 1

 I decided to tackle tasks 1 and 2 initially as a warm-up.  They have to be done anyway and it will be the best way to check program results visually.  The data structure I chose to represent the grid data is a 6x6 array of integers.  It looks like this:

DefVal:array[0..5,0..5] of integer =
((1,1,1,1,1,2),
 (1,1,1,2,2,2),
(1,4,5,5,5,3),
(4,4,5,6,5,3),
(4,4,6,6,3,3));

Each line represents the figure numbers of the six cells on that row.  The grid cells are strings, not integer data, but string constants require ‘quote’ marks, so I use integers and let the computer do the formatting.    The index range is set as 0 to 5 rather than 1 to 6 because grid cells are indexed from zero.

The Grid1DrawCell exit  works  by drawing heavy blue cell top and/or left boundary lines when either the cell is in column zero or row zero, or if the number in the cell above or to the left of this cell doesn’t match this cell.   The right-most column and bottom row cells always add the right and bottom boundary lines.     Here’s a condensed copy of the actual code: {Comments are in red}

                         {*********** GridDrawCell **************}

procedure TForm1.Grid1DrawCell(Sender: TObject; ACol, ARow: Integer; 

                                                          Rect: TRect;  State: TGridDrawState);

begin

   with grid1, canvas, rect  do  {allows shortcut names below for fieldsfrom these objects; e.g.
                                                "cells" means  “grid1.cells”,   “left” means “Rect.left”, etc.}
 
   begin
      pen.width:=3;   pen.color:=clblue;

     {Heavy left side line? Yes, if 1st column or left cell doesn't match}
      If  (acol=0) or   ((acol>0) and (cells[acol,arow]<>cells[acol-1,arow]))
      then  begin  moveto (left,top);  lineto(left,bottom); end;

     {Heavy top line?}
     If (arow=0) or   ((arow>0) and (cells[acol,arow]<>cells[acol,arow-1]))
     then  begin  moveto (left,top);  lineto(right,top); end;

     {Last column?  Draw heavy right side line}
      if acol=colcount-1 then     begin moveto(right,top); lineto(right,bottom); end;

      {Last row?  Graw heavy bottom line}
      if  arow=rowcount-1 then begin moveto(left,bottom); lineto(right,bottom); end;

      {Display the figure number for checking}
      textout(left+4, top+4,cells[acol,arow]);

    end;

end;

                                                                                                                                                                                  

Here’s a screen shot of the resulting grid:

 

 

Program Version 2

So now we have the grid built, it’s time to add the fun part – placing the stars.  Two new data types  were added to help model the data required to solve the puzzle.  Grid1 is simply a 6x6 array of integers representing the current state of the board.   By assigning it as a data type (TGridRec), we can pass the grid status of the board along to the Placenext function call for each new figure we are solving.  The other new data type for this version is TFigLocs, an array of the column and row points for each of the 6 figures on the board.  This greatly simplifies the search as we try placing a star at each location within the current figure  because we can just step though the points array to get the nexxt location to test.  So the Placenext function definition looks like this:  Function Placenext(StarNbr:integer; NextGrid:TGridDef):boolean;   

Pseudo-code for the function looks like this:

All six stars set?

Yes: We have a solution!   Display it.

No:  For all cell locations in this figure (StarNbr) using the FigLocs array for this figure,

Can a star be validly placed here?  (call IsValidLoc function which checks that there is no other star already in this row or column and no star from another figure adjacent to any of the 4 corners).

Yes: Place the star in NextGrid and call Result:=Placenext(StarNbr+1, Nextgrid).  This is the recursion part!  

If Result is true the exit

Otherwise remove the star placed in NextGrid and continue trying locations.

No: Check next location;

 

Notes:  This version does not update the displayed grid, just reports success or failure.  Success is checked by stopping the program to debug the grid using the Watch list.

 

Program Version 3

Almost there – just need to update the displayed grid .   This is the stage when extra unanticipated features start rearing their pretty little heads to add to the fun.  Here’s the list of "unplanned" features added in this case::

bullet

A checkbox to show figure numbers to the grid display.

bullet

There turned out to be so little backtracking that I added a step by step animation option to  verify that the program wasn’t cheating somehow.

bullet

Since the forward search really did have so few backtracking steps, I also added a “reverse search”,  placing trial star locations from bottom to top and right to left within each figure.    

bullet

The reverse search does require many more backtracking steps.  So many in fact that the animation now required several minutes to complete.  I added a track-bar slider control  to adjust the animation speed and also added an animation checkbox to turn it off completely.

bullet

Without  the animation, it made sense to check my original guess that the search would only take a few milliseconds.  In fact, the forward search requires 0.1 milliseconds to run and the reverse search checks several thousand potential star positions and stillfinds the solution in less than 2 milliseconds.

bullet

The  initial timing attempt using the “Now  time retrieval function  does not have sufficient resolution to measure sub-millisecond intervals  so I used the Windows “QueryPerformanceCounter” and ”QueryPerformanceFrequency” procedures which typically measure in the microsecond range in modern computers.   

bullet

Oh, and just because I wanted see if it works, I used the variable precision feature of Format Strings to display  runtimes over one second with one decimal point of precision , and with 4 decimal points if less.   

A final note – I intended to post  the final version as “StarsInAGrid” but discovered that I had posted  program with that name (and solving a similar puzzle), a few years ago.   The approach then seems quite different that the current study, thankfully.   One advantage of growing old is the ability to re-solve a problem as if for the first time!  I'll post this one in our Delphi Techniques section as GridSubdivisionsV3).

Running/Exploring the Program

bullet Download source (Versions 1, 2, and 3)
bullet Download  executable (V3 only)

Suggestions for Further Explorations

This version of "Stars On A Grid" does not support user play, but it could.
Same applies for square grid sizes other that 6x6. Mostly implemented by replacing 6's with a new "Size" variable, and 5's with "Size-1".
I forgot to let the program continue searching after the first solution was found.  It exits when a True result is found, but if the solutions was stored or reported when found,  the program could continue searching, although I  suspect that the first solution found is unique.  
   
Original:  October 30, 2016

Modified:  October 31, 2016

 

  [Feedback]   [Newsletters (subscribe/view)] [About me]
Copyright © 2000-2017, Gary Darby    All rights reserved.