<< Computer Algorithms Use  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 BASIC program below, 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
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 Main
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
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:
Return
'--------------------------
FailedEvenNumber:
p\$ = "That’s an even number."
Failed:
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 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

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 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
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
%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
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 × 101both 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