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 want to subset glioma samples as scf.glioma dataframe from the scf dataframe by removing any columns that begin with NB, which is saved as scf.control. I tried to use the select function in the dplyr library to filter out any scf.control samples from the scf dataframe but it produced an error : argument is not interpretable as logical.
library(dplyr)
scf.ann <- ann[ann$Gene.symbol=="KITLG",]
scf <- dat.filtered[rownames(dat.filtered) %in% rownames(scf.ann),]
scf.control <- scf %>% select(starts_with("NB"))
scf.glioma <- select(scf, -one_of(colnames(scf.control)) %>% colnames(scf))
Error: argument is not interpretable as logical Run
rlang::last_error() to see where the error occurred. In addition:
Warning message: In if (do.NULL) NULL else if (nc > 0L) paste0(prefix,
seq_len(nc)) else character() : the condition has length > 1 and
only the first element will be used
scf.glioma <- as.numeric(unlist(scf.glioma))
> dput(scf)
structure(list(NB_GSM97800 = c(116.2, 5.5, 2.8, 1867.7), NB_GSM97803 = c(72.8,
29, 2.7, 1321.4), NB_GSM97804 = c(89.5, 18.1, 5, 1275.8), NB_GSM97805 = c(58.6,
27.4, 4.4, 1226), NB_GSM97807 = c(71, 28.4, 0.8, 1431.1), NB_GSM97809 = c(62.7,
39.5, 1, 863.2), NB_GSM97811 = c(97.5, 82.7, 5.8, 1458.4), NB_GSM97812 = c(116.9,
80, 5.4, 1627.5), NB_GSM97816 = c(9.8, 10.5, 3.6, 470.5), NB_GSM97817 = c(148.9,
18.8, 10.1, 1224.8), NB_GSM97820 = c(121.1, 76.3, 5.6, 1192.6
), NB_GSM97825 = c(128, 83.1, 2.5, 1724.6), NB_GSM97827 = c(157.6,
101.2, 2.5, 1927.2), NB_GSM97828 = c(60.3, 5.8, 2.4, 425.2),
NB_GSM97833 = c(111.6, 84.3, 1.8, 1346.4), NB_GSM97834 = c(62.1,
29.1, 1.7, 1443.2), NB_GSM97840 = c(67, 84.1, 2.3, 1126.4
), NB_GSM97846 = c(131.3, 45.3, 1.7, 1682.3), NB_GSM97848 = c(116.3,
28.7, 11.5, 1516), NB_GSM97849 = c(141.7, 105.6, 1.7, 1854.9
), NB_GSM97850 = c(97.3, 62.6, 6, 1272.7), NB_GSM97853 = c(84.3,
89, 42.1, 1551.1), NB_GSM97855 = c(56.6, 7, 5.2, 559.8),
II_GSM97878 = c(88.7, 2.9, 14.7, 858), II_GSM97913 = c(184.4,
73.5, 2.9, 1223.3), II_GSM97932 = c(81.6, 39.8, 42.8, 1802.5
), II_GSM97939 = c(61.5, 11.6, 3.9, 462.4), II_GSM97951 = c(67.2,
37.8, 3.5, 1165.8), II_GSM97957 = c(101.8, 5.3, 2.3, 669.1
), II_GSM97972 = c(75.4, 30.7, 2.1, 1041.2), III_GSM97793 = c(203.2,
44.2, 3.6, 2168.4), III_GSM97795 = c(90, 84.1, 3.3, 1338.6
), III_GSM97802 = c(109.2, 3.3, 2.3, 206.5), III_GSM97810 = c(130.3,
90.1, 1.9, 2442.2), III_GSM97815 = c(154, 46.1, 4.1, 1500.2
), III_GSM97837 = c(164.6, 54.1, 2.6, 1630.4), III_GSM97843 = c(188.7,
142.1, 2.5, 1523.7), III_GSM97890 = c(60.2, 7, 5.2, 566.8
), III_GSM97899 = c(127.8, 11.1, 2, 1796.6), III_GSM97910 = c(28,
2.6, 1.8, 1433.3), III_GSM97916 = c(138.6, 79.3, 1.3, 1326.7
), III_GSM97920 = c(16.7, 13.9, 2.1, 495.1), III_GSM97921 = c(181.6,
107.1, 3.5, 2362.4), III_GSM97927 = c(81.6, 66, 1, 1127),
III_GSM97937 = c(78.6, 51.4, 1.2, 1382), III_GSM97941 = c(177.5,
52.1, 71.8, 1301.9), III_GSM97943 = c(70.1, 41.7, 3.5, 1822.6
), III_GSM97958 = c(167.8, 56.4, 10.2, 1789.2), III_GSM97960 = c(49.6,
36.9, 4.2, 1210), IV_GSM97794 = c(186.2, 152.3, 6, 1671.8
), IV_GSM97796 = c(189.9, 122.4, 3.2, 1539.2), IV_GSM97797 = c(196.6,
100.8, 1.1, 963.7), IV_GSM97798 = c(367.8, 308.4, 1.4, 2131
), IV_GSM97801 = c(132.1, 12, 3.1, 955.1), IV_GSM97806 = c(191.8,
95.6, 4.8, 1085.6), IV_GSM97808 = c(145.1, 151.5, 21, 2052.2
), IV_GSM97813 = c(146.6, 89.3, 1, 1103.9), IV_GSM97814 = c(224.4,
78.6, 2.9, 1890.6), IV_GSM97818 = c(40.7, 11.6, 1.7, 1737.7
), IV_GSM97819 = c(200.9, 106.9, 2, 1504.8), IV_GSM97821 = c(152.6,
94, 2.5, 1180), IV_GSM97826 = c(67.6, 47.4, 22.7, 810.3),
IV_GSM97829 = c(103.1, 61.5, 1.4, 1609.4), IV_GSM97832 = c(76.1,
28, 2.2, 1281.6), IV_GSM97836 = c(133.3, 43.1, 2.5, 1257.7
), IV_GSM97839 = c(121.2, 73.9, 1.8, 1756.5), IV_GSM97844 = c(135,
82.5, 6.6, 1624.8), IV_GSM97847 = c(137.7, 41.4, 5.7, 1080.4
), IV_GSM97851 = c(151.8, 140, 1.4, 1668.9), IV_GSM97852 = c(96.4,
118.2, 4.3, 830.6), IV_GSM97856 = c(160, 44.8, 19.4, 1824.3
), IV_GSM97858 = c(102.4, 9.3, 4.5, 1254.7), IV_GSM97859 = c(118.5,
27.8, 3.7, 577.7), IV_GSM97861 = c(181.2, 119.8, 4.4, 2091.7
), IV_GSM97863 = c(168.9, 77.9, 2.2, 1578.3), IV_GSM97869 = c(99.1,
67.5, 2.9, 984.3), IV_GSM97870 = c(81.9, 52.5, 4.3, 914.6
), IV_GSM97871 = c(142.6, 132.3, 2.6, 1445.3), IV_GSM97877 = c(85.6,
65.9, 3.4, 1508.7), IV_GSM97879 = c(56.8, 13.9, 1.3, 1456.5
), IV_GSM97882 = c(153.8, 91.6, 2, 876.2), IV_GSM97885 = c(81.1,
106.5, 1, 1240.7), IV_GSM97886 = c(66.1, 13.9, 5.4, 780.6
), IV_GSM97887 = c(111.4, 3.7, 4.4, 609.2), IV_GSM97888 = c(111.8,
34.3, 3.7, 804.8), IV_GSM97889 = c(121, 78.6, 1.2, 1204.5
), IV_GSM97891 = c(118.4, 8, 4.2, 1047), IV_GSM97892 = c(141.5,
103, 40.1, 1186.8), IV_GSM97893 = c(145.6, 49.8, 2.6, 2324
), IV_GSM97894 = c(143.6, 111.9, 8.1, 2007.1), IV_GSM97896 = c(118.3,
41.4, 8.4, 1503.7), IV_GSM97898 = c(190.8, 178.3, 2.9, 2856.6
), IV_GSM97903 = c(159.6, 45.2, 4.3, 1174.1), IV_GSM97905 = c(97.9,
38.6, 3.7, 1422), IV_GSM97906 = c(110.4, 102, 1.5, 1360.6
), IV_GSM97908 = c(76.7, 15.4, 4.4, 2207.8), IV_GSM97912 = c(43.6,
6.8, 2.2, 778.1), IV_GSM97914 = c(95.3, 3.9, 1, 905.6), IV_GSM97915 = c(193.9,
119.6, 5.5, 1666.4), IV_GSM97917 = c(802.8, 552, 3.5, 3560.7
), IV_GSM97918 = c(131.5, 80.8, 3.1, 1964.2), IV_GSM97919 = c(262.6,
254.8, 4.6, 1556), IV_GSM97922 = c(138.6, 67.5, 3.7, 770.5
), IV_GSM97924 = c(99.8, 12.3, 4.1, 879), IV_GSM97926 = c(102.5,
14.3, 1.8, 1142.9), IV_GSM97930 = c(70.6, 21.5, 4, 1740.5
), IV_GSM97931 = c(130.9, 41.7, 23.8, 558.8), IV_GSM97935 = c(121.6,
53.8, 1.6, 1180.3), IV_GSM97936 = c(121.8, 79.1, 2.7, 1830.8
), IV_GSM97938 = c(160.9, 109.4, 1.9, 1714.8), IV_GSM97940 = c(191.9,
96.7, 2.5, 1562.9), IV_GSM97942 = c(211.2, 140.6, 5.4, 1276.2
), IV_GSM97945 = c(108.8, 86.9, 1.8, 1329.3), IV_GSM97946 = c(87,
47.3, 1.1, 1587.7), IV_GSM97948 = c(117.5, 42.7, 5.4, 778.6
), IV_GSM97950 = c(260.6, 237.2, 6.9, 3320.4), IV_GSM97952 = c(248.7,
166.3, 7.8, 1446.4), IV_GSM97953 = c(173.1, 88.4, 2.6, 5287.1
), IV_GSM97954 = c(71.8, 49.4, 2.8, 1334.8), IV_GSM97955 = c(83.4,
79.8, 21.1, 919.8), IV_GSM97959 = c(100.6, 52.2, 9.2, 1607.6
), IV_GSM97961 = c(86.7, 25.8, 2.3, 1600.9), IV_GSM97963 = c(105.9,
62.7, 1.2, 933), IV_GSM97965 = c(119.9, 77.2, 4.9, 1959.5
), IV_GSM97966 = c(74.4, 50.9, 6.3, 804.2), IV_GSM97967 = c(56.9,
28.6, 1.7, 2295), IV_GSM97968 = c(74.1, 9.4, 6.2, 1142.8),
IV_GSM97969 = c(56, 67.1, 6.7, 1057.5), IV_GSM97971 = c(113.6,
52.7, 1.2, 923.4), II_GSM97799 = c(197.5, 93.3, 22.6, 1552.4
), II_GSM97823 = c(133.6, 8.7, 1.4, 1545.7), II_GSM97824 = c(66.1,
52.9, 1.1, 2014), II_GSM97830 = c(91.2, 5.3, 3.3, 613.5),
II_GSM97835 = c(109.5, 43.6, 1.9, 1556.4), II_GSM97838 = c(108.1,
50.9, 3.4, 1515.2), II_GSM97841 = c(79.2, 89.3, 4, 2068.6
), II_GSM97842 = c(149.1, 27.9, 1.4, 1190.1), II_GSM97854 = c(74.5,
49.5, 4.4, 1121.1), II_GSM97857 = c(97.4, 10.7, 5.3, 1591.9
), II_GSM97860 = c(150.3, 16.5, 14, 1937.4), II_GSM97862 = c(48.8,
19.9, 3.7, 970.9), II_GSM97864 = c(108, 51, 26.3, 1659.9),
II_GSM97866 = c(87.1, 99.9, 5, 1114.7), II_GSM97868 = c(113.6,
50.7, 2.7, 780.5), II_GSM97872 = c(62.4, 23.5, 0.8, 856.3
), II_GSM97873 = c(116.5, 42.8, 1.9, 884.9), II_GSM97874 = c(145.4,
65.3, 2.9, 1653.4), II_GSM97875 = c(196.2, 83.8, 4.7, 1884.1
), II_GSM97876 = c(138.2, 28.5, 2.9, 1599.9), II_GSM97880 = c(150.8,
11.3, 15.1, 2020.6), II_GSM97881 = c(101, 66, 8.1, 919),
II_GSM97884 = c(119, 62, 5.9, 2846.2), II_GSM97901 = c(98.8,
2.9, 15.4, 1469.7), II_GSM97902 = c(80, 44.9, 7.2, 1638.8
), II_GSM97909 = c(141.9, 66.6, 4.5, 984.5), II_GSM97911 = c(139.4,
8.9, 33.4, 1045.6), II_GSM97923 = c(198.2, 81.6, 25.4, 1875.6
), II_GSM97928 = c(80.1, 10.2, 14.2, 432.1), II_GSM97929 = c(97.8,
104.4, 8, 2026.4), II_GSM97933 = c(99.2, 51.3, 1.6, 2814.5
), II_GSM97934 = c(120.7, 46.4, 5.8, 2613.3), II_GSM97944 = c(116.6,
65.9, 7.6, 1492.6), II_GSM97949 = c(104.2, 76.1, 6.9, 2139.2
), II_GSM97956 = c(88.5, 7.1, 1, 1255.5), II_GSM97962 = c(56,
5.2, 3.6, 807.8), II_GSM97964 = c(90.5, 42.6, 1.9, 986.8),
II_GSM97970 = c(205.3, 80, 3, 1313.8), III_GSM97822 = c(85,
53.1, 4.2, 562.7), III_GSM97831 = c(94.2, 39.8, 4.3, 2129.4
), III_GSM97845 = c(147.7, 116.4, 1.1, 1918.8), III_GSM97865 = c(98.4,
29.6, 7.1, 1588.5), III_GSM97867 = c(126.2, 21.2, 2.5, 1551.4
), III_GSM97883 = c(53.4, 12.3, 1.3, 842.6), III_GSM97897 = c(133.6,
49, 1.6, 740.4), III_GSM97900 = c(150.3, 30.6, 3.8, 832),
III_GSM97904 = c(131.4, 13.8, 30.7, 2116.2), III_GSM97907 = c(87.4,
114.3, 6.3, 1129.7), III_GSM97925 = c(83.5, 17.5, 2.9, 460.9
), III_GSM97947 = c(103.7, 12.2, 2.2, 527.5)), row.names = c("207029_at",
"211124_s_at", "216974_at", "226534_at"), class = "data.frame")
> dput(scf.control)
structure(list(NB_GSM97800 = c(116.2, 5.5, 2.8, 1867.7), NB_GSM97803 = c(72.8,
29, 2.7, 1321.4), NB_GSM97804 = c(89.5, 18.1, 5, 1275.8), NB_GSM97805 = c(58.6,
27.4, 4.4, 1226), NB_GSM97807 = c(71, 28.4, 0.8, 1431.1), NB_GSM97809 = c(62.7,
39.5, 1, 863.2), NB_GSM97811 = c(97.5, 82.7, 5.8, 1458.4), NB_GSM97812 = c(116.9,
80, 5.4, 1627.5), NB_GSM97816 = c(9.8, 10.5, 3.6, 470.5), NB_GSM97817 = c(148.9,
18.8, 10.1, 1224.8), NB_GSM97820 = c(121.1, 76.3, 5.6, 1192.6
), NB_GSM97825 = c(128, 83.1, 2.5, 1724.6), NB_GSM97827 = c(157.6,
101.2, 2.5, 1927.2), NB_GSM97828 = c(60.3, 5.8, 2.4, 425.2),
NB_GSM97833 = c(111.6, 84.3, 1.8, 1346.4), NB_GSM97834 = c(62.1,
29.1, 1.7, 1443.2), NB_GSM97840 = c(67, 84.1, 2.3, 1126.4
), NB_GSM97846 = c(131.3, 45.3, 1.7, 1682.3), NB_GSM97848 = c(116.3,
28.7, 11.5, 1516), NB_GSM97849 = c(141.7, 105.6, 1.7, 1854.9
), NB_GSM97850 = c(97.3, 62.6, 6, 1272.7), NB_GSM97853 = c(84.3,
89, 42.1, 1551.1), NB_GSM97855 = c(56.6, 7, 5.2, 559.8)), row.names = c("207029_at",
"211124_s_at", "216974_at", "226534_at"), class = "data.frame")
Try this:
To remove:
library(dplyr)
scf.glioma <- scf %>%
select(-starts_with("NB"))
To subset:
scf.control <- scf %>%
select(starts_with("NB"))
I have a problem with comparing two sets of curves by using the Kolmogorow-Smirnow-test.
What I would like the program to do, is to compare each variation of Curve 1 with each variation of Curve 2. To accomplish that, I have tried to build a for-loop that iterates through Curve 1, and within that loop another loop that iterates through Curve 2.
Unfortunately, when executing the code, I get an error message about
"not enough x-Data“
When I try running the test by comparing one variation of each curve manually, it works, so I think the problem is the combination of the two loops and the KS-test.
If anyone has experienced a similar error and was able to solve the issue, I would highly appreciate any advice on how to fix it. Thank you!
Example data.frames:
Kurve1 <- structure(list(Punkte = 1:21,
Trial.1 = c(105.5, 85.3, 63.1, 54.9, 42, 34.1, 30.7,
24.2, 20.1, 15.7, 14, 11, 9.3, 7.2, 6.6,
5.3, 4.2, 3.3, 2.6, 1.8, 0.9),
Trial.2 = c(103.8, 85.2, 64.3, 54.1, 41.8, 35.9, 29,
23.7, 20.2, 15.9, 13.5, 11, 9.3, 7.3, 6.4,
5.5, 4.3, 3.4, 2.5, 1.9, 0.9),
Trial.3 = c(104.8, 87.2, 64.9, 52.8, 40.8, 35.6, 29.1,
24.5, 20.4, 16.2, 13.7, 11.2, 9.2, 7.5,
6.4, 5.5, 4.2, 3.5, 2.5, 1.8, 0.9),
Trial.4 = c(106.9, 83.9, 67.1, 55.1, 44.1, 34.1, 29.3,
22.9, 19.4, 16.7, 13.6, 10.8, 9.4, 7.4,
6.1, 5.6, 4.4, 3.5, 2.4, 1.9, 0.9),
Trial.5 = c(104.8, 84.3, 68.7, 54.8, 45.3, 35.2, 28.9,
23.1, 20.1, 16.9, 13.3, 11, 9.6, 7.1, 6.3,
5.4, 4.5, 3.4, 2.3, 2, 0.9)),
class = "data.frame", row.names = c(NA, -21L))
Kurve2 <- structure(list(Punkte = 1:21,
Trial.1 = c(103.5, 81.2, 66.2, 54.5, 45.1, 39.1, 30.9,
27, 21.9, 19.3, 16.6, 14.9, 12.9, 11, 10.1,
9.2, 8, 7.1, 6.3, 6.2, 5),
Trial.2 = c(104, 81, 66.9, 55.2, 46, 38.7, 31.2, 27.3,
22.3, 20, 17.2, 15.2, 12.9, 11.1, 10.2,
9.1, 8, 7.1, 6.4, 5.9, 5),
Trial.3 = c(103.9, 81.9, 67.2, 53.8, 45.4, 38.5, 31.5,
26.8, 22.2, 19.8, 17.4, 15.1, 13, 10.9,
10.1, 9.2, 8.1, 7.1, 6.4, 6, 4.9),
Trial.4 = c(104.2, 84.1, 68.7, 55.4, 45.1, 36.3, 32,
26.9, 22.8, 19.8, 16.8, 14.8, 13.2, 10.9,
10.3, 9.1, 8.2, 7.2, 6.3, 6.1, 5),
Trial.5 = c(103.8, 83.2, 69.2, 55.7, 44.8, 36.4, 31.4,
26.7, 22.1, 18.9, 16.9, 14.4, 13, 11.1,
10.2, 9, 7.9, 7, 6.3, 6.1, 5.1)),
class = "data.frame", row.names = c(NA, -21L))
The code I used for the loop:
for(i in 1:ncol(Kurve1)){
for(j in 1:ncol(Kurve2)){
ks.test(Kurve1$Trial.[i], Kurve2$Trial.[j], alternative = "greater")
}
}
This will work:
for(i in 1:(ncol(Kurve1) - 2)){
for(j in (i + 1):(ncol(Kurve2) - 1)){
print(paste0("Trial.", i, " - Trial.", j))
ks_result <- ks.test(Kurve1[, paste0("Trial.", i)],
Kurve2[, paste0("Trial.", j)],
alternative="greater")
print(ks_result)
}
}
Explanation:
As it is doesn't make sense to run the KS test for the same column, and also doesn't make sense to run for both Trial.1 ~ Trial.2 and Trial.2 ~ Trial.1, etc., you have to run your outer for loop from 1 to the last but one ((ncol(Kurve1) - 2)) index for Trial.* columns, and you have to run your inner for loop from the next index as the outer loop has (i + 1) to the last index ((ncol(Kurve2) - 1)) for Trial.* columns.
You can not paste strings like Trial.[i], you have to use the paste function for that. As with that the Kurve1$paste0("Trial.", i) notation not working, you have to use the extract operator [ to get the column you need (Kurve1[, paste0("Trial.", i)])
As in a (nested) for loop the ks.test runs silently, a have added a print to be able to see the results. I have also added a line print(paste0("Trial.", i, " - Trial.", j)) to tag the actual result with the columns for which it belongs.
I want to plot 12 different monthly time series data over the year range 1984-2018. I want to get a graph like the following but graphics::plot() always gives me an error - what's the solution?
Code:
datats <- ts(data, start=c(1984,1), end=c(2018,12), frequency=12)
plot(datats, ylab="PPT_MM")
Error:
Error in plotts(x = x, y = y, plot.type = plot.type, xy.labels = xy.labels, :
cannot plot more than 10 series as "multiple"
Plot: image of plot
My data:
data<-structure(list(Year = 1984:2018, X1 = c(24.2, 5.3, 59, 31.7,
93.7, 133.2, 42.8, 29.3, 12, 256.5, 0, 28.5, 22.4, 3.8, 295.4,
16.1, 7, 244.8, 79.5, 31.6, 45.1, 12.2, 14, 61.4, 117.4, 74.2,
51, 9.1, 0, 50.4, 0, 13.3, 45.1, 20.7, 25.7), X2 = c(0, 110.5,
0, 0, 13.8, 4, 23.2, 13.3, 6.1, 84.9, 103.5, 83.3, 56.5, 0, 219.4,
2.2, 0, 0, 7.5, 17.2, 47.9, 19.2, 20.5, 44.8, 7.3, 26.3, 64.1,
71.8, 4.6, 0, 80, 16.8, 65.1, 26.2, 2.8), X3 = c(3.4, 78.7, 59.4,
23.3, 109.3, 51.1, 217.3, 43.5, 5, 60.9, 75.3, 150.1, 73.7, 46,
118, 121, 52.5, 113, 98.9, 115.2, 83.1, 101.7, 30, 20.5, 73,
3.2, 241.9, 209.8, 1.6, 113.1, 207.4, 39, 27.4, 15.2, 91.6),
X4 = c(51.4, 278.3, 192.4, 56.7, 203.7, 193.7, 251.5, 80.5,
192.9, 20.8, 82.4, 49.6, 96.4, 208.5, 123, 113.8, 68.5, 88.9,
120.4, 153.2, 121.5, 165.1, 117, 143.9, 129.3, 145.4, 107.9,
1, 286.4, 209.3, 44, 55.3, 82.4, 40.3, 83.4), X5 = c(0.6,
84.6, 72.7, 39.4, 23.6, 37, 64.9, 57.5, 32, 13.7, 29.8, 33.1,
42.8, 21.2, 162.6, 9.8, 15.6, 15.3, 126.6, 133.8, 59.8, 100.5,
70, 41.7, 4.5, 29.7, 120.9, 37.7, 112.5, 37.7, 14.8, 34.3,
23.2, 35.6, 22.7), X6 = c(0, 0, 5.7, 61.9, 10.1, 0, 5.1,
3.1, 1.1, 6.3, 8.2, 0.9, 19.3, 0.5, 38.7, 5, 6.2, 4.3, 1.4,
0, 0.7, 0.9, 2, 2.7, 0.3, 5.2, 1.7, 0, 36.9, 0.3, 9.7, 26.3,
5.7, 2.2, 2.7), X7 = c(7, 1.4, 0.4, 3.6, 0, 3.8, 0, 1.4,
6.8, 0.5, 3.3, 4.1, 2.2, 1.2, 15.4, 2.4, 0.3, 4.3, 0, 0,
0, 1, 1.9, 26.8, 1.3, 0, 2.7, 3.4, 0, 2.7, 13, 6.1, 4.8,
5, 3.5), X8 = c(6.4, 1.9, 0.3, 11.6, 3, 14.6, 3.4, 8.9, 0,
3.1, 9.9, 3.2, 2.2, 4.3, 2.9, 4.9, 1.8, 2.5, 0.2, 26.3, 0,
3.5, 4.7, 5.2, 0.2, 0, 1.3, 0.7, 11.8, 0.6, 32.4, 4.1, 3.8,
7.2, 2.8), X9 = c(15.7, 0.2, 0, 0, 15.4, 0.3, 0, 3.4, 0.7,
0.6, 4.3, 5.1, 0.7, 0, 1.8, 0, 2.3, 0, 8.8, 21.5, 1, 1, 3,
4.3, 9.1, 1.2, 0.6, 5.9, 0, 2.5, 13.6, 3, 3.4, 6.8, 2.22),
X10 = c(154.4, 56, 2.6, 0.3, 33.5, 96.9, 48.8, 46.5, 31,
26, 110.9, 103.7, 0, 83.2, 3.3, 20.6, 41, 7.3, 21.2, 31.8,
47.6, 10.2, 14.5, 18.3, 23.9, 41.3, 32.1, 50.2, 22.3, 64,
25.4, 17.2, 7.4, 23.6, 87.6), X11 = c(211.2, 75.1, 180.8,
93.5, 120.8, 106, 208.5, 119.9, 141.2, 150.8, 406.3, 46,
187.7, 270.3, 113.9, 257, 189.8, 169, 144.3, 121.1, 161.3,
125, 117.2, 127.9, 122.8, 34.4, 116, 180.3, 119.7, 1024.7,
104.8, 104.5, 51.5, 38.2, 206.8), X12 = c(341.4, 121, 127.2,
12, 180.2, 129.5, 110.2, 156.7, 186.2, 67.3, 143.7, 87.6,
1.5, 177.3, 15.8, 108.6, 98.8, 43.6, 182.4, 24.1, 89.5, 100.5,
95, 82.4, 44.9, 127.1, 59.6, 28.2, 73.2, 919.5, 0, 122.9,
51.4, 17.9, 249.6)), class = "data.frame", row.names = c(NA,
-35L))
Function documentation (https://rdrr.io/r/stats/plot.ts.html) gives us some hints...
Apparently it is not possible to plot more than 10 charts on the same panel. Try for example:
datats <- ts(data[,-1], start=c(1984,1), end=c(2018,12), frequency=12)
plot(datats[,c(1:10)], ylab="PPT_MM")
It works! Then to use this method 10 looks like to be a limit.
You can use alternatively some ggplot:
library(reshape2)
library(dplyr)
library(ggplot2)
melt(data, id.vars = "Year") %>%
ggplot(aes(x = Year, y = value , group = 1)) +
geom_line() + geom_point() +
facet_wrap(. ~ variable)
The Problem
I'm trying to find a solution to overcome a deficient experimental design in establishing sampling points. The aim is to subset the original dataset, forcing sampling points stratification based on 2 factors with several levels.
I need a general formulation of the problem that may allow me to redefine the set of criteria levels.
Note
I've found examples of subseting tables based on criteria, the most relevant is a post from Brian Diggs but I cannot find a general way to apply that solution to my particular case.
The Dataset
My data.frame have 3 columns, sample id and two factors (f1 and f2).
Criteria are based on interval of values for f1 and f2.
dat <- structure(list(id = 1:203, f1 = c(22, 20.8, 20.7, 22, 12.1, 8,
20.6, 22, 22, 21.6, 0, 22, 21.4, 15.9, 21.2, 19.1, 12.5, 16.6,
14, 21.2, 14.7, 20.7, 20.5, 5.4, 19.1, 18.9, 22, 22, 22, 0, 0,
22, 1.3, 1, 0, 9.4, 7.9, 14.5, 0, 1.5, 0, 20.3, 18, 17.3, 1,
22, 0, 15, 17.9, 4.3, 19.5, 21.2, 21.2, 14.6, 2.3, 0, 6.7, 17.9,
9.5, 19, 21.6, 16.6, 11.7, 13.7, 1.5, 1, 7.6, 3.7, 18.5, 13.5,
20.9, 18.2, 11.5, 7.3, 6.5, 21.1, 22, 20.5, 20.5, 20, 16.2, 18.6,
22, 15.1, 14.4, 10.8, 17.1, 5.7, 15.1, 12.8, 14.5, 8.8, 16.8,
18.7, 1, 6.3, 1.8, 14.6, 22, 16.2, 12.9, 9.1, 2, 7.6, 7, 11.7,
1, 1, 9.6, 11, 2, 2, 14, 14.9, 7.8, 11.4, 8.3, 7.6, 9.1, 4.5,
18, 11.4, 3.1, 4.3, 9.3, 8.1, 1.4, 5.2, 14.7, 3.6, 5, 2.7, 10.3,
11.3, 17.9, 5.2, 1, 1.5, 13.2, 0, 1, 7.4, 1.7, 11.5, 20.2, 0,
14.7, 17, 15.2, 22, 22, 22, 17.2, 15.3, 10.9, 18.7, 11.2, 18.5,
20.3, 21, 20.8, 15, 21, 16.9, 18.5, 18.5, 10.3, 12.6, 15, 19.8,
21, 17.2, 16.3, 18.3, 10.3, 17.8, 11.2, 1.5, 1, 0, 1, 14, 19.1,
6.1, 19.2, 17.1, 14.5, 18.4, 22, 20.3, 6, 13, 18.3, 8.5, 15.3,
10.6, 7.2, 6.2, 1, 7.9, 2, 20, 16.3), f2 = c(100, 100, 92.9,
38.5, 100, 90.9, 100, 100, 100, 91.7, 0, 100, 71.4, 100, 100,
53.8, 28.6, 91.7, 100, 100, 64.3, 100, 92.9, 78.6, 100, 100,
27.3, 83.3, 14.3, 0, 0, 9.1, 23.1, 12.5, 0, 100, 81.8, 100, 0,
15.4, 0, 83.3, 100, 75, 7.1, 81.8, 0, 21.4, 84.6, 25, 80, 90.9,
100, 71.4, 50, 0, 46.2, 90.9, 14.3, 66.7, 90.9, 84.6, 46.2, 91.7,
33.3, 7.7, 71.4, 27.3, 46.2, 100, 100, 100, 60, 54.5, 46.2, 53.8,
91.7, 100, 100, 66.7, 45.5, 57.1, 15.4, 75, 75, 76.9, 53.8, 25,
90.9, 84.6, 91.7, 90.9, 100, 54.5, 23.1, 63.6, 30.8, 90.9, 92.9,
100, 92.3, 90.9, 12.5, 38.5, 15.4, 84.6, 27.3, 7.1, 75, 21.4,
7.7, 15.4, 84.6, 100, 69.2, 63.6, 64.3, 53.8, 92.3, 33.3, 11.1,
61.5, 66.7, 23.1, 85.7, 81.8, 41.7, 69.2, 76.9, 38.5, 9.1, 23.1,
85.7, 90, 100, 100, 14.3, 36.4, 84.6, 0, 7.7, 61.5, 25, 50, 100,
0, 63.6, 36.4, 76.9, 100, 100, 100, 100, 90.9, 100, 100, 100,
100, 100, 83.3, 100, 100, 100, 100, 50, 54.5, 71.4, 100, 85.7,
100, 75, 100, 76.9, 83.3, 100, 92.3, 33.3, 76.9, 33.3, 0, 40,
91.7, 100, 53.8, 100, 100, 100, 100, 100, 92.3, 76.9, 23.1, 84.6,
33.3, 100, 92.3, 46.2, 100, 9.1, 53.8, 7.7, 20, 42.9)), .Names = c("id",
"f1", "f2"), class = "data.frame", row.names = c(NA, -203L))
The expected output
Sampling points should ideally be grouped following a crossed design (it is not a complete factorial design).
For Factor f1: 0, 1-15, 30-60, 80-95, 100
For Factor f2: 0, 5-10, 15-20
I need to find points given all combinations of f1 and f2 intervals, something like this fashion:
gr <- expand.grid(f1=c('0', '1-15', '30-60', '80-95', '100'),
f2=c('0', '5-10', '15-20'))
> gr
f1 f2
1 0 0
2 1-15 0
3 30-60 0
4 80-95 0
5 100 0
6 0 5-10
7 1-15 5-10
8 30-60 5-10
9 80-95 5-10
10 100 5-10
11 0 15-20
12 1-15 15-20
13 30-60 15-20
14 80-95 15-20
15 100 15-20
The solution should split dat based on lines of gr.
This is not a complete factorial design since not all combinations will fulfill this particular criteria combination but it is important to identify NA's as well.
Any help will be appreciated. Please let me know if I'm providing sufficient information.
Use cut, to split f1 and f2 into factors based on your breakpoints, paste the factor together, and then split based on the combined factor.
dat$f1.group<-cut(dat$f1,c(0,1,15,30,60,80,90,95,100))
dat$f2.group<-cut(dat$f1,c(0,5,10,15,20))
gr<-expand.grid(levels(dat$f1.group),levels(dat$f2.group))
names(gr)<-c('f1.group','f2.group')
gr$combined = paste(gr$f1.group,gr$f2.group)
dat<-merge(gr,dat)[c('id','f1','f2','combined')]
split(dat,dat$combined)
That will get you a list of data.frame, with one element for each combo defined in gr. You can them easily sample by these strata.