\ diff-bearings.8th
\ Rosetta Code -- angle difference between two bearings
\ by John I. Helmers 2026.04.04
\ 8th version 26.02 Professional

11 ##  \ sets the precision to 11 decimal places

\ data array
[ [ 20 , 45 ] , [ -45 , 45 ] , [ -85 , 90 ] , [ -95 , 90 ] , [ -45 , 125 ] , [ -45 , 145 ] , [ 29.4803 , -88.6381 ] , [  -78.3251 , -159.036 ] ] constant BEARINGS

\ test array
[ [ -70099.74233810938 , 29840.67437876723 ] , [ -165313.6666297357 , 33693.9894517456 ] , [ 1174.8380510598456 , -154146.66490124757 ] , [ 60175.77306795546 , 42213.07192354373 ] ] constant TEST

360 constant LIMIT   \ sets circle limit to 360 degrees

: make-big-floats    \ [ a0, a1, a2 ... ] -- [ a'0, a'1, a'2 ... ]
                     ( ( n:bfloat ) a:map ) a:map  ;

: subtract-bearings  \ [b1,b2] -- n
                     0 a:@ swap 1 a:@ rot n:-  ;

: simplify        LIMIT n:fmod ;

: find-acute      \ n -- n
                  dup 180 > if 360 n:- else dup -180 < if 360 n:+ then then  ;

: compute-angles  \ a -- a'
            ( subtract-bearings simplify find-acute 2 swap a:! drop ) a:each!  ;

: .table-header  \ --
"   b1___________________    b2__________________   diff_________________" . cr ;

: .lines         \ a -- | print each line of table
                 ( ( "%>24.11f" s:strfmt . ) a:each! drop cr ) a:each!  ;

: .table         .table-header .lines  ;

: process-data   make-big-floats compute-angles ;

: do-it          BEARINGS process-data .table drop cr
                 TEST     process-data .table drop cr  ;

do-it bye