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.
* 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 TimN Haskell version is a factor of 2.5; in terms of resource expenditures (including electricity, employee pay, etc.), the Python version is overwhelmingly cheaper to produce. Magnus Haskell is substantially faster still, leading one to believe that coding in Haskell is more cost-effective than even Python.
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.
\ \ 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