Craft Basic on Rosetta Code
Posted: Wed Feb 22, 2023 10:54 am
Computer Science Discussion
https://www.lucidapogee.com/forum/
Code: Select all
'roots of unity example
define theta = 0, real = 0, imag = 0
define pi = 3.14, n = 5
for m = 0 to n - 1
let theta = m * (pi * 2) / n
let real = cos(theta)
let imag = sin(theta)
if imag >= 0 then
print real, comma, " ", imag, "i"
else
print real, comma, " ", imag * -1, "i"
endif
wait
next m
end
Code: Select all
'department numbers example
print "P S F"
for p = 2 to 7 step 2
for s = 1 to 7
if s <> p then
let f = (12 - p) - s
if f > 0 and f <= 7 and f <> s and f <> p then
print p, " ", s, " ", f
endif
endif
next s
next p
end
Code: Select all
'permutations example
let n = 3
let i = n + 1
dim a[i]
for i = 1 to n
let a[i] = i
next i
do
for i = 1 to n
print a[i]
next i
print
let i = n
do
let i = i - 1
let b = i + 1
loopuntil (i = 0) or (a[i] < a[b])
let j = i + 1
let k = n
do
if j < k then
let t = a[j]
let a[j] = a[k]
let a[k] = t
let j = j + 1
let k = k - 1
endif
loop j < k
if i > 0 then
let j = i + 1
do
if a[j] < a[i] then
let j = j + 1
endif
loop a[j] < a[i]
let t = a[j]
let a[j] = a[i]
let a[i] = t
endif
loopuntil i = 0
end
Code: Select all
'sum of digits example
define number = 0, base = 0, sum = 0
input "number: ", number
input "base: ", base
if number < 0 then
let number = number * -1
endif
if base < 2 then
let base = 2
endif
do
if number > 0 then
let sum = sum + number % base
let number = int(number / base)
endif
loop number > 0
print "sum of digits in base ", base, ": ", sum
end
Code: Select all
'iterated digits squaring example
for i = 1 to 1000
let j = i
do
let k = 0
do
let k = int(k + (j % 10) ^ 2)
let j = int(j / 10)
wait
loop j <> 0
let j = k
loopuntil j = 89 or j = 1
if j > 1 then
let n = n + 1
endif
print "iterations: ", i
next i
print "count result: ", n
end
Code: Select all
'munching squares example
let s = 255
for y = 0 to s
for x = 0 to s
let r = x ~ y
fgcolor r, r * 2, r * 3
dot x, y
wait
next x
next y
end
Code: Select all
'harshard numbers example
for i = 1 to 1002
let t = i
let s = 0
do
let s = s + t % 10
let t = int(t / 10)
wait
loop t > 0
if i % s = 0 and (c < 20 or i > 1000) then
let c = c + 1
print c, " : ", i
endif
next i
end
Code: Select all
'munchausen numbers example
for i = 0 to 5
for j = 0 to 5
for k = 0 to 5
for l = 0 to 5
let s = i
gosub sign
let m = int(i ^ i * s)
let s = j
gosub sign
let m = m + int(j ^ j * s)
let s = k
gosub sign
let m = m + int(k ^ k * s)
let s = l
gosub sign
let m = m + int(l ^ l * s)
let n = 1000 * i + 100 * j + 10 * k + l
if m = n and m > 0 then
print m
endif
wait
next l
next k
next j
next i
end
sub sign
if s <> 0 then
if s < 0 then
let s = -1
else
let s = 1
endif
endif
return
Code: Select all
'dot product example
dim a[1, 3, -5]
dim b[4, -2, -1]
arraysize n, a
for i = 0 to n - 1
let s = s + a[i] * b[i]
next i
print s
end
Code: Select all
'van eck sequence example
define limit = 1000
dim list[limit]
print "calculating van eck sequence..."
for n = 0 to limit - 1
for m = n - 1 to 0 step -1
if list[m] = list[n] then
let c = n + 1
let list[c] = n - m
break m
endif
wait
next m
next n
print "first 10 terms: "
for i = 0 to 9
print list[i]
next i
print "terms 991 to 1000: "
for i = 990 to 999
print list[i]
next i
end
Code: Select all
'narcissistic decimal numbers example
dim p[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
let l = 10
let n = 25
do
if c < n then
if x >= l then
for i = 0 to 9
let p[i] = p[i] * i
next i
let l = l * 10
endif
let s = 0
let y = x
do
if y > 0 then
let t = y % 10
let s = s + p[t]
let y = int(y / 10)
endif
wait
loop y > 0
if s = x then
print x
let c = c + 1
endif
let x = x + 1
endif
loop c < n
end
Code: Select all
'casting out nines example
precision 4
define base = 10, c1 = 0, c2 = 0
for k = 1 to (base ^ 2) - 1
let c1 = c1 + 1
if k % (base - 1) = (k * k) % (base - 1) then
let c2 = c2 + 1
print k
endif
next k
print "trying ", c2, " numbers instead of ", c1, " numbers saves ", 100 - (100 * c2 / c1), "%"
end
Code: Select all
'factors of an integer example
do
input "enter an integer", n
loop n = 0
let a = abs(n)
for i = 1 to int(a / 2)
if a = int(a / i) * i then
print i
endif
next i
print a
end
Code: Select all
'primality by wilson's theorem example
for i = 2 to 100
let f = 1
for j = 2 to i - 1
let f = (f * j) % i
wait
next j
if f = i - 1 then
print i
endif
next i
end
Code: Select all
'arithmetic mean with array example
dim a[3, 1, 4, 1, 5, 9]
arraysize s, a
for i = 0 to s - 1
let t = t + a[i]
next i
print t / s
end
Code: Select all
'arithmetic mean without array example
input "how many numbers to average?", n
for i = 1 to n
input "enter a number: ", s
let a = a + s
next i
print "average: ", a / n
end
Code: Select all
'root mean square example
precision 8
let n = 10
for i = 1 to n
let s = s + i * i
next i
print sqrt(s / n)
end
Code: Select all
'perfect numbers example
print "calculating..."
for n = 1 to 10000
let s = 0
for i = 1 to n / 2
if n % i = 0 then
let s = s + i
endif
next i
if s = n then
print n, " is perfect."
endif
wait
next n
print "done"
end
Code: Select all
'factors of an integer example
do
input "enter an integer", n
loop n = 0
let a = abs(n)
for i = 1 to int(a / 2)
if a = int(a / i) * i then
print i
endif
next i
print a
end
Code: Select all
'geometric mean example
let a = 1
let g = 1 / sqrt(2)
do
let t = (a + g) / 2
let g = sqrt(a * g)
let x = a
let a = t
let t = x
loopuntil a = t
print a
end
Code: Select all
'integer square root example
alert "integer square root of first 65 numbers:"
for n = 1 to 65
let x = n
gosub isqrt
print r
next n
alert "integer square root of odd powers of 7"
cls
cursor 1, 1
for n = 1 to 21 step 2
let x = 7 ^ n
gosub isqrt
print "isqrt of 7 ^ ", n, " = ", r
next n
end
sub isqrt
let q = 1
do
if q <= x then
let q = q * 4
endif
wait
loop q <= x
let r = 0
do
if q > 1 then
let q = q / 4
let t = x - r - q
let r = r / 2
if t >= 0 then
let x = t
let r = r + q
endif
endif
loop q > 1
let r = int(r)
return
Code: Select all
'primality by trial division example
for i = 1 to 50
if i < 2 then
let p = 0
else
if i = 2 then
let p = 1
else
if i % 2 = 0 then
let p = 0
else
let p = 1
for j = 3 to int(i ^ .5) step 2
if i % j = 0 then
let p = 0
break j
endif
wait
next j
endif
endif
endif
if p <> 0 then
print i
endif
next i
end
Code: Select all
'nth root example
precision 6
let a = int(rnd * 5999) + 2
print "calculating nth root of ", a, "..."
for n = 1 to 10
gosub nroot
print n, " : ", y
next n
end
sub nroot
let p = .00001
let x = a
let y = a / n
do
if abs(x - y) > p then
let x = y
let y = ((n - 1) * y + a / y ^ (n - 1)) / n
endif
wait
loop abs(x - y) > p
return