/* returns the average of the epsilons of the pre-synaptic weights */
static flt
averagesyneps(neurone *n)
{
synapse *s;
flt sum;
int num;
Fclr(sum); num=0;
for ( s=n->FSamont; s!=NIL; s=s->NSaval ) {
num++;
sum = Fadd(sum, s->Sepsilon);
}
if (num>0) return Fdiv(sum,InttoF(num));
else return Flt0;
}
/* multiply the accumulators
* by the inverse diagonal
* hessian (hess)
*/
void
Hess_acc(weight *nptr)
{
int i, iend;
weight *w;
if (nptr==NULL) {
w=weightbase;
iend=weightnombre;
} else {
w=nptr;
iend=1;
}
for ( i=0; i<iend; i++, w++ ) {
w->Wacc=Fdiv( w->Wacc, Fadd( mu, Fabs(w->Whess)));
}
}
static flt
mean_sq_input(neurone *n)
{
synapse *s;
flt sum, nbre;
Fclr(sum);
Fclr(nbre);
for ( s=n->FSamont; s!=NIL; s=s->NSaval ) {
flt x = s->Namont->Nval;
sum = Fadd( sum, Fmul(x,x) );
nbre=Fadd(nbre,Flt1);
};
if (nbre>Flt0)
return Fdiv(sum,nbre);
else
return Flt0;
}
char *expr(int prec, struct var **rtv)
{
char *x = "0";
struct var *v = 0;
while (*ptr == ' ' || *ptr == '\t')
++ptr;
if ((*ptr >= 'a' && *ptr <= 'z') || (*ptr >= 'A' && *ptr <= 'Z') || *ptr == '_') {
char *s = ptr, c;
while ((*ptr >= 'a' && *ptr <= 'z') || (*ptr >= 'A' && *ptr <= 'Z') || *ptr == '_' || (*ptr >= '0' && *ptr <= '9'))
++ptr;
c = *ptr;
*ptr = 0;
v = get(s);
x = v->val;
*ptr = c;
if (v->func) {
while (*ptr == ' ' || *ptr == '\t')
++ptr;
if (*ptr == '(') {
char *arg;
++ptr;
arg = expr(0, &dumb);
if (*ptr == ')')
++ptr;
else {
if (!err)
err = "Missing )";
}
x = v->func(arg);
} else {
if (!err)
err = "Missing argument";
}
}
} else if ((*ptr >= '0' && *ptr <= '9') || *ptr == '.') {
char *s = ptr;
while ((*ptr >= '0' && *ptr <= '9') || *ptr == '.' || *ptr == 'e' || *ptr == 'E')
++ptr;
x = (char *)malloc(ptr - s + 1);
x[ptr - s] = 0;
memcpy(x, s, ptr - s);
} else if (*ptr == '(') {
++ptr;
x = expr(0, &v);
if (*ptr == ')')
++ptr;
else {
if (!err)
err = "Missing )";
}
} else if (*ptr == '-') {
++ptr;
x = Fneg(expr(10, &dumb));
}
loop:
while (*ptr == ' ' || *ptr == '\t')
++ptr;
/* if (*ptr == '^' && 6 >= prec) {
++ptr;
x = pow(x, expr(6, &dumb));
goto loop;
} else */ if (*ptr == '*' && 5 > prec) {
++ptr;
x = Fmul(x, expr(5, &dumb));
goto loop;
} else if (*ptr == '/' && 5 > prec) {
++ptr;
x = Fdiv(x, expr(5, &dumb), precision);
goto loop;
} else if (*ptr == '+' && 4 > prec) {
++ptr;
x = Fadd(x, expr(4, &dumb));
goto loop;
} else if (*ptr == '-' && 4 > prec) {
++ptr;
x = Fsub(x, expr(4, &dumb));
goto loop;
} else if (*ptr == '=' && 2 >= prec) {
++ptr;
x = expr(2, &dumb);
if (v)
v->val = x, v->set = 1;
else {
if (!err)
err = "Left side of = is not an l-value";
}
goto loop;
}
*rtv = v;
return x;
}
static double Fdiv(FloatConstant* a, double b) {
return Fdiv(a->Value(), b, a->GetType()->GetSubtype());
}
void print_float(CL_FORM *base)
{
COPY(ARG(0), ARG(2));
Fminusp(ARG(2));
if(CL_TRUEP(ARG(2)))
{
LOAD_CHAR(ARG(2), '-', ARG(2));
COPY(ARG(1), ARG(3));
write_char1(ARG(2));
mv_count = 1;
COPY(ARG(0), ARG(2));
Fminus(ARG(2), 1);
COPY(ARG(2), ARG(0));
}
COPY(ARG(0), ARG(2));
Fzerop(ARG(2));
if(CL_TRUEP(ARG(2)))
{
LOAD_SMSTR((CL_FORM *)&Kprint_float[0], ARG(2)); /* 0.0 */
COPY(ARG(2), ARG(3));
COPY(ARG(1), ARG(4));
LOAD_FIXNUM(ARG(5), 0, ARG(5));
COPY(ARG(2), ARG(6));
Flength(ARG(6));
write_string1(ARG(3));
COPY(ARG(3), ARG(0));
}
else
{
LOAD_FIXNUM(ARG(2), 10, ARG(2));
COPY(ARG(0), ARG(2));
LOAD_FIXNUM(ARG(3), 10, ARG(3));
rt_log(ARG(2));
LOAD_FIXNUM(ARG(3), 1, ARG(3));
LOAD_FIXNUM(ARG(3), 1, ARG(3));
rt_floor(ARG(2));
mv_count = 1;
COPY(ARG(0), ARG(3));
GEN_FLOAT(ARG(4), 10.0, ARG(4));
LOAD_FIXNUM(ARG(5), -1, ARG(5));
COPY(ARG(2), ARG(6));
Fminus(ARG(5), 2);
COPY(ARG(5), ARG(6));
Fminusp(ARG(6));
if(CL_TRUEP(ARG(6)))
{
LOAD_FIXNUM(ARG(6), 1, ARG(6));
COPY(ARG(4), ARG(7));
COPY(ARG(5), ARG(8));
Fminus(ARG(8), 1);
Fexpt(ARG(7));
Fdiv(ARG(6), 2);
COPY(ARG(6), ARG(4));
}
else
{
rt_expt(ARG(4));
}
Fmult(ARG(3), 2);
LOAD_NIL(ARG(4));
COPY(SYMVAL(Slisp, 2), ARG(5)); /* SHORT-FLOAT-EPSILON */
LOAD_NIL(ARG(6));
COPY(ARG(3), ARG(7));
LOAD_FIXNUM(ARG(8), 1, ARG(8));
COPY(ARG(5), ARG(9));
Fminus(ARG(8), 2);
Fge(ARG(7), 2);
if(CL_TRUEP(ARG(7)))
{
GEN_FLOAT(ARG(7), 0.1, ARG(3));
F1plus(ARG(2));
}
COPY(ARG(2), ARG(7));
LOAD_FIXNUM(ARG(8), 7, ARG(8));
Fgt(ARG(7), 2);
if(CL_TRUEP(ARG(7)))
{
goto THEN1;
}
else
{
COPY(ARG(2), ARG(8));
LOAD_FIXNUM(ARG(9), -3, ARG(9));
Flt(ARG(8), 2);
}
if(CL_TRUEP(ARG(8)))
{
THEN1:;
LOAD_FIXNUM(ARG(7), 0, ARG(4));
}
else
{
COPY(ARG(2), ARG(4));
LOAD_FIXNUM(ARG(7), 0, ARG(2));
}
COPY(ARG(4), ARG(7));
Fminusp(ARG(7));
if(CL_TRUEP(ARG(7)))
{
LOAD_CHAR(ARG(7), '0', ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
LOAD_CHAR(ARG(7), '.', ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
LOAD_FIXNUM(ARG(7), 0, ARG(7));
M1_1:;
COPY(ARG(7), ARG(8));
COPY(ARG(4), ARG(9));
Fminus(ARG(9), 1);
F1minus(ARG(9));
Fge(ARG(8), 2);
if(CL_TRUEP(ARG(8)))
{
goto RETURN1;
}
LOAD_CHAR(ARG(8), '0', ARG(8));
COPY(ARG(1), ARG(9));
write_char1(ARG(8));
mv_count = 1;
F1plus(ARG(7));
goto M1_1;
RETURN1:;
LOAD_FIXNUM(ARG(7), -1, ARG(4));
}
M2_1:;
COPY(ARG(5), ARG(7));
LOAD_FIXNUM(ARG(8), 10, ARG(8));
Fmult(ARG(7), 2);
COPY(ARG(7), ARG(5));
LOAD_FIXNUM(ARG(7), 10, ARG(7));
COPY(ARG(3), ARG(8));
Fmult(ARG(7), 2);
LOAD_FIXNUM(ARG(8), 1, ARG(8));
LOAD_FIXNUM(ARG(8), 1, ARG(8));
rt_truncate(ARG(7));
COPY(&mv_buf[0], ARG(8));
{
int nargs;
nargs = 2;
mv_count = 1;
{
switch(nargs)
{
case 0:
LOAD_NIL(ARG(7));
case 1:
LOAD_NIL(ARG(8));
nargs = 2;
}
COPY(ARG(7), ARG(6));
COPY(ARG(8), ARG(3));
}
}
COPY(ARG(3), ARG(7));
LOAD_FIXNUM(ARG(8), 1, ARG(8));
COPY(ARG(5), ARG(9));
Fminus(ARG(8), 2);
Fge(ARG(7), 2);
if(CL_TRUEP(ARG(7)))
{
goto THEN2;
}
else
{
COPY(ARG(3), ARG(8));
COPY(ARG(5), ARG(9));
Fle(ARG(8), 2);
}
if(CL_TRUEP(ARG(8)))
{
THEN2:;
goto RETURN2;
}
COPY(ARG(6), ARG(7));
LOAD_FIXNUM(ARG(8), 10, ARG(8));
digit_char1(ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
COPY(ARG(4), ARG(7));
Fzerop(ARG(7));
if(CL_TRUEP(ARG(7)))
{
LOAD_CHAR(ARG(7), '.', ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
}
F1minus(ARG(4));
goto M2_1;
RETURN2:;
COPY(ARG(3), ARG(7));
GEN_FLOAT(ARG(8), 0.5, ARG(8));
Fge(ARG(7), 2);
if(CL_TRUEP(ARG(7)))
{
F1plus(ARG(6));
}
COPY(ARG(6), ARG(7));
LOAD_FIXNUM(ARG(8), 10, ARG(8));
digit_char1(ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
COPY(ARG(4), ARG(7));
LOAD_FIXNUM(ARG(8), 0, ARG(8));
Fge(ARG(7), 2);
if(CL_TRUEP(ARG(7)))
{
LOAD_FIXNUM(ARG(7), 0, ARG(7));
M3_1:;
COPY(ARG(7), ARG(8));
COPY(ARG(4), ARG(9));
Fge(ARG(8), 2);
if(CL_TRUEP(ARG(8)))
{
goto RETURN3;
}
LOAD_CHAR(ARG(8), '0', ARG(8));
COPY(ARG(1), ARG(9));
write_char1(ARG(8));
mv_count = 1;
F1plus(ARG(7));
goto M3_1;
RETURN3:;
LOAD_CHAR(ARG(7), '.', ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
LOAD_CHAR(ARG(7), '0', ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
}
COPY(ARG(2), ARG(7));
Fzerop(ARG(7));
if(CL_TRUEP(ARG(7)))
{
}
else
{
LOAD_CHAR(ARG(7), 'E', ARG(7));
COPY(ARG(1), ARG(8));
write_char1(ARG(7));
mv_count = 1;
COPY(ARG(2), ARG(7));
COPY(ARG(1), ARG(8));
print_integer(ARG(7));
mv_count = 1;
}
LOAD_NIL(ARG(0));
}
}
static void
updS_new_all(neurone *nptr)
{
synapse *s;
neurone *amont, *aval;
int i,iend;
flt eps, delta;
flt preprod, predecay;
flt unmoinsalpha = Fsub(Flt1, alpha);
#ifndef NONEURTYPE
/* type dependent procedure */
if (nptr==NULL)
{
aval=neurbase;
iend=neurnombre;
for ( i=0; i<iend; i++, aval++ )
updS_new_all(aval);
return;
}
if (nptr->type && nptr->type->updS_new_all)
{
(*nptr->type->updS_new_all)(nptr);
return;
}
#endif
/* Optimized procedure */
if (nptr==NULL) {
aval=neurbase;
iend=neurnombre;
} else {
aval=nptr;
iend=1;
}
#ifdef SYNEPSILON
if ((alpha==Flt0) && (decay==Flt0)) {
for ( i=0; i<iend; i++, aval++ ) {
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
eps=Fdiv(s->Sepsilon, Fadd( mu, Fabs(s->Ssigma)));
delta = Fmul( amont->Nval, Fmul(aval->Ngrad, eps) );
s->Sdelta=delta;
s->Sval = Fadd( s->Sval, delta );
}
}
} /* end of alpha=0, decay=0 */
else if ((alpha != Flt0) && (decay==0)) {
for ( i=0; i<iend; i++, aval++ ) {
preprod=Fmul( unmoinsalpha, aval->Ngrad );
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
eps=Fdiv(s->Sepsilon, Fadd( mu, Fabs(s->Ssigma)));
delta = Fadd( Fmul(s->Sdelta, alpha),
Fmul( amont->Nval, Fmul(preprod, eps) ));
s->Sdelta=delta;
s->Sval = Fadd( s->Sval, delta );
}
}
} /* end of alpha<>0, decay=0 */
else if ((alpha==Flt0) && (decay!=Flt0)) {
for ( i=0; i<iend; i++, aval++ ) {
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
eps=Fdiv(s->Sepsilon, Fadd( mu, Fabs(s->Ssigma)));
predecay=Fsub(Flt1, Fmul(eps, decay));
delta = Fmul( amont->Nval, Fmul(aval->Ngrad, eps) );
s->Sdelta=delta;
s->Sval = Fadd( Fmul(predecay, s->Sval), delta );
}
}
} /* end of alpha=0, decay<>0 */
else if ((alpha!=Flt0) && (decay!=Flt0)) {
for ( i=0; i<iend; i++, aval++ ) {
preprod=Fmul( unmoinsalpha, aval->Ngrad );
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
eps=Fdiv(s->Sepsilon, Fadd( mu, Fabs(s->Ssigma)));
predecay=Fsub(Flt1, Fmul(eps, decay));
delta = Fadd(Fmul(s->Sdelta, alpha),
Fmul( amont->Nval, Fmul(preprod, eps) ));
s->Sdelta=delta;
s->Sval = Fadd( Fmul(predecay, s->Sval), delta );
}
}
} /* end of alpha<>0, decay<>0 */
#else /* NOT SYNEPSILON */
if ((alpha==Flt0) && (decay==Flt0)) {
for ( i=0; i<iend; i++, aval++ ) {
eps=Fdiv(aval->Nepsilon, Fadd( mu, Fabs(aval->Nsigma)));
preprod=Fmul(aval->Ngrad, eps);
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
delta = Fmul( amont->Nval, preprod );
s->Sdelta=delta;
s->Sval = Fadd( s->Sval, delta );
}
}
} /* end of alpha=0, decay=0 */
else if ((alpha != Flt0) && (decay==0)) {
for ( i=0; i<iend; i++, aval++ ) {
eps=Fdiv(aval->Nepsilon, Fadd( mu, Fabs(aval->Nsigma)));
preprod=Fmul(aval->Ngrad, eps);
preprod=Fmul( unmoinsalpha, preprod );
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
delta = Fadd(Fmul(s->Sdelta, alpha),
Fmul( amont->Nval, preprod ) );
s->Sdelta=delta;
s->Sval = Fadd( s->Sval, delta );
}
}
} /* end of alpha<>0, decay=0 */
else if ((alpha==Flt0) && (decay!=Flt0)) {
for ( i=0; i<iend; i++, aval++ ) {
eps=Fdiv(aval->Nepsilon, Fadd( mu, Fabs(aval->Nsigma)));
preprod=Fmul(aval->Ngrad, eps);
predecay=Fsub(Flt1, Fmul(eps, decay));
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
delta = Fmul( amont->Nval, preprod );
s->Sdelta=delta;
s->Sval = Fadd( Fmul(predecay, s->Sval), delta );
}
}
} /* end of alpha=0, decay<>0 */
else if ((alpha!=Flt0) && (decay!=Flt0)) {
for ( i=0; i<iend; i++, aval++ ) {
eps=Fdiv(aval->Nepsilon, Fadd( mu, Fabs(aval->Nsigma)));
preprod=Fmul(aval->Ngrad, eps);
preprod=Fmul( unmoinsalpha, preprod );
predecay=Fsub(Flt1, Fmul(eps, decay));
for ( s=aval->FSamont; s!=NIL; s=s->NSaval ) {
amont=s->Namont;
delta = Fadd(Fmul(s->Sdelta, alpha),
Fmul( amont->Nval, preprod ) );
s->Sdelta=delta;
s->Sval = Fadd( Fmul(predecay, s->Sval), delta );
}
}
} /* end of alpha<>0, decay<>0 */
#endif /* SYNEPSILON */
}