Re: AW: Numerischer Fehler

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Hallo Stefan

> um zu verstehen was da genau abgeht

diese Variante ist ÃŒbersichtlicher

In[3]:= Clear[fuhrerIdentify, partEuclid, workS]
partEuclid[v1_?VectorQ, v2_?VectorQ] :=
   Norm[Most[v1] - Most[v2]] /; Length[v1] == Length[v2]
workS[{v_?VectorQ, s_?NumericQ, w_?MatrixQ, t_Integer}] :=
   Block[{x = Nearest[w, w[[1]], t, DistanceFunction -> partEuclid]},
    {(* First[x] === w[[1]] *)
     v /. Thread[
       Rule[Last /@ Rest[x], Table[Last[x[[1]]], {Length[x] - 1}]]],
     Max[s, partEuclid[x[[-1]], x[[1]]]], Complement[w, x], t
     }
    ]
fuhrerIdentify::tuples =
    "Parameter t = `1`, but only `2` elements present!";
fuhrerIdentify::mod =
    "You can not identify exactly `1`-tuples from the data!";
fuhrerIdentify::res =
    "There will be `1` `2`-tuple(s) and one `3`-tuple in the result.";
fuhrerIdentify[d_ (* data *),
    t_Integer?Positive (* tuple size *),
    verB_: False (* verbose *)] :=
   Module[{r = Flatten[d, 1], rL = 0, rR = {}, t0 = t, rt, rI = {}},
     (* prepare *)
     rL = Length[r]; rR = Range[rL];
     r = Flatten /@ Transpose[{r, rR}];
     (* check *)
     If[t > rL,
      Message[fuhrerIdentify::tuples, t, rL];
      t0 = rL
      ];
     If[Mod[rL, t0] != 0,
      Message[fuhrerIdentify::mod, t0];
      Message[fuhrerIdentify::res, Floor[rL/t0], t0, Mod[rL, t0]]
      ];
     (* work *)
     {rI, rt} =
      If[t0 > 1,
       Take[Nest[workS, {rR, 0, r, t0}, Ceiling[rL/t0]], 2], {rR, 0}];
     (* report *)
     If[TrueQ[verB],
      Print["TrennschÀrfe = ", rt];
      Print["Identifications: ", Rule @@@ Transpose[{rR, rI}]]
      ];
     Partition[Most /@ (Part[r, #] & /@ rI), Most[Rest[Dimensions[d]]]]
     ] /; ArrayQ[d, _, NumericQ] && ArrayDepth[d] > 1

der Algorithmus (in workS[]) ist derselbe, aber die Ersetzungen werden
zunÀchst in der Indexmenge vorgenommen; erst am Schluss wird die Indexmenge
zur Erstellung der Ergebnismenge verwendet. Weiterhin ist es interessant,
etwa

In[29]:= fuhrerIdentify[data, 3, True];

TrennschÀrfe = 0.24858

Identifications:
{1->1,2->33,3->27,4->36,5->11,6->38,7->9,8->33,9->9,10->38,11->11,
12->36,13->13,14->13,15->15,16->15,17->17,18->17,19->19,20->19,21->21,22->21,23->24,
24->24,25->46,26->45,27->27,28->45,29->29,30->29,31->31,32->31,33->33,34->9,35->27,
36->36,37->11,38->38,39->19,40->17,41->15,42->31,43->13,44->21,45->45,46->46,47->72,
48->46,49->63,50->29,51->63,52->64,53->1,54->1,55->24,56->56,57->72,58->69,59->59,
60->59,61->56,62->56,63->63,64->64,65->66,66->66,67->66,68->59,69->69,70->64,71->69,
72->72}

mit

In[28]:= Thread[
   Rule[Range[Length[#]], ClusteringComponents[#, 72/3, 1]] &[
    Flatten[data, 1]]]

Out[28]= {1 -> 1, 2 -> 2, 3 -> 3, 4 -> 4, 5 -> 5, 6 -> 6, 7 -> 2,
   8 -> 2, 9 -> 7, 10 -> 6, 11 -> 8, 12 -> 4, 13 -> 9, 14 -> 9,
   15 -> 10, 16 -> 10, 17 -> 11, 18 -> 12, 19 -> 10, 20 -> 11, 21 -> 12,
    22 -> 9, 23 -> 13, 24 -> 9, 25 -> 14, 26 -> 15, 27 -> 3, 28 -> 15,
   29 -> 16, 30 -> 17, 31 -> 17, 32 -> 10, 33 -> 2, 34 -> 7, 35 -> 3,
   36 -> 3, 37 -> 8, 38 -> 5, 39 -> 11, 40 -> 11, 41 -> 10, 42 -> 10,
   43 -> 9, 44 -> 9, 45 -> 18, 46 -> 19, 47 -> 19, 48 -> 19, 49 -> 20,
   50 -> 16, 51 -> 20, 52 -> 20, 53 -> 1, 54 -> 1, 55 -> 13, 56 -> 13,
   57 -> 19, 58 -> 21, 59 -> 1, 60 -> 22, 61 -> 13, 62 -> 23, 63 -> 20,
   64 -> 24, 65 -> 23, 66 -> 23, 67 -> 23, 68 -> 22, 69 -> 21, 70 -> 24,
    71 -> 21, 72 -> 21}

zu vergleichen. fuhrerIdentify[] sieht die Punkte 29, 30 und 50 im selben
Cluster (sie werden mit Punkt 29 identifiziert), dagegen sieht
ClusteringComponents[] die Punkte 29 und 50 im Cluster 16, den Punkt 30
jedoch im Cluster 17.

Sie könnten auf die Verwendung von workS[] verzichten und
die Indexmenge mit Hilfe von ClusteringComponents[] herstellen, derart,
dass alle Punkte im selben Cluster auf einen Punkt aus diesem Cluster
abgebildet werden.

Gruss
Udo.




Gruss
Udo.