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
\
\ 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 >= swap '9 <= 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 < if drop buy exit then
6 >= 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 @ < while dup %shares% @
sellShares repeat drop ;
liquidate
\
\ Report Results.
\
." Ending balance: " balance s>d <# # # '. hold #s '$ hold #> type cr
bye