Einzelnen Beitrag anzeigen

Go2EITS

Registriert seit: 25. Jun 2006
519 Beiträge
 
Delphi 7 Personal
 
#16

Re: Prozentuale Ähnlichkeit (Mustererkennung)

  Alt 16. Okt 2007, 07:47
Hallo Stahli,

Deine Zahlen kommen meinen Werten am nächsten:
Patient, Alter, Blutdruck, Insolin
1, 35, 120, 3.8
2, 40, 130, 3.5

Wenn man dem noch Attribute wie "sehr gesund", "gesund", "noch gesund", "behandlungsbedürftig", "krank", "akut", beifügt, so kann man bei neuen Datensätzen aus den vorliegenden Datensätzen wohl eine gute Übersicht bekommen, was aus der Datenbank für Antworten kommen. Vielleicht erscheinen bei einer Eingabe eines Datensatzes dann folgende Antworten:
4 mit "sehr gesund" und 3 Datensätze mit "gesund"

Hier meine erste Überarbeitung mit einer Übersicht der der zwei Berechnungen, wobei ich als Schwellen nachfolgende Werte gesetzt habe:
Schelle Abstand =1
und
Schwelle Sqr =0.5

Im Programm wie folgt deklariert:
//Schwellen festlegen:
Schwelle1:=1;
Schwelle2:=0.5;

Inwieweit die Berechnungen ähnliche Datensätze findet und ob die Datenbank sinnvolle Datensätze beinhaltet, wird sich zeigen.
Bei meinem Beispiel zeigt sich, das an der 5 Positon der Datensätze in der ersten Berechnung sich die meisten Ausreißer (17 Zahlen) befinden.
Wenn ich diese ignoriere, erscheinen diese Datensätze als ähnlich. Ich werde diese Berechung mit den Ausreißern auslagern müssen und separat anzeigen.
Als nächstes suche ich eine Datenbank mit Patientendaten oder Sonnenfleckenprognose oder so ähnlich. Falls jemand einen Link zu einem Datensatz hat, bitte hier posten.

Hier mein Delphicode, basierend auf die Datensätze der ersten Datenbank:
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;
    Genullt:Array[1..7] of integer;
    // Array für die Ergebnisse unserer Berechnung mit Fehlerquadraten und Wurzelziehen
    SqrArray:Array[1..1000,1..7] of Real;

    // Schwelle für die 1. Berechnung:
    Schwelle1:Real;
    // Schwelle für die 2. berechnung:
    Schwelle2:Real;

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

// Nullen wird nur für die Berechung des Abstandes verwendet.
Procedure NullenAnzeigen;
Var x,i:integer;
begin
//Kurze Anzeige der Spalte bei den Datensätzen, die die Bedingung
// Ergebnis[x,7] <1 erfüllen, um zu sehen, ob eine Spalte zum Ergenis nicht beiträgt.
for i:=1 to 7 do Genullt[i]:=0;
for x:=2 to 1000 do
begin
   if ergebnis[x,7] <=Schwelle1 then
   begin
   for i:=1 to 7 do
       begin
        if Ergebnis[x,i] =0.00 then
           begin
           inc(Genullt[i]);
           end;//Ergebnis..
       end;//i..
end;
end;//x..
writeln('Genullt:');
for i:=2 to 6 do write(genullt[i],' ');writeln;writeln;
end;

Function ErgebnisAbstand:integer;
begin
Anzahl:=0;
for x:=2 to 1000 do if Ergebnis[x,7] <=Schwelle1 then inc(Anzahl);
result:=anzahl;
end;

Function ErgebnisSqr:integer;
begin
Anzahl:=0;
for x:=2 to 1000 do if SqrArray[x,7] <=Schwelle2 then inc(Anzahl);
result:=anzahl;
end;

Procedure AnzeigeBerechnung1;
begin
writeln;
writeln('Ergebnisse der Berechnung (Berechnung 1) nach Abstand:');
writeln('Datensatz');
write('Zeile 1: ');for i:=2 to 6 do write(daten[1,i]:2:2,' ');writeln('hat Aehnlichkeit mit:');writeln;
for x:=2 to 1000 do
    begin
    if (ergebnis[x,7] <= Schwelle1) then
       begin
        write('Zeile ',x,': ');for i:=2 to 6 do write(daten[x,i]:2:2,' ');Write('Summe Durchschnitt: ',ergebnis[x,7]:2:2);writeln;
