2024年8月31日 星期六

一百個例題 (30 ~ 34)


Ching-Tang Tseng
Hamilton, New Zealand
31 August 2024

第(30)個範例是一個完整、能夠自動產生輸出檔案的程式。

在第(23)個開立方程式中,我們探討過從檔案自動輸入數據的問題。第(30)個範例則更進一步探討將執行結果自動輸出到一個指定檔案的問題。

誰都懂得求解一元二次方程式的技術,所以,我才拿它當例題來設計程式。這個程式的重點,不在介紹這麼簡單的事情,而是在展示我設計的系統,能夠辦到如何將執行結果,自動輸出到一個指定的檔案。因此,一大堆程式內容可以都不要看,直接只看 main 指令的執行內容。

我創作這套技術時,規劃出了檔案輸出的執行協定。程式執行時,從檔案輸入數據的協定就不再贅敘,它就只是那個 ReadCoef 指令的內容。

檔案輸出的技術協定,從必須先宣告出一個新的檔案名稱作為開始,這是第一步,依次按步驟說明整套協定如下:

(1)執行 new-file 指令產生一個指定名稱的新檔案,在 Windows’ 系統中,這種檔案可以僅存在於指定的記憶體內。但在 Linux 系統中,一旦宣告,就必定會在硬碟資料夾內,立刻產生出一個實體檔案。
(2)執行 >file 指令讓 Forth 系統的輸出轉向。所有的輸出,將只輸出到前述產生於記憶體內的指定檔案區內。
(3)此後,便能照常執行整個程式,不論是只求解簡單問題或複雜程式都可以,若碰到有要印出結果的程式時,輸出的結果都不再出現在螢幕上,將全都輸出到檔案緩衝區,該空格的就空格,該跳列的就跳列,完全以看不見的方式完成工作。
(4)執行 file> 指令讓 Forth 系統的輸出,重新回到正常的螢幕輸出狀態。此後的任何操作,都將只在螢幕上進行。
(5)執行 save-file 指令,把檔案緩衝區內的檔案資料正式存入硬碟內去,已有同名檔案,就會蓋掉舊檔,沒有此檔,就正式存放出一個新的檔案。

這五個步驟,就是我自創的檔案輸出執行協定,您在別的場合看不到這種設計。

上列五個步驟產生的協定,不包括能在螢幕上同步顯示結果的設計。因此,我在程式最後,執行了一個叫做 filetype 的指令,它會自動印出現行被開啟在檔案緩衝區內之檔案的內容,有空格就空格,有跳列就跳列,碰到 End Of File(EOF) 就結束在螢幕上印出資料的動作,這個步驟可以不執行,此處只是為了便於使用者觀察而添加的設計。

被列為範例的程式,不必要很大、很長,只是為了展示。如果程式很大,輸入的資料量可以是大數據。輸出結果更需要以報表方式呈現時,這個範例告訴了大家,我設計的系統都辦得到。程式的最後,可以只執行單一個指令,就能完成一切工作。這樣的範例,您很難在網上找得到,只因爲全世界作業系統與程式語言的檔案操作規格,沒有統一的格式與協定,所以我只好自行創作。

從這個範例執行的流暢程度,您可以看得出來,我設計的系統可以完成任何大數據分析的任務。我經常試用別種系統傳送過來的數據檔案,也經常試著讓別種系統接受我的數據輸出檔案,執行起來都沒有問題。

所有的 Forth 原生系統中,可以看到許多檔案操作用的現成指令,請注意!他們都不能被直接使用後就得到或產生檔案,只能被用來加工,形成整套協定規矩後,才能使用。這些知識與技術,沒有人會告訴您該怎麼做,網上也很難找得到設計範例來仿效。甚至於,公開的網路論壇中,也很難見到完整的討論,很少人懂得全套的運作機制,所以必須寫出這個最簡單的應用範例來留參,時間久了,自己也才能記得程式該怎樣設計來按照步驟執行協定?協定都是有點複雜的規矩才叫作協定,道理在此。

還有,隨著作業系統的不同,檔案的規格就會不同,傳送數據出入檔案的技巧也會不同,由於這部分的技術不是傳統 Forth 研究的範疇,我就不談細部的設計方法,只能討論我設計好了的外觀用法。而且,另有特殊的傳送技術,可以在特例狀況使用,雖很方便,卻不能萬用。由於作業系統不同的關係,才會如此。在 Linux OS 中另有簡易的作法,超出了這個主題的討論範圍,此處從略。

