diff --git a/examples/.gitignore b/examples/.gitignore index 314b2462..15daa26a 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -8,3 +8,4 @@ seq fib gol fizz-buzz +whole-sqrt diff --git a/examples/whole-sqrt.porth b/examples/whole-sqrt.porth new file mode 100644 index 00000000..4c9c86cb --- /dev/null +++ b/examples/whole-sqrt.porth @@ -0,0 +1,51 @@ +include "std.porth" + +// in : s n +// out: ((s // n) + n) // 2 +// one iteration of the Babylonian method +macro _apply + over over / + over + + 2 / + swap drop + swap drop +end + +// in : s +// out: floor(sqrt(s)) +// uses Babylonian method +macro whole_sqrt + if dup 1 = do // 1 is a special case for Babylonian method + drop 1 // sqrt(1) == 1 + else if dup 0 < do + "\nValue error, input: " eputs dup print + here eputs " Can't get sqrt from negative number" eputs 1 exit + else // general case + dup // `previous` + dup 2 / // `current` - firt guess + while 2dup swap < do + swap drop // we don't need `previous` anymore + // dup print // debug + 2dup _apply // apply one iteration and get `current` + // old `current` becomes `previous` + end + drop // drop `current` + swap drop // drop `s` + // leave `previous` + end end +end + +// in : number +// out: number == whole_sqrt(number)**2 +macro is_perfect_square + dup whole_sqrt dup * = +end + +// test is_perfect_square +100 while dup -101 != do + if dup is_perfect_square do + "Perfect square: " puts dup print + end + 1 - +end +drop diff --git a/examples/whole-sqrt.txt b/examples/whole-sqrt.txt new file mode 100644 index 00000000..ac53fe12 --- /dev/null +++ b/examples/whole-sqrt.txt @@ -0,0 +1,21 @@ +:i argc 0 +:b stdin 0 + +:i returncode 1 +:b stdout 209 +Perfect square: 100 +Perfect square: 81 +Perfect square: 64 +Perfect square: 49 +Perfect square: 36 +Perfect square: 25 +Perfect square: 16 +Perfect square: 9 +Perfect square: 4 +Perfect square: 1 +Perfect square: 0 +-1 + +:b stderr 89 + +Value error, input: ./examples/whole-sqrt.porth:22:5 Can't get sqrt from negative number