2016-05-13 9 views
5

I einen Datenrahmen von Punkten haben, die Auftragung von zwei Polygonen umreißt, ein rechtwinklig zu dem anderen, etwa so:Rotate aufgetragen Punkte erneut Projekt relativ zu einem anderen Satz von Punkten

enter image description here

hier sind die Daten, die diese Handlung machen:

outlines <- 
    structure(list(sample_ids = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L), class = "factor", .Label = "MA15B1-1-5-C21"), 
    pseudolandmark = structure(1:205, .Label = c("C000-000", 
    "C000-001", "C000-002", "C000-003", "C000-004", "C000-005", 
    "C000-006", "C000-007", "C000-008", "C000-009", "C000-010", 
    "C000-011", "C000-012", "C000-013", "C000-014", "C000-015", 
    "C000-016", "C000-017", "C000-018", "C000-019", "C000-020", 
    "C000-021", "C000-022", "C000-023", "C000-024", "C000-025", 
    "C000-026", "C000-027", "C000-028", "C000-029", "C000-030", 
    "C000-031", "C000-032", "C000-033", "C000-034", "C000-035", 
    "C000-036", "C000-037", "C000-038", "C000-039", "C000-040", 
    "C001-000", "C001-001", "C001-002", "C001-003", "C001-004", 
    "C001-005", "C001-006", "C001-007", "C001-008", "C001-009", 
    "C001-010", "C001-011", "C001-012", "C001-013", "C001-014", 
    "C001-015", "C001-016", "C001-017", "C001-018", "C001-019", 
    "C001-020", "C001-021", "C001-022", "C001-023", "C001-024", 
    "C001-025", "C001-026", "C001-027", "C001-028", "C001-029", 
    "C001-030", "C001-031", "C001-032", "C001-033", "C001-034", 
    "C001-035", "C001-036", "C001-037", "C001-038", "C001-039", 
    "C001-040", "C002-000", "C002-001", "C002-002", "C002-003", 
    "C002-004", "C002-005", "C002-006", "C002-007", "C002-008", 
    "C002-009", "C002-010", "C002-011", "C002-012", "C002-013", 
    "C002-014", "C002-015", "C002-016", "C002-017", "C002-018", 
    "C002-019", "C002-020", "C002-021", "C002-022", "C002-023", 
    "C002-024", "C002-025", "C002-026", "C002-027", "C002-028", 
    "C002-029", "C002-030", "C002-031", "C002-032", "C002-033", 
    "C002-034", "C002-035", "C002-036", "C002-037", "C002-038", 
    "C002-039", "C002-040", "C003-000", "C003-001", "C003-002", 
    "C003-003", "C003-004", "C003-005", "C003-006", "C003-007", 
    "C003-008", "C003-009", "C003-010", "C003-011", "C003-012", 
    "C003-013", "C003-014", "C003-015", "C003-016", "C003-017", 
    "C003-018", "C003-019", "C003-020", "C003-021", "C003-022", 
    "C003-023", "C003-024", "C003-025", "C003-026", "C003-027", 
    "C003-028", "C003-029", "C003-030", "C003-031", "C003-032", 
    "C003-033", "C003-034", "C003-035", "C003-036", "C003-037", 
    "C003-038", "C003-039", "C003-040", "C004-000", "C004-001", 
    "C004-002", "C004-003", "C004-004", "C004-005", "C004-006", 
    "C004-007", "C004-008", "C004-009", "C004-010", "C004-011", 
    "C004-012", "C004-013", "C004-014", "C004-015", "C004-016", 
    "C004-017", "C004-018", "C004-019", "C004-020", "C004-021", 
    "C004-022", "C004-023", "C004-024", "C004-025", "C004-026", 
    "C004-027", "C004-028", "C004-029", "C004-030", "C004-031", 
    "C004-032", "C004-033", "C004-034", "C004-035", "C004-036", 
    "C004-037", "C004-038", "C004-039", "C004-040"), class = "factor"), 
    x = c(12.016122, 11.541907, 11.038835, 10.502722, 9.9116697, 
    9.2927132, 8.7031393, 8.2882128, 7.7682838, 7.4592881, 7.1727204, 
    6.882329, 6.5730295, 6.2629328, 5.974225, 5.6768575, 5.3772326, 
    5.0374117, 4.6981254, 4.3568606, 4.0674963, 3.7128081, 3.3609159, 
    3.0815868, 2.6982265, 2.3401613, 2.1256597, 1.6268489, 1.1917412, 
    1.0033085, 0.88194823, 0.7922346, 0.65476406, 0.388096, 0.21852912, 
    -0.060025979, -0.25463527, -0.43339792, -0.67199445, -0.74821764, 
    -1.0261612, -1.0261612, -0.92627585, -0.61627114, -0.26953429, 
    0.025590658, 0.22602104, 0.49005115, 0.77080095, 1.0086451, 
    1.2377149, 1.486245, 1.7201869, 1.973778, 2.2724597, 2.5824413, 
    2.964093, 3.2498548, 3.5646105, 3.9470801, 4.323751, 4.7156439, 
    5.1217055, 5.4455066, 5.72192, 6.0532079, 6.4232531, 6.8666763, 
    7.2917495, 7.7359419, 8.1826134, 8.6566973, 9.1541157, 9.6898823, 
    10.248864, 10.848221, 11.471651, 12.131388, 12.808134, 13.460155, 
    14.156513, 14.82901, 14.82901, 15.673672, 16.729141, 17.791584, 
    18.740608, 19.599586, 20.401081, 21.159971, 21.838057, 22.454126, 
    22.9597, 23.358027, 23.555031, 23.598192, 23.432957, 23.228603, 
    23.358398, 23.26931, 23.070007, 22.818201, 22.594666, 22.324627, 
    22.001938, 21.619722, 21.251596, 20.906891, 20.514589, 20.084562, 
    19.653286, 19.200079, 18.76742, 18.308954, 17.817726, 17.29768, 
    16.733225, 16.100943, 15.422856, 14.715117, 13.926449, 13.005936, 
    12.016122, -13.766603, -13.935621, -14.166668, -14.608814, 
    -14.919644, -14.839896, -12.870626, -10.359905, -5.3109751, 
    1.5327182, 5.367815, 8.0128088, 10.083024, 11.875553, 13.479352, 
    15.080202, 16.57955, 18.080011, 19.587444, 21.106117, 22.594666, 
    24.057869, 25.619652, 27.149252, 28.715357, 30.36421, 32.024361, 
    33.747543, 35.465405, 37.282791, 39.083374, 40.917885, 42.782429, 
    44.547249, 46.517342, 48.3228, 50.025127, 51.226521, 51.79425, 
    51.81292, 51.350864, 51.350864, 50.712288, 49.727493, 48.188499, 
    46.295891, 43.634846, 39.408772, 34.239418, 29.100199, 24.750076, 
    20.78437, 17.448862, 14.623836, 12.187436, 10.035782, 8.1002054, 
    6.2869821, 4.5976009, 2.9719067, 1.4258807, -0.022152033, 
    -1.4664655, -2.8909578, -4.3156242, -5.6212177, -7.0099473, 
    -8.3390236, -9.6840572, -10.756982, -11.072048, -11.078612, 
    -11.288648, -11.518431, -11.715311, -12.164374, -12.689521, 
    -12.874741, -12.984236, -13.186749, -13.325057, -13.766603 
    ), y = c(-29.035833, -29.341286, -29.524191, -29.617352, 
    -29.582525, -29.559042, -29.727335, -30.435453, -30.877647, 
    -31.823519, -32.774418, -33.682446, -34.534527, -35.375267, 
    -36.243355, -37.097054, -37.951897, -38.769203, -39.605328, 
    -40.459553, -41.383324, -42.267879, -43.180614, -44.17408, 
    -45.114273, -46.101246, -47.206028, -48.160709, -49.188194, 
    -50.379581, -51.624416, -52.90226, -54.175545, -55.411297, 
    -56.715446, -57.996536, -59.338886, -60.712456, -62.08672, 
    -63.551258, -64.960548, -64.960548, -66.095848, -67.283829, 
    -68.451477, -69.582626, -70.686172, -71.78344, -72.867096, 
    -73.942451, -75.013359, -76.076859, -77.141106, -78.198891, 
    -79.238411, -80.269211, -81.259293, -82.296562, -83.31955, 
    -84.296532, -85.274673, -86.239151, -87.189964, -88.227707, 
    -89.338547, -90.414749, -91.467842, -92.440331, -93.458946, 
    -94.472794, -95.514389, -96.540703, -97.558075, -98.525612, 
    -99.472214, -100.33396, -101.13947, -101.80611, -102.3606, 
    -103.02946, -103.25335, -103.3634, -103.3634, -103.23396, 
    -101.97776, -99.767479, -97.053017, -94.317451, -91.671646, 
    -89.110168, -86.560768, -84.055862, -81.558327, -79.093147, 
    -76.637794, -74.252075, -71.948479, -69.772507, -67.696037, 
    -65.677223, -63.73584, -61.868732, -60.046165, -58.283794, 
    -56.586216, -54.961853, -53.364918, -51.774773, -50.241127, 
    -48.760128, -47.291809, -45.853298, -44.371704, -42.896107, 
    -41.429131, -39.946079, -38.466869, -37.086483, -35.756569, 
    -34.21907, -32.492996, -30.540468, -29.035833, -64.279663, 
    -64.431847, -64.572395, -64.716911, -64.756622, -64.598656, 
    -63.945881, -63.02924, -61.699482, -60.840389, -60.469181, 
    -60.270256, -60.174934, -60.11552, -60.097019, -60.055656, 
    -60.050323, -60.042873, -60.036118, -60.031452, -60.046165, 
    -60.07896, -60.085617, -60.114563, -60.141598, -60.151379, 
    -60.169483, -60.178539, -60.202236, -60.205612, -60.228111, 
    -60.25304, -60.282089, -60.357517, -60.381199, -60.472359, 
    -60.610611, -60.919216, -61.434845, -62.125805, -62.965706, 
    -62.965706, -62.721577, -62.7005, -62.964176, -63.475807, 
    -64.327568, -65.531982, -66.759201, -67.726349, -68.583122, 
    -69.032181, -69.287346, -69.39106, -69.402908, -69.362747, 
    -69.289207, -69.224113, -69.148056, -69.087257, -69.023453, 
    -68.941978, -68.890068, -68.853645, -68.838669, -68.784042, 
    -68.784935, -68.770088, -68.771759, -68.66272, -68.247192, 
    -67.730736, -67.32209, -66.940979, -66.564262, -66.290703, 
    -66.0466, -65.689575, -65.31218, -64.962807, -64.588394, 
    -64.279663), z = c(-11.640717, -12.212139, -12.790169, -13.404076, 
    -14.090126, -14.849237, -15.624723, -16.223763, -16.94533, 
    -17.385506, -17.770006, -18.141287, -18.529652, -18.912949, 
    -19.258121, -19.616081, -19.978848, -20.412086, -20.848568, 
    -21.292707, -21.653788, -22.129126, -22.603168, -22.961033, 
    -23.492054, -23.98238, -24.24798, -24.95643, -25.557547, 
    -25.78834, -25.931046, -26.042557, -26.233328, -26.602404, 
    -26.848875, -27.232805, -27.515375, -27.78298, -28.115961, 
    -28.284237, -28.652328, -28.652328, -28.618475, -28.382553, 
    -28.104822, -27.870857, -27.725304, -27.513765, -27.281839, 
    -27.089834, -26.904253, -26.696451, -26.501493, -26.284134, 
    -26.017385, -25.736273, -25.376564, -25.116371, -24.823265, 
    -24.455084, -24.090719, -23.707504, -23.306538, -22.99367, 
    -22.731548, -22.407658, -22.039309, -21.587664, -21.154367, 
    -20.697742, -20.23628, -19.742008, -19.219334, -18.651316, 
    -18.054804, -17.410599, -16.73704, -16.020861, -15.284132, 
    -14.572757, -13.813521, -13.082184, -13.082184, -11.836174, 
    -10.371157, -8.9146891, -7.5984855, -6.3909879, -5.2539153, 
    -4.1701441, -3.1843925, -2.2747555, -1.4981418, -0.85124946, 
    -0.44579506, -0.22767115, -0.26378655, -0.35496628, -0.052757025, 
    -0.018972158, -0.12546009, -0.30359784, -0.45423844, -0.66924334, 
    -0.9572376, -1.3283906, -1.6891971, -2.0254967, -2.4296074, 
    -2.8898013, -3.3561993, -3.856319, -4.3255644, -4.8272915, 
    -5.3697472, -5.9422278, -6.5665784, -7.2926774, -8.0842562, 
    -8.8555298, -9.6650724, -10.555345, -11.640717, -2.7672737, 
    -2.1903069, -1.2737914, 0.16836274, 2.4672432, 5.9690843, 
    10.210753, 15.91739, 19.899754, 14.792585, 11.754315, 9.7791786, 
    8.1368742, 6.8233938, 5.5829773, 4.618804, 3.5732141, 2.5846314, 
    1.6089522, 0.62011236, -0.45423844, -1.6118737, -2.7228773, 
    -3.9464815, -5.2166457, -6.505352, -7.8890376, -9.3358879, 
    -10.906958, -12.543717, -14.332139, -16.252239, -18.320354, 
    -20.591578, -22.985493, -25.616528, -28.454372, -31.466019, 
    -34.491833, -37.347115, -39.844269, -39.844269, -40.963715, 
    -42.466965, -44.281563, -46.622925, -49.180168, -50.47818, 
    -50.001698, -48.150879, -47.208149, -44.766876, -42.444233, 
    -40.224083, -38.183632, -36.332493, -34.635815, -33.141499, 
    -31.745464, -30.478825, -29.272392, -28.079586, -26.989384, 
    -25.958443, -24.988785, -23.958261, -23.041853, -22.102564, 
    -21.195795, -20.102522, -18.509001, -16.776804, -15.243351, 
    -13.770063, -12.316394, -11.027509, -9.7839518, -8.3760729, 
    -6.9421391, -5.5482216, -4.1175952, -2.7672737)), .Names = c("sample_ids", 
"pseudolandmark", "x", "y", "z"), row.names = c(NA, -205L), class = "data.frame") 

