While it is quite easy to compile your program with Meta, chances are you will want to organize your sources a little more than keeping all scripts in the same folder as your ./run script. Easiest method to support this is in my opinion by creating a shell script to take care of this task. Like on Linux:
#!/bin/bash
./run directory/of/your/program/yourprogram.meta
cp program.com directory/of/your/program/yourprogram
cd directory/of/your/program
./yourprogram
cd ../../../
Now when you save this as a .sh script, this will compile, copy your program, run it and return to the directory where your 'run' program is located. When your program is still in a phase where a compilation error is to be expected this approach will execute the previous compiled program.com, so to start, just use the first two lines of such a script.
It is pretty easy.
Meta [
Title: "Test create and write to a file"
file: ./filewrite.meta
]
FILENAME: "newfile"
folder-part: "./old"
specify-file: TO FILE! (join/with join/with join/with folder-part "/" FILENAME ".txt")
Either file-handle= try OPEN/NEW specify-file [
append file-handle "Yes! We did it!"
close file-handle
][
write/line "Not able to open or create file to write"
]
write/line "Will there be a new file? Quick! Take a look!"
Not in the web console, just compile and test. When you do want to re-use the file handle name ('file-handle') be sure to not use the 'file-handle=' notation but in such a case use 'file-handle: '.
To create your own split functionality you can follow this example code.
Sentence: "Hello you good folks that are supporters of the Meta language"
text-left: sentence
while text-left [
text-left: find/tail sentence " " ; space
forward: (count sentence ) - (count text-left)
word: copy cut sentence forward
write/line word
sentence: skip sentence forward
]
Above code has a flaw, hope you have noticed. So if you do not want the spaces after each word change to this.
Sentence: "Hello you good folks that are supporters of the Meta language"
text-left: sentence
while text-left [
text-left: find sentence " " ; space
forward: (count sentence ) - (count text-left)
word: copy cut sentence forward
write/line word
sentence: skip sentence forward + 1
]
So leaving the /tail and adding + 1 in the last line.
Another flaw with this, is you should right trim your sentence at the beginning and left trim each time at the start of the while loop. By the way if you also want to separate on tabs too, the TAB is also available in Meta.
Meta []
string: "hello "
trimmed?: false
until (
length: count string
either any [" " = skip string length - 1
TAB = skip string length - 1] [
string: copy cut string (length - 1)
][
trimmed?: true
]
trimmed?
)[]
write "Trimmed string is:" write string write/line "<-- ends here now."
One problem with this TRIM happened when I imported a file made on a Windows system. This file contains line endings that are CRLF type and not LF as on Linux/Unix systems. The presumed empty strings were not empty anymore but contained 1 character. With the new FIRST-OF function I found out that the remaining character had number 13, it was a CR.
I had to transform my CRLF encoded file to a LF encoded one.
sed -i 's/\r//' fileWindows.txt
helped out.
string: "Hello World!"
lower-characters: "abcdefghijklmnopqrstuvwxyz"
upper-characters: "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
upper-string: ""
lower-string: ""
length: count string
for index [1 length][
lowchar: upchar: copy cut at string index 1
either found: find lower-characters lowchar [
upchar: copy cut at upper-characters (27 - (count found)) 1
][
if found: find upper-characters upchar [
lowchar: copy cut at lower-characters (27 - (count found)) 1
]
]
upper-string: join/with upper-string upchar
lower-string: join/with lower-string lowchar
]
write "Lowercase: " write/line lower-string
write "Uppercase: " write/line upper-string
And the result is:
Lowercase: hello world!
Uppercase: HELLO WORLD!
This example converts a number to a binary string
number: 29
binary-string: ""
for index 32 [
either is-odd number [
binary-string: join/with "1" binary-string
][
binary-string: join/with "0" binary-string
]
number: number >> 1 ; this or
;number: number / 2
]
write/line binary-string
Combining this with displaying parts of the number and seeing how our endianness works on our computer.
startnumber: 149
write/line startnumber
for index 32 [
write "index is: " write/line index
string: first-of startnumber
write "First of: "write/line string
string: second-of startnumber
write "Second of: "write/line string
string: third-of startnumber
write "Third of: "write/line string
string: fourth-of startnumber
write "Fourth of: "write/line string
number: startnumber
write "number is: " write/line number
binary-string: ""
for index2 32 [
either is-odd number [
binary-string: join/with "1" binary-string
][
binary-string: join/with "0" binary-string
]
number: number / 2
]
write/line binary-string
startnumber: startnumber << 1
]
You might notice some strange behaviour. Of course this is due to the signed character of the numbers.
This example converts a binary string to a value, but also checks for wrong input.
bitstring: "01010xA1A0o911"
value: 0
count-zeroes: 0
count-ones: 0
is-binary: true
non-binaries: ""
length: count bitstring
if length > 64 [
write "Your string is " write length
write/line "characters long. Maximum input length is 64."
bye
]
repeat length [
bit: copy cut bitstring 1
any [ if bit = "0" [ increment count-zeroes ]
if bit = "1" [ increment count-ones ]
is-binary: false
if not find non-binaries bit [
non-binaries: join/with non-binaries bit
]
]
if is-binary [
value: value * 2 + to whole! bit
]
advance bitstring
]
write "Your string is " write length write " long and contains " write count-zeroes
write " and " write count-ones write/line " ones."
either is-binary [
write "The value is: " write/line value
][
write/line "but the string was not a binary string!"
write "Value count not be computed because your string also contained these characters: "
write/line non-binaries
]
This example converts a number to a couple of positions in a binary array
let [component] binary! 80000
natural16! index
for index 512 [
poke component (index * 2 - 1) first-of index
poke component (index * 2) second-of index
]
lijst: ""
for index [252 262][
eerste: pick component (index * 2 - 1)
tweede: pick component (index * 2)
getal: tweede * 256 + eerste
lijst: join/with join/with lijst to string! getal " "
]
write/line lijst
For larger number types use more byte!s.
Meta is also capable of computing numbers using math functions. For more info on that, head over to the Dictionary.
;;;;;;;;;;;;;;;;;
;; power
;;;;;;;;;;;;;;;;;
base: 10.0
highest-exponent: 16
for exponent highest-exponent [
write/line base ^ exponent
]
Which results in:
10
100
1000
10000
100000
1000000
10000000
100000000
1000000000
10000000000
100000000000
1000000000000
10000000000000
100000000000000
1000000000000000
10000000000000000
And
base: 2
highest-exponent: 64
for exponent highest-exponent [
write "2 ^ " write exponent write " = " write/line base ^ exponent
]
Results in:
2 ^ 1 = 2
2 ^ 2 = 4
2 ^ 3 = 8
2 ^ 4 = 16
2 ^ 5 = 32
2 ^ 6 = 64
2 ^ 7 = 128
2 ^ 8 = 256
2 ^ 9 = 512
2 ^ 10 = 1024
2 ^ 11 = 2048
2 ^ 12 = 4096
2 ^ 13 = 8192
2 ^ 14 = 16384
2 ^ 15 = 32768
2 ^ 16 = 65536
2 ^ 17 = 131072
2 ^ 18 = 262144
2 ^ 19 = 524288
2 ^ 20 = 1048576
2 ^ 21 = 2097152
2 ^ 22 = 4194304
2 ^ 23 = 8388608
2 ^ 24 = 16777216
2 ^ 25 = 33554432
2 ^ 26 = 67108864
2 ^ 27 = 134217728
2 ^ 28 = 268435456
2 ^ 29 = 536870912
2 ^ 30 = 1073741824
2 ^ 31 = 2147483648
2 ^ 32 = 4294967296
2 ^ 33 = 8589934592
2 ^ 34 = 17179869184
2 ^ 35 = 34359738368
2 ^ 36 = 68719476736
2 ^ 37 = 137438953472
2 ^ 38 = 274877906944
2 ^ 39 = 549755813888
2 ^ 40 = 1099511627776
2 ^ 41 = 2199023255552
2 ^ 42 = 4398046511104
2 ^ 43 = 8796093022208
2 ^ 44 = 17592186044416
2 ^ 45 = 35184372088832
2 ^ 46 = 70368744177664
2 ^ 47 = 140737488355328
2 ^ 48 = 281474976710656
2 ^ 49 = 562949953421312
2 ^ 50 = 1125899906842624
2 ^ 51 = 2251799813685248
2 ^ 52 = 4503599627370496
2 ^ 53 = 9007199254740992
2 ^ 54 = 18014398509481984
2 ^ 55 = 36028797018963968
2 ^ 56 = 72057594037927936
2 ^ 57 = 144115188075855872
2 ^ 58 = 288230376151711744
2 ^ 59 = 576460752303423488
2 ^ 60 = 1.15292150460684698e+18
2 ^ 61 = 2.30584300921369395e+18
2 ^ 62 = 4.6116860184273879e+18
2 ^ 63 = 9.22337203685477581e+18
2 ^ 64 = 1.84467440737095516e+19
Note that as humans, count is starting at 1, not 0.
base: 2
highest-exponent: 4
for exponent [0 highest-exponent] [
write "2 ^ " write exponent write " = " write/line base ^ exponent
]
This makes the count from the start value.
2 ^ 0 = 1
2 ^ 1 = 2
2 ^ 2 = 4
2 ^ 3 = 8
2 ^ 4 = 16
When you first use random with Meta, you might experience some unwanted behaviour.
You have to know that random will generate a random value of the type you mention.
random 100
Will generate a random variable of type byte, because 100 can be fit inside the BYTE! type, so the result will have a value between 0 and 255.
To be able to use random as you might expect, you will have to make some modifications yourself.
I get the maximum value of a multiple under 255 and then calculate that value modulo the wanted maximum. See how this works in this practical example for a WHOLE! value between 1 and 100:
random/seed now
random-byte: random 255
while random-byte > 199 [
random-byte: random 255
]
random-100: 1 + modulo random-byte 100
write/line random-100
To help a bit with checking if it really works you can try:
random/seed now
repeat 100 [
random-byte: random 255
while random-byte > 199 [
random-byte: random 255
]
random-100: 1 + modulo random-byte 100
write/line random-100
]
Random can also be used with a slightly larger type
random/seed now
max: 0
min: 100000
for i 400 [
write/line number: random 1000
if number > max [max: number]
if number < min [min: number]
]
write "minimum was: " write/line min
write "maximum was: " write/line max
An example outcome of this script is (without all the individual lines)
minimum was: 110
maximum was: 65494
Now let's reorder a couple of items in a random order
random/seed now
Let [items] binary! 255
; change/repeat items 0 255
for index [1 (count items)] [
poke items index index
]
number-of-items= 82
for i [number-of-items 2] [
r: random 255
p: 256 / i
;write "i = " write i write ", r = " write r write ", p = " write/line p
while r > (p * i) [
r: random 255
]
j: 1 + modulo r i
swap-value: pick items i
poke items i pick items j
poke items j swap-value
]
for i number-of-items [
write/line pick items i
]
write/line "Ready"
Now previous example uses a count down, but I need a constant value to use this unfortunately. To overcome this issue while Meta fixes this the next variant will serve fine for our purpose.
random/seed now
Let [items] binary! 255
; change/repeat items 0 255
for index [1 (count items)] [
poke items index index
]
number-of-items: 82
for i number-of-items - 1 [
s: number-of-items + 1 - i
r: random 255
p: 256 / s
write "i = " write i write ", s = " write s write ", r = " write r write ", p = " write/line p
while r > (p * s) [
r: random 255
]
j: 1 + modulo r s
swap-value: pick items s
poke items s pick items j
poke items j swap-value
]
for i number-of-items [
write/line pick items i
]
write/line "Ready"
Simple as that.
The example is for computing prime factors of a number.
It is taken from a Rebol example by Sunanda on rebol.org
n: 5251
m: 2
s: 1
a: ""
write/line "start"
until (
either 0 = modulo n m [
n: to whole! n / m
write "found factor: "
write/line m
][
m: m + s
s: 2
]
if n < (m * m ) [
write "found factor: "
write/line n
n: 1
]
n = 1
) []
write/line "end"
As 'always' it also works in the web console. And the result is:
start
found factor: 59
found factor: 89
end
What? Doing recursive programming in a programming language that does not provide user defined functions? (Methods)
Impossible right? Wrong!
When you know how to run another program with Meta this can replace a function call. Unfortunately the return value that any C program returns is of little use. This value is just a simple byte that could be a helpful thing in signaling troubles encountered when running the program. Not much more.
So to hand over real useful data, one must write that to a file that can be read in turn by the caller.
This is how I managed to pull this off for a simple task.
Meta [Title: "Recursively compute the sum of the numbers from n downto 1"
file: ./sum1n.meta
]
buffer-file= ./buffersum1n.dat
Either argument= first-of system/program/ins [
; write "Argument passed: "
; write/line argument
][
write/line "No argument passed"
bye
]
value: to whole! argument
if value <= 1 [
either buffer: try open/new buffer-file [
append buffer 1
close buffer
bye/return 0
][
write/line "unable to open buffer file"
bye
]
]
command: join/with "./sum1n " to string! (value - 1)
write/line command
run command
either buffer: try open buffer-file [
sum: to whole! take/line buffer
close buffer
][
write/line "unable to open buffer file"
bye
]
either buffer: try open/new buffer-file [
append buffer (sum + value)
close buffer
][
write/line "unable to open buffer file"
bye
]
bye/return 0
Now show your version for factorial ;-)
This is a simple script that will show you what year is a leap year. You can cut and paste this into the web-console
for counter [1990 2025][
year: counter
leap: any[
all[
0 = modulo Year 4
0 != modulo Year 100
]
0 = modulo Year 400
]
write "Year " write year write " is "
write either leap ["a "]["not a "]
write/line "leapyear"
]
And the result will be
Year 1990 is not a leapyear
Year 1991 is not a leapyear
Year 1992 is a leapyear
Year 1993 is not a leapyear
Year 1994 is not a leapyear
Year 1995 is not a leapyear
Year 1996 is a leapyear
Year 1997 is not a leapyear
Year 1998 is not a leapyear
Year 1999 is not a leapyear
Year 2000 is a leapyear
Year 2001 is not a leapyear
Year 2002 is not a leapyear
Year 2003 is not a leapyear
Year 2004 is a leapyear
Year 2005 is not a leapyear
Year 2006 is not a leapyear
Year 2007 is not a leapyear
Year 2008 is a leapyear
Year 2009 is not a leapyear
Year 2010 is not a leapyear
Year 2011 is not a leapyear
Year 2012 is a leapyear
Year 2013 is not a leapyear
Year 2014 is not a leapyear
Year 2015 is not a leapyear
Year 2016 is a leapyear
Year 2017 is not a leapyear
Year 2018 is not a leapyear
Year 2019 is not a leapyear
Year 2020 is a leapyear
Year 2021 is not a leapyear
Year 2022 is not a leapyear
Year 2023 is not a leapyear
Year 2024 is a leapyear
Year 2025 is not a leapyear
This is a simple script that asks for your name to input. You can cut and paste this into the web-console
;;;;;;;
; ask ;
;;;;;;;
answer: ask/line "Hi what is your name?"
write/line ""
write "Welcome to Meta " write answer write/line "!!"
You will see a pop-up window where you fill out your name, next you will be prompted with yet another pop-up window asking for input. This time you choose 'Cancel' and the script will continue its task of welcoming you.
Hi what is your name?
Welcome to Meta Arnold!!
This is a simple script that plays a little game of nim with you. You can cut and paste this into the web-console
tokens: 12
write/line "Welcome to the Game of Nim."
write "We begin with " write tokens
write/line " tokens. On each turn, a player"
write/line "may take between 1 and 3 tokens. The player who takes the"
write/line "last token wins."
write/line ""
while tokens > 0 [
write "Available tokens: " write/line tokens;
; provide a visual display
for index [1 tokens][
write "⛀ ";
]
write new-line
answer: ask/line "How many tokens do you want to take (1, 2 or 3)?"
write/line ""
removed: to whole! answer
write "You have taken " write removed write/line " token(s)"
tokens: tokens - removed
computertakes: modulo tokens 4
write "Computer takes " write computertakes write/line " token(s)"
tokens: tokens - computertakes
]
wait 1
write/line "No more tokens left! I took the last one! I won!"
wait 1
write/line "Thank you for playing! Let's play again!"
You will see a pop-up window where you fill out a number from 1 up to 4 the number of tokens you want to take from the stack, next you will be prompted with yet another pop-up window asking for input. This time you choose 'Cancel' and the script will continue its task and also take its share of tokens.
This is a simple script that converts a number into its Roman numeral equivalent
roman-numeral: ""
natural: 2024
;write/line natural
while natural > 0 [
any [if natural >= 1000 [roman-numeral: join/with roman-numeral "M" natural: natural - 1000]
if natural >= 900 [roman-numeral: join/with roman-numeral "CM" natural: natural - 900 ]
if natural >= 500 [roman-numeral: join/with roman-numeral "D" natural: natural - 500 ]
if natural >= 400 [roman-numeral: join/with roman-numeral "CD" natural: natural - 400 ]
if natural >= 100 [roman-numeral: join/with roman-numeral "C" natural: natural - 100 ]
if natural >= 90 [roman-numeral: join/with roman-numeral "XC" natural: natural - 90 ]
if natural >= 50 [roman-numeral: join/with roman-numeral "L" natural: natural - 50 ]
if natural >= 40 [roman-numeral: join/with roman-numeral "XL" natural: natural - 40 ]
if natural >= 10 [roman-numeral: join/with roman-numeral "X" natural: natural - 10 ]
if natural >= 9 [roman-numeral: join/with roman-numeral "IX" natural: natural - 9 ]
if natural >= 5 [roman-numeral: join/with roman-numeral "V" natural: natural - 5 ]
if natural >= 4 [roman-numeral: join/with roman-numeral "IV" natural: natural - 4 ]
if natural >= 1 [roman-numeral: join/with roman-numeral "I" natural: natural - 1 ]
]
;write/line natural
]
write/line roman-numeral
You can add a dialog yourself using another example on this page.
This is an example to approximate the value of tau, the better half, no double, of its 'cousin' pi.
Meta []
LIMIT= 10000
TAU= 6.283185307179586476925286766559
write/line "Determine an approximation of Tau = "
write/line "6.283185307179586476925286766559"
a: 0
b: 1
c: 1
d: 1
number: tau / 10
while all[b < limit d < LIMIT] [
t: a + c
n: b + d
fraction: (to floater! t) / n
either fraction > number [
c: t
d: n
][
a: t
b: n
]
]
either b > limit [
write "c/d: " write 10 * c write " / " write/line d
][
write "a/b: " write 10 * a write " / " write/line b
]
For sure this again works inside the web console, you will see this result:
Determine an approximation of Tau =
6.283185307179586476925286766559
c/d: 710 / 113
This next example draws a simple checker board. You can cut and paste this in the web console to test.
; White draughts man ⛀ U+26C0 ⛀
; king ⛁ U+26C1 ⛁
; Black man ⛂ U+26C2 ⛂
; king ⛃ U+26C3 ⛃
; Empty box (Ballot box) ☐ ☐
; White square code 2000 □
; Black square code 2000 ■
; ▨ (SQUARE WITH UPPER RIGHT TO LOWER LEFT FILL) ▨ U+25A8
;;;;;;;;;;;;;;;;;;;;;;;
; Array using binary! ;
;;;;;;;;;;;;;;;;;;;;;;;
BOARD-SIZE= 50
Let [board] binary! BOARD-SIZE
For index [1 BOARD-SIZE][
poke board index 0
]
for index [1 20][
poke board index 3
poke board (index + 30) 2
]
poke board 3 5
poke board 48 4
;for index 50 [ write pick board index]
;write/line ""
; print the board
write/line "[ "
for row [1 10][
write either is-odd row [" "][""]
for line [1 5][
field: pick board (row - 1 * 5 + line)
either 0 = field [
write "▨"
][
either 2 = field [
write "⛀"
][
either 3 = field [
write "⛂"
][
either 4 = field [
write "⛁"
][
write "⛃"
]
]
]
]
write " "
]
write/line ""
]
write/line "]"
And this is the result
[
⛂ ⛂ ⛃ ⛂ ⛂
⛂ ⛂ ⛂ ⛂ ⛂
⛂ ⛂ ⛂ ⛂ ⛂
⛂ ⛂ ⛂ ⛂ ⛂
▨ ▨ ▨ ▨ ▨
▨ ▨ ▨ ▨ ▨
⛀ ⛀ ⛀ ⛀ ⛀
⛀ ⛀ ⛀ ⛀ ⛀
⛀ ⛀ ⛀ ⛀ ⛀
⛀ ⛀ ⛁ ⛀ ⛀
]
The problem is there are 100 lights all off, or 100 doors all closed. I chose to go along with the lightswitching like the source below. The problem is the same, sometimes also mentioned as the Locker Problem.
At the moment they're all off. The first person comes along and turns them all on. The second person turns every second light switch off. The third person deals with every third light switch - in that they don't just turn them on or off, if they're on they'll turn them off and if they're off they'll turn them on. And the fourth person deals with every fourth light switch, the fifth person deals with every fifth light switch
And that continues for 100 people. That's the setup, the question is: what happens at the end? Which lights or switches are on when 100 people have done this thing?
The problem came to my attention again by this video by Numberphile
Meta []
Let [lights] binary! 100
change/repeat lights 0 100
for index 100 [
; switch the lights
switch: index
while switch < 101 [
either 0 = pick lights switch [
poke lights switch 1
][
poke lights switch 0
]
switch: switch + index
]
increment index
]
for i 10 [
for j 10 [
index: i - 1 * 10 + j
write either index < 10 [" "][" "] write index write " "
write either 1 = pick lights index ["=ON="][" "]
]
write/line ""
]
Solving the 8 queens problem in Meta is a nice challenge. Mainly because Meta does not have the ability to use function calls, or methods as Meta will call them.
This program thus needs to use a state machine approach to handle the recursive aspect of the algorithm commonly used.
The program solves the number of solutions for numbers up to 15. Because the algorithm is build smart, testing possible places for placing queens on the board first, instead of placing first and than testing, it is rather fast in solving.
Here it is, hold on to your seats..
Meta [
Title: "N-queens solution in Meta"
file: ./nqueens.meta
]
Either argument= first-of system/program/ins [
;write/line argument
rows: to whole! argument
][
rows: 4
write "No argument passed, default value " write rows
write/line " used"
]
Either argument2= second-of system/program/ins [
;write/line argument2
count-only?: not to logic! argument2
][
write/line "No second argument passed, not printing (no/false) is default"
count-only?: True
]
; Do some basic timekeeping
write/line now
MAX-ROWS= 15
If any [rows < 1 rows > MAX-ROWS][
write "Number of rows out of bounds, minimal 1, maximal " write/line MAX-ROWS
bye
]
; Definition of progress the source of the values for the solution
Let [progress] binary! MAX-ROWS
change/repeat progress 0 MAX-ROWS
; available room for recursive function data max 15rows x 15steps
Let [available] binary! 225
change/repeat available 1 225
solution-count: to whole! 0
rows-odd?: is-odd rows
interest: rows * rows
half: either is-odd rows [(rows + 1) / 2][rows / 2]
symmetry-to: either is-odd rows [half - 1][half]
ROW-STATE-NEW= 1
ROW-STATE-PROCESSING= 2
either rows > 1 [
; Place the first queen on the board from the first to the row in the middle.
; We only have to do half the work because of symmetry.
for set-queen half [
poke progress rows set-queen
Ready?: False
state: ROW-STATE-NEW
current-row: rows - 1
; Here is the "recursive procedure call" to the add-queen 'method'
while not ready? [
; determine allowed places to put a queen on this row
if state = ROW-STATE-NEW [
diagonal-reach: 1
for index [current-row + 1 rows][
covered: pick progress index
poke available rows * (current-row - 1) + covered 0
if covered + diagonal-reach <= rows [
poke available rows * (current-row - 1) + covered + diagonal-reach 0
]
if covered - diagonal-reach > 0 [
poke available rows * (current-row - 1) + covered - diagonal-reach 0
]
increment diagonal-reach
]
state: ROW-STATE-PROCESSING
]
if state = ROW-STATE-PROCESSING [
; Check for empty
open-locations: 0
tel: 1
while all [0 = open-locations
tel <= rows ][
open-locations: open-locations +
pick available (rows * (current-row - 1) + tel)
increment tel
]
either 0 != open-locations [
either current-row = 1 [
; Check for your solutions
for index rows [
if 1 = pick available (rows * (current-row - 1) + index) [
; Count this one in
solution-count: solution-count + 1
if symmetry-to >= pick progress rows [
; Count this symmetric one too
solution-count: solution-count + 1
]
; We did not print yet(!)
]
]
; When counting has been done we need to go up a level again
poke progress current-row 0
change/repeat skip available rows * (current-row - 1) 1 rows
increment current-row
][
; get next free place and go into the function again
this-row-progress: pick progress current-row
increment this-row-progress
while all [rows >= this-row-progress
0 = pick available (rows * (current-row - 1) + this-row-progress)
][
increment this-row-progress
]
either this-row-progress > rows [
poke progress current-row 0
change/repeat skip available rows * (current-row - 1) 1 rows
increment current-row
][
poke progress current-row this-row-progress
decrement current-row
state: ROW-STATE-NEW
]
]
][
poke progress current-row 0
change/repeat skip available rows * (current-row - 1) 1 rows
increment current-row
]
]
if current-row = rows [Ready?: yes]
]
; Now clear the progress, this is okay because we are in the outermost loop here
change/repeat progress 0 rows
change/repeat available 1 rows * rows
]
][
increment solution-count
if not count-only? [
write/line "Q "
]
]
Write "Total number of solutions for n = " write rows write " is "
write/line solution-count
; Finished at
write/line now
Bye
How does it perform on your machine? Is it comparable with other solutions you may know?
If you would like, printing the results could be done. I would not recommend building the print into a version that you want to speedtest or using a print (even on console) for a board larger than 8 by 8.
But it can be done using
; print the board, the symmetric solutions are not yet printed(!)
board: ""
for-each value progress [
if value != 0 [
repeat value - 1 [
board: join/with board ". "
]
board: join/with board "Q "
repeat rows - value [
board: join/with board ". "
]
board: join/with board new-line
]
]
write/line board
Or printing could be done as well like
symmetric?: yes
for p 2 [
if any [p = 1
all [p = 2
symmetric?]
][
for index [rows 1][
position: pick progress index
either p = 2 [
position: rows - position
][
rest: rows - position
position: position - 1
]
rest: rows - position
repeat position [write ". "]
write "Q "
repeat rest [write ". "]
write new-line
]
]
]
Hope you can appreciate algorithms like these. I solved the problem before using REN-C in my blog
When first Meta got introduced to the Atari age community Kaj de Vos posted a Fibonacci algorithm at Atari Age
; Maximum 24 for natural16! result
; Max 47 for natural32! result
; parameter= 24
parameter= 47
write "Fibonacci " write parameter write ": "
let Fibonacci natural32! 0
let previous natural32! 0
either parameter <= 1 [
Fibonacci: parameter ; Fibonacci 0 ... 1
][
Fibonacci: previous: 1 ; Fibonacci 2
repeat parameter - 2 [
previous: also Fibonacci
Fibonacci: Fibonacci + previous
]
]
write/line Fibonacci
In this code is a curious method present: ALSO A B in this situation would mean:
let safe natural! a
b
safe
On larger machines, NATURAL! and WHOLE! are larger and the same code can compute even larger Fibonacci values. To compute larger Fibonacci values on Atari 8-bit, the variables FIBONACCI and PREVIOUS can be explicitly declared as NATURAL32! type, which is 32 bits unsigned.
So here is 'also' my take on this, it takes a bit more of a traditional approach but.. Meta now has the ability to use 64 bit unsigned WHOLE! numbers, they are available through the type of NATURAL64!. An example here
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fibonacci numbers up to 93-rd
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
let number-next natural64! 0
let number-1 natural64! 1
let number-2 natural64! 1
write "Fibonacci number 0 = " write/line number-next
write "Fibonacci number 1 = " write/line number-1
write "Fibonacci number 2 = " write/line number-2
for index [3 100][
number-next: number-1 + number-2
number-1: number-2
number-2: number-next
write "Fibonacci number "
any [if index < 10 [write " "]
if index < 100 [write " " ]
] write index
write " = " write/line number-next
]
Note that number 93 is the last Fibonacci number that fits inside the 64 bit unsigned type. So the later results that are incorrect are due to this.
Fibonacci number 0 = 0
Fibonacci number 1 = 1
Fibonacci number 2 = 1
Fibonacci number 3 = 2
Fibonacci number 4 = 3
Fibonacci number 5 = 5
Fibonacci number 6 = 8
Fibonacci number 7 = 13
Fibonacci number 8 = 21
Fibonacci number 9 = 34
Fibonacci number 10 = 55
Fibonacci number 11 = 89
Fibonacci number 12 = 144
Fibonacci number 13 = 233
Fibonacci number 14 = 377
Fibonacci number 15 = 610
Fibonacci number 16 = 987
Fibonacci number 17 = 1597
Fibonacci number 18 = 2584
Fibonacci number 19 = 4181
Fibonacci number 20 = 6765
Fibonacci number 21 = 10946
Fibonacci number 22 = 17711
Fibonacci number 23 = 28657
Fibonacci number 24 = 46368
Fibonacci number 25 = 75025
Fibonacci number 26 = 121393
Fibonacci number 27 = 196418
Fibonacci number 28 = 317811
Fibonacci number 29 = 514229
Fibonacci number 30 = 832040
Fibonacci number 31 = 1346269
Fibonacci number 32 = 2178309
Fibonacci number 33 = 3524578
Fibonacci number 34 = 5702887
Fibonacci number 35 = 9227465
Fibonacci number 36 = 14930352
Fibonacci number 37 = 24157817
Fibonacci number 38 = 39088169
Fibonacci number 39 = 63245986
Fibonacci number 40 = 102334155
Fibonacci number 41 = 165580141
Fibonacci number 42 = 267914296
Fibonacci number 43 = 433494437
Fibonacci number 44 = 701408733
Fibonacci number 45 = 1134903170
Fibonacci number 46 = 1836311903
Fibonacci number 47 = 2971215073
Fibonacci number 48 = 4807526976
Fibonacci number 49 = 7778742049
Fibonacci number 50 = 12586269025
Fibonacci number 51 = 20365011074
Fibonacci number 52 = 32951280099
Fibonacci number 53 = 53316291173
Fibonacci number 54 = 86267571272
Fibonacci number 55 = 139583862445
Fibonacci number 56 = 225851433717
Fibonacci number 57 = 365435296162
Fibonacci number 58 = 591286729879
Fibonacci number 59 = 956722026041
Fibonacci number 60 = 1548008755920
Fibonacci number 61 = 2504730781961
Fibonacci number 62 = 4052739537881
Fibonacci number 63 = 6557470319842
Fibonacci number 64 = 10610209857723
Fibonacci number 65 = 17167680177565
Fibonacci number 66 = 27777890035288
Fibonacci number 67 = 44945570212853
Fibonacci number 68 = 72723460248141
Fibonacci number 69 = 117669030460994
Fibonacci number 70 = 190392490709135
Fibonacci number 71 = 308061521170129
Fibonacci number 72 = 498454011879264
Fibonacci number 73 = 806515533049393
Fibonacci number 74 = 1304969544928657
Fibonacci number 75 = 2111485077978050
Fibonacci number 76 = 3416454622906707
Fibonacci number 77 = 5527939700884757
Fibonacci number 78 = 8944394323791464
Fibonacci number 79 = 14472334024676221
Fibonacci number 80 = 23416728348467685
Fibonacci number 81 = 37889062373143906
Fibonacci number 82 = 61305790721611591
Fibonacci number 83 = 99194853094755497
Fibonacci number 84 = 160500643816367088
Fibonacci number 85 = 259695496911122585
Fibonacci number 86 = 420196140727489673
Fibonacci number 87 = 679891637638612258
Fibonacci number 88 = 1100087778366101931
Fibonacci number 89 = 1779979416004714189
Fibonacci number 90 = 2880067194370816120
Fibonacci number 91 = 4660046610375530309
Fibonacci number 92 = 7540113804746346429
Fibonacci number 93 = 12200160415121876738
Fibonacci number 94 = 1293530146158671551
Fibonacci number 95 = 13493690561280548289
Fibonacci number 96 = 14787220707439219840
Fibonacci number 97 = 9834167195010216513
Fibonacci number 98 = 6174643828739884737
Fibonacci number 99 = 16008811023750101250
Fibonacci number 100 = 3736710778780434371
Just to check these values past the 93rd number
1 1111 1
12200160415121876738
7540113804746346429+
--------------------
19740274219868223167
Subtracting the maximum 64 bit unsigned value
19740274219868223167 < - what it should be
18446744073709551616- minus the maximum value of 64 bit
--------------------
1293530146158671551 answer this program produces
So this also checks out.
We now go and ask for BIGNUM implementation for Meta ;-)