直接操作滑鼠將資料反白選定後,人工執行複製、人工開啟新檔案、人工貼上前面選定的資料,也能得到本程式自動執行出來的結果,這種完全人工操作的做法,我就不談了。我在發展 Forth ,它,只要是能講得出來的事情,全都能設計成程式自動地執行出來。
:

 
\ (30)實數係數一元二次方程式的根.f
\ 適用於 abc657 以後版本。
\ 最新修正日期:20150220

\ (30)QuadraticEq.f
\ ABC FORTH file I/O demo code
\ Author   : Ching-Tang Tseng, Hamilton NZ
\ Date     : 6 Aug 2012
\ Contact  : ilikeforth@gmail.com
\ Website  : http://forthfortnight.blogspot.com

2 Integers I N
20 3 MATRIX coef
\ BRA(i) is a primitive BASIC style Real Array in ABC FORTH
: ReadCoef ( -- )
BASIC
10 run S" (30-1)QuadraticEqCoeff.f" Get-File
20 run GetOneLineData
30 let N = INT ( BRA ( 1 ) )
40 for I = 1 to N
50 run GetOneLineData
60 let { coef ( I 1 ) = BRA ( 2 ) }
70 let { coef ( I 2 ) = BRA ( 3 ) }
80 let { coef ( I 3 ) = BRA ( 4 ) }
90 next I
100 end
;

9 Reals a b c x f(x) x1 x2 d dsq

: RealRootCheck ( -- )
BASIC
10 LET { f(x) = a * x * x + b * x + c }
20 END
;

5 complexs za zb zc zx f(zx)

: ComplexRootCheck ( -- )
BASIC
10 let [ za = r>zr ( a ) + r>zi ( 0 ) ]
    :: [ zb = r>zr ( b ) + r>zi ( 0 ) ]
    :: [ zc = r>zr ( c ) + r>zi ( 0 ) ]
20 let [ f(zx) = za * zx * zx + zb * zx + zc ]
30 end
;

: Once ( -- )
BASIC
10 IF { a = 0 AND b = 0 } THEN 400

20 IF { a = 0 } THEN 300

30 LET { d = b * b - ( 4 * a * c ) }
40 IF { d >= 0 } THEN 100
50 GOTO 200

100 LET { dsq = SQRT ( d ) }
     :: { x1 = ( NEGATE b + dsq ) / ( 2 * a ) }
     :: { x2 = ( NEGATE b - dsq ) / ( 2 * a ) }
110 let { x = x1 }
120 run RealRootCheck
130 PRINT { " Root x1:" , x1 ; " ==> f(x1) = " , f(x) }
140 let { x = x2 }
150 run RealRootCheck
160 PRINT { " Root x2:" , x2 ; " ==> f(x2) = " , f(x) }
170 GOTO 900

200 LET { d = ABS ( ( SQRT ( ( 4 * a * c ) - b * b ) ) / ( 2 * a ) ) }
210 let { x1 = negate b / ( 2 * a ) }
220 let [ zx = r>zr ( x1 ) + r>zi ( d ) ]
230 run ComplexRootCheck
240 PRINT [ " Root x1 = " ; zx ; " ==> f(x1) = " ; f(zx) ]
245 print { " ABS(f(x1)) = " ; ZABS ( f(zx) ) }
250 let [ zx = r>zr ( x1 ) - r>zi ( d ) ]
260 run ComplexRootCheck
270 PRINT [ " Root x2 = " ; zx ; " ==> f(x2) = " ; f(zx) ]
275 print { " ABS(f(x2)) = " ; ZABS ( f(zx) ) }
280 GOTO 900

300 LET { x1 = NEGATE c / b }
310 let { f(x) = b * x1 + c }
320 PRINT { " This equation has only one root x = " ; x1 ; " ==> f(x) = " ; f(x) }
330 GOTO 900

400 PRINT " This is not an appropriate quadratic equation!"

900 RUN CR
910 END
;

: test ( -- )
BASIC
10 LET { a = 8 } :: { b = -33.33 } :: { c = 9.876e2 }
20 PRINT { " Equation:( " ; a ; " )*x^2 + ( " ; b ; " )*x + ( " ; c ; " ) = 0" }
30 RUN ONCE
40 END
;

: hi  ( -- )
BASIC
10 PRINT " Typical real coefficient quadratic equation: ax^2 + bx + c = 0 " CR
20 PRINT " Please enter its three coefficients: a b c " CR
30 INPUTR a , b , c
40 RUN ONCE
50 END
;

