/*-L */
MODULE KURDIS;
SYSTEM;
  TY : A1 <->;
  KEY: A1(TFU=1) <-;
PROBLEM;
  SPC TY  DATION INOUT ALPHIC CONTROL(ALL),
      KEY DATION    IN ALPHIC CONTROL(ALL);
  DCL KOEFFIZIENTEN(25) FLOAT(55),
      NULL(5,25) FLOAT(55),
      GENAU FLOAT(55),
      (GRAD,ME) FIXED,
      TEXT CHAR(53),
      (OG,UG,SW) FLOAT(55),
      (UNLINE,NORM) CHAR(3),
      CLS CHAR(2);
/*--------------------------------------------------------------------*/
FKT: PROC (X FLOAT(55), WIEVIEL FIXED) RETURNS (FLOAT(55));
  DCL (ERG,H1) FLOAT(55),
      H2 FIXED;
  ERG = 0;
  FOR I FROM (WIEVIEL+1) TO GRAD REPEAT;
   CASE WIEVIEL + 1
    ALT H1 = 1; H2 = I - 1;
    ALT H1 = I - 1; H2 = I - 2;
    ALT H1 = (I - 1) * (I - 2); H2 = I - 3;
    ALT H1 = (I - 1) * (I - 2) * (I - 3); H2 = I - 4;
   FIN;
   ERG = ERG + H1 * KOEFFIZIENTEN(I) * X ** H2;
  END;
RETURN (ERG);
END;
/*--------------------------------------------------------------------*/
ANZEIGEN: PROC;
  FOR I TO 4 REPEAT;
   PUT TO TY BY SKIP;
   FOR J TO ENTIER NULL(I,1) REPEAT;
    PUT NULL(I,J) TO TY BY SKIP,F(15,6);
   END;
  END;
  GET FROM TY BY SKIP;
END;
/*--------------------------------------------------------------------*/
NULLEN: PROC;
  DCL (Z,C,E,F) FIXED,
      (A,B,D,G,X1,X2) FLOAT(55);
  IF ME == 1 THEN
    FOR I FROM 0 TO 3 REPEAT;
     A = UG; A = A - GENAU; Z = 2;
     WHILE A <= OG REPEAT;
      IF FKT(A,I) == 0 THEN
        NULL(I+1,Z) = X2; Z = Z + 1;
       ELSE
        B = FKT(A,I) * FKT(A+SW,I);
        IF B < 0 THEN
          G = 0; X1 = A - 0.0625;
          WHILE (ABS G) < 0.1 REPEAT;
           X1 = X1 + 0.0625;
           G = FKT(X1,I+1);
          END;
          D = 1; X2 = A;
          WHILE D >= GENAU REPEAT;
           X1 = X2;
           G = FKT(X1,I+1);
           X2 = X1 - FKT(X1,I) / G;
           D = ABS (X2 - X1);
           IF D > 10 THEN
             D = 0; B = 1;
             G = FKT(X1,I);
             WHILE (B * G) < 0 REPEAT;
              X1 = X1 + 0.0001;
              B = FKT(X1,I);
             END;
           FIN;
          END;
          NULL(I+1,Z) = X2; Z = Z + 1;
        FIN;
      FIN;
      A = A + SW;
     END;
     NULL(I+1,1) = Z - 1;
    END;
    FOR I FROM 3 BY - 1 TO 1 REPEAT;
     Z = ENTIER NULL(I+1,1);
     IF Z > 1 THEN
       FOR J FROM 2 TO Z REPEAT;
        IF (ABS FKT(NULL(I+1,J),I-1)) < GENAU THEN
          E = ENTIER NULL(I,1);
          IF E <= 1 THEN
            NULL(I,1) = 2; NULL(I,2) = NULL(I+1,J);
           ELSE
            F = 2;
            WHILE (NULL(I,F) <= NULL(I+1,J)) AND (F <= E) REPEAT;
             F = F + 1;
            END;
            IF (ABS (NULL(I,F-1) - NULL(I+1,J))) >= GENAU THEN
              IF F /= 2 THEN F = F - 1; FIN;
              FOR K FROM E BY -1 TO F REPEAT;
               NULL(I,K+1) = NULL(I,K);
              END;
              NULL(I,F) = NULL(I+1,J);
            FIN;
            IF F > E THEN
              NULL(I,E+1) = NULL(I+1,J);
            FIN;
            NULL(I,1) = NULL(I,1) + 1;
          FIN;
        FIN;
       END;
     FIN;
    END;
    ME = 0;
  FIN;
