<< Computer AlgorithmsUse  Ctrl +  or    to enlarge or reduce text size.

Game Board Method to Factor a Number

Sfactor.exe

Problem:  Factor a given number. That is, given N find A and B so that A × B  =  N.

One and the number itself are trivial factors. We seek non-trivial factors.

We will represent numbers in binary. The binary multiplication table is simply:
    1 × 1  =  1
    For any bit B:   B × 0  =  0 × B  =  0.
Addition is a little more complicated:
    1 + 1  =  10
    For any bit B:   B + 0  =  0 + B  =  B.
Carries go to the left.

The advantage of binary over the decimal representation of numbers that concerns us here is that one bit (0 or 1) times another bit is always one bit, whereas a decimal digit (0 to 9) times another decimal digit might be more than one digit, for example 3 times 5 is 15.

Here is how you would multiply  1101  and  1011:
       1101
     x 1011
     ------- 
       1101
      1101
     0000
    1101
   ---------
   10001111
The final result is the staggered sum of the “partial products.” In this example the length of the final product (8 bits) is the sum of the lengths of the multipliers (4 bits each ). It would have been one less if there had been no carry at the far left.

This looks simpler if instead of offsetting the partial products and adding vertically we don’t offset them and add along the diagonals:
        1101    first number         
second
    1   1101
    0   1101\
    1   0000\\
    1   1101\\\                      
         \\\\\\\ 
         10001111
We placed the two numbers that are being multiplied along a horizontal and vertical side of the partial product matrix. Each bit of the partial product matrix is the product of the bit of the number above and the bit of the number to the left.

Note (and this is true for any two numbers, not just 1101 × 1011):
(1)  The matrix consists of rectangular islands of 1’s separated by rows and columns of 0’s.
(2)  It’s easy to find the matrix given the two multipliers. Start with all 1’s, then wherever there is a 0 in the first number, zero out that column, and wherever there is a 0 in the second number zero out that row.
Alternatively, start with all 0’s and place a 1 only where there is a 1 in both mulipliers directly vertically and horizontally.
(3)  The first multiplier appears in every non-zero row and the second multiplier appears in every non-zero column. Call these the row and column numbers respectively.
(4)  Any matrix of the form (3) is the partial product matrix for the product of its two row and column numbers.

At this point we switch from writing numbers in ordinary binary notation, in which numbers go from high bit to low, and write them in reverse so that they go from low bit to high – the way Nature intended. For example decimal 13 in reverse binary is  1011,  not  1101.  Since we write words from left to right this is really the more consistent way to write numbers, and it will make it easier to program symbolic binary arithmetic. From now on every number is expressed in reverse binary when not expressed in decimal.

Reverse binary multiplication and addition is the same as before except that  1 + 1 = 01  and  carries go to the right.

The multiplication problem above looks like this in reverse binary:
       1011
     x 1101
      -------- 
       1011
        0000
         1011
          1011
      --------
       11110001
The earlier matrix becomes:
         1011

         1011   1  
        /0000   0
       //1011   1  
      ///1011   1  
     ///////
    11110001
Given an odd number N we will try to find factors of N by playing a sort of board game devised by John Charlton. It uses three markers called one, zero, and simply “piece.” One of these markers can be placed in any vacant cell.

Suppose we suspect that the number could be factored into two numbers whose bit lengths are X and Y respectively, choosing the order so that  X ≥ Y.  Either X + Y equals the bit length of N or one more.  First assume it is one more. Consider a game board consisting of empty square “cells” measuring X cells across and Y cells down, so that there are X + Y – 1 cells around the top and right sides of the board. The diagonals of cells of the board slanted like this  ╱ ╱ ╱ ╱ ╱ ╱  we call “slots.”
           1 2 3  ...  X    
          / / / /     /  1
	 · · · · · · · / 2 
	 · · · · · · · / 3
	 · · · · · · · / ... 
	 · · · · · · ·  
	 · · · · · · · / Y – 1
The procedure begins by first imagining X bits of the number N placed across the topmost row of cells and the remaining Y – 1 bits placed down the rightmost column.

1, 2, 3 etc. in the diagram above count the bits of the two parts of N, each is either 0 or 1. Wherever there is a 1 place a “piece.” All the other cells leave empty. Then forget about the bits of N, they will no longer be used for this board.

The method is implemented in the program below, written for PowerBasic PBCC, which will serve as a precise description of the algorithm.  A link to a Windows executable is provided at the beginning of this page if you just want to run the program.  Here is sample output – the first, last, and a middle stage for the successful board size 12 by 8 when given reverse binary 1011011001011100101:



' JOHN R. CHARLTON'S FACTORIZATION ALGORITHM.
' It factors any odd number by moving pieces on a series of game boards.
'
' It performs no divisions other than one integer halving when setting
' up a board, and no multiplications other than in one loop doubling,
' which is effected by shifting left by one bit.
'
' The algorithm is not intended to be practical in code.  The code here
' is for testing the algorithm, which could then be used to build a
' hardware device consisting of field programmable gate arrays that mimic
' the boards.  The boards are independent and can be run in parallel.
'
' Generally the time the algorithm takes grows exponentially with the
' length (number of bits) of the given number, though you can’t predict
' how long it will take on a particular number.
'
' All numbers are written in reverse binary, that is, binary but with
' bits going from low to high.  Thus decimal 13 (1+4+8) is 1011.
'
' Place the given number across the top row of cells of a board, bend it
' at the corner and continue down the right column of cells.  Then remove
' the number and place a green dot in each cell that contained a one, all
' other cells remain empty.  The goal is to get rid of the green dots and
' completely fill the board with blue dots and red x’s, representing ones
' and zeros respectively.
'
' After the initial placement of the green dots the given number is not
' used again.
'
' If successful the final position of the board is the partial product
' matrix of the paper and pencil method of multiplying the factors, with
' the blue dots representing 1’s and the red x’s representing 0’s.
' Instead of the partial products being offset, forming a parallelogram
' shape with addition done vertically, they are not offset and the
' arrangement is rectangular with addition done diagonally (/) along the
' “slots”.  You can read off the first factor from any non-zero row and
' the other factor from any non-zero column.
'----------------------------------------------------------------------

#Dim All
#Console Off

' Macros ..........................

' Macros are pre-compile instructions, not subroutines, that simply insert
' text into the source code. They make the code more readable.  (Note that
' some multiline macros when used must be placed on a separate line, you
' cannot always separate a macro from another instruction with a colon.)

Macro Boolean = Long
Macro True = -1
Macro False = 0

Macro TryHoleSlot(v)
  hslot = v : GoSub Holeslot
End Macro

Macro TryPieceSlot(v)
  pslot = v : GoSub Pieceslot
End Macro

' increment the stack pointer
' used when exit a gosubroutine using GoTo rather than Return
Macro PopStack
  ! add esp, 4
End Macro

' This is used inside PieceSlot, a gosubroutine.  Incrementing the stack
' pointer esp removes the obligation to Return (SlotJam is not a gosubroutine).
Macro ExitToSlotJam
  PopStack
  GoTo SlotJam
End Macro

' The next two macros are used within gosubroutines HoleSlot and PieceSlot.
' They cannot by used in the main code outside of a gosubroutine.  The
' first is used when slot has already been defined.  ExitToSlotJam is
' itself a macro and must be on a separate line.
Macro TryDownSlot0
  GoSub DownSlot
  If FAIL Then
    ExitToSlotJam
  End If
End Macro

Macro TryDownSlot(v)
  slot = v
  TryDownSlot0
End Macro

' most of the time ky = 0 so we want that to be determined quickly
Macro ShowStep
  If ky Then
    If ky = %Esc Then
      If exitflag Then GoTo EndProgram
      If Not showintermediate Then
        GoSub DisplayBoard
        GoSub ShowStepMessage
      End If
    End If
  End If
  If showintermediate Then
    If Not manualstep Then Sleep %pausetime
    GoSub Displayboard
  End If
  If cellsx <> cellsx0 Then GoSub ShowBoardSize
End Macro
'----------------------------------------------------------------------

' Procedure declarations ....................
Declare Sub Printit(ByVal String, ByVal Long, ByVal Long)
Declare Function IsPrime(ByVal String, String, String) As Boolean
Declare Function BinaryString(ByVal Quad) As String
Declare Function DecimalFromBinary(ByVal String) As String
Declare Function SMul(ByVal String, ByVal String) As String
Declare Function GWnewC(ByVal Dword, ByVal Dword, ByVal Dword, ByVal Long) As Long
Declare Function SubClass(ByVal Dword, ByVal Dword) As Dword

Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Dword, lpOperation As Asciiz, lpFile As Asciiz, lpParameters As Asciiz, lpDirectory As Asciiz, ByVal nShowCmd As Long) As Dword
' %MB_OK = 0
 %MB_OKCANCEL    = 1
