Wir verwenden hier einen Trick, um die Schleife

    for i := 1 to p

Im folgendem Programm werden die 2-er Potenzen ausgegeben. Dazu wird die Funktion hoch(x,n) = xⁿ verwendet.

Beispiel 7.6: Wertetafel für 2^-20, 2^-19, ... 2^19, 2²⁰

Die Funktion hoch(x,n) wird jetzt auf negative Hochzahlen n
erweitert.

function hoch(x:real; n:integer):real; //x^n (x:real; n ganze Zahl)
  var p:real;
      i,nabs:integer;
begin
  nabs := abs(n);
  p :=1;
  for i := 1 to nabs do p := p*x;
  if n < 0 then result := 1/p else result := p;
  //Beachte: x^(-n) = 1/x^n für n < 0
end;


procedure TForm1.Button1Click(Sender: TObject);
  var n: integer;
      y: real;
begin
  memo1.lines.clear;
  for n := -20 to 20 do Begin
    y :=hoch(2,n);
    memo1.Lines.Add(IntToStr(n)+ '   ' +
      formatfloat('
 
 
0.
 
 
',y));
  End;
end;

formatfloat('

Aufgabe 7.2:

Oft muß man Zahlenreihen so untereinander schreiben, dass das Komma immer an derselben Stelle steht.

Schreibe deshalb eine Funktion, die mit Hilfe von formatfloat('

---

---

0.
',x) eine Gletkommazahl in einen String umwandelt, der genau 11 Zeichen vor dem Komma hat.

Teste die Funktion mit einer Wertetafel.

Hinweis:

Das Komma findest du mit der Funktion pos(',',s). Achte darauf, dass Komma und zwei Nachkommastellen möglicherweise durch Leerzeichen "hinten" aufgefüllt werden müssen.

Die Länge eines String s findest du mit der Funktion length(s).
Achte darauf, dass der Gesamtstring 14 Zeichen haben muss und möglicherweise "vorne" mit Leerzeichen aufgefüllt werden muss.

Aufgabe 7.3:

Schreibe eine Funktion IstPrimzahl(n), die für eine natürliche Zahl n true oder false ausgibt, je nachdem sie prim ist oder echte Teiler hat.

Im Programm sollen dann alle Primzahlen bis 1000 in ein Memofeld geschrieben werden. Die Einer, Zehner, .. sollen dabei untereinander stehen.

Aufgabe 7.4:

Schreibe ein Programm zur Passwortabfrage.

Hinweis:

1. Mit edit1.PasswordChar := '*' werden die Eingaben in edit1 unsichtbar.

2. Bei der Lösung findest du einen Hinweis, wie man die Passwortabfrage auf drei mal beschränken kannst (mit Hilfe einer globalen oder privaten Variablen.)

Merke:

a and b ist nur true,

wenn a true und b true

a or b ist nur false , wenn a false und b false. Es handelt sich hier um das nicht ausschließende "oder" (lateinisch: vel) und nicht um "Entwerder-Oder" (lateinisch:"aut". In der Booleschen Algebra das exklusive oder "xor").

function f(a: boolean): string; // f=BooleanToString
begin
  if a then result := '  true   ' else
            result := '  false  ';
end;

procedure TForm1.Button1Click(Sender: TObject);
  var a, b :boolean;
begin
  memo1.Font.Name := 'Courier New'; //gleicher Abstand
  memo1.text := '   a         b     a and b  a or b   a xor b';
  a := true; b := true;
  memo1.lines.add(f(a) + f(b) + f(a and b) + f(a or b) + f(a xor b));
  a := true; b := false;
  memo1.lines.add(f(a) + f(b) + f(a and b) + f(a or b) + f(a xor b));
  a := false; b := true;
  memo1.lines.add(f(a) + f(b) + f(a and b) + f(a or b) + f(a xor b));
  a := false; b := false;
  memo1.lines.add(f(a) + f(b) + f(a and b) + f(a or b) + f(a xor b));
end;

function f(a: boolean): string; // f=BooleanToString

begin
  if a then result := '  true   ' else
            result := '  false  ';
end;

procedure TForm1.Button1Click(Sender: TObject);
  var a, b :boolean;
begin
  memo1.Font.Name := 'Courier New'; //gleicher Abstand
  memo1.wordwrap := false; //siehe Bemerkung unten
  memo1.text := '   a         b     a and b  a or b   a xor b';
  a := true; b := true;
  repeat
    memo1.lines.add(f(a) + f(b) + f(a and b) + f(a or b) + f(a xor b));
    b := not b;
    if b then a := not a;
  until memo1.lines.count >= 5;
end;

function f(a: boolean): string; // f=BooleanToString
begin
  if a then result := '  true   ' else
            result := '  false  ';
end;

procedure TForm1.Button1Click(Sender: TObject);
  var a, b :boolean;
      k: integer;
begin
  memo1.lines.clear:
  memo1.lines.add := '   a         b     a and b  a or b   a xor b';
  a := true; b := true;
  k := 0;
  repeat
    memo1.lines.add(f(a) + f(b) + f(a and b) + f(a or b) + f(a xor b));
    inc(k); //Dasselbe wie k := k + 1;
    b := not b;
    if b then a := not a;
  until k = 5;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var blau, gruen, rot, gelb: integer;
begin
  memo1.Text := 'blau grün rot gelb';
  for blau := 1 to 15 do
    for gruen := 1 to 15 do
      for rot := 1 to 15 do
        for gelb := 1 to 15 do
          if (blau > gruen) and
             (blau > rot) and
             (blau > gelb) and
             (gruen < blau) {entbehrlich} and
             (gruen < rot) and
             (gruen < gelb) and
             (rot = gelb) and
             (blau + gruen + rot + gelb= 15) then
               memo1.lines.add(IntToStr(blau)+ ' '
                 + IntToStr(gruen) + ' '
                 + IntToStr(rot) + ' '
                 + IntToStr(gelb));

end;

Merke:

Beispiel 7.8: Drei Lottozahlen werden erzeugt
             (erweiterbar auf 6 Lottozahlen plus Zufallszahl)

procedure TForm1.Button1Click(Sender: TObject);
  var x1,x2,x3: integer;
begin
  randomize;
  x1 := random(49) + 1;
  edit1.text := IntToStr(x1);
  application.ProcessMessages; //Windows ändert sofort edit1
  sleep(2000);                // 2 Sekunden Geduld
  x2 := x1;
  while x2 = x1 do x2 := random(49) + 1;
  edit1.text := edit1.text+' '+IntToStr(x2);
  application.ProcessMessages;
  sleep(2000);
  x3 := x2;
  while (x3 = x1) or (x3 = x2) do x3 := random(49) + 1;
  edit1.text := edit1.text+' '+IntToStr(x3);
  application.ProcessMessages;
  sleep(2000);
end;

  Der Algorithmus ist folgender:     Beispiel 1964
   1. Tausender verarbeiten     1000 = M      1964=M+964   (M+Rest)
      Rest >=900?               900  = CM     1964=M+CM+64 (MCM+Rest)
      Rest >=500?               500  = D
      Rest >= 400?              400  = CD
   2. Hunderter verarbeiten     100  = C
      Rest >= 90?               90   = XC
      Rest >= 50?               50   = L      1964=MCM+L+14
      Rest >= 40?               40   = XL
   3. Zehner verarbeiten        10   = X      1964=MCM+L+X+4
      Rest >= 9?                9    = IX
      Rest >=5?                 5    = V
      Rest >= 4?                4    = IV     1964=MCM+L+X+IV
   4. Einer verarbeiten         1    = I

Function roemisch(n: integer):string;
begin
  result := '';
  {——————— Tausender —————————}
  while n >= 1000 do Begin //kann mehrmals vorkommen
    result := result +'M';
    n := n-1000;
  End;
  if n >= 900 then Begin   //kann nur einmal vorkommen
    result := result +'CM';
    n := n-900;
  End;
  if n >= 500 then Begin
    result := result +'D';
    n := n-500;
  End;
  if n >= 400 then Begin
    result := result +'CD';
    n := n-400;
  End;
  {————————— Hunderter ——————————— }
  while n >= 100 do Begin //kann mehrmals vorkommen
    result := result +'C';
    n := n-100;
  End;
  if n >= 90 then Begin
    result := result +'XC';
    n := n-90;
  End;
  if n >= 50 then Begin
    result := result +'L';
    n := n-50;
  End;
  if n >= 40 then Begin
    result := result +'XL';
    n := n-40;
  End;
  {——————— Zehner ———————————}
  while n >= 10 do Begin
    result := result +'X';
    n := n-10;
  End;
  if n >= 9 then Begin
    result := result +'IX';
    n := n-9;
  End;
  if n >= 5 then Begin
    result := result +'V';
    n := n-5;
  End;
  if n >= 4 then Begin
    result := result +'IV';
    n := n-4;
  End;
  { ——————————— Einer ——————————— }
  while n >= 1 do Begin //kann mehrmals vorkommen
    result := result +'I';
    n := n-1;
  End;
end;

Aufgabe 7.5: Ineinandergeschachtelte  if ... then-Anweisungen.
   Was wird im folgendem Programm berechnet?

procedure TForm1.Button1Click(Sender: TObject);
  var a,b,c :integer;
begin
  for a := 0 to 1 do for b := 0 to 1 do Begin
    if a = 0 then BEgin
      if b = 0 then c := 2 else c := 3;
    ENd else BEgin
      if b = 0 then c := 5 else c := 7;
    ENd;
    memo1.lines.add('a='+IntToStr(a)+' b='+IntToStr(b)+
       ' c='+IntToStr(c));
  End;
end;

  if b0 then if b1 then s0 else s1

  if b0 then Begin
    if b1 then s0 else s1
  End

  if b0 then Begin
    if b1 then s0
  End  else s1

procedure TForm1.erKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if sender <> er then er.text := '';
  if sender <> ed then ed.text := '';
  if sender <> eu then eu.text := '';
  if sender <> ea then ea.text := '';
end;

   Bsp.: n=4004
         i=2  n=2002
         i=2  n=1001
         i=7  n=143
         i=11 n=13
         i=13 n=1
   Also: 4004=2*2*7*11*13

 
function PFZ(n:integer):string;
  var i:integer;
begin
  result:='';
  i:=2;
  repeat
    while n mod i =0 do BEgin
      n:=n div i;
      if result <> '' then result:=result+'*'; //Das 1. Mal kein '*'
      result:=result+floatToStr(i);
    ENd;
    if i=2 then i:=i+1
     else i:=i+2; //ungerade (eigentlich genügen Primzahlen)
    if i > trunc(sqrt(n)) then i:=n; //ohne diese Zeile:Kaffeepause!
  until n=1;
  if pos('*',result)=0 then result:='Primzahl';
end;

8. Lektion: Case .. of .. End

Viele ineinandergeschachtelte if .. then kann man ersetzten durch Case .. of .. else .. End.

Zum Beispiel kann man statt

if i = 1 then s := 'eins' else
  if i = 2 then s := 'zwei' else
   if i =3 then s := 'drei' else
     s := 'viel'

schreiben

Case i of 1: s := 'eins';
          2: s := 'zwei';
          3: s := 'drei';
     else s := 'viel';
End;


Beispiel 8.1: Hier wird dies demonstriert:

procedure TForm1.Button1Click(Sender: TObject);
  var i : integer;
      s : string;
begin
  for i := 1 to 10 do Begin
    CAse i of 1: s := 'eins';
              2: s := 'zwei';
              3: s := 'drei';
      else s := 'viel';
    ENd;
  showmessage(intToStr(i) + ' = ' + s);
  End;
end;

Dasselbe ohne else:

procedure TForm1.Button1Click(Sender: TObject);
  var i : integer;
      s : string;
begin
  for i := 1 to 10 do Begin
    s := 'viel';
    CAse i of 1: s := 'eins';
              2: s := 'zwei';
              3: s := 'drei';
    ENd;
  showmessage(intToStr(i) + ' = ' + s);
  End;
end;


Beispiel 8.2:
   Du benötigst hier radiogroup1 aus der Standardkomponentenleiste.
   Bei einer Radiogroup kann der Benutzer aus
   einer Gruppe von Feldern genau eines auswählen.

   Aktiviere  radiogroup1 und doppelklicke im
   Objektinspektor bei items auf "..." und schreibe
   in den sich nun öffnenden String-Listen-Editor

   rot
   blau
   grün
   gelb
   schwarz
   weiß

Wird jetzt auf der Radiogrup eine Farbe gewählt, soll
das Fenster die entsprechnede Farbe enthalten:

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  Case radiogroup1.ItemIndex of 0 : color := clred;
                                1 : color := clblue;
                                2 : color := clgreen;
                                3 : color := clyellow;
                                4 : color := clblack;
                                5 : color := clwhite;
  End;
  //Nur zur Demonstration
  for i :=0 to radiogroup1.Items.Count -1 do
    showmessage(IntToStr(i) + '=' +radiogroup1.items[i]);
end;

Beachte: Die Feldelemente heißen items.

         Die Anzahl der Elemente ist radiogroup1.Items.Count.

         Die Feldelemente (Items) der Radiogroup werden von
         0 an durchnummeriert bis radiogroup1.Items.Count -1.
         (In der Informatik fängt man häufig bei 0 an zu zählen!)

         Die Eigenschaft itemindex ist die Nummer des
         ausgewählten Elements.

Für den Fachmann:clred u.s.w. sind vordefinierte Konstanten.
                 Genauer: In der unit graphics wird definiert
                 clRed = TColor($0000FF)
                 clBlue = TColor($FF0000)
                 clLime = TColor($00FF00)
                 (Daraus kann man alle Farben mischen)
                 clBlack = TColor($000000) (Kein Farbpixel wird aktiviert)
                 clWhite = TColor($FFFFFF) (Alle drei Farbpixel)

Aufgabe 8.1:
   Unter folgenden Bedingungen zahlt ein Betrieb an seine Mitarbeiter
   eine Jahresendprämie:
   Betriebszugehörigkeit weniger als ein Jahr             : keine Prämie
   Betriebszugehörigkeit ein Jahr aber weniger als 5 Jahre: 200 EUR
   Betriebszugehörigkeit 5 Jahre aber weniger als 10 Jahre: 400 EUR
   Betriebszugehörigkeit 10 Jahre und mehr                : 800 EUR

   Schreibe dazu ein passendes Programm und verwende dabei "Case"!

Aufgabe 8.2:
   Der Fahrkartenautomat gibt aus
   Einzeltageskarten  für 1 Zone  zu EUR   2,00
   Gruppentageskarten für 1 Zone  zu EUR   3,00
   Einzeltageskarten  für 3 Zonen zu EUR   5,00
   Gruppentageskarten für 3 Zonen zu EUR   8,00
   Einzeltageskarten  für 6 Zonen zu EUR   9,00
   Gruppentageskarten für 6 Zonen zu EUR  14,00

   Simuliere den Automaten!

Aufgabe 8.3:
   Plaztiere ein Spinedit- und ein Editfeld auf Dein Formular.
   Nach Eingabe der Punktzahl im Spineditfeld soll die Note in Worten
   im Editfeld erscheinen. Zum Beispiel:

          Notenpunkte                   Note
             11                         gut

   Schreibe dazu ein Programm.

Aufgabe 8.4:
   Oft werden Prüfsummen folgendermaßen gebildet:

   Multipliziere die erste Ziffer mit 7,
   die zweite mit 3,
   die dritte mit 1,
   die vierte wieder mit 7,
   u.s.w.
   und addiere alle Summandden.
   Die Prüfziffer ist dann die letzte Ziffer dieser Summe.

   z.B. Prüfsumme von 861214 = 8·7 + 6·3 + 1·1 + 2·7 + 1·3 + 4·1 = 96
        Prüfziffer = 6

Schreibe eine Funktion unter Verwendung von Case, die die Prüfsumme ermittelt.

Überprüfe dein Können!

a) function flaeche(art: string; r: real): real;
   begin
     if art = 'Kreis' then result := Pi*r*r else
       if art = 'Quadrat' then result := r*r else
         if art = 'Kugel' then result := 4/3*Pi*r*r*r
           else Begin
             showmessage('Unbekanntes Objekt');
             result := 0;
           End;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
     var a, r, y: real;
   begin
     r := 5;
     y := flaeche('Kreis',r);
     memo1.lines.Add('Kreisfläche (r=5) = ' + FloatToStr(y));
     a := 3;
     y := flaeche('Quadrat',a);
     memo1.lines.Add('Quadrat (a=3) = ' + FloatToStr(y));
     a := 10;
     y := flaeche('Dreieck',a);
     memo1.lines.Add('gleichseitiges Dreieck (a=10) = ' + FloatToStr(y));
   end;


b) function f(x: real): real;
     var p, q: real;
   begin
     p := 0;
     if x < 0 then p:= 2*x;
     if x > 0 then q := x/2 else q := 0;
     result := p + q;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
     var i: integer;
   begin
     for i := - 2 to 2 do
       memo1.lines.add(IntToStr(i)+ '    '+ floatToStr(f(i)));
   end;

c) function g(a,b: real): real;
   begin
     if a > 0 then  result := 2*a + 3*b
       else result := 2*a - 3*b;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
     var i:integer;
   begin
     i := -4;
     repeat
       memo1.lines.add(IntToStr(i)+ '    '+ floatToStr(g(i,2*i)));
       i := i+2;
     until i = 4;
   end;

d) function h(x: integer): real;
     var p, q: real;
   begin
     p := 1;
     q := 1;
     while q <= x do Begin
       p := p*q;
       q := q + 1;
     End;
     result := p;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
     var a: integer;
   begin
     a := 0;
     while a <= 5 do Begin
       memo1.lines.add(IntToStr(a)+ '    '+ floatToStr(h(a)));
       a := a + 1;
     End;
   end;

            edit1    edit2  edit3
              a        b     c

            edit4   edit5
              x1      x2

   Zwei Lösungen (d > 0): zusätzlich edit5.show
   Eine Lösung   (d = 0):            edit5.hide
   Keine Lösung  (d < 0):            edit4.text ='keine Lösung' edit5.hide

   Zur Erinnerung: 0 -> ung;  1, 2, 3 -> mgh;  4, 5, 6 -> ausr;
               7,8,9 -> bfr; 10,11,12 -> gut; 13,14,15 -> sgt

                                 1   1         1
   a) Die Funktion f(n) soll 1 + - + - + ... + -  berechnen.
                                 2   3         n



                             1 3 5         2n-1
   b) Die Funktion g(n) soll -·-·- · ... · ————
                             2 4 6          2n

      berechnen.

