Joachim Mohr Mathematik Musik
zurück
Hinweis
Lösungen
Lösung zu Aufgabe 2.1 a) a='Hallo' b='Welt' c='Hallo Welt' b) a=5 b=7 c=9 a=7 b=9 c=7 a=8 b=8 c=6 c) a=1,3 b=-0,3 a=1,4 b=-0,4 c=1 d=-2,22E-16 Theoretisch ist d=0, praktisch wegen der Ungenauigkeit der gespeicherten Zahlen nicht: Hier ist das Ergebnis "zufällig" von der Größenordnung 10^(-16). d) a=-7 b=11 c=13 a=-1 b=-1 c=2 a=-1 b=1 c=-1 a=-2 b=-2 c=-5 e) s := 1 -1/3 + 1/5 -1/7 + 1/9 - 1/11 Bem.: Pi = 4*(1 -1/3 + 1/5 -1/7 + ...)
Lösung zu Aufgabe 3.1
Falls a kleiner als die Hälfte von b ist wird im Fall a) zwei Meldungen, im Fall b) nur eine Meldung ausgegeben.
Lösung zu Aufgabe 4.1 a) procedure TForm1.Button1Click(Sender: TObject); var i:integer; s:real; begin s := 0; for i := 1 to 9999 do s := s + 1/i; showmessage('s='+FloatToStr(s)); //Größenordnung ln(10000) end; Grober Fehler in: procedure TForm1.Button1Click(Sender: TObject); var i:integer; s:real; begin s := 0; for i := 1 to 10000 do; s := s + 1/i; showmessage('s='+FloatToStr(s)); //Größenordnung ln(10000) end; Fehler: Nach do steht der leere Befehl s := s + 1/i; wird erst nach Abarbeitung der Schleife durchgeführt. Für Pascal ist i dann undefiniert! Der Compiler liefert deshalb die Warnung: For-Schleifenvariable i könnte undefiniert sein! (Bei Delphi scheint i = 10000 zu sein und deshalb hier s = 1/1000. Auch dies war nicht beabsichtigt!) b) procedure TForm1.Button1Click(Sender: TObject); var i,s:integer; begin s := 0; for i := 1000 to 1999 do s := s+i; showmessage('s=' + IntToStr(s)); end; c) procedure TForm1.Button1Click(Sender: TObject); var i:integer; p:real; begin p := 1; for i := 1 to 16 do p := p*2; showmessage('p=' + FloatToStr(p)); end; Lösung zu Aufgabe 4.2 a) s = 1 - 1/3 + 1/5 - 1/7 + 1/9 - 1/11 p = 4*(1 - 1/3 + 1/5 - 1/7 + 1/9 -1/11) = 2,976 046 b) p = 4*(s = 1 - 1/3 + 1/5 -1/7 + ... +/- 1/(2*n+1)) Nach Leibniz: p ——> Pi
Lösung zu Aufgabe 5.1 Man benötigt zwei Edit-, eine Memo- und eine Buttonkomponente. procedure TForm1.Button1Click(Sender: TObject); var x, a, b :integer; y :real; begin a := strToInt(edit1.text); b := strToInt(edit2.text); memo1.Lines.clear; for x := a to b do Begin y := 1/3*x*x*x - 3*x; memo1.lines.Add(IntToStr(x) + ' ' + FloatToStr(y)); End; end; Lösung zu Aufgabe 5.2 Das Programm rechnet eine Wertetafel für die Sinusfunktion für von -360° bis 360° in Zehnerschritten aus: Der Inhalt von memo1 ist: -360 -1,0842021724855E-19 theoretisch = Null -350 0,17364817766693 -340 0,342020143325669 -330 0,5 ... 0 0 10 0,17364817766693 20 0,342020143325669 30 0,5 ... Lösung zu Aufgabe 5.3 Setze außer dem Button noch drei Edierkomponenten auf die Form. OOP Ändere im Objektinspektor um: Name von edit1,edit2 und edit3 auf editx1, editx2 und edits Text auf -5, 5 und 0,5 procedure TForm1.Button1Click(Sender: TObject); var x, x1, x2, s, y:real; begin x1 := strToFloat(editx1.text); x2 := strToFloat(editx2.text); s := strToFloat(edits.text); x := x1; //Anfangswert //.. Rest unverändert mit while oder repeat end;
Lösung zu Aufgabe 5.4 a) a = 2 b = -10 c = 0 a = 6 b = -6 c = 4 a = -2 b = 2 c = 0 x = 7 x = 7^2 x = 7^4 y = 7^4 x = 7^8 x = 7^16 y = 7^20 b) a = 6 b = -5 c = -25; d = 625 w = 25 x = 2,5 Allgemein: Eine der zwei Lösungen der Gleichung ax^2+b^+c = 0 c)
| k | 1 | 2 | 3 | 4 | 5 | 6 |
| a | 1 | 4 | 9 | 16 | 25 | 1/36 |
| x 0 | 1 | 1+1/4 | 1+1/4+1/9 | 1+1/4+1/9+16 | 1+1/4+1/9+1/16+1/25 | 1+1/9+1/16+1/25+1/36 |
| a | 1 | 9 | 25 | |
| x | 0 | 1 | 1+1/9 | 1+1/9 + 1/25 |
| k | 1 | 3 | 5 | 7 |
| a | 2 | 4 | 6 | 8 | 10 | |
| b | 3 | 5 | 7 | 9 | 11 | |
| x | 1 | 2/3 | 2/3·4/5 | 2/3·4/5·6/7 | 2/3·4/5·6/7·8/9 | 2/3·4/5·6/7·8/9·10/11 |
| k | 1 | 2 | 3 | 4 | 5 | 6 |
Lösung zu Aufgabe 5.5 a) (i) button1 (ii) button2 und (iii) button3 procedure TForm1.Button1Click(Sender: TObject); var k: integer; x,y:real; begin memo1.lines.clear; for k := -20 to 20 do Begin x := k/10; y := x*x - 2*x; memo1.lines.add(floatToStr(x)+' '+floatToStr(y)); End; end; procedure TForm1.Button2Click(Sender: TObject); var x1, x2, x, y, s: real; begin x1 := -2; x2 := 2; s := 1/10; x := x1; //Startwert memo1.lines.clear; while x < x2 + s/2 do Begin {"+s/2", da x statt 2 nur 1.999..9 erreichen könnte} y := x*x - 2*x; memo1.lines.add(floatToStr(x)+' '+floatToStr(y)); x := x + s; End; end; procedure TForm1.Button3Click(Sender: TObject); var x1, x2, x, y, s: real; begin x1 := -2; x2 := 2; s := 1/10; x := x1; //Startwert memo1.lines.clear; repeat y := x*x - 2*x; memo1.lines.add(floatToStr(x)+' '+floatToStr(y)); x := x + s; until x > x2 + s/2; end; Hinweis: Man sieht (ii) und (iii) rechnet mit Ungenauigkeiten. (die 15. Dezimale weicht vom genauen Ergebnis ab!) Deshalb empfiehlt sich statt floatToStr die formatierte Ausgabe: memo1.lines.add(formatFloat('0.##',x)+' '+formatfloat('0.##',y)). Lösung zu Aufgabe 5.5 b) procedure TForm1.Button1Click(Sender: TObject); var n,i: integer; s: real; begin n := StrToInt(edit1.text); s := 0; //Anfangswert der Summe for i := 1 to n do s := s + 1/(i*i); //"Aufsummieren" ! edit2.text := floatToStr(s); end; Lösung zu Aufgabe 5.5 c) procedure TForm1.Button1Click(Sender: TObject); var a,b,i: integer; p: real; begin a := StrToInt(edit1.text); b := StrToInt(edit2.text); p := 1; //Anfangswert des Produkts for i := a to b do p := p*i; //"Aufmultiplizieren" ! edit3.text := floatToStr(p); end;Lösung zu Aufgabe 5.6 Bildschirmaufnahme
procedure TForm1.Button1Click(Sender: TObject);
var n: integer;
a,s: real;
begin
s := 0;
n := 0;
a := 20;
repeat
n := n + 1;
s := s + 1/n;
until s > a;
showmessage('n = ' + inttoStr(n));
end;
Der Computer liefert nach einiger Zeit n = 272 400 600.
Es handelt sich hierbei um die bestimmt divergente "harmonische" Reihe. (Bestimmt divergent heißt: Die Summe überschreitet jede Schranke, wenn nur n genügend groß gewählt wird).
Um die Summe von 100 zu erreichen, würde man etwa n=e100 = 2,688·1043 erhalten. Ein Computer, der eine Billion Additionen in der Sekunde ausführt, bräuchte dafür etwa 1030 Jahre.
Übrigens: Rechnet der Computer nur auf 16 geltende Ziffern genau (Stand Anfang 3. Jahrtausend), dann ist
100 + 1/1014 = 100,000 000 000 000 01 = 100, d.h. ab n = 1014 wird s nicht mehr geändert.
Etwas ausführlicher zeigt Dir das Programm harmonische Reihe bei Einsteigerprogramme
Für mathematisch Interessierte:
1 + 1/2 + 1/3 + 1/4 + 1/5 + 1/6 + 1/7 + 1/8 + 1/9 + 1/10 + ... > 1 + 1/2 + 1/4 + 1/4 + 1/8 + 1/8 + 1/8 + 1/8 + 1/16 + 1/16 + ... = 1 + 1/2 + 2/4 + + 4/8 + 8/16 + ... = 1 + 1/2 + 1/2(2 Summanden) + 1/2(4 Summanden) + 1/2(8 Summanden) + ... = 1 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + 1/2 + ... = UnendlichZur Genauigkeit von Rechenoperationen siehe Anhang 2
Lösung zu Aufgabe 5.7
procedure TForm1.Button1Click(Sender: TObject);
var p,q,k,a: real;
n: integer;
fertig: boolean;
ns,aas,ks: string; //Zur besseren Darstellung
begin
p := 5; //Besser in Editfeld einlesen
q := 1 + p/100;
K := 1674000; //Besser in Editfeld einlesen
a := 48000; //Besser in Editfeld einlesen
n := 0;
fertig := false;
memo1.text := 'Jahre Auszahlung Rest';
repeat
ns := intToStr(n);
while length(ns) < 6 do ns := ns + ' ';
aas := formatfloat('## ##0.00',a);
while length(aas) < 15 do aas := aas + ' ';
ks := formatfloat('# ### ##0.00',K);
memo1.lines.Add(ns+aas+ks);
if k < 0 then fertig := true;
a := a*q;
K := (K - a)*q;
n := n + 1; //oder inc(n)
until fertig or (n > 200);
end;
Ergebnis: Das Programm zeigt: Nach 33 Jahren ist Schluss. Bemerkung: Das Risiko, dass er für sein Vermögen zu lange lebt, kann er Rentenversicherungen übertragen. Dann hängt seine jährliche Verfügungsmasse von der durchschnittlichen Lebenserwartung ab (abzüglich den Teil, den die Versicherung kassiert).
Lösung zu Aufgabe 6.1
round rundet eine Integerzahl (Achtung: bei ",5" wird auf eine gerade Zahl gerundet), abs gibt den Absolutbetrag einer Zahl an.
a) 25.458 b) -35,445 c) 0 d) runden auf 3 Dezimalen
Lösung zu Aufgabe 6.2 Wertetafel
Dein Formular benötigt button1 und memo1
function f(alpha:real):real;
var x:real;
begin
x := alpha*Pi/180; //x muss zuerst ins Bogenmaß umgewandelt werden
result := 2*sin(x)+sin(2*x)
end;
procedure TForm1.Button1Click(Sender: TObject);
var alpha:integer;
begin
memo1.Text :=
'Wertetafel für f(alpha)=2sin(alpha) + sin(2*alpha)'#13#10#+
'alpha f(alpha)'#13#10#13#10; //#13#10 Zeilenumbruch
alpha := -720;
while alpha <= 720 do Begin
memo1.Lines.Add(
IntToStr(Alpha)+'° '+formatFloat('##0.###',f(alpha)));
alpha := alpha + 30;
End;
end;
Lösung zu Aufgabe 6.3 Das Pascalsche Dreieck:
function nuebk(n,k:integer):integer;
var i:integer;
begin
result := 1;
for i := 1 to k do
result := result*(n-i+1) div i; //Division bei Integer
end;
procedure TForm1.Button1Click(Sender: TObject);
var k,n:integer;
s:string;
begin
memo1.Lines.Clear;
memo1.Alignment := taCenter; //Text zentriert
for n := 0 to 20 do Begin
s := '';
for k := 0 to n do s := s+' '+IntToStr(nuebk(n,k));
memo1.lines.add(s);
End;
end;
Noch etwas strukturierter könnte das Programm folgendermaßen aussehen:
function nuebk(n,k: integer): integer;
var i: integer;
begin
result := 1;
for i := 1 to k do
result := (n-i+1)*result div i;
end;
function zeile(n: integer): string;
var k: integer;
begin
result := '';
for k := 0 to n do
result := result + inttostr(nuebk(n,k)) + ' '
end;
procedure TForm1.Button1Click(Sender: TObject);
var n: integer;
begin
form1.Windowstate := wsmaximized;
memo1.Align := alClient;
memo1.lines.Clear;
for n := 1 to 20 do
memo1.Lines.Add(zeile(n));
end;
Der Ausdruck ist dann folgender:
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
1 6 15 20 15 6 1
1 7 21 35 35 21 7 1
1 8 28 56 70 56 28 8 1
1 9 36 84 126 126 84 36 9 1
1 10 45 120 210 252 210 120 45 10 1
1 11 55 165 330 462 462 330 165 55 11 1
1 12 66 220 495 792 924 792 495 220 66 12 1
1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1
1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1
1 15 105 455 1365 3003 5005 6435 6435 5005 3003 1365 455 105 15 1
u.s.w.
Lösung zu Aufgabe 6.4 Potenzfunktion x^n (n natürliche Zahl)
function hoch(x: real; n: integer):real; var i: integer; begin result := 1; for i := 1 to n do result := result*x; end; procedure TForm1.Button1Click(Sender: TObject); begin showmessage(floatTostr(hoch(2,10))); showmessage(floatTostr(hoch(1.5,2))); showmessage(floatTostr(hoch(5,0))); end;Bemerkung: Häufig wird auch die Formel b^x = (e^lnb)^x verwendet:
function hoch(b,x:real):real; //b > 0 und x <> 0 begin result := exp(x*ln(b)); end;Hoch möglichst allgemein definiert: siehe Anhang.
Lösung zu Aufgabe 7.2 Wertetafel formatiert
Hier wird neben button1 noch memo1 benötigt.
Stelle im Objektinspektor die Schrift auf 'Courier New' und schalte
den Zeilenumbruch aus (wordwrap auf false ).
Hier ist angebenen, wie diese Eigenschaften auch zur Laufzeit
zugewiesen werden können.
function meinFormat(x:real):string;
var n: integer;
begin
result := formatfloat('### ### ##0.##',x);
//Zuerst suchen, wo ist das Komma. Allgemein der Decimalseparator.
n := pos(Decimalseparator,result);
if n = 0 then result := result + ' ' else //3 Stellen
if n = length(result) - 1 then result := result + ' ';
//Drei Stellen "hinten". "Vorne sollen es 11 sein also zusammen 14
while length(result) < 14 do result := ' ' + result;
end;
function f(x:real):real;
begin
result := 1/3*x*x*x - 3*x;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x,y : real;
begin
memo1.lines.clear;
memo1.Font.Name := 'Courier New'; //Im Objektinspektor
memo1.font.size := 12; //Im Objektinspektor
memo1.WordWrap := false; //Im Objektinspektor
x := -5;
while x <= 5 do Begin
y := f(x);
memo1.Lines.Add(MeinFormat(x)+ ' ' + MeinFormat(y));
x := x + 1/4;
End;
end;
Lösung zu Aufgabe 7.3: Alle Primzahlen bis 1000
function IstPrimzahl(n:integer):boolean;
var k : integer;
begin
result := true; //solange kein Treffer gefunden
//Zuerst wird geprüft, ob n gerade, dann werden alle ungeraden Zahlen
//bis sqrt(n) getestet.
//Warum bis sqrt(n): Siehe Beispiel 6.2
if n mod 2 =0 then Begin
result := false;
exit
End else Begin
k := 3; //Alle ungeraden Zahlen werden getestet
while k <= sqrt(n) do BEgin
if n mod k = 0 then BEGin
result := false;
exit;
END;
k := k + 2;
ENd;
End;
end;
{Hinweis: exit bewirkt, dass die Funktion sofort verlassen
wird. Hier sehr sinnvoll: Ist ein Teiler gefunden,
interessieren die übrigen nicht mehr.}
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
memo1.lines.clear;
memo1.WordWrap := true;
for i := 2 to 1000 do
if IstPrimzahl(i) then
memo1.text := memo1.text + IntToStr(i) + ' ';
end;
Lösung zu Aufgabe 7.4: Passworteingabe. Einfache Version
procedure TForm1.Button1Click(Sender: TObject);
const Passwort = '1001';
var s: String;
begin
edit1.PasswordChar := '*';
if edit1.text = Passwort then
showmessage('Sie haben das richtige Passwort eingegeben.') else
showmessage('Das war das falsche Passwort'#13#10+
'Versuchen Sie es nocheinmal');
end;
NochLösung zu Aufgabe 7.4: Passworteingabe. Nur drei Versuche möglich!
Dies ist etwas komlizierter. Wir benötigen noch eine Variable:
Zaehler wird bei jedem Versuch hochgezählt.
Man kann sie als globale Variable deklarieren oder wie hier
(als Prinzip der maximalen Kapselung) als private Variable
der Form1 (dann ist sie von außen mit nicht beeinflussbar.)
type
TForm1 = class(TForm)
...
private
Zaehler: Integer; //<——— Hier den Zähler deklarieren
...
var
Form1: TForm1;
//Zaehler:Integer; <—— Hier als globale Variable
//Initialisieren
procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.PasswordChar := '*';
edit1.text := '';
Zaehler := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
const Passwort = '1001';
var s: String;
begin
Zaehler := Zaehler + 1;
if edit1.text = Passwort then
showmessage('Sie haben das richtige Passwort eingegeben.') else Begin
if zaehler > 2 then BEgin
showmessage('Falsche Passwort: Programm wird beendet');
close;
ENd else
showmessage('Das war das falsche Passwort'#13#10+ //#13#10=Zeilenumbruch
'Versuchen Sie es nocheinmal'#13#10+
'Sie haben noch '+intToStr(3-Zaehler)+' Versuche.');
edit1.text := ''
End;
end;
Lösung zu Aufgabe 7.5:
a=0 b=0 c=2 a=0 b=1 c=3 a=1 b=0 c=5 a=1 b=1 c=7
- Bemerkung:
- Dasselbe Ergebnis würde man auch mit folgendem Programm, ohne BEgin und ENd erreichen.
-
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 if b = 0 then c := 2 else c := 3 else //bezieht sich auf if a = 0 then... if b = 0 then c := 5 else c := 7; memo1.lines.add('a='+IntToStr(a)+' b='+IntToStr(b)+ ' c='+IntToStr(c)); End; end; - Mit BEgin und ENd ist das Programm jedoch besser strukturiert.
Nenne die Buttons br, bd, bu und bA! Procedure Berechnungen(r: real); var d,u,a:real; //kann auch als Methode fon form1 deklariert werden. Siehe download begin d := 2 *r; u := Pi*d; a := Pi*r*r; form1.er.text := FloatToStr(r); form1.ed.text := FloatToStr(d); form1.eu.text := FloatToStr(u); form1.a.text := FloatToStr(a); end; procedure TForm1.brClick(Sender: TObject); var r:real; begin r := StrToFloat(er.text); berechnungen(r); end; procedure TForm1.bdClick(Sender: TObject); var r:real; begin r := StrToFloat(ed.text)/2; berechnungen(r); end; procedure TForm1.buClick(Sender: TObject); var r:real; begin r := StrToFloat(eu.text)/(2*Pi); berechnungen(r); end; procedure TForm1.baClick(Sender: TObject); var r:real; begin r := sqrt(StrToFloat(ea.text)/Pi); berechnungen(r); end;Das ganze Projekt zum Download findest Du bei Kreisberechnungen
Lösung zu Aufgabe 8.1: Wertetafel Betriebszugehörigkeit -> Prämie
function f(n: integer): integer;
begin
Case n of 0 : result := 0;
1 .. 4 : result := 200;
5 .. 10: result := 400;
else result := 800;
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
var n:integer;
begin
memo1.lines.clear;
for n := 0 to 60 do
memo1.lines.Add('Alter: '+inttoStr(n)+' Jahre Prämie: '+IntToStr(f(n))+ ' EUR')
end;
Lösung zu Aufgabe 8.2: Fahrkartenautomat
Du benötigst eine radiogroup1 und ein label1.
Beschrifte im Objektinspektor die items der radiogroup1:
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
Ergänze das Onklick-Ereignis der radiogroup1:
procedure TForm1.RadioGroup1Click(Sender: TObject);
var preis: integer;
begin
Case radiogroup1.itemindex of 0: preis := 2;
1: preis := 3;
2: preis := 5;
3: preis := 8;
4: preis := 9;
5: preis := 14;
else preis :=0 ;//unnötig, aber keine Warnung des Compilers
End;
label1.Caption :=
'Ihrer Geldkarte wird abgebucht: ' +
intToStr(preis) + ' ,00 EUR'
end;
Lösung zu Aufgabe 8.3: Punkte -> Note
function note(punktzahl: integer):string;
begin
Case punktzahl of 15,14,13: result := 'sehr gut';
12,11,10: result := 'gut';
9, 8, 7: result := 'befriedigend';
6, 5, 4: result := 'ausreichend';
3, 2, 1: result := 'mangelhaft';
0: result := 'ungenügend';
else result := 'Fehleingabe';
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text := note(spinedit1.value);
end;
Lösung zu Aufgabe 8.4: 7-3-1-Prüfsumme
function pruefsumme(s:string): integer;
var k: integer;
begin
result := 0;
for k := 1 to length(s) do
Case k mod 3 of 1: result := result + 7*StrToInt(s[k]);
2: result := result + 3*StrToInt(s[k]);
0: result := result + StrToInt(s[k]);
End;
end;
Eine Anwendung findest Du bei Ausweis.
Beim Personalausweis werden die Prüfziffern von der Stadtkennzahl,
dem Geburts- und Ablaufdatum und eine Gesamtprüfziffer gebildet.
Lösung zu Aufgabe 8.5: Bei Aufgabe 8.5 wird getestet, ob Du folgende Konstruktionen verstanden hast:
- if .. then .. else
- for .. to .. do
- repeat .. until ..
- while .. do ..
- Und alles noch verschachtelt mit Funktionen f(x) und f(x,y), die ebenfalls mit diesen Konstruktionen arbeiten.
a) Ins Memo wird nacheinander geschrieben:
Kreisfläche (r=5) = 78,5398163397448 [=25·Pi]
Quadrat (a=3) = 9
gleichseitiges Dreieck (a=10) = 0
Vor der letzten Zeile erscheint die Meldung:
Unbekanntes Objekt
b) Folgende Wertetafel für i und f(i) wird geschrieben:
-2 -4
-1 -2
0 0
1 0,5
2 1
c) Folgende Wertetafel für i und g(i,2·i) wird geschrieben:
-4 16
-2 8
0 0
2 16
d) Die Wertetafel für die Fakultät h(n) = n! wird geschrieben:
0 1
1 1
2 2
3 6
4 24
5 120
Lösung zu Aufgabe 8.6:
Die Lösungen der quadratischen Gleichung in Abhängigkeit von der
Diskriminante:
procedure TForm1.Button1Click(Sender: TObject);
var a, b, c, d, x1, x2: real;
begin
a := StrToFloat(edit1.text);
b := StrToFloat(edit2.text);
c := StrToFloat(edit3.text);
d := b*b - 4*a*c;
if d < 0 then Begin
edit4.text := 'Keine Lösung';
edit5.hide;
End else if d = 0 then Begin
x1 := - b/(2*a);
edit4.Text := floatToStr(x1);
edit5.hide;
End else Begin
x1 := (-b + sqrt(d))/(2*a);
x2 := (-b - sqrt(d))/(2*a);
edit4.Text := floatToStr(x1);
edit5.Text := floatToStr(x2);
edit5.Show;
End;
end;
Lösung zu Aufgabe 8.7:
procedure TForm1.Button1Click(Sender: TObject);
var p: integer;
begin
p := StrToInt(edit1.text);
Case p of 0 : edit2.text := 'ung';
1 .. 3: edit2.text := 'mgh';
4 .. 6: edit2.text := 'ausr';
7 .. 9: edit2.text := 'bfr';
10..12: edit2.text := 'gut';
13..15: edit2.text := 'sgt';
else edit2.text := 'Fehler';
End;
end;
Lösung zu Aufgabe 8.8:
function f(n:integer): real;
var i:integer;
begin
result := 0; //Anfangswert der Summe
for i := 1 to n do
result := result + 1/i;
end;
function g(n:integer): real;
var i:integer;
begin
result := 1; //Anfangswert des Produkts
for i := 1 to n do
result := result * (2*i - 1)/(2*i)
end;
oder (Timo's geniale Lösung)
function g(n:integer): real;
var i:integer;
begin
result := 1; //Anfangswert des Produkts
for i := 1 to 2*n do
if i mod 2 = 1 then
result := result*i
else
result := result/i
end;
oder (Frank's geniale Lösung)
function g(n:integer): real;
var zaehler, nenner: integer;
begin
result := 1; //Anfangswert des Produkts
zaehler := 1;
nenner := 2;
while zaehler <= 2*n - 1 do Begin
result := result*zaehler/nenner;
zaehler := zaehler + 2;
nenner := nenner + 2;
End;
end;
Lösung zu Aufgabe 8.9:
Hast Du div und mod verstanden?
a = 416 q = 2 r = 96 a1 = 416
a = 160 q = 1 r = 64 a1 = 160
a = 96 q = 1 r = 32 a1 = 96
a = 64 q = 2 r = 0 a1 = 64
Du kannst hier erkennen: Stets ist: a := b·(a div b) + (a mod b). Beispiel: 13 div 3 = 4 Rest 1. Also 13 := 3·4 + 1.
Bei diesem Beispiel wurde übrigens ggT(416,160) = 32 berechnet. Bevor r = 0 wird, ist r = ggT(a,b). Dies wird in der nächsten Lektion ausführlich besprochen.
Lösung zu Aufgabe 8.10: Börsensimulation. Benötigte Komponenten: Timer. Die übrigen ergeben sich aus dem Programm. Man sollte diese zur besseren Wartung noch umbenennen: button2 in bschliessen u.s.w.
Hier wurde der ursprüngliche Namen beibehalten. Dann kann man das Programm einfacher nach Delphi kopieren. Zum Beispiel: Form1 anklicken und (im Objektinspektor) das Ereignis OnCreate doppelklicken. Dann
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
———————————— Programm Börse: Downloadseite Simulation Aktie var Form1: TForm1; tempo: integer; //Timereinstellung (Anfangswert500 ms) // Kann mit button4 geändert werden. implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin //Anfangswerte setzen. randomize; //Nötig wann immer random benötigt wird. label1.Caption := //Ein label mit Zeilenumbruch. 'Eugen hat eine Aktie A im Wert von 1000 EUR. Josef hat 1000 EUR bar.'#13+ 'Täglich wechselt die Aktie den Besitzer. Der Wert der Aktie kann'#13+ 'täglich um maximal p% nach oben oder unten schwanken.'#13+ 'Wie viel hat jeder? Negativer Besitz heißt: Geld geliehen. Steigt/fällt'#13+ 'der Wert der Aktie ist der Besitz von Eugen + Josef höher/geringer.'#13+ '(In Wahrheit ist die Aktie nichts wert, nur wissen die beiden es nicht.'#13+ ' Zusammen besitzen sie - auch nach der Umverteilung - 1000 EUR)'; //Hier sind die Anfangswerte sichtbar edit1.text := '5'; //Anfangswert p edit2.Text := '1000'; //Eugen bar edit3.text := '0'; //Josef bar edit4.text := '0'; //Eugen Aktie edit5.text := '1000'; //Aktie von Josef edit6.text := ''; //Summe Eugen edit7.text := ''; //Summe Joasef label5.Caption := '0'; //Zähler timer1.Enabled := false; //Disabled tempo := 512; //Millisekunten button4.Caption := 'Schneller'; //Knopf, der Timer steuert. end; procedure TForm1.Button1Click(Sender: TObject); //Sart-Weiter-Knopf begin if button1.Caption = 'Stop' then Begin //"Stop" wurde angeklickt. timer1.Enabled := false; //Timer außer Betrieb button1.Caption := 'Weiter'; //Als nächstes kann "Weiter" angeklickt werden. End else Begin //"Start" oder "weiter" wurde angeklickt. timer1.Enabled := true; //Timer in Betrieb button1.Caption := 'Stop'; //Als nächstes kann "Stop" angeklickt werden. End; end; procedure TForm1.Timer1Timer(Sender: TObject); var eug, jos, eug_a, jos_a, vol: real; begin label5.Caption := IntToStr(StrToInt(label5.caption) + 1); //Zähler eug := strToFloat(edit2.text); //Kapital von Eugen bar jos := strToFloat(edit3.text); //Kapital von Josef eug_a := strToFloat(edit4.text); //Wert der Aktie von Eugen jos_a := strToFloat(edit5.text); //Wert der Aktie von Josef vol := StrToFloat(edit1.Text)*(2*random-1); //Volatilität maximal +/- p/100 vol := round(10*vol)/10; //Gerundet auf 1 Dezimale label7.Caption := Formatfloat('0.###',vol)+ ' %'; //Zum Beispiel -2,4% if jos_a > 0 then Begin //Eugen kauft von Josef die Aktie eug_a := jos_a*(1 + vol/100); //Jetzt hat Eugen die Aktie zum Tageskurs eug := eug - eug_a; //.. und zahlt den Kaufpreis. jos := jos + eug_a; //Josef erhält den Kaufpreis jos_a := 0; //.. und hat keine Aktie mehr. End else Begin //Josef kauft von Eugen die Aktie jos_a := eug_a*(1 + vol/100); //Jetzt hat Josef die Aktie zum Tageskurs jos := jos - jos_a; //.. und zahlt den Kaufpreis. eug := eug + jos_a; //Eugen erhält den Kaufpreis eug_a := 0; //.. und hat keine Aktie mehr. End; //Berechnung klar? edit2.text := formatfloat('0.##',eug); //Besitz schreiben. Siehe oben. edit3.text := formatfloat('0.##',jos); edit4.text := formatfloat('0.##',eug_a); edit5.text := formatfloat('0.##',jos_a); edit6.text := formatfloat('0',eug+eug_a); //Zusammen edit7.text := formatfloat('0',jos+jos_a); application.ProcessMessages; end; procedure TForm1.Button4Click(Sender: TObject); begin tempo := tempo div 2; if tempo <= 1 then tempo := 1; timer1.Interval := tempo; button4.Caption := intToStr(tempo) + 'ms'; end; procedure TForm1.Button2Click(Sender: TObject); begin close end;
- Bemerkung:
- Der Bargeldbesitz kann auch negativ werden (Geld geliehen).
- Steigt/fällt der Wert der Aktie ist der
Besitz von Eugen + Josef höher/geringer. Es kann durchaus sein, dass
die Aktie gar nichts wert ist. Eugen und Josef wissen das nur nicht.
(Alte Börsenweisheit: An der Börse geht kein Geld verloren. Es wechselt nur den Besitzer.) - Langfristig fällt der Wert der Aktie. Nehmen wir an, der Wert
steigt oder fällt abwechselnd jeden Tag um p = ±50%. Dann hat man
folgende Entwicklung:
Der Grund liegt darin, dass additiv und nicht multiplikativ gerechnet wird.1000 EUR 1500 EUR 750 EUR 1125 EUR 563 EUR 844 EUR 442 EUR 633 EUR 316 EUR 474 EUR 237 EUR 356 EUR 178 EUR 267 EUR 133 EUR 200 EUR 100 EUR 150 EUR 75 EUR 113 EUR 56 EUR 84 EUR 44 EUR 63 EUR 32 EUR 47 EUR 24 EUR 36 EUR 18 EUR 27 EUR 13 EUR 20 EUR 10 EUR 15 EUR 7,5 EUR 11,3 EUR 5,6 EUR 8,4 EUR 4,4 EUR 6,3 EUR 3,2 EUR 4,7 EUR 2,4 EUR 3,6 EUR 1,8 EUR 2,7 EUR 1,3 EUR 2 EUR
Statt K1 := K0*(1 ± p/100)*K0 sollte man besser mit K1=K0*(1+p/100) bzw. K1=K0/(1+p/100) rechnen.
Also zum Beispiel alternierend +50% und -33,3%.
Allgemein: alternierend +p% und -100*p/(100+p)%.
Lösung zu Aufgabe 9.1: Kürzen.
function ggT(a,b: integer):integer;
begin {siehe in der Lektion} end;
procedure TForm1.Button1Click(Sender: TObject);
var a, b, c, d, q: integer;
begin
a := spinedit1.Value;
b := spinedit2.Value;
if b <> 0 then q := ggT(a,b) else q := 1;
c := a div q;
d := b div q;
spinedit3.Value := c;
spinedit4.value := d;
end;
Aufgabe 9.2: In dieser Aufgabe wird ein schöner Algorithmus demonstriert: Die römische Multiplikation
Die Römer hatten ja bekanntlich ein nicht sehr übersichtliches Zahlensystem. (Siehe Römische Zahlen). Immerhin: Sie konnten die Hälfte und das Doppelte berechnen. Darauf konnten sie dann die Multiplikation zurückführen. In der Aufgbabe wurde der Algorithmus verwendet. (Im Grunde wird der erste Faktor ins Zweiersystem zerlegt.)
Lösung:
a=45 b=17 s=0 a=22 b=34 s=17 a=11 b=68 s=17 a=5 b=136 s=85 a=2 b=272 s=221 a=1 b=544 s=221 Erg.=765
Lösung zu Aufgabe 10.1: Wertetafel für die Fakultät
function f(n: integer): real;
begin
if n < 1 then result := 1 else result := n*f(n-1)
end;
procedure TForm1.Button1Click(Sender: TObject);
var n:integer;
begin
memo1.lines.clear;
for n := 0 to 100 do
memo1.lines.Add(inttoStr(n)+' '+FloatToStr(f(n)))
end;
Lösung zu Aufgabe 10.2: a) Funktionert für positive Werte von n wie bei
Aufgabe 10.1
f(5) = 5·4·3·2·1 = 5!
b) f(-5) = -5*f(-6) mit
f(-6) = -5*f(-7)
...
Ende wird nie erreicht.
Bedeutet "Computerabsturz" wegen "Stacküberlauf".
Unter Delphi kannst Du allerdings dein Programm
über Menü "Start|Programm zurücksetzen" stoppen.
Lösung zu Aufgabe 10.3 a) 1.5*1.5*1.5*1.5*1.5 = 1.5^5
1
b) ——————————————————— = 1.5^(-5)
1.5*1.5*1.5*1.5*1.5
c) h(x,n) = x^n für x beliebig und n ganze Zahl
Lösung zu Aufgabe 10.4 a) f(2) = 1/5 + f(1) mit
f(1) = 1/3 + f(0) mit
f(0) = 1/1 + 0
Somit: f(2) = 1/5 + 1/3 + 1
b) f(10) = 1/21 + f(9) mit
f(8) = 1/19 + f(8) mit
...
f(0) = 1
Somit: f(10) = 1/21 + 1/19 + 1/17 + ... + 1/3 + 1
c) f(n) = 1 + 1/3 + 1/5 + 1/7 + ... + 1/(2n+1)
Lösung zu Aufgabe 10.5 Wertetafel für die Fibonacci-Folge:
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);
var k: integer;
begin
memo1.lines.clear;
for k := 1 to 30 do
memo1.lines.Add(intToStr(k)+ ' ' + intToStr(fib(k)));
end;
Lösung zu Aufgabe 10.6 Wieviel Addition werden bei fib(k) ausgeführt?
var
Form1: TForm1;
Zaehladd:integer; //Globale Variable
implementation
{$R *.DFM}
function add(a,b:integer): integer; //bei a + b wird Zaehladd um 1 erhöht
begin
inc(Zaehladd);
result := a + b
end;
function fib(n:integer): integer;
begin
if n < 2 then result := 1 else
result := add(fib(n-1), fib(n-2))
end;
procedure TForm1.Button1Click(Sender: TObject);
var k: integer;
begin //wertetafel
for k := 1 to 35 do Begin
Zaehladd := 0;
memo1.lines.Add(intToStr(k) + ' ' +
intToStr(fib(k)) + ' ' +
intToStr(ZaehlAdd));
End;
end;
Der Ausdruck ist folgender:
1 1 0
2 2 1
3 3 2
4 5 4
5 8 7
6 13 12
7 21 20
8 34 33
9 55 54
...
35 14930352 14930351
Man sieht fib(k) benötigt, rekursiv berechnet, f(k) - 1 Additionen.
Also bei f(35) fast 15 Millionen. Lösung zu Aufgabe 10.7 Die Fibonacci-Folge nach der Binet'sche Formel:
Als Hilfsfunktion benötigt man noch hoch, in dieser Lektion natürlich rekursiv definiert.
function hoch(x:real; n:integer):real; //rekursiv
begin
if n < 0 then result := 1/hoch(x,-n) //x^(-m)=1/x^m
else if n = 0 then result := 1 //Anfangswert
else result := x*hoch(x,n-1); //x ^n=x*x^(n-1)
end;
function fib(n:integer):integer;
var x1,x2,y:real;
begin
x1 := (1+sqrt(5))/2;
x2 := (1-sqrt(5))/2;
y := (hoch(x1,n) - hoch(x2,n))/sqrt(5);
result := round(y);
end;
oder
function fib(n:integer):integer;
begin
result := round((hoch((1+sqrt(5))/2,n) - hoch((1-sqrt(5))/2,n))/sqrt(5));
end;
Lösung zu Aufgabe 10.8
1 1 1 1
a) s = 1 + - + - + - + -
2 3 1 5
1 1 1 1
b) s = 1 + - + - + - + ... + ——
2 3 4 10
c) s = 0
1 1 1 1
b) s = 1 + - + - + - + ... + -
2 3 4 n
Lösung zu Aufgabe 10.9:
| n | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |
| f(n) | 1 | 1 | 3 | 2+3 | 6+5 | 10+11 | 22+21 | 42+43 | 86+85 | 170+171 | 342+341 |
| f(n) | 1 | 1 | 3 | 5 | 11 | 21 | 43 | 85 | 171 | 341 | 683 |
a) f(3)=5 b) f(5)=21 c) f(10)=683 d( f(-2) fatal (Endlosschleife)
Lösung zu Aufgabe 11.1 Lösung der quadratischen Gleichung ax2 + bx + c =0.
Die Werte für a, b und c werden in edit1, edit2 und edit3 eingegeben.
Es ist nur folgende Prozedur zu ändern:
procedure TForm1.Button1Click(Sender: TObject);
var anz: integer;
a, b, c, x1,x2: real;
begin
a := strToFloat(edit1.text);
b := strToFloat(edit2.text);
c := strToFloat(edit3.text);
QuadrGl(a, b, c,anz,x1,x2);
if anz = 0 then showmessage('Keine Lösung') else
if anz = 1 then showmessage('Eine Lösung: x ='+floatToStr(x1))
else showmessage('Lösungen: x1=' + FloatToStr(x1) + ' x2=' + FloatToStr(x2));
end;
Eine ausgefeiltere Programmversion steht bereit in
Quadratische Gleichung
- Dort werden noch die folgenden wiederverwendbare Funktionen eingesetzt:
- Eingabe von Brüchen (Verwendung eines Parsers)
- Ausgabe von Brüchen
Procedure Kegel(r, h: real; var O, V: real); var s: real; begin s := sqrt(r*r + h*h); O := Pi*r*(r + s); V := 1/3*Pi*r*r end; procedure TForm1.Button1Click(Sender: TObject); var r, h, V, O: real; begin r := StrToFloat(edit1.text); h := StrToFloat(edit2.text); Kegel(r, h, V, O); edit3.text := 'Oberfläche = ' + floatToStr(O); edit4.text := 'Volumen = ' + floatToStr(V); end;Lösung zu Aufgabe 11.3
Hinweis: für arcCos muss die unit math eingebunden werden.
Ganz oben im Programm findest Du die uses-Klausel. Ergänze math zu den den veschieden Units.
uses math, Windows, ... (Suche in der ca 3. Zeile Deines Programms!)
...
Procedure dreieck(a,b,c: real; var al, be, ga: real);
var x: real; //für cos(al)
begin
x := (b*b + c*c - a*a)/(2*b*c); //cos al
al := ArcCos(x)*180/Pi; //Gradmass
x := (a*a + c*c - b*b)/(2*a*c); //cos be
be := ArcCos(x)*180/Pi; //Gradmass
x := (a*a + b*b - c*c)/(2*a*b); //cos al
ga := ArcCos(x)*180/Pi; //Gradmass
end;
procedure TForm1.Button1Click(Sender: TObject);
var a,b,c, alpha, beta, gamma: real;
begin
a := StrToFloat(edit1.text);
b := StrToFloat(edit2.text);
c := StrToFloat(edit3.text);
Dreieck(a, b, c, alpha, beta, gamma);
memo1.lines.Clear;
memo1.Lines.add('Alpha = ' + FloatToStr(alpha));
memo1.Lines.add('Beta = ' + FloatToStr(beta));
memo1.Lines.add('gamma = ' + FloatToStr(gamma));
end;
Elegantere Lösung von Björn:
function dreieck(a,b,c: real): real;
var x: real; //für cos ...
begin
x := (b*b + c*c - a*a)/(2*b*c); //cos al
result := ArcCos(x)*180/Pi; //Gradmass
end;
procedure TForm1.Button1Click(Sender: TObject);
var a,b,c, alpha, beta, gamma: real;
begin
a := StrToFloat(edit1.text);
b := StrToFloat(edit2.text);
c := StrToFloat(edit3.text);
alpha := Dreieck(a, b, c); //Achtung: alpha liegt der Seite a (1. Parameter) gegenüber
beta := Dreieck(b, a, c); //Analog beta liegt der Seite b gegenüber
gamma := Dreieck(c, b, a); //Analog gamma liegt der Seite c gegenüber
memo1.lines.Clear;
memo1.Lines.add('Alpha = ' + FloatToStr(alpha));
memo1.Lines.add('Beta = ' + FloatToStr(beta));
memo1.Lines.add('gamma = ' + FloatToStr(gamma));
end;
Lösung zu Aufgabe 11.4
procedure LGS2(a, b, c, d, e, f: real; var lsg: boolean; var x, y: real);
{Die Gleichungen ax + cy = e
bx + dy = f
haben die Lösung x = (ed - cf)/det y = (af - be)/det für det = ad - bc}
var det:real;
begin
det := a*d - b*c;
if det = 0 then lsg := false else Begin
lsg := true;
x := (e*d - c*f)/det;
y := (a*f - b*e)/det;
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
var a, b, c, d, e, f, x1, x2:real;
lsg: boolean;
begin
a := 5; c := -7; e := 9;
b := -3; d := 2; f := 4;
//Die primitivste Form die Aufgabe zu lösen
LGS2(a, b, c, d, e, f, lsg, x1, x2);
if lsg then
showmessage('Die Lösung ist'#13+
'x1 = ' + formatfloat('0.######',x1) + #13+
'x2 = ' + formatfloat('0.######',x2))
else showmessage('Keine eindeutige Lösung');
end;
Lösung zu Aufgabe 12.1:Heronverfahren:
Anfangswert: x0 = 1
Iteration: x = 1/2(xn + a/xn)
n+1
Abbruchbedingung: xn·xn = a (Nicht korrekt, da Computer nicht exakt rechnen)
|xn·xn - a| < 10^(-12)
("Daumenregel" 3 Dezimalen weniger als Rechengenauigkeit)
procedure TForm1.Button1Click(Sender: TObject);
var a,x: real;
begin
a := 2;
x := 1;
repeat
x := 1/2*(x + a/x);
memo1.Lines.add(FloatToStr(x));
until abs(x*x - a) < 1E-15
end;
Lösung zu Aufgabe 12.1
Lösung zu Aufgabe 12.31 0 1 1 1 2 1 3 1 4 1 5 a) f(2,5)= -·2 + ——·2 + ——·2 + ——·2 + ——·2 + ——·2 (genügt!) 0! 1! 2! 3! 4! 5! 1 1 1 1 = 1 + 1·2 + -·4 + -·8 + ——·16 + ———·32 = 7,266 2 6 24 120 Bemerkung: x 1 0 1 1 1 2 1 3 1 4 1 5 e = -·x + ——·x + ——·x + ——·x + ——·x + ——·x + ... (ad infinitum) 0! 1! 2! 3! 4! 5! f(x,n) nähert also die Exponentialfunktion an: Für genügend großes 1 n n ist —— so klein gegenüber x , dass man abbrechen kann. n! 2 Vergleiche e = 7,389 mit f(2,5) = 7,266 (siehe oben) b) f(-5) =0 (Die Schleife wird nicht durchlaufen)
Lösung zu Aufgabe 12.45 4 3 2 1 15 a) f(5) = (——)·(——)·(——)·(——)·(——)·(-1) = —— 2 2 2 2 2 4 b) Die Funktion ruft sich ohne Terminierung pausenlos selbst auf. Ein fataler Fehler!
Lösung zu Aufgabe 12.52 5 3 5 7 7 4 5 83 a) f(0) = 1, f(1) = 1, f(2) = 1 + - = -, f(3) = -·- + 1 = -; f(4) = 2·- + -·- = —— 3 3 2 3 2 2 3 3 9 b) f(-5) = 1, da für n = - 5 die Bedingung n <= 1 erfüllt ist
**********
********
******
****
**
Lösung zu Aufgabe 12.6
function f(x:real):real; //Zum Beispiel
begin
result :=x*x*x - 7/3*x - 20/27
end;
function fs(x:real):real; //fs = f'
begin
result := 3*x*x - 7/3
end;
function newton(x0:real):real;
var y0: real;
n: integer; //Bremse
begin
n := 0;
y0 := f(x0);
repeat
x0 := x0 - y0/fs(x0); //fs = f'
y0 := f(x0);
n := n + 1;
//{Alternative statt "or (n > 25)"} if n > 25 then Begin
//showmessage('Abbruch Newtonverfahren'); exit End;
until (abs(y0) < 1E-9) or (n > 25);
if n > 25 then showmessage('Newtonverfahren funktioniert nicht!');
result := x0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage('Eine von drei NS ist:' + floatToStr(newton(0)));
end;
Lösung zu Aufgabe 12.7
function f(x: real):real; //oder auch eine langwierige Berechnung
//zum Beispiel Näherung von f(x) =x - x^2/2 + x^3/3 - x^4/4 +/- ...
begin
result := x*x - 2;
end;
function intervallh(x1, x2: real):real;
var m:real;
begin
m := (x1 + x2)/2;
while abs(f(m)) >= 1E-15 do Begin
m := (x1 + x2)/2;
if f(x1)*f(m) < 0 then x2 := m else x1 := m;
End;
result := (x1 + x2)/2;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x1, x2:real;
begin
x1 := strTofloat(edit1.text);
x2 := strTofloat(edit2.text);
if f(x1)*f(x2) >= 0 then showmessage('Kein VZW') else
showmessage(floatToStr(intervallh(x1,x2)));
end;
Zusatz: Ersetze "intervalh" durch
function intervallhalbierung(var x1, x2: real);
var m, y1, ym:real;
begin
y1 := f(x1);
repeat
m := (x1 + x2)/2;
ym := f(m);
if y1*ym > 0 then Begin
x1 := m; //Neuer Wert für f(x1) ist alter Wert f(m)
y1 := ym; //d.h. y1 schon berechnet!
End else x2 := m;
until abs(x2 - x1) > 1E-15
end;
Lösung zu Aufgabe 12.8 Berechnung der 3. Wurzel nach dem Intervallhalbierungsverfahren.
function dritteWurzel(a: real): real;
function f(x: real): real;
begin
result := x*x*x - a;
end;
var x1,x2,xm: real;
begin
//Einfädeln
x2 := 0;
repeat
x2 := x2 + 1
until f(x2) >= 0;
if abs(f(x2)) < 1E-15 then Begin
result := x2;
exit;
End; //Ergebnis ganzzahlig
x1 := x2 - 1; //Jetzt f(x1) < 0 und f(x2) > 0
//Intervallhalbierungsverfahren
repeat
xm := 1/2*(x1 + x2);
if f(x1)*f(xm) < 0 then x2 := xm else x1 := xm
until abs(x1 - x2) < 1E-12;
result := (x1 + x2)/2
end;
Lösung zu Aufgabe 12.9Berechnung der 4. Wurzel nach dem Newtonverfahren.
function vierteWurzel(a: real): real;
function f(x: real): real;
begin
result := x*x;
result := result*result - a; //= x^4 - a
end;
function fs(x: real): real;
begin
result := 4*x*x*x;
end;
var y0, y1, yalt: real;
begin
y0 := 1;
repeat
y1 := y0 - f(y0)/fs(y0);
yalt := y0; //Zum Vergleichen
y0 := y1; //zum Weiterrechnen
until abs(y1 - yalt) < 1E-12;
result := y1;
end;
Lösung zu Aufgabe 13.1:
function wort_n(const s:string; const n:integer): string;
var p:integer;
begin
p := pos(' ',s);
if p = 0 then Begin
if n > 1 then result :='' else result := trim(s);
End else Begin //p > 0
if n = 1 then result := trim(copy(s,1,p-1)) else
result := wort_n(trim(copyab(s,p+1)),n-1);
End;
end;
Bemerkung: trimright, trimleft bzw. trim entfernt Leerstellen
am Anfang, am Ende bzw. am Anfang und am Ende eines Strings.
Lösung zu Aufgabe 14.1: Die 20 Namen in Memo1 werden geordnet in Memo2 gezeigt.
const anzahl = 20;
var
Form1: TForm1;
var aa: array[1..20] of string;
implementation
{$R *.DFM}
procedure tausche(var a,b: string);
var x: string;
begin
x := a;
a := b;
b := x;
end;
procedure bubblesort(n1,n2:integer); //sortiert von n1 bis n2
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=n1 to n2-1 do Begin
if aa[i] > aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
var k: integer;
begin
for k := 1 to Anzahl do aa[k] := memo1.Lines[k-1];
//Achtung: Memo1.lines zählt ab Null, und dann nur bis Anzahl - 1
bubblesort(1,Anzahl);
memo2.Lines.Clear;
for k := 1 to anzahl do memo2.lines.Add(aa[k]);
end;
Lösung zu Aufgabe 14.1 b:
Sechs Lottozahlen sollen geordnet ausgegeben werden.
type Tintergerarray = array[1..6] of integer; // Eigene Type-Deklarationen vor ...
var //... diese beiden Zeilen, die Delphi ...
Form1: TForm1; //... schreibt, einfügen
...
function mindestensDreiZeichen(s: string): string;
begin
result := s;
while length(result) < 3 do result := ' ' + result;
end;
function zeile(a: Tintergerarray): string; //schreibt die 6 Lottozahlen in eine Zeile
var i: integer;
begin
result := '';
for i := low(a) to High(a) do //low, high = kleinster, größter Wert des Arrays
result := result + mindestensDreiZeichen(intToStr(a[i]));
end;
procedure tausche(var a,b: integer);
var x: integer;
begin
x := a;
a := b;
b := x;
end;
procedure bubblesort(var a: Tintergerarray); //Array wird als Parameter übergeben
//sortiert den array
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=low(a) to high(a) - 1 do Begin
if a[i] > a[i+1] then BEgin
tausche(a[i],a[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
var lotto: Tintergerarray;
i,j: integer;
neu: boolean;
s: string;
begin
memo1.Font.Name := 'Courier New'; //gleiche Abstände
memo1.WordWrap := false;
for i := 1 to 6 do Begin
repeat
neu := true;
lotto[i] := 1 + random(49);
for j := 1 to i - 1 do
if lotto[i] = lotto[j] then neu := false;
until neu;
End;
s := zeile(lotto);
bubblesort(lotto);
s := s + ' geordnet: ' + zeile(lotto);
memo1.Lines.Add(s);
end;
Lösungen zu Block 1
Lösungen zu Aufgabe 14.u1:1. a) 4 b) 0 c) 9 d) 4 e) 3 f) -3Lösungen zu Aufgabe 14.u2:
2 3 10 100
a) 3 b) 2 c) 5 d) 0.75
Lösungen zu Aufgabe 14.u3:
1 1 1 1 1
a) - b) ——— c) ——————— d) ————————————— = —————
2 2*3 2*3*4*5 2*3*4*...*100 100!
Lösungen zu Aufgabe 14.u4:
procedure kegel(r,h: real; //Eingansvariablen
var O,V: real); //Ausgangsvariablen
var s: real;
begin
s := sqrt(sqr(h) + sqr(r)); //sqr=quadrat sqrt=quadratwurzel
O := Pi*r*(s+r);
V := 1/3*Pi*sqr(r)*h;
end;
procedure TForm1.Button1Click(Sender: TObject);
var radius, hoehe, oberflaeche, volumen: real;
begin
radius := 5; //besser aus edit1 auslesen
hoehe := 10; //besser aus edit2 auslesen
kegel(radius, hoehe, oberflaeche, volumen);
//hier möglich kegel(5,10,oberflaeche,volumen);
showmessage('Oberfläche = ' + floattostr(oberflaeche));
showmessage('Volumen = ' + floattostr(volumen));
end;
Lösungen zu Aufgabe 14.u5:
//Teil a)
procedure fuelle;
var i: integer;
begin
randomize;
for i := 1 to 50 do
aa[i] := 50 + random(100) + random;
//ergibt Werte zwischen 50 und 150,
end;
//Zu Teil b)
procedure tausche(var a,b: real);
var x: real;
begin
x := a;
a := b;
b := x;
end;
//Zu Teil b)
procedure bubblesort(n1,n2:integer); //ordnet aa fallend
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=n1 to n2-1 do Begin
if aa[i] < aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
//In der Aufgabe nicht verlangtes Testprogramm
procedure zeigeIn(m: Tmemo);
var i: integer;
begin
m.Lines.Clear;
for i := 1 to 50 do m.Lines.add(FloatToStr(aa[i]));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
fuelle;
zeigeIn(memo1);
bubblesort(1,50);
zeigeIn(memo2);
end;
Lösungen zu Block 2
Lösungen zu Aufgabe 14.uu1:
a) Ronald erhält 1 Notenpunkt(e)
Gerhard erhält 5 Notenpunkte
Joschka erhält 14 Notenpunkte
b)
function oberstufeneu(p,m:real): integer;
var n: real;
begin
p := p * 60 / m;
//Gute Schüler werden noch besser
if p > 56 then n := 15 else
if p > 55 then n := 14 else
//Hauptformel
if p > 23 then n := (p - 12) / 3 else
//Nicht so gute Schüler werden noch schlechter
if p > 22 then n := 4 else
if p > 18 then n := 3 else
if p > 14 then n := 2 else
if p > 10 then n := 1 else
n := 0;
result := trunc(n + 1 / 4096); //trunc rundet ab. z.B. trunc(4.99)=4
end;
procedure TForm1.Button1Click(Sender: TObject);
var max: real;
begin
max := 30; //Maximale Punktezahl der Klassenarbeit
showmessage('Ronald erhält ' + inttostr(oberstufeneu(7,max)) + ' Notenpunkte');
showmessage('Gerhard erhält ' + inttostr(oberstufeneu(14,max)) + ' Notenpunkte');
showmessage('Joschka erhält ' + inttostr(oberstufeneu(27,max)) + ' Notenpunkte');
end;
Lösungen zu Aufgabe 14.uu2:
a) f(2) = 1+1/4 (Rechnausdruck genügt)
f(4) = 1 + 1/4 + 1/9 + 1/16
f(4) = 1 + 1/4 + 1/9 + 1/16 + ... + 1/10000
f(0) = 0 (Schleife wird nicht durchlaufen)
f(-2) = 0 (Schleife wird nicht durchlaufen)
b)
function f(n: integer): real;
var k,a: integer;
begin
result := 1;
for k := 1 to n do Begin
a := k*k;
result := result * a;
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage('f(2) = ' +floattoStr(f(2)) + #13+ //#13 "Neue Zeile!"
'f(4) = ' +floattoStr(f(4)) + #13+
//'f(100) = ' +floattoStr(f(100)) + #13+ ergibt Gleitkommaüberlauf
'f(0) = ' +floattoStr(f(0)) + #13+
'f(-2) = ' +floattoStr(f(-2)));
end;
Lösungen zu Aufgabe 14.uu3:
procedure QuadrGl(a,b,c: real; var n: Integer; var x1,x2: real);
var d: real;
begin
d := b*b - 4*a*c;
if d < 0 then n := 0 else
if d = 0 then Begin
n := 1;
x1 := -b/(2*a);
End else Begin
n := 2;
x1 := (-b + sqrt(d))/(2*a);
x2 := (-b - sqrt(d))/(2*a)
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
var anz: integer;
x1,x2: real;
begin
QuadrGl(1,5,6,anz,x1,x2);
if anz = 0 then showmessage('Keine Lösung') else
if anz = 1 then showmessage('Eine Lösung: x ='+floatToStr(x1))
else showmessage('Lösungen: x1=' + FloatToStr(x1) + ' x2=' + FloatToStr(x2));
end;
Lösungen zu Aufgabe 14.uu4:
a)
function f(n: integer): real;
var k: integer;
begin
result := 0;
for k := 1 to n do
result := result + 1/k
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(floattostr(f(4))); //zum Beispiel
end;
b)
function f(n: integer): real;
var k: integer;
begin
result := 1;
for k := 1 to n do
result := result * (2*k-1)/(2*k)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(floattostr(f(4)));
end;
Lösungen zu Aufgabe 14.uu5:
a) n willkürliche aus 3 Buchstaben bestehende "Namen" werden
in Memo1 geschrieben
b)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
procedure fuelleMemo(n:integer);
public
{ Public-Deklarationen }
end;
const Anzahl = 100;
var
Form1: TForm1;
aa: array[1..Anzahl] of string;
implementation
{$R *.DFM}
procedure TForm1.fuelleMemo(n:integer);
begin
memo1.lines.Clear;
while memo1.Lines.Count <= n do
memo1.lines.add(chr(65+random(25)) + chr(65+random(25)) + chr(65+random(25)));
end;
procedure tausche(var a,b: string);
var x: string;
begin
x := a;
a := b;
b := x;
end;
procedure bubblesort(n1,n2:integer);
//sortiert den globalen array aa von n1 bis n2
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=n1 to n2-1 do Begin
if aa[i] > aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
var k: integer;
begin
fuellememo(Anzahl);
for k := 0 to Anzahl - 1 do aa[k+1] := memo1.lines[k];
bubblesort(1,Anzahl);
memo2.Lines.Clear;
for k := 1 to Anzahl do
memo2.Lines.Add(aa[k]);
end;
end.
Lösungen zu Block 3
Lösung zu Aufgabe 14.z1:a) f(10) = 1/2 - 1/3 + 1/4 - 1/5 + 1/6 - 1/7 + 1/8 - 1/9 + 1/10
b) f(-1) = 0
c)
function f(n: integer): real;
begin
//showmessage(intToStr(n));
if n <=1 then result := 0 else
if n mod 2 = 0 then result := f(n-1) + 1/n
else result := f(n-1) - 1/n
end;
procedure TForm1.Button1Click(Sender: TObject);
var k: integer;
begin
for k := 1 to 10 do
memo1.lines.Add(IntToStr(k) + ' ' + floatToStr(f(k)))
end;
d) Das Meldungsfenster zeigt "10, 9, 8, 7, 6, 5, 4, 3 ,2 ,1". Es
erscheint also 10 mal. Lösung zu Aufgabe 14.z2:
a) f(1) = 2;
f(2) = f(1)*f(1) = 2^2
f(3) = f(2)*f(2) = 2^4
f(4) = f(3)*f(3) = 2^8
...
f(10) = 2^512 = 1,34*10^154
Allgemein ist f(n) = 2^(2^(n-1))
b) Bei f(-1) gibt es einen Stacküberlauf, die Berechnung ist nicht terminiert. (Fataler Laufzeitfehler.)
c) Bei f(3) wird nacheinander im Meldungsfenster gezeigt:
"3, 2, 1, 1, 2, 1 ,1". Es erscheint also 7 Mal das Meldungsfenster, allein vier Mal die "1" .
Bei f(4), f(5), f(6), ..., f(10) erscheint die "1" 8 Mal, 16 Mal, 32 Mal, ..., 512 mal (genügt als Angabe der Größenordnung. Genau erscheint bei f(10) das Meldungsfenster 512+256+...+1=1023 Mal).
Bemerkung: Die Effizienz ist O(2^n).
d) Die Effizienz der folgenden Funktion ist O(n):
function f(n: integer): real;
var y: real;
begin
if n=1 then result := 2 else Begin
y := f(n-1); //f wird nur einmal rekursiv aufgerufen
result := y*y //Eleganter (Christian A.) result := sqr(f(n-1))
End;
end;
Lösung zu Aufgabe 14.z3:
procedure tausche(var a,b: string);
var x: string;
begin
x := a;
a := b;
b := x;
end;
procedure TForm1.Button1Click(Sender: TObject);
const n = 100;
h = 25;
b = 50;
var ee: array[0..n-1] of Tedit; //oder dynamisch: ee: array of Tedit
k, rand: integer;
p, q: string;
begin
randomize;
//setlength(ee,n); //falls Deklaration "ee: array of Tedit"
for k := 0 to n - 1 do Begin
ee[k] := Tedit.Create(Form1);
//Bei Freigabe von Form1 werden auch die Editfelder freigegeben.
ee[k].Parent := Form1;
ee[k].Height := h;
ee[k].Width := b;
ee[k].Top := h*(k div 10);
ee[k].left := b*(k mod 10);
ee[k].Text := intToStr(k+1);
End;
button1.hide; {Beim 2 Klick würden die ersten 100 Editfelder
nie mehr freigegeben. Schwerer Programmierfehler!}
showmessage('Das war Aufgabe 14.z3');
for k := 0 to n - 1 do Begin
rand := random(n);
p := ee[k].text;
q := ee[rand].text;
tausche(p,q);
ee[k].text := p;
ee[rand].text := q;
End;
showmessage('Das war der der Zusatz');
end;
Lösung zu Aufgabe 14.z4:
procedure tausche(var a,b: integer);
var x: integer;
begin
x := a;
a := b;
b := x;
end;
procedure bubblesort(var aa: array of integer); //das größte zuerst
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=0 to length(aa) - 2 do Begin
if aa[i] < aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
const n = 100;
var aa: array[0..n-1] of integer;//oder dynamisch:aa: array of integer
begin
randomize;
//setlength(aa,n); //falls Deklaration "aa: array of integer"
for k :=0 to n - 1 do aa[k] := random(100) + 1;
bubblesort(aa);
for k := 0 to n - 1 do showmessage(intToStr(aa[k]));
end;
Lösung zu Aufgabe 14.z5:
//Das folgende aus Aufgabe 14.z4 wird benötigt
procedure tausche(var a,b: integer);
var x: integer;
begin
x := a;
a := b;
b := x;
end;
procedure bubblesort(var aa: array of integer); //das größte zuerst
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=0 to length(aa) - 2 do Begin
if aa[i] < aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
const n = 100;
h = 25;
b = 50;
var ee: array[0..n-1] of Tedit;
aa: array[0..n-1] of integer;
k, rand: integer;
function ZahlNochNichterfasst(r, j:integer): boolean;
var i:integer;
begin
result := false;
for i := 0 to j do if strToInt(ee[i].text) = r then exit;
result := true; //r ist neu
end;
begin
//Das folgende darf als gegeben vorausgesetzt sein
randomize;
for k := 0 to n - 1 do Begin
ee[k] := Tedit.Create(Form1);
ee[k].Parent := Form1;
ee[k].Height := h;
ee[k].Width := b;
ee[k].Top := h*(k div 10);
ee[k].left := b*(k mod 10);
repeat
rand := random(1000) + 1;
until ZahlNochNichterfasst(rand,k-1);
ee[k].Text := intToStr(rand);
End;
button1.hide; //Nur einmal erzeugen.
//——————————— Nur dieser Teil war zu schreiben ———————————————
showmessage('1. Version: Die ersten 10 Preisträger!');
for k := 0 to n - 1 do aa[k] := StrToInt(ee[k].text);
bubblesort(aa);
//in aa[0] und aa[9] stehen nun die größten Werte
for k := 0 to n - 1 do
if StrToInt(ee[k].text) >= aa[9] then ee[k].color := clred;
{Idee von Joahannes K. ohne bubblesort: Ergänze var wert, zaehl: integer;
showmessage('2. Version: Die ersten 10 Preisträger!');
for zaehl := 1 to 10 do Begin
wert := 0;
for k := 0 to n - 1 do
if (StrToInt(ee[k].text) >= wert) and (ee[k].color <> clred) then
wert := StrToInt(ee[k].text); //der höchste nicht rote Wert
for k := 0 to n - 1 do
if StrToInt(ee[k].text) >= wert then ee[k].color := clred;}
End;
//Falls gleiche Werte erlaubt sind, müßte man noch diese zählen
end;
Lösung zu Aufgabe 14.2: Ein dynamisches Array wird mit Zahlen gefüllt, die Werte des Arrays in ein Memo geschrieben, dann durcheinandergewirbelt (permutiert) und in ein zweites Memo geschrieben. Schließlich geordnet und in ein drittes Memo geschrieben.
type TIntegerArray = array of Integer; // Eigene Type-Deklarationen vor ...
var //... diese beiden Zeilen, die Delphi ...
Form1: TForm1; //... schreibt, einfügen ...
procedure tausche(var a,b: integer);
var x: integer;
begin
x := a;
a := b;
b := x;
end;
procedure permutiere(var aa: TIntegerArray);
var i:integer;
begin
for i := 0 to length(aa) - 1 do
tausche(aa[i], aa[random(length(aa))]);
end;
procedure bubblesort(var aa: TIntegerArray);
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=0 to length(aa) - 2 do Begin
if aa[i] > aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
const Anzahl = 100;
var k: integer;
aa: TIntegerArray;
begin
setlength(aa,Anzahl); //aa[0] bis aa[Anzahl - 1]
for k := 0 to length(aa) - 1 do aa[k] := k;
memo1.Lines.Clear;
for k := 0 to length(aa) - 1 do memo1.lines.Add(intTostr(aa[k]));
permutiere(aa);
memo2.Lines.Clear;
for k := 0 to length(aa) - 1 do memo2.lines.Add(intTostr(aa[k]));
bubblesort(aa);
memo3.Lines.Clear;
for k := 0 to length(aa) - 1 do memo3.lines.Add(intTostr(aa[k]));
end;
Lösung zu Aufgabe 14.3:
Sieb des Eratosthenes.
procedure TForm1.Button1Click(Sender: TObject);
const n=100;
var aa: array of boolean;
k, j: integer;
s: string;
begin
setlength(aa,n+1);
//Anfangswerte
for k := 1 to n do aa[k] := true;
//Die Nicht-Primzahlen "streichen"
for k := 2 to round(sqrt(n)) do if aa[k] then //Primzahl
for j := 2 to n div k do aa[k*j] := false; //Maximal j*(n div j) = n
//Das wars. Jetzt bleibt noch die Ausgabe.
s := '';
memo1.lines.clear;
for k := 2 to n do Begin
if aa[k] then s := s + intToStr(k) + ' ';
if length(s) > 60 then BEgin
memo1.lines.Add(s);
s := '';
ENd;
End;
memo1.lines.Add(s);
end;
Lösungen zu Aufgabe 14.4:
...
var
Form1: TForm1;
daten: array of string; //Global
anzahl: integer;
implementation
{$R *.DFM}
procedure tausche(var a,b:string);
var x:string;
begin
x:=a;
a:=b;
b:=x;
end;
procedure bubblesort(var aa:array of string; n1,n2:integer);
//sortiert von n1 bis n2
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=n1 to n2-1 do Begin
if aa[i] > aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
function copyab(const s:string; const i:integer):string; //Rest von s ab i. em Zeichen
begin result:=copy(s,i,length(s)-i+1) end;
procedure bubblesortVorname(var aa:array of string; n1,n2:integer);
//sortiert von n1 bis n2
const posVorn = 15;
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=n1 to n2-1 do Begin
if copyab(aa[i],15) > copyab(aa[i+1],15) then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure TForm1.Button1Click(Sender: TObject);
var pfad: String;
k: integer;
begin
if opendialog1.Execute then
pfad := opendialog1.FileName;
memo1.Lines.LoadFromFile(pfad);
// Gegestück mit savedialog1: memo1.Lines.SaveToFile(pfad);
Anzahl := memo1.lines.Count - 1;
setlength(daten,Anzahl);
for k := 0 to Anzahl-1 do
daten[k] := memo1.lines[k];
end;
procedure TForm1.Button2Click(Sender: TObject);
var k:integer;
begin
bubblesort(daten,0,Anzahl-1);
memo2.Lines.clear;
for k := 0 to Anzahl-1 do
memo2.Lines.Add(daten[k]);
end;
procedure TForm1.Button3Click(Sender: TObject);
var k:integer;
begin
bubblesortVorname(daten,0,Anzahl-1);
memo2.Lines.clear;
for k := 0 to Anzahl-1 do
memo2.Lines.Add(daten[k]);
end;
end.
Lösung zu Aufgabe 14.5:Sortieren durch
geordnetes mischen von vier Stapeln.
procedure tausche(var a,b:real);
var x:real;
begin
x:=a;
a:=b;
b:=x;
end;
//Noch muss ein Teil sortiert werden. Primitv mit Bubblesort
procedure bubblesort(var aa:array of real; n1,n2:integer); //sortiert von n1 bis n2
var i:integer;
fertig: Boolean;
begin
repeat
fertig:=true;
for i:=n1 to n2-1 do Begin
if aa[i] > aa[i+1] then BEgin
tausche(aa[i],aa[i+1]);
fertig:=false;
ENd;
End;
until fertig;
end;
procedure Einsortieren(var aa:array of real; n1,m,n2:integer);
//aa[n1] <= aa[n1+1] <= ..<=aa[m] aa[m+1]<=aa[m+2]<=...<=aa[n2]
// i1——————————————————> i2——————————————————————>
// k—————————— füllt Hilfsfeld———————————————————————>
var i1,i2,k,n:integer;
hilf: array of real;
begin
n:=n2-n1+1; //Anzahl von aa[n1] ... aa[n2]
setlength(hilf,n); //Platz für hilf[0] ... hilf[n-1]
i1:=n1;
i2:=m+1;
for k:=0 to n-1 do //i1 > m und i2 > n2 auch abfangen!
if (i1 > m) or ((i2 <= n2) and (aa[i1] > aa[i2])) then Begin
hilf[k]:=aa[i2];
inc(i2);
End else Begin
hilf[k]:=aa[i1];
inc(i1);
End;
for k:=0 to n-1 do aa[n1+k]:=hilf[k];
end;
procedure zeige(mm:Tmemo; aa:array of real);
var i:integer;
begin
mm.Lines.Clear;
for i:=0 to length(aa)-1 do mm.Lines.Add(FloatToStr(aa[i]));
end;
procedure sortieren(var aa:array of real);
var n,m:integer;
begin
n:=length(aa); //Bsp.: n=16
m:=n div 4; // m=4
bubblesort(aa,0,m-1); // 0 bis 3
bubblesort(aa,m,2*m-1); // 4 bis 7
bubblesort(aa,2*m,3*m-1);// 8 bis 11
bubblesort(aa,3*m,n-1); // 12 bis5
//Zu Testzwecken
zeige(form1.memo2,aa);
Einsortieren(aa,0,m-1,2*m-1); //0..3 und 4..7
Einsortieren(aa,2*m,3*m-1,n-1); //8..11 und 12..15
Einsortieren(aa,0,2*m-1,n-1); //0..7 und 8..15
end;
procedure TForm1.BFuellenClick(Sender: TObject);
var i,anzahl:integer;
aa:array of real;
begin
anzahl:=strToInt(EAnzahl.text);
setlength(aa,anzahl);
for i:=0 to Anzahl-1 do aa[i]:=i+1;
//Durcheinanderwirbeln
randomize;
for i:=0 to Anzahl-1 do tausche(aa[i],aa[random(Anzahl)]);
zeige(memo1,aa);
end;
procedure TForm1.BOrdnenClick(Sender: TObject);
var aa:array of real;
n,i:integer;
begin
n:=strToInt(EAnzahl.text);
setlength(aa,n); //n Plätze für aa[0] bis aa[n-1] reserviert
for i:=0 to n-1 do aa[i]:=StrToFloat(memo1.lines[i]);
sortieren(aa);
zeige(memo3,aa);
end;
Lösung zu Aufgabe 14.6:Sortieren durch
Mischen.
procedure Einsortieren(var aa:array of real; n1,m,n2:integer);
//aa[n1] <= aa[n1+1] <= .. <= aa[m] aa[m+1] <= aa[m+2] <= ... <= aa[n2]
// i1——————————————————> i2——————————————————————>
// k—————————— füllt Hilfsfeld———————————————————————>
var i1,i2,k,n:integer;
hilf: array of real;
begin
n:=n2-n1+1; //Anzahl von aa[n1] ... aa[n2]
setlength(hilf,n); //Platz für hilf[0] ... hilf[n-1]
i1:=n1;
i2:=m+1;
for k:=0 to n-1 do //i1 > m und i2 > n2 auch abfangen!
if (i1 > m) or ((i2 <= n2) and (aa[i1] > aa[i2])) then Begin
hilf[k]:=aa[i2];
inc(i2);
End else Begin
hilf[k]:=aa[i1];
inc(i1);
End;
for k:=0 to n-1 do aa[n1+k]:=hilf[k];
end;
procedure zeige(mm:Tmemo; aa:array of real);
var i:integer;
begin
mm.Lines.Clear;
for i:=0 to length(aa)-1 do mm.Lines.Add(FloatToStr(aa[i]));
end;
procedure sortieren(var aa:array of real;n1,n2:integer);
var m:integer;
begin
if n1=n2 then exit; //Bei einem Element ist nichts zu sortieren
m:=(n1+n2) div 2; //Mitte
sortieren(aa,n1,m); //Rekursiv
sortieren(aa,m+1,n2); //Rekursiv
Einsortieren(aa,n1,m,n2);
end;
procedure TForm1.BFuellenClick(Sender: TObject);
var i,anzahl:integer;
aa:array of real;
procedure tausche(var a,b:real); //hier lokale Prozedur
var x:real;
begin
x:=a;
a:=b;
b:=x;
end;
begin
anzahl:=strToInt(EAnzahl.text);
setlength(aa,anzahl);
for i:=0 to Anzahl-1 do aa[i]:=i+1;
//Durcheinanderwirbeln
randomize;
for i:=0 to Anzahl-1 do tausche(aa[i],aa[random(Anzahl)]);
zeige(memo1,aa);
end;
procedure TForm1.BOrdnenClick(Sender: TObject);
var aa:array of real;
n,i:integer;
begin
n:=strToInt(EAnzahl.text);
setlength(aa,n); //n Plätze für aa[0] bis aa[n-1] reserviert
for i:=0 to n-1 do aa[i]:=StrToFloat(memo1.lines[i]);
sortieren(aa,0,length(aa)-1);
zeige(memo3,aa);
end;
Lösung zu Aufgabe 15.1
k k k k k
S(n,k) = 1 + 2 + 3 + 4 + ... + n
0 1 2 2 k+1
= a·n + a ·n + a ·n + a ·n + ... + a ·n (k+2 Unbekannte)
0 1 2 3 k+1
function hoch(x: real; n:integer): real; //n=0, 1, 2, ...
begin
if n = 0 then result := 1 else
result := x*hoch(x,n - 1)
end;
function s(n,k:integer): extended; //=1^k + 2^k + 3^k + ... + n^k
var i:integer;
begin
result := 0;
for i := 1 to n do result := result + hoch(i,k);
end;
function mitBruchgerechnet(x: extended): extended;
begin
result := TermToReal(reellZuBruch(x,g_eps));
end;
procedure probe(k: integer; a: array of extended);
var n,j: integer;
erg1,erg2,erg3: string;
su: extended;
begin
with form1.memo1.lines do Begin
add('Probe');
for n := 0 to k + 5 do BEgin
erg1 := floatToStr(S(n,k)); //s := 1^k + 2^k + ... + n^k
su := 0;
for j := 0 to k + 1 do
su := su + a[j]*hoch(n,j); //s := a0 + a1*n + ... + a(k+1)*n^(k+1)
erg2 := floatToStr(su);
su := 0;
for j := 0 to k + 1 do
su := su + mitBruchgerechnet(a[j])*hoch(n,j); //s := a0 + a1*n + ... + a(k+1)*n^(k+1)
erg3 := floatToStr(su);
add(intToStr(n) + ' ' + erg1 + ' ?=? ' + erg2 + ' ?=? ' + erg3);
ENd;
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
var k, i, j: integer;
koeff: TarrayOfArrayOfExtended;
a: array of extended;
erg, ai, nhochi :string;
begin
k := StrToInt(edit1.text);//gesucht Formel für S(n,k)
setlength(a, k+2); //s(n,k) = a0 + a1*n ... a(k+1)*n^(k+1) (a0=0)
setlength(koeff, length(a) + 1,length(a) + 2);
for i := 0 to length(a) do Begin
for j := 0 to length(a) - 1 do koeff[i,j] := hoch(i,j);
koeff[i,length(a)] := s(i,length(a)-2)//rechte Seite
End;
ArrayInMemo(length(a),Koeff,memo1);
LSG(length(a),koeff,a);
erg := '';
for i := k+1 downto 0 do Begin
if i=1 then nhochi := 'n' else nhochi := 'n^' + intToStr(i);
if a[i] = 1 then ai := ' ' else if a[i] = -1 then ai := '- '
else BEgin
if k > 15 then
ai := ' ' + FloatToStr(a[i]) else
ai := ' ' + ReellZuBruch(a[i],g_eps);
ENd;
if abs(a[i]) > 1E-8 then BEgin
if (a[i] < 0) or (i = k+1) then erg := erg + ' ' + ai + nhochi else
erg := erg + '+' + ai + nhochi;
ENd;
End;
memo1.Lines.Add(erg);
probe(k,a);
end;
Hinweis: Downloadseite "Summenf".
Mit diesem Programm lassen sich alle Formeln berechnen, z.B.
S(n,k)=1k + 2k + ... nk mit den Lösungen:
Summenformeln für Potenzsummen
Siehe dazu auch: Vollständige Induktion und Errechnung der Summenformel mit Hilfe eines LGS sowie nach der Faulhaberformel.
1
1 + 2 + 3 + 4 + 5 + ... n = -n·(n+1)
2
2 2 2 2 2 2 1 1
1 + 2 + 3 + 4 + 5 + ... n = -n·(n + -)·(n + 1)
3 2
3 3 3 3 3 3 1
1 + 2 + 3 + 4 + 5 + ... n = -n·n·(n+1)·(n+1)
4
Diese ersten drei Summen kann man sich in dieser Form leicht merken.Die weiteren werden so wiedergegeben, wie sie das Programm liefert :
1^1 + 2^1 + 3^1 ... + n^1 = 1/2*(n+1)*n
1^2 + 2^2 + 3^2 ... + n^2 = 1/3*(n+1)*(n+1/2)*n
1^3 + 2^3 + 3^3 ... + n^3 = 1/4*(n+1)*(n+1)*n*n
1^4 + 2^4 + 3^4 ... + n^4 = (1/5*n^2 + 1/5*n - 1/15)*(n+1)*(n+1/2)*n
1^5 + 2^5 + 3^5 ... + n^5 = (1/6*n^2 + 1/6*n - 1/12)*(n+1)*(n+1)*n*n
1^6 + 2^6 + 3^6 ... + n^6 = (1/7*n^4 + 2/7*n^3 - 1/7*n + 1/21)*(n+1)*(n+1/2)*n
1^7 + 2^7 + 3^7 ... + n^7
= (1/8*n^4 + 1/4*n^3 - 1/24*n^2 - 1/6*n + 1/12)*(n+1)*(n+1)*n*n
1^8 + 2^8 + 3^8 ... + n^8
= (1/9*n^6 + 1/3*n^5 + 1/9*n^4 - 1/3*n^3 - 1/45*n^2 + 1/5*n - 1/15)*(n+1)*(n+1/2)*n
1^9 + 2^9 + 3^9 ... + n^9
= (1/10*n^7 + 2/5*n^6 + 7/20*n^5 - 7/20*n^4 - 7/20*n^3 + 7/20*n^2 + 3/20*n - 3/20)
*(n+1)*n*n
1^10 + 2^10 + 3^10 ... + n^10
= (1/11*n^10 + 1/2*n^9 + 5/6*n^8 - n^6 + n^4 - 1/2*n^2 + 5/66)*n
1^11 + 2^11 + 3^11 ... + n^11
= (1/12*n^11 + 1/2*n^10 + 11/12*n^9 - 11/8*n^7 + 11/6*n^5 - 11/8*n^3 + 5/12*n)*n
Lösung zu Aufgabe 17.1:
a) 206(10) = 128 + 64 + 8 + 2 (10) = 11001110(2)
b) Verlaufsprotokoll:
| i | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | |
| n | 128 | 78 | 14 | 14 | 14 | 6 | 2 | 0 | 0 |
| s | '' | '1' | '11' | '011' | '0011' | '00111' | '001111' | '0011111' | '00011111' |
| p | 128 | 64 | 32 | 16 | 8 | 4 | 2 | 1 | 0 |
Das Programm gibt "00011111" aus. Es müßte aber 11001110 ausgeben! Die "0" wird jeweils falsch angehängt.
c) Die viertletzte Zeile muss statt
"ENd else s := '0' + s;"
lauten:
"ENd else s := s + '0';"
Dann werden alle Dezimalzahlen kleiner als 256 richtig umgerechnet.
d) Die Umwandlung ist nicht allgemein genug, sondern nur für "kleine" Zahlen geeignet.
- 1. Verbesserungsvorschlag:
- Wähle für p die für Integerzahlen maximale Zahl und ändere das Schleifenende der for-Schleife entsprechend.
- Kritik am Verbesserungsvorschlag:
- Maschinenabhängig.
- 2.Verbesserungsvorschlag:
- Prüfe zuerst mit welcher Zweierpotenz man anfangen soll. Zum Beispiel:
p := 2; while p < n do p := p*2;
- Dritter Verbesserungsvorschlag:
- Programmiere eine bewährte Methode: siehe Beispiel am Kopf des Abschnitts
Lösung zu Aufgabe 20.1 Rechnen mit 3-dim. Vektoren als Record.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
type Tvektor = record
x1: real;
x2: real;
x3: real;
End;
var
Form1: TForm1;
implementation
{$R *.DFM}
function vektoraddition(a, b: Tvektor):Tvektor;
begin
with result do Begin
x1 := a.x1 + b.x1;
x2 := a.x2 + b.x2;
x3 := a.x3 + b.x3;
End;
end;
function SMultiplikation(t: real; a: Tvektor):Tvektor;
begin
with result do Begin
x1 :=t*a.x1;
x2 :=t*a.x2;
x3 :=t*a.x3;
End;
end;
function vektor(x1, x2, x3: real): Tvektor;
begin
result.x1 := x1;
result.x2 := x2;
result.x3 := x3;
end;
{oder aber jetzt mit gutem Grund Parameter a, b und c
function vektor(a, b, c: real): Tvektor;
begin
with result do Begin
x1 := a;
x2 := b;
x3 := c;
End;
end;}
procedure zeige(a: Tvektor);
begin
Showmessage('Der Vektor hat die Koordinaten x1= '
+ FloatToStr(a.x1)
+ ' x2= ' + FloatToStr(a.x2)
+ ' x3= ' + FloatToStr(a.x3));
end;
function BerechnePunkt(stuetzvektor, Richtungsvektor: Tvektor; t:real):TVektor;
begin
result := vektoraddition(stuetzvektor,SMultiplikation(t,Richtungsvektor));
end;
procedure TForm1.Button1Click(Sender: TObject);
var stuetzvektor,Richtungsvektor,Ortsvektor:Tvektor;
t: real;
begin
stuetzvektor := vektor(2, -1, 5);
Richtungsvektor := vektor(0, 1, 4);
t := 4;
Ortsvektor := BerechnePunkt(stuetzvektor,Richtungsvektor,t);
Zeige(Ortsvektor);
end;
end.
Lösung zu Aufgabe aus Beispiel 22.5: Halte dich an
Beispiel 22.5 Lokal wurden
die Variablen x0,x0 eingeführt und folgende Prozeuren verändert.
...
private
zeichne: boolean;
x0, y0: integer; <= Neu!
myimageArchiv:array of TImage;
procedure TForm1.ImageonMousedown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with (sender as Timage).canvas do moveto(x,y);
Zeichne := True;
x0 := x;
y0 := y;
end;
procedure TForm1.ImageOnMousemove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
//entfällt;
end;
procedure TForm1.ImageOnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Zeichne := false;
if abs(y - y0) < 20 then y := y0;
if abs(x - x0) < 20 then x := x0;
with (sender as Timage).canvas do lineto(x,y);
end;
Lösung zu Aufgabe 21.1 Vergleich zweier Dateien
procedure TForm1.Button1Click(Sender: TObject);
var k,z: integer;
begin
memo1.Lines.LoadFromFile('c:\test1.txt');
memo2.Lines.LoadFromFile('c:\test2.txt');
if memo1.Lines.Count <> memo2.Lines.Count then Begin
showmessage('Die Dateien sind verschieden lang.');
End else Begin
z := 0;
for k := 0 to memo1.lines.count - 1 do
if memo1.lines[k] <> memo2.lines[k] then z := z + 1;
if z > 0 then showmessage(IntToStr(z)+' Zeilen sind verschieden')
else showmessage('Die Dateien sind identsch');
End;
end;
Lösung zu Aufgabe 21.2 Dateinamen in Datei
ausgeben und bestimmen, wie viel Platz sie beanspruchen.
procedure TForm1.Button1Click(Sender: TObject);
var SR: TSearchRec;
s : integer; //Summe der Dateigrößen
begin
s := 0; //Anfangswert bei Summen
if FindFirst('c:\*.*',faAnyFile,SR)=0 then Begin
repeat
memo1.lines.add(sr.name);
s := s + sr.size;
until FindNext(SR)<>0;
FindClose(SR);
memo1.Lines.Add('Belegt '+IntToStr(s)+' Bytes');
End;
end;
Lösung zu Aufgabe 24.1: Einen "Abbrechenknopf" einblenden.
Füge folgende unit2 zu (Menü: Datei|Neu|unit. Lösche die Vorgabe und überschreibe mit folgendem):
unit unit2;
interface
uses
Classes, //Für TComponent
Forms, // Für TForm
Dialogs, //für showmessage
StdCtrls; //Für TButton
type
TFormabbrechen = class(TForm)
babbrechen: TButton;
labbrechen: Tlabel;
procedure BabbrechenClick(Sender: TObject);
public
stop: boolean;
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
end;
implementation
Constructor TFormabbrechen.Create(aOwner: TComponent);
begin
inherited CreateNew(aOwner);
//Aufbau der Form: Einen Button mit Onclick-Ereignisroutine und ein Label
self.stop := false; //Anfangswert
babbrechen := TButton.Create(self);
babbrechen.Parent := self;
babbrechen.Caption := 'Abbrechen';
babbrechen.OnClick := self.BabbrechenClick;
labbrechen := Tlabel.Create(Self);
labbrechen.parent := self;
labbrechen.caption := 'Bitte etwas Gelduld!';
labbrechen.left := 10;
self.BorderStyle := bssizeable;
self.BorderIcons := [];
self.width := 250;
babbrechen.Top := labbrechen.Height + 5;
babbrechen.left := (self.width - babbrechen.width) div 2;
self.Top := (screen.height - self.Height) div 2;
self.left := (screen.width - self.width) div 2;
self.Height := 100;
self.Show;
end;
Destructor TFormabbrechen.Destroy;
begin
inherited Destroy;
end;
procedure TFormabbrechen.BabbrechenClick(Sender: TObject);
begin
if MessageDlg('Wollen Sie wirklich abbrechen?',mtConfirmation,
[mbYes, mbNo], 0) = 6 then Begin
self.stop := true;
End;
end;
end.
Ergänze Dein Programm so, dass die neue Form eingeblendet und auf
Knopfdruck reagiert wird. Zum Beispiel folgendermaßen:
uses unit2;
procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
n: int64;
Abbrechen: TFormabbrechen;
begin
n := 18115587450017; //Besser aus Editfeld auslesen.
Abbrechen:= TFormabbrechen.Create(self); //Abbrechen-Fenster wird eingeblendet
Abbrechen.Caption := ' Test auf Primzahl';
form1.enabled := false; //Dann kann der Button nicht nochmals
//gedrückt werden
try
for i := 2 to round(sqrt(1.0*n)) do Begin
if i mod 10000 = 0 then BEgin //genügt, sonst langsamer
application.ProcessMessages; //Ein Klick wird registriert.
Abbrechen.labbrechen.caption := 'Fertig, wenn ' +
floatToStr(1.0*i*i) + ' > ' + inttostr(n);
if abbrechen.stop then exit; //Falls Klick: Abbruch
ENd;
if n mod i = 0 then BEgin
showmessage(intToStr(i) + ' ist Teiler');
exit;
ENd;
End;
showmessage('Primzahl');
finally
form1.enabled := true;
form1.show;
abbrechen.Free
End;
end;
Hinweis:
Du kannst den Quelltext hier (Beispiele aus den Lektionen oder Lösungen) ohne weiteres in dein Delphi-Programm kopieren. Zum Beispiel:
function fakultaet(n:integer):real;
var k: integer; //k: lokale Variable
begin
result := 1;
for k := 1 to n do result :=result*k;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
memo1.text := 'n fakultaet(n)';
for i := 1 to 100 do
memo1.lines.add(IntToStr(i)+' '+floatToStr(fakultaet(i)));
end;
Dazu mußt Du folgendes beachten:
- Wie Du siehst: Ein Button und ein Memo wird benötigt. Diese zwei Komponenten mußt Du vorher auf dein Formular platzieren.
- Selbst definierte Funktionen und Prozeduren können direkt
nach implementation eingefügt werden.
Zum Beispiel:function fakultaet(n:integer):real - Bei Methoden einer Klasse sieht es anders aus.
(Methoden sind besondere Prozeduren. Sie erkennt man an der Form zum Beispiel
procedure TForm1.Button1Click(Sender: TObject).)
Du darfst nicht selbst schreiben:procedure TForm1.Button1Click(Sender: TObject); begin end;
Das muss Delphi für Dich tun, indem Du auf den Button auf dem Formular doppelt klickst. Kopiere dann den fehlenden Text dazwischen!
unit1 //komplette Unit1 ersetzten end.Aus diesem Grunde sind in allen Beispielen hier die Namen der Instanzen, so wie sie Delphi vorgibt, belassen.
Zum Beispiel:
Button1(Caption von Button1) Button2(Caption von Button2)
Dir bleibt die Beschriftung überlassen. Der Name sollte dann auch entsprechend
geändert werden.
Zum Beispiel:
Öffnen(Caption von Boeffnen) Schliessen(Caption von Bschliessen)
zurück
Hinweis