' %MB_DEFBUTTON1 = 0
 %SW_SHOWNORMAL  = 1

 %MB_SYSTEMMODAL = &h1000
 %IDOK  = 1
Declare Function MessageBox Lib "USER32.DLL" Alias "MessageBoxA" (ByVal hWnd As Dword, lpText As Asciiz, lpCaption As Asciiz, ByVal dwType As Dword) As Long

'----------------------------------------------------------------------

' Constants .......................

' possible states of Board() cells,
' these four values are arbitrary except they must be different
%one   = 3    ' determined 1  - blue disk
%zero  = 2    ' determined 0  - red X in light gray disk
%piece = 1    ' piece         - green disk
%blank = 0    ' blank         - light gray empty circle

%minLEVEL = 1                    ' the last rectangle is %minlEVEL + 1 cells high

%noshrink = 1                    ' two phases
%shrink   = 2                    ' values irrelevent just so the second is one more than the first

%pausetime = 27                  ' in milliseconds, applies if showintermediate is set and manualstep isn't

%BlueColor       = &hA00000      ' colors
%LightBlueColor  = &hFF2020
%GreenColor      = &h00C000
%RedColor        = &h8080FF
%DarkRedColor    = &h0000F0
%GrayColor       = &hC0C0C0
%DarkGrayColor   = &h202020
%LightGrayColor  = &hF0F0F0
%MediumGrayColor = &hA0A0A0
%PurpleColor     = &hA00080

%cw = 9          ' cell size
%cs = %cw*2      ' cell spacing
%cw1 = %cw + %cw\2 + 2
%o = 3           ' increase spot/circle size
%oo = 4          ' bring digits closer to board
%ooo = 11        ' extend diagonal lines up
%vvv = 5         ' extend diagonal lines down

%Enter = 13 : %Esc = 27          ' key codes
%space = 32 : %C = 67 : %M = 77 : %X = 88
%bksp = 8 : %Del = 46
%digit0 = 48 : %digit1 = 49 : %nine = 57 : %period = 46
%periodcode = 190                ' to distinguish from %Del
%KPzero = 96 : %KPnine = 105 : %KPperiod = 110
%endkey = 35 : %homekey = 36 : %left = 37 : %up = 38 : %rightkey = 39 : %down = 40

%solvekey   = %space
%stepkey    = %Enter
%moviekey   = %M
%quitkey    = %bksp
%mousecode  = 999
%repeatcode = 82
%previousboardkey = 34  ' PgDn
%nextboardkey     = 33  ' PgUp

%WW = 670 : %HH = 210                             ' width and height of rectangle around options

%mlen = 63                                        ' for InputLine
%fieldlen = %mlen*8
%optiongrnd = %LightGrayColor
%editgrnd = &hE0FFC0
'----------------------------------------------------------------------

' global variables ....................
Global GWoldC As Dword           ' handle for subclassing graphic window winC
Global ky As Long                ' keypress code
Global exitflag As Long          ' flag for user closed window
Global xpos, ypos As Long        ' position of cursor after Printit
Global newcursorPos As Long      ' mouse click position for InputLine
Global fieldX, fieldY As Long    ' upper left corner of InputLine
Global xwindow, ywindow As Long  ' dimensions of window

'================= MAIN PROGRAM =======================================

Function PBMain
  Local winC As Dword            ' handle of  graphic window
  Local xmargin, ymargin As Long ' upper left corner of text
  Local xboard, yboard As Long   ' upper left corner of boards
  Local ymessage As Long         ' vertical position of messages
  Local InputLine$               ' input number
  Local lastKB$                  ' last input entry
  Local badinput As Boolean      ' for vetting input
  Local n$, m$, p$, q$, lastp$   ' used for input
  Local FAIL As Long             ' flag for a board jam, set in DownSlot
  Local cellsx0, cellsy0 As Long ' last board size so can erase it
  Local i, k As Long             ' general purpose variables
  Local slots As Long            ' cellsx + cellsy, # of slots perpendicalar to \ diagonal
  Local maxx As Long             ' length of binary string minus one
  Local cellsx, cellsy As Long   ' size of board (minus one)
  Local ending As Boolean        ' board completed
  Local boardsize As Long        ' limit of k in DownSlot
  Local xhighslot As Long        ' Topslot(BN) - cellsy,  not indexed by BN
  Local yhighslot As Long        ' Topslot(BN) - cellsx,  not indexed by BN
  Local ms, ts As Long           ' Mslot(BN), Topslot(BN), not indexed by BN
  Local slot As Long             ' index for slot, argument for DownSlot which it changes
  Local hslot, pslot As Long     ' arguments for HoleSlot and PieceSlot
  Local ix, iy As Long           ' general cell position, general x, y variables
  Local x$, y$, a$, b$           ' for checking and displaying solution
  Local LEVEL, phase As Long     ' master double loop
  Local maxLEVEL As Long         ' one less than longest width of board
  Local shownumber As Boolean    ' show number to factor wrapped around board
  Local x0, y0, xbase, ybase As Long    ' used to position text, general x, y variables
  Local continuing As Boolean    ' continuing to search for more factors after finding one
  Local sameboard As Boolean     ' continuing search on same board
  Local xboardmessage, yboardmessage As Long
  Local showintermediate, manualstep As Boolean
  Local time0, time1 As Single   ' start and finish times accurate to .01 seconds
  Local BN As Long               ' board state
  Dim ZZ(0) As Long              ' given binary number as an array
  Dim Board(0,0) As Long         ' display board, derived from XX() and YY()
  ' in the following arrays the first (or only) index is BN
  Dim XX(0,0) As Long, YY(0,0) As Long  ' board status
  Dim Nh(0,0) As Long, Np(0,0) As Long  ' # holes, # pieces in given slot
  Dim XII(0) As Long, YII(0) As Long    ' locations of one cells
  Dim XIDX(0) As Long, YIDX(0) As Long  ' sizes of XII, YII arrays
  Dim Mslot(0) As Long           ' the highest unlocked slot below the upper block of locked slots
  Dim Topslot(0) As Long         ' the lowest unlocked slot above the lower block of locked slots

  ' Given BN,  XX() refers to the non-zero horizontal rows
  '            YY() refers to the non-zero vertical columns
  ' If the board is solved these arrays encode the factorization.  For example
  ' (* stands for %one and · stands for %zero)
  '
  '    * * · · * * · * * *
  '    * * · · * * · * * *
  '    * * · · * * · * * *
  '    · · · · · · · · · ·
  '    · · · · · · · · · ·
  '    * * · · * * · * * *
  '    * * · · * * · * * *
  '
  '  XX() = 1100110111
  '  YY() = 1110011
  '  When the board is solved the contents of any given cell (x,y) is  XX(x) times YY(y).

  ' Diagonals of cells (like this /////) are called slots.  Slots vary in length from one cell at
  ' the upper left, to the number of vertical cells in the middle, to one cell at the lower right.
  ' Slots are numbered from 0 to cellsx + cellsy, the top cell going across the top and down the
  ' right side.  A slot is called "locked" if all its cells are determined, either zero or one --
  ' in other words the slot has no holes or pieces.  Since an 'X' is used in the graphic diagram
  ' to represent a zero, setting a cell or row or column to zero is called "X-ing it out".

  ' A board is solved when  Mslot + cellsy = Topslot

  Desktop Get Size To xwindow,ywindow
  Graphic Window "JRC’s factorization algorithm", 0,0, xwindow,ywindow To winC
  Graphic Attach winC, 0, ReDraw
  Graphic Color %Black, %White : Graphic Clear
  Graphic Set Focus
  xmargin = (xwindow - %WW) \ 2
  ymargin = (ywindow - %HH) \ 20
  xboard = xmargin + 10 : yboard = ymargin + 100
  ymessage = ymargin + 49                                 ' vertical position of board messages
  fieldX = xmargin + 63 : fieldY = ymargin + %HH + 132    ' position of InputLine
  ' The only reason we subclass the window is to be able to detect the user closing the program
  ' from outside the program by pressing Alt-F4 or clicking the window's X button.  In that case
  ' we want the program to terminate itself, otherwise -- though the window will be gone -- the
  ' process will remain running, and to end it the user would have to use Windows Task Manager.
  ' Given that we subclass the window, we might as well use GWnewC to get the keystrokes (which
  ' is a convenient and flexible method) instead of using Graphic Inkey$ and Waitkey$.
  GWoldC = SubClass(winC, CodePtr(GWnewC))
  Randomize                                               ' random seed for Rnd using Timer
'----------------------------