Und den Code für den 3D-Plot oben:

library(plotly) 
plot_ly(outlines, x = x, y = y, z = z, 
     text = pseudolandmark, 
     type = "scatter3d", mode = "markers", 
     marker = list(size = 2)) 

Jetzt wandle ich auf einen Datenrahmen, und Grundstück in 2d

outlines_df <- data.frame(pseudolandmark = outlines[,2], 
          x = as.numeric(outlines[,3]), 
          y = as.numeric(outlines[,4]), 
          z = as.numeric(outlines[,5])) 

ggplot(outlines_df, aes(x, z)) + 
    geom_point() + 
    coord_equal() 

enter image description here

Dies ist für eine des Umrisses ist ideal, es ist wie der Blick direkt senkrecht zu dem Plan des Umrisses ist. Dies scheint eine sehr genaue Darstellung dieses bestimmten Querschnitts des Objekts zu sein.

Aber ich stecke fest, den Datensatz zu drehen, um den zweiten Umriss in 2d zu projizieren, so dass ich den Umriss als "flach" sehe, dh. um 90 Grad zum ersten Umriss. Wenn ich einfach x- und y-Koordinaten anstelle von x und z (wie oben) verwende, ist das Ergebnis leicht verzerrt (ich möchte den horizontalen Umriss als einzelne Linie sehen, als würde ich auf seine dünne Kante schauen):