: main ( -- )
PAGE
BASIC
10 RUN ReadCoef
20 run S" (30-2)OutputResult.f" new-file
30 run >file
40 FOR I = 1 TO N
50 LET { a = COEF ( I 1 ) }
    :: { b = COEF ( I 2 ) }
    :: { c = COEF ( I 3 ) }
60 PRINT " ( " ; I ; " )"
   ; { " Equation:( " ; a ; " )*x^2 + ( " ; b ; " )*x + ( " ; c ; " ) = 0" }
70 RUN Once
80 NEXT I
90 run file>
100 run S" (30-2)OutputResult.f" save-file
110 run filetype
120 END
;

cr cr 
.( Usage: ) cr 
.( 1. test : for fixed data set using. ) cr 
.( 2. hi   : for interactive input data using. ) cr
.( 3. main : for file I/O data sets using. ) cr

\S
cr cr
.( 程式用法: ) cr
.( 1. test : 固定的輸入數據時使用。 ) cr
.( 2. hi   : 交談式輸入數據時使用。 ) cr
.( 3. main : 由檔案輸入數據時使用。 ) cr

第(31)個範例,探討如何印出浮點數字。

分成三個子程式,但實際上只有兩套方法,(31-2)與(31-3)是同一方法,只是(31-2)中使用了 flog 函數來計算,(31-3)中只用浮點四則運算來計算的差別,有所不同而已。

Win32Forth 系統原本沒有 (f.) 指令,只有直接使用的 f. 的指令可用,我後來自行補進系統的 (f.) 指令,僅供 ABC Forth 系統專用。

大家可以從最近的幾個範例程式中體會到,這些範例都是我在發展系統的過程中使用過的精華設計。但很可惜,後來在發展哲理的探討上,發現了問題,知道它們都無法配合我的創作,所以均未被採用。我覺得就這樣丟棄這些創作,實在可惜,只好將這些奮鬥過程中參考過的作品,納入範例教材來收集,也許來日會有用途。

想要順利地使用這套設計,您必須先學會看懂指令後面加註的堆疊補充說明。例如:

: F.R ( F: r -- ) ( n u -- )

表示您想使用這個靠右對齊印出浮點數的指令時,在使用前,必須先輸入一個標準的浮點數輸入數值例如: 1.23456e3 ,然後,一般的數據堆疊上,也得有兩個整數,一個是代表總欄位寬度的 n ,及另一個代表小數點後面有幾位數的 u 。

您載入程式後自行操作,就能體會效果。測試輸入如:

1.23456E3 20 8 F.R

得到的結果是個近似值,這就是硬體二進制浮點轉換後的固有缺點,我不太認同這樣做出來的結果。

(31-1)的程式,是我比較喜歡的格式,因為它還配合傳統 Forth ,將數值印成數字時,逐個剝離單個位數的方式,設計出全套指令。(31-2)及(31-3)的設計,就沒有這些效果,直接算完。這個範例是一個運用到所有與 # 符號有關之數字處理指令的用法佳例,可以用來體會 # 指令具有將數值逐個剝離出數字的效果。

後兩套程式的原始來源,都是16位元時代古聖先賢的作品,我收集在筆記本中,作者已不可考,好像只有 BNE 的縮寫姓名,我將其保留在程式中顯示,以示尊重。但是,原始程式都只能適用於16位元時代的環境,其中有些標準指令的使用規格,已與現行的標準不同,我熟悉這些問題,因此,還能讓它們跑得起來,必須先修正後才進行測試,我做好了,才列為範例。

以上是討論程式設計大要與用法的部分。以下,我要增列一些說明,屬於觀念問題,不得不談。

首先,為什麼範例中只列浮點數的輸出 FloatDot (F.) 設計程式,卻沒有列浮點數的輸入設計程式?因為,輸出還算容易設計,輸入很難設計。浮點數的輸入處理,要將數字轉換成二進制的浮點數(binary floating point number)標準規格,那是一種以 64 位元包裝出來的古怪位元花樣,最高效的 12 個位元用來表示帶有正負號的二進制方次數字,低效的 52 個位元,以二進制的方式表示小數點以後的正負數值,在轉換過程中,必須配合小數點後面的數字,調整高效部分的二進制數字方次,這種複雜的過程,設計者很難直接體會。因此,現行做法,都是交給硬體 coprocessor 使用組合語言指令完成,您無法追蹤到底,我在這個範例中也沒辦法詳列程式。但是,系統中可以用反組譯工具看到源碼,也有點複雜,很難看懂。我曾在我的個人網頁中貼了一篇具有高階方式設計出來的轉換程式,也是從 16 位元時代的老程式修改而成。