Start:

  showintermediate = True
  manualstep = True

  GoSub ClearWindow
  Graphic Font "Verdana",13,0 : Printit "ARIwatch.com/VS/Algorithms ",10,ywindow-50
  Graphic Font "Calabri", 11, 1
  Graphic Box (xmargin+20,ymargin+180)-(xmargin+20+%WW,ymargin+180+%HH),, %optiongrnd,%optiongrnd
  Graphic Width 2
  Graphic Box (xmargin+20,ymargin+180-1)-(xmargin+20+%WW,ymargin+180+%HH),, %DarkRedColor
  Graphic Width 1
  Graphic Color %Black,%optiongrnd
  Printit "Enter ...",                                                                                     xmargin + 20 + 2*9,     ymargin + 190
  Printit "An odd number,  either in reverse binary",                                                      xmargin + 20 + 5*9,     ypos + 28
  Graphic Font "Calabri", 10, 1
  Printit "(",                                                                                             xmargin + 20 + 5*9+283, ypos
  Printit "bits low to high, e.g. decimal 13 is 1011 not 1101",                                            xmargin + 20 + 5*9+288, ypos + 1
  Printit ")",                                                                                             xmargin + 20 + 5*9+593, ypos - 1
  Graphic Font "Calabri", 11, 1
  Printit "or in decimal",                                                                                 xmargin + 20 + 5*9,     ypos + 18
  Graphic Font "Calabri", 10, 1
  Printit "(",                                                                                             xmargin + 20 + 5*9+95,  ypos
  Printit "if the number looks binary put a decimal point at the end  .",                                  xmargin + 20 + 5*9+101, ypos + 1
  Printit ")",                                                                                             xmargin + 20 + 5*9+455, ypos - 1
  Graphic Font "Calabri", 11, 1
  Printit "or press ...",                                                                                  xmargin + 20 + 2*9,     ypos + 25
  Printit "Alt C  for a random odd number,",                                                               xmargin + 20 + 5*9,     ypos + 25
  Printit "Alt X  to exit,      Esc  to erase line,     Enter on a blank line to repeat your last entry.", xmargin + 20 + 5*9,     ypos + 18

  lastKB$ = ""
  Do
    GoSub GetInputLine : p$ = InputLine$
PostInputLine:
    Select Case Long ky
    Case -%X
      GoTo EndProgram
    Case -%repeatcode                   ' ky was %Enter on a blank line
      If lastp$ = "" Then
        Open "lastoption501.txt" For Input As #1
        Input #1, lastp$
        Close #1
        If lastp$ = "" Then Iterate Do
      End If
      lastKB$ = lastp$
    Case -%C                            ' make random odd number expressed in reverse binary
      k = Rnd(1,43)                     ' of between 1+2 and 43+2 bits
      p$ = "1"                          ' lowest bit must be 1 because number is odd
      For i = 1 To k
        p$ = p$ + Chr$(Rnd(%digit0,%digit1))
      Next
      p$ = p$ + "1"                     ' highest bit must be 1, number should not "begin" with 0
      q$ = p$
      Exit Do
    Case Else                           ' ky was %Enter not on a blank line
      q$ = p$
      GoSub CheckInput                  ' given p$, returns p$ (possibly modified) and badinput
      If Not badinput Then Exit Do
    End Select
  Loop
  lastp$ = q$

  Graphic Color %Black,%White
  Graphic Clear
  Graphic Font "Calabri", 10, 1
'----------------------------

  ' given p$ find a pair of non-trivial factors

  maxx = Len(p$) - 1

  ' the following arrays are independent from one board to the next
  ' redimensioning an array resets it to all zeros
  ReDim ZZ(maxx)
  ReDim XX(maxx,maxx), YY(maxx,maxx)
  ReDim Nh(maxx,maxx), Np(maxx,maxx)
  ReDim Board(maxx,maxx)
  ReDim Mslot(maxx), Topslot(maxx)
  ReDim XII(maxx), YII(maxx)
  ReDim XIDX(maxx), YIDX(maxx)

  For i = 0 To maxx                               ' convert p$ into an array
    If Asc(p$, i + 1) = %digit1 Then ZZ(i) = 1    ' the other ZZ(i) are zero
  Next

  Printit "Given  " + p$ + "   (" + Format$(Len(p$)) + "  bits)", xmargin, ymargin
  a$ = DecimalFromBinary(p$)
  If InStr(a$,"E") = 0 Then b$ = "   (" + Format$(Len(a$)) + "  digits)" Else b$ = ""
  Printit "decimal  " + a$ + b$, xmargin+45, ymargin + 16

  If showintermediate Then
    If manualstep Then GoSub ShowStepMessage
  Else
    GoSub ShowWorkingMessage
  End If
  Graphic ReDraw
'========================================================================

  ' Try all possible boards until success.
  ' A board's dimensions are the number of bits in two potential factors.
  ' LEVEL + 1 goes over the possible horizontal dimensions

  time0 = -1                           ' so know it hasn't been set yet
  cellsx0 = -1                         ' so know the first cellsx is new.
  continuing = False
  sameboard = False

  maxLEVEL = maxx \ 2
  If maxLEVEL = 0 Then maxLEVEL = 1    ' happens only when the given number is 3 (binary 11)
  xboardmessage = xboard
  yboardmessage = yboard + maxlevel*%cs + %cw + 30
  If maxlevel > 30 Then yboardmessage = yboardmessage - %cw

  ' the order of searching the levels doesn't matter, a random permutation would work
  For LEVEL = maxLEVEL To %minLEVEL Step -1
  ' phase takes only two values, shrink means we will decrement the horizontal dimension of the board
  For phase = %noshrink To %shrink     ' 1 To 2
