Adding text label on a ggplotly figure - r

I have compiled the following code in R using ggplot and plotly. Everything with my graph is fine, however I would like to add a text label in the top right corner which will display my R Squared for the model I've specified. When I try to use the stat_poly_eq function it works for my standard ggplot, however it disappears in ggplotly
Is there a way for me to add the R squared automatically in ggplotly or by manually adding the label "R^2 = 0.6"?
Here is my code
library(rmsfuns)
packages <- c('tidyquant','PerformanceAnalytics','PortfolioAnalytics','tidyr',
'dplyr','lubridate','tbl2xts', 'ggplot2','plotly','ggthemes','readxl', 'ISLR','ggrepel', 'ggpmisc','mgcv')
load_pkg(packages)
data <- read_excel(path = "C:/Users/user/Documents/latest website/website/SA_dataset.xlsx", col_names = T)
data <- data %>% mutate(Date = as.Date(Date))
my.formula <- y~splines::bs(x, 3)
p1 <- ggplot(data, aes(x=Oil,y = ZAR)) +
geom_point(aes(col = VIX),size = 2, alpha = 2) +
scale_color_continuous(low = '#fb9d9d', high = '#4f042e') +
geom_smooth(aes(group=1),method ='lm',formula = my.formula,se=FALSE,,color='#56242e', linetype = 'dashed', size = 1.5) +
labs(title = 'USD-ZAR Exchange Rate vs Crude Oil Prices', subtitle = 'Higher oil prices tend to coincide with a stronger Rand',
x = 'Spot Brent Crude, USD per barrel', y= 'USD-ZAR', caption = 'Data downloaded from Yahoo Finance') +
theme_light() +
stat_poly_eq(formula = my.formula,
aes(label = stat(adj.rr.label)),
parse = TRUE, label.x = 'middle', label.y ='middle')
p2 <- ggplotly(p1)
p3 <- ggplotly(p2) %>%
layout(title = list(text = paste0('USD-ZAR Exchange Rate vs Crude Oil Prices',
'<br>',
'<sup>',
'Higher oil prices (and lower global uncertainty) tend to coincide with a stronger Rand',
'</sup>')))
I've added a reproductible of my dataset here
structure(list(Date = structure(c(16437, 16444, 16451, 16458,
16465, 16472, 16479, 16486, 16493, 16500, 16507, 16514, 16521,
16528, 16535, 16542, 16549, 16556, 16563, 16570, 16577, 16584,
16591, 16598, 16605, 16612, 16619, 16626, 16633, 16640, 16647,
16654, 16661, 16668, 16675, 16682, 16689, 16696, 16703, 16710,
16717, 16724, 16731, 16738, 16745, 16752, 16759, 16766, 16773,
16780, 16787, 16794, 16801, 16808, 16815, 16822, 16829, 16836,
16843, 16850, 16857, 16864, 16871, 16878, 16885, 16892, 16899,
16906, 16913, 16920, 16927, 16934, 16941, 16948, 16955, 16962,
16969, 16976, 16983, 16990, 16997, 17004, 17011, 17018, 17025,
17032, 17039, 17046, 17053, 17060, 17067, 17074, 17081, 17088,
17095, 17102, 17109, 17116, 17123, 17130, 17137, 17144, 17151,
17158, 17165, 17172, 17179, 17186, 17193, 17200, 17207, 17214,
17221, 17228, 17235, 17242, 17249, 17256, 17263, 17270, 17277,
17284, 17291, 17298, 17305, 17312, 17319, 17326, 17333, 17340,
17347, 17354, 17361, 17368, 17375, 17382, 17389, 17396, 17403,
17410, 17417, 17424, 17431, 17438, 17445, 17452, 17459, 17466,
17473, 17480, 17487, 17494, 17501, 17508, 17515, 17522, 17529,
17536, 17543, 17550, 17557, 17564, 17571, 17578, 17585, 17592,
17599, 17606, 17613, 17620, 17627, 17634, 17641, 17648, 17655,
17662, 17669, 17676, 17683, 17690, 17697, 17704, 17711, 17718,
17725, 17732, 17739, 17746, 17753, 17760, 17767, 17774, 17781,
17788, 17795, 17802, 17809, 17816, 17823, 17830, 17837, 17844,
17851, 17858, 17865, 17872, 17879, 17886, 17893, 17900, 17907,
17914, 17921, 17928, 17935, 17942, 17949, 17956, 17963, 17970,
17977, 17984, 17991, 17998, 18005, 18012, 18019, 18026, 18033,
18040, 18047, 18054, 18061, 18068, 18075, 18082, 18089, 18096,
18103, 18110, 18117, 18124, 18131, 18138, 18145, 18152, 18159,
18166, 18173, 18180, 18187, 18194, 18201, 18208, 18215, 18222,
18229, 18236, 18243, 18250, 18257, 18264, 18271, 18278, 18285,
18292, 18299, 18306, 18313, 18320, 18327, 18334, 18341, 18348,
18355, 18362, 18369, 18376, 18383, 18390, 18397, 18404, 18411,
18418), class = "Date"), ZAR = c(11.496, 11.549, 11.4148, 11.6468,
11.513, 11.6695, 11.6215, 11.668, 12.0395, 12.479, 12.015, 12.045,
11.798, 11.9953, 12.067, 12.1255, 12.0605, 11.926, 11.794, 11.895,
12.1555, 12.5805, 12.3809, 12.1625, 12.2025, 12.3205, 12.4505,
12.36, 12.6233, 12.6745, 12.6255, 12.8261, 12.97, 13.3044, 13.8545,
13.5795, 13.3255, 13.9135, 13.732, 13.3522, 13.0814, 13.636,
13.8247, 14.1585, 14.4019, 13.9525, 14.4061, 14.3393, 15.88,
15.0983, 15.2865, 15.471, 16.3173, 16.8098, 16.4675, 15.891,
16.0275, 15.8825, 15.398, 16.1688, 15.355, 15.2627, 15.2575,
15.4548, 14.692, 14.98, 14.5697, 14.4, 14.2345, 14.8729, 15.405,
15.6323, 15.7162, 15.093, 15.23, 15.1215, 15.065, 14.5603, 14.5333,
14.58, 14.285, 13.88, 13.725, 13.4737, 13.5075, 14.375, 14.485,
14.4196, 14.1831, 13.7139, 13.725, 13.8692, 14.3193, 13.9834,
13.8265, 13.575, 14.384, 14.4755, 14.1153, 13.8061, 13.8296,
14.08, 14.0074, 13.7386, 13.735, 13.505, 13.595, 13.47, 13.2788,
13.3588, 13.065, 12.96, 13.015, 13.1628, 12.7238, 12.4396, 13.4247,
13.76, 13.419, 13.1313, 13.3693, 13.4215, 13.356, 13.234, 12.8699,
12.8115, 12.951, 12.814, 12.9318, 13.0551, 13.395, 13.0332, 12.9158,
13.0096, 13.455, 13.4418, 13.1614, 13.038, 12.9417, 12.9376,
13.1658, 13.2438, 13.5561, 13.775, 13.2663, 13.64, 14.0641, 14.2239,
14.3704, 13.981, 14.1587, 13.7068, 13.655, 13.1464, 12.5987,
12.3724, 12.3044, 12.3612, 12.191, 11.8672, 12.0916, 12.0352,
11.6363, 11.545, 11.8966, 11.8172, 11.9745, 11.7428, 11.8385,
12.025, 12.069, 12.0989, 12.3282, 12.5, 12.254, 12.7625, 12.491,
12.6906, 13.0655, 13.4344, 13.4383, 13.7275, 13.4702, 13.2684,
13.4051, 13.1793, 13.3256, 14.104, 14.6413, 14.2087, 14.6875,
15.2372, 14.9345, 14.3136, 14.1473, 14.7747, 14.5194, 14.4188,
14.6021, 14.3048, 14.3259, 14.0227, 13.8588, 13.8692, 14.1615,
14.4016, 14.6372, 14.4298, 13.9623, 13.8351, 13.843, 13.6153,
13.3233, 13.6257, 14.0828, 13.9978, 14.229, 14.4393, 14.4146,
14.5, 14.4975, 14.096, 13.9568, 14.055, 14.3807, 14.3511, 14.1598,
14.4188, 14.4, 14.585, 14.9535, 14.8393, 14.325, 14.0808, 14.1775,
13.9857, 13.9409, 14.2963, 14.7885, 15.2623, 15.3056, 15.2519,
15.185, 14.8083, 14.5778, 14.9268, 15.1563, 15.045, 14.8055,
14.7905, 14.6329, 15.0318, 14.8605, 14.7137, 14.7175, 14.6535,
14.627, 14.5226, 14.2751, 14.0326, 14.3164, 14.3679, 14.4569,
14.3936, 15.0106, 15.0649, 14.9117, 15.0065, 15.6695, 15.6723,
16.2771, 17.6077, 17.63, 19.049, 17.9689, 18.7408, 19.0263, 18.8453,
18.3495, 18.5674, 17.6373, 17.548, 16.8765, 16.5863), Interest = c(6,
5.9, 5.8, 5.75, 6.03, 6.04, 5.95, 5.91, 5.91, 5.91, 5.91, 5.91,
6.15, 6, 6.15, 6.13, 6.16, 6.16, 6.25, 6.08, 6.25, 6.5, 6.6,
6.6, 6.45, 6.44, 6.6, 6.38, 6.44, 6.49, 6.48, 6.44, 6.44, 6.49,
6.5, 6.49, 6.49, 6.3, 6.3, 6.55, 6.55, 6.55, 6.65, 6.65, 6.65,
6.65, 6.65, 6.35, 6.35, 6.35, 6.35, 6.35, 7.3, 7.3, 6.9, 7.3,
7.3, 7.3, 7.3, 7.2, 7.3, 7.2, 7.7, 7.2, 7.1, 7.35, 7.15, 7.15,
7.35, 7.35, 7.35, 7.35, 7.15, 7.15, 7.45, 7.9, 8, 7.95, 7.45,
7.55, 8, 8, 7.35, 6.8, 7.3, 6.8, 6.95, 6.9, 7.8, 7.6, 7.3, 7.7,
7.4, 8.05, 7.5, 7.9, 7.75, 7.45, 7.8, 7.5, 7.65, 7.5, 7.15, 8,
7.31, 7.25, 7.25, 7.75, 6.85, 6.98, 6.6, 7.4, 6.8, 7.05, 6.39,
6.1, 6.4, 7.15, 6.65, 7.2, 6.75, 6.5, 6.2, 6.5, 6.4, 6.9, 6.3,
7.25, 6.7, 6.72, 6.8, 6.8, 6.75, 7.15, 6.5, 6.3, 5.95, 6.45,
6.45, 6.35, 6.25, 5.95, 5.5, 6.2, 6.6, 6.35, 7.3, 6.4, 6.15,
6.5, 6.25, 6.9, 6, 6.95, 7.15, 7.05, 5.6, 6.55, 6.55, 5.5, 6.5,
6.5, 6.5, 6.6, 6.6, 6.55, 6.35, 6.6, 7.06, 6.95, 6.35, 6.35,
6.35, 6.3, 6.3, 6.42, 6.95, 6.3, 6.38, 6.83, 6.7, 6.9, 6.9, 6.4,
6.35, 6.29, 6.85, 6.2, 6.9, 7.07, 7.08, 7.08, 6.6, 7.1, 7.1,
7.15, 7.15, 7.06, 7.06, 7.06, 6.78, 6.78, 6.99, 6.02, 7.35, 7.17,
7.3, 6.74, 7.1, 7.2, 6.4, 6.92, 6.84, 6.87, 7.01, 7, 6.95, 6.95,
6.4, 6.33, 6.15, 6.86, 6.77, 6.78, 7.1, 6.88, 6.82, 6.82, 6.81,
6.83, 6.83, 6.82, 6.76, 6.74, 6.22, 5.58, 4.9, 6.73, 6, 6.68,
6.09, 6.59, 6.75, 6.51, 6.4, 6.5, 6.62, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5.5, 5.4,
4.35, 4.3, 3.93, 3.5, 3.65, 2.29, 3.05, 3.63, 3.6, 3.55, 3.8),
Oil = c(56.03, 49.47, 46.58, 46.44, 46.76, 54.62, 56.57,
60.57, 60.63, 60.12, 56.51, 52.72, 55.01, 54.79, 56.51, 59.12,
61.41, 63.49, 65.01, 64.9, 64.31, 61.57, 61.9, 63.24, 60.65,
60.84, 60.36, 56.63, 57.17, 55.75, 54.14, 48.59, 47.94, 46,
43.53, 48.87, 47.6, 47.34, 47.33, 46.99, 51.33, 48.99, 46.81,
47.15, 47.23, 44.75, 41.54, 43.65, 42.41, 38.76, 36.84, 35.9,
36.55, 34.19, 29.1, 27.76, 31.75, 32.18, 30.41, 32.29, 33.12,
36.28, 39.3, 38.5, 39.41, 37, 37.51, 42.35, 43.04, 44.46,
44.2, 45.2, 48.34, 48.73, 48.91, 49.94, 47.39, 48.12, 47.09,
45.96, 45.54, 45.22, 42.55, 40.88, 43.63, 48.6, 48.65, 47.31,
47.51, 46.21, 46.24, 46.74, 49.52, 49.94, 50.33, 48.95, 44.63,
43.09, 44.01, 46.49, 48.78, 52.26, 53.26, 53.81, 54.96, 55.13,
54.02, 54.19, 54.91, 55.53, 54.48, 54.46, 55.4, 54.4, 52.78,
50.29, 50.1, 51.33, 53.28, 54.83, 52.08, 49.55, 48.7, 48,
51.75, 52.58, 50.23, 47.28, 46.18, 44.63, 46.16, 48.17, 47.1,
47.99, 49.95, 52.04, 51.96, 50.58, 52.03, 52.25, 53.88, 55.54,
57.03, 58.75, 56.08, 56.21, 57.78, 58.58, 61.04, 64.29, 61.52,
62.68, 63.73, 63.08, 64.35, 64.36, 66.52, 67.81, 69.47, 69.39,
70.04, 68, 65.5, 62.72, 65.52, 66.02, 65.12, 64.14, 67.4,
68.65, 67.03, 71.24, 73.39, 74.98, 74.42, 76.68, 78.75, 78.59,
75.35, 73.98, 74.26, 74.12, 75.24, 76.33, 75.29, 71.27, 74,
73.37, 71.42, 69.82, 72.77, 76.08, 76.64, 78.11, 78.97, 81.85,
85.44, 83.05, 80.41, 78.23, 74.09, 70.34, 66.21, 61.22, 58.65,
60.47, 59.51, 54.64, 51.03, 54.31, 58.64, 59.83, 61.34, 61.38,
61.71, 63.36, 66.58, 64.56, 64.73, 65.71, 67.34, 67.25, 69.54,
71.33, 70.87, 72.93, 71.59, 71.25, 73.32, 70.89, 69.29, 63.15,
63.19, 64.04, 66.51, 63.84, 65.98, 63.63, 62.8, 62.59, 57.33,
58.25, 59.57, 59.83, 60.23, 62.74, 65.56, 63.15, 59.22, 59.39,
59.32, 60.75, 60.23, 62.39, 62.56, 63.76, 64.74, 64.71, 66.5,
68.9, 68.73, 68.07, 67.93, 64.11, 62.2, 58.57, 54.59, 55.33,
58.61, 54.09, 50.7, 33.72, 25.65, 23.96, 18.72, 22.53, 20,
14.24, 17.05, 23.57, 28.18, 33.94, 33.7, 39.66), VIX = c(17.55,
20.95, 16.66, 20.97, 17.29, 14.69, 14.3, 13.34, 15.2, 16,
13.02, 15.07, 14.67, 12.58, 13.89, 12.29, 12.7, 12.86, 12.38,
12.13, 13.84, 14.21, 13.78, 13.96, 14.02, 16.79, 16.83, 11.95,
13.74, 12.12, 13.39, 12.83, 28.03, 26.05, 27.8, 23.2, 22.28,
23.62, 20.94, 17.08, 15.05, 14.46, 15.07, 14.33, 20.08, 15.47,
15.12, 14.81, 24.39, 20.7, 15.74, 18.21, 27.01, 27.02, 22.34,
20.2, 23.38, 25.4, 20.53, 19.81, 16.86, 16.5, 14.02, 14.74,
13.1, 15.36, 13.62, 13.22, 15.7, 14.72, 15.04, 15.2, 13.12,
13.47, 17.03, 19.41, 25.76, 14.77, 13.2, 12.67, 12.02, 11.87,
11.39, 11.55, 11.34, 13.65, 11.98, 17.5, 15.37, 12.29, 13.29,
13.48, 16.12, 13.34, 16.19, 22.51, 14.17, 12.85, 12.34, 14.12,
11.75, 12.2, 11.44, 14.04, 11.32, 11.23, 11.54, 10.58, 10.97,
10.85, 11.49, 11.47, 10.96, 11.66, 11.28, 12.96, 12.37, 12.87,
15.96, 14.63, 10.82, 10.57, 10.4, 12.04, 9.81, 9.75, 10.7,
10.38, 10.02, 11.18, 11.19, 9.51, 9.36, 10.29, 10.03, 15.51,
14.26, 11.28, 10.13, 12.12, 10.17, 9.59, 9.51, 9.65, 9.61,
9.97, 9.8, 9.14, 11.29, 11.43, 9.67, 11.43, 9.58, 9.42, 9.9,
11.04, 9.22, 10.16, 11.27, 11.08, 17.31, 29.06, 19.46, 16.49,
19.59, 14.64, 15.8, 24.87, 19.97, 21.49, 17.41, 16.88, 15.41,
14.77, 12.65, 13.42, 13.22, 13.46, 12.18, 11.98, 13.77, 16.09,
13.37, 12.18, 12.86, 13.03, 11.64, 13.16, 12.64, 11.99, 12.86,
14.88, 12.07, 11.68, 12.12, 14.82, 21.31, 19.89, 24.16, 19.51,
17.36, 18.14, 21.52, 18.07, 23.23, 21.63, 30.11, 28.34, 21.38,
18.19, 17.8, 17.42, 16.14, 15.72, 14.91, 13.51, 13.57, 16.05,
12.88, 16.48, 13.71, 12.82, 12.01, 12.09, 12.73, 12.87, 16.04,
15.96, 15.85, 18.71, 16.3, 15.28, 15.4, 15.08, 13.28, 12.39,
14.45, 12.16, 17.61, 17.97, 18.47, 19.87, 18.98, 15, 13.74,
15.32, 17.22, 17.04, 15.58, 14.25, 12.65, 12.3, 12.07, 12.05,
12.34, 12.62, 13.62, 12.63, 12.51, 13.43, 14.02, 12.56, 12.1,
14.56, 18.84, 15.47, 13.68, 17.08, 40.11, 41.94, 57.83, 66.04,
65.54, 46.8, 41.67, 38.15, 35.93, 37.19, 27.98, 31.89, 28.16,
27.51, 24.52, 28.27)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -284L))

