View source for Programming performance/kc5tja Forth

* '''Language:''' Forth
* '''Skill:''' Advanced.  I've been programming Forth for more than 10 years.
* '''Time:''' 3.7 hours total, including re-inventing the necessary iterators and string processing routines.  Precise breakdown follows.
* '''Notes:'''
** This demonstrates that, while Forth coding took way longer than Haskell or Python, it's still not ''that bad,'' considering I had to write the software in terms of raw primitives (bytes, fetches, stores, etc), and ended up with abstractions that closely matched the problem being solved.  Still, in commercial software development, this kind of time sink is acceptable only for deep embedded environments; 3.7 hours versus 1.5 for the [[Programming performance/TimN Haskell]] version is a factor of 2.5; in terms of resource expenditures (including electricity, employee pay, etc.), the Haskell version is overwhelmingly cheaper to produce.  [[Programming performance/Magnus Haskell]] is substantially faster still.  In Python's favor, however, that version took "less than 30 minutes," to complete, so Python is right up there as far as programmer productivity goes too.
** The code is pragmatic; I use variables where it makes the coder easier to develop.  However, you'll find that the overwhelming majority of the code is written to use values on the stack, thus employing Forth in a more functional manner.  Indeed, though Forth isn't a functional language, Forth ''strongly'' encourages referential transparency.  This is one possible reason why Forth has a reputation for being a ''highly'' productive programming environment.
** Note that most of the time spent was in parsing the file.  The "Forth Way" obviously would not use this approach to store the data in the first place, thus eliminating all that code, and the 1.5 hours it took to write it.  :)
** The last three sub-components of the program took 1.5 hours to write primarily because of me getting too tired.  It's after midnight as I post this.
** I parse the date field of the text file.  I didn't have to; I spent a LOT of time in the parser just to support that, only to find out, I never used it.  If I'd concentrated exclusively on the closing prices alone, the line parser would have been done much, much faster (I'd guess 15 minutes instead of 90).

== Time Breakdown ==

5 minutes coding mapLines

90 minutes coding line parser engine (using iterative development)

5 minutes coding database

30 seconds coding routine to load database from file.  :)

1 minute coding the bank

5 minutes coding the purchasing of shares

25 minutes coding the selling of shares, due to HIGHLY ambiguous (actual coding took 3 minutes) requirements.  :(

90 minutes coding the portfolio manager, broker, and liquidator, combined.

Sum total time: 3.7 hours coding time.

Remember that, due to Forth's lack of standard string processing
functions, I had to write my own.  :)  On the other hand, they're
perfectly taylored to the job at hand.  All times include
debugging effort as well.


== Code ==
<pre>
\
\ Maps a function to each line in the gspc.txt file.
\

create lineBuffer 100 chars allot
variable GSPC
: open S" gspc.txt" r/o open-file throw GSPC ! ;
  open

: mapLines ( ... xt -- ... ) \ xt ( ... caddr u -- ... )
  >r begin lineBuffer 100 chars GSPC @ read-line throw
  while lineBuffer swap r@ execute repeat
  0 s>d GSPC @ reposition-file throw  rdrop drop ;



\
\ Determine number of records in the database
\

variable records 0 records !

: isn'tAComment?                over c@ '# = 0= ;
: tallyRecord  ( caddr u -- )   isn'tAComment? IF 1 records +! THEN  2drop ;
' tallyRecord mapLines

." Database records: " records @ . cr
records @ constant #records

variable record#
records @ record# !



\
\ Database of dates and closing prices
\

create years        #records cells allot
create months       #records cells allot
create days         #records cells allot
create closings     #records cells allot \ fixed-point representation!

: currentRecord     record# @ ;
: previousRecord    currentRecord 1- ;
: prevRecord        -1 record# +! ;
: closingPriceA     cells closings + ;

: *year*            currentRecord cells years + ;
: *month*           currentRecord cells months + ;
: *day*             currentRecord cells days + ;
: *closing*         currentRecord closingPriceA ;

: currentPrice      *closing* @ ;
: previousPrice     previousRecord closingPriceA @ ;



\
\ Line parser
\

variable input

: currentCharacterAddress   input @ ;
: currentCharacter          currentCharacterAddress c@ ;
: nextCharacter             1 input +! ;

: fixedFieldAsInteger ( addr n -- )
  currentCharacterAddress over evaluate  swap input +!  swap ! ;

: year                      *year* 4 fixedFieldAsInteger ;
: month                     *month* 2 fixedFieldAsInteger ;
: day                       *day* 2 fixedFieldAsInteger ;

: isn'tDash                 '- = 0= ;
: isn'tDot                  '. = 0= ;
: isn'tSpace                32 = 0= ;
: isInteger                 dup '0 &gt;= swap '9 &lt;= and ;

: '-' currentCharacter isn'tDash abort" E1: Malformed input" nextCharacter ;
: '.' currentCharacter isn'tDot abort" E3: Malformed input" nextCharacter ;
: spc currentCharacter isn'tSpace abort" E2: Malformed input" nextCharacter ;

: skipNonWhitespace
  begin currentCharacter isn'tSpace while nextCharacter repeat ;

: asInteger     '0 - ;
: accumulate    asInteger *closing* @ 10 * + *closing* !  nextCharacter ;
: integer       begin currentCharacter dup isInteger while accumulate repeat drop ;

: unused        skipNonWhitespace spc ;

: closing       0 *closing* !  integer '.' integer spc ;
: date          year '-' month '-' day spc ;

: lineFormat    date unused unused unused closing ( rest ignored ) ;



\
\ Load database from file
\

: readLine  isn'tAComment? if drop input !  lineFormat  prevRecord exit then
            2drop ;
' readLine mapLines



\
\ Bank
\

\ fixed point integer; same scale as database records
variable account 1000000 account !       

: balance       account @ ;
: credit        account +! ;
: debit         negate credit ;



\
\ Stock Broker
\

create prices       #records cells allot
create shares       #records cells allot
variable buys       0 buys !
variable sells      0 sells !

: *price*           buys @ cells prices + ;
: *shares*          buys @ cells shares + ;
: bought            1 buys +! ;

: %price%           sells @ cells prices + ;
: %shares%          sells @ cells shares + ;
: sold              1 sells +! ;

: buyShares     dup *shares* !  currentPrice dup *price* ! * debit bought ;
: buy           balance 10 / currentPrice / buyShares ;

: sellShares    * credit sold ;
: sell          %price% @ %shares% @ sellShares ;



\
\ Portfolio Manager
\

: %change   over - swap 100 swap */ ;
: action    %change dup -2 &lt; if drop buy exit then
                         6 &gt;= if sell then ;
: history   dup record# !  previousPrice currentPrice ;
: manage    2 begin dup #records < while history action 1+ repeat drop ;

manage



\
\ Final liquidator
\

: liquidate     %price% @ begin sells @ buys @ &lt; while dup %shares% @
                sellShares repeat drop ;

liquidate



\
\ Report Results.
\

." Ending balance: " balance s>d &lt;# # # '. hold #s '$ hold #&gt; type cr 
bye
</pre>