{$R-}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N+}    { numeric coprocessor}
{$M 16384,0,655360} {Turbo 3 default stack and heap}

Program decmpstr(input,output);


(*Prg reads std nw network LST and evaluates wts*)
(*Prg is NOT general, only for bindind site inputs,with
<=100 interneurons*)
(*sum over all hidden neurons for rel effect of one binary word on a
SINGLE o.n.*)
(* within the context of a specific input sequence*)
(*LST file must be edited: out 1st and named 'ONE' where was 'PE', input 2nd, all'bias' replaced
w0000*)


Uses WinCRT;

Label 1;

Type
numptr=^darr;
darr=record
      nnum:double;
      linker:numptr;
     end;



Var
z,l,n,j,k,g,F,ct,basect,first,second,third,seql,ans,opn,flag10,sct,
totct,bitct,onect,bitts
 :integer;
x,y,basevar,ch,query,reply
 :char;
ifil,ifil2,ifil3,ofil,ofil2,ifil4
 :text;
 zct:longint;
namei,w,filename,seqstr,teststr
 :string;
a,b,c,d,e,maxwt,sumactwt,sumposwt,relf,f1,f2,f3,f4,f5,
maxf,tal,sumoutal,p1actwt,currseqval,currexp,d1,d2,relfA,relfB,relfD,
relfC,maxfp,maxfn,totout
 :double;
 infline,tstline,tstlinel
 :string[12];
flag1
 :boolean;
top1,top2,top3,top4,top5,
top6,top7,top8,top9,top10,top11,top12,
top13,top14,top15,top16,top17,top18,top19,top20,
top21,top22,top23,top24,top25,top26,top27,top28,top29,
top30,top31,top32,top33,frac,frac1,top,top34,top35,top36,top37,top38,
top39,top40,top41,top42,top43,top44,top45,
top46,top47,top48,top49,top50,top51,top52,top53,
top54,top55,top56,top57,top58,top59,top60,top61,top62,
top63,top64,top65,top66,top67,top68,top69,top70,top71,top72,
top73,top74,top75,top76,top77,top78,top79,
top80,top81,top82,top83,top84,top85,top86,top87,
top88,top89,top90,top91,top92,top93,top94,top95,top96,
top97,top98,top99,top100,sumout,first1,last
:numptr;
wtout                            :array[0..21] of double;  (****!!VARIABLE!!****)
(*=second+1*)
actwt                            :numptr;

