MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 08.07.2011, 11:57   #1
ClaudeG
Neuer Benutzer
Neuer Benutzer
Standard VBA - Clustering Algorithms

Hallo,

Ich bin ein Neuling was VBA angeht, aber ich muss in Excel ein paar Beispiele präsentieren wo ich auch Clustering Algorithms, wie DBSCAN oder K-Means einsetzen muss.

Da ich aber mich nicht so mit der VBA-Programmierung vertraut bin, wollt ich mal fragen ob niemand von euch, ein Clustering Algorithms in VBA programmiert hat und mir in freundlicherweise zu Verfügung stellen könnte da ich auch noch zusätzlich unter Zeitdruck bin!

Vielen Dank für jegliche Hilfestellung !!!
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 12:23   #2
NoNet
MOF Koryphäe
MOF Koryphäe
Verwirrt Verständnisproblem

Hallo Claude,

das Problem wird hier im Forum wohl eher sein, dass es zahlreiche VBA-Spezialisten gibt, aber wohl kaum jemand die Begriffen DBSCAN und K-Means versteht. Zumindest mir geht das so...

Vielleicht solltest Du zum besseren Verständnis zunächst einmal etwas darüber schreiben ?

__________________

Gruß, NoNet


PS: Ein kurzes Feedback auf Antworten von Helfenden halte ich immer für angebracht - der Helfende freut sich darüber !
Übrigens : Hilfreiche und positive Beiträge kann man auch bewerten



TIPP : Für alle Excel-Interessierte...

http://www.exceltreffen.de/index.php?page=278
NoNet ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 12:33   #3
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Danke für die schnelle Anwort!

Also Dbscan wie auch K-means sind Clustering Algorithms die aus Daten, Gruppen ermittelen. In den jeweiligen Gruppen sind sich die Daten ähnlicher als in verschiedenen Gruppen!

Ich poste mal den Code von DBSCAN den ich habe, dieser ist leider in Matlab-Code geschrieben und nimmt als Input eine TXT-Datei sowie die Mindestzahl an Punkten die in soeinem Cluster/Gruppe sein müssen und eine EPS-Variable die angibt wie ähnlich die Daten sein müssen um in eine Gruppe zugehören!

Code:

function [class,type]=dbscan(x,k,Eps)

[m,n]=size(x);

if nargin<3 | isempty(Eps)
   [Eps]=epsilon(x,k);
end

x=[[1:m]' x];
[m,n]=size(x);
type=zeros(1,m);
no=1;
touched=zeros(m,1);

for i=1:m
    if touched(i)==0;
       ob=x(i,:);
       D=dist(ob(2:n),x(:,2:n));
       ind=find(D<=Eps);
    
       if length(ind)>1 & length(ind)=k+1; 
          type(i)=1;
          class(ind)=ones(length(ind),1)*max(no);
          
          while ~isempty(ind)
                ob=x(ind(1),:);
                touched(ind(1))=1;
                ind(1)=[];
                D=dist(ob(2:n),x(:,2:n));
                i1=find(D<=Eps);
     
                if length(i1)>1
                   class(i1)=no;
                   if length(i1)>=k+1;
                      type(ob(1))=1;
                   else
                      type(ob(1))=0;
                   end

                   for i=1:length(i1)
                       if touched(i1(i))==0
                          touched(i1(i))=1;
                          ind=[ind i1(i)];   
                          class(i1(i))=no;
                       end                    
                   end
                end
          end
          no=no+1; 
       end
   end
end

i1=find(class==0);
class(i1)=-1;
type(i1)=-1;


%...........................................
function [Eps]=epsilon(x,k)

% Function: [Eps]=epsilon(x,k)
%
% Aim: 
% Analytical way of estimating neighborhood radius for DBSCAN
%
% Input: 
% x - data matrix (m,n); m-objects, n-variables
% k - number of objects in a neighborhood of an object
% (minimal number of objects considered as a cluster)



[m,n]=size(x);

Eps=((prod(max(x)-min(x))*k*gamma(.5*n+1))/(m*sqrt(pi.^n))).^(1/n);


%............................................
function [D]=dist(i,x)

% function: [D]=dist(i,x)
%
% Aim: 
% Calculates the Euclidean distances between the i-th object and all objects in x	 
%								    
% Input: 
% i - an object (1,n)
% x - data matrix (m,n); m-objects, n-variables	    
%                                                                 
% Output: 
% D - Euclidean distance (m,1)



[m,n]=size(x);
D=sqrt(sum((((ones(m,1)*i)-x).^2)'));

if n==1
   D=abs((ones(m,1)*i-x))';
end
Diesen Code wollte ich im Grunde umwandeln habe aber leider grosse Problem, naturlich wollte ich anstelle einer Txt-Datei, eine Tabelle aus der Excell-Sheet benutzen!
Wäre froh wenn einer mir bei dieser Umwandlung behilfreich sein könnte!

Vielen Dank
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 13:01   #4
ransi
MOF Koryphäe
MOF Koryphäe
Standard

HAllo Claude

Der k-means ist nicht schwer.(Glaube ich....)
Den kann ich nachvollziehen.
Ich bastel mal ne Beispielmappe.

ransi
ransi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 13:06   #5
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Ransi,

Ich wäre dir sehr dankbar wenn du mir so eine Beispiel-Mappe basteln könntest und ich sie somit für meine Beispiele benutzen resp. nur geringfügig ändern müsste!

Danke im Voraus
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 15:14   #6
ransi
MOF Koryphäe
MOF Koryphäe
Standard

HAllo Claude

Schau dir das mal an.
Ich hab mich da an WIKI gehalten...
Das müsste es schon fast sein.

ransi
Angehängte Dateien
Dateityp: xls k_Means.xls (118,5 KB, 59x aufgerufen)
ransi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 15:37   #7
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Vielen Dank für diese Beispielmappe,

Habe nun noch eine Frage, du hast die Mappe ja für dein eine 2-dimensonale Tabelle angelegt und drei Cluster(Startpunkte) angegeben, also so weit ich deinen Code verstanden habe hast du die Startpunkte zufällig ausgefällt.
Was mich jetzt noch interessiert, wie kann man eine Tabelle, die aus mehreren Dimensionen besteht, benutzen?

Muss man die dann alle per Hand so wie du es mit der 2-dimensionalen tabelle gemacht hast angeben also die weiteren Dimensionen?
Wenn ich jetzt 5, oder 6 Startpunkte angeben möchte, gebe ich die dann einfach an und ändere deinen "startpunkt array" sowie die einträge für diesen array?

Hinzu kommt wie muss ich dann die "Select Case" ändern wenn mehere Starpunkte gesetzt wären?

Letzte Frage noch, bei deinen Code verstehe ich folgende Aussage nicht:
Code:

S = get_Distance(arr(L, 1), startPunkte(I)(1, 1), arr(L, 2), startPunkte(I)(1, 2))
also darin verstehe ich folgendes nicht : startPunkte(I)(1,1) respektive startPunkte(I)(1,2), was bedeuten die zweite Klamer mit (1,1) oder (1,2)?

Nochmals vielen Dank und ich hoffe dass ich dir nicht zu sehr auf die Nerven gehe mit meinem Problem und meinen Fragen
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 15:57   #8
ransi
MOF Koryphäe
MOF Koryphäe
Standard

HAllo

Zitat:

wie kann man eine Tabelle, die aus mehreren Dimensionen besteht,...

Bin nur ein kleiner dummer Schlosser, daher übersteigt sowas meine Vorstellungskraft ;-)
Eine Tabelle hat Zeilen und Spalten.
Wo wär da noch Platz für andere Dimensionen?

Zitat:

Wenn ich jetzt 5, oder 6 Startpunkte angeben möchte, gebe ich die dann einfach an und ändere deinen "startpunkt array" sowie die einträge für diesen array?

Ja, genauso müsste das dann laufen.
Allerdings müsstest du dann noch hier:
Range("C3:H2000").ClearContents 'Aufräumen


und hier:
For I = 1 To 3

und hier:

Select Case T '"Jedes Objekt wird demjenigen Cluster zugeordnet, dessen Schwerpunkt ihm am nächsten liegt. "
    Case 1
        Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = arr(L, 1)
        Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = arr(L, 2)
    Case 2
        Range("E" & Rows.Count).End(xlUp).Offset(1, 0) = arr(L, 1)
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0) = arr(L, 2)
    Case 3
        Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = arr(L, 1)
        Range("H" & Rows.Count).End(xlUp).Offset(1, 0) = arr(L, 2)
    Case 4
        
        
    Case 5
        
        
    Case 6
        
        
End Select


und hier:
'"Für jeden Cluster wird der Schwerpunkt neu berechnet, sodass dieser in der Mitte des Clusters liegt.
Range("C2").Value = CDbl(WorksheetFunction.Average(Range(Range("C3"), Range("C3").End(xlDown)))) 'Mittelwerte der x-Werte startpunkte(1)
Range("D2").Value = CDbl(WorksheetFunction.Average(Range(Range("D3"), Range("D3").End(xlDown)))) 'Mittelwerte der y-Werte startpunkte(1)
Range("E2").Value = CDbl(WorksheetFunction.Average(Range(Range("E3"), Range("E3").End(xlDown)))) 'Mittelwerte der x-Werte startpunkte(2)
Range("F2").Value = CDbl(WorksheetFunction.Average(Range(Range("F3"), Range("F3").End(xlDown)))) 'Mittelwerte der y-Werte startpunkte(1)
Range("G2").Value = CDbl(WorksheetFunction.Average(Range(Range("G3"), Range("G3").End(xlDown)))) 'Mittelwerte der x-Werte startpunkte(3)
Range("H2").Value = CDbl(WorksheetFunction.Average(Range(Range("H3"), Range("H3").End(xlDown)))) 'Mittelwerte der y-Werte startpunkte(3)
'usw.

Anpassungsarbeit leisten.

All das geht noch relativ einfach.
Wenn man das Diagramm dann aber noch auf die geänderteten Bedingungen einstellen soll wirds spannend..



startPunkte(1) = Range("C2:D2") 'Startpunkte festlegen

ist ein Array.
Eine Zeile hoch und 2 Spalten breit.

Für I=1:
startPunkte(I)(1, 1) ist also der erste Wert aus dem Array startPunkte(1). Also Range("C1")
(1,1) = 1 te Zeile, 1 te Spalte
startPunkte(I)(1, 2) ist also der zweite Wert aus dem Array startPunkte(1). Also Range("D1")
(1,2) = 1 te Zeile, 2 te Spalte



ransi

Geändert von ransi (08.07.2011 um 16:00 Uhr).
ransi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 16:11   #9
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Nein so war das jetzt nicht mit den Dimensionen gedacht, aber du hast in deinem Beispiel eine Tabelle mit 2000 Zeilen und 2 Spalten, was muss man nun ändern wenn die Tabelle aber mehere Spalten hat also man einen Tabelle hat die anstatt:

1 2
3 4
5 6

eher so aus sieht gegebenfalls noch mehr Spalten hat:

1 2 3
4 5 6
7 8 9
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 16:28   #10
ransi
MOF Koryphäe
MOF Koryphäe
Standard

HAllo Claude

Aus Wikipedia:

Zitat:

'"Dazu muss eine Distanzfunktion, ..., verwendet werden."

Kernstück des Codes ist genau diese Distanzfunktion.
Ich hab den guten alten Phytagoras bemüht.

Public Function get_Distance(x1, x2, y1, y2)
'"Dazu muss eine Distanzfunktion, ..., verwendet werden."
'A² + B² = C²
get_Distance = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function



Meine Daten bestehen aus Punkten.
Die haben einen x-Wert und einen y-Wert.
Damit kann man (ich) rechnen.

Eine dritte Dimension könnte ich mir zur Not auch noch vorstellen.
x,y,z
DAnn würde das Ganze sich im Raum abspielen und nicht auf einer Fläche.
Eine Distanzfunktion die den Abstand zwischen 2 Punkten im Raum berechnet ließe sich auch noch schreiben.

Zitat:

Tabelle....gegebenfalls noch mehr Spalten hat:

Da muss ich passen.

Gib uns doch mal eine Beispieltabelle.

ransi
ransi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 16:40   #11
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Also erstmals vielen dank dass du soviel Geduld mit mir hast!

Also habe nun mal eine Tabelle gebastelt wo 3 Spalten/Zeilen vorkommen:

176.6 115 17450
175 72 18344
202 123 31600
162.4 69 8249
186.7 95 16900
171.7 68 9495
197 182 36880
199.6 176 32250
166.5 67 8545


Habe auch dafür die Distanzfunktion geändernt indem ich folgendes tat:
Code:

get_Distance = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2)
Zusätzlich rufe ich den array arr nun so auf:
Code:

arr = Range("A2:C9")
Hoffen das ist mal richtig?

Nun habe ich aber noch eine Frage zu der Grafik wie integrist du die Grafik und wie wird diese zu dem VBA-Programm verbunden dass die Punkten dargestellt werden.

Dann kann ich auch mal versuchen die Daten mit der Grafik zu visualisieren oder villeicht kanns du mir sagen (glaube das wäre ein einfacher Weg) wie ich herausbekomme welche Zeile zu welchen Cluster gehört und dann eine Tabelle erstellen wo die Daten zu den dazugehörigen Cluster/Gruppen angezeigt werden?

Vielen Dank
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2011, 17:03   #12
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Also ich sende dir mal meine Test-Version wo ich deine Mappe benutzt habe um mein vergrössertes Beispill also jetz nicht mit Punkten aber mehere Spalten zu benutzen.

Wie es scheint funktioniert das ganze, wollt nur fragen ob das der richtige Weg ist und ich so es erweitern kann wie ich es möchte?

Vielen Dank
Angehängte Dateien
Dateityp: xlsm k_means_test.xlsm (20,9 KB, 38x aufgerufen)
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.07.2011, 13:39   #13
ransi
MOF Koryphäe
MOF Koryphäe
Standard

HAllo Claude

Das sieht doch gut aus.
Ich denke das kann so bleiben.