另外,您從程式中可以看得出來,浮點數字的每一位數字,都是經由浮點運算產生出來的結果。那麼,這就有個哲理問題了,一個系統設計者,在開始設計浮點系統時,一定是首先就想要設計一個能夠精準印出浮點數字的指令,無論是 f. 或 fs. 都可以,但是,系統都還沒有建立,那來的浮點運算指令可用?這是個雞生蛋或蛋生雞的問題,能夠先生雞(系統)的高手,一定得忍受看不到蛋的設計秩序(印出浮點數的指令 fs.),直到最後,才能設計得出可以印出浮點數字的指令來看效果。這很可怕,就算我很熟悉系統的設計方法了,換一套 Forth 後,努力工作,最起碼也得耗兩個星期在看不到結果的情況下設計浮點系統,我確實吃過這種苦頭。

所以,我後來自創浮點系統時,就完全不採用二進制的浮點表示方式,改採十進制的浮點表示方式設計浮點系統,上列問題就沒有了。自我在網上公開貼文,宣告已經設計出這種系統後,它被人注意,也被提出一個幾十年來沒人用過的名稱,叫做十進制浮點數字系統(decimal floating point number system)。我不是原始創作者,但是,是一個首先實現整套系統的設計者,所有貼出的實際應用範例,全都可以接受檢驗與挑戰。我的浮點數系統,使用一個數字單元來表示假數(mantissa),另一個數字單元來表示十的幾次方(exponent),完全可以精確地運作出所有的浮點數運算,包括數學函數。

本網頁於 20240710 貼出的『設計浮點系統』一文中,有我自己設計的 fs. 指令,已經向全球公佈,與本範例完全無關。
:

 
\ (31-1)FloatDot.f
\ Hans Bezemer

\ SFPOUT.F 
\ 
\ Simple Floating Point Output 
\ 
\ Don't attempt to output non-real numbers such as 
\ NANs or INFs as it will hang. 

\ Floating-point pictured numeric output operators
: <#. ( F: r1 -- r2 )  FROUND <# ; 
: #. ( F: r1 -- r2 )  10.E F/ FDUP FLOOR FSWAP FOVER F- 
  10.E F* FROUND F>D D>S  [CHAR] 0 + HOLD ; 
: #S. ( F: r1 -- r2 )  BEGIN #. FDUP F0= UNTIL ; 
: #>. ( F: r -- ) ( c-addr u )  FDROP 0 0 #> ; 
: SIGN. ( flag -- )  IF [CHAR] - HOLD THEN ; 

[UNDEFINED] S>F [IF] : S>F ( n -- r )  S>D D>F ; [THEN] 

VARIABLE FDP  FDP ON  \ decimal point control 

: 10^n ( r1 n -- r2 )  0 ?DO 10.E F* LOOP ; 
: #.n ( r1 n -- r2 )  0 ?DO #. LOOP ; 

1 VALUE rscale 
10 VALUE rstep 

\ Normalize to range 1.0 <= r < STEPSIZE 
: fnorm ( r1 -- |r2| sign exp ) 
  FDUP F0<  0 2>R  FABS 
  FDUP F0= 0=
  IF
    BEGIN FDUP  rstep S>F  F< 0= 
    WHILE rstep S>F F/  R> rscale + >R
    REPEAT

    BEGIN FDUP 1.0E F<
    WHILE rstep S>F F*  R> rscale - >R
    REPEAT
  THEN
  2R>
;

\ Convert real number r to string c-addr u in exponential 
\ notation with n places right of the decimal point. 
: f(e.) ( r n scale step -- c-addr u )
  TO rstep  TO rscale  0 MAX >R  fnorm 
  R> 2>R
  IF FNEGATE THEN
  1.E R@ 10^n
  FSWAP FOVER F*  FROUND ( make integer) 
  FDUP FABS FROT F/ rstep S>F F< 0=
  IF ( overflow)
  rstep S>F F/  R> R> rscale + >R >R
  THEN
  <#.  R>  R> S>D TUCK DABS # #S  2DROP 
  0<
  IF [CHAR] - ELSE [CHAR] + THEN
  HOLD [CHAR] E HOLD  >R  FDUP F0< ( sign)
  R> 2>R FABS  FDP @
  IF  ( always output decimal point )
    R> #.n  [CHAR] . HOLD 
  ELSE  ( conditionally output decimal point ) 
    R@ #.n  R>
    IF  [CHAR] . HOLD  THEN
  THEN  #S.  R> SIGN.  #>.
