Related
I am trying to calculate the value of x where y = 0. I could able to do it for single x using the following code
lm.model <- lm(y ~ x)
cc <- coef(lm.model)
f <- function(x) cc[2]*x + cc[1]
plot(x, y)
abline(coef(lm.model))
abline(h=0, col="blue")
(threshold <- uniroot(f, interval = c(0, 100))$root)
abline(v=threshold, col="blue")
x = c(33.05, 14.22, 15.35, 13.52, 8.7, 13.73, 8.28, 21.02, 9.97,
11.98, 12.87, 5.05, 11.23, 11.65, 10.05, 12.58, 13.88, 9.66,
4.62, 4.56, 5.35, 3.7, 3.29, 4.87, 3.75, 6.55, 4.51, 7.77, 4.7,
4.18, 25.14, 18.08, 10.41)
y = c(16.22699279, 15.78620732, 9.656361014, -17.32805679, -20.85685895,
7.601993251, -4.776053714, 10.50972236, 3.853479771, 7.713563136,
8.579366561, 14.16989395, 7.484692081, -1.2807472, -12.13759458,
-0.29138513, -5.238157067, -2.033194068, -38.12157566, -33.61912493,
-9.763657548, -0.240863712, 9.090638907, 7.345492608, 6.949676888,
-19.94866471, 0.995659732, -1.162616185, 5.497998429, 1.656653092,
2.116687436, 22.23175649, 10.33039543)
But I have multiple x variables. Now how can I apply it for multiple x variables at a time?
Here is an example data
df = structure(list(y = c(16.2269927925813, 15.7862073196372, 9.65636101412767,
-17.3280567922775, -20.8568589521297, 7.6019932507973, -4.77605371404423,
10.5097223644541, 3.85347977129367, 7.71356313645697, 8.57936656085966,
14.1698939499927, 7.4846920807874, -1.28074719969249, -12.1375945758837,
-0.291385130176774, -5.23815706681139, -2.03319406769161, -38.1215756639013,
-33.6191249261727, -9.76365754821171, -0.240863712421707, 9.09063890677045,
7.34549260800693, 6.94967688778232, -19.9486647079697, 0.995659731521127,
-1.16261618452931, 5.49799842947493, 1.65665309209479, 2.11668743610013,
22.2317564898722, 10.3303954315884), x1 = c(8.56, 8.66, 9.09,
8.36, 8.3, 8.63, 8.78, 8.44, 8.34, 8.46, 8.33, 8.19, 8.58, 8.65,
8.75, 8.34, 8.77, 9.06, 9.31, 9.11, 9.26, 9.81, 9.68, 9.79, 9.26,
9.53, 8.89, 8.89, 10.37, 9.58, 10.27, 10.16, 10.27), x2 = c(164,
328.3, 0, 590.2, 406.6, 188.4, 423.8, 355.3, 337.6, 0, 0, 200.1,
0, 315.8, 547.5, 225.6, 655.7, 387.2, 0, 487.4, 400.4, 0, 234.9,
275.5, 0, 0, 613.2, 207.4, 184.4, 162.8, 220, 174.8, 0), x3 = c(4517.7,
2953.4, 2899.3, 2573.8, 3310.7, 3880.3, 3016.8, 3552.3, 2960.1,
323, 2638.5, 3343.1, 3274.7, 3218, 3268.3, 3507.9, 3709.2, 3537.5,
2634.4, 1964.6, 3333.7, 2809.7, 3326.8, 3524.5, 3893.9, 3166.7,
3992.1, 4324.7, 3077.9, 3069.9, 4218.9, 3897.4, 2693.9), x4 = c(14.7,
14.5, 15.5, 17, 16.2, 15.9, 15.7, 15.3, 13.5, 14, 15.4, 16.2,
15.6, 15.7, 15.1, 15.8, 15.3, 14.9, 15.7, 16.3, 15.21000004,
16.7, 15.6, 16.2, 15.7, 16.3, 17.3, 16.9, 15.7, 14.9, 13.81999969,
14.90754509, 12.42847157), x5 = c(28.3, 29.1, 28.3, 29.1, 28.7,
29.3, 28.9, 28.4, 29.3, 29.3, 29.1, 29, 29.9, 29.5, 28.4, 30.3,
29.1, 29.1, 29, 29.5, 29.3, 28.5, 29, 28.7, 29.4, 28.8, 29.2,
30.1, 28.3, 28.7, 24.96999931, 25.79496384, 25.3072052), x6 = c(33.05,
14.22, 15.35, 13.52, 8.7, 13.73, 8.28, 21.02, 9.97, 11.98, 12.87,
5.05, 11.23, 11.65, 10.05, 12.58, 13.88, 9.66, 4.62, 4.56, 5.35,
3.7, 3.29, 4.87, 3.75, 6.55, 4.51, 7.77, 4.7, 4.18, 25.14, 18.08,
10.41), x7 = c(13.8425, 11.1175, 8.95, 13.5375, 5.4025, 13.5625,
13.735, 14.14, 8.0875, 5.565, 12.255, 3.3075, 6.345, 4.8125,
4.0325, 11.475, 10.32, 17.71, 2.3375, 3.92, 5.7, 2.42, 8.3075,
7.4725, 7.7925, 10.8725, 8.005, 11.7475, 13.405, 8.425, 47.155,
26.1, 6.6675), x8 = c(0.95, 3.01, 1.92, 1.51, 2.61, 1.32, 3.55,
1.21, 2.14, 1.1, 1.32, 0.76, 1.34, 5.41, 9.38, 6.55, 4.44, 7.37,
9.84, 12.68, 15.52, 23.01, 18.59, 21.64, 19.69, 25.22, 22.38,
25.03, 37.42, 22.26, 2.1, 3.01, 0.82), x9 = c(26.2, 25.8, 25.8,
25.5, 26, 24.7, 22.9, 25.3, 26.3, 26.1, 22.5, 25.9, 26.4, 25.2,
25.8, 25.4, 25, 23.2, 26.4, 25.8, 26.6, 26.2, 25.8, 26.8, 25,
25.4, 25.6, 26.1, 25.7, 25.8, 24.78000069, 24.98148918, 26.39899826
), x10 = c(35.4, 39, 37.5, 36.4, 37.1, 36.2, 37.3, 36.4, 37.5,
36, 36.6, 35.6, 37.3, 38.3, 37, 37.5, 37.5, 39.6, 37.8, 36.8,
36.6, 38.4, 38.9, 38.4, 38.4, 37.7, 39.1, 37.7, 37.8, 39.4, 36.25,
35.57029343, 35.57416534), x11 = c(653.86191565, 383.1, 457.1,
591.4, 549.2, 475.2, 626.4, 308.8, 652.4, 77, 380.9, 530.5, 393,
712.1, 623.4, 515.7, 706.4, 713.4, 343.7, 559.5, 630.1, 292.3,
578.6, 628.88904574, 480.96959685, 591.35600287, 804.8, 419.6,
403.7, 361.2, 515.07101438, 434.66682808, 299.9531298), x12 = c(163.9793854,
167.9, 135, 215.8, 213, 188.4, 260.6, 191.8, 337.6, 55, 147.6,
200.1, 140.7, 315.8, 189.6, 225.6, 469.3, 201.8, 140, 297.2,
204.6, 142.5, 234.9, 275.494751, 153.7796173, 147.6174622, 433.6,
207.4, 184.4, 162.8, 219.9721832, 174.8355713, 106.8163605),
x13 = c(92, 67, 67, 50, 70, 87, 68, 86, 70, 11, 66, 79, 70,
61, 75, 78, 78, 77, 69, 35, 72, 76, 69, 84, 93, 73, 81, 99,
80, 76, 101, 86, 80), x14 = c(70, 42, 46, 34, 55, 60, 51,
65, 49, 1, 40, 56, 54, 41, 48, 57, 46, 50, 41, 22, 47, 47,
49, 57, 70, 52, 56, 70, 48, 50, 74, 66, 47), x15 = c(21,
12, 13, 10, 14, 16, 10, 13, 10, 0, 9, 14, 16, 20, 14, 14,
13, 15, 10, 7, 17, 8, 14, 14, 14, 11, 17, 19, 12, 11, 17,
17, 9), x16 = c(1076.8, 783.7, 711.8, 1041.9, 957.4, 939.3,
662.9, 768.1, 770.3, 0, 399.2, 606.2, 724.1, 960.8, 943.8,
737.8, 1477.4, 1191.7, 371.3, 956.4, 1251.7, 345.7, 1210.7,
845, 598.1, 821.7, 1310.6, 940.1, 581, 520, 313.5, 606.8,
201.2), x17 = c(163.9793854, 167.9, 128.4, 215.8, 213, 188.4,
260.6, 191.8, 337.6, 55, 147.6, 200.1, 140.7, 315.8, 189.6,
225.6, 469.3, 201.8, 140, 297.2, 204.6, 142.5, 234.9, 157.7472534,
153.7796173, 147.6174622, 133.1873627, 150.2, 184.4, 162.8,
219.9721832, 174.8355713, 106.8163605)), row.names = c(NA,
33L), class = "data.frame")
You can use purrr::map to loop through every x.
library(dplyr)
library(purrr)
thresholds <- df %>%
select(-y) %>%
map_dbl(function(x){
lm.model <- lm(df$y ~ x)
cc <- coef(lm.model)
f <- function(x) cc[2]*x + cc[1]
plot(x, df$y)
abline(coef(lm.model))
abline(h=0, col="blue")
threshold <- tryCatch(uniroot(f, interval = c(0, 100))$root, error = function(cond){NA})
abline(v=threshold, col="blue")
return(threshold)})
For some x's, uniroot(f, interval = c(0, 100))$root yields an error: Error
in uniroot(f, interval = c(0, 100)) : f() values at end points not of opposite sign
So the tryCatch is used to return NA for the threshold associated with that x, instead of breaking the code.
Result:
> thresholds
x1 x2 x3 x4 x5 x6 x7 x8 x9
9.023314 NA NA 15.459841 28.727293 10.514728 10.493577 9.669244 25.522480
x10 x11 x12 x13 x14 x15 x16 x17
37.370852 NA NA 73.398380 50.239522 13.022176 NA NA
Edit: binding the graphs together
graphs <- df %>%
select(-y) %>%
imap(function(x, name){
lm.model <- lm(df$y ~ x)
cc <- coef(lm.model)
f <- function(x) cc[2]*x + cc[1]
threshold <- tryCatch(uniroot(f, interval = c(0, 100))$root, error = function(cond){NA})
g = ggplot(mapping = aes(x)) +
geom_point(aes(y = df$y)) +
geom_line(aes(y = cc[2]*x + cc[1])) +
geom_hline(yintercept = 0, color = "blue") +
labs(title = name, y = "y", x = "x")
if(!is.na(threshold)) {g = g + geom_vline(xintercept = threshold, color = "blue")}
return(g)})
ggpubr::ggarrange(plotlist = graphs)
Result:
Obs2: i assumed that you don't need the thresholds vector defined in the first attempt, if you still need it, it's easy to add it back to the answer
Obs1: let me know if you want any aesthetic change on the graphs
Edit 2: graph with common axis
To use a common axis is better to use facets instead of ggarrange. In order to do that, we need to first save the fitted data for all variables, then plot, so the ggplot expression goes out of the map. Also, we now save the treshold info.
graphs <- df %>%
select(-y) %>%
imap(function(x, name){
lm.model <- lm(df$y ~ x)
cc <- coef(lm.model)
f <- function(x) cc[2]*x + cc[1]
threshold <- tryCatch(uniroot(f, interval = c(0, 100))$root, error = function(cond){NA})
list(threshold = threshold,
data = tibble(y = df$y, "name" = name, "x" = x, "fitted" = cc[2]*x + cc[1]))})
Now we use the purrr::transpose() function to build a dataset for the data and other for the treshold. This functions does something like:
list(x1 = list(treshold, data), x2 = ...) >>> list(treshold = list(x1, x2, ...), data = list(x1, x2, ...))
df2 = graphs %>%
transpose() %>%
`$`(data) %>%
bind_rows() %>%
mutate(name = factor(name, paste0("x", 1:17)))
thresholds = graphs %>%
transpose() %>%
`$`(threshold) %>%
{tibble(int = as.numeric(.), name = names(.))} #both datasets have the name column, to be used inside `facet_wrap()`
ggplot(df2, aes(x)) +
geom_point(aes(y = y)) +
geom_line(aes(y = fitted)) +
facet_wrap(vars(name), scales = "free_x") +
geom_hline(yintercept = 0, color = "blue") +
geom_vline(aes(xintercept = int), thresholds, color = "blue", linetype = 2) +
geom_label(aes(label = round(int, 2), x = int*1, y = min(df$y)), thresholds, size = 4)
Result:
Obs1: the labels position and size can be easily altered. Another option is using the thresholds as a axis break
Obs2: this method can be slow for large datasets. A more efficient option is to save only threshold and cc inside map, and then building the dataset after it.
I'm reviewing factors related to cancer and hoping to find how they're related to one another. After I input my .xslx file into R, I'm at a loss how to use that list of data to find the z-scores for each measurement and then using that matrix Z of z-scores of X to compute the covariance matrix of A using cov(Z). How do I plot and analyze entries of A (which tell me how correlated the measurements in X are)?
This is an example of the plot I'm trying to achieve with my factors (UrbanPop, Rape, Assault, and Murder are factors of that plot -- you can ignore the states plotted).
Thank you!
The factors I'm reviewing are Age, BMI, Glucose, Insulin, HOMA, Leptin, Adiponectin, Resistin, MCP.1
This is my data -- I used dput(mydata)
structure(list(Age = c(48, 83, 82, 68, 86, 49, 89, 76, 73, 75,
34, 29, 25, 24, 38, 44, 47, 61, 64, 32, 36, 34, 29, 35, 54, 45,
50, 66, 35, 36, 66, 53, 28, 43, 51, 67, 66, 69, 60, 77, 76, 76,
75, 69, 71, 66, 75, 78, 69, 85, 76, 77, 45, 45, 49, 34, 42, 68,
51, 62, 38, 69, 49, 51, 59, 45, 54, 64, 46, 44, 45, 44, 51, 72,
46, 43, 55, 43, 86, 41, 59, 81, 48, 71, 42, 65, 48, 85, 48, 58,
40, 82, 52, 49, 60, 49, 44, 40, 71, 69, 74, 66, 65, 72, 57, 73,
45, 46, 68, 75, 54, 45, 62, 65, 72, 86), BMI = c(23.5, 20.69049,
23.12467, 21.36752, 21.11111, 22.85446, 22.7, 23.8, 22, 23, 21.47,
23.01, 22.86, 18.67, 23.34, 20.76, 22.03, 32.03896, 34.52972,
36.51264, 28.57668, 31.97501, 32.27079, 30.27682, 30.48316, 37.03561,
38.57876, 31.44654, 35.25076, 34.17489, 36.21228, 36.79017, 35.85581,
34.42217, 27.68878, 29.60677, 31.23859, 35.0927, 26.34929, 35.58793,
29.21841, 27.2, 27.3, 32.5, 30.3, 27.7, 25.7, 25.3, 29.4, 26.6,
27.1, 25.9, 21.30395, 20.83, 20.95661, 24.24242, 21.35991, 21.08281,
19.13265, 22.65625, 22.49964, 21.51386, 21.36752, 22.89282, 22.83288,
23.1405, 24.21875, 22.22222, 20.83, 19.56, 20.26, 24.74, 18.37,
23.62, 22.21, 26.5625, 31.97501, 31.25, 26.66667, 26.67276, 28.67263,
31.64037, 32.46191, 25.5102, 29.29688, 29.66655, 28.125, 27.68878,
31.25, 29.15452, 30.83653, 31.21748, 30.80125, 32.46191, 31.23141,
29.77778, 27.88762, 27.63605, 27.91552, 28.44444, 28.65014, 26.5625,
30.91558, 29.13632, 34.83815, 37.10938, 29.38476, 33.18, 35.56,
30.48, 36.05, 26.85, 26.84, 32.05, 25.59, 27.18), Glucose = c(70,
92, 91, 77, 92, 92, 77, 118, 97, 83, 78, 82, 82, 88, 75, 86,
84, 85, 95, 87, 86, 87, 84, 84, 90, 83, 106, 90, 90, 80, 101,
101, 87, 89, 77, 79, 82, 101, 103, 76, 83, 94, 85, 93, 102, 90,
94, 60, 89, 96, 110, 85, 102, 74, 94, 92, 93, 102, 93, 92, 95,
112, 78, 103, 98, 116, 86, 98, 88, 114, 92, 106, 105, 105, 86,
101, 92, 103, 201, 97, 77, 100, 99, 112, 98, 85, 90, 196, 199,
139, 128, 100, 87, 134, 131, 70, 99, 103, 104, 108, 88, 89, 97,
83, 95, 134, 90, 92, 131, 152, 119, 92, 100, 97, 82, 138), Insulin = c(2.707,
3.115, 4.498, 3.226, 3.549, 3.226, 4.69, 6.47, 3.35, 4.952, 3.469,
5.663, 4.09, 6.107, 5.782, 7.553, 2.869, 18.077, 4.427, 14.026,
4.345, 4.53, 5.81, 4.376, 5.537, 6.76, 6.703, 9.245, 6.817, 6.59,
15.533, 10.175, 8.576, 23.194, 3.855, 5.819, 4.181, 5.646, 5.138,
3.881, 5.376, 14.07, 5.197, 5.43, 8.34, 6.042, 8.079, 3.508,
10.704, 4.462, 26.211, 4.58, 13.852, 4.56, 12.305, 21.699, 2.999,
6.2, 4.364, 3.482, 5.261, 6.683, 2.64, 2.74, 6.862, 4.902, 3.73,
5.7, 3.42, 15.89, 3.44, 58.46, 6.03, 4.42, 36.94, 10.555, 16.635,
4.328, 41.611, 22.033, 3.188, 9.669, 28.677, 10.395, 4.172, 14.649,
2.54, 51.814, 12.162, 16.582, 41.894, 18.077, 30.212, 24.887,
30.13, 8.396, 9.208, 2.432, 18.2, 8.808, 3.012, 6.524, 10.491,
10.949, 12.548, 5.636, 4.713, 5.75, 8.15, 7.01, 11.91, 3.33,
4.53, 5.73, 2.82, 19.91), HOMA = c(0.467409, 0.706897, 1.009651,
0.612725, 0.805386, 0.732087, 0.890787, 1.883201, 0.801543, 1.013839,
0.667436, 1.145436, 0.827271, 1.33, 1.06967, 1.6, 0.59, 3.790144,
1.037394, 3.00998, 0.921719, 0.972138, 1.203832, 0.906707, 1.229214,
1.383997, 1.752611, 2.05239, 1.513374, 1.300427, 3.869788, 2.534932,
1.84041, 5.091856, 0.732193, 1.133929, 0.845677, 1.406607, 1.305395,
0.727558, 1.100646, 3.262364, 1.089638, 1.245642, 2.098344, 1.341324,
1.873251, 0.519184, 2.349885, 1.056602, 7.111918, 0.960273, 3.485163,
0.832352, 2.853119, 4.924226, 0.687971, 1.55992, 1.001102, 0.790182,
1.232828, 1.84629, 0.507936, 0.696143, 1.658774, 1.402626, 0.791257,
1.37788, 0.742368, 4.468268, 0.780651, 15.28534, 1.56177, 1.14478,
7.836205, 2.629602, 3.775036, 1.099601, 20.63073, 5.271762, 0.605507,
2.38502, 7.002923, 2.871792, 1.008511, 3.071407, 0.56388, 25.05034,
5.96992, 5.685415, 13.22733, 4.458993, 6.483495, 8.225983, 9.736007,
1.449709, 2.248594, 0.61789, 4.668907, 2.346451, 0.653805, 1.432235,
2.510147, 2.241625, 2.940415, 1.862886, 1.046286, 1.304867, 2.633537,
2.628283, 3.495982, 0.755688, 1.1174, 1.370998, 0.570392, 6.777364
), Leptin = c(8.8071, 8.8438, 17.9393, 9.8827, 6.6994, 6.8317,
6.964, 4.311, 4.47, 17.127, 14.57, 35.59, 20.45, 8.88, 15.26,
14.09, 26.65, 30.7729, 21.2117, 49.3727, 15.1248, 28.7502, 45.6196,
39.2134, 12.331, 39.9802, 46.6401, 45.9624, 50.6094, 10.2809,
74.7069, 27.1841, 68.5102, 31.2128, 20.092, 21.9033, 16.2247,
83.4821, 24.2998, 21.7863, 28.562, 35.891, 10.39, 15.145, 56.502,
24.846, 65.926, 6.633, 45.272, 7.85, 21.778, 13.74, 7.6476, 7.7529,
11.2406, 16.7353, 19.0826, 9.6994, 11.0816, 9.8648, 8.438, 32.58,
6.3339, 8.0163, 14.9037, 17.9973, 8.6874, 12.1905, 12.87, 13.08,
7.65, 18.16, 9.62, 21.78, 10.16, 9.8, 37.2234, 25.7816, 47.647,
44.7059, 17.022, 38.8066, 46.076, 19.0653, 12.2617, 26.5166,
15.5325, 70.8824, 18.1314, 22.8884, 31.0385, 31.6453, 29.2739,
42.3914, 37.843, 51.3387, 12.6757, 14.3224, 53.4997, 14.7485,
31.1233, 14.9084, 44.0217, 26.8081, 33.1612, 41.4064, 23.8479,
18.69, 17.87, 50.53, 89.27, 54.68, 12.45, 61.48, 24.96, 90.28
), Adiponectin = c(9.7024, 5.429285, 22.43204, 7.16956, 4.81924,
13.67975, 5.589865, 13.25132, 10.35873, 11.57899, 13.11, 26.72,
23.67, 36.06, 17.95, 20.32, 38.04, 7.780255, 5.46262, 5.1, 8.6,
7.64276, 6.209635, 9.048185, 9.73138, 4.617125, 4.667645, 10.35526,
6.966895, 5.065915, 7.53955, 20.03, 4.7942, 8.300955, 3.19209,
2.19428, 4.267105, 6.796985, 2.19428, 8.12555, 7.36996, 9.34663,
9.000805, 11.78796, 8.13, 7.652055, 3.74122, 10.5673, 8.2863,
7.9317, 4.935635, 9.75326, 21.05663, 8.237405, 8.412175, 21.82375,
8.462915, 8.574655, 5.80762, 11.23624, 4.77192, 4.138025, 3.886145,
9.349775, 4.230105, 4.294705, 3.70523, 4.783985, 18.55, 20.37,
16.67, 16.1, 12.76, 17.86, 9.76, 6.420295, 11.01846, 12.71896,
5.357135, 13.49487, 16.44048, 10.63653, 21.57, 5.4861, 6.695585,
7.28287, 10.22231, 7.901685, 4.104105, 10.26266, 6.160995, 9.92365,
6.26854, 10.79394, 8.40443, 10.73174, 5.47817, 6.78387, 1.65602,
5.288025, 7.65222, 8.42996, 3.71009, 2.78491, 2.36495, 3.335665,
6.644245, 9.16, 11.9, 10.06, 8.01, 12.1, 21.42, 22.54, 33.75,
14.11), Resistin = c(7.99585, 4.06405, 9.27715, 12.766, 10.57635,
10.3176, 12.9361, 5.1042, 6.28445, 7.0913, 6.92, 4.58, 5.14,
6.85, 9.35, 7.64, 3.32, 13.68392, 6.70188, 17.10223, 9.1539,
5.62592, 24.6033, 16.43706, 10.19299, 8.70448, 11.78388, 23.3819,
22.03703, 15.72187, 22.32024, 10.26309, 21.44366, 6.71026, 10.37518,
4.2075, 3.29175, 82.1, 20.2535, 17.2615, 8.04375, 8.4156, 7.5767,
11.78796, 4.2989, 6.7052, 4.49685, 4.6638, 4.53, 9.6135, 8.49395,
11.774, 23.03408, 28.0323, 23.1177, 12.06534, 17.37615, 13.74244,
5.57055, 10.69548, 15.73606, 15.69876, 22.94254, 11.55492, 8.2049,
5.2633, 10.34455, 13.91245, 13.56, 4.62, 7.84, 5.31, 3.21, 4.82,
5.68, 16.1, 7.16514, 38.6531, 24.3701, 27.8325, 31.6904, 29.5583,
10.15726, 42.7447, 53.6717, 19.46324, 16.11032, 55.2153, 53.6308,
13.97399, 17.55503, 19.94687, 24.24591, 5.768, 11.50005, 20.76801,
23.03306, 26.0136, 49.24184, 16.48508, 18.35574, 14.91922, 20.4685,
14.76966, 9.9542, 6.89235, 15.55625, 8.89, 4.19, 11.73, 5.06,
10.96, 7.32, 10.33, 3.27, 4.35), MCP.1 = c(417.114, 468.786,
554.697, 928.22, 773.92, 530.41, 1256.083, 280.694, 136.855,
318.302, 354.6, 174.8, 313.73, 632.22, 165.02, 63.61, 191.72,
444.395, 252.449, 588.46, 534.224, 572.783, 904.981, 733.797,
1227.91, 586.173, 887.16, 1102.11, 667.928, 581.313, 864.968,
695.754, 358.624, 960.246, 473.859, 585.307, 634.602, 263.499,
378.996, 618.272, 698.789, 377.227, 335.393, 270.142, 200.976,
225.88, 206.802, 209.749, 215.769, 232.006, 45.843, 488.829,
552.444, 382.955, 573.63, 481.949, 321.919, 448.799, 90.6, 703.973,
199.055, 713.239, 737.672, 359.232, 355.31, 518.586, 635.049,
395.976, 301.21, 220.66, 193.87, 244.75, 513.66, 195.94, 312,
806.724, 483.377, 775.322, 1698.44, 783.796, 910.489, 426.175,
738.034, 799.898, 1041.843, 1698.44, 1698.44, 1078.359, 1698.44,
923.886, 638.261, 994.316, 764.667, 656.393, 396.021, 602.486,
407.206, 293.123, 256.001, 353.568, 572.401, 269.487, 396.648,
232.018, 655.834, 788.902, 621.273, 209.19, 198.4, 99.45, 218.28,
268.23, 330.16, 314.05, 392.46, 90.09)), class = "data.frame", row.names = c(NA,
-116L))
To get the z-scores you can use scale() and to get the covariance matrix you can use cov(). But, there is no reason to produce the covariance matrix from the z-scores instead of the raw data. You can also visualize a correlation matrix using the corrplot function in the corrplot package. The corrplot function will also take the raw data as an input. Not the covariance matrix.
I have a scatter plot of data points, and I am able to use abline to create the quadrant lines. Now I'm trying to color the points of those in quadrant 1 and quadrant 3. I am going to plot all the points first, and then plot only those in quadrant one in red, and those in quadrant three in blue. They will be superimposed on the old ones. However, I don't know how to plot points by quadrant. Thank you.
"write the R code to plot the points that are in the(Q1,Q1) quadrant of(waiting, eruption) in Red, AND the points that are in the(Q3,Q3) Quadrant of(waiting, eruption) in blue, everything else in black, use a pch=19 and cex=0.5. (Hint, plot everything with pch=19, col="black" first, then add the conditional points with the required colors, they will be superimposed on the old ones, whatever left stays in black)."
This is my foundation:
plot(faithful$waiting, faithful$eruptions, pch=19, cex=0.5, col="black")
I realize I somehow need to plot only those in quadrant 1 in a color and then plot those in quadrant 3 in another color, and run that code after my foundation. But I'm not sure how. Thanks.
The dput(faithful) is:
structure(list(eruptions = c(3.6, 1.8, 3.333, 2.283, 4.533, 2.883,
4.7, 3.6, 1.95, 4.35, 1.833, 3.917, 4.2, 1.75, 4.7, 2.167, 1.75,
4.8, 1.6, 4.25, 1.8, 1.75, 3.45, 3.067, 4.533, 3.6, 1.967, 4.083,
3.85, 4.433, 4.3, 4.467, 3.367, 4.033, 3.833, 2.017, 1.867, 4.833,
1.833, 4.783, 4.35, 1.883, 4.567, 1.75, 4.533, 3.317, 3.833,
2.1, 4.633, 2, 4.8, 4.716, 1.833, 4.833, 1.733, 4.883, 3.717,
1.667, 4.567, 4.317, 2.233, 4.5, 1.75, 4.8, 1.817, 4.4, 4.167,
4.7, 2.067, 4.7, 4.033, 1.967, 4.5, 4, 1.983, 5.067, 2.017, 4.567,
3.883, 3.6, 4.133, 4.333, 4.1, 2.633, 4.067, 4.933, 3.95, 4.517,
2.167, 4, 2.2, 4.333, 1.867, 4.817, 1.833, 4.3, 4.667, 3.75,
1.867, 4.9, 2.483, 4.367, 2.1, 4.5, 4.05, 1.867, 4.7, 1.783,
4.85, 3.683, 4.733, 2.3, 4.9, 4.417, 1.7, 4.633, 2.317, 4.6,
1.817, 4.417, 2.617, 4.067, 4.25, 1.967, 4.6, 3.767, 1.917, 4.5,
2.267, 4.65, 1.867, 4.167, 2.8, 4.333, 1.833, 4.383, 1.883, 4.933,
2.033, 3.733, 4.233, 2.233, 4.533, 4.817, 4.333, 1.983, 4.633,
2.017, 5.1, 1.8, 5.033, 4, 2.4, 4.6, 3.567, 4, 4.5, 4.083, 1.8,
3.967, 2.2, 4.15, 2, 3.833, 3.5, 4.583, 2.367, 5, 1.933, 4.617,
1.917, 2.083, 4.583, 3.333, 4.167, 4.333, 4.5, 2.417, 4, 4.167,
1.883, 4.583, 4.25, 3.767, 2.033, 4.433, 4.083, 1.833, 4.417,
2.183, 4.8, 1.833, 4.8, 4.1, 3.966, 4.233, 3.5, 4.366, 2.25,
4.667, 2.1, 4.35, 4.133, 1.867, 4.6, 1.783, 4.367, 3.85, 1.933,
4.5, 2.383, 4.7, 1.867, 3.833, 3.417, 4.233, 2.4, 4.8, 2, 4.15,
1.867, 4.267, 1.75, 4.483, 4, 4.117, 4.083, 4.267, 3.917, 4.55,
4.083, 2.417, 4.183, 2.217, 4.45, 1.883, 1.85, 4.283, 3.95, 2.333,
4.15, 2.35, 4.933, 2.9, 4.583, 3.833, 2.083, 4.367, 2.133, 4.35,
2.2, 4.45, 3.567, 4.5, 4.15, 3.817, 3.917, 4.45, 2, 4.283, 4.767,
4.533, 1.85, 4.25, 1.983, 2.25, 4.75, 4.117, 2.15, 4.417, 1.817,
4.467), waiting = c(79, 54, 74, 62, 85, 55, 88, 85, 51, 85, 54,
84, 78, 47, 83, 52, 62, 84, 52, 79, 51, 47, 78, 69, 74, 83, 55,
76, 78, 79, 73, 77, 66, 80, 74, 52, 48, 80, 59, 90, 80, 58, 84,
58, 73, 83, 64, 53, 82, 59, 75, 90, 54, 80, 54, 83, 71, 64, 77,
81, 59, 84, 48, 82, 60, 92, 78, 78, 65, 73, 82, 56, 79, 71, 62,
76, 60, 78, 76, 83, 75, 82, 70, 65, 73, 88, 76, 80, 48, 86, 60,
90, 50, 78, 63, 72, 84, 75, 51, 82, 62, 88, 49, 83, 81, 47, 84,
52, 86, 81, 75, 59, 89, 79, 59, 81, 50, 85, 59, 87, 53, 69, 77,
56, 88, 81, 45, 82, 55, 90, 45, 83, 56, 89, 46, 82, 51, 86, 53,
79, 81, 60, 82, 77, 76, 59, 80, 49, 96, 53, 77, 77, 65, 81, 71,
70, 81, 93, 53, 89, 45, 86, 58, 78, 66, 76, 63, 88, 52, 93, 49,
57, 77, 68, 81, 81, 73, 50, 85, 74, 55, 77, 83, 83, 51, 78, 84,
46, 83, 55, 81, 57, 76, 84, 77, 81, 87, 77, 51, 78, 60, 82, 91,
53, 78, 46, 77, 84, 49, 83, 71, 80, 49, 75, 64, 76, 53, 94, 55,
76, 50, 82, 54, 75, 78, 79, 78, 78, 70, 79, 70, 54, 86, 50, 90,
54, 54, 77, 79, 64, 75, 47, 86, 63, 85, 82, 57, 82, 67, 74, 54,
83, 73, 73, 88, 80, 71, 83, 56, 79, 78, 84, 58, 83, 43, 60, 75,
81, 46, 90, 46, 74)), row.names = c(NA, 272L), class = "data.frame")
And how I defined my quadrants:
plot(faithful$waiting, faithful$eruptions, pch=19, cex=0.5, col="green")
abline(v=quantile(faithful$waiting, 0.75), col="red")
abline(h=quantile(faithful$eruptions,0.75),col="red")
abline(v=quantile(faithful$waiting, 0.25), col="red")
abline(h=quantile(faithful$eruptions,0.25),col="red")
mtext("Q1", side=1, at=quantile(faithful$waiting, 0.25), col="red")
mtext("Q1", side=2, at=quantile(faithful$eruptions, 0.25), col="red")
mtext("Q3", side=2, at=quantile(faithful$eruptions, 0.75), col="red")
mtext("Q3", side=1, at=quantile(faithful$waiting, 0.75), col="red")
What I've been trying, when using a grouping:
faithful$color<- 'black'
q1<-quantile(faithful$waiting, 0.25) #how do I assign the quantiles
q3<-quantile(faithful$waiting, 0.75)
faithful$color[faithful$waiting ]="red" #how do I then assign the quantiles a color
faithful$color[faithful$waiting ]="blue"
We can cut both variables into quantiles and paste the levels together to obtain a group for each quadrant.
faithful <- within(faithful, {
e.qtl <- as.integer(cut(faithful$eruptions,
quantile(faithful$eruptions, c(0, .25, .75, 1)),
include.lowest=TRUE))
w.qtl <- as.integer(cut(faithful$waiting,
quantile(faithful$waiting, c(0, .25, .75, 1)),
include.lowest=TRUE))
qtl <- as.integer(as.factor(with(faithful,
paste0(e.qtl, w.qtl))))
})
Then we can easily plot the data assigning color for each group.
colors <- rainbow(length(unique(faithful$qtl))) # create colors
# plot
plot(faithful$waiting, faithful$eruptions, type="n") # empty plot here
with(faithful, points(waiting, eruptions, col=colors[qtl], pch=19, cex=0.5))
After that add your ablines and mtext.
abline(v=quantile(faithful$waiting, 0.75), col="red")
abline(h=quantile(faithful$eruptions, 0.75),col="red")
abline(v=quantile(faithful$waiting, 0.25), col="red")
abline(h=quantile(faithful$eruptions, 0.25),col="red")
mtext("Q1", side=1, at=quantile(faithful$waiting, 0.25), col="red")
mtext("Q1", side=2, at=quantile(faithful$eruptions, 0.25), col="red")
mtext("Q3", side=2, at=quantile(faithful$eruptions, 0.75), col="red")
mtext("Q3", side=1, at=quantile(faithful$waiting, 0.75), col="red")
Result
I need to subset my data frame. I need to include values greater than 95 percentile for each column for every 5 minutes.
My data frame is t:
dput(t)
structure(list(Date = structure(c(1468814400, 1468814700, 1468815000,
1468815300, 1468815600, 1468815900, 1468816200, 1468816800, 1468817400,
1468817700, 1468818000, 1468818300, 1468818600, 1468818900, 1468819200,
1468819500, 1468819800, 1468820100, 1468820400, 1468820700, 1468821000,
1468821300, 1468821600, 1468821900, 1468822200, 1468822500, 1468822800,
1468823100, 1468823400, 1468823700), class = c("POSIXct", "POSIXt"
), tzone = ""), CPU = c(6.09, 4.96, 8.61, 1.07, 5.13, 9.7, 1.97,
4.39, 3.25, 13.5, 1.86, 3.79, 4, 2.68, 8.71, 1.99, 14, 2.96,
2.75, 15.38, 7.97, 4.41, 5.08, 16.26, 12.19, 7.05, 6.97, 17.78,
17.57, 7.23), Trans_A = c(35, 32, 18, 23, 13, 51, 12, 15, 22,
228, 219, 71, 277, 434, 414, 154, 273, 284, 331, 170, 320, 287,
277, 157, 313, 316, 629, 448, 594, 478), Trans_B = c(53, 11,
56, 10, 11, 15, 7, 91, 8, 10, 197, 98, 101, 354, 209, 449, 429,
788, 391, 312, 131, 212, 229, 189, 529, 389, 438, 662, 855, 559
), Heap_A = c(4.58, 7.81, 7.81, 3.3, 3.95, 9.75, 3.01, 10.07,
10.4, 10.64, 3.2, 9.85, 10.56, 7.51, 4.3, 7.31, 10.18, 3.54,
10.64, 9.16, 7.49, 6.61, 10.72, 6.48, 10.48, 9.97, 11.22, 10.8,
10.73, 11.94), Heap_B = c(53, 11, 56, 10, 11, 15, 7, 91, 8, 10,
197, 98, 101, 354, 209, 449, 429, 788, 391, 312, 131, 212, 229,
189, 529, 389, 438, 662, 855, 559)), .Names = c("Date", "CPU",
"Trans_A", "Trans_B", "Heap_A", "Heap_B"), row.names = c(NA,
-30L), class = "data.frame")
I can get the max values like this but I need values greater than 95th percentile for every 5 minutes. How would I do that?
library(dplyr)
ff<-t %>%
mutate(Date = as.POSIXct(Date, format = '%Y-%m-%d %H:%M:%S')
%>% cut('5 min')) %>%
group_by(Date) %>%
dplyr::summarise(mCpu=max(CPU),
mTrans_a=max(Trans_A),
mTrans_b=max(Trans_B),
mHeap_a=max(Heap_A),
mHeap_b=max(Heap_B))
You can't subset with summarise, but you can with filter. After grouping, the quantiles will be calculated for each value of Date.
For example, the following code will give you all rows with a CPU value above the 95% percentile:
library(dplyr)
ff<-t %>%
mutate(
Date = as.POSIXct(Date, format = '%Y-%m-%d %H:%M:%S') %>% cut('5 min')
) %>%
group_by(Date) %>%
filter(CPU > quantile(CPU, 0.95))
If you only want rows that have values > 95% for all columns, use:
filter(
CPU > quantile(CPU, 0.95),
Trans_a > quantile(Trans_a, 0.95),
Trans_b > quantile(Trans_b, 0.95),
Heap_A > quantile(Heap_A, 0.95),
Heap_B > quantile(Heap_B, 0.95)
)
Also see: filter_all.
I have some stock data together with some returns that are presented below.
Now I would like to coerce both the daily price changes (open, high, low, close, volume, adj. close) and the returns given to weekly or monthly values.
I know that the weekly prices can be obtained by xts::to.weekly(), but this drops the return. I don't know the exact mechanism behind the to.weekly function, but the returns need to be summarized with the sum function (I'm thinking of using xts::apply.weekly()), but then this would not be consistent with the stock price data....
How can this transition to weekly or monthly timescale be achieved efficiently?
Data <-
structure(c(64.5, 67, 72, 76, 75.75, 72, 75.5, 76, 76, 78, 78,
77.5, 79.25, 80, 76.25, 84, 89.75, 90.75, 92.25, 95.75, 94.5,
95, 92, 95.75, 100, 98, 104.25, 101.25, 100.25, 96.5, 94.75,
89, 94, 91.25, 99.25, 100.25, 100.25, 98, 96.5, 94.75, 97.5,
96.25, 99.25, 97, 98, 98.75, 97.25, 98.75, 100.25, 100.25, 103.25,
105.75, 108.5, 108.25, 103.75, 101.5, 99.75, 100, 99, 94.5, 99,
101.5, 105, 64.75, 73.25, 76.5, 76.75, 76, 75.75, 76, 76, 76,
80.75, 79, 79.5, 83, 80.5, 76.75, 91.5, 92.75, 94.75, 100.25,
96, 97.5, 96.75, 92, 100, 101.75, 104, 105, 103.25, 100.75, 99,
95.5, 92.75, 94, 97.75, 103.75, 101, 100.25, 99.5, 97.75, 96.75,
98, 99, 100, 100.75, 99.25, 98.75, 98, 102.25, 101, 103, 105,
109, 110.5, 108.25, 105, 102.25, 100.75, 100, 99.75, 98.75, 102.5,
103, 107.25, 60.75, 66.75, 71.25, 74.25, 72.25, 71.5, 74.25,
76, 76, 77, 75.75, 76, 79, 75.75, 73.25, 82, 88.75, 89.5, 91.75,
92.25, 92.75, 92, 92, 94, 97.75, 96.5, 98.5, 99.25, 93.5, 94,
88.25, 87.5, 91, 91, 98.75, 98.5, 100.25, 95.75, 95.5, 90.75,
96.75, 96, 95.25, 97, 95.75, 95.75, 96.75, 98.5, 97.25, 100.25,
102.5, 105.5, 107.5, 103.5, 102.75, 97.5, 98.25, 100, 94, 94.25,
98, 100, 103.75, 64.25, 72.75, 75.75, 75, 73.75, 75.5, 76, 76,
76, 79, 76, 79.25, 81.25, 76.75, 75.75, 88, 90.25, 93.75, 97.5,
95, 95, 92, 92, 100, 97.75, 102.75, 99.75, 100.25, 97.25, 94.5,
89, 91.75, 92.5, 97, 99.5, 100.25, 100.25, 96.75, 96, 96, 97.5,
98, 95.5, 100.75, 98, 96.75, 98, 100.25, 99.5, 102.25, 103.5,
108, 109.25, 104, 102.75, 99, 100, 100, 94.5, 97.5, 102, 103,
104.5, 6808900, 8180500, 5628500, 3238900, 3765800, 3177100,
887600, 0, 0, 3923200, 2425700, 3331200, 4058600, 3682800, 3293500,
10525000, 5664200, 3982600, 4702300, 6479800, 2565300, 2480500,
0, 3653000, 3400, 4010500, 5145800, 2782200, 3925100, 2770700,
4618500, 2712300, 1675400, 3331500, 5343000, 1169700, 0, 2095400,
1016600, 3642600, 3729400, 3575300, 3396900, 1963400, 3547300,
1865100, 2496300, 3226800, 2333200, 4285900, 3933000, 7400700,
3325200, 1848400, 21000, 4273700, 1910400, 0, 3168000, 2356000,
2184800, 1950300, 2649900, 51.5865, 58.4112, 60.8199, 60.2178,
59.2141, 60.6192, 61.0207, 61.0207, 61.0207, 63.4294, 61.0207,
63.6301, 65.2359, 61.6228, 60.8199, 70.6555, 72.462, 75.2722,
78.2831, 76.2758, 76.2758, 73.8671, 73.8671, 80.2903, 78.4838,
82.4983, 80.0896, 80.4911, 78.0824, 75.8744, 71.4584, 73.6664,
74.2686, 77.8816, 79.8889, 80.4911, 80.4911, 77.6809, 77.0787,
77.0787, 78.2831, 78.6845, 76.6773, 80.8925, 78.6845, 77.6809,
78.6845, 80.4911, 79.8889, 82.0969, 83.1005, 86.7136, 87.7172,
83.5019, 82.4983, 79.4874, 80.2903, 80.2903, 75.8744, 78.2831,
81.8961, 82.699, 83.9034, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.086956169, -0.022499605, 0.051150683,
-0.029196965, 0.005013135, -0.029925048, -0.028277819, -0.058201449,
0.030899097, 0.00817469, 0.048647746, 0.025773739, 0.007537968,
0, -0.034913177, -0.007752227, 0, 0.015625588, 0.005127543, -0.025509471,
0.054973245, -0.027295485, -0.012754736, 0.012919521, 0.022960049,
-0.007481572, 0.027638383, 0.012224579, 0.043478679, 0.011573732,
-0.048055569, -0.012018888, -0.03649651, 0.010100972, 0, 0, 0,
0.046153001, 0.009803886, 0.014563659), .Dim = c(63L, 7L), .Dimnames = list(
NULL, c("Open", "High", "Low", "Close", "Volume", "Adj.Close",
"Return")), index = structure(c(1238544000, 1238630400, 1238716800,
1238976000, 1239062400, 1239148800, 1239235200, 1239321600, 1239580800,
1239667200, 1239753600, 1239840000, 1239926400, 1240185600, 1240272000,
1240358400, 1240444800, 1240531200, 1240790400, 1240876800, 1240963200,
1241049600, 1241136000, 1241395200, 1241481600, 1241568000, 1241654400,
1241740800, 1.242e+09, 1242086400, 1242172800, 1242259200, 1242345600,
1242604800, 1242691200, 1242777600, 1242864000, 1242950400, 1243209600,
1243296000, 1243382400, 1243468800, 1243555200, 1243814400, 1243900800,
1243987200, 1244073600, 1244160000, 1244419200, 1244505600, 1244592000,
1244678400, 1244764800, 1245024000, 1245110400, 1245196800, 1245283200,
1245369600, 1245628800, 1245715200, 1245801600, 1245888000, 1245974400),
tzone = "UTC", tclass = "Date"), class = c("xts", "zoo"), .indexCLASS = "Date",
tclass = "Date", .indexTZ = "UTC", tzone = "UTC")
Use period.apply (or apply.daily, apply.weekly, etc.) with your own custom function. Something like:
library(quantmod) # for Op, Hi, Lo, Cl, and Vo functions
myFun <- function(x) {
# need coredata, so c.xts will not be dispatched
cx <- coredata(x)
c(Open = first(Op(cx)),
Hi = max(Hi(cx)),
Low = min(Lo(cx)),
Close = last(cx[,"Close"]),
Volume = sum(Vo(cx)),
Adj.Close = last(cx[,"Adj.Close"]),
Return = sum(cx[,"Return"]))
}
out <- period.apply(Data, endpoints(Data, "months"), myFun)
# Open Hi Low Close Volume Adj.Close Return
# 2009-04-30 64.5 100.25 60.75 92.0 88802000 73.8671 0.0000000
# 2009-05-29 92.0 105.00 87.50 95.5 58597300 76.6773 0.0486306
# 2009-06-26 97.0 110.50 94.00 104.5 54739400 83.9034 0.1222869