AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Sonstige Fragen zu Delphi Delphi Prozentuale Ähnlichkeit (Mustererkennung)
Thema durchsuchen
Ansicht
Themen-Optionen

Prozentuale Ähnlichkeit (Mustererkennung)

Ein Thema von Go2EITS · begonnen am 8. Okt 2007 · letzter Beitrag vom 16. Okt 2007
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:22 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz