home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume8 / qhwc < prev    next >
Text File  |  1989-10-01  |  13KB  |  382 lines

  1. Newsgroups: comp.sources.misc
  2. organization: NASA Ames Research Center, Calif.
  3. subject: v08i088: qhwc: a version of Kernighan/Pike's hoc(1) calculator for quaterions
  4. From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)
  5. Reply-To: eugene@eos.arc.nasa.gov
  6.  
  7. Posting-number: Volume 8, Issue 88
  8. Submitted-by: eugene@eos.arc.nasa.gov
  9. Archive-name: qhwc
  10.  
  11. Bill Burke, Lick Observatory, Astronomy/Physics Dept, UC Santa Cruz
  12. has asked me to post this.  Qhwc (silent Q, pronounced "hawk," for K/P's hoc
  13. calculator, yet another pun, and dedicated to physicist Stephen Hawking.)
  14. The code can be in the public domain, but he asks that users
  15. of quaterions send him a copy of papers on sample research areas
  16. they are using quaterions requiring this calcuator).  You can either mail
  17. directly to him (no email, but reachable at UCSC) or me.
  18.  
  19. He said to say, "Yes, some physicists do program using lex and yacc.
  20. And like Unix.  Way to go."
  21.  
  22. Another gross generalization from
  23.  
  24. --eugene miya, NASA Ames Research Center, eugene@aurora.arc.nasa.gov
  25.   resident cynic at the Rock of Ages Home for Retired Hackers:
  26.   "You trust the `reply' command with all those different mailers out there?"
  27.   "If my mail does not reach you, please accept my apology."
  28.   {ncar,decwrl,hplabs,uunet}!ames!eugene
  29.                   Live free or die.
  30.  
  31. --------snip here and run thru sh-----------
  32. echo x - Makefile
  33. sed 's/^X//' >Makefile <<'*-*-END-of-Makefile-*-*'
  34. XFILES= Makefile qhwc.c qhwc.l qhwc.y
  35. XOBJECTS= y.tab.o lex.yy.o qhwc.o
  36. XLIBES= -lm -ll
  37. XCFLAGS= -O
  38. X
  39. Xqhwk: $(OBJECTS)
  40. X    cc $(CFLAGS) $(OBJECTS) $(LIBES) -o qhwk
  41. X
  42. Xy.tab.c: qhwc.y
  43. X    yacc -d qhwc.y
  44. X
  45. Xlex.yy.c: qhwc.l
  46. X    lex qhwc.l
  47. X
  48. Xclean:
  49. X    rm *.o y.tab.[hc] lex.yy.c
  50. *-*-END-of-Makefile-*-*
  51. echo x - qhwc.c
  52. sed 's/^X//' >qhwc.c <<'*-*-END-of-qhwc.c-*-*'
  53. X#include <stdio.h>
  54. X#include <math.h>
  55. X
  56. Xtypedef struct 
  57. X{
  58. X  double real, imag, jmag, kmag;
  59. X} QRT;
  60. X
  61. X#include "y.tab.h"
  62. X
  63. Xdouble obj[8][4];
  64. Xint j;
  65. X
  66. Xint  main()
  67. X{
  68. X  double u;
  69. X
  70. X  printf("QHWC: William's Quaternionic Hand Calculator \n\n");
  71. X  printf("Last expression is H0, then H1, up to H7     \n");
  72. X  printf("Use h as a shorthand for H0, the previous one\n");
  73. X  printf("Operators: + - * % (u minus) (h*=CCG) exp |h| \n");
  74. X  printf("        pi if(,,) Re Pu (Re(h)+Pu(h)=h)      \n");
  75. X  printf("Enter expression to calculate (^D to quit):  \n\n");
  76. X  for ( j=0; j<8; ++j) {
  77. X  obj[j][0] = 0;
  78. X  obj[j][1] = 0;
  79. X  obj[j][2] = 0;
  80. X  obj[j][3] = 0;
  81. X  }
  82. X
  83. X  return (yyparse());
  84. X}
  85. *-*-END-of-qhwc.c-*-*
  86. echo x - qhwc.l
  87. sed 's/^X//' >qhwc.l <<'*-*-END-of-qhwc.l-*-*'
  88. X%{
  89. Xdouble pi=3.141592654;
  90. Xtypedef struct qrt
  91. X{
  92. X  double real, imag, jmag, kmag;
  93. X} QRT;
  94. X#include "y.tab.h"
  95. X
  96. Xdouble rbuff;
  97. X
  98. X%}
  99. X
  100. X%%
  101. X
  102. X[0-9]+(\.[0-9]+)?  {
  103. X                   sscanf(yytext,"%lf",&rbuff);
  104. X                   yylval.hval.real = rbuff;
  105. X                   yylval.hval.imag = 0;
  106. X                   yylval.hval.jmag = 0;
  107. X                   yylval.hval.kmag = 0;    
  108. X                   return H; 
  109. X                   }
  110. X[0-9]+(\.[0-9]+)?i {
  111. X                   yytext[yyleng-1] = '\0';
  112. X                   sscanf(yytext,"%lf",&rbuff);
  113. X                   yylval.hval.real = 0;
  114. X                   yylval.hval.imag = rbuff;
  115. X                   yylval.hval.jmag = 0;
  116. X                   yylval.hval.kmag = 0;    
  117. X                   return H;
  118. X                   }
  119. X[0-9]+(\.[0-9]+)?j {
  120. X                   yytext[yyleng-1] = '\0';
  121. X                   sscanf(yytext,"%lf",&rbuff);
  122. X                   yylval.hval.real = 0;
  123. X                   yylval.hval.imag = 0;
  124. X                   yylval.hval.jmag = rbuff;
  125. X                   yylval.hval.kmag = 0;    
  126. X                   return H;
  127. X                   }
  128. X[0-9]+(\.[0-9]+)?k {
  129. X                   yytext[yyleng-1] = '\0';
  130. X                   sscanf(yytext,"%lf",&rbuff);
  131. X                   yylval.hval.real = 0;
  132. X                   yylval.hval.imag = 0;
  133. X                   yylval.hval.jmag = 0;
  134. X                   yylval.hval.kmag = rbuff;    
  135. X                   return H;
  136. X                   }
  137. X[hH][0-7]          {     /* recalling previous from stack */
  138. X                   yylval.intval = (int) (yytext[1]-'0');
  139. X                   return OBJECT;
  140. X                   }
  141. Xh                  {
  142. X                   yylval.intval = 0;
  143. X                   return OBJECT;
  144. X                   }
  145. XRe                 {
  146. X                   return RE;
  147. X                   }
  148. X[sS][qQ][rR][tT]   {
  149. X                   return SQRT;
  150. X                   }
  151. X[sS][qQ]           {
  152. X                   return SQ;
  153. X                   }
  154. X[eE][xX][pP]       {
  155. X                   return EXP;
  156. X                   }
  157. X[iI][fF]           {
  158. X                   return IF;
  159. X                   }
  160. XPu                 {
  161. X                   return PU;
  162. X                   }
  163. X[pP][iI]           {
  164. X                   yylval.hval.real = pi;
  165. X                   yylval.hval.imag = 0;
  166. X                   yylval.hval.jmag = 0;
  167. X                   yylval.hval.kmag = 0;
  168. X                   return H;
  169. X                   }
  170. Xi                  {
  171. X                   yylval.hval.real = 0;
  172. X                   yylval.hval.imag = 1.0;
  173. X                   yylval.hval.jmag = 0;
  174. X                   yylval.hval.kmag = 0;
  175. X                   return H;
  176. X                   }
  177. Xj                  {
  178. X                   yylval.hval.real = 0;
  179. X                   yylval.hval.imag = 0;
  180. X                   yylval.hval.jmag = 1.0;
  181. X                   yylval.hval.kmag = 0;
  182. X                   return H;
  183. X                   }
  184. Xk                  {
  185. X                   yylval.hval.real = 0;
  186. X                   yylval.hval.imag = 0;
  187. X                   yylval.hval.jmag = 0;
  188. X                   yylval.hval.kmag = 1.0;
  189. X                   return H;
  190. X                   }
  191. X[-()|+/*,\n]       return *yytext;
  192. X[ \t]+               ;
  193. X.                  {yyerror("Unrecognized input: %s\n",yytext);}
  194. X
  195. X%%
  196. X
  197. *-*-END-of-qhwc.l-*-*
  198. echo x - qhwc.y
  199. sed 's/^X//' >qhwc.y <<'*-*-END-of-qhwc.y-*-*'
  200. X%{
  201. X
  202. X#include <math.h>
  203. X
  204. Xtypedef struct qrt
  205. X{
  206. X  double real, imag, jmag, kmag;
  207. X} QRT;
  208. X
  209. Xdouble sqrt(), sin(), cos(), exp();
  210. Xdouble x,r,rsqd,theta;
  211. XQRT hh, hhh, hcc;
  212. Xextern double obj[8][4];
  213. Xextern double pi;
  214. Xint i;
  215. X
  216. X%}
  217. X
  218. X%union {
  219. X    int intval;
  220. X        double realval;
  221. X        QRT hval;
  222. X        }
  223. X
  224. X%token <hval> H
  225. X%token <intval>  OBJECT
  226. X%left '+' '-'
  227. X%left '*' '/'
  228. X%right SQ SQRT EXP IF
  229. X%right RE PU
  230. X%left UMINUS CCG
  231. X
  232. X%type <hval> expression program
  233. X
  234. X%%
  235. X
  236. Xprogram:
  237. X    program expression '\n'    = { printf("%lf + %lfi + %lfj + %lfk \n",
  238. X                                      $2.real, $2.imag, $2.jmag, $2.kmag);
  239. X                                    for ( i=7; i>0; --i) {
  240. X                                      obj[i][0] = obj[i-1][0];
  241. X                                      obj[i][1] = obj[i-1][1];
  242. X                                      obj[i][2] = obj[i-1][2];
  243. X                                      obj[i][3] = obj[i-1][3];
  244. X                                    }
  245. X                                    obj[0][0] = $2.real;
  246. X                                    obj[0][1] = $2.imag;
  247. X                                    obj[0][2] = $2.jmag;
  248. X                                    obj[0][3] = $2.kmag;
  249. X                                  }
  250. X|       program error '\n'      = { yyerrok; }
  251. X|    /* NULL */              = {}
  252. X;
  253. X
  254. Xexpression:
  255. X    H                               = {  $$.real = $1.real;
  256. X                                             $$.imag = $1.imag;
  257. X                                             $$.jmag = $1.jmag;
  258. X                                             $$.kmag = $1.kmag;
  259. X                                          }
  260. X|       OBJECT                          = {  $$.real = obj[$1][0];
  261. X                                             $$.imag = obj[$1][1];
  262. X                                             $$.jmag = obj[$1][2];
  263. X                                             $$.kmag = obj[$1][3];
  264. X                                          }
  265. X|    expression '+' expression    = {  $$.real = $1.real + $3.real;
  266. X                                             $$.imag = $1.imag + $3.imag;
  267. X                                             $$.jmag = $1.jmag + $3.jmag;
  268. X                                             $$.kmag = $1.kmag + $3.kmag;
  269. X                                          }
  270. X|    expression '-' expression    = {  $$.real = $1.real - $3.real;
  271. X                                             $$.imag = $1.imag - $3.imag;
  272. X                                             $$.jmag = $1.jmag - $3.jmag;
  273. X                                             $$.kmag = $1.kmag - $3.kmag;
  274. X                                          }
  275. X|    expression '*' expression    = {  
  276. X                                            Multiply(&$1,&$3,&$$);
  277. X                                          }
  278. X|       expression '/' expression =       {
  279. X                                            Conjugate(&$3,&hcc);
  280. X                                            Multiply(&$3,&hcc,&hh);
  281. X                                            hh.real = 1/(hh.real);
  282. X                                            Multiply(&$1,&hcc,&hhh);
  283. X                                            Multiply(&hh,&hhh,&$$);
  284. X                                          }
  285. X|   RE expression                       = {  $$.real = $2.real;
  286. X                                             $$.imag = 0;
  287. X                                             $$.jmag = 0;
  288. X                                             $$.kmag = 0;
  289. X                                          }
  290. X|   PU expression                       = {  $$.real = 0;
  291. X                                             $$.imag = $2.imag;
  292. X                                             $$.jmag = $2.jmag;
  293. X                                             $$.kmag = $2.kmag;
  294. X                                          }
  295. X|   EXP '('  expression ')' = { 
  296. X    r = sqrt($3.imag*$3.imag+$3.jmag*$3.jmag+$3.kmag*$3.kmag);
  297. X    if ( r > 0.0) {
  298. X    $$.real = exp($3.real)*cos(r);
  299. X    $$.imag = exp($3.real)*sin(r)*$3.imag/r;
  300. X    $$.jmag = exp($3.real)*sin(r)*$3.jmag/r;
  301. X    $$.kmag = exp($3.real)*sin(r)*$3.kmag/r;
  302. X    } else {
  303. X    $$.real = exp($3.real);
  304. X    $$.imag = 0.0;
  305. X    $$.jmag = 0.0;
  306. X    $$.kmag = 0.0;
  307. X    }
  308. X  }
  309. X|   IF '(' expression ',' expression',' expression ')' = {
  310. X                               if ( $3.real > 0) {
  311. X                                 $$.real = $5.real;
  312. X                                 $$.imag = $5.imag;
  313. X                                 $$.jmag = $5.jmag;
  314. X                                 $$.kmag = $5.kmag;
  315. X                               }
  316. X                               else {
  317. X                                 $$.real = $7.real;
  318. X                                 $$.imag = $7.imag;
  319. X                                 $$.jmag = $7.jmag;
  320. X                                 $$.kmag = $7.kmag;
  321. X                               }
  322. X                              }
  323. X|   '-' expression  %prec UMINUS        = {  $$.real = -$2.real;
  324. X                                             $$.imag = -$2.imag;
  325. X                                             $$.jmag = -$2.jmag;
  326. X                                             $$.kmag = -$2.kmag;
  327. X                                          }
  328. X|    expression '*'   %prec CCG         = {  $$.real =  $1.real;
  329. X                                             $$.imag = -$1.imag;
  330. X                                             $$.jmag = -$1.jmag;
  331. X                                             $$.kmag = -$1.kmag;
  332. X                                          }
  333. X|    '(' expression ')'            = {  $$.real = $2.real;
  334. X                                             $$.imag = $2.imag;
  335. X                                             $$.jmag = $2.jmag;
  336. X                                             $$.kmag = $2.kmag;
  337. X                                          }
  338. X|    '|' expression '|'            = {   
  339. X                                             Conjugate(&$2,&hcc);
  340. X                                             Multiply(&$2,&hcc,&hh);
  341. X                                             $$.real = sqrt(hh.real);
  342. X                                             $$.imag = 0;
  343. X                                             $$.jmag = 0;
  344. X                                             $$.kmag = 0;
  345. X                                          }
  346. X;
  347. X
  348. X%%
  349. X
  350. X
  351. Xvoid Multiply (hh1, hh2, hh3)
  352. XQRT *hh1, *hh2, *hh3;
  353. X{
  354. X  hh3->real = hh1->real * hh2->real - hh1->imag * hh2->imag
  355. X            -hh1->jmag * hh2->jmag - hh1->kmag * hh2->kmag;
  356. X  hh3->imag = hh1->real * hh2->imag + hh1->imag * hh2->real
  357. X            +hh1->jmag * hh2->kmag - hh1->kmag * hh2->jmag;
  358. X  hh3->jmag = hh1->real * hh2->jmag + hh1->jmag * hh2->real
  359. X            +hh1->kmag * hh2->imag - hh1->imag * hh2->kmag;
  360. X  hh3->kmag = hh1->real * hh2->kmag + hh1->kmag * hh2->real
  361. X            +hh1->imag * hh2->jmag - hh1->jmag * hh2->imag;
  362. X}
  363. X
  364. Xvoid Conjugate (hh1, hh2)
  365. XQRT *hh1, *hh2;
  366. X{
  367. X  hh2->real =  hh1->real;
  368. X  hh2->imag = -hh1->imag;
  369. X  hh2->jmag = -hh1->jmag;
  370. X  hh2->kmag = -hh1->kmag;
  371. X}
  372. X
  373. Xyyerror(s)
  374. Xchar *s;
  375. X{
  376. X    printf("%s\n",s);
  377. X}
  378. *-*-END-of-qhwc.y-*-*
  379. exit
  380.  
  381.  
  382.