CurrentBoard:

    ' initialize

    slots = maxx
    cellsx = slots - LEVEL      ' width of board minus 1
    cellsy = LEVEL              ' height of board minus 1, always cellsy <= cellsx
    If cellsx = cellsy And phase = %shrink Then Iterate    ' don't shrink square boards (LEVEL = maxLEVEL and that's odd)
    boardsize = cellsx*cellsy   ' used in DownSlot

    BN = 0                      ' board state
    FAIL = 0                    ' flag for jam
    shownumber = True           ' in first DisplayBoard for this LEVEL & phase show given number wrapped around board
    ending = False              ' in case here from a GoTo at beginning of DisplayBoard

    xbase = xboard + cellsx*%cw
    ybase = yboard + cellsy*%cs + 20     ' position of text below board

    For i = 0 To slots
      XX(0,i) = %blank                   ' rows
      YY(0,i) = %blank                   ' columns
    Next

    For slot = 0 To slots                ' compute number of holes & pieces
      Np(0,slot) = ZZ(slot)              ' # pieces, except in first DisplayBoard the only time ZZ() is accessed
      If slot <= cellsy Then             ' find length of slot
        k = slot + 1                     ' left triangle with corner at upper left
      Else
        If slot > cellsx Then
          k = slots - slot + 1           ' right triangle with corner at lower right
        Else
          k = cellsy + 1                 ' middle parallelogram
        End If
      End If
      Nh(0,slot) = k - Np(0,slot)        ' # holes equals length of slot minus # pieces
    Next

    ms = 1 : Mslot(0) = 1                ' ms, ts used in DisplayBoard
    ts = slots - 1 : Topslot(0) = ts

    If showintermediate Then
      GoSub Displayboard
      If Not manualstep And shownumber Then Sleep 250
    End If
    If shownumber Then
      If showintermediate Then GoSub ClearBoardTopNumber
      shownumber = False
    End If

    If phase = %shrink Then                       ' cellsx > cellsy, shrink the board?
      For ix = cellsx To slots                    ' X out (zero out) last column
        TryHoleSlot(ix)                           ' uses cellsx, cellsy, etc but not xhighslot or yhighslot
      Next
      Decr cellsx
      Decr slots
      Decr ts : Topslot(0) = ts
      xbase = xbase - %cw
      ShowStep
    End If

    ' cellsx, cellsy, slots are now fixed

    xhighslot = ts - cellsy
    yhighslot = ts - cellsx

    ' set top left corner to one
    Np(0,0) = 0                                   ' since number was vetted to be odd, Np(0,0) was 1
    XX(0,0) = %one : XIDX(0) = 0 : XII(0) = 0
    YY(0,0) = %one : YIDX(0) = 0 : YII(0) = 0
    ShowStep

    If time0 < 0 Then time0 = Timer               ' must have a ShowStep before this

    ' set bottom left corner to one
    TryPieceSlot(cellsy)                          ' generally PieceSlot might change BN but not here (and next two times below)
    YY(0,cellsy) = %one : Incr YIDX(0) : YII(YIDX(0)) = cellsy     ' XX(0,0) is already %one
    ShowStep                                                       ' YIDX(0) = 1 : YII(1) = cellsy  would do as well

    ' set top right corner to one
    TryPieceSlot(cellsx)                          ' YY(0,0) is already one
    XX(0,cellsx) = %one : Incr XIDX(0) : XII(XIDX(0)) = cellsx     ' XIDX(0) = 1 : XII(1) = cellsx  would do as well

    ' set bottom right corner to one
    TryPieceSlot(slots)                           ' XX(0,cellsx) and YY(0,cellsy) are already %one
    ShowStep
'----------------------------

    ' process top slots, could skip this if Np(BN,ts) > 0
    Do
      ' pin completed top slots (no pieces or holes, that is, all zeros and ones)
      While Np(BN,ts) = 0 And Nh(BN,ts) = 0
        If xhighslot <= ms Then GoTo BoardComplete     ' necessary when given number is 9 or 15 (others?), < only need for 9
        Decr ts                                        ' see comment after Wend
        Decr xhighslot : Decr yhighslot
        ShowStep
      Wend
      Topslot(BN) = ts                                 ' the only place where Topslot(BN) is changed
      ' after above topslot is not locked (locked meaning all the slots cells are determined zero or one),
      ' it has holes and/or pieces

      ' zero the mandatory top holes
      If Np(BN,ts) Then Exit Do                   ' if no pieces must be only holes

      ' sometimes  yhighslot >= 0  check is necessary, eg when the given number is 57 or 111 (decimal) or 6609
      If yhighslot >= 0 And YY(BN,yhighslot) = %blank Then
        For ix = 0 To cellsx                      ' X out the row
          If XX(BN,ix) <> %zero Then
            TryHoleSlot(yhighslot + ix)
          End If
        Next
        YY(BN,yhighslot) = %zero
        ShowStep
      End If
      If XX(BN,xhighslot) = %blank Then           ' X out the column tx = xhighslot
        For iy = 0 To cellsy
          If YY(BN,iy) <> %zero Then
            TryHoleSlot(xhighslot + iy)           ' argument goes from xhighslot to ts
          End If
        Next
        XX(BN,xhighslot) = %zero
        ShowStep
      End If

    Loop Until Nh(BN,ts)
'----------------------------

    Do                                            ' main loop

      If   Np(BN,ms) Then                         ' any pieces?
        If Nh(BN,ms) = 0 Then GoTo OneSlot        ' no holes?
      Else
        If Nh(BN,ms) = 1 Then GoTo ZeroSlot       ' one hole?
      End If

      ' else   at least one piece and at least one hole,
      '        or no pieces and (no holes or more than one hole)
      ' copy board state to BN + 1, increment BN, and continue to OneSlot
      k = BN + 1
      For i = 0 To cellsx
        XX(k,i) = XX(BN,i)
      Next
      For i = 0 To cellsy
        YY(k,i) = YY(BN,i)
      Next
      For i = 0 To slots
        Nh(k,i) = Nh(BN,i)
        Np(k,i) = Np(BN,i)
      Next
      XIDX(k) = XIDX(BN) : YIDX(k) = YIDX(BN)
      Mslot(k) = ms                               ' Mslot(BN)
      Topslot(k) = ts                             ' Topslot(BN)
      Incr BN                                     ' use the new state (xhighslot, yhighslot, ms, ts unchanged)

OneSlot:
      ' put top piece and each intersection in column
      XX(BN,ms) = %one : Incr XIDX(BN) : XII(XIDX(BN)) = ms    ' set XX and save the location
      ShowStep
      For iy = 0 To YIDX(BN)                             ' use the saved YY location
        TryPieceSlot(ms + YII(iy))                       ' lock intersections in column
      Next
      GoTo LockSlot                                      ' both OneSlot and ZeroSlot continue to LockSlot
'----------------------------

ZeroSlot:
      ' X out the column
      For iy = 0 To YIDX(BN)                             ' use the saved YY location
        TryHoleSlot(ms + YII(iy))                        ' X out cells not already Xed out
      Next
      For iy = ms To yhighslot                           ' ms might be > yhighslot
        TryHoleSlot(ms + iy))                            ' in which case this will not be executed
      Next
      XX(BN,ms) = %zero                                  ' before this XX = %blank
      ShowStep
'----------------------------

LockSlot:
      If ms <= yhighslot Then
        ' see if unfillable hole
        If Nh(BN,ms) <> 0 And YY(BN,ms) = %blank Then    ' X out the row
          For ix = 0 To XIDX(BN)
            TryHoleSlot(ms + XII(ix))             ' location in the array can't be %zero
          Next
          For ix = ms + 1 To xhighslot            ' X out all unprocessed locations
            TryHoleSlot(ms + ix)
          Next
          YY(BN,ms) = %zero
          ShowStep
        End If
        ' see if unmovable piece
        If Np(BN,ms) Then                         ' place left piece and each intersection in row
          YY(BN,ms) = %one : Incr YIDX(BN) : YII(YIDX(BN)) = ms    ' set the row and save the location
          ShowStep
          For ix = 0 To XIDX(BN)                  ' use the saved XX locations
            TryPieceSlot(ms + XII(ix))            ' lock intersections in row
          Next
        End If
      End If

      ' SlotDone
      If ms = xhighslot Then GoTo BoardComplete   ' Mslot = Topslot - cellsy,  earlier ms < xhighslot

      Incr Mslot(BN) : Incr ms                    ' only place where Mslot(BN) is changed
      ShowStep

    Loop                                          ' loop is exited by a Goto BoardComplete or ExitToSlotJam in a GoSub
'-----------------------------------------------

SlotJam:                               ' here from GoTo in ExitToSlotJam, either in DownSlot or PieceSlot
    FAIL = 0                           ' reset FAIL flag in case that's how we got here
    If showintermediate Then
      GoSub DisplayBoard
      If sameboard Then
        sameboard = False
      Else
        Printit "JAMMED", xbase - 23, ybase
      End If
      Graphic ReDraw
      If Not manualstep Then Sleep %pausetime
      GoSub ClearJammedMessage : If ky = %solvekey Then Graphic ReDraw
    End If
    If BN Then
      Decr BN                          ' revert to previous board state
      ms = MSlot(BN)                   ' these four varialbes were not saved, redefine them
      ts = Topslot(BN)                 '
      xhighslot = ts - cellsy          '
      yhighslot = ts - cellsx          '
      ShowStep
      GoTo ZeroSlot                    ' X out the column
    End If

    ' no previous board state, all decisions have been made
    If showintermediate Then
      x0 = xbase - 34 : y0 = ybase
      Printit "board failed", x0, y0
      Graphic ReDraw
      If Not manualstep Then Sleep 250
      Graphic Box (x0, y0)-(x0 + 100, y0 + 16),, %White, %White
      If manualstep Then GoSub Getkey
    End If

    If cellsx <> cellsx0 Then GoSub ShowBoardSize

NextBoard:
  Next ' phase
  Next ' LEVEL
  '----------------------------

  ' here if tried all boards and all failed
  FAIL = 1

BoardComplete:
  ix = xboardmessage : iy = yboardmessage
  GoSub ClearExtraneousBoardSize
  GoSub DisplayBoard0
  ending = True
  GoSub CheckSolution
  ending = False : sameboard = False : xboardmessage = ix : yboardmessage = iy
  ' next problem
  Graphic Color %BlueColor
  GoSub ClearMessage
  Printit "Press Backspace to factor another number.", xmargin, ymessage
  If FAIL = 0 Then                 ' And (cellsy > 1 Or phase = 1)
    Printit "or M, Enter, or Spacebar to continue search,  PgUp to skip to next board.", xmargin, ymessage + 15
  End If
  Graphic Color %Black
  Graphic ReDraw
  Do
    GoSub Getkey
    If ky = -%C Then GoTo PostInputLine
    If ky = %quitkey Or ky = -%X Then GoTo Start
    If (FAIL = 0 And (ky = %stepkey Or ky = %moviekey Or ky = %solvekey Or ky = %nextboardkey)) Or ky = %previousboardkey Then
      GoSub SetDisplayMode         ' determine manualstep and showintermediate from ky
      GoSub ClearAll
      GoSub ClearLowerMessage
      GoSub ShowWorkingMessage
      If     ky = %nextboardkey And maxLEVEL > 1 Then
        If LEVEL > %minLEVEL Or (LEVEL = %minLEVEL And phase = %noshrink) Then
          continuing = True
          time0 = Timer
          GoTo NextBoard
        End If
      ElseIf ky = %previousboardkey Then
        If phase = %shrink Then
          phase = %noshrink
          continuing = True
          time0 = Timer
          GoTo CurrentBoard
        Else  ' phase = %noshrink
          If     LEVEL = maxLEVEL - 1 Then
            Incr LEVEL
            continuing = True
            time0 = Timer
            GoTo CurrentBoard
          ElseIf LEVEL < maxLEVEL Then
            phase = %shrink
            Incr LEVEL
            continuing = True
            time0 = Timer
            GoTo CurrentBoard
          End If
        End If
      Else
        continuing = True : sameboard = True : cellsx0 = -1
        time0 = Timer
        GoTo SlotJam
      End If
    End If
  Loop