enter image description here

Hier ist der zweite Umriss von selbst

second_outline <- outlines_df[1:123, ] 

ggplot(second_outline, aes(x, z)) + 
    geom_point() + 
    coord_equal() 

enter image description here

das Ergebnis ist, als ob ich eine eigentümliche Scheibe durch den 3D-Raum. Was ich will, bekommen, ist eine 2D-Projektion, die wie folgt aussieht:

enter image description here

Diese Ansicht zeigt den Umriss ‚flach‘, und senkrecht zur anderen Kontur.

ich first thought that a simple rotation would solve the problem, aber das ist nicht ganz richtig:

ratio = diff(range(first_outline$x))/diff(range(first_outline$z)) 
first_outline$znew = ratio * first_outline$z - (ratio - 1) * mean(first_outline$z) 

ggplot(first_outline, aes(x, znew)) + 
    geom_point() + 
    coord_equal() 

enter code here

Oder wenn ich diese Drehung auf der y-Achse gelten, ist das Ergebnis nicht stimmt:

ratio = diff(range(first_outline$x))/diff(range(first_outline$y)) 
first_outline$ynew = ratio * first_outline$y - (ratio - 1) * mean(first_outline$y) 

ggplot(first_outline, aes(x, ynew)) + 
    geom_point() + 
    coord_equal() 