The issue is that stat_poly_eq is yet not implemented in ggplotly. ggplotly should give you a warning about this. But you can add a text annotation to your plot like so, where I used TeX to get the super- and subscripts:
p3 %>%
add_annotations(
x = mean(p3$x$layout$xaxis$range),
y = mean(p3$x$layout$yaxis$range),
text = TeX("R^{2}_{adj} = 0.48"),
showarrow = F
) %>%
config(mathjax = 'cdn')

Related

Some functions in PerformanceAnalytics package are failing when use with zoo::rollapply

I am trying to use the zoo::rollapply function to chronologically calculate Sterling Ratio using the package PerformanceAnalytics. Below is my calculation -
library(zoo)
library(PerformanceAnalytics)
Orig_Data = structure(c(12.05, 12.75, 12.75, 12.55, 13.05, 14.15, 16.2, 16.5,
15.95, 16.9, 17.3, 17.5, 16.2, 16.7, 16.4, 15.95, 17.15, 16.2,
16.5, 15.35, 15.8, 16.1, 16.35, 18.3, 18.2, 17.35, 17.95, 18.35,
18.3, 17.9, 18.1, 20.65, 20.45, 20.3, 20.65, 18.7, 18.95, 18.3,
16.65, 17.05, 17.15, 16.9, 17.15, 16.55, 16.2, 16, 16.8, 16.8,
16.9, 16.75, 16.4, 15.8, 15.2, 15.15, 16.5, 16.75, 16.5, 15.85,
15.75, 15.15, 15.2, 15.45, 16.15, 16.1, 16.05, 15.7, 15.75, 15.85,
15.9, 15.5, 15.5, 15.7, 15.55, 15.45, 15.2, 14.75, 14.7, 14.1,
14.2, 14.1, 14.25, 14.35, 14, 13.4, 13.4, 13.05, 12.9, 12.8,
12.5, 12.45, 12.45, 12.6, 12.15, 12, 12.1, 12.4, 13, 12.9, 12.9,
12.7, 13.15, 11.75, 11.25, 11.05, 10.95, 11.4, 11.4, 11.45, 11.2,
10.95, 10.65, 9.9, 9.65, 9.65, 9.05, 8.6, 8.75, 8.8, 9.3, 9.85,
10.15, 9.7, 9.8, 9.85, 10.25, 11.15, 12.25, 12.75, 12.55, 12,
12.85, 12.5, 12.3, 12.6, 12.25, 11.65, 11.4, 11.2, 11.15, 10.75
), index = structure(c(15341, 15342, 15343, 15344, 15345, 15348,
15349, 15350, 15351, 15352, 15355, 15356, 15357, 15358, 15359,
15362, 15363, 15364, 15366, 15369, 15370, 15371, 15372, 15373,
15376, 15377, 15378, 15379, 15380, 15383, 15384, 15385, 15386,
15387, 15391, 15392, 15393, 15394, 15397, 15398, 15399, 15400,
15401, 15404, 15405, 15406, 15408, 15411, 15412, 15413, 15414,
15415, 15418, 15419, 15420, 15421, 15422, 15425, 15426, 15427,
15428, 15429, 15432, 15433, 15434, 15439, 15440, 15441, 15442,
15443, 15446, 15447, 15448, 15449, 15450, 15453, 15454, 15455,
15456, 15457, 15460, 15462, 15463, 15464, 15467, 15468, 15469,
15470, 15471, 15474, 15475, 15476, 15477, 15478, 15481, 15482,
15483, 15484, 15485, 15488, 15489, 15490, 15491, 15492, 15495,
15496, 15497, 15498, 15499, 15502, 15503, 15504, 15505, 15506,
15509, 15510, 15511, 15512, 15513, 15516, 15517, 15518, 15519,
15520, 15523, 15524, 15525, 15526, 15527, 15530, 15531, 15532,
15533, 15534, 15537, 15538, 15539, 15540, 15541, 15544), class = "Date"), class = "zoo")
rollapply(Orig_Data,
width = 132,
align = 'right',
function(Data) {
Start = as.character(index(Data)[1])
End = as.character(last(index(Data)))
SterlingRatio = as.vector(SterlingRatio(R = diff(log(Data))))
return(data.frame('Start' = Start,
'End' = End,
'SterlingRatio' = SterlingRatio, check.names = FALSE))
})
This code is failing with an error -
Error in try.xts(x, error = "'x' needs to be timeBased or xtsible") :
'x' needs to be timeBased or xtsible
Couple of issues with the result -
Even if I dont use the function SterlingRatio() above code is not retuning correct values for Start and End
Above error is with SterlingRatio() and SharpeRatio() functions. If I use some other function e.g. SortinoRatio() it works fine.
Any idea what is going wrong would be highly helpful.
Thanks and regards,
Both SterlingRatio and SharpeRatio have some internal checks that use of the function xtsible from the xts package. This just checks if the data is in an xts format. Which in this case it is not, it is a zoo object. Example below would return data.
rollapply(xts::as.xts(Orig_Data),
width = 132,
align = 'right',
SterlingRatio)
But using as.xts inside the function you have created above, would return an error because you would be trying to merge a data.frame with an xts object. So first you need to know how you want your output to look like.

