Einführung in die imperative Programmierung

WS 2018/19

for-Schleife

program ForSchleife;

 var
   i: integer;
 summe: integer;

BEGIN
   summe:=0;
   for i:=1 to 100  do
   begin
   summe:= summe + i;
   end;
   
   writeln(i,' ',summe)
   
END.

while-Schleife

   program WhileSchleife;

 var
   i: integer;
 summe: integer;

BEGIN
   summe:=0;
   i:=0;
   while (i<100) do
   begin
   i:=i+1;
   summe:= summe + i;
   end;
   
   writeln(i,' ',summe)
   
   END.

repeat-Schleife

program RepeatSchleife;

 var
   i: integer;
   summe: integer;

BEGIN
   summe:=0;
   i:=0;
   repeat
   i:=i+1;
   summe:= summe + i;
   until i=100;
   
   writeln(i,' ',summe)
   
END.

Strings

   program zeichenkette;

 var
   wort: string;
   laenge,i: integer;

BEGIN
   readln(wort);
   
   laenge := length(wort);
   
   for i:= laenge downto 1 do
   write(wort[i]);
   
   writeln;
   
   END.

Aufgabe 1

program aufg1;

var 
   Eingabe,Maximum: integer;

BEGIN
   readln(Eingabe);
   Maximum:=Eingabe;
   while Eingabe<>0 do
   begin
   if Eingabe > Maximum then
   Maximum := Eingabe;
   readln(Eingabe); 
   if Eingabe=0 then
   writeln('Maximum: ',Maximum); 
   end;
   
   if (Maximum=0) then
   writeln('Leere Eingabefolge')
   
END.

Aufgabe 2

program merge (input, output);
   { liest ohne Eingabeueberpruefung zwei sortierte Felder mit 
   integer-Zahlen ein; beide Felder werden in einem weiteren Feld
   sortiert zusammengefuegt; das Ergebnis wird ausgegeben; ist 
   die Eingabe unsortiert, so ist das Ergebnisfeld undefiniert }
   const
   FELDLAENGE1 = 5;
   FELDLAENGE2 = 8;
   ERGEBNISFELDLAENGE = 13; { FELDLAENGE1 + FELDLAENGE2 }
   
   type
   tFeld1 = array [1..FELDLAENGE1] of integer;
   tFeld2 = array [1..FELDLAENGE2] of integer;
   tErgebnisFeld = array [1..ERGEBNISFELDLAENGE] of integer;

 var
   Feld1 : tFeld1;
   Feld2 : tFeld2;
   ErgebnisFeld : tErgebnisFeld;
   i : integer;
   j : integer;
   k : integer;
   begin
   { sortierte Felder einlesen }
   writeln ('Bitte', FELDLAENGE1:2, ' Werte des ersten Feldes ',
   'sortiert eingeben!');
   for i := 1 to FELDLAENGE1 do
   readln (Feld1[i]);
   writeln ('Bitte', FELDLAENGE2:2, ' Werte des zweiten Feldes ',
   'sortiert eingeben!');
   for j := 1 to FELDLAENGE2 do
   readln (Feld2[j]);

 { Verschmelzungsprozess beginnen }
   i:=1;
   j:=1;
   k:=1;
   repeat 
   if Feld1[i]>=Feld2[j] then
   begin
   ErgebnisFeld[k]:= Feld2[j];
   j:=j+1;
   end
   else 
   begin
   ErgebnisFeld[k]:= Feld1[i];
   i:=i+1;
   end; 
   k:=k+1; 
   until (i>FELDLAENGE1) or (j>FELDLAENGE2);
   
   if i<=FELDLAENGE1 then
   for j:=k to ERGEBNISFELDLAENGE do
   begin
   ErgebnisFeld[j]:= Feld1[i];
   i:=i+1;
   end
   else
   for i:=k to ERGEBNISFELDLAENGE do
   begin
   ErgebnisFeld[i]:= Feld2[j];
   j:=j+1;
   end; 
   
   writeln ('Das Ergebnisfeld ist:');
   for k := 1 to ERGEBNISFELDLAENGE do
   write (ErgebnisFeld[k], ' ');
   writeln
   end.

Brüche

   program brueche;

type
   tBruch = record 
   zaehler: integer;
   nenner: integer;
   end;
   
   var 
   bruch1, bruch2, bruch3: tBruch;

function ggt(a,b:integer): integer;
   begin
   while a<>b do
   if a>b then
   a:=a-b
   else
   b:=b-a;
   ggt:=a;
   end; {ggt}

function kuerzen(b: tBruch): tBruch;
   var
   teiler:integer;
   begin
   teiler:=ggt(b.zaehler, b.nenner);
   kuerzen.zaehler:= b.zaehler div teiler;
   kuerzen.nenner:= b.nenner div teiler;
   end; {kuerzen}

function addiere(x,y: tBruch) : tBruch;
   var
   ergebnis: tBruch;
   begin
   if x.nenner<>y.nenner then
   begin
   ergebnis.nenner:= x.nenner*y.nenner;
   ergebnis.zaehler := x.nenner*y.zaehler + x.zaehler*y.nenner;
   end 
   else
   begin
   ergebnis.nenner:= x.nenner;
   ergebnis.zaehler := x.zaehler + y.zaehler;
   end ;
   addiere:=kuerzen(ergebnis); 
   end;

BEGIN

 write('Bruch1 ');
   readln(bruch1.zaehler);
   readln(bruch1.nenner);
   
   write('Bruch2 ');
   readln(bruch2.zaehler);
   readln(bruch2.nenner);
   
   bruch3:= addiere(	bruch1, bruch2);
   
   write('Ergebnis: ', bruch3.zaehler, '/', bruch3.nenner);
   
   END.

3+1-Problem

program dreipluseins;

var
   Zahl: integer;

BEGIN
   readln(Zahl);
   
   while Zahl<>1 do
   begin
   if odd(Zahl) then
   Zahl := Zahl*3+1
   else
   Zahl:= Zahl div 2;
   writeln(Zahl);
   end 
   
END.

Fakultät rekursiv

{R+}

program fak;

var 
   n : integer;

function fak(n: integer): integer;
   begin
   if n=0 then
   fak:=1
   else
   fak := fak(n-1) * n;

end;

BEGIN
   readln(n);
   
   writeln('Fakultät: ', fak(n));
   
END.

ggT rekursiv

program ggtRek;

var 
   a,b : integer;

function ggt(x,y: integer): integer;
   begin
   writeln(x,' ',y);
   if x=y then
   ggt:=x
   else
   if x>y then
   ggt := ggt(x-y,y)
   else
   ggt := ggt(x,y-x)
   end;

BEGIN
   readln(a);
   readln(b);
   
   writeln('ggT: ', ggt(a,b));
   
   END.

Türme von Hanoi

program hanoiRek;

var 
   n : integer;
   step:integer;

procedure hanoi(n: integer; 
   von, ueber, nach: string);
   begin
   if n=1 then
   begin
   step:=step+1;
   writeln(step,': ',von,'->',nach)
   end 
   else
   begin
   hanoi(n-1,von, nach,ueber);
   hanoi(1,von,ueber, nach);
   hanoi(n-1,ueber,von,nach);
   end;

end;
 

BEGIN
   readln(n);
   step:=0;
   
   hanoi(n, 'A', 'B', 'C');
   
END.