Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!torn!utcsri!rpi!uwm.edu!spool.mu.edu!howland.reston.ans.net!sol.ctr.columbia.edu!The-Star.honeywell.com!umn.edu!csus.edu!sfsuvax1.sfsu.edu!emclean
From: emclean@sfsuvax1.sfsu.edu (Emmett McLean)
Subject: A few idioms and programs for new J'ers
Message-ID: <1993Jan30.051637.16384@csus.edu>
Sender: news@csus.edu
Organization: San Francisco State University
Distribution: NA
Date: Sat, 30 Jan 1993 05:16:37 GMT
Lines: 209

NB.   Here are a few J idioms and programs I am posting for
NB.   those new to J who are looking for something to study
NB.   while waiting for ISI's textbooks or for others just
NB.   interested in perusing some code.
NB.   0!:2 this file and check it out.  If you put it thru
NB.   a word processor to edit out my comments be certain
NB.   your wp doesn't truncate long lines.
NB.   Fortunately it's the beginning of the semester so I
NB.   have time for this.
NB.   Emmett
9!:3 (5) NB. Use this display for verbs it's nicest
   NB. counts contigous types so :
   NB. cc 0 0 0 0 1 2 2 1  is 4 1 2 1
   h =. '(<@(] #~ -.@(*/\)@({. = ]))>@(0&{) y.) 0 } y.':11
   g =. '(<@(>@(1&{) , (+/)@(*/\)@({. = ])@>@(0&{) ) y.) 1 } y.':11
   f =. ''&$@(0&~:)@$@,@>@(0&{)
   cc =.>@(1&{)@(( h f.)@(g f.) ^: (f f.))@(] ; ''"_)
   erase =. 4!:55&<
   erase 'h'
   erase 'g'
   erase 'f'
   cc 0 0 0 0 1 2 2 1  
   NB.   To find the frequency of all unique values in a list :
   freq =: |:@/:~@:(~. ,. +/@(=/ ~.))
   v =. ? 20 # 4
   (freq v) ; v 
NB.   For special formatting:  Thanks to Roger Hui (repost)
   replacewithblanks =. ; @: (,&' '@(0&~: # ":)&.>)
   paddwithzeros =. , @ (,.&' ') @ (0 2&}.) @ (0.3&":) @ ,. @ (%&1e3)
NB.   From APL, expand: Thanks to those at ISI (repost)
   expand =. (* +/\)@[ { 0&,@]
   a =. i. 5 5
   ((1 1 0 0 1) expand a ); (1 1 0 0 1) expand"1 a
NB. Nice formatting  Thanks to ISI 
    over  =. ({.;}.)@":@,
    by    =. ' '&;@,.@[,.]
    (i. 5) by (i. 5) over +/~ i. 5
NB. annuities
  discount_factor =. %@>:@interest_rate
  interest_rate =. 100&(%~)@[
  valuesofn =. >:@i.@]
  annuities =.  (1: - discount_factor ^ valuesofn) % interest_rate
NB. annuity immediate values for 10 years at 5% and 6% 
  5 6 (annuities/)"(0 0) 10
NB. MasterMind Game : User must guess 4 digits between 0 & 9
m =. i. 0 0
m =. m,'NB. MasterMind (TM) ~=~= programed by emclean '
m =. m,'cows =.  ''cows ''&;@(+/)@(~: *. e.)'
m =. m,'bulls =. ''bulls''&;@(+/)@( = ])'
m =. m,'length =. (4&~:)@#'
m =. m,'duplicates =. # ~: #@(~.)'
m =. m,'range  =. 1&e.@(0&>) +. 1&e.@(9&<)'
m =. m,'write  =. 1!:2&2'
m =. m,'NB. invoke range error message for value errors'
m =. m,'read   =. '' ''''y.=.10'''' ". '''' y. =. ". 1!:1 (1) '''' '' : '''' '
m =. m,'blank  =. '' '' '
m =. m,'ischar =. (2&=)@(3!:0)'
m =. m,'errors =. ''Guesses must be digits between 0 and 9'' '
m =. m,'errors =. errors ,: ''Guesses can not contain duplicates'' '
m =. m,'errors =. errors ,  ''Guesses must have four digits '' '
m =. m,'permutation =. >: 4 ? 10'
m =. m,'NB. write permutation <> uncomment this line when checking '
m =. m,'write ''Welcome to MasterMind (TM)'',: blank'
m =. m,'write ''~~~~~~~~~~~~~~~~~~~~~~~~~~'',: blank'
m =. m,'loop) '
m =. m,' write ''Guess!   (Or ''''*'''' to quit)'' ,: blank'
m =. m,' ".(ischar guess =. read'''')#''$. =. end'' '
m =. m,' write blank'
m =. m,' notvalid =. (range,duplicates,length) guess'
m =. m,' ".(+./notvalid)#''$.=. loop [ write blank ,:~ {. notvalid # errors'' '
m =. m,' write blank ,~ ": permutation (bulls ,: cows) guess'
m =. m,' $. =. > (permutation -: guess ) { loop ; end'
m =. m,'end) write blank , ''Thanks for playing MasterMind (TM) '',: blank' 
m =. m,'".(-.@ischar guess)#''y.=. ''''      CONGRATULATIONS '''' '' '
m =. m : ''
   a =. i. 5 5
   b =. 3 ; 10 * i. 5
NB.   For column reassignment into a table : (requires v6.1 or 6.2)
NB. (repost)
   acol=.  ;@(|:@>@}.@])`(;@(>@{.@] +/ (''&$@}. * i.@{.)@$@[))`[}
   a acol b
NB.   For row reassignment into a table:
   arow =. |:@:(|:@:[ acol ])
   a arow b
NB.   For reading a text file into J:
   read2  =. >@(<&}:;.2)@(1!:1&<)
NB.   Primes, demonstrates forks and hooks (finger my account)
   pf =. (1&=@(+/)@(0&=)@(i.@>:@<.@%: |/ ])"0 # ])@(>:@+:@i.@>.@-:)
   ph =. (#~ (1&=)@(+/)@(0&=)@(|/~ i.@>:@<.@%:)"0)@(>:@+:@i.@>.@-:)
   pf 100
   ph 100
    NB. see how long it takes to find all primes under 100
    6!:2 'ph 100'
   NB. Raul Rockwells debugger go to the archive for explanations.
   NB. RR's original used a read_block verb which is obsolete.
   NB. This should save some time for anyone wishing to study
   NB. this program.  It provides a great example of the power
   NB. one gets from a functional programming language. (I just
   NB. wish I *really* understood it -:)
   print   =. 1!:2&2
   resolve =. '(5!:1<x.)5!:0':1
   eval    =. ('''''".''r=.'',x.';'r') : 1
   DEB     =. #~ -.@('  '&E.)
   mtm        =. i.@(,~)@0:
   rowvec     =. (*@# , #) $ ]
   enquote =. ''''"], ], ''''"] 
   undocify =. ('o=:prefob x.' ; '(<x.)=. o resolve') :1
   types =. (;:'boolean literal integer floating complex boxed')
   d_type =. ''&,@>@{&types@((2 ^ i. 6)&i.)@(3!:0)@]
   p =. i. 0 0
   p =.p,' print@[ print @ ('' ''&,:@(x. & [ , d_type , '' $ '' & [ , ": @ $))'
   p_label =.p : 1
   p =. i. 0 0
   p =. p,' o  =. y. , ''_orig_'' '
   p =. p,' $. =. do }.~  0 < 4!:0 < o' NB. idiom : a great alternative to
   p =. p,' do) (<o) =: y. resolve'     NB. execute or branch
   p =. p,' o'
   prefob =. p : ''
   q =. i. 0 0
   q =. q,'print $.'
   q =. q,'print s1'
   q =. q,'$.=.s1 }.~ 0 < y.'
   q =. q,'s1) y. =. 3'
   q =. q,'y. =.y., 2'
   q =. q : ''
   p =. i. 0 0
   p =. p,'o=.prefob x.'
   p =. p,'(<x.) =: (enquote x.) p_label @ (o resolve) @ ((''entering '',enquote x.) p_label) : (((enquote x.),'' x. '') p_label @ [ (enquote x.) p_label @ (o resolve) ((enquote x.),'' y. '') p_label @ ]) " (o resolve) '
   docify =. p : 1
NB. Useage is:    
   test =. +/
   'test' docify
    test 1 2 3
    test =. 'test' undocify 
NB. A repost of mine on sci.math.stat .....
NB. I've recently been honing my LISP to J translation skills so this
NB. provides me an opportunity to post something cool. The following
NB. program is from the Abelson and Sussman textbook. It counts all
NB. the ways of ways to make a a given amount amount of change using
NB. an unlimited number of dimes,nickels, and pennies.
NB.  
NB. For example there are 13 ways to make 25 cents:
NB.  0 pennies +  0 nickels +  0 dimes + 1 quarter
NB.  0 pennies +  1 nickels +  2 dimes + 0 quarter
NB.  0 pennies +  3 nickels +  1 dime  + 0 quarter
NB.  0 pennies +  5 nickels +  0 dimes + 0 quarter
NB.  5 pennies +  0 nickels +  2 dimes + 0 quarter
NB.  5 pennies +  2 nickels +  1 dimes + 0 quarter
NB.  5 pennies +  4 nickels +  0 dimes + 0 quarter
NB. 10 pennies +  1 nickels +  1 dimes + 0 quarter
NB. 10 pennies +  3 nickels +  0 dimes + 0 quarter
NB. 15 pennies +  0 nickels +  1 dime  + 0 quarter
NB. 15 pennies +  2 nickels +  0 dimes + 0 quarter
NB. 20 pennies +  1 nickel  +  0 dimes + 0 quarter
NB. 25 pennies +  0 nickels +  0 dimes + 0 quarter
NB. Here is the LISP :
NB. (defun count-change (amount)
NB.     (cc amount 5))
NB. (defun cc (amount kinds-of-coins)
NB.     (cond
NB.         ((= amount 0) 1)
NB.         ((or (< amount 0) (= kinds-of-coins 0)) 0)
NB.         (t (+ ( cc (- amount
NB.                (first-denomination kinds-of-coins)) kinds-of-coins)
NB.               ( cc amount (- kinds-of-coins 1)) )) ))
NB. (defun first-denomination (kinds-of-coins)
NB.     (cond
NB.         ((= kinds-of-coins 1)  1)
NB.         ((= kinds-of-coins 2)  5)
NB.         ((= kinds-of-coins 3) 10)
NB.         ((= kinds-of-coins 4) 25)
NB.         ((= kinds-of-coins 5) 50) ))
NB. Franz Lisp, Opus 38.79
NB. -> (load  "cc")
NB. [load cc]
NB. t
NB. -> (count-change 25)
NB. 13
NB. -> 
NB.  **
NB.    Here is a literal translation. By literal I mean the translation
NB.    preserves the logical structure and orientation of logic of the 
NB.    original program. Notice that none of the primitives are spelled
NB.    in English, only symbols such as "{.","@.","+." are primitive.
   amount =. {.
   kinds_of_coins =. {:
   cond =. @.
   or   =. +.
   cc   =. cc1`1: cond ((0&=)@amount)
   cc1  =. cc2`0: cond ((0&>)@amount or (0&=)@kinds_of_coins)
   cc2a =. cc@(((amount - first_denomination@kinds_of_coins) , kinds_of_coins))
   cc2b =. cc@(amount , (kinds_of_coins - 1:))
   first_denomination =. (1"_)`(5"_)`(10"_)`(25"_)`(50"_) cond (1 2 3 4 5&i.)
   cc2  =. cc2a + cc2b
   count_change =. cc@(,&5)
   count_change 25
NB.   J is shareware available via ftp at 'watserv1.waterloo.edu'
NB.   Comprehensive documentation is available for $34.00 USA
NB.   ($10.00 shipping and $24.00 for two texts "The Dictionary
NB.   of J" and "An Introduction to J".  Some other publications
NB.   are available. Many sample J programs  can be found in the
NB.   comp.lang.apl archive, also at watserv1.
NB.   For information contact:
NB.   Iverson Software Inc.
NB.   33 Major Street 
NB.   Toronto, Ontario, Canada
NB.   M5S 2K9
NB.   Phone (416)-925-6096
NB.   FAX (416)-488-7559
