I am working through the practice problems in Forth Application Techniques (6th ed.) and something struck my curiosity. Page 51 has a problem asking me to define a word called avalanche that computes an avalanche numbers sequence. The rules:
If the number on the stack is odd, multiply it by 3 and add 1.
If the number on the stack is even, divide it by two.
If the number on the stack is one, stop.
My solution was
: even? ( n -- flag ) odd? 0= ;
: avalanche begin dup 1 <> while dup even? if 1 rshift dup . else 3 * 1 + dup . then repeat ;
So, it seems that avalanche number sequences rise and fall, but ultimately come back down and terminate on 1, in an avalanche-like effect. Observation shows that all sequences end up being supersets of other sequences at some point, with the exception of the base sequence [ 1 ]. If it is true that all sequences do settle on 1, then consequently all positive whole numbers are included in some sequence.
I got the idea to map some of the sequences out as a tree, with the sequences working inwards (from branch to root). A branch consists of a sequence of numbers being divided in half, and a branch merges into another branch where an odd number must be multiplied. Since we are dealing with infinitely long branches, I made some practical limitations of having the “trunk” limited to 12 nodes, the main branches limited to 6 nodes, the third set of branches limited to 3 nodes, and not exploring the branches any more deeply than those three levels. We start with the trunk being the sequence [ 5096, 2048 … 2, 1 ], a sequence familiar to computer programmers. This was the result:
The graph has a tantalizing hint of pattern, but not consistent pattern. You see the six nodes of one level-two branch do not have level-three branches. Also the node with value 5096 does not branch out, as you might intuitively suppose.
Again assuming that all sequences converge on 1, then all whole numbers are in some branch. Yet no branch (referring to a single straight line) shares a number with any other branch, except at the points of branching off.
I did a quick search on startpage.com for avalanche number sequences but was unable to find more information on this subject. If somebody has a good link, please share it in the comments.
Grecian Computer Puzzle (Product of Project Genius)
I got this puzzle a while ago as a present. It is a wooden puzzle made up of rotating discs of numbers. The goal is to line up the discs so that all the numbers add up to 42. What makes this especially complicated is that most of the discs have gaps in them, and therefore propagate numbers up from below depending on their position.
As an exercise, I wanted to see if I could write a memory-space efficient Forth program which would solve this puzzle.
In principle, this seemed like a simple idea, as I only need to represent the discs in memory and rotate them methodically, checking along the way for the solution. The trickiest part, however, was figuring out how to represent these discs in memory, while preserving their holes, and figuring out how to overlay them properly.
In the approach I took, there is one 48 byte memory space representing the board as a composite of the discs:
decimal
create board 48 allot
The first disc, the bottom one, is easy because it has no holes. This is represented by another 48 byte array.
For the other discs, I will also use byte arrays. However, I have to represent the holes some how. The most practical choice is to use the number zero, which is not used anywhere on the actual board, and conveniently maps to the boolean false value in Forth. So, I create disc1, disc2, and so on. You see that my number of rows shrinks with each disc.
Now, how to manipulate the board? The computationally simple and space-efficient approach is to simple rotate the bytes in place. So, here is my row rotation function, followed by one that rotates a whole disc. (Please forgive some of my inconsistent parameter descriptions…)
: rot-row ( addr -- )
dup 11 + c@ swap ( c a )
11 0 u+do
dup 10 + i - c@ swap ( c c a )
dup 11 + i - ( c c a a )
rot ( c a a c )
swap c! ( c a )
loop
c!
;
: rot-disc ( addr n )
0 u+do
dup 12 i * +
rot-row loop
drop
;
Having all the discs, and a way to rotate each of them, eventually I would need a procedure to stack them onto the board:
: overlay ( a a u -- )
12 * 0 u+do ( a1 a2 )
dup i + c@ ( a1 a2 c )
dup 0<> if
2 pick ( a1 a2 c a1 )
i + c! ( a1 a2 )
else drop
endif
loop
drop drop
;
: overlay-all
board disc0 4 overlay
board disc1 4 overlay
board 12 + disc2 3 overlay
board 24 + disc3 2 overlay
board 36 + disc4 1 overlay
;
We are pretty close now. I need a function to check for a solution, which is simple addition of the columns on the board:
: solved? ( -- bool )
true
12 0 u+do
board i + c@
board 12 i + + c@
board 24 i + + c@
board 36 i + + c@
+ + +
42 <> if drop false leave then
loop
;
Now, I’ve got to walk through rotating all the discs, checking for a solution in each case. I chose to do this with five nested procedures, which each handle their disc with the appropriate minor variations. (A nested loop would have worked also.)
: solve4 ( -- bool )
false
12 0 u+do
overlay-all
solved? if drop true leave else disc4 1 rot-disc then
loop
;
: solve3 ( -- bool )
false
12 0 u+do
solve4 if drop true leave else disc3 2 rot-disc then
loop
;
: solve2 ( -- bool )
false
12 0 u+do
solve3 if drop true leave else disc2 3 rot-disc then
loop
;
: solve1 ( -- bool )
false
12 0 u+do
solve2 if drop true leave else disc1 4 rot-disc then
loop
;
: solve ( -- bool )
false
12 0 u+do
solve1 if drop true leave else disc0 4 rot-disc then
loop
;
Now, I just need to run the solve procedure. It should return -1 (true) and then I can print the board with the command board 48 dump, which prints the board memory.
Unfortunately, I did this, and after a few seconds, the program instead return 0 (false) meaning there is no solution. Naturally, I expected there was some fault in my coding, and I dived into debugging. After an hour of carefully checking code, and inserting debugging code here and there, I was still getting the same result, and getting discouraged.
At one point, I inserted some code that would, at least, allow me to see the closest solution. I found one solution that had all columns adding up to 42, and one column adding up to 47. I did a quick Internet search, and found this revelation on the Project Genius website!
Notice from Project Genius Inc of a defective early Grecian Computer product.
Yes, indeed, I happened to own one of the defective early models, which had a misprint. I edited my disc0 array to read 3 instead of 8 in that location (already corrected above). The edited program found the solution quickly.
One must translate between hexidecimal to decimal, and then map the four arrays of twelve bytes onto the board, which gives you the solution (SPOILER WARNING!)
The Forth code above is provided under the GPLv3+ license:
Copyright 2020 Christopher Howard
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
I learned recently how to do implicit differentiation, which led me to the fun exercise of getting the slope of a point on a “figure-eight”, and showing the steps using WxMaxima. Here is a PDF print:
I have been fascinated lately with the concept of frequency spectrum and the idea that all periodic signals can be approximated by an infinite sum of sinusoidal functions. There are many introductory videos on this subject, usually titled as introductions to the Fourier transform.
I don’t actually use the YouTube Website directly because of the massive amounts of proprietary JavaScript involved, but instead use youtube-dl to download the video.)
He converts an off-on type of function to a fourier series. After the integration, we get this:
I translated that into some plots in Racket, to give the visual idea. Say we only add in a single sinusoid:
Then, another:
And a few more:
And a lot more:
And finally, hundreds of them:
It cannot quite perfectly represent the function, because the Fourier series adds an extra point in between the switch from off to on (and back), whereas the original just jumps from 0 to 1 (and back).
Here is the Racket code for those interested (I did not bother to optimize):
The second video covers two subjects: (1) mapping functions over vectors, and (2) using emacs to display algebraic formulas as math LaTeX (to paste into a WordPress post, for example). Please forgive the improper pronunciation of “LaTeX”, which I remembered afterwards.
The Libre Hacker 