END;
/*--------------------------------------------------------------------*/
EINGABE: PROC;
  PUT CLS,UNLINE,' Eingabe der Koeffizienten ',NORM
     TO TY BY SKIP,A,X(20),A,A,A;
  GRAD = 0;
  WHILE (GRAD < 3) OR (GRAD > 25) REPEAT;
   PUT 'Anzahl der Koeffizienten [ 3 -> 25 ]  : ' TO TY BY SKIP(2),A;
   GET GRAD FROM TY BY SKIP,F(2);
  END;
  PUT TEXT TO TY BY SKIP(2),A;
  FOR I TO GRAD REPEAT;
   PUT 'a',I-1,' : ' TO TY BY SKIP,A,F(2),A;
   GET KOEFFIZIENTEN(I) FROM TY BY SKIP,F(15,6);
  END;
  ME = 1;
END;
/*--------------------------------------------------------------------*/
INTERVALL: PROC;
  DCL H FLOAT(55);
  PUT TEXT TO TY BY SKIP(2),A;
  UG = 0; OG = UG;
  WHILE UG == OG REPEAT;
   PUT 'untere Intervallgrenze : ' TO TY BY SKIP,A;
   GET UG FROM TY BY SKIP,F(15,6);
   PUT ' obere Intervallgrenze : ' TO TY BY SKIP,A;
   GET OG FROM TY BY SKIP,F(15,6);
  END;
  IF UG > OG THEN H = UG; UG = OG; OG = UG; FIN;
  ME = 1;
END;
/*--------------------------------------------------------------------*/
SCHRITTWEITE: PROC;
  PUT TEXT TO TY BY SKIP(2),A;
  SW = 0;
  WHILE (SW <= 0) OR ((OG - UG) < SW) REPEAT;
   PUT 'Schrittweite : ' TO TY BY SKIP,A;
   GET SW FROM TY BY SKIP,F(15,6);
  END;
  ME = 1;
END;
/*--------------------------------------------------------------------*/
WERTETABELLE: PROC;
  DCL Z FIXED,
      A FLOAT(55);
  PUT CLS,UNLINE,' Wertetabelle ',NORM
     TO TY BY SKIP,A,X(30),A,A,A;
  PUT 'x','f(x)','f`(x)','f``(x)','f```(x)'
    TO TY BY SKIP(2),X(2),A,X(15),A,X(13),A,X(12),A,X(12),A,SKIP;
  FOR I TO 80 REPEAT;
   PUT '-' TO TY BY A;
  END;
  A = UG; Z = 0;
  WHILE A <= OG REPEAT;
   PUT A,FKT(A,0),FKT(A,1),FKT(A,2),FKT(A,3)
     TO TY BY F(9,4),X(3),(4)(F(14,6),X(3));
   Z = Z + 1;
   IF Z == 18 THEN
     Z = 0;
     PUT 'weiter ??' TO TY BY SKIP,A;
     GET FROM KEY BY SKIP;
     PUT TOCHAR 27, '=', TOCHAR 36, TOCHAR 32 TO TY BY (4)A;
     PUT TOCHAR 27, 'Z' TO TY BY A,A;
     PUT TOCHAR 27, '=', TOCHAR 36, TOCHAR 32 TO TY BY (4)A;
   FIN;
   A = A + SW;
  END;
  GET FROM KEY BY SKIP;
