Einführung in die imperative Programmierung

WS 2015/16

Klausur 2015 Aufg3

Es soll geprüft werden, ob Liste b in Liste a vorkommt. Wenn ja, sollen die Elemente von b in a gelöscht werden.

Algorithmus:

 prozedur Listenvergleich:
      
    {input Liste a und b}
    
    gefunden = false
    a1 = erstes Element von a
    while a1 <> nil and gefunden = false do
      y = erstes Element von b
      a2 = a1
      gefunden = true
      while y <> nil do
        if a2=y then 
          a2 = Nachfolger von a2 in a
          y = Nachfolger von y in b
          if a2=nil and y <>nil then
            gefunden = false
          else
            gefunden = false
      end while
      if gefunden = false then
        a1 = Nachfolger von a1 in a
    end while
    
    if gefunden = true then
      {Lösche in a ab a1 so viele Elemente, wie b hat}
      a2 = ioA;
      while Nachfolger von a2 <> a1 do
        a2 = Nachfolger von a2
      a3 = Nachfolger von a2
      y= inB;
      while y<>nil do
        y = Nachfolger von y
        a3 = Nachfolger von a3
      Nachfolger von a2 = a3
Programm:


program Klausur2015Aufg3;
 uses crt;
   
   type tRefListe= ^tListe;
   tListe = record
   info: integer;
   next: tRefListe;
   end;
   
   var a,b,neu, alt : tRefListe;
   
   procedure Listenvergleich(var ioA: tRefListe; inB: tRefListe);
   
   var 
   gefunden: boolean;
   a1, a2, y, a3: tRefListe;
   
   begin
   gefunden:= false;
   a1 := ioA;
   while ((a1<>nil) and (gefunden=false)) do
   begin
   y := inB;
   a2 := a1;
   gefunden:= true;
   while (y<>nil) and (gefunden=true) do
   begin
   if a2^.info=y^.info then
   begin
   a2 := a2^.next;
   y := y^.next;
   if (a2=nil) and (y<>nil) then
   gefunden := false;
   end
   else
   gefunden := false;
   end;
   if gefunden = false then
   a1 := a1^.next;
   end;
   
   if gefunden then
   begin
   {Löschen}
   a2 := ioA;
   while a2^.next <> a1 do
   a2 := a2^.next;
   a3 := a2^.next;
   y := inB;
   while y<>nil do
   begin
   y := y^.next;
   a3 := a3^.next;
   end;
   end;
   a2^.next := a3;
   
   end;
 
BEGIN
   
   new(a);
   a^.info:=2;
   a^.next:=nil;
   
   new(neu);
   neu^.info:=3;
   neu^.next:=nil;
   a^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=6;
   neu^.next:=nil;
   alt^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=1;
   neu^.next:=nil;
   alt^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=8;
   neu^.next:=nil;
   alt^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=4;
   neu^.next:=nil;
   alt^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=9;
   neu^.next:=nil;
   alt^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=10;
   neu^.next:=nil;
   alt^.next:= neu;
   
   new(b);
   b^.info:=6;
   b^.next:=nil;
   
   new(neu);
   neu^.info:=1;
   neu^.next:=nil;
   b^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=8;
   neu^.next:=nil;
   alt^.next:= neu;
   
   alt:=neu;
   new(neu);
   neu^.info:=4;
   neu^.next:=nil;
   alt^.next:= neu;
 Listenvergleich(a,b);
   
   alt:= a;
   while alt<>nil do
   begin
   writeln(alt^.info);
   alt:=alt^.next;
   end;
   
   END.

Maximum von Pfaden in den Blättern

Es soll geprüft werden, ob das Maximum jedes Pfades im Blatt liegt

program BaumMaxBlatt;
 uses crt;
   
   type
   tRefBinbaum = ^tBinbaum;
   tBinbaum = Record
   info: integer;
   links,rechts: tRefBinbaum;
   end;
   
   var i : integer;
 function aufg4(inWurzel: tRefBinbaum; inMax:integer) : boolean;
   var
   neuMax:integer;
   begin
   if inWurzel<>nil then
   begin
   if (inWurzel^.links=nil) and (inWurzel^.rechts=nil) then
   begin
   if inWurzel^.info >= inMax then
   aufg4:= true
   else
   aufg4:= false;
   end
   else
   begin
   if inWurzel^.info >= inMax then
   neuMax:=inWurzel^.info
   else neuMax:= inMax;
   aufg4:= aufg4(inWurzel^.links,neuMax) and aufg4(inWurzel^.rechts,neuMax);
   
   end;
   end
   else 
   aufg4 := true;
   end;
 
BEGIN
   
   END.

Näherung der Wurzel berechnen mit Heron-Formel

program wurzel2;
 {Eingabe: reelle Zahl a
 Ausgabe: Wurzel der Zahl a in n-ter Näherung
 nach dem Heron-Verfahren}
 var
   a, w: real;
   n : integer;
BEGIN
   {Eingabe reelle Zahl}
   write('a: ');
   readln(a);
   
   {Eingabe Anzahl der Näherungsschritte}
   write('n: ');
   readln(n);
   
   w:=1.0;
   
   while n>0 do
   begin
   w:= 0.5 * (w + a/w);
   n:= n-1;
   end;
   
   Writeln( w:10:4);
   
   END.

Näherung der Wurzel berechnen mit Heron-Formel

Nicht mit fester Anzahl der Rechenschritte. Es wird berechnet, ob sich die Näherungswerte noch stark ändern

program wurzel3;
 {Eingabe: reelle Zahl a
 Ausgabe: Wurzel der Zahl a in n-ter Näherung
 nach dem Heron-Verfahren}
 var
   a, w, w0: real;
   n : integer;
BEGIN
   {Eingabe reelle Zahl}
   write('a: ');
   readln(a);
   
   w:=1.0;
   w0:= 2.0;
   n:=0;
   
   while (abs(w0-w)> 0.001) do
   begin
   w0:= w;
   w:= 0.5 * (w + a/w);
   n:= n+1;
   end;
   
   Writeln( w);
   writeln('berechnet in ',n,' Schritten');
   
   END.

Klausuraufgaben von 2015 von Kommilitonin mit Lösungsansätzen:

Aufgabe 2:
{ Entwurf }

program Aufgabe2(input,output);
{ Heron-Verfahren }

var
  n,          { Schrittanzahl (natuerliche Zahl) }
  i,          { Schrittzähler }
  a: integer; { Operand (natuerliche Zahl) }
  w: real;    { aktueller Wert der Wurzelnäherung }

begin

  {Nähere in n Schritten die Wurzel von a an.}
  readln(a);
  readln(n);

  w:=1.0;
  write(w:6:2);

  for i := 2 to n do
  begin
    {Berechne Annäherungsschritt}
    w:=0.5*(w+a/w);
    write(w:6:2)
  end;

end.

Alternative: rekursiv
program Aufgabe2(input,output);
{ Heron-Verfahren }

  var
  n,
  a: integer;


  function w(inA, inN:integer):real;
  { berechnet die Wurzel von a in n Schritten mit Ausgabe }

    var
    wAlt: real; { w_n-1 }

  begin
    if inN <= 1 then
      w := 1.0
    else
    begin
      wAlt := w(inA, inN-1); { Rekursion }
      write(wAlt:6:2);
      w := 0.5 * (wAlt + inA / wAlt );
    end;
  end;


begin { Hauptprogramm }
  readln(a);
  readln(n);
  write(w(a,n):6:2);
end.

Aufgabe 3:
procedure Aufgabe3( inB:tRefListe;
                    var ioA:tRefListe);
{ Die Prozedur sucht das erste Vorkommen von der Liste B in der
  Liste A und kettet diesen Teil aus der Liste A aus.
  Ist die Liste B nicht in der Liste A enthalten,
  bleibt die Liste A unverändert. }

  var
  aStart,
  aLauf,
  aAlt,
  bLauf:tRefListe;
  found:boolean;

begin
  if (inB<>nil) and (ioA<>nil) then
  begin
    aStart:=ioA;
    aAlt:=nil;
    found:=false;
    while (not found) and (aStart<>nil) do
    { Liste A durchlaufen bis Ende oder gefunden }
    begin

      aLauf:=aStart;
      bLauf:=inB;
      while (aLauf^.wert=bLauf^.wert) and (aLauf^.next<>nil)
            and (bLauf^.next<>nil) do
      { Listen A und B parallel durchlaufen und vergleichen }
      begin
        aLauf:=aLauf^.next;
        bLauf:=bLauf^.next;
      end;

      if (bLauf^.next=nil) and (aLauf^.wert=bLauf^.wert) then
        found:=true  { Schleifenabbruch }
      else
      begin { weiter in Liste A }
        aAlt:=aStart;
        aStart:=aStart^.next;
      end;

    end;

    if found then { Fundstelle ausketten }
    begin
      if ioA=aStart then
        ioA:=aLauf^.next
      else
        aAlt^.next:=aLauf^.next
      end;
  end;
