Kirjainyhdistelmät

Kokeilin tälläistä ratkaisua koska Pascal saallii taulukon koon määrittelyn myös merkkeinä.
Ideana tässä koodissa on että sanat on TStringList-tyyppisessä oliossa ja tuloksenkin voi työntää
TStringList olioon. Koodista puuttuu skandimerkkien käsittely. Se on tarkoituksella jätetty pois.
Se voidaan toteuttaa niin kuin ennenvanhaan eli merkkien {,| ja } tilalla on ääkköset. Mutta
monella muullakin tapaa.

type // tyyppien määrittely


TKP1=Class
private
lkm:array['a'..'}'] of integer;
public
constructor Create;
procedure Add(ch:char);
function KerroLKM(ch:char):integer;
end;

{ TKP }

TKP =Class
private
destructor Free;
procedure kasitteleErikoisTapaukset(mjono: string);
function KerroSanojenMaara(s: string): integer;
function onaz(ch:char):boolean;
tau:array ['a'..'}'] of TKP1;
procedure sana(s: string);
function tarkistaMerkit(s: string): boolean;
public
constructor Create;
procedure Add(kaksiMerkkia:string);
end;

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Memo1: TMemo;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
merkkiYhdistelmat:TKP;
sanat:TStringList;
procedure KerroMerkkiYhdistelmienEsiintymiset;
procedure LueSanatStringListiin;
procedure VieSanakerrallaanTutkittavaksi;
public
{ public declarations }
end;


.............


ja varsinainen toteutusosa:


constructor TKP1.Create;
var ch:char;
begin
for ch:= 'a' to '}' do lkm[ch]:=0;
end;

procedure TKP1.Add(ch:char);
begin
lkm[ch]:=lkm[ch] 1;
end;

function TKP1.KerroLKM(ch:char):integer;
begin
result:=lkm[ch];
end;

constructor TKP.Create;
var ch:char;
begin
for ch:= 'a' to '}' do tau[ch]:= TKP1.Create;
end;

procedure TKP.add(kaksiMerkkia:string);
var mjono:string; ch1,ch2:char;
ok:boolean;
begin
mjono:=lowercase(kaksiMerkkia);
if tarkistaMerkit(mjono)
then tau[mjono[1]].Add(mjono[2])
else kasitteleErikoisTapaukset(mjono);
end;

function TKP.onaz(ch:char):boolean;
begin
if ch in['a'..'z']
then result := true
else result := false;
end;

function TKP.tarkistaMerkit(s:string):boolean;
begin
if onaz(s[1]) and onaz(s[2])
then result := true
else result := false;
end;

procedure TKP.kasitteleErikoisTapaukset(mjono:string);
begin
end;

function TKP.KerroSanojenMaara(s:string):integer;
begin
if tarkistaMerkit(s)
then result :=tau[s[1]].KerroLKM(s[2]);
end;

procedure TKP.sana(s:string);
var mjono:string;
paikka:integer;
begin
paikka :=1;
for paikka :=1 to length(s) do
begin
mjono := copy(s,paikka,2);
add(mjono);
end;
end;

destructor TKP.Free;
var ch:char;
begin
for ch:= 'a' to '}' do tau[ch].Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
LueSanatStringListiin;
VieSanakerrallaanTutkittavaksi;
KerroMerkkiYhdistelmienEsiintymiset;
end;

procedure TForm1.LueSanatStringListiin;
begin
Sanat.Text:=Memo1.Text;
end;

procedure TForm1.VieSanakerrallaanTutkittavaksi;
var i:integer ;
begin
for i:=0 to sanat.count-1 do
merkkiYhdistelmat.Sana(sanat[i]);
end;

procedure TForm1.KerroMerkkiYhdistelmienEsiintymiset;
var ch1,ch2:char; mjono:string; i:integer;
begin
for ch1 := 'a' to 'z' do
for ch2 := 'a' to 'z' do
begin
mjono:=ch1 ch2;
i:=merkkiYhdistelmat.KerroSanojenMaara(mjono);
if i > 0 then Memo2.Lines.add(mjono ' :' IntToStr(i));
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
merkkiYhdistelmat := TKP.Create;
sanat := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
sanat.Free;
merkkiYhdistelmat.Free;
end;