Plot anomalies stripes line

Hi how can I make this kind of plot for anomalies? Is there ggplot function ?
The geom_tile function does the trick:
library(RColorBrewer)
col_strip <- brewer.pal(11, "RdBu")
library(ggplot2)
ggplot(df,
aes(x = date, y = 1, fill = Temp))+
geom_tile() +
scale_fill_gradientn(colors = rev(col_strip)) +
guides(fill = guide_colorbar(barwidth = 1)) +
theme_void()
Data:
structure(list(date = structure(c(-32872, -32506, -32141, -31776,
-31411, -31045, -30680, -30315, -29950, -29584, -29219, -28854,
-28489, -28123, -27758, -27393, -27028, -26662, -26297, -25932,
-25567, -25202, -24837, -24472, -24107, -23741, -23376, -23011,
-22646, -22280, -21915, -21550, -21185, -20819, -20454, -20089,
-19724, -19358, -18993, -18628, -18263, -17897, -17532, -17167,
-16802, -16436, -16071, -15706, -15341, -14975, -14610, -14245,
-13880, -13514, -13149, -12784, -12419, -12053, -11688, -11323,
-10958, -10592, -10227, -9862, -9497, -9131, -8766, -8401, -8036,
-7670, -7305, -6940, -6575, -6209, -5844, -5479, -5114, -4748,
-4383, -4018, -3653, -3287, -2922, -2557, -2192, -1826, -1461,
-1096, -731, -365, 0, 365, 730, 1096, 1461, 1826, 2191, 2557,
2922, 3287, 3652, 4018, 4383, 4748, 5113, 5479, 5844, 6209, 6574,
6940, 7305, 7670, 8035, 8401, 8766, 9131, 9496, 9862, 10227,
10592, 10957, 11323, 11688, 12053, 12418, 12784, 13149, 13514,
13879, 14245, 14610, 14975, 15340, 15706, 16071, 16436, 16801,
17167, 17532), class = "Date"), Temp = c(15.16, 16.27, 15.17,
14.83, 15.26, 14.89, 15.26, 15.68, 14.99, 14.7, 14.99, 15.02,
15.74, 16.28, 15.2, 16.11, 15.75, 16.31, 16.04, 16.88, 15.85,
15.36, 15.18, 15.75, 15.68, 15.49, 15.82, 15.44, 15.92, 15.67,
15.64, 15.43, 15.61, 15.57, 15.54, 15.77, 15.81, 15.55, 15.64,
16.28, 16.03, 16.11, 15.91, 15.87, 15.55, 15.55, 17.01, 15.9,
15.74, 15.93, 15.9, 15.66, 15.02, 15.63, 14.53, 15.05, 15.25,
15.62, 15.8, 15.46, 16.02, 15.68, 15.58, 16.45, 16.1, 16.44,
15.82, 16.3, 16.68, 17, 16.11, 16.02, 16.41, 16.79, 16.25, 17.17,
15.78, 16.18, 16.31, 16.53, 16.78, NA, 16.13, 15.64, 16.4, 15.73,
16.44, 15.76, NA, NA, 16.33, 15.53, 15.32, 16.24, 15.98, 16.12,
15.95, 16.13, 16.41, 16.22, 16.65, 16.7, 16.74, 16.48, 16.12,
16.62, 16.38, 16.98, 16.7, 17.06, 17.3, 16.56, 16.39, 15.9, 16.62,
17.7, 16.61, 17.62, 17.12, 16.5, 16.77, 16.99, 16.6, 17.36, 17,
16.86, 17.48, 16.8, 16.8, 17.26, 17.09, 17.48, 16.85, 16.84,
17.16, 17.23, 17.59, 17.95, 17.12)), class = "data.frame", row.names = c(NA,
-139L))

Using IF/Else Statements in R

This is my data.frame:
tsdata=structure(list(S.Educ = c(228.3000255, 237.2500067, 248.2500235,
235.8500022, 243.3000045, 254.9999758, 258.1000174, 261.1000144,
268.3000056, 277.1000373, 249.2000057, 234.7000229, 239.8500266,
0.66159, 0.67453, 0.64213, 0.6248, 0.65231, 228.3000255, 237.2500067,
248.2500235, 235.8500022, 243.3000045, 254.9999758, 258.1000174,
261.1000144, 268.3000056, 277.1000373, 249.2000057, 234.7000229,
239.8500266, 0.76481, 0.81037, 0.82068, 0.83542, 0.86355, 0.88456,
0.92678, 0.80906, 228.3000255, 237.2500067, 248.2500235, 235.8500022,
243.3000045, 254.9999758, 258.1000174, 261.1000144, 268.3000056
), i.Educ.A = c(6.76, 6.53, 6.93, 6.99, 7.16, 7.46, 7.16, 7.49,
7.43, 7.06, 7.43, 6.96, 6.68, 11.36, 10.86, 10.31, 10.46, 9.76,
6.76, 6.53, 6.93, 6.99, 7.16, 7.46, 7.16, 7.49, 7.43, 7.06, 7.43,
6.96, 6.68, 10.88, 10.81, 10.63, 9.75, 10.13, 12.44, 13.88, 13.25,
6.76, 6.53, 6.93, 6.99, 7.16, 7.46, 7.16, 7.49, 7.43), i.Globi.A = c(14.76,
15.16, 15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11,
11.01, 9.36, 9.44, 8.86, 9.69, 9.06, 9.56, 9.81, 14.76, 15.16,
15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11, 11.01,
9.36, 9.44, 12, 11.31, 10.06, 9.19, 8.72, 8.54, 9.56, 9.13, 14.76,
15.16, 15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56), i.Educ.B = c(6.76,
6.53, 6.93, 6.99, 7.16, 7.46, 7.16, 7.49, 7.43, 7.06, 7.43, 6.96,
6.68, 11.36, 10.86, 10.31, 10.46, 9.76, 6.76, 6.53, 6.93, 6.99,
7.16, 7.46, 7.16, 7.49, 7.43, 7.06, 7.43, 6.96, 6.68, 10.88,
10.81, 10.63, 9.75, 10.13, 12.44, 13.88, 13.25, 6.76, 6.53, 6.93,
6.99, 7.16, 7.46, 7.16, 7.49, 7.43), i.Globi.B = c(14.76, 15.16,
15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11, 11.01,
9.36, 9.44, 8.86, 9.69, 9.06, 9.56, 9.81, 14.76, 15.16, 15.56,
14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11, 11.01, 9.36,
9.44, 12, 11.31, 10.06, 9.19, 8.72, 8.54, 9.56, 9.13, 14.76,
15.16, 15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56), S.Torto = c(228.3000255,
237.2500067, 248.2500235, 235.8500022, 243.3000045, 254.9999758,
258.1000174, 261.1000144, 268.3000056, 277.1000373, 249.2000057,
234.7000229, 239.8500266, 237.850026, 239.0000239, 238.3000059,
238.8500041, 239.280016, 241.7499798, 246.4500108, 235.6499768,
234.0500179, 232.5000145, 231.6999874, 234.6700059, 233.4299733,
224.7500106, 227.0000177, 231.5800102, 237.3000006, 245.2999909,
241.8999792, 246.8999855, 245.7000042, 247.5000025, 251.5999872,
254.7999858, 259.4500127, 250.9999839, 251.5000089, 251.1999823,
248.3999935, 236.4499965, 239.0000239, 216.4999833, 211.5499951,
202.0999805, 200.2499921), i.Torto.A = c(6.76, 6.53, 6.93, 6.99,
7.16, 7.46, 7.16, 7.49, 7.43, 7.06, 7.43, 6.96, 6.68, 6.81, 6.56,
6.31, 6.81, 6.56, 6.66, 6.76, 6.75, 6.37, 6.9, 6.37, 6.4, 6.5,
6.5, 6.5, 6.5, 6.3, 6.31, 6.31, 6.38, 6.44, 6.44, 6.31, 6.38,
6.5, 6.44, 6.38, 6.38, 6.38, 6.38, 6.44, 6.56, 7.81, 7.94, 7.5
), i.Globi.A = c(14.76, 15.16, 15.56, 14.96, 14.46, 15.96, 13.16,
11.56, 11.56, 10.11, 11.01, 9.36, 9.44, 8.86, 9.69, 9.06, 9.56,
9.81, 10.36, 10.36, 9.6, 9.62, 9.9, 9.87, 9.75, 9.13, 9.13, 11.75,
11.75, 11.6, 11.94, 12, 11.31, 10.06, 9.19, 8.72, 8.54, 9.56,
9.13, 8.75, 7.88, 7.88, 8.31, 8.06, 8.19, 8.06, 8.19, 8.06),
i.Torto.B = c(6.76, 6.53, 6.93, 6.99, 7.16, 7.46, 7.16, 7.49,
7.43, 7.06, 7.43, 6.96, 6.68, 6.81, 6.56, 6.31, 6.81, 6.56,
6.66, 6.76, 6.75, 6.37, 6.9, 6.37, 6.4, 6.5, 6.5, 6.5, 6.5,
6.3, 6.31, 6.31, 6.38, 6.44, 6.44, 6.31, 6.38, 6.5, 6.44,
6.38, 6.38, 6.38, 6.38, 6.44, 6.56, 7.81, 7.94, 7.5), i.Globi.B = c(14.76,
15.16, 15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11,
11.01, 9.36, 9.44, 8.86, 9.69, 9.06, 9.56, 9.81, 10.36, 10.36,
9.6, 9.62, 9.9, 9.87, 9.75, 9.13, 9.13, 11.75, 11.75, 11.6,
11.94, 12, 11.31, 10.06, 9.19, 8.72, 8.54, 9.56, 9.13, 8.75,
7.88, 7.88, 8.31, 8.06, 8.19, 8.06, 8.19, 8.06), S.Pub = c(7.6025,
7.9875, 8.228, 7.96, 7.99, 8.51, 8.57, 8.715, 8.8475, 9.01,
8.67, 8.38, 8.655, 8.67, 234.7000229, 239.8500266, 237.850026,
239.0000239, 238.3000059, 238.8500041, 239.280016, 241.7499798,
246.4500108, 235.6499768, 234.0500179, 232.5000145, 231.6999874,
9.971, 10.049, 10.2025, 10.62, 10.5125, 11.1175, 10.9685,
11.186, 11.285, 11.2925, 11.96, 234.7000229, 239.8500266,
237.850026, 239.0000239, 238.3000059, 238.8500041, 239.280016,
241.7499798, 246.4500108, 235.6499768), i.Pub.A = c(15.56,
15.66, 16.46, 20.06, 19.66, 15.46, 14.06, 14.06, 20.06, 21.31,
22.31, 19.66, 18.66, 17.16, 6.96, 6.68, 6.81, 6.56, 6.31,
6.81, 6.56, 6.66, 6.76, 6.75, 6.37, 6.9, 6.37, 10.75, 10.75,
11.25, 11.62, 11.88, 11.5, 11.88, 12, 12, 12, 11.25, 6.96,
6.68, 6.81, 6.56, 6.31, 6.81, 6.56, 6.66, 6.76, 6.75), i.Globi.A = c(14.76,
15.16, 15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11,
11.01, 9.36, 9.44, 8.86, 9.36, 9.44, 8.86, 9.69, 9.06, 9.56,
9.81, 10.36, 10.36, 9.6, 9.62, 9.9, 9.87, 11.75, 11.75, 11.6,
11.94, 12, 11.31, 10.06, 9.19, 8.72, 8.54, 9.56, 9.36, 9.44,
8.86, 9.69, 9.06, 9.56, 9.81, 10.36, 10.36, 9.6), i.Pub.B = c(15.56,
15.66, 16.46, 20.06, 19.66, 15.46, 14.06, 14.06, 20.06, 21.31,
22.31, 19.66, 18.66, 17.16, 6.96, 6.68, 6.81, 6.56, 6.31,
6.81, 6.56, 6.66, 6.76, 6.75, 6.37, 6.9, 6.37, 10.75, 10.75,
11.25, 11.62, 11.88, 11.5, 11.88, 12, 12, 12, 11.25, 6.96,
6.68, 6.81, 6.56, 6.31, 6.81, 6.56, 6.66, 6.76, 6.75), i.Globi.B = c(14.76,
15.16, 15.56, 14.96, 14.46, 15.96, 13.16, 11.56, 11.56, 10.11,
11.01, 9.36, 9.44, 8.86, 9.36, 9.44, 8.86, 9.69, 9.06, 9.56,
9.81, 10.36, 10.36, 9.6, 9.62, 9.9, 9.87, 11.75, 11.75, 11.6,
11.94, 12, 11.31, 10.06, 9.19, 8.72, 8.54, 9.56, 9.36, 9.44,
8.86, 9.69, 9.06, 9.56, 9.81, 10.36, 10.36, 9.6), S.Hemot = c(228.3000255,
237.2500067, 248.2500235, 235.8500022, 243.3000045, 254.9999758,
258.1000174, 261.1000144, 268.3000056, 277.1000373, 249.2000057,
234.7000229, 239.8500266, 237.850026, 239.0000239, 238.3000059,
238.8500041, 239.280016, 241.7499798, 246.4500108, 235.6499768,
234.0500179, 232.5000145, 231.6999874, 234.6700059, 233.4299733,
224.7500106, 227.0000177, 231.5800102, 237.3000006, 245.2999909,
241.8999792, 246.8999855, 245.7000042, 247.5000025, 251.5999872,
254.7999858, 259.4500127, 250.9999839, 251.5000089, 251.1999823,
248.3999935, 236.4499965, 239.0000239, 216.4999833, 211.5499951,
202.0999805, 200.2499921), i.Hemot.A = c(13.8595, 14.069,
15.1918, 16.7617, 234.7000229, 239.8500266, 237.850026, 239.0000239,
238.3000059, 238.8500041, 239.280016, 241.7499798, 246.4500108,
235.6499768, 234.0500179, 232.5000145, 231.6999874, 13.3219,
13.2862, 13.19, 12.9323, 13.2048, 13.1795, 13.0952, 13.0033,
12.9988, 12.9988, 12.8194, 12.8194, 12.65, 12.476, 12.88,
13.3279, 13.36, 13.2716, 13.1788, 12.8091, 12.49, 12.733,
12.7595, 12.668, 12.6874, 12.6965, 12.6845, 12.6471, 12.4939,
12.5433, 12.555), i.Globi.A = c(14.76, 15.16, 15.56, 14.96,
6.96, 6.68, 6.81, 6.56, 6.31, 6.81, 6.56, 6.66, 6.76, 6.75,
6.37, 6.9, 6.37, 9.81, 10.36, 10.36, 9.6, 9.62, 9.9, 9.87,
9.75, 9.13, 9.13, 11.75, 11.75, 11.6, 11.94, 12, 11.31, 10.06,
9.19, 8.72, 8.54, 9.56, 9.13, 8.75, 7.88, 7.88, 8.31, 8.06,
8.19, 8.06, 8.19, 8.06), i.Hemot.B = c(13.8595, 14.069, 15.1918,
16.7617, 234.7000229, 239.8500266, 237.850026, 239.0000239,
238.3000059, 238.8500041, 239.280016, 241.7499798, 246.4500108,
235.6499768, 234.0500179, 232.5000145, 231.6999874, 13.3219,
13.2862, 13.19, 12.9323, 13.2048, 13.1795, 13.0952, 13.0033,
12.9988, 12.9988, 12.8194, 12.8194, 12.65, 12.476, 12.88,
13.3279, 13.36, 13.2716, 13.1788, 12.8091, 12.49, 12.733,
12.7595, 12.668, 12.6874, 12.6965, 12.6845, 12.6471, 12.4939,
12.5433, 12.555), i.Globi.B = c(14.76, 15.16, 15.56, 14.96,
6.96, 6.68, 6.81, 6.56, 6.31, 6.81, 6.56, 6.66, 6.76, 6.75,
6.37, 6.9, 6.37, 9.81, 10.36, 10.36, 9.6, 9.62, 9.9, 9.87,
9.75, 9.13, 9.13, 11.75, 11.75, 11.6, 11.94, 12, 11.31, 10.06,
9.19, 8.72, 8.54, 9.56, 9.13, 8.75, 7.88, 7.88, 8.31, 8.06,
8.19, 8.06, 8.19, 8.06)), .Names = c("S.Educ", "i.Educ.A",
"i.Globi.A", "i.Educ.B", "i.Globi.B", "S.Torto", "i.Torto.A",
"i.Globi.A", "i.Torto.B", "i.Globi.B", "S.Pub", "i.Pub.A", "i.Globi.A",
"i.Pub.B", "i.Globi.B", "S.Hemot", "i.Hemot.A", "i.Globi.A",
"i.Hemot.B", "i.Globi.B"), row.names = c(NA, -48L), class = "data.frame")
I have 4 countries: c("Educ","Torto","Pub","Hemot")
For each country I need to run a regression. For example, for Educ country:
Reg.Educ.A = lm (data.country $ S.Educ ~ data.country $ i.Educ.A - data.country $ i.Globi.A)
Reg.Educ.B = lm (data.country $ S.Educ ~ data.country $ i.Educ.B - data.country $ i.Globi.B)
I'm not very good at R. What I got to do was this, but it is not working.
I need to use the If/else statements.
The idea is: "If the country is "Educ" I will work with data.countra=tsdata[,1:5]. If the country is "Torto" I will work with data.country=tsdata[,6:10], and so on until the fourth country which is "Hemot".
The code below was the maximum I could do and it is wrong. I do not know how to use it "if/else" statements:
country <- c("Educ", "Torto", "Pub", "Hemot")
coef.matrix=matrix(0,4,4)
for (i in 1:4){
if (country[i]=="Educ"){
data.country=tsdata[,1:5]
coef.matrix[1,1]=summary(lm(data.country$S.Educ~data.country$i.Educ.A - data.country$i.Globi.A))$coef[1,1]
coef.matrix[1,2]=summary(lm(data.country$S.Educ~data.country$i.Educ.A - data.country$i.Globi.A))$coef[2,1]
coef.matrix[1,3]=summary(lm(data.country$S.Educ~data.country$i.Educ.B - data.country$i.Globi.B))$coef[1,1]
coef.matrix[1,4]=summary(lm(data.country$S.Educ~data.country$i.Educ.B - data.country$i.Globi.B))$coef[2,1]
}
if (country[i]=="Torto"){
data.country=tsdata[,6:10]
coef.matrix[2,1]=summary(lm(data.country$S.Torto~data.country$i.Torto.A - data.country$i.Globi.A))$coef[1,1]
coef.matrix[2,2]=summary(lm(data.country$S.Torto~data.country$i.Torto.A - data.country$i.Globi.A))$coef[2,1]
coef.matrix[2,3]=summary(lm(data.country$S.Torto~data.country$i.Torto.B - data.country$i.Globi.B))$coef[1,1]
coef.matrix[2,4]=summary(lm(data.country$S.Torto~data.country$i.Torto.B - data.country$i.Globi.B))$coef[2,1]
}
if (country[i]=="Pub"){
data.country=tsdata[,11:15]
coef.matrix[3,1]=summary(lm(data.country$S.Pub~data.country$i.Pub.A - data.country$i.Globi.A))$coef[1,1]
coef.matrix[3,2]=summary(lm(data.country$S.Pub~data.country$i.Pub.A - data.country$i.Globi.A))$coef[2,1]
coef.matrix[3,3]=summary(lm(data.country$S.Pub~data.country$i.Pub.B - data.country$i.Globi.B))$coef[1,1]
coef.matrix[3,4]=summary(lm(data.country$S.Pub~data.country$i.Pub.B - data.country$i.Globi.B))$coef[2,1]
}
if (country[i]=="Hemot"){
data.country=tsdata[,16:20]
coef.matrix[4,1]=summary(lm(data.country$S.Hemot~data.country$i.Hemot.A - data.country$i.Globi.A))$coef[1,1]
coef.matrix[4,2]=summary(lm(data.country$S.Hemot~data.country$i.Hemot.A - data.country$i.Globi.A))$coef[2,1]
coef.matrix[4,3]=summary(lm(data.country$S.Hemot~data.country$i.Hemot.B - data.country$i.Globi.B))$coef[1,1]
coef.matrix[4,4]=summary(lm(data.country$S.Hemot~data.country$i.Hemot.B - data.country$i.Globi.B))$coef[2,1]
}
}
Any help would be great.
This is simpler if you use long-format data. For example, with data.table...
# fix data
library(data.table)
DT = melt(setDT(tsdata),
meas = split(seq_along(tsdata), 1:5),
value.name = c("S", "iA", "iGA", "iB", "iGB"),
variable.name = "country"
)
# run models, extracting coefficients
DT[, c(
A = as.list(coef(lm(S ~ iA - iGA))),
B = as.list(coef(lm(S ~ iB - iGB)))
), by=country]
country A.(Intercept) A.iA B.(Intercept) B.iB
1: 1 613.7994 -52.85050685 613.7994 -52.85050685
2: 2 277.2805 -5.47557795 277.2805 -5.47557795
3: 3 333.4474 -19.39535189 333.4474 -19.39535189
4: 4 236.4338 0.05428531 236.4338 0.05428531

R: Plot varimax rotated factor analysis

I want to analyze my data as here with factor analysis and PCA.
It works so far, but what I did figure out is the following.
How can I perform a varimax rotation and visualize the rotated matrix in the correlation circle?
res.pca <- prcomp(decathlon2.active, scale = TRUE)
my.var <- varimax(res.pca$rotation)
res.pca is a prcomp object, my.var is a list, therefore I cannot use it for the plots as described in the article.
Any ideas?
Edit (output of dput(decathlon2.active)):
> data(decathlon2)
> decathlon2.active <- decathlon2[1:23, 1:10]
> dput(decathlon2.active)
structure(list(X100m = c(11.04, 10.76, 11.02, 11.34, 11.13, 10.83,
11.64, 11.37, 11.33, 11.33, 11.36, 10.85, 10.44, 10.5, 10.89,
10.62, 10.91, 10.97, 10.69, 10.98, 10.95, 10.9, 11.14), Long.jump = c(7.58,
7.4, 7.23, 7.09, 7.3, 7.31, 6.81, 7.56, 6.97, 7.27, 6.8, 7.84,
7.96, 7.81, 7.47, 7.74, 7.14, 7.19, 7.48, 7.49, 7.31, 7.3, 6.99
), Shot.put = c(14.83, 14.26, 14.25, 15.19, 13.48, 13.76, 14.57,
14.41, 14.09, 12.68, 13.46, 16.36, 15.23, 15.93, 15.73, 14.48,
15.31, 14.65, 14.8, 14.01, 15.1, 14.77, 14.91), High.jump = c(2.07,
1.86, 1.92, 2.1, 2.01, 2.13, 1.95, 1.86, 1.95, 1.98, 1.86, 2.12,
2.06, 2.09, 2.15, 1.97, 2.12, 2.03, 2.12, 1.94, 2.06, 1.88, 1.94
), X400m = c(49.81, 49.37, 48.93, 50.42, 48.62, 49.91, 50.14,
51.1, 49.48, 49.2, 51.16, 48.36, 49.19, 46.81, 48.97, 47.97,
49.4, 48.73, 49.13, 49.76, 50.79, 50.3, 49.41), X110m.hurdle = c(14.69,
14.05, 14.99, 15.31, 14.17, 14.38, 14.93, 15.06, 14.48, 15.29,
15.67, 14.05, 14.13, 13.97, 14.56, 14.01, 14.95, 14.25, 14.17,
14.25, 14.21, 14.34, 14.37), Discus = c(43.75, 50.72, 40.87,
46.26, 45.67, 44.41, 47.6, 44.99, 42.1, 37.92, 40.49, 48.72,
50.11, 51.65, 48.34, 43.73, 45.62, 44.72, 44.75, 42.43, 44.6,
44.41, 44.83), Pole.vault = c(5.02, 4.92, 5.32, 4.72, 4.42, 4.42,
4.92, 4.82, 4.72, 4.62, 5.02, 5, 4.9, 4.6, 4.4, 4.9, 4.7, 4.8,
4.4, 5.1, 5, 5, 4.6), Javeline = c(63.19, 60.15, 62.77, 63.44,
55.37, 56.37, 52.33, 57.19, 55.4, 57.44, 54.68, 70.52, 69.71,
55.54, 58.46, 55.39, 63.45, 57.76, 55.27, 56.32, 53.45, 60.89,
64.55), X1500m = c(291.7, 301.5, 280.1, 276.4, 268, 285.1, 262.1,
285.1, 282, 266.6, 291.7, 280.01, 282, 278.11, 265.42, 278.05,
269.54, 264.35, 276.31, 273.56, 287.63, 278.82, 267.09)), .Names = c("X100m",
"Long.jump", "Shot.put", "High.jump", "X400m", "X110m.hurdle",
"Discus", "Pole.vault", "Javeline", "X1500m"), row.names = c("SEBRLE",
"CLAY", "BERNARD", "YURKOV", "ZSIVOCZKY", "McMULLEN", "MARTINEAU",
"HERNU", "BARRAS", "NOOL", "BOURGUIGNON", "Sebrle", "Clay", "Karpov",
"Macey", "Warners", "Zsivoczky", "Hernu", "Bernard", "Schwarzl",
"Pogorelov", "Schoenbeck", "Barras"), class = "data.frame")