;

\ Convert real number r to string c-addr u in scientific 
\ notation with n places right of the decimal point. 
: f(FS.) ( r n -- c-addr u )  1 10 f(e.) ;

\ Display real number r in scientific notation right- 
\ justified in a field width u with n places right of 
\ the decimal point. 
: FS.R ( r n u -- )  >R f(FS.) R> OVER - SPACES TYPE ;

\ Convert real number r to string c-addr u in engineering 
\ notation with n places right of the decimal point. 
: f(FE.) ( r n -- c-addr u )  3 1000 f(e.) ;

\ Display real number r in engineering notation right- 
\ justified in a field width u with n places right of 
\ the decimal point. 
: FE.R ( r n u -- )  >R f(FE.) R> OVER - SPACES TYPE ;

\ Convert real number r to string c-addr u in fixed-point 
\ notation with n places right of the decimal point. 
: f(F.) ( F: r -- ) ( n -- c-addr u )
  0 MAX  DUP >R  10^n 
  <#. ( round)  FDUP F0< ( sign)  R> 2>R 
  FABS  R> #.n 
  [CHAR] . HOLD #S.  R> SIGN.  #>. ; 

\ Display real number r in fixed-point notation right- 
\ justified in a field width u with n places right of 
\ the decimal point. 
: F.R ( F: r -- ) ( n u -- ) 
  >R f(F.) R> OVER - SPACES TYPE ;

\ end


fvariable fpPAD

0 fpPAD 2 cells + W! 0 fpPad cell + ! 1 fpPAD !

\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ (31-2)FloatDot.f

CREATE FPOWERS 
 1E0 F, 1E1 F, 1E2 F, 1E3 F, 1E4 F, 1E5 F, 1E6 F, 1E7 F, 1E8 F, 1E9 F, 
 1E10 F, 1E11 F, 1E12 F, 1E13 F, 1E14 F, 1E15 F, 1E16 F, 1E17 F, 1E18 F, 

: f(F.)  ( -- c_addr u ) ( float: r -- ) 
   FDUP F0< FABS  FDUP FLOG F>S        ( minus? log10[r] ) ( float: r ) 
   0 MAX                 \ for small r, trade readability for precision 
   <#  >R  PRECISION 1- R@ -        ( minus? trailing ) ( R: log10[r] ) 
   DUP 0< IF  DROP                      \ r > 10^PRECISION 
      R> 18 - 0 MAX  DUP >R             \ assuming decimal BASE, 
      0 ?DO  10E0 F/  LOOP  F>D         \ reduce range if too big for # 
   ELSE                                     \ ordinary numbers 
      PRECISION FLOATS FPOWERS + F@ F* F>D  \ r*10^PRECISION 
      R> 0 ?DO  #  LOOP  5 0 D+  #          \ round 
      <# ROT 0 ?DO  #  LOOP  0 >R           \ after decimal 
   THEN 
   [CHAR] . HOLD 
   R> 0 ?DO  [CHAR] 0 HOLD  LOOP        \ big num overflow 
   #S  ROT SIGN  #>                     \ before decimal 
; 

\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ (31-3)FloatDot.f

\ Convert float to string                         2013.10.17 BNE 
CREATE FPOWERS  1E0 F, 1E1 F, 1E2 F, 1E3 F, 1E4 F, 1E5 F, 1E6 F, 
   1E7 F, 1E8 F, 1E9 F, 1E10 F, 1E11 F, 1E12 F, 1E13 F, 1E14 F, 
   1E15 F, 1E16 F, 1E17 F, 1E18 F, : [PRS] FLOATS FPOWERS + F@ ; 
