Einführung in die imperative Programmierung

WS 2016/17

Klausuraufgabe HK14 Aufgabe 2

program aufg2;

 const
 ANZ = 20;

 type
 tIndex = 1..ANZ;
 tFeld = array[tIndex] of integer;
   
 var
 A: tFeld;
 i: integer;

 procedure loeschen(var ioFeld: tFeld);
   var 
   element: integer; 
   i, j: integer;
   
 begin
   for i:= 1 to 20 do
   begin
     element:= ioFeld[i];
     for j:= i+1 to 20 do
       if ioFeld[j]=element then
         ioFeld[j] := 0;
    end;
 end; 

BEGIN
  for i:=1 to ANZ do
  readln(A[i]);
   
  loeschen(A);
   
  for i:=1 to ANZ do
    write(A[i],' '); 
  writeln();
   
END.

Klausuraufgabe HK14 Aufgabe 3

program pascal;

 type 
 tRefListe = ^tListe; 
 tListe = record 
            wert:integer; 
            next:tRefListe 
          end;
   
 var 
 P, neu, neuP: tRefListe;

 function Peck(inRefListe: tRefListe) : tRefListe;
   
   var 
   vor, nach, kopf, ende, hilfe: tRefListe;
   
 begin
   vor:= inRefListe;
   if vor^.next = nil then
   {Liste hat nur ein Element}
   begin
     new(kopf);
     kopf^.wert:= 1;
     new(ende);
     ende^.wert:= 1;
     kopf^.next:= ende;
     ende^.next:=nil;
     Peck:=kopf;
   end
   else
   begin
     nach:=vor^.next;
     new(kopf);
     kopf^.wert:= 1;
     hilfe:=kopf;
     while (nach<>nil) do
     begin
       new(ende);
       ende^.wert:= vor^.wert+nach^.wert;
       ende^.next:=nil;
       hilfe^.next:= ende;
       hilfe:=ende;
       vor:= nach;
       nach:=nach^.next;
     end;
     new(ende);
     ende^.wert:=1;
     ende^.next:=nil;
     hilfe^.next:= ende;
     Peck:= kopf;
   end;
 end;

BEGIN
  new(neu);
  neu^.wert:=1;
  neu^.next:=nil;
  P:=neu;
  new(neu);
  neu^.wert:=4;
  neu^.next:=P;
  P:=neu;
  new(neu);
  neu^.wert:=6;
  neu^.next:=P;
  P:=neu;
  new(neu);
  neu^.wert:=4;
  neu^.next:=P;
  P:=neu; 
  new(neu);
  neu^.wert:=1;
  neu^.next:=P;
  P:=neu; 
   
  neuP := Peck(P);
   
  while (neuP <> nil) do
  begin
    write(neuP^.wert, ' ');
    neuP:= neuP^.next;
  end;
  writeln();
END.

Klausuraufgabe HK14 Aufgabe 4

program aufgabe4;

  type tNatZahl = 1..maxint; 
  tRefBinBaum = ^tBinBaum; 
  tBinBaum = record 
               Wert:tNatZahl; 
               links:tRefBinBaum; 
               rechts:tRefBinBaum 
             end;

  function OKBaum(inRefWurzel: tRefBinBaum; inMax: tNatZahl) : boolean;
    var
    left,right:boolean;
   
  begin
    if (inRefWurzel^.links=nil) and (inRefWurzel^.rechts=nil) then
    {Blatt erreicht}
    begin
      if inMax < inRefWurzel^.Wert then
        OKBaum:=true
      else
        OKBaum:= false;
    end
    else
    {innerer Knoten}
    begin
      if inMax < inRefWurzel^.Wert then
        inMax:= inRefWurzel^.Wert;
      if inRefWurzel^.links<>nil then
        left:= OKBaum(inRefWurzel^.links, inMax)
      else
        left:=true;
      if inRefWurzel^.rechts<>nil then
        right := OKBaum(inRefWurzel^.rechts,inMax)
      else
        right:= true;
      OKBaum:= right and left; 
    end;
  end;
 

BEGIN
   
END.

Heron

program heron;

 var
 w,a: real;
 i,n: integer;

BEGIN
  writeln('a');
  readln(a);
   
  writeln('n');
  readln(n);
   
  w:=1;
   
  for i:=1 to n do
    w:=0.5*(w+a/w);
   
  writeln(w);
   
END.