procedure TForm1.Button1Click(Sender: TObject);
  var a, b, q, r, a1:integer;
begin
   a := 416;
   b := 160;
   repeat
     q:= a div b;
     r:= a mod b;
     a1 := q*b + r;
     memo1.Lines.Add(' a = '  + intToStr(a) +
                     ' q = '  + intToStr(q) +
                     ' r = '  + intToStr(r) +
                     ' a1 = ' + intToStr(a1));
     a:=b;
     b:=r;
   until r = 0;
end;

Eugen hat eine Aktie A im Wert von 1000 EUR. Josef hat 1000 EUR bar. Täglich wechselt die Aktie den Besitzer. Der Wert der Aktie kann täglich um maximal p% nach oben oder unten schwanken (random). Wie viel besitzt jeder nach einem Tag, nach zwei, drei ... Tagen?

9. Lektion: Algorithmen

• Sie muss eindeutig sein.
• Sie muss endlich beschreibbar sein.
• Das Verfahren muss terminiert sein. (Das heißt: es muss irgendwann beendet werden.)

• Vorschrift zum Zähneputzen (unabhängig von Zahnbürste und Paste)
• Kochbuchrezepte (linear)
• Überfahren einer Kreuzung unter Beachtung der Verkehrsregeln
• Berechne Idealgewicht aus Körpergröße und Geschlecht

• Abwasch in eine Wohngemeinschaft (A beauftragt B, B beauftragt C, ..., Z beauftragt A)
• 1+1/2+1/4+1/8+1/16+... (ad infinitum) kann so kein Computer berechnen. Man muss dafür erst einen Algorithmus entwickeln.
  
  

function hoch(x:real; n:integer):real;
  var k:integer;
begin
  result := 1;
  for k := 1 to n do result := x*result;
end;

  Beispiel y = 221
  Rechne   a:=2*2
           b:=a*a (=24)
           c:=b*b (=28)
           d:=b*b (=216)
           y:=d*b*2*1 (=216*24*2=221)
           ("*1" steht hier nur wegen des Anfangswertes beim Algorithmus.)

Verfolgen wir den Algorithmus an unserem Beispiel y = 2²¹ (m=2 e=21)

y=1 m=2 e=21 (e gibt an, wie oft noch y mit m zu multiplizieren ist)

y=2 m=2 e=20

y=2 m=2² e=10

y=2 m=(2²)²=2⁴ e=5

y=2·2⁴=2⁵ m=2⁴ e=4

y=2⁵ m=(2⁴)²=2⁸ e=2

y=2⁵ m=(2⁸)²=2¹⁶ e=1

y=2⁵·2¹⁶=2²¹ e=0

fertig!

function hoch(m:extended; e:integer):extended;
begin
  result := 1;
  while e > 0 do
    if odd(e) then Begin //odd(e) = true, wenn e ungerade
      result := result*m;
      e := e -1;
    End else Begin
      m :=m*m;
      e := e div 2
    End;
end;

zum Beispiel: ggT(18,12) = 6
              ggT(5406,1785) = 51

Ist nämlich t ein gemeinsamer Teiler von a und b mit
       a       div t = x     und
       b       div t = y     (x, y ganze Zahlen), dann ist bekanntlich
       ———————————————————
       (a - b) div t = x - y (Vertausche a und b, falls a < b).
Zum Beispiel:
       143     div 13 = 11
        52     div 13 = 4
       ———————————————————
        91     div 13 = 7

Also:

ggT(a,b) = ggT(b,a - b)

Zum Beispiel:
ggT(143,52) = ggT(91,52), nämlich 13

Man kann sogar statt a -  b auch
                     a - 2b oder
                     a - 3b ... nehmen.
Am besten ist natürlich
                     a - k·b für das größte k so, dass noch a -k·b > 0.
Es ist     a mod b = a - k·b = Rest bei Division von a durch b

Also gilt auch hier: ggT(a,b) = ggT(b,a mod b)

Zum Beispiel:        ggT(143,52) = ggT(52,143 - 2·52)
                                 = ggT(52,39)
                     Beachte: 143/52 = 2 Rest 39