(*=first/2*)
artfrac                          :array[1..20] of double;             (*"*)
(*=second*)
(****************************************************************
******)
Procedure Initialize;
Begin
(*  writeln('Enter the name of the modified LST input file');
  readln(namei);      *)
  NAMEI:='O:\400a\a9m.lst';                                (****!!VARIABLE!!****)

  assign(ifil,namei);
  reset(ifil);
  assign(ofil,'O:\400a\dec9');                            (****!!VARIABLE!!****)
  rewrite(ofil);
  writeln('Enter # of bits per word.');
  readln(bitts);                           (****!!VARIABLE!!****)
  writeln('Enter # of words in the input.');
  readln(second);

  first:=bitts*second;                                                  (*"*)
  seql:=second;
  second:=8;                                                    (*"*)
  third:=1;                                                      (*"*)
  if second>100 then writeln('second layer out of range');
 (* writeln('Enter the name of the nna file for example being
decompiled');
  readln(namei);*)
  namei:='O:\400a\a95.nna';                                   (****!!VARIABLE!!****)
  assign(ifil2,namei);
  reset(ifil2);
(*  writeln('Enter name of nnr file chk correct format');
  readln(namei);*)
  NAMEI:='O:\400a\a95.nn';                                    (****!!VARIABLE!!****)
  assign(ifil3,namei);
  reset(ifil3);
  readln(ifil3,currseqval);    (*Specific for single output*)
  ans:=1;
  sumoutal:=0;
  totout:=0;
  totct:=1;
  flag10:=0;
  onect:=0;
  bitct:=0;
  sct:=1;
  zct:=0;
  opn:=1;
  relfA:=0;
  relfB:=0;
  relfC:=0;
  flag1:=false;
end;
(****************************************************************
*******)
Procedure Readin;


var

val,mult                                                   :double;
d
:longint;
ctr
:integer;


Begin

  n:=0;
  k:=0;
  l:=1;

{  for n:=1 to second do
    for k:=1 to (first +1) do
     frac[k,n]:=0;
                    }
    for k:=1 to second do
     begin
      wtout[k]:=0;
     end;
    wtout[0]:=0;
    {
  for k:=1 to (seql+1) do
    for n:=1 to second do
      actwt[k,n]:=0;
     }





tstlinel:='   ONE';

    repeat                (*Independent of specific PE #*)
    readln(ifil,infline);
    until infline=tstlinel;
  readln(ifil);
  readln(ifil);
  readln(ifil);
  readln(ifil);
(*  readln(ifil);*)

(*  for l:=1 to third do
  begin *)

   for k:=0 to (second) do
    begin
    readln(ifil,a,b,c,w);
    wtout[k]:=c;
    end;
   (*  readln(ifil);
     readln(ifil);
     readln(ifil);
     readln(ifil);
     readln(ifil);
     readln(ifil);
  end; *)


   reset(ifil);
        for k:=1 to second do         (*kindexes interneuron*)
          begin
                  case k of
                 1:tstline:='   PE: 1';    (*=first+2*) (**!!VARIABLE!!****)
                 2:tstline:='   PE: 2';
                 3:tstline:='   PE: 3';
                 4:tstline:='   PE: 4';
                 5:tstline:='   PE: 5';
                 6:tstline:='   PE: 6';
                 7:tstline:='   PE: 7';
                 8:tstline:='   PE: 8';
                 9:tstline:='   PE: 4435';
                10:tstline:='   PE: 4436';
                11:tstline:='   PE: 4437';
                12:tstline:='   PE: 4438';
                13:tstline:='   PE: 4439';
                14:tstline:='   PE: 4440';
                15:tstline:='   PE: 4441';
                16:tstline:='   PE: 4442';
                17:tstline:='   PE: 4443';
                18:tstline:='   PE: 4444';
                19:tstline:='   PE: 4445';
                20:tstline:='   PE: 4446';
                21:tstline:='   PE: 28784';
                22:tstline:='   PE: 28785';
                23:tstline:='   PE: 28786';
                24:tstline:='   PE: 28787';  (*=end of second*)
                25:tstline:='   PE: 28788';  (*1+end of second*)
                26:tstline:='   PE: 28789';
                27:tstline:='   PE: 28790';
                28:tstline:='   PE: 28791';
                29:tstline:='   PE: 28792';
                30:tstline:='   PE: 28793';
                31:tstline:='   PE: 28794';
                32:tstline:='   PE: 28795';
                33:tstline:='   PE: 28796';
                34:tstline:='   PE: 28797';
                35:tstline:='   PE: 28798';          (*first+second+1 or PE for last of second*)
                36:tstline:='   PE: 15202';
                37:tstline:='   PE: 15203';
                38:tstline:='   PE: 15204';
                39:tstline:='   PE: 15205';
                40:tstline:='   PE: 15206';
                41:tstline:='   PE: 15207';
                42:tstline:='   PE: 15208';
                43:tstline:='   PE: 15209';
                44:tstline:='   PE: 15210';
                45:tstline:='   PE: 15211';
                46:tstline:='   PE: 15212';
                47:tstline:='   PE: 15213';
                48:tstline:='   PE: 15214';
                49:tstline:='   PE: 15215';
                50:tstline:='   PE: 15216';
                51:tstline:='   PE: 13364';
                52:tstline:='   PE: 13365';
                53:tstline:='   PE: 13366';
                54:tstline:='   PE: 13367';
                55:tstline:='   PE: 13368';
                56:tstline:='   PE: 13369';
                57:tstline:='   PE: 13370';
                58:tstline:='   PE: 13371';
                59:tstline:='   PE: 13372';
                60:tstline:='   PE: 13373';
                61:tstline:='   PE: 13374';
                62:tstline:='   PE: 13375';
                63:tstline:='   PE: 13376';
                64:tstline:='   PE: 13377';
                65:tstline:='   PE: 13378';
                66:tstline:='   PE: 13379';
                67:tstline:='   PE: 13380';
                68:tstline:='   PE: 13381';
                69:tstline:='   PE: 13382';
                70:tstline:='   PE: 13383';
                71:tstline:='   PE: 13384';
                72:tstline:='   PE: 13385';
                73:tstline:='   PE: 13386';
                74:tstline:='   PE: 13387';
                75:tstline:='   PE: 13388';
                76:tstline:='   PE: 13389';
                77:tstline:='   PE: 13390';
                78:tstline:='   PE: 13391';
                79:tstline:='   PE: 13392';
                80:tstline:='   PE: 13393';
                81:tstline:='   PE: 13394';
                82:tstline:='   PE: 13395';
                83:tstline:='   PE: 13396';
                84:tstline:='   PE: 13397';
                85:tstline:='   PE: 13398';
                86:tstline:='   PE: 13399';
                87:tstline:='   PE: 13400';
                88:tstline:='   PE: 13401';
                89:tstline:='   PE: 13402';
                90:tstline:='   PE: 13403';
                91:tstline:='   PE: 13404';  (*=end of second*)
                92:tstline:='   PE: 13405';  (*1+end of second*)
                93:tstline:='   PE: 13406';
                94:tstline:='   PE: 13407';
                95:tstline:='   PE: 13408';
                96:tstline:='   PE: 13409';
                97:tstline:='   PE: 13410';
                98:tstline:='   PE: 13411';
                99:tstline:='   PE: 13412';
               100:tstline:='   PE: 13413';

               end;(*case*)

               repeat
                 readln(ifil,infline);
               until infline=tstline;
               readln(ifil);
               readln(ifil);
               readln(ifil);
               readln(ifil);
               readln(ifil,a,b,c,w);
               new(frac1);
               new(frac);
               frac^.linker:=nil;
               frac^.nnum:=c;
               artfrac[k]:=c;           (*reads in bias for each
                                            middle neuron*)
               frac^.linker:=frac;
               frac1:=frac;
               case k of
               1:top1:=frac;           (*sets ptr to each set of
                                 input wts for ea middle
                                  neuron,includes bias at pos1*)
               2:top2:=frac;
               3:top3:=frac;
               4:top4:=frac;
               5:top5:=frac;
               6:top6:=frac;
               7:top7:=frac;
               8:top8:=frac;
               9:top9:=frac;
              10:top10:=frac;
              11:top11:=frac;
              12:top12:=frac;
              13:top13:=frac;
              14:top14:=frac;
              15:top15:=frac;
              16:top16:=frac;
              17:top17:=frac;
              18:top18:=frac;
              19:top19:=frac;
              20:top20:=frac;
              21:top21:=frac;
              22:top22:=frac;
              23:top23:=frac;
              24:top24:=frac;
              25:top25:=frac;
              26:top26:=frac;
              27:top27:=frac;
              28:top28:=frac;
              29:top29:=frac;
              30:top30:=frac;
              31:top31:=frac;
              32:top32:=frac;
              33:top33:=frac;
              34:top34:=frac;           (*sets ptr to each set of
                                          input wts for ea middle
                                           neuron,includes bias at pos1*)
              35:top35:=frac;
              36:top36:=frac;
              37:top37:=frac;
              38:top38:=frac;
              39:top39:=frac;
              40:top40:=frac;
              41:top41:=frac;
              42:top42:=frac;
              43:top43:=frac;
              44:top44:=frac;
              45:top45:=frac;
              46:top46:=frac;
              47:top47:=frac;
              48:top48:=frac;
              49:top49:=frac;
              50:top50:=frac;
              51:top51:=frac;
              52:top52:=frac;
              53:top53:=frac;
              54:top54:=frac;
              55:top55:=frac;
              56:top56:=frac;
              57:top57:=frac;
              58:top58:=frac;
              59:top59:=frac;
              60:top60:=frac;
              61:top61:=frac;
              62:top62:=frac;
              63:top63:=frac;
              64:top64:=frac;
              65:top65:=frac;
              66:top66:=frac;
              67:top67:=frac;
              68:top68:=frac;  (*sets ptr to each set of input wts
                               for ea middle neuron,includes bias
                                at pos1*)
              69:top69:=frac;
              70:top70:=frac;
              71:top71:=frac;
              72:top72:=frac;
              73:top73:=frac;
              74:top74:=frac;
              75:top75:=frac;
              76:top76:=frac;
              77:top77:=frac;
              78:top78:=frac;
              79:top79:=frac;
              80:top80:=frac;
              81:top81:=frac;
              82:top82:=frac;
              83:top83:=frac;
              84:top84:=frac;
              85:top85:=frac;
              86:top86:=frac;
              87:top87:=frac;
              88:top88:=frac;
              89:top89:=frac;
              90:top90:=frac;
              91:top91:=frac;
              92:top92:=frac;
              93:top93:=frac;
              94:top94:=frac;
              95:top95:=frac;
              96:top96:=frac;
              97:top97:=frac;
              98:top98:=frac;
              99:top99:=frac;
             100:top100:=frac;

              end;
               for n:=1 to (first ) do               (*reads input
                                               wts   to ea middle
                                                     neuron*)
                 begin
                   new(frac);
                   readln(ifil,a,b,c,w);
                   frac^.linker:=nil;
                   frac^.nnum:=c;
                   frac1^.linker:=frac;
                   frac1:=frac;
                  end;
             end;(*for k*)
n:=0;

z:=0;
relf:=0;
sumactwt:=0;

while n<(first+1) do        (* chk first or first+ 1 *)
  begin
    repeat
       read(ifil2,ch);
    until ch in ['0','1'];
    n:=succ(n);
    if ch='0'then
     mult:=0
      else
       mult:=1;
    for k:=1 to second do
          begin
                 case k of
               1:top:=top1;
               2:top:=top2;
               3:top:=top3;
               4:top:=top4;
               5:top:=top5;
               6:top:=top6;
               7:top:=top7;
               8:top:=top8;
               9:top:=top9;
              10:top:=top10;
              11:top:=top11;
              12:top:=top12;
              13:top:=top13;
              14:top:=top14;
              15:top:=top15;
              16:top:=top16;
              17:top:=top17;
              18:top:=top18;
              19:top:=top19;
              20:top:=top20;
              21:top:=top21;
              22:top:=top22;
              23:top:=top23;
              24:top:=top24;
              25:top:=top25;
              26:top:=top26;
              27:top:=top27;
              28:top:=top28;
              29:top:=top29;
              30:top:=top30;
              31:top:=top31;
              32:top:=top32;
              33:top:=top33;
              34:top:=top34;
              35:top:=top35;
              36:top:=top36;
              37:top:=top37;
              38:top:=top38;
              39:top:=top39;
              40:top:=top40;
              41:top:=top41;
              42:top:=top42;
              43:top:=top43;
              44:top:=top44;
              45:top:=top45;
              46:top:=top46;
              47:top:=top47;
              48:top:=top48;
              49:top:=top49;
              50:top:=top50;
              51:top:=top51;
              52:top:=top52;
              53:top:=top53;
              54:top:=top54;
              55:top:=top55;
              56:top:=top56;
              57:top:=top57;
              58:top:=top58;
              59:top:=top59;
              60:top:=top60;
              61:top:=top61;
              62:top:=top62;
              63:top:=top63;
              64:top:=top64;
              65:top:=top65;
              66:top:=top66;
              67:top:=top67;
              68:top:=top68;
              69:top:=top69;
              70:top:=top70;
              71:top:=top71;
              72:top:=top72;
              73:top:=top73;
              74:top:=top74;
              75:top:=top75;
              76:top:=top76;
              77:top:=top77;
              78:top:=top78;
              79:top:=top79;
              80:top:=top80;
              81:top:=top81;
              82:top:=top82;
              83:top:=top83;
              84:top:=top84;
              85:top:=top85;
              86:top:=top86;
              87:top:=top87;
              88:top:=top88;
              89:top:=top89;
              90:top:=top90;
              91:top:=top91;
              92:top:=top92;
              93:top:=top93;
              94:top:=top94;
              95:top:=top95;
              96:top:=top96;
              97:top:=top97;
              98:top:=top98;
              99:top:=top99;
             100:top:=top100;


              end;
      if n=1 then
       begin
        frac:=top;
        frac:=frac^.linker;
        val:=frac^.nnum;            (*first of input wts for ea of
                                       middle neuron*)
        if val=0 then val:=0.0000001;
        val:=(mult)*(val);
        frac^.nnum:=val;        (* if input neuron inactive , ch wt
                                   to 0*)
       end
        else
         begin
          frac:=top;
          if n<=(first)then
           for ctr:=1 to (n) do
            frac:=frac^.linker ;       (*positions ptr to neutralize
                                        inactive inputs*)
          val:=frac^.nnum;
          if val=0 then val:=0.0000001;
          val:=(mult)*(val);
          frac^.nnum:=(val);
         end;


     end; (*for k*)

   end;(*while n*)

end;
(****************************************************************
*******)
Procedure Calc;
Label 2;
Var topp               :numptr;
    val1               :real;
Begin

 relf:=0;
 for k:=1 to second do  (*computes single word input effect thruall i.n.*)
  begin

   case k of
               1:topp:=top1;
               2:topp:=top2;
               3:topp:=top3;
               4:topp:=top4;
               5:topp:=top5;
               6:topp:=top6;
               7:topp:=top7;
               8:topp:=top8;
               9:topp:=top9;
              10:topp:=top10;
              11:topp:=top11;
              12:topp:=top12;
              13:topp:=top13;
              14:topp:=top14;
              15:topp:=top15;
              16:topp:=top16;
              17:topp:=top17;
              18:topp:=top18;
              19:topp:=top19;
              20:topp:=top20;
              21:topp:=top21;
              22:topp:=top22;
              23:topp:=top23;
              24:topp:=top24;
              25:topp:=top25;
              26:topp:=top26;
              27:topp:=top27;
              28:topp:=top28;
              29:topp:=top29;
              30:topp:=top30;
              31:topp:=top31;
              32:topp:=top32;
              33:topp:=top33;
              34:topp:=top34;           (*sets ptr to each set of
                               input wts for ea middle neuron,includes bias at pos1*)
              35:topp:=top35;
              36:topp:=top36;
              37:topp:=top37;
              38:topp:=top38;
              39:topp:=top39;
              40:topp:=top40;
              41:topp:=top41;
              42:topp:=top42;
              43:topp:=top43;
              44:topp:=top44;
              45:topp:=top45;
              46:topp:=top46;
              47:topp:=top47;
              48:topp:=top48;
              49:topp:=top49;
              50:topp:=top50;
              51:topp:=top51;
              52:topp:=top52;
              53:topp:=top53;
              54:topp:=top54;
              55:topp:=top55;
              56:topp:=top56;
              57:topp:=top57;
              58:topp:=top58;
              59:topp:=top59;
              60:topp:=top60;
              61:topp:=top61;
              62:topp:=top62;
              63:topp:=top63;
              64:topp:=top64;
              65:topp:=top65;
              66:topp:=top66;
              67:topp:=top67;
              68:topp:=top68;
              69:topp:=top69;
              70:topp:=top70;
              71:topp:=top71;
              72:topp:=top72;
              73:topp:=top73;
              74:topp:=top74;
              75:topp:=top75;
              76:topp:=top76;
              77:topp:=top77;
              78:topp:=top78;
              79:topp:=top79;
              80:topp:=top80;
              81:topp:=top81;
              82:topp:=top82;
              83:topp:=top83;
              84:topp:=top84;
              85:topp:=top85;
              86:topp:=top86;
              87:topp:=top87;
              88:topp:=top88;
              89:topp:=top89;
              90:topp:=top90;
              91:topp:=top91;
              92:topp:=top92;
              93:topp:=top93;
              94:topp:=top94;
              95:topp:=top95;
              96:topp:=top96;
              97:topp:=top97;
              98:topp:=top98;
              99:topp:=top99;
             100:topp:=top100;


              end;
     frac:=topp;
     frac:=frac^.linker;                          (*move ptr past
                                                    bias val*)
    for j:=1 to (first) do
      begin
        sumactwt:=sumactwt+frac^.nnum;              (*sum all active wts
                                               to each middle neuron in turn*)
        frac:=frac^.linker;
      end;


    frac:=topp;
(*    frac:=frac^.linker;  *)                        (*move ptr past bias val*)
     if (frac<>nil) and (frac^.linker<>nil) then
    for ct:=1 to totct do
      begin
      frac:=frac^.linker;                         (*moves to next word*)
      end;

    for bitct:=1 to bitts do
     begin
       val1:=frac^.nnum;

       if val1<>0 then                            (* reduces sumactwt for
                                               each 1 in the word by 15%*)
         begin
           sumactwt:=sumactwt-0.15*val1;
           onect:=succ(onect);
         end;
       frac:=frac^.linker;
     end; (*for*)


    if onect=0 then
     begin
       relf:=-1000;
       k:=second;
       goto 2;
     end;
    onect:=0;



   (*
f1:=((actwt[ans,k]+artfrac[k]/seql)/(sumactwt+artfrac[k]));*)

f2:=wtout[k]/(1+exp(-(sumactwt+artfrac[k])));    (*wt-prod of k middle neuron
                                                  to output neuron*)
(*f3:=f2/wtout[k];*)

(* f4:=(f3-0.5)/abs(f3-0.5);

f5:=(f2*(1-f4)/seql) +f2*f4*f1;  *)

    relf:=relf + f2 +wtout[0]/(second);   (*total sum to output neuron from
                                          all middle neurons, OUTPUT BIAS
                                           included*)
2:  sumactwt:=0;
  end;(*for k*)

end;

(****************************************************************
*****)
(*main*)

Begin
   Initialize;
   Readin;
   new(first1);
   new(last);
   1: Calc;
(*       if relf<> -1000 then
         begin*)
           new(sumout);
           sumout^.nnum:=relf;
           last^.linker:=sumout;
           sumout^.linker:=nil;
           last:=sumout;
           if ans=1 then first1:=sumout;
(*         end;   *)
   ans:=ans+1;
   totct:=(totct+bitts);
   if ans<(seql+1) then
        goto 1;

   sumout:=first1;
   for k:=1 to (seql) do
    begin
     if sumout^.nnum= -1000
        then
         sumout^.nnum:=0
           else
            begin
              sumout^.nnum:=1/(1+exp(-(sumout^.nnum)));    (*computed output
                                                         from each active
                                                         input neuron reduced
                                                         15% at input*)
              sumout^.nnum:=currseqval-sumout^.nnum     (* computed change
                                                        from real output due
                                               to single input perturbation*)
           end; (*else*)
     sumout:=sumout^.linker;
    end; (*for k*)


   sumout:=first1;
   maxfp:=sumout^.nnum;
   maxfn:=sumout^.nnum;
   n:=0;
   ct:=0;

   sumout:=first1;
   for k:=1 to (seql) do
    begin
      if sumout^.nnum>0 then
       if maxfp<sumout^.nnum then
        maxfp:=sumout^.nnum;
      if sumout^.nnum<=0 then
       if maxfn>sumout^.nnum then
        maxfn:=sumout^.nnum;
      sumout:=sumout^.linker;
    end;
    maxfn:=-maxfn;
    if maxfp>maxfn then
       maxf:=maxfp
        else
         maxf:=maxfn;


   sumout:=first1;
   for k:= 1 to (seql) do
     begin
        sumout^.nnum:= sumout^.nnum/maxf;  (* MUST REMOVE if want actual values*)
        sumout:=sumout^.linker;
     end;

   sumout:=first1;
   for k:=1 to (seql) do
    begin
     if abs(sumout^.nnum)>0.8 then
      writeln(ofil,'output neuron',opn,' position',' ',k,' ',sumout^.nnum);
     sumout:=sumout^.linker;
    end;

   writeln(ofil, 'Maxf is ',maxf);

   sumout:=first1;
   for k:=1 to seql do
    begin
      totout:= totout+sumout^.nnum;
      sumout:=sumout^.linker;
    end;
   writeln(ofil,totout);


   close(ifil2);
   close(ifil3);
   close(ofil);
   close(ifil);
end.