home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / Q_.CMD < prev    next >
OS/2 REXX Batch file  |  1998-07-11  |  4KB  |  98 lines
  1. /*  REXX-Programm q_.cmd  */
  2.    signal on syntax name q_Msg
  3.  
  4. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  5. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  6.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  7.    lp=LastPos("\", Pfd)
  8.    Pfd=DelStr(Pfd, 1+lp)
  9.    NDAq_ =Pfd||"NDAq_.DAT"
  10.    bufND =Pfd||"NDZahl.DAT"
  11.    bufMsg=Pfd||"Meldung.DAT"
  12.    ND = LineIn(bufND, 1)
  13.  
  14.    if ND > 50 then
  15.    do
  16.      ND=50
  17.      call charout(NDAq_) ; Call SysFileDelete NDAq_
  18.      ret=LineOut(NDAq_, 50)
  19.      Call Charout,"   Achtung, nur  50 Dezimalstellen bei der Berechnung von   q_(...)"
  20.      say
  21.      Beep(444, 200); Beep(628,300)
  22.    end
  23.  
  24.    /* Wenn ND <= 50 ist, wird ND = ND  weitergegeben */
  25.    call charout(NDAq_) ; Call SysFileDelete NDAq_
  26.    ret=LineOut(NDAq_, ND)
  27.  
  28.    numeric digits 125
  29.    /*    2/sqrt(2*Pi)=sqrt(2/Pi)  */
  30.    c=0.7978845608028653558798921198687637369517172623298693153318516593413158517986036770025046678146138728606051177252703653710220
  31.    /*    1/sqrt(2*Pi)   */
  32.    d=0.39894228040143267793994605993438186847585863116493465766592582967065792589930183850125233390730693643030255886263518268551099
  33.    Numeric Digits ND+10
  34.  
  35.    arg x,y
  36.    z=x*x  /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  37.  
  38.    if length(y) > 0 then
  39.    do
  40.      call charout(NDAq_) ; Call SysFileDelete NDAq_
  41.      ret=LineOut(bufMsg, "Im Argument von  q_(...)  ist mindestens  1  nicht zulässiges Komma !")
  42.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  43.   /*  damit in den diesbezüglichen temporären Dateien                      */
  44.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  45.      EXIT
  46.    end
  47.  
  48.    if x>=0 then sgn=1; else sgn=-1
  49.    x=abs(x)
  50.  
  51.    if x >=  0    &  x <  6.2 then SIGNAL A
  52.    if x >=  6.2  &  x < 14.8 then SIGNAL B
  53.    if x >= 14.8  then do y=1; SIGNAL C; end
  54.  
  55. A: u=1; v=1; n=1; m=2;
  56.    do while abs(u/v)>10**(-ND-7)
  57.      g=-z*(m-1)/(m*(m+1)); u=u*g;  v=v+u; n=n+1; m=2*n
  58.    end
  59.    y=c*x*v; SIGNAL C
  60.  
  61. B: u=d*exp(-x*x/2)
  62.    /* Der folgende Kettenbruch stammt aus dem Lexikon der Stochastik, */
  63.    /* Seite 289; In der Definition von Φ(x) die Grenzen beachten !    */
  64.    /* Nur bis zu 8 solcher Klammer-Verschachtelungen je Zeile         */
  65.    /* werden erkannt; andernfalls meldet REXX einen Fehler.           */
  66.    v12=96/x
  67.    v11=88/(x+89/(x+90/(x+91/(x+92/(x+93/(x+94/(x+95/(x+v12))))))))
  68.    v10=80/(x+81/(x+82/(x+83/(x+84/(x+85/(x+86/(x+87/(x+v11))))))))
  69.    v9 =72/(x+73/(x+74/(x+75/(x+76/(x+77/(x+78/(x+79/(x+v10))))))))
  70.    v8 =64/(x+65/(x+66/(x+67/(x+68/(x+69/(x+70/(x+71/(x+v9 ))))))))
  71.    v7 =56/(x+57/(x+58/(x+59/(x+60/(x+61/(x+62/(x+63/(x+v8 ))))))))
  72.    v6 =48/(x+49/(x+50/(x+51/(x+52/(x+53/(x+54/(x+55/(x+v7 ))))))))
  73.    v5 =40/(x+41/(x+42/(x+43/(x+44/(x+45/(x+46/(x+47/(x+v6 ))))))))
  74.    v4 =32/(x+33/(x+34/(x+35/(x+36/(x+37/(x+38/(x+39/(x+v5 ))))))))
  75.    v3 =24/(x+25/(x+26/(x+27/(x+28/(x+29/(x+30/(x+31/(x+v4 ))))))))
  76.    v2 =16/(x+17/(x+18/(x+19/(x+20/(x+21/(x+22/(x+23/(x+v3 ))))))))
  77.    v1 = 8/(x+ 9/(x+10/(x+11/(x+12/(x+13/(x+14/(x+15/(x+v2 ))))))))
  78.    v  = 1/(x+ 1/(x+ 2/(x+ 3/(x+ 4/(x+ 5/(x+ 6/(x+ 7/(x+v1 ))))))))
  79.    y  =1-2*v*u
  80.  
  81. C: y=sgn*y     /* Bis hierher ist  y = Φ(x)  */
  82.    u=(1-y)/2   /* u = (1 - Φ(x))/2 = Q(x)    */
  83.    numeric digits ND
  84.    return(Format(u))
  85.  
  86. q_Msg:
  87.    sf=ErrorText(RC)
  88.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  89.    do
  90.      call charout(NDAq_) ; Call SysFileDelete NDAq_
  91.      ret=LineOut(bufMsg, "Sie haben in  q_(...)  kein gültiges Argument eingegeben !")
  92.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  93.   /*  damit in den diesbezüglichen temporären Dateien                      */
  94.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  95.      EXIT
  96.    end
  97.  
  98.