Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/compsrcs/misc/volume08/qhwc

Internet Message Format | 1991-08-27 | 13.1 KB

From decwrl!ucbvax!ucsd!swrinde!cs.utexas.edu!uunet!allbery Sun Oct  1 15:40:14 PDT 1989
Article 1132 of comp.sources.misc:
Path: decwrl!ucbvax!ucsd!swrinde!cs.utexas.edu!uunet!allbery
From: [e-mail] (Brandon S. Allbery - comp.sources.misc)
Newsgroups: comp.sources.misc
Subject: v08i088: qhwc: a version of Kernighan/Pike's hoc(1) calculator for quaterions
Message-ID: <[e-mail]>
Date: 1 Oct 89 14:48:55 GMT
Sender: [e-mail]
Reply-To: [e-mail]
Organization: NASA Ames Research Center, Calif.
Lines: 373
Approved: [e-mail] (Brandon S. Allbery - comp.sources.misc)

Posting-number: Volume 8, Issue 88
Submitted-by: [e-mail]
Archive-name: qhwc

Bill Burke, Lick Observatory, Astronomy/Physics Dept, UC Santa Cruz
has asked me to post this.  Qhwc (silent Q, pronounced "hawk," for K/P's hoc
calculator, yet another pun, and dedicated to physicist Stephen Hawking.)
The code can be in the public domain, but he asks that users
of quaterions send him a copy of papers on sample research areas
they are using quaterions requiring this calcuator).  You can either mail
directly to him (no email, but reachable at UCSC) or me.

He said to say, "Yes, some physicists do program using lex and yacc.
And like Unix.  Way to go."

Another gross generalization from

--eugene miya, NASA Ames Research Center, [e-mail]
  resident cynic at the Rock of Ages Home for Retired Hackers:
  "You trust the `reply' command with all those different mailers out there?"
  "If my mail does not reach you, please accept my apology."
  {ncar,decwrl,hplabs,uunet}!ames!eugene
                  Live free or die.