END;
/*--------------------------------------------------------------------*/
NULLSTELLEN: PROC;
  DCL A FIXED;
  PUT CLS,UNLINE,'markante Punkte  P(x/y)',NORM
    TO TY BY SKIP,A,X(25),(3)A,SKIP(2);
  CALL NULLEN;
  A = ENTIER NULL(1,1);
  IF A /= 0 THEN
    PUT 'Nullstellen : ' TO TY BY SKIP(2),A;
    FOR I FROM 2 TO A REPEAT;
     PUT 'x = ',NULL(1,I) TO TY BY A,F(15,6),SKIP,X(14);
    END;
  FIN;
END;
/*--------------------------------------------------------------------*/
EXTREMWERTE: PROC;
  DCL A FIXED,
      H FLOAT(55);
  A = ENTIER NULL(2,1);
  IF A /= 0 THEN
    PUT 'Extremwerte : ' TO TY BY SKIP(2),A,SKIP;
    FOR I FROM 2 TO A REPEAT;
     H = FKT (NULL(2,I),2);
     IF (ABS H) >= GENAU THEN
       PUT 'x = ',NULL(2,I),';  f(x) = ',FKT(NULL(2,I),0)
          TO TY BY SKIP,(2)(A,F(15,6));
       IF H < 0 THEN
         PUT '    lokales Maximum' TO TY BY A;
        ELSE
         PUT '    lokales Minimum' TO TY BY A;
       FIN;
     FIN;
    END;
  FIN;
END;
/*--------------------------------------------------------------------*/
WENDEPUNKTE: PROC;
  DCL A FIXED,
      H FLOAT(55);
  A = ENTIER NULL(3,1);
  IF A /= 0 THEN
    PUT 'Wende u. Sattelpunkte : ' TO TY BY SKIP(2),A,SKIP;
    FOR I FROM 2 TO A REPEAT;
     H = FKT(NULL(3,I),3);
     IF (ABS H) >= GENAU THEN
       PUT 'x = ',NULL(3,I),';  f(x) = ',FKT(NULL(3,I),0)
         TO TY BY SKIP,(2)(A,F(15,6));
       IF (ABS FKT(NULL(3,I),1)) < GENAU THEN
         PUT '    Sattelpunkt' TO TY BY A;
        ELSE
         PUT '    Wendepunkt' TO TY BY A;
       FIN;
     FIN;
    END;
  FIN;
  GET FROM KEY BY SKIP;
END;
/**********************************************************************/
GRAPH: TASK;
  DCL (WAHL,H1) FIXED INIT(1,1);
  UNLINE = TOCHAR 27 CAT 'G4';
  NORM   = TOCHAR 27 CAT 'G0';
  CLS    = TOCHAR 27 CAT '*';
  TEXT = 'beachte, dass jede reele Zahl ein Komma haben muss !!';
  GENAU = 0.000001;
  ME = 1;
  REPEAT;
   PUT CLS,UNLINE,' Programm zur Kurvendiskussion '
      TO TY BY A,X(20),A,A;
   PUT 'Menue :', NORM, '  1. Koeffizienten',
                        '  2. Intervallgrenzen',
                        '  3. Schrittweite',
                        '  4. Wertetabelle',
                        '  5. markante Punkte  P(x/y)',
                        '  6. Ende',
       ' bitte waehlen (',H1,')  : '
     TO TY BY SKIP(4),(3)A,(5)(SKIP,X(7),A),SKIP,A,F(1),A;
   GET WAHL FROM KEY BY SKIP,F(1);
   IF WAHL == 0 THEN WAHL = H1; FIN;
   CASE WAHL
    ALT CALL EINGABE;      H1 = 2;
    ALT CALL INTERVALL;    H1 = 3;
    ALT CALL SCHRITTWEITE; H1 = 4;
    ALT CALL WERTETABELLE; H1 = 5;
    ALT CALL NULLSTELLEN;
        CALL EXTREMWERTE;
        CALL WENDEPUNKTE;  H1 = 6;
    ALT PUT 'Tschuess bis zum naechsten mal.' TO TY BY SKIP,A,SKIP;
        TERMINATE;
   FIN;
  END;
END;
MODEND;