Rotate plotted points to re-project relative to another set of points

Question

I have a data frame of points that plot outlines of two polygons, one at right angles to the other, like so:

Here are the data that make that plot:

    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")

And the code for the 3d plot above:

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

Now I convert to a dataframe, and plot 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()

This is ideal for one of the outlines, it's like the view is directly perpendicular to the plan of the outline. This seems like a very accurate representation of that particular cross-section of the object.

But I'm stuck at rotating the dataset to project the second outline into 2d so that I see the outline as 'flat', ie. at 90 degrees to the first outline. If I simply use x and y coords instead of x and z (as above), the result is slightly skewed (I want to see the horizontal outline as a single line, as if I am looking at its thin edge):

Here's the second outline by itself

second_outline <- outlines_df[1:123, ]

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

The result is as if I have a peculiar slice through the 3d space. What I want to get is a 2d projection that looks like this:

This view shows the outline 'flat', and perpendicular to the other outline.

I first thought that a simple rotation would solve the problem, but that's not quite right:

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()

Or if I apply this rotation to the y-axis, the result is not right:

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()

How can I rotate the data to get the projection that I want for the second outline?

I see in the literature about tensors and inertia tensors, but I'm not sure how to get started with those.

Answer 1

Following from dww's helpful comments, here's a PCA of the coordinates:

# 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()

The blue is the original raw coords, and the red is the PCA-transformed coords. And that red outline looks pretty much exactly like what I was expecting, fantastic!