Related
I'm solving an equation with OLS which returns a timing point on an x/y/z surface mesh. I can solve for speed and directionality per the method outlined below. The problem is, my vectors are not parallel to the surface mesh and I'm uncertain of the correct transforms needed to get it in the correct direction.
The literature states:
"For the visualization of the vectors in the 3D geometry ... If only surface data were used in the calculation of the vectors, the conduction velocity vectors were geometrically projected into the plane orthogonal to the surface normals. This constraint corrected vectors pointing inside or outside the surface"
I have no idea how to do that.
Reprex Data:
library(plotly)
library(dplyr)
tri_list <- list(surf_tri = structure(c(1L, 1L, 4L, 8L, 11L, 12L, 17L, 6L,
19L, 13L, 3L, 5L, 22L, 1L, 26L, 18L, 18L, 8L, 21L, 14L, 27L,
4L, 14L, 7L, 6L, 29L, 22L, 16L, 23L, 26L, 3L, 28L, 2L, 13L, 12L,
31L, 33L, 35L, 32L, 28L, 33L, 31L, 20L, 9L, 36L, 12L, 29L, 20L,
31L, 27L, 17L, 26L, 8L, 15L, 9L, 29L, 9L, 35L, 15L, 11L, 16L,
16L, 38L, 31L, 37L, 32L, 24L, 35L, 23L, 23L, 23L, 37L, 10L, 35L,
2L, 4L, 5L, 7L, 10L, 13L, 16L, 18L, 20L, 2L, 2L, 7L, 3L, 3L,
25L, 17L, 27L, 17L, 7L, 2L, 18L, 27L, 28L, 5L, 7L, 1L, 30L, 29L,
30L, 31L, 13L, 5L, 5L, 12L, 14L, 33L, 10L, 25L, 25L, 20L, 12L,
12L, 28L, 36L, 15L, 19L, 4L, 7L, 37L, 4L, 27L, 13L, 36L, 36L,
7L, 16L, 10L, 32L, 16L, 15L, 23L, 30L, 16L, 34L, 34L, 37L, 35L,
24L, 13L, 24L, 26L, 11L, 11L, 38L, 3L, 2L, 2L, 6L, 9L, 14L, 15L,
8L, 9L, 14L, 13L, 21L, 23L, 22L, 24L, 8L, 17L, 15L, 20L, 28L,
6L, 6L, 19L, 4L, 4L, 22L, 16L, 22L, 22L, 32L, 23L, 21L, 28L,
31L, 19L, 34L, 34L, 32L, 26L, 19L, 9L, 33L, 21L, 11L, 11L, 9L,
1L, 9L, 32L, 29L, 29L, 31L, 9L, 8L, 8L, 17L, 33L, 38L, 38L, 38L,
39L, 23L, 39L, 37L, 10L, 38L, 39L, 25L, 26L, 39L, 24L, 38L, 37L,
39L), dim = c(74L, 3L), dimnames = list(NULL, c("V1", "V2", "V3"
))), coordinates = structure(c(1.9194540977478, 11.1435489654541,
5.42491292953491, -1.66259050369263, 7.44240760803223, -6.69524192810059,
-0.0333123430609703, -4.23227882385254, 21.1540908813477, 28.65553855896,
26.0386810302734, 24.6995525360107, 38.495361328125, 22.120174407959,
-2.17373514175415, 0.292593091726303, -11.4042282104492, -10.3343534469604,
17.5129470825195, 11.7786016464233, 9.42895698547363, -1.22890889644623,
23.1779632568359, 31.624174118042, 38.5983734130859, 45.1263847351074,
-11.1577320098877, 12.0059661865234, -2.91624927520752, 0.309472501277924,
30.9889793395996, 42.6134490966797, 23.7120399475098, 26.9033088684082,
30.3514823913574, 7.96694564819336, 31.1637763977051, 31.1527690887451,
25.4455451965332, -61.4243927001953, -56.5476036071777, -45.9739837646484,
-66.2752914428711, -66.6171951293945, -84.5177154541016, -78.7427749633789,
-92.5044403076172, -86.8224487304688, -90.4450073242188, -100.261276245117,
-64.494514465332, -54.8481636047363, -57.9494781494141, -109.206504821777,
-76.7904586791992, -95.8042831420898, -88.341796875, -64.2513122558594,
-69.0683898925781, -68.2359237670898, -69.7075653076172, -76.6936798095703,
-76.4758529663086, -78.4939727783203, -64.2876815795898, -86.8634643554688,
-61.3102798461914, -68.8540496826172, -74.4825897216797, -79.063835144043,
-81.4954528808594, -86.3758010864258, -87.7453536987305, -83.0354080200195,
-109.458961486816, -90.4418487548828, -90.170280456543, -80.8295745849609,
189.259994506836, 207.376663208008, 187.388595581055, 200.771896362305,
215.514175415039, 214.221862792969, 217.531005859375, 215.624313354492,
211.211242675781, 205.350524902344, 203.870376586914, 210.061508178711,
195.598449707031, 210.308349609375, 195.291015625, 177.159469604492,
194.172241210938, 210.24040222168, 213.330307006836, 216.293930053711,
216.293441772461, 180.884536743164, 163.47248840332, 163.422592163086,
168.801071166992, 186.711502075195, 207.275924682617, 212.505798339844,
190.655349731445, 176.77978515625, 204.541122436523, 191.065948486328,
209.147216796875, 206.617050170898, 172.961532592773, 211.9609375,
203.223968505859, 179.055145263672, 170.081588745117), dim = c(39L,
3L)), activation_timing_ms = c(-25.9116878216266, -35, 17.8156572141554,
-32.3085435482249, -30.425790486056, -22.7921350518616, -19.7547757364543,
-17.1422476398632, -5.21201605679312, 6.529324221754, 6.37415402817896,
-18.6397688908753, 6.16765189118496, -23.9073664920415, -6.74190321661786,
-17, -15.3633306040704, -20.0486637091315, -23.098251364298,
-23.5797990311573, -23.6085020691451, -27.8322123439857, 11.4184099588406,
12.5422915301849, 9.07414737038971, 5.42139612786991, -21.8214591939045,
-29.3013020135356, -33.236757970705, -19.3552220222891, -5.4698807256143,
-2.27373675443232e-13, -3.44126922278861, -0.401211436169433,
17.9550207172763, 1, 5.84672565064739, -2.04852001824679, 26.5347286690835
))
# Polynomial Surface Fitting
lm_dat <- cbind(tri_list$coordinates, activation_timing_ms = tri_list$activation_timing_ms) |>
as.data.frame() |>
rename(x = V1, y = V2, z = V3)
lm <- lm(activation_timing_ms~polym(x,y,z, degree=2, raw = TRUE), lm_dat)
lm_coef <- coef(lm)
a <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)2.0.0"]]
b <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)0.2.0"]]
c <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)0.0.2"]]
d <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)1.1.0"]]
e <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)1.0.1"]]
f <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)0.1.1"]]
g <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)1.0.0"]]
h <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)0.1.0"]]
i <- lm_coef[["polym(x, y, z, degree = 2, raw = TRUE)0.0.1"]]
j <- lm_coef[["(Intercept)"]]
# Differentiation
t_x_fun <- function(x,y,z){
2*a*x + d*y + e*z + g
}
t_y_fun <- function(x,y,z){
2*b*y + d*x + f*z + h
}
t_z_fun <- function(x,y,z){
2*c*z + e*x + f*y + i
}
CV_x_fun <- function(t_x,t_y,t_z){
t_x/(t_x^2 + t_y^2 + t_z^2)
}
CV_y_fun <- function(t_x,t_y,t_z){
t_y/(t_x^2 + t_y^2 + t_z^2)
}
CV_z_fun <- function(t_x,t_y,t_z){
t_z/(t_x^2 + t_y^2 + t_z^2)
}
fitted_activation_timing <- fitted(lm)
# Loop through the V1 coordinates
node_indices_tmp <- vector(length=nrow(tri_list$surf_tri))
v1_vertex_coord <- vector("list",
length = nrow(tri_list$coordinates))
for(i in seq_along(1:nrow(tri_list$coordinates))) {
v3_index_tmp <- tri_list$surf_tri[i,3]
v2_index_tmp <- tri_list$surf_tri[i,2]
v1_index_tmp <- tri_list$surf_tri[i,1]
timing_sorted <- matrix(c(fitted_activation_timing[v1_index_tmp], v1_index_tmp,
fitted_activation_timing[v2_index_tmp], v2_index_tmp,
fitted_activation_timing[v3_index_tmp], v3_index_tmp),
nrow = 3,
ncol = 2,
byrow=T)
timing_sorted <- timing_sorted[order(timing_sorted[, 1]), ]
v3_index <- timing_sorted[3,2]
v2_index <- timing_sorted[2,2]
v1_index <- timing_sorted[1,2]
v1_vertex_coord[[i]] <- tri_list$coordinates[v1_index,]
}
v1_vertex_coord <- matrix(unlist(v1_vertex_coord),
nrow = length(v1_vertex_coord),
ncol = 3,
byrow=T)
CV_x <- vector(length=nrow(v1_vertex_coord))
CV_y <- vector(length=nrow(v1_vertex_coord))
CV_z <- vector(length=nrow(v1_vertex_coord))
for(i in seq_along(1:nrow(v1_vertex_coord))) {
x <- v1_vertex_coord[i,1]
y <- v1_vertex_coord[i,2]
z <- v1_vertex_coord[i,3]
t_x <- t_x_fun(x,y,z)
t_y <- t_y_fun(x,y,z)
t_z <- t_z_fun(x,y,z)
CV_x[i] <- CV_x_fun(t_x,t_y,t_z)
CV_y[i] <- CV_y_fun(t_x,t_y,t_z)
CV_z[i] <- CV_z_fun(t_x,t_y,t_z)
}
CV <- cbind(lm_dat, CV_x, CV_y, CV_z, fitted_activation_timing) |> as.data.frame()
plot_ly() |>
add_trace(
name = "Faces",
type = "mesh3d",
x = tri_list$coordinates[,1], y = tri_list$coordinates[,2], z = tri_list$coordinates[,3],
i = tri_list$surf_tri[,1]-1, j = tri_list$surf_tri[,2]-1, k = tri_list$surf_tri[,3]-1,
opacity = 0.8,
flatshading = TRUE # we don't want smoothing
) |>
add_trace(
type = "scatter3d",
mode = "markers",
x = tri_list$coordinates[,1],
y = tri_list$coordinates[,2],
z = tri_list$coordinates[,3]) |>
add_trace(
type="cone",
name = "CV Vectors",
x = CV[,"x"],
y = CV[,"y"],
z = CV[,"z"],
u = CV[,"CV_x"],
v = CV[,"CV_y"],
w = CV[,"CV_z"],
opacity=0.8,
sizemode= 'absolute',
sizeref= 1
)
Relevant Sections of the literature:
Calculating the weights is beyond the scope of MRE and I left it out.
My other Questions was marked as an duplicate (I used a common example, not my real data), therefore I opened a new one.
So again, I hope this time it becomes clear, what my problem is.
I have following data frame called "sample" (it´s extracted from my real dataframe):
county testscr str
1 Alameda 690.80 17.88991
2 Butte 661.20 21.52466
3 Butte 643.60 18.69723
4 Butte 647.70 17.35714
5 Butte 640.85 18.67133
6 Fresno 605.55 21.40625
7 San Joaquin 606.75 19.50000
8 Kern 609.00 20.89412
9 Fresno 612.50 19.94737
10 Sacramento 612.65 20.80556
11 Merced 615.75 21.23809
12 Fresno 616.30 21.00000
13 Tulare 616.30 20.60000
14 Tulare 616.30 20.00822
15 Tulare 616.45 18.02778
16 Tulare 617.35 20.25196
17 Kern 618.05 16.97787
18 Kern 618.30 16.50980
19 Los Angeles 619.80 22.70402
20 Kern 620.30 19.91111
I have plotted the variable testscr against str and added a linear Regression line to the plot using ggplot
ggplot(data=sample,aes(x=str,y=testscr))+
geom_point()+
geom_smooth(method="lm")
Now I want to highlight/color all points, which have "Butte", "Los Angeles" and "Fresno" as County value. All three of them should have different Colors and the rest of the points should be black.
dput(sample)
structure(list(county = structure(c(1L, 2L, 2L, 2L, 2L, 6L, 29L,
11L, 6L, 25L, 19L, 6L, 42L, 42L, 42L, 42L, 11L, 11L, 15L, 11L,
9L, 42L, 11L, 42L, 19L, 42L, 20L, 11L, 42L, 42L, 28L, 20L, 15L,
20L, 27L, 15L, 19L, 6L, 31L, 11L, 44L, 19L, 11L, 11L, 24L, 15L,
33L, 11L, 11L, 33L, 15L, 16L, 20L, 32L, 15L, 15L, 15L, 25L, 20L,
44L, 42L, 25L, 22L, 12L, 12L, 11L, 15L, 12L, 28L, 37L, 11L, 15L,
12L, 19L, 32L, 27L, 4L, 8L, 36L, 36L, 44L, 6L, 19L, 19L, 6L,
27L, 24L, 15L, 11L, 42L, 25L, 13L, 33L, 2L, 31L, 42L, 15L, 9L,
9L, 15L, 11L, 11L, 39L, 18L, 27L, 26L, 15L, 2L, 11L, 44L, 6L,
15L, 16L, 22L, 42L, 33L, 9L, 28L, 35L, 42L, 40L, 42L, 6L, 20L,
42L, 24L, 37L, 15L, 40L, 31L, 36L, 11L, 38L, 43L, 31L, 5L, 19L,
29L, 6L, 25L, 38L, 19L, 44L, 8L, 8L, 28L, 13L, 8L, 44L, 40L,
25L, 29L, 36L, 38L, 6L, 22L, 22L, 12L, 42L, 28L, 35L, 19L, 39L,
28L, 15L, 11L, 39L, 28L, 27L, 22L, 37L, 35L, 40L, 43L, 36L, 8L,
4L, 43L, 23L, 37L, 37L, 38L, 35L, 8L, 42L, 7L, 37L, 14L, 9L,
14L, 22L, 37L, 32L, 8L, 39L, 35L, 11L, 28L, 34L, 24L, 11L, 33L,
9L, 29L, 40L, 8L, 35L, 15L, 21L, 42L, 11L, 25L, 26L, 28L, 39L,
6L, 4L, 36L, 29L, 33L, 12L, 38L, 29L, 23L, 26L, 5L, 27L, 35L,
21L, 31L, 12L, 35L, 3L, 17L, 28L, 33L, 39L, 21L, 8L, 37L, 31L,
40L, 22L, 27L, 15L, 8L, 27L, 30L, 33L, 5L, 15L, 10L, 32L, 16L,
36L, 37L, 21L, 42L, 42L, 43L, 15L, 19L, 31L, 33L, 37L, 11L, 31L,
43L, 23L, 38L, 14L, 35L, 42L, 15L, 33L, 15L, 37L, 11L, 35L, 23L,
36L, 37L, 16L, 8L, 5L, 37L, 40L, 37L, 37L, 23L, 34L, 8L, 27L,
23L, 5L, 22L, 7L, 31L, 32L, 27L, 37L, 33L, 32L, 28L, 22L, 32L,
34L, 7L, 37L, 21L, 12L, 28L, 14L, 44L, 43L, 36L, 37L, 28L, 37L,
8L, 11L, 42L, 33L, 11L, 12L, 28L, 28L, 42L, 28L, 22L, 15L, 15L,
17L, 33L, 40L, 8L, 28L, 35L, 11L, 33L, 22L, 5L, 5L, 23L, 5L,
8L, 15L, 23L, 23L, 37L, 31L, 21L, 16L, 30L, 14L, 6L, 37L, 37L,
31L, 5L, 23L, 28L, 5L, 21L, 37L, 8L, 41L, 21L, 23L, 44L, 41L,
35L, 21L, 8L, 37L, 28L, 17L, 33L, 15L, 37L, 20L, 37L, 33L, 37L,
37L, 38L, 17L, 32L, 37L, 17L, 34L, 31L, 35L, 34L, 34L, 4L, 32L,
17L, 33L, 34L, 33L, 32L, 28L, 31L, 17L, 17L, 4L, 28L, 31L, 4L,
4L, 31L, 32L, 31L, 33L, 31L, 33L, 44L, 45L, 45L), .Label = c("Alameda",
"Butte", "Calaveras", "Contra Costa", "El Dorado", "Fresno",
"Glenn", "Humboldt", "Imperial", "Inyo", "Kern", "Kings", "Lake",
"Lassen", "Los Angeles", "Madera", "Marin", "Mendocino", "Merced",
"Monterey", "Nevada", "Orange", "Placer", "Riverside", "Sacramento",
"San Benito", "San Bernardino", "San Diego", "San Joaquin", "San Luis Obispo",
"San Mateo", "Santa Barbara", "Santa Clara", "Santa Cruz", "Shasta",
"Siskiyou", "Sonoma", "Stanislaus", "Sutter", "Tehama", "Trinity",
"Tulare", "Tuolumne", "Ventura", "Yuba"), class = "factor"),
testscr = c(690.8, 661.2, 643.6, 647.7, 640.85, 605.55, 606.75,
609, 612.5, 612.65, 615.75, 616.3, 616.3, 616.3, 616.45,
617.35, 618.05, 618.3, 619.8, 620.3, 620.5, 621.4, 621.75,
622.05, 622.6, 623.1, 623.2, 623.45, 623.6, 624.15, 624.55,
624.95, 625.3, 625.85, 626.1, 626.8, 626.9, 627.1, 627.25,
627.3, 628.25, 628.4, 628.55, 628.65, 628.75, 629.8, 630.35,
630.4, 630.55, 630.55, 631.05, 631.4, 631.85, 631.9, 631.95,
632, 632.2, 632.25, 632.45, 632.85, 632.95, 633.05, 633.15,
633.65, 633.9, 634, 634.05, 634.1, 634.1, 634.15, 634.2,
634.4, 634.55, 634.7, 634.9, 634.95, 635.05, 635.2, 635.45,
635.6, 635.6, 635.75, 635.95, 636.1, 636.5, 636.6, 636.7,
636.9, 636.95, 637, 637.1, 637.35, 637.65, 637.95, 637.95,
638, 638.2, 638.3, 638.3, 638.35, 638.55, 638.7, 639.25,
639.3, 639.35, 639.5, 639.75, 639.8, 639.85, 639.9, 640.1,
640.15, 640.5, 640.75, 640.9, 641.1, 641.45, 641.45, 641.55,
641.8, 642.2, 642.2, 642.4, 642.75, 643.05, 643.2, 643.25,
643.4, 643.4, 643.5, 643.5, 643.7, 643.7, 644.2, 644.2, 644.4,
644.45, 644.45, 644.5, 644.55, 644.7, 644.95, 645.1, 645.25,
645.55, 645.55, 645.6, 645.75, 645.75, 646, 646.2, 646.35,
646.4, 646.5, 646.55, 646.7, 646.9, 646.95, 647.05, 647.25,
647.3, 647.6, 647.6, 648, 648.2, 648.25, 648.35, 648.7, 648.95,
649.15, 649.3, 649.5, 649.7, 649.85, 650.45, 650.55, 650.6,
650.65, 650.9, 650.9, 651.15, 651.2, 651.35, 651.4, 651.45,
651.8, 651.85, 651.9, 652, 652.1, 652.1, 652.3, 652.3, 652.35,
652.4, 652.4, 652.5, 652.85, 653.1, 653.4, 653.5, 653.55,
653.55, 653.7, 653.8, 653.85, 653.95, 654.1, 654.2, 654.2,
654.3, 654.6, 654.85, 654.85, 654.9, 655.05, 655.05, 655.05,
655.2, 655.3, 655.35, 655.35, 655.4, 655.55, 655.7, 655.8,
655.85, 656.4, 656.5, 656.55, 656.65, 656.7, 656.8, 656.8,
657, 657, 657.15, 657.4, 657.5, 657.55, 657.65, 657.75, 657.8,
657.9, 658, 658.35, 658.6, 658.8, 659.05, 659.15, 659.35,
659.4, 659.4, 659.8, 659.9, 660.05, 660.1, 660.2, 660.3,
660.75, 660.95, 661.35, 661.45, 661.6, 661.6, 661.85, 661.85,
661.85, 661.9, 661.9, 661.95, 662.4, 662.4, 662.45, 662.5,
662.55, 662.55, 662.65, 662.7, 662.75, 662.9, 663.35, 663.45,
663.5, 663.85, 663.85, 663.9, 664, 664, 664.15, 664.15, 664.3,
664.4, 664.45, 664.7, 664.75, 664.95, 664.95, 665.1, 665.2,
665.35, 665.65, 665.9, 665.95, 666, 666.05, 666.1, 666.15,
666.15, 666.45, 666.55, 666.6, 666.65, 666.65, 666.7, 666.85,
666.85, 667.15, 667.2, 667.45, 667.45, 667.6, 668, 668.1,
668.4, 668.6, 668.65, 668.8, 668.9, 668.95, 669.1, 669.3,
669.3, 669.35, 669.35, 669.8, 669.85, 669.95, 670, 670.7,
671.25, 671.3, 671.6, 671.6, 671.65, 671.7, 671.75, 671.9,
671.9, 671.95, 672.05, 672.05, 672.3, 672.35, 672.45, 672.55,
672.7, 673.05, 673.25, 673.3, 673.55, 673.55, 673.9, 674.25,
675.4, 675.7, 676.15, 676.55, 676.6, 676.85, 676.95, 677.25,
677.95, 678.05, 678.4, 678.8, 679.4, 679.5, 679.65, 679.75,
679.8, 680.05, 680.45, 681.3, 681.3, 681.6, 681.9, 682.15,
682.45, 682.55, 682.65, 683.35, 683.4, 684.3, 684.35, 684.8,
684.95, 686.05, 686.7, 687.55, 689.1, 691.05, 691.35, 691.9,
693.95, 694.25, 694.8, 695.2, 695.3, 696.55, 698.2, 698.25,
698.45, 699.1, 700.3, 704.3, 706.75, 645, 672.2, 655.75),
str = c(17.88991, 21.52466, 18.69723, 17.35714, 18.67133,
21.40625, 19.5, 20.89412, 19.94737, 20.80556, 21.23809, 21,
20.6, 20.00822, 18.02778, 20.25196, 16.97787, 16.5098, 22.70402,
19.91111, 18.33333, 22.61905, 19.44828, 25.05263, 20.67544,
18.68235, 22.84553, 19.26667, 19.25, 20.54545, 20.60697,
21.07268, 21.53581, 19.904, 21.19407, 21.86535, 18.32965,
16.22857, 19.17857, 20.27737, 22.98614, 20.44444, 19.82085,
23.20522, 19.26697, 23.30189, 21.18829, 20.8718, 19.01749,
21.91938, 20.10124, 21.47651, 20.06579, 20.3751, 22.44648,
22.89524, 20.49797, 20, 22.25658, 21.56436, 19.47737, 17.67002,
21.94756, 21.78339, 19.14, 18.1105, 20.68242, 22.62361, 21.7865,
18.58293, 21.54545, 21.15289, 16.63333, 21.14438, 19.78182,
18.98373, 17.66767, 17.75499, 15.27273, 14, 20.59613, 16.31169,
21.12796, 17.48801, 17.88679, 19.30676, 20.89231, 21.28684,
20.1956, 24.95, 18.13043, 20, 18.72951, 18.25, 18.99257,
19.88764, 19.37895, 20.46259, 22.29157, 20.70474, 19.06005,
20.23247, 19.69012, 20.36254, 19.75422, 19.37977, 22.92351,
19.3734, 19.15516, 21.3, 18.30357, 21.07926, 18.79121, 19.62662,
19.59016, 20.87187, 21.115, 20.08452, 19.91049, 17.81285,
18.13333, 19.22221, 18.66072, 19.6, 19.28384, 22.81818, 18.80922,
21.37363, 20.02041, 21.49862, 15.42857, 22.4, 20.12709, 19.03798,
17.34216, 17.01863, 20.8, 21.15385, 18.45833, 19.14082, 19.40766,
19.56896, 21.5012, 17.52941, 16.43017, 19.79654, 17.18613,
17.61589, 20.12537, 22.16667, 19.96154, 19.03945, 15.22436,
21.14475, 19.6439, 21.04869, 20.17544, 21.3913, 20.00833,
20.29137, 17.66667, 18.22055, 20.271, 20.19895, 21.38424,
20.97368, 20, 17.15328, 22.34977, 22.17007, 18.18182, 18.95714,
19.74533, 16.42623, 16.6254, 16.38177, 20.07416, 17.99544,
19.3913, 16.42857, 16.72949, 24.41345, 18.26415, 18.95504,
21.03896, 20.74074, 18.1, 19.84615, 21.6, 22.44242, 23.01438,
17.74892, 18.28664, 19.26544, 22.66667, 19.29412, 17.36364,
19.82143, 20.43378, 21.03721, 19.92462, 19.00986, 23.82222,
19.36909, 19.82857, 15.25885, 17.16129, 21.81333, 19.07471,
25.78512, 18.21261, 18.16606, 16.97297, 21.50087, 20.6, 16.99029,
20.77954, 15.51247, 19.88506, 21.39882, 20.49751, 19.36376,
17.65957, 21.01796, 19.05565, 22.53846, 21.10787, 20.05135,
14.20176, 18.47687, 18.63542, 20.94595, 21.08548, 18.69288,
20.86808, 19.82558, 19.75, 19.5, 18.3908, 18.78676, 19.77018,
19.33333, 21.46392, 23.08492, 21.06299, 18.68687, 20.77024,
19.30556, 20.1328, 20.66964, 22.28155, 20.60027, 20.82734,
19.22492, 17.65477, 17, 16.49773, 19.78261, 22.30216, 17.73077,
20.44836, 20.37169, 20.16479, 21.61538, 20.56143, 19.95551,
21.18387, 18.81042, 20.57838, 18.32461, 18.82063, 20.81633,
20, 19.68182, 19.39018, 20.92732, 19.94437, 20.79109, 19.20354,
19.02439, 17.62058, 20.23715, 19.29374, 18.82998, 20.33949,
19.229, 17.8913, 19.51881, 19.08451, 19.93548, 18.87326,
20.14178, 23.55637, 21.46479, 19.19101, 20.1308, 25.8, 18.77774,
19.10982, 19.70109, 18.61594, 20.99721, 20, 20.98325, 21.64262,
20.02967, 19.8114, 18, 19.35811, 20.17912, 21.11986, 23.38974,
22.18182, 19.94283, 17.78826, 14.70588, 19.04077, 20.89195,
19.83851, 19.52191, 20.68622, 18.18182, 18.89224, 24.88889,
18.58064, 18.04, 17.73399, 21.45455, 19.92343, 20.33942,
22.54608, 21.10344, 18.19743, 20.10768, 19.15984, 19.54545,
20.88889, 18.3915, 19.1799, 19.39771, 21.67827, 19.28889,
20.34927, 20.96416, 19.46039, 19.28572, 20.91979, 20.90021,
20.59575, 19.375, 19.95122, 18.84973, 18.11787, 19.18341,
22, 21.58416, 20.38889, 16.2931, 18.27778, 19.37472, 18.90909,
16.40693, 15.5914, 18.70694, 18.32985, 17.90235, 18.91157,
20.32497, 20.02457, 24, 17.60784, 19.34853, 19.67846, 18.72861,
15.88235, 20.05491, 17.98825, 16.96629, 19.23937, 19.19586,
19.59906, 20.54348, 18.58848, 15.60419, 15.29304, 17.65537,
17.57976, 22.33333, 18.75, 18.10241, 20.25641, 18.80207,
18.7723, 20.40521, 18.65079, 20.70707, 22, 17.69978, 21.48329,
16.70103, 19.57567, 17.25806, 17.37526, 17.34931, 16.26229,
17.70045, 20.12881, 18.26539, 14.54214, 19.15261, 17.36574,
15.13898, 17.84266, 15.40704, 18.86534, 16.47413, 17.86263,
21.88586, 20.2, 19.0364)), class = "data.frame", row.names = c(NA,
-420L))
First order of business is to not use $ in aes calls.
Second, create a variable in the data the hold the 3 factor levels you want, and all other levels collapsed into an "other" level, which you'll use to assign color. The easiest way to do that is with forcats::fct_other, where you specify the levels to keep.
You can assign specific colors by name; for a quick example, I didn't, and just put the "other" color last, knowing that fct_other puts this as the last level.
library(ggplot2)
library(dplyr)
hilite_counties <- as_tibble(sample) %>%
mutate(county2 = forcats::fct_other(county, keep = c("Butte", "Los Angeles", "Fresno")))
ggplot(hilite_counties, aes(x = str, y = testscr)) +
geom_point(aes(color = county2)) +
geom_smooth(method = lm) +
scale_color_manual(values = c("red", "blue", "orange", "black"))
Edit: Taking a second pass to make the color palette more flexible. Like I said, you can assign names to colors to make sure you match the county to the color. I'll put black as the last color because "Other" is the last level, but I could assign them in any order and keep the colors and counties matched by name.
Instead of manually naming colors, I'll add another county to the highlighted group, pull a palette from Color Brewer with the length of the county2 levels minus 1, and tack on "black" as the last color, then assign names. Again, I could do this out of order as well.
hilite_counties <- as_tibble(sample) %>%
mutate(county2 = forcats::fct_other(county, keep = c("Butte", "Los Angeles", "Fresno", "Sacramento")))
county_lvls <- levels(hilite_counties$county2)
pal <- c(RColorBrewer::brewer.pal(n = length(county_lvls) - 1, name = "Dark2"), "black")
names(pal) <- county_lvls
pal
#> Butte Fresno Los Angeles Sacramento Other
#> "#1B9E77" "#D95F02" "#7570B3" "#E7298A" "black"
ggplot(hilite_counties, aes(x = str, y = testscr)) +
geom_point(aes(color = county2)) +
geom_smooth(method = lm) +
scale_color_manual(values = pal)
One note: by default, geom_smooth will make lines for each group i.e. color. I'm guessing that's not what you wanted, but you can avoid that by moving the color assignment to a separate aes that only applies to geom_point.
After doing :
p = ggplot(data=sample,aes(x=str, y=testscr))+
geom_point()+
geom_smooth(method="lm")
You could use dplyr library to show in red points of interest :
p + geom_point(data=filter(sample,county %in% c('Butte','Los Angeles','Fresno')),aes(x=str,y=testscr),colour='red')
Or you can add a column indicating if you want to highlight specific points :
sample$code = ifelse(sample$county %in% c('Butte','Los Angeles','Fresno'), TRUE, FALSE)
ggplot(data=sample,aes(x=str,y=testscr))+
geom_point(aes(colour=code),sample)+
geom_smooth(method="lm") +
scale_colour_manual(name = 'County', values = c("black", "red"), labels = c('Others', 'B, LA, F'))
[edit]
Or with one color by city :
city = c('Butte','Los Angeles','Fresno')
sample %>% mutate_if(is.factor, as.character) -> sample
sample$code = ifelse(sample$county %in% city, sample$county, 'others')
ggplot(data=sample,aes(x=str,y=testscr))+
geom_point(aes(colour=code),sample)+
geom_smooth(method="lm") +
scale_colour_manual(name = 'County', values = c("blue", "red","green","black"))
Another option would be to create two separate layers, one for the special counties and another for the rest. You can do that by subsetting the default dataset in the specification of each layer.
special_county <- c("Butte", "Los Angeles", "Fresno")
ggplot(data=sample, aes(x=str,y=testscr))+
geom_smooth(method="lm") +
geom_point(data = function(x) subset(x, !county %in% special_county)) +
geom_point(data = function(x) subset(x, county %in% special_county),
aes(color = county))
For completeness sake, you can also get the result you want by using scale_color_manual to specify the color for each of the 45 counties, but I guess that wouldn't be very elegant.
This question already has an answer here:
month language in the as.date function
(1 answer)
Closed 5 years ago.
My data frame is:
x=structure(list(V1 = structure(c(33L, 35L, 36L, 37L, 39L, 4L,
6L, 7L, 8L, 10L, 14L, 16L, 18L, 19L, 21L, 25L, 27L, 28L, 29L,
30L, 1L, 17L, 31L, 32L, 34L, 38L, 40L, 2L, 3L, 5L, 9L, 11L, 12L,
13L, 15L, 20L, 22L, 23L, 24L, 26L), .Label = c("1-Feb-71", "10-Feb-71",
"11-Feb-71", "11-Jan-71", "12-Feb-71", "12-Jan-71", "13-Jan-71",
"14-Jan-71", "15-Feb-71", "15-Jan-71", "16-Feb-71", "17-Feb-71",
"18-Feb-71", "18-Jan-71", "19-Feb-71", "19-Jan-71", "2-Feb-71",
"20-Jan-71", "21-Jan-71", "22-Feb-71", "22-Jan-71", "23-Feb-71",
"24-Feb-71", "25-Feb-71", "25-Jan-71", "26-Feb-71", "26-Jan-71",
"27-Jan-71", "28-Jan-71", "29-Jan-71", "3-Feb-71", "4-Feb-71",
"4-Jan-71", "5-Feb-71", "5-Jan-71", "6-Jan-71", "7-Jan-71", "8-Feb-71",
"8-Jan-71", "9-Feb-71"), class = "factor"), V2 = structure(c(1L,
15L, 2L, 4L, 3L, 5L, 10L, 5L, 7L, 12L, 8L, 16L, 16L, 22L, 16L,
19L, 22L, 12L, 17L, 23L, 24L, 24L, 21L, 17L, 19L, 16L, 6L, 11L,
9L, 25L, 25L, 8L, 5L, 13L, 20L, 18L, 16L, 13L, 12L, 14L), .Label = c("7.1359",
"7.1367", "7.1382", "7.1386", "7.1390", "7.1397", "7.1403", "7.1406",
"7.1410", "7.1411", "7.1412", "7.1414", "7.1418", "7.1420", "7.1422",
"7.1429", "7.1431", "7.1434", "7.1435", "7.1437", "7.1439", "7.1443",
"7.1445", "7.1465", "ND"), class = "factor")), .Names = c("V1",
"V2"), class = "data.frame", row.names = c(NA, -40L))
I am trying to convert column V1 to Date, but it is not working. Ive been looking some topics but it just doesnt work.
This my code:
x$V1 <- as.Date(x$V1, format="%d-%b-%y")
It works for some rows of V1 column but not for others.
Any help?
In my version of R, the conversion in your example only works for January and not for February. I think it is related to the language.
For example, in French, February is coded as fév and so Feb is not recognized.
Once I did:
x$V1=gsub("Feb", "fév", x$V1)
it worked.
It probably depends on which language your version of R uses.
I have adjacency list in the form of:
1. 3,4
2. 4
3. 1,4
4. 1,2,3
and I want to transform into adjacency matrix using R.
I have tried various commands like transformation of adjacency list to igraph object and then retransformation of igraph to adjacency matrix, but the obtained adjacency matrix is S4 class. I want simple commands to transform adjacency list to adjacency matrix in R.
data
list(c(1L, 3L, 4L, 8L, 14L, 31L, 2L, 29L, 33L, 7L, 11L, 17L,
5L, 6L, 34L), c(2L, 3L, 4L, 8L, 9L, 12L, 13L, 14L, 18L, 22L,
1L, 10L, 33L, 34L), c(2L, 3L, 4L, 8L, 9L, 12L, 13L, 14L, 18L,
20L, 22L, 32L, 1L, 31L, 34L, 24L), c(2L, 3L, 4L, 5L, 6L, 7L,
8L, 9L, 11L, 12L, 13L, 14L, 18L, 20L, 22L, 1L, 31L, 10L, 28L,
29L), c(4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L, 20L,
22L, 32L, 1L, 17L), c(4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L, 13L,
14L, 18L, 20L, 22L, 32L, 1L, 17L), c(4L, 5L, 6L, 7L, 8L, 9L,
11L, 12L, 13L, 14L, 18L, 20L, 22L, 32L, 1L, 17L), c(2L, 3L, 4L,
5L, 6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L, 20L, 22L, 32L, 1L,
31L, 10L, 28L, 29L), c(2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L,
13L, 14L, 18L, 20L, 22L, 32L, 10L, 28L, 29L, 33L, 34L, 15L, 16L,
19L, 21L, 23L, 24L, 30L, 31L, 27L), c(2L, 4L, 8L, 9L, 10L, 14L,
28L, 29L, 33L, 15L, 16L, 19L, 20L, 21L, 23L, 24L, 27L, 30L, 31L,
32L), c(4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L, 20L,
22L, 32L, 1L, 17L), c(2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L,
13L, 14L, 18L, 20L, 22L, 32L), c(2L, 3L, 4L, 5L, 6L, 7L, 8L,
9L, 11L, 12L, 13L, 14L, 18L, 20L, 22L, 32L), c(2L, 3L, 4L, 5L,
6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L, 20L, 22L, 32L, 1L, 31L,
10L, 28L, 29L, 33L, 15L, 16L, 19L, 21L, 23L, 24L, 27L, 30L),
c(9L, 15L, 16L, 19L, 21L, 23L, 24L, 30L, 31L, 32L, 10L, 14L,
20L, 27L, 28L, 29L), c(9L, 15L, 16L, 19L, 21L, 23L, 24L,
30L, 31L, 32L, 10L, 14L, 20L, 27L, 28L, 29L), c(1L, 7L, 11L,
17L, 5L, 6L), c(2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L,
13L, 14L, 18L, 20L, 22L, 32L, 31L), c(9L, 15L, 16L, 19L,
21L, 23L, 24L, 30L, 31L, 32L, 10L, 14L, 20L, 27L, 28L, 29L
), c(3L, 4L, 5L, 6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L,
20L, 22L, 32L, 31L, 10L, 15L, 16L, 19L, 21L, 23L, 24L, 27L,
28L, 29L, 30L), c(9L, 15L, 16L, 19L, 21L, 23L, 24L, 30L,
31L, 32L, 10L, 14L, 20L, 27L, 28L, 29L), c(2L, 3L, 4L, 5L,
6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L, 20L, 22L, 32L, 31L
), c(9L, 15L, 16L, 19L, 21L, 23L, 24L, 30L, 31L, 32L, 10L,
14L, 20L, 27L, 28L, 29L), c(24L, 25L, 32L, 3L, 34L, 27L,
33L, 9L, 15L, 16L, 19L, 21L, 23L, 30L, 31L, 10L, 14L, 20L,
28L, 29L), c(24L, 25L, 32L, 34L, 26L, 29L), c(26L, 28L, 30L,
33L, 34L, 32L, 25L, 29L), c(24L, 27L, 33L, 9L, 10L, 14L,
15L, 16L, 19L, 20L, 21L, 23L, 28L, 29L, 30L, 31L, 32L), c(4L,
8L, 9L, 10L, 14L, 28L, 29L, 33L, 26L, 30L, 32L, 15L, 16L,
19L, 20L, 21L, 23L, 24L, 27L, 31L), c(1L, 4L, 8L, 9L, 10L,
14L, 28L, 29L, 33L, 25L, 26L, 15L, 16L, 19L, 20L, 21L, 23L,
24L, 27L, 30L, 31L, 32L), c(26L, 28L, 30L, 33L, 34L, 9L,
15L, 16L, 19L, 21L, 23L, 24L, 31L, 32L, 10L, 14L, 20L, 27L,
29L), c(1L, 3L, 4L, 8L, 14L, 18L, 20L, 22L, 31L, 33L, 34L,
9L, 15L, 16L, 19L, 21L, 23L, 24L, 30L, 32L, 10L, 27L, 28L,
29L), c(3L, 5L, 6L, 7L, 8L, 9L, 11L, 12L, 13L, 14L, 18L,
20L, 22L, 32L, 26L, 28L, 24L, 25L, 15L, 16L, 19L, 21L, 23L,
30L, 31L, 10L, 27L, 29L), c(1L, 2L, 9L, 10L, 14L, 28L, 29L,
33L, 31L, 34L, 26L, 30L, 24L, 27L), c(1L, 3L, 31L, 33L, 34L,
2L, 26L, 30L, 24L, 25L, 9L))
Suppose el is a list of edge list:
el = list(c(3,4),
c(2,4),
c(1,4),
c(1,2,3))
#Get the matrix dimension
dim <- length(el)
m <- sapply(el, function(x) { r<-rep(0,dim); r[unlist(x)]<-1;r})
[,1] [,2] [,3] [,4]
[1,] 0 0 1 1
[2,] 0 1 0 1
[3,] 1 0 0 1
[4,] 1 1 1 0
I have been working on the same R script now for 5 months, had some minor coding problems, but this morning I got a problem that makes me unable to run the whole script. To clean my imported data I use a lot of subset(), but this morning when running the code I got the Warning:
Error in subset(T23810, date < as.Date("2015-10-22")) : byte code version mismatch
It appears that I only get this warning after trying to run a subset function, but it blocks my whole script at the moment. What could be the cause and solution for this?
EDIT: Reproducible example
x = structure(list(names = structure(c(11L, 3L, 5L, 27L, 26L, 15L,
18L, 13L, 8L, 2L, 22L, 12L, 1L, 25L, 29L, 31L, 6L, 23L, 28L,
14L, 19L, 4L, 10L, 16L, 9L, 17L, 21L, 30L, 7L, 6L, 27L, 26L,
12L, 13L, 14L, 4L, 28L, 15L, 31L, 23L, 1L, 22L, 11L, 18L, 3L,
20L, 8L, 5L, 16L, 2L, 25L, 30L, 21L, 4L, 6L, 3L, 5L, 27L, 14L,
11L, 26L, 31L, 13L, 18L, 15L, 1L, 23L, 2L, 8L, 28L, 30L, 20L,
22L, 12L, 10L, 16L, 21L, 25L, 17L, 24L, 32L, 31L, 23L, 26L, 1L,
18L, 11L, 12L, 3L, 15L, 27L, 28L, 5L, 22L, 6L, 17L, 20L, 2L,
8L, 21L, 30L, 13L, 25L, 24L, 7L, 4L, 10L, 16L, 14L), .Label = c("50/50",
"Babylon", "Big Rock Market", "Core Gut", "Customs House", "David's Dropoff",
"David's Dropoff Deep", "Diamond Rock", "Giles Quarter", "Green Island",
"Greer Gut", "Hole in the Corner", "Hot Springs", "Ladder Labyrinth",
"Man O War", "Mount Michel", "Muck Dive", "Outer Limits", "Poriotes Point",
"Porites Point", "Rays & Anchors", "Shark Shoals", "Tedran",
"Tent Boulders", "Tent Deep", "Tent Reef", "Tent Wall", "Third Encounter",
"Torens Point", "Torrens Point", "Twilight Zone", "Wells Bay"
), class = "factor")), .Names = "names", row.names = c(NA, -109L
), class = "data.frame")
Then if I execute the following:
x[x=="Torens Point"] = "Torrens Point"
x[x=="Poriotes Point"] = "Porites Point"
x = droplevels(subset(x, names != "Muck Dive"))
I get the error:
Error in subset(x, names != "Muck Dive") : byte code version mismatch
Okay solved it and in the end it was pretty easy. Since I am working on a server and rely on versions of R that are installed on that server I didn't realize how to update R itself. Now I got it it seems to work. Thank you all for your help! This one is SOLVED!