home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
sonderh1
/
unison.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
3KB
|
113 lines
{---------------------------------------------------------------------------}
PROGRAM unison_demo (Input, Output);
CONST maxstrlen = 80;
TYPE strtyp = STRING [maxstrlen];
VAR elem1, elem2: strtyp;
aehnlichkeit: INTEGER;
{---------------------------------------------------------------------------}
FUNCTION max (r1, r2: INTEGER): INTEGER;
BEGIN
IF r1>r2 THEN
max := r1
ELSE
max := r2;
END;
{---------------------------------------------------------------------------}
{ Unison: Ermittlung des Prozentsatzes, zu dem 's1' in 's2' enthalten ist. }
FUNCTION unison (s1, s2: strtyp): INTEGER;
VAR treffer, p1, p2, pt, diff: INTEGER;
hstr: strtyp;
test: ARRAY [1..maxstrlen] OF BOOLEAN;
BEGIN
IF Length(s1) < Length(s2) THEN
BEGIN
hstr := s2;
s2 := s1;
s1 := hstr;
END;
p1 := 1;
p2 := 1;
treffer := 0;
diff := max(Length(s1), Length(s2)) DIV 3 + abs(Length(s1)-Length(s2));
FOR pt := 1 TO Length(s1) DO
test[pt] := FALSE;
REPEAT
IF NOT(test[p1]) THEN
BEGIN
IF (s1[p1] = s2[p2]) AND (abs(p1-p2) <= diff) THEN
BEGIN
test[p1] := TRUE;
treffer := Succ(treffer);
p1 := Succ(p1);
p2 := Succ(p2);
IF p1 > Length(s1) THEN
p1 := 1
END
ELSE
BEGIN
test[p1] := FALSE;
p1 := Succ(p1);
IF p1 > Length(s1) THEN
BEGIN
WHILE (p1 > 1) AND NOT(test[p1]) DO
p1 := Pred(p1);
p2 := Succ(p2)
END;
END;
END
ELSE
BEGIN
p1 := Succ(p1);
IF p1 > Length(s1) THEN
BEGIN
REPEAT
p1 := Pred(p1)
UNTIL (p1 = 1) OR test[p1];
p2 := Succ(p2)
END;
END;
UNTIL p2 > Length(s2);
unison := 100 * treffer DIV Length(s1) ;
END;
{---------------------------------------------------------------------------}
BEGIN {unison_demo}
REPEAT
WriteLn;
WriteLn('Aehnlichkeitstest:');
Write('Bitte das erste Wort eingeben: '); ReadLn(elem1);
Write('Bitte das zweite Wort eingeben: '); ReadLn(elem2);
aehnlichkeit := unison(elem1, elem2);
Write('Die Ahnlichkeit betraegt ', aehnlichkeit:3);
Write('%, die Woerter sind also ');
IF aehnlichkeit = 100 THEN
WriteLn('gleich.')
ELSE IF aehnlichkeit >= 90 THEN
WriteLn('fast gleich.')
ELSE IF aehnlichkeit >= 80 THEN
WriteLn('sehr aehnlich.')
ELSE IF aehnlichkeit >= 70 THEN
WriteLn('aehnlich.')
ELSE IF aehnlichkeit >= 60 THEN
WriteLn('etwas aehnlich.')
ELSE IF aehnlichkeit >= 30 THEN
WriteLn('unterschiedlich.')
ELSE IF aehnlichkeit >= 10 THEN
WriteLn('sehr unterschiedlich.')
ELSE
WriteLn('total anders.')
UNTIL false;
END.