'================== GOSUBROUTINES =======================================

  Local holes As Long
' given slot
' DownSlot removes a piece from the slot and changes lower bit slots (slots
' diagonally above and left) accordingly.  It sets FAIL if there is no room.
' On return slot equals the lowest slot that got a piece.  This gosubroutine
' is used by Holeslot and Pieceslot.
DownSlot:                          ' borrow (push down)
  k = 2
  Decr Np(BN,slot)
  Incr Nh(BN,slot)
  Do While slot > ms
    Decr slot                      ' look at lower bit (to the left)
    holes = Nh(BN,slot)            '   increase # pieces by k if possible and stop
    If     holes >= k Then
      Np(BN,slot) = Np(BN,slot) + k
      Nh(BN,slot) = holes - k
      Return
    ElseIf holes Then              ' if not possible, increase # pieces by as much
      Np(BN,slot) = Np(BN,slot) + holes   ' as possible (the # holes) and decrease k
      Nh(BN,slot) = 0
      k = k - holes                ' holes < k so k > 0
    End If
    Shift Left k, 1                ' double k
  Loop Until k > boardsize
  FAIL = 1                         ' couldn't move piece, jammed
Return
'----------------------------------------------------------

' given hslot
HoleSlot:
  If Nh(BN,hslot) = 0 Then         ' no holes
    TryDownSlot(hslot)
  End If
  Decr Nh(BN,hslot)
Return
'----------------------------------------------------------

  Local tsx, tsy As Long                       ' general cell coordinates (avoid indices of caller)

' given pslot
PieceSlot:

  If Np(BN,pslot) = 0 Then

    slot = pslot

    Do                                         ' search up for a piece
      Incr slot
      If slot > ts Then                        ' no pieces
        ExitToSlotJam
      End If
    Loop Until Np(BN,slot)

    If slot = ts And Np(BN,slot) = 1 Then      ' always choosing the other option works but this is a little faster (~5%)

      TryDownSlot0                             ' changes slot
      ' here Nh(BN,ts) <> 0

      If XX(BN,xhighslot) = %blank Then
        For tsy = cellsy To 0 Step -1
          If YY(BN,tsy) <> %zero Then
            hslot = xhighslot + tsy            ' goes from ts to xhighslot
            If Nh(BN, hslot) = 0 Then          ' no holes
              If Np(BN, hslot) = 0 Then        ' no pieces
                ExitToSlotJam
              End If
              TryDownSlot(hslot)
            End If
            Decr Nh(BN,hslot)
          End If
        Next
        XX(BN,xhighslot) = %zero
        ShowStep
      End If
      ' the above might change Nh(BN,ts)

      If Nh(BN,ts) <> 0 And YY(BN,yhighslot) = %blank Then
        For tsx = cellsx To 0 Step -1
          If XX(BN,tsx) <> %zero Then
            hslot = yhighslot + tsx            ' goes from ts to yhighslot
            If Nh(BN,hslot) = 0 Then           ' no holes
              If Np(BN,hslot) = 0 Then         ' no pieces
                ExitToSlotJam
              End If
              TryDownSlot(hslot)
            End If
            Decr Nh(BN,hslot)
          End If
        Next
        YY(BN,yhighslot) = %zero
        ShowStep
      End If

      If xhighslot > ms Then
        Decr Topslot(BN) : Decr ts             ' one of two places where Topslot(BN) is changed
        Decr xhighslot
        Decr yhighslot
        ShowStep
      End If

      GoTo PieceSlot                           ' Np(BN,pslot) may have changed, eg when given number 121

    Else                                       ' Not (slot = ts And Np(BN,slot) = 1)

      Do                                       ' push pieces down
        TryDownSlot0                           ' changes slot
      Loop Until slot <= pslot

    End If

  End If

  Decr Np(BN,pslot)
Return
'----------------------------------------------------------

PrintFancyX:
  Graphic Color %DarkGrayColor : Graphic Font "Verdana", 8, 1
  Printit "x", k + 8, y0 + 17
  Graphic Color %Black         : Graphic Font "Calabri", 10, 1
Return

CheckSolution:
  GoSub ClearBoardSize

  If FAIL Then
    GoSub ClearExtraneousBoardSize
    y0 = ybase + 4
    If continuing Then
      Printit "No more factors found.", xmargin, y0
    Else
      Printit "Could not factor.", xmargin, y0
      If IsPrime(p$, a$, b$) Then
        Printit "It’s a prime number.", xpos+9, y0
      Else
        Graphic Color %Red
        Printit "Error", xpos+9, y0
        Graphic Color %Black
        Printit "it’s not a prime number:  " + a$ + " x " + b$, xpos + 9, y0
      End If
    End If
    GoSub ShowTimer
    Return
  End If

  x$ = ""
  For i = 0 To cellsx
    If XX(BN,i) = %zero Then
      x$ = x$ + "0"
    Else
      x$ = x$ + "1"
    End If
  Next
  y$ = ""
  For i = 0 To cellsy
    If YY(BN,i) = %zero Then
      y$ = y$ + "0"
    Else
      y$ = y$ + "1"
    End If
  Next

  y0 = ybase + 6
  Printit "horizontal", xmargin, y0 : i = xpos      ' i = end of "horizontal"
  Printit x$, xmargin, y0 + 16 : k = xpos           ' k + 25 is beginning of second number
  If i < k + 20 Then                                ' don't want "vertical" to overwrite "horizontal"
   Printit "vertical", k + 25, y0
  Else
   Printit ", vertical", i, y0
  End If
  xboardmessage = xpos + 30 : yboardmessage = y0
  If FAIL = 0 Then GoSub ShowBoardSize              ' yboardmessage = ybase + 6
  GoSub PrintFancyX
  Printit y$, xpos + 7, y0 + 16

  a$ = SMul(x$,y$)
  Printit "equals  " + a$, xmargin, y0 + 32
  If a$ = p$ Then
    GoSub ShowTimer
    y0 = y0 + 41
    Printit "decimal  " + DecimalFromBinary(x$), xmargin+51, y0 + 16 : k = xpos
    GoSub PrintFancyX
    Printit DecimalFromBinary(y$), xpos + 7, y0 + 16
    Printit "equals  " + DecimalFromBinary(a$), xmargin+109, y0 + 32
  Else
    Graphic Color %Red
    Printit "error" , xpos + 9, y0 + 32
    Printit "Press Esc.", xpos - 32, y0 + 48
    Graphic ReDraw
    Graphic Color %Black
    Do
      GoSub Getkey
      If ky = %Esc Then GoTo Start
    Loop
  End If
Return
'----------------------------------------------------------

SetDisplayMode:
  If     ky = %solvekey Then
    manualstep       = False
    showintermediate = False
  ElseIf ky = %moviekey Then
    manualstep       = False
    showintermediate = True
  Else  ' %stepkey or %nextboardkey or %previousboardkey or %Esc
    manualstep       = True
    showintermediate = True
  End If
Return

ShowBoardSize:
  If ending Then
    Printit "(" + Format$(cellsx + 1) + " by " + Format$(cellsy + 1) + " board", xboardmessage, yboardmessage
    If slots < maxx Then                          ' shrunken
      Printit "««)", xpos+4, yboardmessage
    Else
      Printit ")", xpos+1, yboardmessage
    End If
  Else
    If     slots < maxx Then                      ' in shrink phase
      Printit "««", xboardmessage+45, yboardmessage + 12
    ElseIf phase <> %shrink Then
      Graphic Box(xboardmessage+45,yboardmessage+17)-(xboardmessage+60,yboardmessage+25),,%White,%White
    End If
    Graphic Box(xboardmessage+75,yboardmessage)-(xboard+200,yboardmessage+16),,%White,%White
    Printit "board  " + Format$(cellsx + 1) + " x " + Format$(cellsy + 1) + " ", xboardmessage, yboardmessage
    If slots = maxx And phase = %shrink Then
      Printit "(will shrink)", xpos + 10, yboardmessage
    End If
  End If
  If Not showintermediate Then Graphic ReDraw     ' otherwise Redraw done in DisplayBoard
  cellsx0 = cellsx
Return

ClearBoardSize:
  Graphic Box(xboard,yboardmessage)-(xboard+175,yboardmessage+25),,%White,%White
Return
'----------------------------------------------------------

ShowTimer:
  Printit "(done in  " + Format$(time1 - time0,"#.00") + " seconds)", xpos+20, ypos
Return
'----------------------------------------------------------

Getkey:                       ' wait for a keypress furnished by GWnewC
  ky = 0
  Do
    Sleep 1
  Loop Until ky
  If exitflag Then GoTo EndProgram
Return
'------------------------------------------------------------

ClearWindow:                  ' workaround for PBCC5 compiler bug that makes Graphic Clear unreliable
  Graphic Set Pixel (0,0), %Red
  Graphic ReDraw
  i = 1
  Do
    Graphic Clear
    Sleep i
    Graphic ReDraw
    Graphic Get Pixel (0,0) To k
    i = i + 10
  Loop Until k = %White
Return
'------------------------------------------------------------

ClearBoard:
  Graphic Box (xboard-%o-7,yboard-20)-(xboard+(cellsx0+2)*%cs+50,yboard+(cellsy0+1)*%cs - %cw + %o+4),, %White, %White
Return

ClearBoardTopNumber:
  Graphic Box (xboard-%o-6,yboard-%cs-12)-(xboard+(cellsx0+2)*%cs,yboard),, %White, %White
Return

ClearAll:
  Graphic Box (xboard-%o-7,yboard-54)-(xboard + Max&((cellsx0+2)*%cs+165,450),yboard+(cellsy0+1)*%cs + 100),, %White, %White   ' max business to clear time message
Return
'----------------------------------------------------------

ShowWorkingMessage:
  Graphic Color %BlueColor
  If Not showintermediate And maxx > 32 Then              ' long numbers can take more than a split second
    Printit "Working ...     (Esc will pause)", xmargin, ymessage
  ElseIf showintermediate And Not manualstep Then
    Printit "Esc will pause the movie", xmargin, ymessage
  Else
    GoSub ShowStepMessage
  End If
  Graphic Color %Black
  GoSub ClearJammedMessage
  Graphic ReDraw
Return
'----------------------------------------------------------

ShowStepMessage:
  Graphic Color %BlueColor
  Printit "Press M to show movie,  Enter to step through the process,  Spacebar to solve,  Backspace to quit.", xmargin, ymessage
  Graphic Color %Black
Return

ClearMessage:
  Graphic Box (xmargin,ymessage)-(xmargin + 650,ymessage+16+12),,%White,%White
Return

ClearLowerMessage:
  Graphic Box (xmargin,ymessage+16)-(xmargin + 546,ymessage+16+15),,%White,%White
Return

ClearJammedMessage:
  x0 = xbase - 25 : y0 = ybase
  Graphic Box (x0,y0)-(x0+65,y0+16),, %White,%White
Return

ClearExtraneousBoardSize:
  Graphic Box (xboardmessage,yboardmessage)-(xboardmessage+96,yboardmessage+16),,%White,%White
Return
'----------------------------------------------------------

Local pcs As Long              ' number of leftover pieces in a slot
Local tx, ty As Long           ' general cell coordinates
Local XP, YP As Long           ' particular XX(), YY()
' also uses  i, k, slot, ms, ts, XX(), YY(), ky
DisplayBoard0:
  time1 = Timer
  If Not showintermediate Or (showintermediate And manualstep) Then GoSub ClearMessage
  GoSub ClearBoardSize
DisplayBoard:
  If exitflag Then GoTo EndProgram

  If showintermediate Then

    If manualstep And Not sameboard Then
      If Not shownumber Then
        Do
          GoSub Getkey
          If     ky = %QuitKey Or ky = -%X Then
            PopStack
            GoTo Start
          ElseIf ky = %solvekey Then
            GoSub ClearBoard : GoSub ClearBoardTopNumber
            GoSub ClearMessage
            GoSub ClearJammedMessage
            GoSub SetDisplayMode
            GoSub ShowWorkingMessage
            Return
          ElseIf ky = %moviekey Then
            GoSub ClearMessage
            GoSub SetDisplayMode
            GoSub ShowWorkingMessage
            Return
          ElseIf ky = %stepkey Then
            Exit Do
          ElseIf ky = %nextboardkey And maxLEVEL > 1 Then
            If level > %minLEVEL Or (LEVEL = %minLEVEL And phase = %noshrink) Then
              continuing = true
              time0 = -1
              PopStack
              GoTo NextBoard
            End If
          ElseIf ky = %previousboardkey Then
            If phase = %shrink Then
              phase = %noshrink
              time0 = -1
              PopStack
              GoTo CurrentBoard
            Else   ' phase = %noshrink
              If     LEVEL = maxLEVEL - 1 Then
                Incr LEVEL
                time0 = -1
                PopStack
                GoTo CurrentBoard
              ElseIf LEVEL < maxLEVEL Then
                phase = %shrink
                Incr LEVEL
                time0 = -1
                PopStack
                GoTo CurrentBoard
              End If
            End If
          ElseIf ky = -%C Then
            PopStack
            GoTo PostInputLine
          End If
        Loop
      End If
    Else                                   ' showing movie
      If  ky = %Esc Then
        manualstep = True
        GoSub ShowStepMessage
        GoSub ClearJammedMessage
      End If
    End If

  Else                                     ' fast solution

    If ky = %Esc Then
      GoSub SetDisplayMode
      GoSub ShowStepMessage
    End If

  End If

  ' determine  board(x,y)  from  XX(BN,x) and YY(BN,y)
  For slot = 0 To slots                          ' slot = 0 to cellsx, slot to slots
    If slot <= cellsx Then                       ' find top of slot
      ty = 0             : tx = slot             ' ty fixed at top, tx goes across
    Else
      ty = slot - cellsx : tx = cellsx           ' tx fixed at right, ty goes down
    End If
    pcs = Np(BN,slot)                            ' after this we don't use slot anymore
    Do                                           ' go down slot / top to bottom
      XP = XX(BN,tx) : YP = YY(BN,ty)
      If     XP = %zero Or YP = %zero Then
        k = %zero
      ElseIf XP = %one And YP = %one  Then
        k = %one
      ElseIf pcs Then
        k = %piece : Decr pcs                    ' pcs pieces then blanks interspersed with zeros and ones
      Else                                       ' along a slot there is no blank above a piece
        k = %blank                               ' not zero or one and used up pcs
      End If
      Board(tx, ty) = k
      Incr ty : Decr tx                          ' next cell down /
    Loop Until ty > cellsy Or tx < 0
  Next

  GoSub ClearBoard

'  Mslot(BN) = ms      the highest unlocked slot below the upper block of locked slots
'  Topslot(BN) = ts    the lowest unlocked slot above the lower block of locked slots
'
'         Mslot              Topslot
'----------/-------------------/------------
' locked  /                   /
'        /        ???        /
'       /                   /    locked
'      /                   /

  ' draw slots
  Graphic Width 3
  If shownumber Then                     ' first display of this  (LEVEK, phase)
    For slot = 0 To slots
      If slot + 1 <= cellsy Then         ' upper left corner triangle
        Graphic Line (xboard-%vvv, yboard +%vvv+ (slot+1)*%cs - %cw)-(xboard + (slot+1)*%cs+%ooo, yboard - %cw-%ooo), %MediumGrayColor
      Else
        If slot + 1 > cellsx Then        ' lower right corner triangle
          Graphic Line (xboard -%vvv + (slot-cellsy)*%cs, yboard +%vvv + cellsy*%cs + %cw)-(xboard + (cellsx+1)*%cs +%ooo, yboard + (slot-cellsx-1)*%cs+%cw-%ooo), %MediumGrayColor
        Else                             ' middle parallelogram
          Graphic Line (xboard -%vvv + (slot-cellsy)*%cs, yboard +%vvv+ cellsy*%cs+%cw)-(xboard + (slot+1)*%cs +%ooo, yboard -%cs+%cw-%ooo), %MediumGrayColor
         End If
      End If
    Next
    ' draw the input number, across and down, turning at cellsx
    For i = 0 To cellsx - 1              ' top row
      Printit Format$(ZZ(i)), xboard + (i + 1) * %cs + %cs-%oo, yboard - %cs*2 + %oo
    Next
    For i = i To maxx                    ' right column, maxx = slots or slots + 1
      Printit Format$(ZZ(i)), xboard + (cellsx + 2)*%cs-%oo, yboard + (i-cellsx - 2)*%cs+%oo
    Next
  Else
    For slot = 0 To slots
      If slot = ms - 1 Or slot = ts + 1 Then
        k = %PurpleColor
      ElseIf slot < ms Or (slot > ts And Not shownumber) Then
        k = %DarkRedColor
      Else
        k = %MediumGrayColor
      End If
      If slot + 1 <= cellsy Then         ' upper left corner triangle
        Graphic Line (xboard-%vvv, yboard +%vvv+ (slot+1)*%cs - %cw)-(xboard + (slot+1)*%cs-%cw1+%ooo, yboard - %cw+%cw1-%ooo), k
      Else
        If slot + 1 > cellsx Then        ' lower right corner triangle
          Graphic Line (xboard -%vvv + (slot-cellsy)*%cs, yboard +%vvv + cellsy*%cs + %cw)-(xboard + (cellsx+1)*%cs -%cw1+%ooo, yboard + (slot-cellsx-1)*%cs+%cw+%cw1-%ooo), k
        Else                             ' middle parallelogram
          Graphic Line (xboard -%vvv + (slot-cellsy)*%cs, yboard +%vvv+ cellsy*%cs+%cw)-(xboard + (slot+1)*%cs -%cw1+%ooo, yboard -%cs+%cw+%cw1-%ooo), k
        End If
      End If
    Next
  End If
  Graphic Width 1

  ' draw blue dots (ones) and red Xs (zeros)
  For ty = 0 To cellsy
    y0 = yboard + ty*%cs
    For tx = 0 To cellsx
      x0 = xboard + tx*%cs
      k = Board(tx,ty)
      slot = tx + ty
      If slot < ms Or slot > ts Then
        i = %DarkRedColor
      Else
        i = %DarkGrayColor
      End If
      If     k = %one   Then
        Graphic Ellipse (x0-%o, y0-%o)-(x0+%cw+%o, y0+%cw+%o), i,%LightBlueColor
      ElseIf k = %zero  Then
        Graphic Ellipse (x0-%o, y0-%o)-(x0+%cw+%o, y0+%cw+%o), i,%LightGrayColor
        Graphic Width 3
        If slot = ms - 1 Or slot = ts + 1 Then
          i = %PurpleColor
        Else
          i = %RedColor
        End If
        Graphic Line (x0, y0)-(x0+%cw, y0+%cw), %RedColor
        Graphic Line (x0, y0+%cw)-(x0+%cw,y0 ), i
        Graphic Width 1
      ElseIf k = %piece Then
        Graphic Ellipse (x0-%o, y0-%o)-(x0+%cw+%o, y0+%cw+%o), i, %GreenColor
      Else     ' %blank
        Graphic Ellipse (x0-%o, y0-%o)-(x0+%cw+%o, y0+%cw+%o), %MediumGrayColor, %White
      End If
    Next
  Next

  ' draw outline
  Graphic Width 2
  Graphic Box (xboard-6,yboard-6)-(xboard+(cellsx+1)*%cs-2,yboard+(cellsy+1)*%cs-%cw+7),,%GrayColor
  Graphic Width 1

  GoSub ShowBoardSize

  Graphic ReDraw

  ' save board size for next ClearBoard
  If shownumber Then
    cellsx0 = cellsx + 1                  ' so ShowNumber will work next time
  Else
    cellsx0 = cellsx
  End If
  cellsy0 = cellsy
Return
'----------------------------------------------------------

Local KBbuffer As String
Local char As String
Local cursorPos, nChar, w As Long

GetInputLine:
  KBbuffer = lastKB$
  nchar = Len(KBbuffer)
  cursorpos = nchar
  Graphic Color %Black, %editgrnd

  Do
   w = cursorpos*8
   Graphic Box (fieldx-2,fieldy-3)-(fieldX+%fieldlen+2,fieldy+18),, %editgrnd,%editgrnd   ' clear field
   Printit KBbuffer, fieldx, fieldy
   Graphic Box (fieldx+w,fieldy-1)-(fieldx+w+2,fieldy+17),,%DarkGrayColor, -1             ' cursor
   Graphic ReDraw
   GoSub Getkey
   If %KPzero <= ky And ky <= %KPnine Then ky = ky - 48       ' convert keypad keys to regular
   If ky = %KPperiod                  Then ky = %periodcode   '
   If badinput Then                      ' from caller when it called CheckInput
    Graphic Box (fieldx,fieldy+20)-(fieldx+400,fieldy+40),,%optiongrnd,%optiongrnd        ' clear error message
    Graphic ReDraw
    badinput = False
   End If
   Select Case Long ky
   Case -%X,-%C
    Exit Loop
   Case %moviekey, %solvekey
     If KBbuffer <> "" Then
       GoSub SetDisplayMode
       ky = %Enter
       Exit Loop
     End If
   Case %Enter
    If kBbuffer = "" Then ky = -%repeatcode
    Exit Loop
   Case %bksp
    If nChar = 0 Then Exit Select
    If     cursorPos = nChar Then
     Decr nChar
     KBbuffer = Left$(KBbuffer, nChar)
     cursorPos = cursorpos - 1
    ElseIf cursorPos > 0 Then
     KBbuffer = Left$(KBbuffer, cursorPos - 1) + Right$(KBbuffer, nChar - cursorPos)
     Decr cursorPos
     Decr nChar
    End If
   Case %left
    If cursorPos > 0 Then
     Decr cursorPos
    End If
   Case %rightkey
    If cursorPos < nchar Then
     Incr cursorPos
    End If
   Case %endkey
    cursorPos = nChar
   Case %homekey
    cursorPos = 0
   Case %Esc
    KBbuffer = ""
    nChar = 0
    cursorPos = 0
   Case %del
    If nChar > 0 Then
     If     cursorPos = 0 Then
      Decr nChar
      KBbuffer = Right$(KBbuffer, nChar)
     ElseIf cursorPos < nchar Then
      KBbuffer = Left$(KBbuffer, cursorPos) + Right$(KBbuffer, nChar - cursorPOS - 1)
      Decr nChar
     End If
    End If
   Case %mousecode
     If newcursorPos = -1 Then                      ' code for clicking URL
       If MessageBox(winC, "  Exit program and open website ?"+$Nul, $Nul, %MB_OKCANCEL+%MB_SYSTEMMODAL) = %IDOK Then
         ShellExecute 0, "open", "http://ARIwatch.com/VS/Algorithms" + $Nul, "", "", %SW_SHOWNORMAL
         ky = -%X
         Exit Loop
       Else
         Graphic Set Focus
       End If
     ElseIf newcursorPos <= nChar Then
       cursorPos = newcursorPos
     ElseIf newcursorPos <= nChar + 1 Then
       cursorPos = nChar
     End If
   Case %digit0 To %nine, %periodcode
    If nChar >= %mlen Then Exit Select
    If ky = %periodcode Then
     ky = %period
     If cursorPos <> nChar Then Iterate                 ' not at end
     If cursorPos = 0 Then Iterate                      ' at beginning
    End If
    If Asc(KBbuffer,cursorPos) = %period Then Iterate   ' previous character a period
    char = Chr$(ky)
    If cursorPos = nChar Then
     KBbuffer = KBbuffer + char
    Else
     KBbuffer = Left$(KBbuffer, cursorPos) + char + Right$(KBbuffer, nChar - cursorPOS)
    End If
    Incr nChar
    Incr cursorPos
   End Select
  Loop

  If Len(KBbuffer) Then lastKB$ = KBbuffer
   Graphic Color %Black, %White
  InputLine$ = KBbuffer
Return
'------------------------------------------------------------

CheckInput:                         ' sets badinput = True if input error
  ' uses i, k
  If Right$(p$,1) = "." Then        ' check if forced decimal
     p$ = Left$(p$, Len(p$) - 1)
     GoTo IsDecimal
  End If
  p$ = RTrim$(p$,"0")               ' possible binary, trim "leading" zeros
  If p$ = "1" Then
    p$ = "Enter a number greater than one."
    GoTo Failed
  End If
  If Len(p$) > 63 Then
    p$ = "That’s too large, over 63 bits."
    GoTo Failed
  End If
  For i = 1 To Len(p$)              ' check if binary
    k = Asc(p$,i) : If k <> %digit0 And k <> %digit1 Then Exit For
  Next
  If i > Len(p$) Then               ' it's binary
    If Left$(p$,1) = "0" Then
      GoTo FailedEvenNumber
    Else                            ' it's binary and odd
      GoTo Succeeded
    End If
  End If
IsDecimal:
  p$ = LTrim$(p$,"0")               ' trim leading zeros
  If Len(p$) > 18 Then
    p$ = "That’s too large, over 18 decimal digits."
    GoTo Failed
  End If
  p$ = BinaryString(Val(p$))        ' convert to binary
  If Left$(p$,1) = "0" Then
    GoTo FailedEvenNumber
  End If
Succeeded:
  badinput = False
  Return
'--------------------------
FailedEvenNumber:
  p$ = "That’s an even number."
Failed:
  badinput = True
  Graphic Color %BlueColor, %optiongrnd
  Printit p$, fieldx, fieldy + 20
  Graphic Color %Black, %editgrnd
  Graphic ReDraw
Return
'------------------------------------------------------------

EndProgram:
  If lastp$ <> "" Then
    Open "lastoption501.txt" For Output As #1          ' presumably a unique filename
    Write #1, lastp$
    Close #1
  End If
End Function

'===================== SUBROUTINES ======================================

' convert decimal n to a reverse binary string (that is, low bit first)
Function BinaryString(ByVal n As Quad) As String
  Local k As Quad
  Local a$
  While n
    k = n\2
    a$ = a$ + Chr$(%digit0 + n - k*2)
    n = k
  Wend
  Function = a$
End Function
'------------------------------------------------------------

Function IsPrime(ByVal p As String, a As String, b As String) As Boolean    ' given p a reverse binary string representing an odd number
  Local n As Quad                                                           ' if not prime, return factorization a and b (decimal strings)
  Local i, k As Long
  k = Len(p$)
  For i = 1 To k
   If Asc(p$,i) = %digit1 Then
     n = n + 2^(i-1)
   End If
  Next
  k = Sqr(n)
  For i = 3 To k Step 2              ' possible divisors of n
    If (n\i)*i = n Then Exit For     ' i divides n
  Next
  If i > k Then                      ' no divisor found
    Function = True
  Else                               ' i is a divisor
    a = Format$(i)
    b = Format$(n\i)
  End If
End Function
'------------------------------------------------------------

Function SMul(ByVal x$, ByVal y$) As String
  Local cx, cy, tx, ty, k, i As Long
  Local p$
  Dim Z(0) As Long

  cx = Len(x$)
  cy = Len(y$)
  k = cx + cy - 1
  ReDim Z(k)                     ' array of zeros

  ' multiply smx$ and smy$ as a binary operation, low bit at left
  For ty = 1 To cy
  For tx = 1 To cx
    i = tx + ty - 2
    If Asc(x$, tx) = %digit1 And Asc(y$, ty) = %digit1 Then
      Incr Z(i)
    End If
  Next
  Next

  For i = 0 To k                 ' take care of carries
    While Z(i) > 1
      Z(i) = Z(i) - 2
      Incr Z(i + 1)
    Wend
  Next

  While Z(k) = 0                 ' trim any "leading" zeros
    Decr k
  Wend

  For i = 0 To k                 ' p$ starts at ""
    p$ = p$ + Chr$(%digit0 + Z(i))
  Next

  Function = p$
End Function
'------------------------------------------------------------

Sub Printit(ByVal a$, ByVal x As Long, ByVal y As Long)
  Graphic Set Pos (x,y) : Graphic Print a$;
  Graphic Get Pos To xpos,ypos   ' cursor position after printing
End Sub
'------------------------------------------------------------

Declare Function sprintf CDecl Lib "msvcrt.dll" Alias "sprintf" (buffer As Asciiz, ByRef format As Asciiz, ByVal q As Quad) As Long

Function QuadToString(ByVal n As Quad) As String
  Local s As Asciiz*20                             ' n >= 0, otherwise would use *21
  sprintf s, "%lld", n
  Function = s
End Function

Function DecimalFromBinary(ByVal a$) As String     ' given a reverse binary
  Local n As Quad
  Local i, k As Long
  k = Len(a$)
  For i = 1 To k
   If Asc(a$,i) = %digit1 Then
     n = n + 2^(i-1)
   End If
  Next
  Function = QuadToString(n)
End Function
'------------------------------------------------------------

Declare Function GetWindowLong Lib "USER32.DLL" Alias "GetWindowLongA" (ByVal hWnd As Dword, ByVal nIndex As Long) As Long
Declare Function GetWindow Lib "USER32.DLL" Alias "GetWindow" (ByVal Wnd As Dword, ByVal wCmd As Dword) As Long
Declare Function SetWindowLong Lib "USER32.DLL" Alias "SetWindowLongA" (ByVal Wnd As Dword, ByVal nIndex As Long, ByVal lNewLong As Long) As Long
Declare Function CallWindowProc Lib "USER32.DLL" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Dword, ByVal Wnd As Dword, ByVal uMsg As Dword, ByVal param As Dword, ByVal mousepos As Long) As Long

%GW_DEPENDENT = 5
%GWL_WNDPROC  = -4

Function SubClass(ByVal hwnd As Dword, ByVal subptr As Dword) As Dword
  Local GW As Dword
  GW = GetWindow(hwnd, %GW_DEPENDENT)
  Function = SetWindowLong(GW, %GWL_WNDPROC, subptr)
End Function

Type KeyState
  repeatcount As Bit*16 In Dword
  scancode    As Bit*8
  extendkey   As Bit*1      '1 if right Alt or Ctrl
  reserve1    As Bit*4
  context     As Bit*1      '1 if Alt down when key pressed
  previous    As Bit*1      '1 if down, 0 if up
  transstate  As Bit*1      'always 0
End Type

Union Syskey                'KeyState in one 32 bit word
  value As Dword
  KeyState
End Union

%WM_SysKeyDown = &H104
%VK_MENU       = &H12       'alt key
%WM_SYSCOMMAND = &H112
%SC_KeyMenu    = &HF100&    'alt key, & is necessary so unsigned
%WM_KeyDown    = &H100
%WM_KeyUp      = &H101
%VK_SHIFT      = &H10
%VK_CONTROL    = &H11
%WM_Destroy    = &H2
%WM_Close      = &H10
%WM_LButtonDown = &H201
%WM_LButtonUp   = &H202

Function GWnewC(ByVal Wnd As Dword, ByVal Msg As Dword, ByVal param As Dword, ByVal mousepos As Long) As Long
  Static shiftdown As Long
  Local Xmouse, Ymouse As Long
  Local ks As Syskey
  Select Case Long Msg
  Case %WM_Destroy, %WM_Close                               'user closed window using Windows commands
    exitflag = 1
    ky = %Esc
  Case %WM_KeyUp
    If param = %VK_SHIFT Or Param = %VK_CONTROL Then        'shift key up
      shiftdown = 0
    End If
  Case %WM_KeyDown
    If param = %VK_SHIFT Or Param = %VK_CONTROL Then        'shift key down
      shiftdown = True
    Else
      If shiftdown Then                                     'param is always uppercase
        ky = -param                                         'indicate shift by negative
      Else
        ky =  param
      End If
    End If
  Case %WM_SYSCOMMAND
    If param = %SC_KeyMenu And mousepos <> 0 Then
      ky = 32 - mousepos                                    'UpperCase(mousepos), when a letter mousepos is always lowercase
    End If
  Case %WM_SysKeyDown
    If param = %VK_MENU Then
      ks.value = mousepos
      ks.previous = 1 - ks.previous                         'Alt generates a WM_SYSCOMMAND, make the system change the state
      mousepos = ks.value
    End If
  Case %WM_LButtonDown
    Xmouse = Lo(Word,mousepos) : Ymouse = Hi(Word,mousepos)
    If     fieldx-2 < Xmouse And fieldy-3 < Ymouse And Ymouse < fieldy+18 Then
      ky = %mousecode
      newcursorPos = (Xmouse - fieldx+3) \ 8
    ElseIf Xmouse < 271 And Ymouse > ywindow-50 Then
      ky = %mousecode
      newcursorPos = -1
    End If
  End Select

  Function = CallWindowProc(GWoldC, Wnd, Msg, param, mousepos)
End Function

'============================ THE END =======================================

There might be more than one factorization per board.

Given a number and a board, if the number can be factored into two numbers whose bit lengths equal the dimensions (width and height) of the board, then the above algorithm will find it. But keep in mind there might be more than one factorization whose bit lengths fit the board and the first one found might not be the one you expected.

Consider decimal numbers instead of binary.  In decimal,  75  equals both  15 × 5  and  25 × 3.  Both factorizations consist of a two and one digit number.  Similarly there are binary numbers (that is, numbers when expressed in binary) that can be factored in more than one way even though you specify the bit lengths of the factors. For example (we write in reverse binary) the products of the 6 and 3 bit numbers
       110001 × 111
       100011 × 101
both equal  10101111.  Given that number, on a 6 by 3 board the algorithm finds the first factorization then, unless you skip to the next board, the second.

In general if there are several possible factorizations of a number whose bit lengths equal the dimensions of a given board, the algorithm finds them in the order of the first factor (the horizontal, longest one) as if its bits went from high to low instead of the reverse. For example, when the given number is 8085, which is 1010100111111 (13 bits) in reverse binary, on an 8 by 6 board there are four possible factorizations and they get discovered in this order:
       11100111 × 110001
       11001001 × 111011
       10101111 × 100001
       10100101 × 100011