enter image description here

Wie kann ich drehen die Daten, um die Projektion zu bekommen, die ich für den zweiten Umriss haben möchte?

Ich sehe in der Literatur über Tensoren und Trägheit Tensoren, aber ich bin nicht sicher, wie man mit diesen beginnt.

+1

Ich denke, was Sie wollen, ist die Hauptkomponentenanalyse. Das Ausarbeiten der genauen Details für eine verallgemeinerte Version dieses Problems wird etwas länger dauern als ich gerade habe. Aber da Sie sagen, dass sich die Ebenen der 2 Polygone bei 90 Grad schneiden, können wir vereinfachen. Ich denke, es wird so etwas ... Die x-Achse Ihres 2d-Diagramms sollte die erste Hauptkomponente des ersten Polygons sein, und die y-Achse wird der erste pc des zweiten Polygons sein, der um 90 Grad gedreht ist. – dww

+1

Wenn ich genauer hinschaue, merke ich, dass Ihr Datenrahmen nicht unterscheidet, welche Punkte in welchem ​​Polygon liegen. Um die obige Methode zu verwenden, müssen Sie sie zuerst trennen. Noch einmal, pca ist dein Freund, um herauszufinden, welche Punkte außerhalb der Ebene liegen, die von den 2 Hauptkomponenten gebildet wird, die den Haupt- und Nebenachsen eines der Polygone entsprechen. Allerdings, noch einmal auf die Tatsache, dass die Polygone schneiden bei 90 Grad können wir noch mehr vereinfachen (ohne Zeichen bis zum nächsten Kommentar ...) – dww