end;

Alternative:
{ Lösung von Gerhard Gappmeier, 23.08.2015 20:52 }

procedure remove(inB : tRefList;
                 var ioA : tRefList);
{ Sucht Liste inB in Liste ioA und entfernt diese falls gefunden.
  Ist inB nicht in ioA enthalten bleibt ioA unverändert.
}
var pos : tRefList;   { Haupt iterator }
    prev : tRefList;  { Zeigt auf vorheriges Element }
    posA : tRefList;  { Hilfsvariable für Listenvergleich }
    posB : tRefList;  { Hilfsvariable für Listenvergleich }
    gefunden : boolean;
begin
    prev := NIL;
    pos := ioA;
    { Über A iterieren um Teilliste B zu finden }
    while pos <> NIL do
    begin
        gefunden := true;
        posA := pos;
        posB := inB;
        { Listen vergleichen }
        while (posB <> NIL) and (gefunden) do
        begin
            if posA^.wert <> posB^.wert then
                gefunden := false; { listen nicht identisch }
            posB := posB^.next;
            posA := posA^.next;
            if (posA = NIL) and (posB <> NIL) then
                gefunden := false; { vorzeitiges Ende von A }
        end;
        { posA zeigt nun auf Element nach gefundener Teilliste }
        if gefunden then
        begin
            if prev <> NIL then
                prev^.next := posA { Teilliste entfernen }
            else
                ioA := posA { Listenanfang aktualisieren }
        end;
        prev := pos;
        pos := pos^.next
    end
end;

2. Alternative:
{ funktional zerlegte Lösung }


function istAnfang(inAnfang, inListe:tRefListe):Boolean;
{ true, wenn die Anfangsliste der Anfang der anderen Liste ist;
  false, wenn die andere Liste zu kurz ist
  oder sich Elemente unterscheiden }
var
  Anfang, Liste: tRefListe;
  gleich:Boolean;
begin
  gleich := true;
  Anfang := inAnfang;
  Liste := inListe;
  while (Anfang <> nil) and (Liste <> nil) and gleich do
  begin
    gleich:=(Anfang^.info = Liste^.info);
    Anfang:=Anfang^.next;
    Liste:=Liste^.next;
  end;
  istAnfang = (gleich and (Anfang = nil));
end;

procedure entketteAnfang(inAnfang:tRefListe;
                        var ioListe:tRefListe);
{ kettet den Anfang der Liste aus; inAnfang muss der Anfang sein }
var
  Anfang: tRefListe;
begin
  Anfang := inAnfang;
  while Anfang <> nil do
  begin
    Anfang := Anfang^.next;
    ioListe := ioListe^.next;
  end;
end;



procedure entferneBausA(inB : tRefListe;
                            var ioA : tRefListe);
{ Sucht Liste inB in Liste ioA und entfernt diese ein Mal
 (falls möglich). }
var
  ZeigerA: tRefListe;
  ungeloescht: Boolean;
begin
  if istAnfang(inB, ioA) then
      entketteAnfang(inB, ioA)
  else
  begin
    ZeigerA := ioA;
    ungeloescht := true;
    while (ZeigerA <> nil) and ungeloescht do
    begin
      if istAnfang(inB, ZeigerA^.next) then
      begin
        entketteAnfang(inB, ZeigerA^.next);
        ungeloescht = false;
      end;
      ZeigerA:=ZeigerA^.next;
    end; {while}
  end;
end;

Aufgabe 4:
function KnotenVonIndex ( baum : tRefBinBaum;
                          index : integer) : tRefBinBaum;
{ findet den Knoten zum Binärbaumindex }

var
  elter : tRefBinBaum; { Zeiger auf Elternknoten }

begin
  if (index = 1) then { Wurzel, Rekursionsabbruch }
    KnotenVonIndex := baum
  else
  begin { Rekursion }
    elter := KnotenVonIndex(baum, index div 2);
    if ( (index mod 2 ) = 0 ) then
      KnotenVonIndex := elter^.links
    else
      KnotenVonIndex := elter^.rechts
  end;
end;