DataMuseum.dk

Presents historical artifacts from the history of:

Bogika Butler

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Bogika Butler

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦e8c6c73f6⟧ TextFile

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

Derivation

└─⟦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»