weiteres Beispiel:   ggT(5406,1785) = ggT(1785, 5406 - 3·1785)
                                    = ggT(1785, 51)
                     Beachte: 5406/1785 = 3 Rest 51

          Jetzt können wir das Spiel wiederholen, bis der Rest Null ist.

            ggT(1785,51) = ggT(51, 1785 - 35·51)
                         = ggT(51, 0)

Wir sehen: ggT(1785,51) = 51. Also ebenfalls ggT(5406,1785) = 51

Hier noch ein längeres Beispiel:
           ggT(416,256) = ggT(256,160)
                        = ggT(160,96)
                        = ggT(96,64)
                        = ggT(64,32)
                        = ggT(32,0)
                        = 32

Der Algorithmus lautet:

 
 Wiederhole:

 Ersetzte a und b

solange durch b und (a mod b) 

bis a mod b = 0. 

Der ggT ist dann die letzte Zahl <> 0.
 


In Pascal:

function  ggT(a,b: integer):integer;
   var x :integer;
begin
   if b <> 0 then
   repeat
     x:=a mod b;
     a:=b;
     b:=x;
   until x = 0;
     result := abs(a); //falls a, oder b negativ
end;

      a   a div ggT(a,b)
      - = ——————————————
      b   b div ggT(a,b)

