Craft Basic on Rosetta Code

[admin]

https://rosettacode.org/wiki/Category:Craft_Basic

[admin]

I have solved more tasks on Rosetta Code with Craft Basic. These snippets will be included with the next version of Craft Basic (whenever it is released), but are uploaded to Rosetta code for now.

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

[admin]

Here's a few more.

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

[admin]

More tasks complete...

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

[admin]

I have been busy doing Rosetta code tasks. It's fun.
While running doing these tasks, I also test them in Commando Basic. The results are great. It can do a lot of things that Craft Basic cannot. Faster too.

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