home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume28 / backprop / part04 < prev    next >
Encoding:
Text File  |  1992-02-22  |  44.5 KB  |  1,698 lines
  1. Newsgroups: comp.sources.misc
  2. From: drt@chinet.chi.il.us (Donald Tveter)
  3. Subject:  v28i066:  backprop - Fast Backpropagation, Part04/04
  4. Message-ID: <1992Feb24.031334.10128@sparky.imd.sterling.com>
  5. X-Md4-Signature: 9ca051c62a16f87a6a3b3ca969630bb2
  6. Date: Mon, 24 Feb 1992 03:13:34 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: drt@chinet.chi.il.us (Donald Tveter)
  10. Posting-number: Volume 28, Issue 66
  11. Archive-name: backprop/part04
  12. Environment: UNIX, DOS
  13. Supersedes: back-prop: Volume 22, Issue 73-76
  14.  
  15. #! /bin/sh
  16. # This is a shell archive.  Remove anything before this line, then unpack
  17. # it by saving it into a file and typing "sh file".  To overwrite existing
  18. # files, type "sh file -c".  You can also feed this as standard input via
  19. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  20. # will see the following message at the end:
  21. #        "End of archive 4 (of 4)."
  22. # Contents:  int.c real.c misc.c
  23. # Wrapped by drt@chinet on Tue Feb 18 10:24:02 1992
  24. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  25. if test -f 'int.c' -a "${1}" != "-c" ; then 
  26.   echo shar: Will not clobber existing file \"'int.c'\"
  27. else
  28. echo shar: Extracting \"'int.c'\" \(14360 characters\)
  29. sed "s/^X//" >'int.c' <<'END_OF_FILE'
  30. X/* *********************************************************** */
  31. X/* file int.c:  Contains the network evaluation and weight     */
  32. X/*              adjustment procedures for the integer versions */
  33. X/*              bp and sbp.                                    */
  34. X/*                                                             */
  35. X/* Copyright (c) 1991 by Donald R. Tveter                      */
  36. X/*                                                             */
  37. X/* The code here has been optimized for use with the Motorola  */
  38. X/* MC 68010 processor and version 3.5 of the UNIX (tm) PC      */
  39. X/* C compiler where UNIX is a trademark of Bell Laboratories.  */
  40. X/* *********************************************************** */
  41. X
  42. X#include "ibp.h"
  43. X#include <stdio.h>
  44. X
  45. Xextern char activation, backprop, deriv, wtlimithit;
  46. Xextern WTTYPE alpha, D, decay, eta, eta2, etamax, kappa, noise;
  47. Xextern WTTYPE theta1, theta2, toler;
  48. Xextern LAYER *last, *start;
  49. Xextern INT32 totaldiff;
  50. X
  51. Xvoid forward()             /* computes unit activations */
  52. X{ 
  53. Xregister INT32 sum, x, intpart;
  54. Xregister WTNODE *w;
  55. Xregister UNIT *u, *predu;
  56. XLAYER *layer;
  57. Xregister short fract, val;
  58. X
  59. Xlayer = start->next;
  60. Xwhile (layer != NULL)
  61. X {
  62. X  u = (UNIT *) layer->units;
  63. X  while (u != NULL)
  64. X   {
  65. X    sum = 0;
  66. X    w = (WTNODE *) u->wtlist;
  67. X    while (w != NULL)
  68. X     {
  69. X      predu = (UNIT *) w->backunit;
  70. X#ifdef SMART
  71. X#   ifdef SYMMETRIC
  72. X      sum = sum + (INT32) *(w->weight) * predu->oj / 1024;
  73. X#   else
  74. X      sum = sum + (INT32) w->weight * predu->oj / 1024;
  75. X#   endif
  76. X#else
  77. X#   ifdef SYMMETRIC
  78. X      x = (INT32) *(w->weight) * predu->oj;
  79. X#   else
  80. X      x = (INT32) w->weight * predu->oj;
  81. X#   endif
  82. X      if (x >= 0) sum = sum + (x >> 10); else sum = sum - ( (-x) >> 10);
  83. X#endif
  84. X      w = w->next;
  85. X     };
  86. X    sum = (INT32) D * sum / 1024;
  87. X    if (activation == 'p' || activation == 't')
  88. X     {
  89. X      if (sum > 0) x = sum; else x = -sum;
  90. X      intpart = x >> 10;
  91. X      fract = x & 01777;
  92. X      switch (intpart) {
  93. Xcase 0:  val = 512 + (((INT32) 237 * fract) >> 10);       /* 0 <= x < 1 */
  94. X         break;
  95. Xcase 1:  val = 748 + (((INT32) 153 * fract) >> 10);       /* 1 <= x < 2 */
  96. X         break;
  97. Xcase 2:  val = 901 + (((INT32) 73 * fract) >> 10);        /* 2 <= x < 3 */
  98. X         break;
  99. Xcase 3:
  100. Xcase 4:  val = 976 + (((INT32) (x - 3072) * 20) >> 10);   /* 3 <= x < 5 */
  101. X         break;
  102. Xdefault: val = 1024;                                      /* x >= 5 */ };
  103. X         if (sum < 0) u->oj = 1024 - val; else u->oj = val;
  104. X         if (activation == 't') u->oj = (u->oj - 512) * 2;
  105. X     }
  106. X    else if (activation == 'l') u->oj = sum;
  107. X    u = u->next;
  108. X   };
  109. X    layer = layer->next;
  110. X   };
  111. X}
  112. X
  113. Xshort backoutput()  /* computes weight changes from the output layer */
  114. X{
  115. Xregister short deltaj, temp2, temp3;
  116. Xregister INT32 temp;
  117. Xregister UNIT *bunit, *u;
  118. Xregister WTNODE *w;
  119. Xregister short adiff, notclose;
  120. X
  121. Xnotclose = last->unitcount;
  122. Xu = (UNIT *) last->units;
  123. Xwhile (u != NULL)
  124. X { 
  125. X  temp3 = u->oj;
  126. X  temp2 = u->tj - temp3;
  127. X  if (temp2 > 0) adiff = temp2; else adiff = -temp2;
  128. X  if (adiff < toler) notclose = notclose - 1;
  129. X  totaldiff = totaldiff + adiff;
  130. X  if (adiff >= toler || backprop)  /* then compute errors */
  131. X   {
  132. X    if (deriv == 'd') /* diff. step size method */
  133. X       deltaj = temp2;
  134. X    else if (deriv == 'f' || deriv == 'F') /* Fahlman's derivative */
  135. X     {
  136. X      if (activation == 't') temp3 = temp3 / 2 + 512;
  137. X      temp = (INT32) temp2 * ((INT32) 104448 + (INT32) temp3 * ((short)(1024 - temp3)));
  138. X      if (temp > 0) deltaj = (INT32) (temp + 524288) >> 20;
  139. X      else deltaj = -((INT32) (524288 - temp) >> 20);
  140. X     }
  141. X    else /* the derivative in the original formula */
  142. X     {
  143. X      if (activation == 't') temp3 = temp3 / 2 + 512;
  144. X      temp = (INT32) temp2 * ((INT32) temp3 * ((short)(1024 - temp3)));
  145. X      if (temp > 0) deltaj = (INT32) (temp + 524288) >> 20;
  146. X      else deltaj = -((INT32) (524288 - temp) >> 20);
  147. X     }
  148. X    w = (WTNODE *) u->wtlist;
  149. X#ifdef SYMMETRIC
  150. X    while (w->next != NULL)  /* skips threshold unit at end */
  151. X#else
  152. X    while (w != NULL)
  153. X#endif
  154. X     {
  155. X      bunit = (UNIT *) w->backunit;
  156. X#ifdef SYMMETRIC
  157. X      *(w->total) = *(w->total) + (INT32) deltaj * bunit->oj;
  158. X#else
  159. X      w->total = w->total + (INT32) deltaj * bunit->oj;
  160. X      if (bunit->layernumber > 1)
  161. X         bunit->error = bunit->error + (INT32) deltaj * w->weight;
  162. X#endif
  163. X      w = w->next;
  164. X     }
  165. X   };
  166. X  u = u->next;
  167. X };
  168. Xreturn(notclose);
  169. X}
  170. X
  171. X#ifndef SYMMETRIC
  172. X
  173. Xvoid backinner()             /* Computes slopes and passes back */
  174. X{                            /* errors from hidden layers.      */
  175. Xregister short deltaj, temp3;
  176. Xregister INT32 temp;
  177. Xregister UNIT *bunit, *u;
  178. Xregister WTNODE *w;
  179. XLAYER *layer;
  180. X
  181. Xlayer = last->backlayer;
  182. Xwhile (layer->backlayer != NULL)
  183. X {
  184. X  u = (UNIT *) layer->units;
  185. X  while (u != NULL)
  186. X   {
  187. X    if (activation == 't') temp3 = u->oj / 2 + 512; else temp3 = u->oj;
  188. X    if (deriv == 'f') /* Fahlman's derivative */
  189. X       temp = (INT32) (((short)(((INT32) temp3*((short)(1024-temp3))+512) >> 10))
  190. X              + 102) * u->error;
  191. X    else /* either for the original or diff. step size */
  192. X       temp = (INT32) ((short)(((INT32) temp3*((short)(1024-temp3))+512) >> 10))
  193. X          * u->error;
  194. X    if (temp > 0) deltaj = (INT32) (temp + 524288) >> 20;
  195. X    else deltaj = -((INT32) (524288 - temp) >> 20);
  196. X    w = (WTNODE *) u->wtlist;
  197. X    while (w != NULL)
  198. X     {
  199. X      bunit = (UNIT *) w->backunit;
  200. X      w->total = w->total + (INT32) deltaj * bunit->oj;
  201. X      if (bunit->layernumber > 1)
  202. X         bunit->error = bunit->error + (INT32) deltaj * w->weight;
  203. X      w = w->next;
  204. X     };
  205. X    u = u->next;
  206. X   };
  207. X  layer = layer->backlayer;
  208. X };
  209. X}
  210. X
  211. X#endif
  212. X
  213. X#ifdef SYMMETRIC
  214. Xvoid dbd_update() {pg("symmetric dbd update no longer supported\n");}
  215. X#else
  216. Xvoid dbd_update() /* the delta-bar-delta method for weight updates */
  217. X{
  218. Xregister short rkappa, temp2, dbarm1, rdecay;
  219. Xregister INT32 temp;
  220. Xregister UNIT *u;
  221. Xregister WTNODE *w;
  222. XLAYER *layer;
  223. X
  224. X/* w->olddw is used for delta-bar minus 1 */
  225. X
  226. Xrkappa = kappa;
  227. Xrdecay = decay;
  228. Xlayer = last;
  229. Xwhile (layer->backlayer != NULL)
  230. X {
  231. X  u = (UNIT *) layer->units;
  232. X  while (u != NULL)
  233. X   {
  234. X    w = (WTNODE *) u->wtlist;
  235. X    while (w != NULL)
  236. X     {
  237. X      if (w->total > 0) temp2 = (INT32) (w->total + 512) >> 10;
  238. X      else temp2 = -((INT32) (512 - w->total) >> 10);
  239. X      dbarm1 = w->olddw;
  240. X      temp = (INT32) theta2 * temp2 + (INT32) theta1 * dbarm1;
  241. X      if (temp > 0) w->olddw = (INT32) (temp + 512) >> 10;
  242. X      else w->olddw = -((INT32) (512 - temp) >> 10);
  243. X      if (temp2 > 0 && dbarm1 > 0) w->eta = w->eta + rkappa;
  244. X      else if (temp2 < 0 && dbarm1 < 0) w->eta = w->eta + rkappa;
  245. X      else if (temp2 > 0 && dbarm1 < 0)w->eta = ((INT32) w->eta * rdecay) >> 10;
  246. X      else if (temp2 < 0 && dbarm1 > 0)w->eta = ((INT32) w->eta * rdecay) >> 10;
  247. X      if (w->eta > etamax) w->eta = etamax;
  248. X      temp = (INT32) temp2 * w->eta;
  249. X      if (temp > 0) temp2 = (INT32) (temp + 512) >> 10;
  250. X      else if (temp < 0) temp2 = -((INT32) (512 - temp) >> 10);
  251. X
  252. X      else if (w->slope == 0)
  253. X         {if (w->total < 0) temp2 = noise; else temp2 = -noise;}
  254. X      w->slope = temp2;
  255. X
  256. X      temp = (INT32) w->weight + temp2;
  257. X      if (temp > MAXSHORT)
  258. X       {
  259. X        wtlimithit = 1;
  260. X        w->weight = MAXSHORT;
  261. X       }
  262. X      else if (temp < MINSHORT)
  263. X       {
  264. X        wtlimithit = 1;
  265. X        w->weight = MINSHORT;
  266. X       }
  267. X      else w->weight = temp;
  268. X      w = w->next;
  269. X     };
  270. X    u = u->next;
  271. X   };
  272. X  layer = layer->backlayer;
  273. X };
  274. X}
  275. X#endif
  276. X
  277. Xvoid periodic_update()   /* update weights for the original method */
  278. X{                        /* and the differential step size algorithm */
  279. Xregister short reta, ralpha;
  280. Xregister INT32 temp;
  281. Xregister short temp2;
  282. Xregister UNIT *u;
  283. Xregister WTNODE *w;
  284. XLAYER *layer;
  285. X
  286. Xralpha = alpha;
  287. Xlayer = last;
  288. Xwhile (layer->backlayer != NULL)
  289. X {
  290. X  if (layer == last) reta = eta; else reta = eta2;
  291. X  u = (UNIT *) layer->units;
  292. X  while (u != NULL)
  293. X   {
  294. X    w = (WTNODE *) u->wtlist;
  295. X    while (w != NULL)
  296. X     {
  297. X#ifdef SYMMETRIC
  298. X      if (((UNIT *) w->backunit)->unitnumber > u->unitnumber)
  299. X       {
  300. X        if (*(w->total) > 0) temp = (INT32) ((INT32)(*(w->total) + 512) >> 10) * reta 
  301. X           + (INT32) ralpha * *(w->olddw);
  302. X        else temp = (INT32) -(((INT32) 512 - *(w->total)) >> 10) * reta
  303. X           + (INT32) ralpha * *(w->olddw);
  304. X        if (temp > 0) temp2 = (INT32) (temp + 512) >> 10;
  305. X        else temp2 = -(((INT32) 512 - temp) >> 10);
  306. X        *(w->olddw) = temp2;
  307. X        temp = (INT32) *(w->weight) + temp2;
  308. X        if (temp > MAXSHORT)
  309. X         {
  310. X          wtlimithit = 1;
  311. X          *(w->weight) = MAXSHORT;
  312. X         }
  313. X        else if (temp < MINSHORT)
  314. X         {
  315. X          wtlimithit = 1;
  316. X          *(w->weight) = MINSHORT;
  317. X         }
  318. X        else *(w->weight) = temp;
  319. X       };
  320. X#else
  321. X      if (w->total > 0)
  322. X        temp = (INT32) (((INT32) w->total + 512) >> 10) * reta + (INT32) ralpha * w->olddw;
  323. X      else
  324. X        temp = (INT32) -(((INT32) 512 - w->total) >> 10) * reta + (INT32) ralpha * w->olddw;
  325. X      if (temp > 0) temp2 = (INT32) (temp + 512) >> 10;
  326. X      else temp2 = -(((INT32) 512 - temp) >> 10);
  327. X      w->olddw = temp2;
  328. X      temp = (INT32) w->weight + temp2;
  329. X      if (temp > MAXSHORT)
  330. X       {
  331. X        wtlimithit = 1;
  332. X        w->weight = MAXSHORT;
  333. X       }
  334. X      else if (temp < MINSHORT)
  335. X       {
  336. X        wtlimithit = 1;
  337. X        w->weight = MINSHORT;
  338. X       }
  339. X      else w->weight = temp;
  340. X#endif
  341. X      w = w->next;
  342. X     };
  343. X    u = u->next;
  344. X   };
  345. X  layer = layer->backlayer;
  346. X };
  347. X}
  348. X
  349. X
  350. Xvoid qp_update() {pg("quickprop not yet finished\n");}
  351. Xvoid supersab() {pg("supersab not yet finished\n");}
  352. X
  353. Xshort cbackoutput()          /* The continuous update version */
  354. X{                            /* of back-propagation */
  355. Xregister short deltaj;
  356. Xregister INT32 etadeltaj, temp, temp2;
  357. Xregister short temp3, adiff;
  358. Xregister UNIT *bunit;
  359. Xregister WTNODE *w;
  360. Xregister UNIT *u;
  361. Xregister short ralpha, reta, notclose;
  362. X
  363. Xralpha = alpha;
  364. Xreta = eta;
  365. Xnotclose = last->unitcount;
  366. Xu = (UNIT *) last->units;
  367. Xwhile (u != NULL)
  368. X { 
  369. X  temp3 = u->oj;
  370. X  temp2 = u->tj - temp3;
  371. X  if (temp2 > 0) adiff = temp2; else adiff = -temp2;
  372. X  if (adiff < toler) notclose = notclose - 1;
  373. X  totaldiff = totaldiff + adiff;
  374. X  if (adiff >= toler || backprop)
  375. X   {
  376. X    if (deriv == 'd') /* the differential step size method */
  377. X      deltaj = temp2;
  378. X    else if (deriv == 'f' || deriv == 'F') /* Fahlman's derivative */
  379. X     { /* deltaj = (u->tj - u->oj) * [0.1 + u->oj*(1.0 - u->oj)] */
  380. X      if (activation == 't') temp3 = temp3 / 2 + 512;
  381. X      temp = (INT32) temp2 * ((INT32) 104448 + (INT32) temp3 * ((short)(1024 - temp3)));
  382. X      if(temp > 0) deltaj = (INT32) (temp + 524288) >> 20;
  383. X      else deltaj = -(((INT32) 524288 - temp) >> 20);
  384. X     }
  385. X    else /* the original derivative */
  386. X     { /* deltaj = (u->tj - u->oj) * u->oj * (1.0 - u->oj) */
  387. X      if (activation == 't') temp3 = temp3 / 2 + 512;
  388. X      temp = (INT32) temp2 * ((INT32) temp3 * ((short)(1024 - temp3)));
  389. X      if(temp > 0) deltaj = ((INT32) temp + 524288) >> 20;
  390. X      else deltaj = -(((INT32) 524288 - temp) >> 20);
  391. X     };
  392. X    etadeltaj = (INT32) deltaj * reta;
  393. X    w = (WTNODE *) u->wtlist;
  394. X#ifdef SYMMETRIC
  395. X    while (w->next != NULL)
  396. X#else
  397. X    while (w != NULL)
  398. X#endif
  399. X     { /* get a slope for each weight */
  400. X      bunit = (UNIT *) w->backunit;
  401. X      temp = (INT32) etadeltaj * bunit->oj;
  402. X      if(temp > 0) temp = (INT32) (temp + 524288) >> 20;
  403. X      else temp = -(((INT32) 524288 - temp) >> 20);
  404. X#ifdef SYMMETRIC
  405. X      temp2 = (INT32) ralpha * *(w->olddw);
  406. X#else
  407. X      temp2 = (INT32) ralpha * w->olddw;
  408. X#endif
  409. X      if (temp2 > 0) temp3 = temp + (((INT32) temp2 + 512) >> 10);
  410. X      else temp3 = temp - (((INT32) 512 - temp2) >> 10);
  411. X#ifdef SYMMETRIC
  412. X      *(w->olddw) = temp3;
  413. X#else
  414. X      w->olddw = temp3;
  415. X#endif
  416. X      /* w->weight = w->weight + w->olddw */
  417. X#ifdef SYMMETRIC
  418. X      temp = (INT32) *(w->weight) + temp3;
  419. X      if (temp > MAXSHORT)
  420. X       {
  421. X        wtlimithit = 1;
  422. X        *(w->weight) = MAXSHORT;
  423. X       }
  424. X      else if (temp < MINSHORT)
  425. X       {
  426. X        wtlimithit = 1;
  427. X        *(w->weight) = MINSHORT;
  428. X       }
  429. X      else *(w->weight) = temp;
  430. X#else
  431. X      temp = (INT32) w->weight + temp3;
  432. X      if (temp > MAXSHORT)
  433. X       {
  434. X        wtlimithit = 1;
  435. X        temp3 = MAXSHORT;
  436. X       }
  437. X      else if (temp < MINSHORT)
  438. X       {
  439. X        wtlimithit = 1;
  440. X        temp3 = MINSHORT;
  441. X       }
  442. X      else temp3 = temp;
  443. X      w->weight = temp3;
  444. X      if (bunit->layernumber > 1)
  445. X         bunit->error = bunit->error + (INT32) deltaj * temp3;
  446. X#endif
  447. X      w = w->next;
  448. X     }
  449. X   }
  450. X  u = u->next;
  451. X }
  452. Xreturn(notclose);
  453. X}
  454. X
  455. X#ifndef SYMMETRIC
  456. X
  457. Xvoid cbackinner()
  458. X{
  459. Xregister short deltaj;
  460. Xregister INT32 etadeltaj, temp, temp2;
  461. Xregister short temp3, reta, ralpha;
  462. Xregister UNIT *bunit;
  463. Xregister WTNODE *w;
  464. Xregister UNIT *u;
  465. XLAYER *layer;
  466. X
  467. Xreta = eta2;
  468. Xralpha = alpha;
  469. Xlayer = last->backlayer;
  470. Xwhile (layer->backlayer != NULL)
  471. X {
  472. X  u = (UNIT *) layer->units;
  473. X  while (u != NULL)
  474. X   {
  475. X    if (activation == 't') temp3 = u->oj / 2 + 512;
  476. X    else temp3 = u->oj;
  477. X    if (deriv == 'f')  /* Fahlman's derivative */
  478. X       temp = (INT32) ((((INT32) temp3 * ((short)(1024 - temp3)) + 512) >> 10) + 102)
  479. X               * u->error;
  480. X    else  /* diff. step size and original derivative */
  481. X       temp = (((INT32) temp3 * ((short)(1024 - temp3)) + 512) >> 10)
  482. X                * u->error;
  483. X    if (temp > 0) deltaj = (INT32) (temp + 524288) >> 20;
  484. X    else deltaj = -(((INT32) 524288 - temp) >> 20);
  485. X    etadeltaj = (INT32) reta * deltaj;
  486. X    w = (WTNODE *) u->wtlist;
  487. X    while (w != NULL)
  488. X     {
  489. X      bunit = (UNIT *) w->backunit;
  490. X      temp = (INT32) etadeltaj * bunit->oj;
  491. X      if (temp > 0) temp = (INT32) (temp + 524288) >> 20;
  492. X      else temp = -(((INT32) 524288 - temp) >> 20);
  493. X      temp2 = (INT32) ralpha * w->olddw;
  494. X      if (temp2 > 0) temp3 = temp + ((INT32) (temp2 + 512) >> 10);
  495. X      else temp3 = temp - (((INT32) 512 - temp2) >> 10);
  496. X      w->olddw = temp3;
  497. X      temp = (INT32) w->weight + temp3;
  498. X      if (temp > MAXSHORT)
  499. X       {
  500. X        wtlimithit = 1;
  501. X        temp3 = MAXSHORT;
  502. X       }
  503. X      else if (temp < MINSHORT)
  504. X       {
  505. X        wtlimithit = 1;
  506. X        temp3 = MINSHORT;
  507. X       }
  508. X      else temp3 = temp;       
  509. X      w->weight = temp3;
  510. X      if (bunit->layernumber > 1)
  511. X         bunit->error = bunit->error + (INT32) deltaj * temp3;
  512. X      w = w->next;
  513. X     };
  514. X    u = u->next;
  515. X   };
  516. X  layer = layer->backlayer;
  517. X };
  518. X}
  519. X#endif
  520. END_OF_FILE
  521. if test 14360 -ne `wc -c <'int.c'`; then
  522.     echo shar: \"'int.c'\" unpacked with wrong size!
  523. fi
  524. # end of 'int.c'
  525. fi
  526. if test -f 'real.c' -a "${1}" != "-c" ; then 
  527.   echo shar: Will not clobber existing file \"'real.c'\"
  528. else
  529. echo shar: Extracting \"'real.c'\" \(9446 characters\)
  530. sed "s/^X//" >'real.c' <<'END_OF_FILE'
  531. X/* *********************************************************** */
  532. X/* file real.c:  contains the network evaluation and weight    */
  533. X/* adjustment procedures for the 64-bit floating point program */
  534. X/*                                                             */
  535. X/* Copyright (c) 1991 by Donald R. Tveter                      */
  536. X/*                                                             */
  537. X/* *********************************************************** */
  538. X
  539. X#include "rbp.h"
  540. X#include <stdio.h>
  541. X
  542. Xextern char activation, backprop, deriv;
  543. Xextern REAL alpha, D, decay, eta, eta2, etamax, kappa;
  544. Xextern REAL noise, theta1, theta2, toler, totaldiff;
  545. Xextern LAYER *last, *start;
  546. X
  547. Xextern double exp(); /* built-in functions */
  548. X
  549. Xvoid forward()       /* computes unit activations */
  550. X{
  551. XUNIT *u, *predu;
  552. XLAYER *layer;
  553. XWTNODE *b;
  554. Xregister REAL fract, x, sum;
  555. XREAL val; /* should be in a register, but UNIX pc C-compiler does */
  556. X          /* not handle it correctly */
  557. Xint intpart;
  558. X
  559. Xlayer = start->next;
  560. Xwhile (layer != NULL)
  561. X {
  562. X  u = (UNIT *) layer->units;
  563. X  while (u != NULL)
  564. X   {
  565. X    sum = 0.0;
  566. X    b = (WTNODE *) u->wtlist;
  567. X    while (b != NULL)
  568. X     {
  569. X      predu = (UNIT *) b->backunit;
  570. X#ifdef SYMMETRIC
  571. X      sum = sum + *(b->weight) * predu->oj;
  572. X#else
  573. X      sum = sum + b->weight * predu->oj;
  574. X#endif
  575. X      b = b->next;
  576. X     };
  577. X    sum = sum * D;
  578. X    if (activation == 'p' || activation == 't')
  579. X     {
  580. X      if (sum >= 0.0) x = sum; else x = - sum;
  581. X      intpart = x;
  582. X      fract = x - intpart;
  583. X      switch (intpart) {
  584. Xcase 0:  val = 0.5 + 0.231 * fract;          /* 0 <= x < 1 */
  585. X         break;
  586. Xcase 1:  val = 0.731059 + 0.149738 * fract;  /* 1 <= x < 2 */
  587. X         break;
  588. Xcase 2:  val = 0.880797 + 0.071777 * fract;  /* 2 <= x < 3 */
  589. X         break;
  590. Xcase 3:
  591. Xcase 4:  val = 0.9525741 + (x - 3.0) * 0.02; /* 3 <= x < 5 */
  592. X         break;
  593. Xdefault: val = 1.0;                          /* x >= 5 */
  594. X            };
  595. X      if (sum < 0.0) u->oj = 1.0 - val; else u->oj = (REAL) val;
  596. X      if (activation == 't') u->oj = (u->oj - 0.5) * 2;
  597. X     }  /* end of p or t */
  598. X    else if (activation == 's') u->oj = 1.0 / (1.0 + exp(-sum));
  599. X    else if (activation == 'l') u->oj = sum;
  600. X    else if (activation == 'T') u->oj = 2.0 / (1.0 + exp(-sum)) - 1.0;
  601. X    u = u->next;
  602. X   };
  603. X  layer = layer->next;
  604. X };
  605. X}
  606. X
  607. Xshort backoutput()  /* back propagate errors from the output units */
  608. X{                   /* send down errors for any previous layers    */
  609. Xregister REAL deltaj, diff, adiff, uoj;
  610. Xregister UNIT *u, *bunit;
  611. Xregister WTNODE *w;
  612. Xregister short notclose;
  613. X
  614. Xnotclose = last->unitcount;
  615. Xu = (UNIT *) last->units;
  616. Xwhile (u != NULL)
  617. X {
  618. X  diff = u->tj - u->oj;
  619. X  if (diff > 0) adiff = diff; else adiff = -diff;
  620. X  if (adiff < toler) notclose = notclose - 1;
  621. X  totaldiff = totaldiff + adiff;
  622. X  if (adiff >= toler || backprop)
  623. X   {
  624. X    if (deriv == 'd') /* differential step size */
  625. X       deltaj = diff;
  626. X    else if (deriv == 'f' || deriv == 'F') /* Fahlman's derivative */
  627. X     {
  628. X      if (activation == 't' || activation == 'T') uoj = u->oj / 2 + 0.5;
  629. X      else uoj = u->oj;
  630. X      deltaj = diff * (0.1 + uoj * (1.0 - uoj));
  631. X     }
  632. X    else /* the original derivative */
  633. X     {
  634. X      if (activation == 't' || activation == 'T') uoj = u->oj / 2 + 0.5;
  635. X      else uoj = u->oj;
  636. X      deltaj = diff * uoj * (1.0 - uoj);
  637. X     };
  638. X    w = (WTNODE *) u->wtlist;
  639. X#ifdef SYMMETRIC
  640. X    while (w->next != NULL)
  641. X#else
  642. X    while (w != NULL)
  643. X#endif
  644. X     {
  645. X      bunit = (UNIT *) w->backunit;
  646. X#ifdef SYMMETRIC
  647. X      *(w->total) = *(w->total) + deltaj * bunit->oj;
  648. X#else
  649. X      w->total = w->total + deltaj * bunit->oj;
  650. X      if (bunit->layernumber > 1)  /* pass back the error */
  651. X         bunit->error = bunit->error + deltaj * w->weight;
  652. X#endif
  653. X      w = w->next;
  654. X     };
  655. X   }
  656. X  u = u->next;
  657. X }
  658. Xreturn(notclose);
  659. X}
  660. X
  661. X#ifndef SYMMETRIC
  662. X
  663. Xvoid backinner()  /* compute weight changes for hidden layers */
  664. X{                 /* send down errors for any previous layers */
  665. XLAYER *layer;
  666. Xregister REAL deltaj, uoj;
  667. Xregister UNIT *bunit;
  668. Xregister WTNODE *w;
  669. Xregister UNIT *u;
  670. X
  671. Xlayer = last->backlayer;
  672. Xwhile (layer->backlayer != NULL)
  673. X {
  674. X  u = (UNIT *) layer->units;
  675. X  while (u != NULL)
  676. X   {
  677. X    if (activation == 't' || activation == 'T') uoj = u->oj / 2 + 0.5;
  678. X    else uoj = u->oj;
  679. X    if (deriv == 'f') /* Fahlman's derivative */
  680. X       deltaj = (0.1 + uoj * (1.0 - uoj)) * u->error;
  681. X    else /* for o, d and F */
  682. X       deltaj = (uoj * (1.0 - uoj)) * u->error;
  683. X    w = (WTNODE *) u->wtlist;
  684. X    while (w != NULL)
  685. X     {
  686. X      bunit = (UNIT *) w->backunit;
  687. X      w->total = w->total + deltaj * bunit->oj;
  688. X      if (bunit->layernumber > 1)
  689. X         bunit->error = bunit->error + deltaj * w->weight;
  690. X      w = w->next;
  691. X     };
  692. X    u = u->next;
  693. X   };
  694. X  layer = layer->backlayer;
  695. X };
  696. X}
  697. X
  698. X#endif
  699. X
  700. X#ifdef SYMMETRIC
  701. Xvoid dbd_update() {pg("symmetric dbd update no longer supported\n");}
  702. X#else
  703. Xvoid dbd_update() /* delta-bar-delta method for changing weights */
  704. X{
  705. Xregister short stotal,sdbarm1;
  706. Xregister UNIT *u;
  707. Xregister WTNODE *w;
  708. XLAYER *layer;
  709. X
  710. X/* w->olddw is used for delta-bar minus 1 */
  711. X
  712. Xlayer = last;
  713. Xwhile (layer->backlayer != NULL)
  714. X {
  715. X  u = (UNIT *) layer->units;
  716. X  while (u != NULL)
  717. X   {
  718. X    w = (WTNODE *) u->wtlist;
  719. X    while (w != NULL)
  720. X     {
  721. X      if (w->total > 0) stotal = 1;
  722. X        else if (w->total < 0) stotal = -1;
  723. X         else stotal = 0;
  724. X      if (w->olddw > 0) sdbarm1 = 1;
  725. X        else if (w->olddw < 0) sdbarm1 = -1;
  726. X         else sdbarm1 = 0;
  727. X      w->olddw = theta2 * w->total + theta1 * w->olddw;
  728. X      if ((stotal > 0) && (sdbarm1 > 0)) w->eta = w->eta + kappa;
  729. X      else if ((stotal < 0) && (sdbarm1 < 0)) w->eta = w->eta + kappa;
  730. X      else if ((stotal > 0) && (sdbarm1 < 0)) w->eta = w->eta * decay;
  731. X      else if ((stotal < 0) && (sdbarm1 > 0)) w->eta = w->eta * decay;
  732. X      if (w->eta > etamax) w->eta = etamax;
  733. X      w->weight = w->weight + w->eta * w->total;
  734. X      w = w->next;
  735. X     };
  736. X    u = u->next;
  737. X   };
  738. X  layer = layer->backlayer;
  739. X };
  740. X}
  741. X#endif
  742. X
  743. Xvoid periodic_update()  /* the original periodic method */
  744. X{
  745. Xregister REAL reta, ralpha;
  746. Xregister UNIT *u;
  747. Xregister WTNODE *w;
  748. XLAYER *layer;
  749. X
  750. Xralpha = alpha;
  751. Xlayer = last;
  752. Xwhile (layer->backlayer != NULL)
  753. X {
  754. X  if (layer == last) reta = eta; else reta = eta2;
  755. X  u = (UNIT *) layer->units;
  756. X  while (u != NULL)
  757. X   {
  758. X    w = (WTNODE *) u->wtlist;
  759. X    while (w != NULL)
  760. X     {
  761. X#ifdef SYMMETRIC
  762. X      if (((UNIT *) w->backunit)->unitnumber > u->unitnumber)
  763. X       {
  764. X        *(w->olddw) = *(w->total) * reta + ralpha * *(w->olddw);
  765. X        *(w->weight) = *(w->weight) + *(w->olddw);
  766. X       };
  767. X#else
  768. X      w->olddw = w->total * reta + ralpha * w->olddw;
  769. X      w->weight = w->weight + w->olddw;
  770. X#endif
  771. X      w = w->next;
  772. X     };
  773. X    u = u->next;
  774. X   };
  775. X  layer = layer->backlayer;
  776. X };
  777. X}
  778. X
  779. Xvoid qp_update() {pg("quickprop not yet finished\n");}
  780. Xvoid supersab() {pg("supersab not yet finished\n");}
  781. X
  782. Xshort cbackoutput()  /* backoutput for continuous updates */
  783. X{
  784. Xregister REAL deltaj, etadeltaj, diff, adiff, uoj, reta, ralpha;
  785. Xregister UNIT *u, *bunit;
  786. Xregister WTNODE *b;
  787. Xregister short notclose;
  788. X
  789. Xreta = eta;
  790. Xralpha = alpha;
  791. Xnotclose = last->unitcount;
  792. Xu = (UNIT *) last->units;
  793. Xwhile (u != NULL)
  794. X {
  795. X  diff = u->tj - u->oj;
  796. X  if (diff > 0) adiff = diff; else adiff = -diff;
  797. X  if (adiff < toler) notclose = notclose - 1;
  798. X  totaldiff = totaldiff + adiff;
  799. X  if (adiff >= toler || backprop)
  800. X   {
  801. X    if (deriv == 'd') /* differential step size derivative */
  802. X       deltaj = diff;
  803. X    else if (deriv == 'f' || deriv == 'F') /* Fahlman's derivative */
  804. X     {
  805. X      if (activation == 't' || activation == 'T') uoj = u->oj / 2 + 0.5;
  806. X      else uoj = u->oj;
  807. X      deltaj = diff * (0.1 + uoj * (1.0 - uoj));
  808. X     }
  809. X    else /* the original derivative */
  810. X     {
  811. X      if (activation == 't' || activation == 'T') uoj = u->oj / 2 + 0.5;
  812. X      else uoj = u->oj;
  813. X      deltaj = diff * uoj * (1.0 - uoj);
  814. X     };
  815. X    etadeltaj = deltaj * reta;
  816. X    b = (WTNODE *) u->wtlist;
  817. X#ifdef SYMMETRIC
  818. X    while (b->next != NULL)
  819. X#else
  820. X    while (b != NULL)
  821. X#endif
  822. X     {
  823. X      bunit = (UNIT *) b->backunit;
  824. X#ifdef SYMMETRIC
  825. X      *(b->olddw) = etadeltaj * bunit->oj + ralpha * *(b->olddw);
  826. X      *(b->weight) = *(b->weight) + *(b->olddw);
  827. X#else
  828. X      b->olddw = etadeltaj * bunit->oj + ralpha * b->olddw;
  829. X      b->weight = b->weight + b->olddw;
  830. X      if (bunit->layernumber > 1)
  831. X         bunit->error = bunit->error + deltaj * b->weight;
  832. X#endif
  833. X      b = b->next;
  834. X     };
  835. X   };
  836. X  u = u->next;
  837. X }
  838. Xreturn(notclose);
  839. X}
  840. X
  841. X#ifndef SYMMETRIC
  842. X
  843. Xvoid cbackinner()  /* backinner for continuous updates */
  844. X{
  845. XLAYER *layer;
  846. Xregister REAL deltaj, etadeltaj, reta, uoj, ralpha;
  847. Xregister UNIT *bunit, *u;
  848. Xregister WTNODE *b;
  849. X
  850. Xreta = eta2;
  851. Xralpha = alpha;
  852. Xlayer = last->backlayer;
  853. Xwhile (layer->backlayer != NULL)
  854. X {
  855. X  u = (UNIT *) layer->units;
  856. X  while (u != NULL)
  857. X   {
  858. X    if (activation == 't' || activation == 'T') uoj = u->oj / 2 + 0.5;
  859. X    else uoj = u->oj;
  860. X    if (deriv == 'f') /* Fahlman's derivative */
  861. X       deltaj = (0.1 + uoj * (1.0 - uoj)) * u->error;
  862. X    else /* for o, d and F */
  863. X       deltaj = (uoj * (1.0 - uoj)) * u->error;
  864. X    etadeltaj = reta * deltaj;
  865. X    b = (WTNODE *) u->wtlist;
  866. X    while (b != NULL)
  867. X     {
  868. X      bunit = (UNIT *) b->backunit;
  869. X      b->olddw = etadeltaj * bunit->oj + ralpha * b->olddw;
  870. X      b->weight = b->weight + b->olddw;
  871. X      if (bunit->layernumber > 1)
  872. X         bunit->error = bunit->error + deltaj * b->weight;
  873. X      b = b->next;
  874. X     };
  875. X    u = u->next;
  876. X   };
  877. X  layer = layer->backlayer;
  878. X };
  879. X}
  880. X#endif
  881. END_OF_FILE
  882. if test 9446 -ne `wc -c <'real.c'`; then
  883.     echo shar: \"'real.c'\" unpacked with wrong size!
  884. fi
  885. # end of 'real.c'
  886. fi
  887. if test -f 'misc.c' -a "${1}" != "-c" ; then 
  888.   echo shar: Will not clobber existing file \"'misc.c'\"
  889. else
  890. echo shar: Extracting \"'misc.c'\" \(17655 characters\)
  891. sed "s/^X//" >'misc.c' <<'END_OF_FILE'
  892. X/* **************************************************** */
  893. X/* file misc.c:  contains pattern manipulation routines */
  894. X/*               and miscellaneous other functions.     */
  895. X/*                                                      */
  896. X/* Copyright (c) 1991 by Donald R. Tveter               */
  897. X/*                                                      */
  898. X/* **************************************************** */
  899. X
  900. X#include <stdio.h>
  901. X
  902. X#ifdef UNIX
  903. X#include <malloc.h>
  904. X#else
  905. X#include <stdlib.h>
  906. X#include <conio.h>
  907. X#endif
  908. X
  909. X#ifdef INTEGER
  910. X#include "ibp.h"
  911. X#else
  912. X#include "rbp.h"
  913. X#endif
  914. X
  915. X/* an addition for large data sets */
  916. X
  917. Xextern INT32 g;
  918. X
  919. X/* built-in function */
  920. X
  921. Xextern int rand();
  922. X
  923. X/* homemade functions */
  924. X
  925. X#ifdef INTEGER
  926. Xextern REAL unscale(), unscaleint();
  927. Xextern WTTYPE scale();
  928. X#endif
  929. X
  930. Xextern short backoutput(), cbackoutput();
  931. Xextern void backinner(), cbackinner(), saveweights();
  932. Xextern WTTYPE rdr();
  933. Xextern void dbd_update(), periodic_update(), qp_update(), supersab();
  934. Xextern REAL readchar();
  935. X
  936. Xextern char backprop,emptystring,informat,outstr[],patform,ringbell;
  937. Xextern char summary, *testfile, update, up_to_date_stats, wtlimithit;
  938. Xextern int bad, benchmark,bufferptr,lastprint,lastsave,npats;
  939. Xextern int prevnpats,readerror,readingpattern,right,saverate,testpat;
  940. Xextern int totaliter,unlearned,wrong,wttotal;
  941. Xextern WTTYPE dbdeta, error, initialkick, toler, toosmall;
  942. Xextern REAL errorperunit, pct_right;
  943. Xextern UNIT *hlayer, *ilayer, *jlayer, *klayer;
  944. Xextern LAYER *last, *start;
  945. Xextern short skiprate;
  946. X#ifdef INTEGER
  947. Xextern INT32 totaldiff;
  948. X#else
  949. Xextern REAL totaldiff;
  950. X#endif
  951. X
  952. Xvoid nullpatterns()  /* dispose of any patterns before reading more */
  953. X{
  954. XPATLIST *pl, *nextpl;
  955. XWTTYPE *p;
  956. X
  957. Xif (start->patstart != NULL)
  958. X {
  959. X  pl = start->patstart;
  960. X  while (pl != NULL)
  961. X   {
  962. X    nextpl = pl->next;
  963. X    p = pl->pats;
  964. X    free(p);
  965. X    pl = nextpl;
  966. X   };
  967. X  pl = last->patstart;
  968. X  while (pl != NULL)
  969. X   {
  970. X    nextpl = pl->next;
  971. X    p = pl->pats;
  972. X    free(p);
  973. X    pl = nextpl;
  974. X   };
  975. X };
  976. Xstart->patstart = NULL;
  977. Xlast->patstart = NULL;
  978. Xnpats = 0;
  979. Xprevnpats = 0;
  980. X}
  981. X
  982. Xvoid resetpats()
  983. X{
  984. Xstart->currentpat = NULL;
  985. Xlast->currentpat = NULL;
  986. X}
  987. X
  988. Xvoid findendofpats(layer)  /* purpose is to set all layer->currentpat */
  989. XLAYER *layer;              /* fields to end of pattern list so more   */
  990. X{                          /* patterns can be added at the end.       */
  991. XPATLIST *pl;
  992. Xpl = (PATLIST *) layer->patstart;
  993. Xwhile (pl->next != NULL) pl = pl->next;
  994. Xlayer->currentpat = pl;
  995. X}
  996. X
  997. Xint copyhidden(u,hidden,layerno)
  998. XUNIT *u, **hidden;
  999. Xint layerno;
  1000. X{
  1001. Xif (hidden == NULL)
  1002. X {
  1003. X  sprintf(outstr,"ran out of hidden units in layer %d\n",layerno);
  1004. X  pg(outstr);
  1005. X  return(0);
  1006. X }
  1007. Xu->oj = (*hidden)->oj;
  1008. X*hidden = (*hidden)->next;
  1009. Xreturn(1);
  1010. X}
  1011. X
  1012. Xint loadpat(command)
  1013. Xchar command;
  1014. X{
  1015. XUNIT *u, *hunit, *iunit, *junit, *kunit;
  1016. Xhunit = hlayer;
  1017. Xiunit = ilayer;
  1018. Xjunit = jlayer;
  1019. Xkunit = klayer;
  1020. Xreadingpattern = 1;
  1021. Xu = (UNIT *) start->units;
  1022. Xwhile (u != NULL)
  1023. X {
  1024. X  if (informat == 'r') u->oj = rdr(GE,(REAL) HCODE,command);
  1025. X  else u->oj = scale(readchar());
  1026. X  if (readerror) goto errorexit;
  1027. X  if (u->oj <= KCODE)
  1028. X   {
  1029. X    if (u->oj == HCODE)
  1030. X       {if (!copyhidden(u,&hunit,2)) goto errorexit;}
  1031. X    else if (u->oj == ICODE)
  1032. X       {if (!copyhidden(u,&iunit,3)) goto errorexit;}
  1033. X    else if (u->oj == JCODE)
  1034. X       {if (!copyhidden(u,&junit,4)) goto errorexit;}
  1035. X    else if (!copyhidden(u,&kunit,5)) goto errorexit;
  1036. X   };
  1037. X  u = u->next;
  1038. X };
  1039. Xreadingpattern = 0;
  1040. Xforward();
  1041. Xreturn(1);
  1042. X
  1043. Xerrorexit:
  1044. Xreadingpattern = 0;
  1045. Xreturn(0);
  1046. X}
  1047. X
  1048. Xvoid nextpat()
  1049. X{
  1050. Xif (start->currentpat == NULL)
  1051. X {
  1052. X  start->currentpat = start->patstart;
  1053. X  last->currentpat = last->patstart;
  1054. X }
  1055. Xelse
  1056. X {
  1057. X  start->currentpat = (start->currentpat)->next;
  1058. X  last->currentpat = (last->currentpat)->next;
  1059. X };
  1060. X}
  1061. X
  1062. Xvoid setoutputpat()
  1063. X{
  1064. Xregister WTTYPE *p;
  1065. Xregister UNIT *u;
  1066. Xregister short i, answer;
  1067. XPATLIST *pl;
  1068. X
  1069. Xif (patform == 'c' || patform == 'C')
  1070. X {
  1071. X  pl = last->currentpat;
  1072. X  p = pl->pats;
  1073. X  answer = *p;
  1074. X  u = (UNIT *) last->units;
  1075. X  for (i=1;i<=last->unitcount;i++)
  1076. X   {
  1077. X    if (i == answer) u->tj = scale(1.0); else u->tj = scale(0.0);
  1078. X    u = u->next;
  1079. X   };
  1080. X }
  1081. Xelse
  1082. X {
  1083. X  pl = last->currentpat;
  1084. X  p = pl->pats;
  1085. X  u = (UNIT *) last->units;
  1086. X  while (u != NULL)
  1087. X   {
  1088. X    u->tj = *p++;
  1089. X    u = u->next;
  1090. X   };
  1091. X }
  1092. X}
  1093. X
  1094. Xvoid setinputpat()
  1095. X{
  1096. Xregister WTTYPE *p;
  1097. Xregister UNIT *u;
  1098. XUNIT *hunit, *iunit, *junit, *kunit;
  1099. XPATLIST *pl;
  1100. X  
  1101. Xhunit = hlayer;
  1102. Xiunit = ilayer;
  1103. Xjunit = jlayer;
  1104. Xkunit = klayer;
  1105. Xpl = start->currentpat;
  1106. Xp = pl->pats;
  1107. Xu = (UNIT *) start->units;
  1108. Xwhile (u != NULL)
  1109. X {
  1110. X  if (*p > KCODE) u->oj = *p++;
  1111. X  else if (*p++ == HCODE)
  1112. X     {if (!copyhidden(u,&hunit,2)) return;}
  1113. X  else if (*p++ == ICODE)
  1114. X     {if (!copyhidden(u,&iunit,3)) return;}
  1115. X  else if (*p++ == JCODE)
  1116. X     {if (!copyhidden(u,&junit,4)) return;}
  1117. X  else if (!copyhidden(u,&kunit,5)) {p++; return;};
  1118. X  u = u->next;
  1119. X };
  1120. X}
  1121. X
  1122. Xvoid setonepat() /* set input and output patterns */
  1123. X{
  1124. Xregister UNIT *u;
  1125. Xregister LAYER *innerlayers;
  1126. X
  1127. Xsetinputpat();
  1128. Xsetoutputpat();
  1129. Xinnerlayers = start->next;
  1130. Xwhile (innerlayers->next != NULL)
  1131. X {  /* set errors on the inner layer units to 0 */
  1132. X  u = (UNIT *) innerlayers->units;
  1133. X  while (u != NULL)
  1134. X   {
  1135. X    u->error = 0;
  1136. X    u = u->next;
  1137. X   };
  1138. X  innerlayers = innerlayers->next;
  1139. X };
  1140. X}
  1141. X
  1142. Xvoid clear()
  1143. X{
  1144. XLAYER *p;
  1145. XUNIT *u;
  1146. XWTNODE *w;
  1147. Xint i;
  1148. X
  1149. Xif (toosmall != -1)
  1150. X {
  1151. X  pg("cannot restart with the weights removed\n");
  1152. X  return;
  1153. X };
  1154. Xright = 0;
  1155. Xwrong = npats;
  1156. Xpct_right = 0.0;
  1157. Xunlearned = npats;
  1158. Xwtlimithit = 0;
  1159. Xtotaliter = 0;
  1160. Xlastsave = 0;
  1161. Xinitialkick = -1;
  1162. Xlastprint = 0;
  1163. Xresetpats();
  1164. Xfor (i=1;i<=npats;i++)
  1165. X {
  1166. X  nextpat();
  1167. X  if (last->currentpat->bypass > 0) last->currentpat->bypass = 0;
  1168. X  else if (last->currentpat->bypass < 0) last->currentpat->bypass = -1;
  1169. X };
  1170. Xp = start->next;
  1171. Xwhile (p != NULL)
  1172. X {
  1173. X  u = (UNIT *) p->units;
  1174. X  while (u != NULL)
  1175. X   {
  1176. X    w = (WTNODE *) u->wtlist;
  1177. X    while (w != NULL)
  1178. X     {
  1179. X#ifdef SYMMETRIC
  1180. X      if (w->next != NULL)
  1181. X       { /* skip threshold weight */
  1182. X        *(w->weight) = 0;
  1183. X        *(w->olddw) = 0;
  1184. X        *(w->eta) = dbdeta;
  1185. X       };
  1186. X#else
  1187. X      w->weight = 0;
  1188. X      w->olddw = 0;
  1189. X      w->eta = dbdeta;
  1190. X      w->slope = 0;
  1191. X#endif
  1192. X      w = w->next;
  1193. X     };
  1194. X    u = u->next;
  1195. X   };
  1196. X  p = p->next;
  1197. X };
  1198. X}
  1199. X
  1200. X#ifndef SYMMETRIC
  1201. X
  1202. Xvoid whittle(amount)    /* removes weights whose absolute */
  1203. XWTTYPE amount;          /* value is less than amount      */
  1204. X{LAYER *layer;
  1205. X UNIT *u;
  1206. X WTNODE *w, *wprev;
  1207. X
  1208. Xlayer = start->next;
  1209. Xwhile (layer != NULL)
  1210. X {
  1211. X  u = (UNIT *) layer->units;
  1212. X  while (u != NULL)
  1213. X   {
  1214. X    w = (WTNODE *) u->wtlist;
  1215. X    wprev = (WTNODE *) NULL;
  1216. X    while (w->next != (WTNODE *) NULL)
  1217. X     {
  1218. X      if ((w->weight) < amount && (w->weight) > -amount)
  1219. X       {
  1220. X        if (wprev == NULL) (WTNODE *) u->wtlist = w->next;
  1221. X        else (WTNODE *) wprev->next = w->next;
  1222. X        wttotal = wttotal - 1;
  1223. X       }
  1224. X      else wprev = w;
  1225. X      w = w->next;
  1226. X     }
  1227. X    u = u->next;
  1228. X   }
  1229. X  layer = layer->next;
  1230. X }
  1231. X}
  1232. X
  1233. X#endif
  1234. X
  1235. Xvoid testcheck()  /* checks the testfile */
  1236. X{
  1237. Xint class, best, count, tcright, tcwrong, testcount, printing;
  1238. Xint tright, twrong, ch2;
  1239. XREAL pct, testerr, eperunit;
  1240. XWTTYPE max;
  1241. XUNIT *u;
  1242. X
  1243. Xpushfile(testfile);
  1244. Xtesterr = 0.0;
  1245. Xtestcount = 0;
  1246. Xtcright = 0;
  1247. Xtcwrong = 0;
  1248. Xtright = 0;
  1249. Xtwrong = 0;
  1250. Xif (patform == 'c' || patform == 'g') printing = 0; else printing = 1;
  1251. Xch2 = readch();
  1252. Xwhile (ch2 != EOF)
  1253. X {
  1254. X  bufferptr = bufferptr - 1;
  1255. X  if (!loadpat('t')) if (readerror == 2) goto summarize; else goto exit;
  1256. X  class = 0;
  1257. X  if (patform == 'c' || patform == 'C')
  1258. X   {
  1259. X    class = readint(1,last->unitcount,'t');
  1260. X    if (readerror) goto exit;
  1261. X    count = 0;
  1262. X    max = -MAXINT;
  1263. X    best = 0;
  1264. X   };
  1265. X  u = (UNIT *) last->units;
  1266. X  while (u != NULL)
  1267. X   {
  1268. X    if (class)
  1269. X     {
  1270. X      count = count + 1;
  1271. X      if (u->oj > max)
  1272. X       {
  1273. X        max = u->oj;
  1274. X        best = count;
  1275. X       }
  1276. X      if (count == class) u->tj = scale(1.0); else u->tj = scale(0.0);
  1277. X     }
  1278. X    else
  1279. X     {
  1280. X      u->tj = rdr(GT,(REAL) KCODE,'t');
  1281. X      if (readerror) goto exit;
  1282. X     };
  1283. X    u = u->next;
  1284. X   };
  1285. X  testcount = testcount + 1;
  1286. X  if (class)
  1287. X   if (best == class) tcright = tcright + 1; else tcwrong = tcwrong + 1;
  1288. X  if (printing)
  1289. X   {
  1290. X    sprintf(outstr,"%5d",testcount);
  1291. X    pg(outstr);
  1292. X   };
  1293. X  if (printoutunits(printing,last,1))
  1294. X   {
  1295. X    popfile();
  1296. X    return;
  1297. X   };
  1298. X  testerr = testerr + unscale(error);
  1299. X  if (bad) twrong = twrong + 1; else tright = tright + 1;
  1300. X  do ch2 = readch(); while (ch2 != '\n');
  1301. X  ch2 = readch();
  1302. X };
  1303. X
  1304. Xsummarize:
  1305. Xpct = 100.0 * (REAL) tright / (REAL) testcount;
  1306. Xif (pg("based on tolerance:\n")) return;
  1307. Xsprintf(outstr,"   %6.2f%%,   (%d right,  %d wrong)",pct,tright,twrong);
  1308. Xpg(outstr);
  1309. Xeperunit = testerr / (REAL) (last->unitcount * testcount);
  1310. Xsprintf(outstr,"   %7.5f error/unit\n",eperunit); pg(outstr);
  1311. Xif (patform == 'c' || patform == 'C')
  1312. X {
  1313. X  pct = 100.0 * (REAL) tcright / (REAL) testcount;
  1314. X  if (pg("based on maximum value:\n")) return;
  1315. X  sprintf(outstr,"   %6.2f%%,   %d right,   %d wrong\n",pct,tcright,tcwrong);
  1316. X  pg(outstr);
  1317. X };
  1318. Xpopfile();
  1319. Xreturn;
  1320. X
  1321. Xexit:
  1322. Xsprintf(outstr,"error while reading pattern %d\n",testcount+1);
  1323. Xpg(outstr);
  1324. Xpopfile();
  1325. X}
  1326. X
  1327. Xvoid stats(callfromrun)
  1328. Xint callfromrun;
  1329. X{
  1330. X if (callfromrun) wrong = unlearned;
  1331. X right = npats - wrong;
  1332. X if (testpat) right = right - 1;
  1333. X errorperunit =
  1334. X    unscaleint(totaldiff) / (REAL) ((right + wrong) * last->unitcount);
  1335. X pct_right = 100.0 * (REAL) right / (REAL) (right + wrong);
  1336. X}
  1337. X
  1338. Xint patcheck(first,finish,printoutputs,printerrors,sumup,printsumup,skip)
  1339. Xint first,finish,printoutputs,printerrors,sumup,printsumup,skip;
  1340. X{
  1341. Xint i;
  1342. X
  1343. Xif (skip && printoutputs == 0) goto shortcut;
  1344. Xif (sumup)
  1345. X {
  1346. X  totaldiff = 0;
  1347. X  wrong = 0;
  1348. X };
  1349. Xresetpats();
  1350. Xfor (i=1;i<first;i++) nextpat();
  1351. Xfor (i=first;i<=finish;i++)
  1352. X { 
  1353. X  nextpat();
  1354. X  setonepat();
  1355. X  forward();
  1356. X  if (printoutputs) {sprintf(outstr,"%3d ",i); pg(outstr);};
  1357. X  if (printoutunits(printoutputs,last,printerrors)) return(1);
  1358. X  if (i != testpat && sumup)
  1359. X    {
  1360. X     wrong = wrong + bad;
  1361. X     totaldiff = totaldiff + error;
  1362. X    };
  1363. X };
  1364. Xif (printoutputs) lastprint = totaliter;
  1365. Xif (sumup) stats(0);
  1366. X
  1367. Xshortcut:
  1368. Xif (printsumup)
  1369. X {
  1370. X  sprintf(outstr,"%5d iterations  ",totaliter); pg(outstr);
  1371. X  sprintf(outstr,"%6.2f%% right ",pct_right); pg(outstr);
  1372. X  sprintf(outstr,"(%1d right ",right); pg(outstr);
  1373. X  sprintf(outstr,"  %1d wrong)   ",wrong); pg(outstr);
  1374. X  sprintf(outstr,"%7.5f error/unit\n",errorperunit);
  1375. X  if (pg(outstr)) return(1);
  1376. X }
  1377. Xreturn(0);
  1378. X}
  1379. X
  1380. Xvoid oneset() /* go through the patterns once and update weights */
  1381. X{ 
  1382. Xint i;
  1383. XLAYER *layer;
  1384. Xregister UNIT *u;
  1385. Xregister WTNODE *w;
  1386. Xshort numbernotclose, attempted, passed;
  1387. X
  1388. Xlayer = last;      /* make all b->totals = 0 */
  1389. Xwhile (layer->backlayer != NULL)
  1390. X {
  1391. X  u = (UNIT *) layer->units;
  1392. X  while (u != NULL)
  1393. X   {
  1394. X    w = (WTNODE *) u->wtlist;
  1395. X    while (w != NULL)
  1396. X     {
  1397. X#ifdef SYMMETRIC
  1398. X      *(w->total) = 0;
  1399. X#else
  1400. X      w->total = 0;
  1401. X#endif
  1402. X      w = w->next;
  1403. X     };
  1404. X    u = u->next;
  1405. X   };
  1406. X  layer = layer->backlayer;
  1407. X };
  1408. Xattempted = 0;
  1409. Xpassed = 0;
  1410. Xif (testpat) unlearned = npats - 1; else unlearned = npats;
  1411. Xresetpats();
  1412. Xfor(i=1;i<=npats;i++)
  1413. X {
  1414. X  nextpat();
  1415. X  if (last->currentpat->bypass == 0)
  1416. X   {
  1417. X    setonepat();
  1418. X    forward();
  1419. X    attempted = attempted + 1;
  1420. X    if (update == 'c') numbernotclose = cbackoutput();
  1421. X    else numbernotclose = backoutput();
  1422. X    if (numbernotclose != 0)
  1423. X     {
  1424. X#ifndef SYMMETRIC
  1425. X      if (update == 'c') cbackinner(); else backinner();
  1426. X#endif
  1427. X     }
  1428. X    else /* this one pattern has been learned */
  1429. X     {
  1430. X      passed = passed + 1;
  1431. X      unlearned = unlearned - 1;
  1432. X      last->currentpat->bypass = skiprate;
  1433. X#ifndef SYMMETRIC
  1434. X      if (backprop) if (update == 'c') cbackinner(); else backinner();
  1435. X#endif
  1436. X     }
  1437. X   }
  1438. X  else last->currentpat->bypass = last->currentpat->bypass - 1;
  1439. X };
  1440. Xif (update == 'c') totaliter = totaliter + 1;
  1441. Xif (up_to_date_stats == '+' && update == 'c') patcheck(1,npats,0,0,1,0,0);
  1442. Xif (unlearned == 0) return;
  1443. Xif (skiprate && (attempted == passed))
  1444. X {
  1445. X  resetpats();
  1446. X  for (i=1;i<=npats;i++)
  1447. X   {
  1448. X    nextpat();
  1449. X    if (last->currentpat->bypass > 0) last->currentpat->bypass = 0;
  1450. X   };
  1451. X };
  1452. Xif (update == 'c') return;
  1453. Xelse if (update == 'd') dbd_update();
  1454. Xelse if (update == 'p') periodic_update();
  1455. Xelse if (update == 'q') qp_update();
  1456. Xelse if (update == 's') supersab();
  1457. Xif (up_to_date_stats == '+') patcheck(1,npats,0,0,1,0,0);
  1458. Xtotaliter = totaliter + 1;
  1459. X}
  1460. X
  1461. Xvoid kick(size,amount) /* give the network a kick */
  1462. XWTTYPE size, amount;
  1463. X{ 
  1464. XLAYER *layer;
  1465. XUNIT *u;
  1466. XWTNODE *w;
  1467. XWTTYPE value;
  1468. XWTTYPE delta;
  1469. Xint sign;
  1470. X
  1471. Xlayer = start->next;
  1472. Xwhile (layer != NULL)
  1473. X {
  1474. X  u = (UNIT *) layer->units;
  1475. X  while (u != NULL)
  1476. X   {
  1477. X    w = (WTNODE *) u->wtlist;
  1478. X    while (w != NULL)
  1479. X     {
  1480. X#ifdef SYMMETRIC
  1481. X      value = *(w->weight);
  1482. X#else
  1483. X      value = w->weight;
  1484. X#endif
  1485. X      if (value != 0) sign = 1;
  1486. X      else if ((rand() & 32767) > 16383) sign = -1;
  1487. X      else sign = 1;
  1488. X      delta = (INT32) sign * amount * (rand() & 32767) / 32768;
  1489. X      if (value >= size) value = value - delta;
  1490. X      else if (value < -size) value = value + delta;
  1491. X#ifdef SYMMETRIC
  1492. X      if (((UNIT *) w->backunit)->unitnumber != u->unitnumber &&
  1493. X         w->next != NULL)
  1494. X         *(w->weight) = value;
  1495. X#else
  1496. X      w->weight = value;
  1497. X#endif
  1498. X      w = w->next;
  1499. X     }
  1500. X    u = u->next;
  1501. X   }
  1502. X  layer = layer->next;
  1503. X } 
  1504. X}
  1505. X
  1506. Xvoid newoneset() /* go through the patterns once and update weights */
  1507. X{ int i;
  1508. X  LAYER *layer;
  1509. X  register UNIT *u;
  1510. X  register WTNODE *w;
  1511. X  short numbernotclose, attempted, passed;
  1512. X
  1513. Xbegin:
  1514. X layer = last;      /* make all b->totals = 0 */
  1515. X while (layer->backlayer != NULL)
  1516. X  {
  1517. X   u = (UNIT *) layer->units;
  1518. X   while (u != NULL)
  1519. X    {
  1520. X     w = (WTNODE *) u->wtlist;
  1521. X     while (w != NULL)
  1522. X      {
  1523. X#ifdef SYMMETRIC
  1524. X       *(w->total) = 0;
  1525. X#else
  1526. X       w->total = 0;
  1527. X#endif
  1528. X       w = w->next;
  1529. X      };
  1530. X     u = u->next;
  1531. X    };
  1532. X   layer = layer->backlayer;
  1533. X  };
  1534. X attempted = 0;
  1535. X passed = 0;
  1536. X unlearned = npats;
  1537. X resetpats();
  1538. X for(i=1;i<=npats;i++)
  1539. X  {
  1540. X   nextpat();
  1541. X   if (last->currentpat->bypass == 0)
  1542. X    {
  1543. X     setonepat();
  1544. X     forward();
  1545. X     attempted = attempted + 1;
  1546. X     if (update == 'c') numbernotclose = cbackoutput();
  1547. X     else numbernotclose = backoutput();
  1548. X     if (numbernotclose != 0)
  1549. X      {
  1550. X#ifndef SYMMETRIC
  1551. X       if (update == 'c') cbackinner(); else backinner();
  1552. X#endif
  1553. X      }
  1554. X     else /* this one pattern has been learned */
  1555. X      {
  1556. X       passed = passed + 1;
  1557. X       unlearned = unlearned - 1;
  1558. X       last->currentpat->bypass = skiprate;
  1559. X#ifndef SYMMETRIC
  1560. X       if (backprop) if (update == 'c') cbackinner(); else backinner();
  1561. X#endif
  1562. X      }
  1563. X    }
  1564. X   else last->currentpat->bypass = last->currentpat->bypass - 1;
  1565. X   if (g && (i % g == 0 || i == npats))
  1566. X    {
  1567. X     if (update == 'd') dbd_update();
  1568. X     else if (update == 'p') periodic_update();
  1569. X     layer = last;      /* make all b->totals = 0 */
  1570. X     while (layer->backlayer != NULL)
  1571. X      {
  1572. X       u = (UNIT *) layer->units;
  1573. X       while (u != NULL)
  1574. X        {
  1575. X         w = (WTNODE *) u->wtlist;
  1576. X         while (w != NULL)
  1577. X          {
  1578. X           w->total = 0;
  1579. X           w = w->next;
  1580. X          };
  1581. X         u = u->next;
  1582. X        };
  1583. X       layer = layer->backlayer;
  1584. X      }; /* end while */
  1585. X    };  /* end if g */
  1586. X}; /* end for i */
  1587. Xif (update == 'c'|| g != 0) totaliter = totaliter + 1;
  1588. Xif (up_to_date_stats == '+' && update == 'c') patcheck(1,npats,0,0,1,0,0);
  1589. Xif (unlearned == 0) return;
  1590. Xif (skiprate && (attempted == passed))
  1591. X {
  1592. X  resetpats();
  1593. X  for (i=1;i<=npats;i++)
  1594. X   {
  1595. X    nextpat();
  1596. X    last->currentpat->bypass = 0;
  1597. X   };
  1598. X  goto begin;
  1599. X };
  1600. Xif (g == 0)
  1601. X {
  1602. X  if (update == 'c') return;
  1603. X  else if (update == 'd') dbd_update();
  1604. X  else if (update == 'p') periodic_update();
  1605. X  else if (update == 'q') qp_update();
  1606. X  else if (update == 's') supersab();
  1607. X };
  1608. Xif (up_to_date_stats == '+') patcheck(1,npats,0,0,1,0,0);
  1609. Xif (g == 0) totaliter = totaliter + 1;
  1610. X}
  1611. X
  1612. Xint run(n,prpatsrate)
  1613. Xint n;            /* the number of iterations to run */
  1614. Xint prpatsrate;   /* rate at which to print output patterns */
  1615. X{
  1616. Xint i, wtlimitbefore;
  1617. X#ifndef UNIX
  1618. Xint chx;
  1619. X#endif
  1620. X
  1621. Xif (pg("running . . .\n")) return(1);
  1622. Xfor (i=1;i<=n;i++)
  1623. X {
  1624. X  totaldiff = 0;
  1625. X  wtlimitbefore = wtlimithit;
  1626. X  if (g == 0) oneset(); else newoneset();
  1627. X  stats(1);
  1628. X  if (wtlimitbefore == 0 && wtlimithit == 1)
  1629. X   {
  1630. X    sprintf(outstr,">>>>> WEIGHT LIMIT HIT <<<<< at %d\n",totaliter);
  1631. X    if (pg(outstr)) return(1);
  1632. X   };
  1633. X  if (unlearned == 0) /* training finished */
  1634. X   {
  1635. X    if (benchmark && testpat)
  1636. X     {
  1637. X      sprintf(outstr,"S  %d iterations",totaliter); pg(outstr);
  1638. X      sprintf(outstr," %9.5f error/unit\n",errorperunit); pg(outstr);
  1639. X      if (patcheck(testpat,testpat,1,1,0,0,0)) return(1);
  1640. X     };
  1641. X    if ((prpatsrate > 0 && lastprint != totaliter))
  1642. X     if (patcheck(1,npats,summary == '-',summary == '-',1,1,0)) return(1);
  1643. X    sprintf(outstr,"patterns learned to within %4.2f",unscale(toler));
  1644. X    pg(outstr);
  1645. X    pg(" at iteration");
  1646. X    if (ringbell == '+') putchar(7);
  1647. X    sprintf(outstr," %d\n",totaliter);
  1648. X    if (pg(outstr)) return(1);
  1649. X    if (benchmark && *testfile != emptystring) testcheck();
  1650. X    return(0);
  1651. X   };
  1652. X  if (benchmark && testpat && (prpatsrate > 0 && i % prpatsrate == 0))
  1653. X   {
  1654. X    if (unlearned == 1) pg("S"); else pg("F");
  1655. X    sprintf(outstr," %d iterations",totaliter); pg(outstr);
  1656. X    sprintf(outstr," %7.5f error/unit\n",errorperunit);
  1657. X    if (pg(outstr)) return(1);
  1658. X    if (patcheck(testpat,testpat,1,1,0,0,0)) return(1);
  1659. X   }
  1660. X  if (totaliter % saverate == 0) saveweights();
  1661. X  if ((prpatsrate > 0) && ((i % prpatsrate == 0) || (i == n)))
  1662. X   {
  1663. X    if (patcheck(1,npats,summary == '-',summary == '-',1,1,
  1664. X             up_to_date_stats == '-')) return(1);
  1665. X    if (benchmark && (*testfile != emptystring)) testcheck();
  1666. X   };
  1667. X#ifndef UNIX
  1668. X  if (kbhit() && getch() == 27 /* escape key */) return(1);
  1669. X#endif
  1670. X };
  1671. Xreturn(0);
  1672. X} 
  1673. END_OF_FILE
  1674. if test 17655 -ne `wc -c <'misc.c'`; then
  1675.     echo shar: \"'misc.c'\" unpacked with wrong size!
  1676. fi
  1677. # end of 'misc.c'
  1678. fi
  1679. echo shar: End of archive 4 \(of 4\).
  1680. cp /dev/null ark4isdone
  1681. MISSING=""
  1682. for I in 1 2 3 4 ; do
  1683.     if test ! -f ark${I}isdone ; then
  1684.     MISSING="${MISSING} ${I}"
  1685.     fi
  1686. done
  1687. if test "${MISSING}" = "" ; then
  1688.     echo You have unpacked all 4 archives.
  1689.     rm -f ark[1-9]isdone
  1690. else
  1691.     echo You still need to unpack the following archives:
  1692.     echo "        " ${MISSING}
  1693. fi
  1694. ##  End of shell archive.
  1695. exit 0
  1696.  
  1697. exit 0 # Just in case...
  1698.