--------snip here and run thru sh-----------
echo x - Makefile
sed 's/^X//' >Makefile <<'*-*-END-of-Makefile-*-*'
XFILES= Makefile qhwc.c qhwc.l qhwc.y
XOBJECTS= y.tab.o lex.yy.o qhwc.o
XLIBES= -lm -ll
XCFLAGS= -O
X
Xqhwk: $(OBJECTS)
X    cc $(CFLAGS) $(OBJECTS) $(LIBES) -o qhwk
X
Xy.tab.c: qhwc.y
X    yacc -d qhwc.y
X
Xlex.yy.c: qhwc.l
X    lex qhwc.l
X
Xclean:
X    rm *.o y.tab.[hc] lex.yy.c
*-*-END-of-Makefile-*-*
echo x - qhwc.c
sed 's/^X//' >qhwc.c <<'*-*-END-of-qhwc.c-*-*'
X#include <stdio.h>
X#include <math.h>
X
Xtypedef struct
X{
X  double real, imag, jmag, kmag;
X} QRT;
X
X#include "y.tab.h"
X
Xdouble obj[8][4];
Xint j;
X
Xint  main()
X{
X  double u;
X
X  printf("QHWC: William's Quaternionic Hand Calculator \n\n");
X  printf("Last expression is H0, then H1, up to H7     \n");
X  printf("Use h as a shorthand for H0, the previous one\n");
X  printf("Operators: + - * % (u minus) (h*=CCG) exp |h| \n");
X  printf("        pi if(,,) Re Pu (Re(h)+Pu(h)=h)      \n");
X  printf("Enter expression to calculate (^D to quit):  \n\n");
X  for ( j=0; j<8; ++j) {
X  obj[j][0] = 0;
X  obj[j][1] = 0;
X  obj[j][2] = 0;
X  obj[j][3] = 0;
X  }
X
X  return (yyparse());
X}
*-*-END-of-qhwc.c-*-*
echo x - qhwc.l
sed 's/^X//' >qhwc.l <<'*-*-END-of-qhwc.l-*-*'
X%{
Xdouble pi=3.141592654;
Xtypedef struct qrt
X{
X  double real, imag, jmag, kmag;
X} QRT;
X#include "y.tab.h"
X
Xdouble rbuff;
X
X%}
X
X%%
X
X[0-9]+(\.[0-9]+)?  {
X                   sscanf(yytext,"%lf",&rbuff);
X                   yylval.hval.real = rbuff;
X                   yylval.hval.imag = 0;
X                   yylval.hval.jmag = 0;
X                   yylval.hval.kmag = 0;
X                   return H;
X                   }
X[0-9]+(\.[0-9]+)?i {
X                   yytext[yyleng-1] = '\0';
X                   sscanf(yytext,"%lf",&rbuff);
X                   yylval.hval.real = 0;
X                   yylval.hval.imag = rbuff;
X                   yylval.hval.jmag = 0;
X                   yylval.hval.kmag = 0;
X                   return H;
X                   }
X[0-9]+(\.[0-9]+)?j {
X                   yytext[yyleng-1] = '\0';
X                   sscanf(yytext,"%lf",&rbuff);
X                   yylval.hval.real = 0;
X                   yylval.hval.imag = 0;
X                   yylval.hval.jmag = rbuff;
X                   yylval.hval.kmag = 0;
X                   return H;
X                   }
X[0-9]+(\.[0-9]+)?k {
X                   yytext[yyleng-1] = '\0';
X                   sscanf(yytext,"%lf",&rbuff);
X                   yylval.hval.real = 0;
X                   yylval.hval.imag = 0;
X                   yylval.hval.jmag = 0;
X                   yylval.hval.kmag = rbuff;
X                   return H;
X                   }
X[hH][0-7]          {     /* recalling previous from stack */
X                   yylval.intval = (int) (yytext[1]-'0');
X                   return OBJECT;
X                   }
Xh                  {
X                   yylval.intval = 0;
X                   return OBJECT;
X                   }
XRe                 {
X                   return RE;
X                   }
X[sS][qQ][rR][tT]   {
X                   return SQRT;
X                   }
X[sS][qQ]           {
X                   return SQ;
X                   }
X[eE][xX][pP]       {
X                   return EXP;
X                   }
X[iI][fF]           {
X                   return IF;
X                   }
XPu                 {
X                   return PU;
X                   }
X[pP][iI]           {
X                   yylval.hval.real = pi;
X                   yylval.hval.imag = 0;
X                   yylval.hval.jmag = 0;
X                   yylval.hval.kmag = 0;
X                   return H;
X                   }
Xi                  {
X                   yylval.hval.real = 0;
X                   yylval.hval.imag = 1.0;
X                   yylval.hval.jmag = 0;
X                   yylval.hval.kmag = 0;
X                   return H;
X                   }
Xj                  {
X                   yylval.hval.real = 0;
X                   yylval.hval.imag = 0;
X                   yylval.hval.jmag = 1.0;
X                   yylval.hval.kmag = 0;
X                   return H;
X                   }
Xk                  {
X                   yylval.hval.real = 0;
X                   yylval.hval.imag = 0;
X                   yylval.hval.jmag = 0;
X                   yylval.hval.kmag = 1.0;
X                   return H;
X                   }
X[-()|+/*,\n]       return *yytext;
X[ \t]+               ;
X.                  {yyerror("Unrecognized input: %s\n",yytext);}
X
X%%
X
*-*-END-of-qhwc.l-*-*
echo x - qhwc.y
sed 's/^X//' >qhwc.y <<'*-*-END-of-qhwc.y-*-*'
X%{
X
X#include <math.h>
X
Xtypedef struct qrt
X{
X  double real, imag, jmag, kmag;
X} QRT;
X
Xdouble sqrt(), sin(), cos(), exp();
Xdouble x,r,rsqd,theta;
XQRT hh, hhh, hcc;
Xextern double obj[8][4];
Xextern double pi;
Xint i;
X
X%}
X
X%union {
X    int intval;
X        double realval;
X        QRT hval;
X        }
X
X%token <hval> H
X%token <intval>  OBJECT
X%left '+' '-'
X%left '*' '/'
X%right SQ SQRT EXP IF
X%right RE PU
X%left UMINUS CCG
X
X%type <hval> expression program
X
X%%
X
Xprogram:
X    program expression '\n'    = { printf("%lf + %lfi + %lfj + %lfk \n",
X                                      $2.real, $2.imag, $2.jmag, $2.kmag);
X                                    for ( i=7; i>0; --i) {
X                                      obj[i][0] = obj[i-1][0];
X                                      obj[i][1] = obj[i-1][1];
X                                      obj[i][2] = obj[i-1][2];
X                                      obj[i][3] = obj[i-1][3];
X                                    }
X                                    obj[0][0] = $2.real;
X                                    obj[0][1] = $2.imag;
X                                    obj[0][2] = $2.jmag;
X                                    obj[0][3] = $2.kmag;
X                                  }
X|       program error '\n'      = { yyerrok; }
X|    /* NULL */              = {}
X;
X
Xexpression:
X    H                               = {  $$.real = $1.real;
X                                             $$.imag = $1.imag;
X                                             $$.jmag = $1.jmag;
X                                             $$.kmag = $1.kmag;
X                                          }
X|       OBJECT                          = {  $$.real = obj[$1][0];
X                                             $$.imag = obj[$1][1];
X                                             $$.jmag = obj[$1][2];
X                                             $$.kmag = obj[$1][3];
X                                          }
X|    expression '+' expression    = {  $$.real = $1.real + $3.real;
X                                             $$.imag = $1.imag + $3.imag;
X                                             $$.jmag = $1.jmag + $3.jmag;
X                                             $$.kmag = $1.kmag + $3.kmag;
X                                          }
X|    expression '-' expression    = {  $$.real = $1.real - $3.real;
X                                             $$.imag = $1.imag - $3.imag;
X                                             $$.jmag = $1.jmag - $3.jmag;
X                                             $$.kmag = $1.kmag - $3.kmag;
X                                          }
X|    expression '*' expression    = {
X                                            Multiply(&$1,&$3,&$$);
X                                          }
X|       expression '/' expression =       {
X                                            Conjugate(&$3,&hcc);
X                                            Multiply(&$3,&hcc,&hh);
X                                            hh.real = 1/(hh.real);
X                                            Multiply(&$1,&hcc,&hhh);
X                                            Multiply(&hh,&hhh,&$$);
X                                          }
X|   RE expression                       = {  $$.real = $2.real;
X                                             $$.imag = 0;
X                                             $$.jmag = 0;
X                                             $$.kmag = 0;
X                                          }
X|   PU expression                       = {  $$.real = 0;
X                                             $$.imag = $2.imag;
X                                             $$.jmag = $2.jmag;
X                                             $$.kmag = $2.kmag;
X                                          }
X|   EXP '('  expression ')' = {
X    r = sqrt($3.imag*$3.imag+$3.jmag*$3.jmag+$3.kmag*$3.kmag);
X    if ( r > 0.0) {
X    $$.real = exp($3.real)*cos(r);
X    $$.imag = exp($3.real)*sin(r)*$3.imag/r;
X    $$.jmag = exp($3.real)*sin(r)*$3.jmag/r;
X    $$.kmag = exp($3.real)*sin(r)*$3.kmag/r;
X    } else {
X    $$.real = exp($3.real);
X    $$.imag = 0.0;
X    $$.jmag = 0.0;
X    $$.kmag = 0.0;
X    }
X  }
X|   IF '(' expression ',' expression',' expression ')' = {
X                               if ( $3.real > 0) {
X                                 $$.real = $5.real;
X                                 $$.imag = $5.imag;
X                                 $$.jmag = $5.jmag;
X                                 $$.kmag = $5.kmag;
X                               }
X                               else {
X                                 $$.real = $7.real;
X                                 $$.imag = $7.imag;
X                                 $$.jmag = $7.jmag;
X                                 $$.kmag = $7.kmag;
X                               }
X                              }
X|   '-' expression  %prec UMINUS        = {  $$.real = -$2.real;
X                                             $$.imag = -$2.imag;
X                                             $$.jmag = -$2.jmag;
X                                             $$.kmag = -$2.kmag;
X                                          }
X|    expression '*'   %prec CCG         = {  $$.real =  $1.real;
X                                             $$.imag = -$1.imag;
X                                             $$.jmag = -$1.jmag;
X                                             $$.kmag = -$1.kmag;
X                                          }
X|    '(' expression ')'            = {  $$.real = $2.real;
X                                             $$.imag = $2.imag;
X                                             $$.jmag = $2.jmag;
X                                             $$.kmag = $2.kmag;
X                                          }
X|    '|' expression '|'            = {
X                                             Conjugate(&$2,&hcc);
X                                             Multiply(&$2,&hcc,&hh);
X                                             $$.real = sqrt(hh.real);
X                                             $$.imag = 0;
X                                             $$.jmag = 0;
X                                             $$.kmag = 0;
X                                          }
X;
X
X%%
X
X
Xvoid Multiply (hh1, hh2, hh3)
XQRT *hh1, *hh2, *hh3;
X{
X  hh3->real = hh1->real * hh2->real - hh1->imag * hh2->imag
X            -hh1->jmag * hh2->jmag - hh1->kmag * hh2->kmag;
X  hh3->imag = hh1->real * hh2->imag + hh1->imag * hh2->real
X            +hh1->jmag * hh2->kmag - hh1->kmag * hh2->jmag;
X  hh3->jmag = hh1->real * hh2->jmag + hh1->jmag * hh2->real
X            +hh1->kmag * hh2->imag - hh1->imag * hh2->kmag;
X  hh3->kmag = hh1->real * hh2->kmag + hh1->kmag * hh2->real
X            +hh1->imag * hh2->jmag - hh1->jmag * hh2->imag;
X}
X
Xvoid Conjugate (hh1, hh2)
XQRT *hh1, *hh2;
X{
X  hh2->real =  hh1->real;
X  hh2->imag = -hh1->imag;
X  hh2->jmag = -hh1->jmag;
X  hh2->kmag = -hh1->kmag;
X}
X
Xyyerror(s)
Xchar *s;
X{
X    printf("%s\n",s);
X}
*-*-END-of-qhwc.y-*-*
exit