Opasarkisto: Pascal-ohjelmointi: Osa 5 - Funktiot, aliohjelmat ja omat moduulit

program Funktiot;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  Koko = 31;

type
  TTaulukko = Array [0 .. Koko] of Integer;

  (* Määritellään muuttujatyyppi TLajittelu, joka siis osoittaa aliohjelmaan,
   * jonka parametreinä on kaksi kokonaislukua ja muuttuva TTaulukko *)
  TLajittelu = procedure (const Alku, Loppu: Integer; var Taulu: TTaulukko);

(* Vaihtaa lukujen paikkaa *)
procedure Vaihda(var A, B: Integer);
begin
  A := A xor B;
  B := B xor A;
  A := A xor B;
end;

(* Bubblesort on melkoisen hidas lajittelualgoritmi *)
procedure Bubblesort(const Alku, Loppu: Integer; var Taulu: TTaulukko);
var
  I, J: Integer;
begin
  (* Käydään lista läpi alusta toiseksi viimeiseen asti *)
  for I := Alku to Loppu - 1 do
  begin
    (* Käydään joka kerta lista läpi lopusta I:tä seuraavaan asti *)
    for J := Loppu downto I + 1 do
    begin
      (* Jos nämä kaksi lukua ovat väärässä järjestyksessä *)
      if Taulu[I] > Taulu[J] then
      begin
        (* Vaihdetaan niiden paikkoja *)
        Vaihda(Taulu[I], Taulu[J]);
      end;
    end;
  end;
end;

(* Shellsort on melkoisen nopea lajittelualgoritmi *)
procedure Shellsort(const Alku, Loppu: Integer; var Taulu: TTaulukko);
var
  Valmis: Boolean;
  Hyppy, I, J: Integer;
begin
  (* Asetetaan Hyppy listan pituuden mittaiseksi *)
  Hyppy := Loppu - Alku;
  while Hyppy > 1 do
  begin
    (* Tämä on toinen tapa jakaa kokonaisluku kahdella.
     * Sen bittejä siirretään yhden bitin verran oikealle. *)
    Hyppy := Hyppy shr 1;
    repeat begin
      Valmis := True;
      (* Käydään taulukko läpi yhä pienemmällä välillä. I:n ja J:n
       * ero on sama kuin Hyppy, ja koska Hyppy pienenee ulommassa
       * while-silmukassa, luvut siirretään yhä tarkemmin paikoilleen. *)
      J := Alku + Hyppy;
      I := Alku;
      while J <= Loppu do
      begin
        (* Jos luvut ovat väärin päin, vaihdetaan ja kerrotaan,
         * että ei olla vielä valmiita *)
        if Taulu[I] > Taulu[J] then
        begin
          Vaihda(Taulu[I], Taulu[J]);
          Valmis := False;
        end;
        (* Suurennetaan molempia *)
        Inc(I);
        Inc(J);
      end;
      (* Toistetaan, kunnes ollaan tältäosin valmiita *)
    end until Valmis;
    (* Viimeisellä toistolla Hyppy on 1, joten toisto päättyy *)
  end;
end;

var
  Taulu1, Taulu2, Taulu3: TTaulukko;
  X, Y: Integer;
  Lajittelu: TLajittelu;

begin
  for X := 0 to Koko do
  begin
    Taulu1[X] := Random(100000);
    Taulu2[X] := Taulu1[X];
    Taulu3[X] := Taulu1[X];
  end;

  (* Lajitellaan Taulu1 Bubblesortilla ja Taulu2 Shellsortilla *)
  Lajittelu := Bubblesort;
  Lajittelu(0, Koko, Taulu1);

  Lajittelu := Shellsort;
  Lajittelu(0, Koko, Taulu2);

  (* Kirjoitetaan tulokset *)
  for X := 0 to Koko do
    Writeln(Taulu1[X] : 11, Taulu2[X] : 11, Taulu3[X] : 11);
end.

unit TyhjaModuuli;
interface
implementation
end.

unit Luvunheitto;

interface

type
  TLuku = record
    X, Y, Arvo: Single;
  end;

procedure HeitaLukuIlmaan(Korkeus: Single; var Luku: TLuku);

implementation

procedure HeitaLukuIlmaan(Korkeus: Single; var Luku: TLuku);
var
  Vauhti, MaxKorkeus, Alku: Single;

const
  Aloituskerroin = 0.9;

begin
  Vauhti:= Aloituskerroin * Korkeus;
  Alku := Luku.Y;
  MaxKorkeus := Korkeus + Luku.Y;

  (* Nostetaan Lukua kunnes se on korkeimmillaan *)
  while Luku.Y < MaxKorkeus do
  begin
    Luku.Y := Luku.Y + Vauhti;
    Vauhti := Vauhti / 2;
  end;

  (* Lasketaan Luku takaisin *)
  while Luku.Y - Vauhti > Alku do
  begin
    Luku.Y := Luku.Y - Vauhti;
    Vauhti := Vauhti * 2;
  end;

  Luku.Y := Alku;
end;

end.

uses
  Esimerkki in 'Esimerkki.pas';

program Ongelma;

procedure Vaihda(var A, B: Longint);
var
  C: Longint;
begin
  C := A;
  A := B;
  B := C;
end;

var
  X: Longint;

begin
  X := 10;
  Vaihda(X, 4);
end.