DataMuseum.dk

top - download

    Length: 1792 (0x700)
    Types: TextFile
    Names: »BISEC.PAS«

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─ ⟦this⟧ »BISEC.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »BISEC.PAS« 
└─⟦3702e543b⟧ Bits:30003064 Demoprogrammer A-J til Pascal bog
    └─ ⟦this⟧ »BISEC.PAS« 
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
    └─ ⟦this⟧ »BISEC.PAS« 

TextFile

PROGRAM bisec;

  (* I dette program gentages intervalhalveringerne indtil *)
  (* intervallets endepunkter falder sammen (i datamatens  *)
  (* interne repræsentation af endepunkterne).             *)
  (* En mere økonomisk metode ville være at gentage halve- *)
  (* ringerne, indtil intervallængden var mindre end en    *)
  (* bestemt tolerenceværdi.                               *)
  
  VAR
    x, a, b, gla, glb, glmellem, mellem : REAL;
    i, j, halvering : INTEGER;
    ch : CHAR;

  FUNCTION f(x : REAL) : REAL;

    BEGIN
      f := COS(x) - x;
    END;

  BEGIN
    WRITE(CLRHOM);
    WRITELN('Nulpunkter ved bisection');
    WRITELN;
    REPEAT
      REPEAT
        WRITE('Begyndelsespunkt i intervallet: '); READLN(a);
        WRITE('Slutpunkt i intervallet       : '); READLN(b);
        IF f(a) * f(b) > 0
          THEN WRITELN('Samme funktionsværdi i intervalendepunkterne!');
      UNTIL f(a) * f(b) <= 0;
      gla := a;
      glb := b;
      mellem := (a + b) / 2;
      halvering := 0;
      REPEAT
        glmellem := mellem;
        IF f(a) * f(mellem) >= 0 THEN
          a := mellem
        ELSE
          b := mellem;
        mellem := (a + b) / 2;
        halvering := halvering + 1;
        WRITELN(mellem);
      UNTIL glmellem = mellem;
      WRITELN('Nulpunkt i intervallet fra ', gla : 8 : 2, ' til ',
              glb : 8 : 2, ': ', mellem : 20 : 10);
      WRITELN('Funktionsværdien i dette punkt er: ', f(mellem) : 20 : 13);
      WRITELN('Roden er fundet ved ', halvering, ' halveringer');
      WRITE('Ønsker du at prøve igen (j/n)? ');
      REPEAT
        BUFLEN := 1;
        READ(ch);
      UNTIL (ch = 'j') OR (ch = 'n');
      WRITELN;
    UNTIL ch = 'n';
  END.
«eof»