// Falls wir die Berechnung auch sehen wollen:
// write('Ergebnis: ');for i:=2 to 6 do write(Ergebnis[x,i]:2:2,' ');
// writeln('Taste');readln;
      end;
    end;
end;

procedure AnzeigeBerechnung2;
Var x,i:integer;
begin
writeln;
writeln('Ergebnisse der Berechnung (Berechnung 2) nach Fehlerquadrat und Wurzel:');
writeln('Datensatz');
write('Zeile 1: ');for i:=2 to 6 do write(daten[1,i]:2:2,' ');writeln('hat Aehnlichkeit mit:');
for x:=2 to 1000 do
begin
if (SqrArray[x,7] <= Schwelle2) then
    begin
    write('Zeile ',x,': ');for i:=2 to 6 do write(daten[x,i]:2:2,' ');write('Summe Durchschnitt: ',SqrArray[x,7]:2:2);writeln;
// Falls wir die Berechnung auch sehen wollen:
// for i:=2 to 6 do write(SqrArray[x,i]:2:2,' ');writeln;
// ;writeln;
// writeln('Taste');readln;
    end;

end;
end;

Procedure Berechnung;
VAr x,i:integer;
begin
//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;

for x:=2 to 1000 do
    begin
    for i:=2 to 6 do
        begin
        // 1. Berechnung
        // Wir dividieren durch die Anzahl der Daten:
        Ergebnis[x,i]:=(daten[x,i]/daten[1,i]);
        //Negative Ergebnisse bringen nicht das Resultat, daher *-1
        if Ergebnis[x,i]< 0 then ergebnis[x,i]:=ergebnis[x,i]*-1;

        //2. Berechnung: Fehlerquadrat und Wurzelziehen.
        //abweichung2 := abweichung2+ SQR((B.value[i]-A.value[i])/A.Value[i]);
        //result := SQRT(abweichung2);
        sqrArray[x,i]:=0;
        sqrArray[x,i]:=sqrArray[x,i]+(SQR((Daten[x,i]-Daten[x,1]) / Daten[x,1]));
        sqrArray[x,i]:=Sqrt(sqrArray[x,i]);
        end;//i..

    //1.Berechnung: 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]/5;

    //2. Berechnung: Ergebnis vom Fehlerquadrat und Wurzelziehen:
    SqrArray[x,7]:=0;
    for I:=2 to 6 do SqrArray[x,7]:=SqrArray[x,7]+SqrArray[x,i]/5;

//Ergänzung zur ersten Berechnung
   // Wir prüfen auf einen Ausreißer im Array Ergebnis[x,2..6], um zu sehen,
   // ob 4 von 5 Werten unsere Bedingungen erfüllen.
   if ergebnis[x,7] > Schwelle1 then
   begin
   p:=0;
   h:=Schwelle1;
   for i:=2 to 6 do
       If ergebnis[x,i] >h then
       begin
       p:=I;
       h:=ergebnis[x,i];
       end;
       // Ausreiß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];
   // und setzen den Durchschnitt:
      ergebnis[x,7]:=ergebnis[x,7]/4;
      end;
   end;
end;

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);
//Schwellen festlegen:
Schwelle1:=1;
Schwelle2:=0.5;

// Berechnung von
// a) Abstand
// b) Fehlerquadrat
Berechnung;

ErgebnisAbstand;
ErgebnisSQR;

//Kurze Anzeige aller Datensätze, die gefunden wurden:
writeln('Anzahl der aehnlichen Datensaetze Berechnung 1: ',ErgebnisAbstand);
writeln('Anzahl der aehnlichen Datensaetze Berechnung 2: ',ErgebnisSqr);
writeln;
writeln('Weiter - ENTER');readln;

//Anzeige, wie oft Ausreisser zur Berechnung "genullt" wurden.
NullenAnzeigen;

AnzeigeBerechnung1;
AnzeigeBerechnung2;

writeln('Ende - ENTER');
readln;

end.
Das Ergebnis sollte ich wohl auch mal hier einfügen:
Berechnung 1: 29 (Abstand ohne Aussreißer)
Berechnung 2: 6 (Fehlerquadrat und Wuzelziehen)
  Mit Zitat antworten Zitat