: F.RIGHT  ( .right d -- d' )  5 0 D+ # <#  ROT 0 ?DO # LOOP ; 
: f(F.)  ( -- c_addr u ) ( float: r -- ) 
   <#  FDUP F0< FABS  0 
   BEGIN FDUP DUP 1+ [PRS] F< 0=  OVER 18 < AND  WHILE 1+ REPEAT 
   >R PRECISION 1- R@ -               ( -? .right | r: log10[r]) 
   DUP 0< IF  DROP                           \ r >= 10^PRECISION 
      R> 18 - 0 MAX  DUP >R             \ assuming decimal BASE, 
      0 ?DO  10E0 F/  LOOP  F>D  \ reduce range if too big for # 
   ELSE  PRECISION [PRS] F* F>D               \ r * 10^PRECISION 
      R>  0 ?DO # LOOP  F.RIGHT  0 >R   \ rounded, after decimal 
   THEN  [CHAR] . HOLD  R> 0 ?DO [CHAR] 0 HOLD LOOP  \ 0overflow 
   #S  ROT SIGN  #>  ;                         \ left of decimal 

\ Float to string with fixed number of digits after the decimal 
: (F.F)  ( digits -- c_addr u ) ( float: r -- ) 
   FDUP F0< SWAP  FABS  DUP 1+ [PRS] F* F>D 
   <# F.RIGHT  [CHAR] . HOLD  #S  ROT SIGN  #> 
; 

第(32)個範例,是以公式解得複數之平方根的程式。

在 ABC Forth 系統中,複數體系,是一個自成一格的獨立體系,平方根是必要的基本函數,在很多場合都會用到。

我們在學校唸書期間,並不熱衷於算出複數的平方根,真要算起來,非常冗長,因為公式本身就很複雜,要開兩次平方。請直接閱讀我寫成的範例程式,就可以看出他的公式,這也是使用 BASIC 格式設計程式時,所產生的好處。

在系統中, ZSQRT 是一個原生函數,您不用自己設計。我為什麼還要設計這個 Bzq 做同樣的事情來當範例?其來有自。

在發展系統的初期,我就開始應用系統算出所有的數學計算問題,那時,直接採用德國人公開捐獻的公益複數系統,沒有仔細研究其內容。有一次,我在設計一個求解一元多次方程式所有根的龐大應用程式時,要用到 ZSQRT ,理論根據被稱為: Bairstow-Hitchcock method ,其中就非用到 ZSQRT 不可。

寫完了程式,測試結果,才發現答案完全不對,我花了很多時間除錯、找問題,最後,才發現錯誤的起源,就是德國人在捐獻程式中添加了許多以 [IF] , [ELSE] , [THEN] 之類的選擇性編譯指令,造成得先正確設定才能有正確編譯結果的應用方式,前後一大堆設計的程式還互相影響,簡直就是一個亂七八糟的捐獻。我沒細究就直接應用,造成後來一發不可收拾的許多錯誤。查出問題的方法,用的就是此第(32)個範例程式,道理下述:

複數的平方根,不是單一個值,可以有好幾組解,解的格式,也不單純是共軛複數的性質,而是實部與虛部正負號都得對調的格式。數字開平方,本就會產生增根,回算驗證就能得知,這方面的問題,我不進行理論上的解釋,如果您有興趣,可以網上搜索,許多網頁都會告訴您複數的平方根有許多組解的觀念,也有很多圖文並茂的解釋,我若要拿來轉貼於此,有點麻煩,所以不做。但是,總歸一句話,解雖多,只有一個被稱為是『主值』的根,才是全世界電腦界公推的用法,德國人為了丑表技術,污染了這個環境,我則被困惑了許久。

這個程式,因此被用來驗證,我在編譯系統時,作了正確的前期設定,複數的平方根只採用主值。

除此之外,求複數的根,也有很多算法,學校裡就用 Z^(-n) 畫一個圓,分成 n 等份,然後採用三角函數來求解所有均分角度後的根,這樣的算法,當然也能求得平方根,可是要用系統中原本就是導得性質的三角函數,精確度當然就越來越差,系統設計者,都不可能用這種方法提供 ZSQRT ,我的系統也不採用,而採用此範例中的固定公式算法。

這個範例,另有一個意義,在傳統的 Forth 系統中,數據的傳遞都只使用堆疊,複數系統中提供的 ZSQRT 也是。但是,在這第(32)個範例中,沒有使用堆疊,而是使用宣告出來的變數傳遞參數。從這樣的範例,也照樣能設計得出系統函數,性質與速度絕不遜色,因為程式被編譯完畢後,其本質仍然是 Forth 。您用

See Bzq

看結果,就能明白。

貼出這些範例,實際上很有意義。如果有一天,系統向全世界公開,別人也許會來說三道四,硬說許多東西都是抄襲,這些範例就可以證明,抄用的材料,很多都有問題,這一個不就是最好的明證嗎?

創作不是要您從零開始,創作是要您把性質相異的素材,重新排列組合成前所未有的新事物。寫成這一百個範例,就更能證明,它們都是創作。
:

 
\ (32)Zsqrt.f

5 reals a b c d |Bz|

: Bzq ( f: c d -- a b )
  {{ d }} f! {{ c }} f!
BASIC
10 let { |Bz| = sqrt ( c * c + d * d ) }
20 let { a = sqrt ( abs ( |Bz| + c ) / 2 ) }
30 let { b = sqrt ( abs ( |Bz| - c ) / 2 ) }
40 if { d < 0 } then 60
50 goto 70
60 let { b = negate ( b ) }
70 end
{{ a }} f@ {{ b }} f@
;

: test ( f: r1 r2 -- )
  zdup
  cr cr zsqrt z.
  cr cr bzq fswap fs. fs. ." i "
  cr cr ;

20 sigdigits !

第(33)個範例,是一個簡單的 BASIC 語法夾雜了 Forth 語法之範例展示程式。

一百個範例是多年收集後的成果,也是我多年經常試用的程式,內容隱含了發展多年所經歷過的歷史。在這個範例中,您可以看到形如:

30 let a = a @ + b @ + c @

這種寫法的程式也能被執行,它就是混用了 BASIC 語法與 Forth 語法的典型代表程式。 a = … + … + … 是 BASIC 語法, a @ , b @ , c @ 是 Forth 語法。

我是系統的設計者,熟知以 integer , real , complex ..... 等等方式宣告而成的變數,在有 = 號的表示式中,出現於 = 號左邊時,是以變數的位址被編譯。出現在 = 號右邊時,是以變數的內容被編譯。如果我改採人工處理的方式書寫成上列格式,系統照樣能編譯出正確的可執行碼。這個範例程式的主要目的,就是試用這種寫法來測試系統,顯示的結果,是可以執行。

這種依然能被執行出正確結果的程式格式,有點怪異,也有潛在的好處,所以我留參。怪異處,就像中國人問您可不可以時,硬要講成有點洋派的言語,結果就問說:這樣 O 不 OK ?

潛在的好處,就是因為宣告出來的變數結構,使用了 Forth 之 variable 式的宣告格式。於是,這種變數就能自由自在的被使用於兩種程式環境之間。我在搞繪圖程式時,就經常面對需要具有這種特殊規格之變數的困擾,苦思不得其解,於是測試了這種程式,也才發現它的潛在好處。如果想體會這種參數傳遞上的困擾問題,在我的個人網頁中,有一篇2011年10月25日發佈的文章:向上發展FORTH技術,公開展示過動態顯示行星齒輪運轉的繪圖程式,仔細看其程式,就能發現這種參數傳遞上的困擾問題,用它來解決了。

這樣討論程式,屬於探討系統哲理上的問題,內容很簡單,觀念卻很複雜。

我設計的 ABC Forth 是一種帶有標號的 BASIC ,通常,這種 BASIC 都是屬於執行速度很慢,必須逐列拿來編譯,然後逐列予以執行的 interpreter 式語言。

但是,我創作的 BASIC 語法雖帶有標號,卻是一次就編譯完成,照樣能夠順利執行的 compiler 式語言,執行速度就能跟純粹的 Forth 程式一樣快。而且,程式被編譯完畢後,標號全不見了,所有的標號,只在單一個指令內有效,過了編譯邊界,就自動消失,緊接著下一個指令的設計,可以重新再用標號。

這種哲理的意義,表示我所創作的系統,一個系統內就能處理出無窮多個 BASIC 式的程式,不像一般的 BASIC ,一次只能執行一個 BASIC 式的程式。也難怪大家會稱 BASIC程式語言是麵條式的語言。我設計的 BASIC ,就可以沒有麵條式的問題,使用者在覺得程式顯現出有聚集成麵條式團塊的顧慮時,請儘管進行模組化編寫,令其變小,分寫成多少個小模組程式都沒有關係。

所有被編譯成功的 BASIC 式程式的指令,都能在 Win32Forth 系統中透過使用 see 指令看出編譯後的結果,這個程式只需執行:

See test1

便可。請試著與前面討論過的範例比較,是不是編譯後的結果,所有的『列首標號』全都不見了?
:

 
\ (33)VariablesTest.f

integer i
3 variables a b c

: test1
BASIC
10 let a = 1 :: b = 2 :: c = 3
20 for i = 1 to 10
30 let a = a @ + b @ + c @
40 run cr a @ . b @ . c @ .
50 next i
60 run cr a @ .
70 end
;

第(34)個範例程式,是用來展示一種很簡單之浮點局部變數的設計方法。

我向來很反對使用局部變數(Local variables)設計程式。表面上,使用局部變數設計程式,雖然能令程式比較容易被讀懂,但它破壞 Forth 的傳統。為什麼這樣說?最古典的 Forth ,根本不考慮局部變數的設計問題,一方面是它很浪費記憶體,另方面是需要使用它的地方並不多,第三方面是非常妨礙精簡快速設計出可用系統的發展工作。

如果把 Forth 的基本性質搞得很清楚,就能知道,一個系統只需要具有變數(variable)的宣告能力,就足夠用來解決所有的需要了。變數在執行時,能提供資料結構的位址,有了位址,什麼事不能做?都能做。所以,局部變數是多餘的,妨礙發展是它最為敗筆的地方,能不用時,我就不用,硬有人強行愛用,我也可以教大家如何精簡快速的取消它的存在,也就是教您直接刪改它,令其毫無用處。更何況,我創作的 ABC Forth 能全面讓程式更容易讀懂,何須再用局部變數?這個程式,只是用來告訴大家,局部變數實在沒有什麼。了解便可,深下功夫去研究它,大可不必,若真想要用它,這一個範例程式,就絕對足夠派得上用場了。

Win32Forth 系統中,有現成之整數的局部變數功能可以直接使用,但沒有浮點格式的局部變數可用。喜歡使用這種格式釋出應用程式者,大部分是歐洲人,他們不是 Forth 的發明人,甚至於他們發佈的系統,胚胎版本都還是來自美國,他們只是喜歡加油添醋後,號稱與眾不同,尤其是喜歡添加局部變數的功能,再大肆強調,我很不以為然。例如: gForth , iForth 都是。

早期,傳統 Forth 只強調兩種資料結構的宣告指令,一個是 CONSTANT ,另一個就是 VARIABLE 。後來,歐洲人介入 Forth 世界後,開始強調還要具有一個叫做 VALUE 的宣告方法,Charles H. Moore 就很不以為然,我也很不以為然。因為設計 VALUE ,很簡單,誰都會做,硬要加裝,一點也不難。結果,這個歐洲人強調的 VALUE ,反而是能用來打倒歐洲人自己喜歡強調之局部變數用法的寶貝。

如果您不怕麻煩,凡是碰到程式強用局部變數,那麼,您可以不用管它,也不用怕它,直接就把所有的局部變數功能取消。仍用原來的變數名稱,重新在使用之前使用 VALUE 宣告出該變數的名稱,放入數值時,使用 TO ,就改成了。絕對沒有改不成的問題,能這樣替換,還用局部變數幹什麼?所以,我一直不用。

在我的個人網頁中,我公佈過不少原為使用局部變數公開釋出的程式,改成之後我才貼出,協助沒有局部變數功能的系統也能使用這些程式,我就是這樣長期挑戰原作者的,目的在消滅局部變數。

下一個範例,也探討解決局部變數問題的另套辦法。
:

 
\ (34)FLocal.f

8 CONSTANT /flocals 

: (frame) ( n -- ) FALIGN FLOATS ALLOT ; 
: |FRAME  ( n -- ) /flocals NEGATE (frame) ; 

: FRAME| 
 0 >R BEGIN BL WORD COUNT  1 = 
            SWAP C@ [CHAR] | = AND 0= 
      WHILE R@ 0= IF  POSTPONE FALIGN  ENDIF 
            POSTPONE F, R> 1+ >R 
      REPEAT 
 /flocals R> - DUP 0< ABORT" too many flocals" 
 POSTPONE LITERAL POSTPONE (frame) ; IMMEDIATE 

: *h            HERE 1 FLOATS - ; 
: *g            HERE 2 FLOATS - ; 
: *f            HERE 3 FLOATS - ; 
: *e            HERE 4 FLOATS - ; 
: *d            HERE 5 FLOATS - ; 
: *c            HERE 6 FLOATS - ; 
: *b            HERE 7 FLOATS - ; 
: *a            HERE 8 FLOATS - ; 

: a             *a F@ ; 
: b             *b F@ ; 
: c             *c F@ ; 
: d             *d F@ ; 
: e             *e F@ ; 
: f             *f F@ ; 
: g             *g F@ ; 
: h             *h F@ ; 

: func1 ( F: r1 r2 -- r3 ) FRAME| b a | CR ."    b = " b F.  ." a = " a F.  a b F+  ." a + b = " fdup F.  |FRAME ;


: func2 ( F: r1 -- )       FRAME| a |   CR ." a = " a F.   FPI 2e fln func1  CR ." a = " a F. ." result = " a F* F. |FRAME ;

12.34e func2

\s
a = 12.340000 
a = 0.693147 b = 3.141593 a + b = 3.834740 
a = 12.340000 result = 47.320690  ok 

沒有留言: