home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / comp / lang / perl / 7577 < prev    next >
Encoding:
Internet Message Format  |  1992-12-22  |  2.2 KB
  1. Path: sparky!uunet!nestroy.wu-wien.ac.at!dec4.wu-wien.ac.at!neumann
  2. From: neumann@dec4.wu-wien.ac.at (Gustaf Neumann)
  3. Newsgroups: comp.lang.perl
  4. Subject: reduce fun
  5. Date: Tue, 22 Dec 92 14:17:54 MET
  6. Organization: WU-Wien
  7. Lines: 70
  8. Distribution: world
  9. Message-ID: <7250302748-326288@dec4.wu-wien.ac.at>
  10. NNTP-Posting-Host: dec4.wu-wien.ac.at
  11.  
  12. here is a new version of reduce which allows left and right assiciative
  13. reduction. it allows for example to evaluate
  14.  
  15.     9 op 5 op 3 op 1
  16.  
  17. as   yfx                or as  xfy
  18.  
  19.           op               op
  20.        op      1         9    op
  21.     op     3                5    op
  22.   9    5                       3    1   
  23.  
  24.  
  25. where the y stands fo the nested term, and the f for the function.
  26. if op == '-', the yfx term is avaluated to 0, and the xfy term to 6.
  27.  
  28.    
  29. sub reduce_op {
  30.     local($func,$op,@array) = @_;
  31.     local($a,$b,$c);
  32.  
  33.     return @array[$[] if $#array == 0;
  34.  
  35.     if ($op eq 'yfx') { 
  36.     $a = shift @array; 
  37.     $b = &reduce_op($func,$op,@array);
  38.     }
  39.     elsif ($op eq 'xfy') { 
  40.     $b = pop @array; 
  41.     $a = &reduce_op($func,$op,@array);
  42.     }
  43.     elsif ($op eq 'xfyfx') { 
  44.     $c = pop @array; 
  45.     $a = shift @array; 
  46.     $b = &reduce_op($func,$op,@array);
  47.     }
  48.  
  49.     return eval $func;
  50. }
  51.  
  52. # here are some more obvious examples. 
  53. # a and b are from left to right the operands in xfy or yfx
  54.  
  55. print &reduce_op('$a >  $b ? $a : $b','yfx',1,6,5,8,3,4),"\n";
  56. print &reduce_op('$a <  $b ? $a : $b','yfx',1,6,5,8,3,4),"\n";
  57. print &reduce_op('$a + $b','yfx',1,6,5,8,3,4),"\n";
  58. print &reduce_op('$a - $b','xfy',9,5,3,1),"\n";
  59. print &reduce_op('$a - $b','yfx',9,5,3,1),"\n";
  60.  
  61. #
  62. # the middle two are palindroms, the others remind me on towers of hanoi
  63.  
  64. print &reduce_op('"$a $b $a"','xfy',1..5),"\n";
  65. print &reduce_op('"$a $b $a"','yfx',1..5),"\n";
  66. print &reduce_op('"$b $a $b"','xfy',1..5),"\n";
  67. print &reduce_op('"$b $a $b"','yfx',1..5),"\n";
  68.  
  69. #
  70. # and finally ther Perl rap.
  71.  
  72. print &reduce_op('"$c $b $b $a $a\n"','xfyfx',
  73.          'Hacker','Perl','other','an','just'),"\n";
  74.  
  75. -gustaf
  76. --
  77. Gustaf Neumann          neumann@dec4.wu-wien.ac.at, neumann@awiwuw11.bitnet
  78. Vienna University of Economics and Business Administration 
  79. Augasse 2-6,  A-1090 Vienna, Austria        
  80. Tel: +43 (222) 31-336 x4533      Fax: 347-555
  81.  
  82.