Integer Square Root

[Pete Zawasky]

Calculate integer square root in FlashForth.

An example of porting FORTH code to FF from other Forths.

\ *********
\
\ Filename: integer_sqrt.txt
\ FlashForth: ff-pic24-30-33_5.0
\ MCU PIC24, dsPIC30
\ Application:
\
\ Author: Pete Zawasky
\ Created: 11:31am 03/24/2017 ppz
\ Last Edit: ppz
\ *
\ *********
\ FlashForth is licensed acording to the GNU General Public License *
\ *********
\ This code 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. *
\ ************
-sqrt
marker -sqrt
decimal ram

\ Calculate integer square root in FlashForth.

\ ************
\ From: Jason Woofenden sametwice.com
\ \ calculate square root in forth
\ \ Here's my version of sqrt. This is as simple as I could make the
\ Newton Method for finding the square root. It gives great results for
\ any input > 0. It's pretty fast. It takes about 20 iterations when
\ the numbers get up to around 2 billion.
\ ************

\ This implementation of SQRT requires that dividing by two makes all
\ numbers closer to zero. Try replacing the '2 /' in sqrt-closer with
\ 'S>D 2 SM/REM NIP' if needed.
\ Note the result if '2 /' is replaced by '2/' . This can be used
\ to investigate the difference between floored and symmetric division.

: /-test ( -- )
-1 2 / 0= abort" Try replacing the '2 /' in sqrt-closer" ;

/-test

: sqrt-closer ( square guess -- square guess adjustment )
2dup / over - 2 / ;

: sqrt-closer1 ( square guess -- square guess adjustment )
2dup / over - s>d 2 sm/rem nip ;

: sqrt ( square -- root )
1 begin sqrt-closer dup while + repeat drop nip ;

: sqrt1 ( square -- root )
1 begin sqrt-closer1 dup while + repeat drop nip ;

\ : sqrt-test ( -- )
\ cr 32767 1 do i dup . sqrt . cr i 100 / 1+ +loop ;

: sqrt-test ( -- )
cr 32767 1
begin
dup . dup sqrt .
cr dup 100 / 1+ +
2dup - 0<
until 2drop ;

\ : sqrt1-test ( -- )
\ cr 32767 1 do i dup . sqrt1 . cr i 100 / 1+ +loop ;

: sqrt1-test ( -- )
cr 32767 1
begin
dup . dup sqrt1 .
cr dup 100 / 1+ +
2dup - 0<
until 2drop ;

: .sqrt ( square -- )
1 begin sqrt-closer dup while + repeat drop swap . . ;

ram hex