Hab mich mal am DBSCAN versucht.
Es werden Cluster, Randpunkte und Rauschen erkannt und in einem Diagramm angezeigt.

Schau es dir mal an:

ransi
Angehängte Dateien
Dateityp: xls DBSCAN.xls (162,0 KB, 50x aufgerufen)
ransi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.07.2011, 11:38   #14
ClaudeG
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Danke,

Habe nun noch zwei Fragen die nicht direkt mit diesen Algorithmen zu tun haben!

1. Wie kann man das Erbegnis auf eine anderes Tabellenblatt schreiben lassen?
2. Oder besser wäre kann man einfach die verschiedenen Daten mit verschiedenen Farben untermalen um anzuzeigen in welcher Gruppe sie sich befinden und dafür auch wenn ich mich jetzt auf K-Means besiehe die Startpoint in der entsprechenden Farbe markieren?

Aber nochmals vielen Dank für deine Hilfe!
ClaudeG ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.07.2011, 12:24   #15
ransi
MOF Koryphäe
MOF Koryphäe
Standard

Hallo

Für den k-Means:
Das Diagramm hat 6 Datenreihen.
Für jeden Startpunkt eine.--> Macht 3
Für jeden Cluster eine.--> Macht wieder 3 ;-)

Lass den Code mal durchlaufen.
Jetzt im Diagramm einen Rechtsclick auf die Datenreihe die du formatieren möchtest-->Datenreihen formatieren

Die Daten kannst du ganz einfach in ein anderes Blatt wegschreiben.
Musst du im Code nur angeben.

Bsp:

Zitat:

With Sheets("Tabelle2")
..Range("A1")=irgendwas
end with

Wichtig ist der Punkt vor Range.

Wenn du das gemacht hast, musst du dem Diagramm aber noch sagen das die Daten jetzt woanders sind.

Rechte MAus aufs Diagramm:
Daten auswählen...
Jetzt die Datenreihen einzeln durchgehen.
-->Datenreihen 1-->Bearbeiten-->In dem Dialog die Bezüge anpassen.
-->Datenreihen 2-->Bearbeiten-->In dem Dialog die Bezüge anpassen.
usw.

Habs mal für den k_Means gemacht.
Im Anhang auch noch der optimierte DBSCAN.

ransi
Angehängte Dateien
Dateityp: zip DBSCAN_v2.zip (133,3 KB, 44x aufgerufen)

Geändert von ransi (13.07.2011 um 12:58 Uhr).
ransi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 23:03 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.