+1

So, einfachste Methode, die ich denken kann, erfordert ein wenig Versuch und Irrtum. Die x-Achse ist 1. pc. Versuchen Sie dann, den zweiten PC als y-Achse zu verwenden. Entweder ist dies das, was Sie wollen, oder (abhängig davon, wie die Punkte verteilt sind), sieht es aus wie zwei sich schneidende Linien in einem X, wenn Sie das Objekt orthogonal zu beiden Ebenen betrachten. Wenn das, was Sie sehen, ein x ist, dann zeichnen Sie den dritten PC als y-Achse auf. Dies sollte hoffentlich die richtige Ansicht sein. Wenn du noch ein paar Tage hier feststeckst, werde ich vielleicht Zeit finden, über das Wochenende zu basteln, um dir eine vollständige Antwort zu geben, aber hoffentlich werden diese Vorschläge funktionieren. – dww

Antwort

2

Nach von dww's helpful comments, hier ist ein PCA der Koordinaten:

# compute PCA... 
first_outline_pca <- prcomp(first_outline[ , c('x', 'y', 'z')], 
          scores = TRUE, 
          cor = FALSE) 
# extract PCs... 
compscores <- data.frame(first_outline_pca$x[ ,1:3]) 

# plot to see what the result is... 
ggplot() + 
    geom_point(data = compscores, aes(PC1, PC2), colour = "red") + 
    geom_point(data = compscores, aes(mean(PC1), mean(PC2)), colour = "green") + 
    geom_point(data = first_outline, aes(x, z), colour = "blue") + 
    geom_point(data = first_outline, aes(mean(x), mean(z)), colour = "green") + 
    coord_equal() + 
    theme_bw() 

enter image description here

Der blaue die ursprünglichen rohen coords ist, und das Rot ist die PCA-transformierten Koordinaten. Und dieser rote Umriss sieht ziemlich genau so aus, wie ich es erwartet hatte, fantastisch!

+1

Großartig. Froh, dass es funktioniert hat. – dww

Verwandte Themen