Das Formular könnte folgendermaßen aussehen:

      Bruch(Label1)   gekürzter Bruch(Label2)

      spinedit1       spinedit3
      —————————   =   —————————
      spinedit2       spinedit4

function RoemischeMultiplikation(a,b: integer):integer;
  var s: integer;
begin
  form1.memo1.lines.Clear; //Nur zum Testen
  s := 0;
  repeat
    form1.memo1.Lines.Add('a=' + IntToStr(a)
      + ' b=' + inttostr(b) + ' s=' + inttostr(s));//Test
    if a mod 2 = 1 then s := s + b;
    a := a div 2;
    b := b*2;
  until a = 0;
  result:=s;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var x, y: integer;
begin
  x:= 45;
  y := 17;
  memo1.lines.add('Erg.=' + IntTostr(RoemischeMultiplikation(x,y)));
  //Bemerkung 45*17=(32 + 8 + 4 + 1)*17
end;

Setzte Anfangswert a=0 und y = x.
                            0

     2                      2                1
Ist y  > 2, dann setze y = y - 2 und addiere - zu a,
     0                  1   0                2
                                   2
            andernfalls setze y = y  und addiere nichts zu a.
                               1   0

     2                      2                1
Ist y  > 2, dann setze y = y - 2 und addiere - zu a,
     1                  2   1                4
                                   2
            andernfalls setze y = y  und addiere nichst zu a.
                               2   1

                                         1   1   1
Fahre so fort und addiere gegebenenfalls -, ——, ——, ...
                                         8  16  32

10. Lektion: Rekursive Funktionen. I. Teil

Bei der Rekursion wird ein großes Problem in Teilprobleme zerlegt, die ähnlich strukturiert sind. Hier betrachten wir nur einen kleinen Ausschnitt von diesem Thema: Funktionen, die sich selbst aufrufen.

Man erhält damit häufig erstaunlich kurze, leicht verständliche und effiziente Algorithmen.

Das berühmteste Beispiel ist die Fakultät f(n)= n! =1·2·3·...·n


               1          falls  n = 0
   f(n) := {
               n*f(n-1)   falls  n > 0

Als Delphifunktion:

function f(n: integer): real;
  begin
    if n < 1 then result := 1 else result := n*f(n-1)
  end;

Wird zum Beispiel f(5) aufgerufen, muss man den Werten "hinterher rennen":

  f(5) = 5*f(4) mit
  f(4) = 4*f(3) mit
  f(3) = 3*f(2) mit
  f(2) = 2*f(1) mit
  f(1) = 1*f(0) mit
  f(0) = 1 (Anfangswert)

Also f(5) = 5*4*3*2*1*1

Wichtig: Bei rekursiven Funktionen muss gewährleistet sein.
         I  Das Problem wird auf einfachere Probleme reduziert.
            (Bei der Fakultät: Rechnung für ein kleineres n)

         II Nach endlich vielen Schritten ist das Problem ohne
            Rekursion lösbar.
            (Bei der Fakultät: Schließlich kommt man zu n = 0)


Aufgabe 10.1: Schreibe ein Programm, das eine Wertetafel für f ausgibt.

Aufgabe 10.2: Was wird bei der folgenden Funktion g berechnet?
             a) g(5)       b) g(-5)

function g(n: integer): real;
  begin
    if n = 0 then result := 1 else result := n*g(n-1)
  end;

Aufgabe 10.3: Was wird bei folgender Funktion h berechnet?
             Gib nicht den Wert der Rechnung, sondern einen
             Rechenausdruck an!

             a) h(1.5,5)   b) h(1.5,-5)  c) Allgemein

function h(x:real; n: integer): real;
begin
  if n < 0 then result := 1/h(x,-n) else
    if n = 0 then result := 1 else
      result := x*h(x,n-1)
end;

Aufgabe 10.4: Was wird bei folgender Funktion berechnet?
             Gib nicht den Wert der Rechnung, sondern einen
             Rechenausdruck an!

             a) f(2)    b) f(10)   c) Allgemein


function f(n: integer): real;
begin
  if n < 0 then result := 0
    else result := 1/(2*n+1) + f(n-1)
end;
Lösung

Die Fibonacci-Folge lautet rekursiv definiert:

             1 für n = 1 und n = 2
   f(n) = {
             f(n-1) + f(n-2) für n > 2

function fib(n:integer):integer;
begin
  if n < 2 then result := 1
      else result := fib(n-1) + fib(n-2)
   end;

procedure TForm1.Button1Click(Sender: TObject);
  const max = 500;
  var n: integer;
      nn: array[1..max] of real;
  function f(n: integer): real;
    //zuvor muss f(1), f(2), ..., f(n-1) aufgerufen sein
  begin
    if n <= 2 then result := 1
     else result := nn[n-1] + nn[n-2];
    nn[n] := result;
  end;
begin
  for n := 1 to max do
  memo1.Lines.Add(inttostr(n) + ' ' +floattostr(f(n)));
end;

function fib(n:integer):integer;
  var k, x1,x2: integer;
begin
  result := 1; //für n=1 oder n=2
  x1 := 1;
  x2 := 1;
  for k := 3 to n  do Begin
    result := x1 + x2;
    x1 := x2;
    x2 := result;
  End;
end;

Die Binet'sche Formel

     / 1, falls e=0
     |
     |
 e   |    e-1
m  = | m·m   , falls e ungerade
     |
     |      e
     |      -
     |   2  2
     \ (m )

  function h(m:extended; e:integer):extended;
  begin
    if e = 0 then result := 1 else
      if odd(e) then result := m*h(m,e-1)//da me=m*m(e-1)
        else result := h(m*m,e div 2)    //da me=(m*m)(e/2)
  end;

Die Rekursiosformel:
         / k*PFZ(n div k), falls k Teiler von m (k > 1 minimal}
PFZ(n) ={
         \ n, sonst (d.h. n Primzahl)

       wobei die Darstellung als String noch erforderlich ist.

In Delphi:

function PFZ(const n:integer):string;
  var k:integer;
begin
  for k:=2 to trunc(sqrt(n)) do
    if n mod k = 0 then Begin
      result:=intToStr(k)+'*'+PFZ(n div k); //rekursiv
      exit;
    End;
  result:=intToStr(n);
end;

function ggT(a,b:integer):integer;
begin
 if b=0 then result := a else
   result := ggT(b, a mod b); //Rekursiv
end;

function f(n: integer): real;
begin
  if n <=0 then result := 0 else
    result := 1/n + f(n-1);
end;

function f(n: integer): real;
begin
  if (n=0) or (n=1) then result := 0 else
    result := f(n-1) + 2*f(n-2);
end;

 n    n·(n-1)·(n-2)·...(n-k+1)                49   49·48·47·46·45·44
( ) = ———————————————————————   zum Beispiel (  ) =——————————————————
 k    1 · 2 · 3 ·  ...   ·k                    6    1· 2· 3· 4 ·5 ·6

function nuebk(n,k: integer): integer;
begin
 if k <= 0 then result := 1 else
   result := nuebk(n-1,k-1)*n div k;
end;

zurück

Lösungen der Aufgaben

Inhalt

Lektion 11