Prozentuale Ähnlichkeit (Mustererkennung)

[Go2EITS]

So, ich habe eine Ergänzung:
Wenn von die 5 Feldern ein Feld ein "Ausreisser" ist, dann prüfe, ob die Summe der restlichen 4 kleiner 1 ist.
Ist das der Fall, dann wird die Zeile/Datensatz als ähnlich angezeigt.
Ich verwende hierfür die Abfrage, an welcher Position der Aussreißer steht und weise den Index der Varibalen p zu und lösche
dann das Ergebnis[x,p]. Die neue Summe zeigt mir dann, ob der Datensatz, bis auf den Ausreißer ähnlich meiner ersten Zeile in der Datenbank ist.

Delphi-Quellcode:

// Wir prüfen, einen Aussreißer im Array Ergbnis[x,1.6] um zu sehen,
// ob 4 von 5 Werten unsere Bedingungen erfüllen.
if ergebnis[x,7] > 1 then
begin
   h:=ergebnis[x,2];
   p:=0;
   // 2 haben wir schon, mit drei machen wir weiter:
   for i:=3 to 6 do If ergebnis[x,i] >h then p:=I;
   // Aussreißer gefunden? Dann...
   if p>0 then
      begin
   // Wir setzen den Ausreisser auf NUll
      Ergebnis[x,p]:=0;
   // und berechnen die Summen von Ergebnis neu:
      ergebnis[x,7]:=0;
      for I:=2 to 6 do ergebnis[x,7]:=ergebnis[x,7]+ergebnis[x,i];
      end;

Der neue vollständige Code liegt bei. Bitte Daten.txt auf C:\ speichern.

Delphi-Quellcode:

program ReadDaten;

{$APPTYPE CONSOLE}
uses math;
var f:textfile;
    Feldnamen:string;
    Daten:Array[1..1000,1..6] of real;
    Ergebnis:Array[1..1000,1..7] of real;
    x,i:integer;
    h:real;
    p:integer;
    Anzahl:integer;

function Runden(x: Extended; Stellen: Byte): Extended;
begin
Result:= Round(x * IntPower(10, Stellen))/IntPower(10, Stellen);
end;

begin

// DATEN in Array Daten einlese
assignfile(f,'C:\Daten.txt');
Reset(f);
readln(f,Feldnamen);
for X:=1 to 1000 do
    begin
    for i:=1 to 6 do
        begin
        read(f,daten[x,i]);
        end;
end;
closefile(f);


//Wir stellen sicher, dass keine 0 vorkommt und ersetzten diese durch 0.01;
for x:=1 to 1000 do
     begin
     for i:=1 to 6 do if daten[x,i]=0 then daten[x,i]:=0.01;
     end;


// Wir gehen alle Zeilen und Spalten in Muster durch und speichern das Ergebnis:
for x:=2 to 1000 do
    begin
    for i:=2 to 6 do
        begin
        // Wir dividieren durch die Anzahl der Daten, hier 5:
        Ergebnis[x,i]:=(daten[x,i]/daten[1,i])/5;
        //<Negative Ergebnisse bringen nicht das resultat, daher *-1
        if Ergebnis[x,i]< 0 then ergebnis[x,i]:=ergebnis[x,i]*-1;
        //Ursprünglich:
        {
        Ergebnis[x,i]:=(daten[x,i]/daten[1,i]);
        }

        end;//i..
    //Ergebnis von Spalte 2 bis 6 in 7 speichern:
    ergebnis[x,7]:=0;
    for I:=2 to 6 do ergebnis[x,7]:=ergebnis[x,7]+ergebnis[x,i];


// Wir prüfen, einen Aussreißer im Array Ergbnis[x,1.6] um zu sehen,
// ob 4 von 5 Werten unsere Bedingungen erfüllen.
if ergebnis[x,7] > 1 then
begin
   h:=ergebnis[x,2];
   p:=0;
   // 2 haben wir schon, mit drei machen wir weiter:
   for i:=3 to 6 do If ergebnis[x,i] >h then p:=I;
   // Aussreißer gefunden? Dann...
   if p>0 then
      begin
   // Wir setzen den Ausreisser auf NUll
      Ergebnis[x,p]:=0;
   // und berechnen die Summen von Ergebnis neu:
      ergebnis[x,7]:=0;
      for I:=2 to 6 do ergebnis[x,7]:=ergebnis[x,7]+ergebnis[x,i];
      end;
end;


end;//x..

//Kurze Anzeige aller Datensätze, die gefunden wurden:
Anzahl:=0;
for x:=2 to 1000 do if Ergebnis[x,7] <1 then inc(Anzahl);
writeln('Anzahl der aehnlichen Datensaetze: ',Anzahl:2);
writeln;

// Anzeige aller Datensätze, die die Bedingungen erfüllen:
writeln('Anzeige der gefundenen Datensätze');
for x:=2 to 1000 do
begin
// Die Ausgabe wird beschränkt:
if (ergebnis[x,7] < 1)  then
    begin
    writeln('Datensatz: ',x);
    for i:=2 to 6 do write(daten[1,i]:2:2,' ');writeln;
    for i:=2 to 6 do write(daten[x,i]:2:2,' ');writeln;
    for i:=2 to 6 do write(ergebnis[x,i]:2:2,' ');writeln;
    writeln('Ergebnis: ',ergebnis[x,7]:2:2);writeln;
    writeln('Taste');
    readln;
end;
end;

writeln('Ende - ENTER');
readln;

end.

Programmanzeige nauch "unten" verlagert.
Vorschläge, Verbesserungen?