Von Thomas Grasel

Hallo,
ich hoffe ihr habt noch nicht zu viel
aus den letzten 2 Kursen vergessen. Das
folgende Demo wird nämlich einige der
neuen Befehle benutzen. Es ist ein
Programm zur Umfangsberechnung von
Rechtecken , Kreisen und Dreiecken. Die
Formeln für diese Figuren dürfen ja aus
der Schule bekannt sein.


program umfang<SM>

type shape = (RECHTECK,KREIS,          
              DREIECK)<SM>
     figur = record
               case form: shape of
                 RECHTECK: (laenge,
breite: real)<SM>
                 KREIS   : (radius:
real)<SM>
                 DREIECK : (s1, s2,
winkel: real)
             end<SM>

var figuren: set of char<SM>
    info   : figur<SM>
    i      : char<SM>

(*-----------------------------------*)

procedure eingabe(var daten:figur)<SM>

begin
  with daten do
  begin
    case form of
      RECHTECK: begin
                  write ('Laenge :
')<SM>
                  readln (laenge)<SM>
                  write ('Breite :
')<SM>
                  readln (breite)
                end<SM>

      KREIS   : begin
                  write ('Radius :
')<SM>
                  readln (radius)
                end<SM>

      DREIECK : begin
                  write ('1.Seite :
')<SM>
                  readln (s1)<SM>
                  write ('2.Seite :
')<SM>
                  readln (s2)<SM>
                  write ('Winkel  :
')<SM>
                  readln (winkel)
                end
    end (* case *)
  end (* with *)
end<SM>

(*-----------------------------------*)

function umfang(var f: figur):real<SM>

var pi, s3, b: real<SM>

begin
  pi:=4*arctan(1)<SM>
  with f do
  begin
    case form of
    RECHTECK: begin
               
umfang:=2*(laenge+breite)
              end<SM>

    KREIS   : begin
                umfang:=2*pi*radius
              end<SM>

    DREIECK : begin
                b:=pi*winkel/180<SM>
               
s3:=sqrt(sqr(s1
+sqr(s2)-2*s1*s2*cos(b))<SM>
                umfang:=s1+s2+s3
              end
    end (* case *)
  end (* with *)
end<SM>

(*-----------------------------------*)

procedure titel<SM>

begin
  writeln('
':10,'Umfangsberechnung')<SM>
  writeln<SM>
  writeln('Fuer den Pascal-Kurs des
User-Mags')<SM>
  writeln(' ':8,'(c) 1992 Th.Grasel')
end<SM>

(*************************************)

begin
  writeln(chr(125))<SM>
  titel<SM>
  writeln<SM>
  writeln (' ':10,'R - Rechteck')<SM>
  writeln (' ':10,'K - Kreis')<SM>
  writeln (' ':10,'D - Dreieck')<SM>
  writeln<SM>
  write ('Figur : ')<SM>
  readln (i)<SM>
  writeln<SM>
 
f
guren:=+('r','R','k','K','d','D'+)<SM>
  if i in figuren then
  begin
    with info do
    begin
      if (i='R') or (i='r') then
form:=RECHTECK<SM>
      if (i='K') or (i='k') then
form:=KREIS<SM>
      if (i='D') or (i='d') then
form:=DREIECK
    end<SM>
    eingabe(info)<SM>
    writeln<SM>
    write ('Der Umfang betraegt :
')<SM>
    writeln (umfang(info):6:2)
  end
  else
    writeln('Falsche Eingabe !!!')
end.


Der Umstand mit dem Set 'shape' ist
nötig da die case-Schleife leider nicht
mit Strings zusammenarbeitet. Wieso
habe ich in der letzten Ausgabe
beschrieben!

So, nun aber zum schon lange ange-
kündigten Utility. Es handelt sich
dabei um ein Programm zur Berechnung
von Funktionswerten aus Polynomen. Das
sind Gleichungen die x und höhere
Potenzen von x enthalten. Das Programm
verlangt zunächst die Eingabe des
Grades. Das ist die höchste Potenz in
der x vorkommt. Für die Gleichung

f(x)=3*x^3-7*x-4

wäre dies 3. Danach wird gefragt
welchen Wert x haben soll. Anschließend
müssen alle Terme eingegeben werden.
Terme die nicht vorkommen, z.B. wie
oben x^2 müssen mit 0 angegeben werden.
Der Term x^0 ist übrigens der Term ohne
x (x^0=1)!


program polynom<SM>

var x, p: real<SM>
    i, n: integer<SM>
    a   : array+(0..20+) of real<SM>

(*-----------------------------------*)

procedure titel<SM>

begin
  writeln('
':8,'Polynomwertberechnung')<SM>
  writeln<SM>
  writeln('    Mit Hilfe des
Horner-Schemas')<SM>
  writeln<SM>
  writeln(' Fuer den Pascal-Kurs des
User-Mags')<SM>
  writeln(' ':8,'(c) 1992
Th.Grasel')<SM>
  writeln
end<SM>

(*************************************)

begin
  writeln(chr(125))<SM>
  titel<SM>
  write('Grad des Polynoms : ')<SM>
  readln(n)<SM>
  write('Stelle der Ber. X = ')<SM>
  readln(x)<SM>
  writeln<SM>
  writeln('Eingabe der
Koeffizienten:')<SM>
  (* Eingabe *)
  for i:=n downto 0 do
  begin
    write('X^',i,' : ')<SM>
    readln(a+(i+))
  end<SM>
  (* Berechnung *)
  p:=a+(n+)<SM>
  for i:=n-1 downto 0 do
    p:=p*x+a+(i+)<SM>
  (* Ausgabe *)
  writeln<SM>
  writeln('p(',x:6:2,') = ',p:6:2)
end.


Noch ein Tip am Rande. Wenn man eine
Gleichung mit vielen Brüchen hat ist es
sinnvoll sie so durch zu multiplizieren
das nur noch ganze Zahlen vorkommen.

Hast du vielleicht eine Idee für ein
kurzes Mathehilfsprogramm? Dann schreib
es doch! Oder falls du dich noch nicht
so fit fühlt, schreibt mir, vielleicht
kann ich dir ja helfen. Meine Adresse
wurde bereits im Kurs #12 veröffent-
licht! Also, noch viel Spaß bis zum
nächsten Mal.