Heron rekursiv

program heron_rek;

  var
  w,a: real;
  i,n: integer;
   
  function heron(inA: real; inN : integer): real;
    var
    w: real;
  begin
    if inN=0 then
      heron:= inA/2
    else
    begin
      w:= heron(inA, inN-1);
      writeln(w);
      heron:= 0.5* (w+inA/w);
    end;
  end;

BEGIN
  writeln('a');
  readln(a);
   
  writeln('n');
  readln(n);
   
  w:= heron(a, n);
   
  writeln(w);
   
END.

Nachklausur 2013 Aufgabe3

program untitled;

  const 
  FELDGROESSE=5;

  type 
  tIndex=1..FELDGROESSE; 
  tFeld=array[tIndex] of integer;

  function istDrin(inFeldA: tFeld; inFeldB: tFeld): boolean;
    var
    i,j: integer;
    OK,elem_drin: boolean;
   
  begin
    OK:= true;
   
    for i:= 1 to FELDGROESSE do
    begin
      elem_drin:= false;
      for j:= 1 to FELDGROESSE do
        if inFeldA[i]=inFeldB[j] then
          elem_drin:= true; 
        OK:= OK and elem_drin;
    end;
   
  end;

BEGIN
   
END.
 

Pascalsches Dreieck

 program PascalDreieck;

 type 
   tRefListe = ^tListe; 
   tListe = record 
   wert:integer; 
   next:tRefListe 
   end;
 

 var 
   Liste,zeiger,neu, NeuZeile : tRefListe;
   
   function naechsteZeile(inListe: tRefListe) : tRefListe;
   var
   zeigerneu, zeigeralt, neuerKnoten, zeigerneuLetzter: tRefListe;
   vorWert:integer;
   begin
   vorWert:=0;
   zeigeralt:= inListe;
   zeigerneu:=nil;
   while zeigeralt<>nil do
   begin
   new(neuerKnoten);
   neuerKnoten^.wert:= vorWert + zeigeralt^.wert;
   neuerKnoten^.next:=nil;
   if zeigerneu=nil then
   begin
   zeigerneu:=neuerKnoten;
   zeigerneuLetzter:= neuerKnoten;
   end
   else
   begin
   zeigerneuLetzter^.next:= neuerKnoten;
   zeigerneuLetzter:= neuerKnoten;
   end; 
   vorWert := zeigeralt^.wert;
   zeigeralt:= zeigeralt^.next;
   end; {while}
   {letztes Element erzeugen}
   new(neuerKnoten);
   zeigerneuLetzter^.next := neuerKnoten;
   neuerKnoten^.wert := 1;
   neuerKnoten^.next := nil;
   
   naechsteZeile := zeigerneu;
   
   end;
   
   procedure drucken(inListe: tRefListe);
   var zeiger: tRefListe;
   begin
   zeiger:= inListe;
   while zeiger<> nil do
   begin
   write(zeiger^.wert, ' ');
   zeiger:= zeiger^.next;
   end;
   writeln();
   end;

BEGIN
   new(Liste);
   Liste^.wert:=1;
   Liste^.next:=nil;
   zeiger:=Liste;
   
   new(neu);
   neu^.wert:=4;
   neu^.next:=nil;
   zeiger^.next:=neu;
   zeiger:= neu;
   
   new(neu);
   neu^.wert:=6;
   neu^.next:=nil;
   zeiger^.next:=neu;
   zeiger:= neu;
   
   new(neu);
   neu^.wert:=4;
   neu^.next:=nil;
   zeiger^.next:=neu;
   zeiger:= neu;

 new(neu);
   neu^.wert:=1;
   neu^.next:=nil;
   zeiger^.next:=neu;
   zeiger:= neu;
   
   write(' ');
   drucken(Liste);
   
   neuZeile := naechsteZeile(Liste);
   
   drucken(neuZeile);
   
   END.

Quadratzahl?

program quadrat;

  var
  n,i: integer;
  istQuadrat: boolean;

BEGIN
  readln(n);
  istQuadrat:= false;
   
  i:= 0;
   
  while (not istQuadrat) and ((i*i)<=n) do
  begin 
    if (i*i)=n then
      istQuadrat:= true
    else 
      i:= i+1;
  end;
  if istQuadrat then
    writeln('Ist Quadratzahl')
  else
    writeln('Ist keine Quadratzahl'); 
END.