How to use ggplot2 to plot results from 'segmented' package?

I followed these steps to plot the results of a piecewise linear regression with one breakpoint which I have done by segmented package:
lin.mod <- lm(ChH~CL)
segmented.mod <- segmented(lin.mod, seg.Z=~CL)
data1 <- data.frame(x = CL, y = ChH)
data2 <- data.frame(x = CL, y = broken.line(segmented.mod)$fit)
ggplot(data1, aes(x = CL, y = ChH)) +
geom_point() +
geom_line(data = data2, color = 'blue')
and I get this plot which does not show two lines with a breakpoint!!!
How should I change my codes to get the correct plot?
This is my dataset:
(ChH has 11 missing data)
CL <- c(9.26, 9.38, 9.41, 9.44, 9.52, 9.58, 9.74, 9.91, 10.03, 10.22,
10.23, 10.4, 10.92, 11.15, 11.38, 11.77, 11.79, 12, 12.45, 12.5,
12.54, 12.79, 12.98, 13.04, 13.04, 13.54, 14.26, 14.33, 14.4,
14.56, 14.77, 14.83, 15.14, 15.19, 15.21, 15.46, 15.61, 15.62,
15.82, 15.87, 16.02, 16.04, 16.05, 16.07, 16.26, 16.32, 16.33,
16.41, 16.53, 16.57, 16.63, 16.64, 16.68, 16.76, 16.87, 17.13,
17.2, 17.37, 17.47, 17.49, 17.68, 17.72, 18.04, 18.1, 18.14,
18.16, 18.18, 18.18, 18.18, 18.22, 18.42, 18.55, 18.63, 18.72,
18.75, 18.77, 18.84, 19, 19.03, 19.3, 19.34, 19.35, 19.36, 19.46,
19.58, 19.61, 19.64, 19.7, 19.73, 19.76, 19.85, 19.85, 19.89,
19.93, 19.97, 20.1, 20.13, 20.16, 20.16, 20.22, 20.26, 20.29,
20.31, 20.31, 20.37, 20.43, 20.46, 20.47, 20.61, 20.64, 20.65,
20.66, 20.78, 20.85, 20.85, 20.88, 20.9, 20.98, 21, 21.02, 21.23,
21.26, 21.29, 21.33, 21.39, 21.4, 21.41, 21.45, 21.5, 21.5, 21.58,
21.6, 21.76, 21.85, 21.9, 22.1, 22.12, 22.14, 22.17, 22.2, 22.21,
22.23, 22.24, 22.3, 22.4, 22.42, 22.43, 22.46, 22.47, 22.48,
22.5, 22.68, 22.7, 22.7, 22.75, 22.8, 22.85, 22.89, 22.89, 22.92,
22.93, 22.94, 22.99, 23.19, 23.3, 23.33, 23.42, 23.51, 23.53,
23.67, 23.7, 23.7, 23.72, 23.72, 23.76, 23.77, 23.78, 23.91,
24.05, 24.05, 24.06, 24.08, 24.11, 24.16, 24.17, 24.2, 24.21,
24.3, 24.38, 24.38, 24.43, 24.49, 24.62, 24.89, 24.89, 24.91,
24.92, 24.95, 24.95, 25.07, 25.1, 25.11, 25.13, 25.13, 25.16,
25.28, 25.3, 25.32, 25.42, 25.43, 25.47, 25.6, 25.71, 25.87,
25.92, 25.94, 25.96, 26.14, 26.18, 26.22, 26.32, 26.33, 26.36,
26.43, 26.6, 26.69, 26.73, 26.73, 26.82, 26.83, 26.86, 27, 27,
27.08, 27.09, 27.1, 27.14, 27.23, 27.24, 27.27, 27.3, 27.55,
27.56, 27.81, 27.9, 27.94, 27.94, 27.98, 28.03, 28.03, 28.17,
28.18, 28.2, 28.49, 28.55, 28.7, 28.76, 28.88, 29.07, 29.13,
29.23, 29.43, 29.63, 29.71, 29.75, 29.97, 30.8, 30.87, 31.27,
31.28, 31.33, 31.45, 31.61, 31.64, 31.68, 32.11, 32.91, 33, 33.6,
34.04, 35.04, 36.05, 36.85)
And:
ChH <- c(2.76, 3.03, 2.86, 2.86, 2.99, 3, 2.96, 3.17, 3.12, 3.27, 3.21,
3.08, 3.53, 3.6, 8.7, 3.75, 3.87, 4.17, 4.38, 4.23, 4.04, 4.24,
4.36, 4.2, 8.78, 4.17, 5.02, 5.22, 5.06, 4.9, NA, 5.3, 5.16,
5.51, 4.25, 5.3, 5.25, 5.65, 5.52, 5.57, 5.5, 5.48, 6.14, 4.65,
5.75, 5.41, 5.42, 5.73, 5.63, 5.85, 6.09, 6.05, 5.88, 5.97, 6.64,
5.18, 6.51, 6.38, 6.27, 6.09, 6.62, 6.3, 4.2, 7.13, NA, 5.85,
6.83, 6.75, 6.94, 6.73, 6.23, 6.79, 6.7, 6.87, NA, 6.7, 6.52,
NA, 7.17, 7.06, 7.01, 7.33, 7.04, 6.94, 7.35, 7.01, 7.54, 7.8,
7.75, 7.86, 7.58, 7.09, 7.42, 7.52, 6.69, NA, 7.69, 7.57, 7.34,
7.52, 8.18, 7.51, 7.8, 7.77, 8.07, 7.92, 6.7, 7.43, 7.58, 8.09,
7.7, 7.81, 8.11, 7.83, 7.48, 7.81, 8.27, 8.32, 7.86, 8.1, 8.63,
7.8, 5.42, 8.36, 8.08, NA, 7.78, 8.27, 8.44, 6.62, 8.01, 8.5,
7.86, 9.1, 8.15, 8.69, 8.6, 8.49, 7.98, 8.76, 8.34, 8.75, 7.97,
9.08, 8.29, NA, 8.92, 8.71, 8.94, 8.44, 9, 8.63, 9.15, 8.93,
9.37, 8.77, 9.21, 9.07, 9.1, 8.89, 7.43, 8.34, 8.64, 8.5, 9.59,
7.59, 9.08, 9.4, 9.07, 8.83, 9.46, 9.3, 9.24, 9.44, 9, 9.43,
9.17, 7.68, 9.56, 9.27, 9.33, 6.8, 9.98, 9.81, 9.59, 9.49, 9.55,
9.39, 10.04, 9.5, 9.93, 9.3, 9.49, 8.45, 7.77, 7.84, 9.88, 9.35,
10.09, 10.22, 10.75, 10.75, 8.04, 8.07, 10.14, 9.94, 10.44, 10.25,
9.49, 10.6, 8.41, 9.57, 11.25, NA, 11.61, 6.72, 10.63, 11.12,
10.55, 10.7, 10.18, 10.94, 11.02, 10.66, 10.73, 8.65, 11.84,
NA, 11.25, 11.59, 10.96, 11.58, 11.43, 12.46, 10.46, 10.99, 11.94,
8.77, 11.58, 12.36, 11, 11.05, 11.86, 9.52, 12.48, 12.39, 12.64,
12.28, 12.12, 11.27, 10.86, 12.49, 12.13, 12.74, 9.64, 10.97,
12.41, 12.32, 13.86, 13.04, NA, 10.26, 13.24, 13.89, 12.77, 13.33,
13.37, 13.55, 14.01, 14.25, 14.75, 14.3, 13.87, 14.96, 14.32,
14.49, NA, 15.41, 15.47, 14.31, 17.7, 12.48, 16.46)
Edited to take into account OP's real data
Put everything inside the same data.frame:
library(segmented)
library(ggplot2)
lin.mod <- lm(ChH~CL)
segmented.mod <- segmented(lin.mod, seg.Z=~CL)
fit <- numeric(length(CL)) * NA
fit[complete.cases(rowSums(cbind(ChH, CL)))] <- broken.line(segmented.mod)$fit
data1 <- data.frame(CL = CL, ChH = ChH, fit = fit)
ggplot(data1, aes(x = CL, y = ChH)) +
geom_point() +
geom_line(aes(x = CL, y = fit), color = 'blue')

Resources