Related
I have been using dplyr::summarise to sum daily data by month and have just spent a few hours finally figuring out that for whatever reason the decimal places in my raw data was throwing the function off.
Basically, the monthly sums for 'temp1' (which is the 'Mod' data) are wrong (the digits look right but the decimal place is in the wrong place) until I apply a rounding function (rounded to 7 or less digits fixes the problem it seems, 8 just reproduces the problem)
temp1 <- as.data.frame(read.csv("data/ModObs.csv"))
temp1$Date <- as.Date(temp1$Date, "%d/%m/%Y")
((((temp1$Obs <- round(temp1$Obs, 7))))#this line fixes the problem
((((temp1$Mod <- round(temp1$Mod, 7))))#this line fixes the problem
temp1$yearmonth <- lubridate::floor_date(as.Date(temp1$Date), 'month')
temp2 <- dplyr::group_by(temp1, yearmonth)
temp2 <- dplyr::summarise(temp2, Obs = sum(Obs, na.rm=TRUE))
temp1 <- dplyr::group_by(temp1, yearmonth)
temp1 <- dplyr::summarise(temp1, Mod = sum(Mod, na.rm=TRUE))
My question is, is there a way of using dplyr::summarise that means I would not have encountered this issue (which took me quite a while to figure out and solve)?
dput with error:
dput(temp1)
structure(list(yearmonth = structure(c(0, 31, 59, 90, 120, 151,
181, 212, 243, 273, 304, 334, 365, 396, 424, 455, 485, 516, 546,
577, 608, 638, 669, 699, 730, 761, 790, 821, 851, 882, 912, 943,
974, 1004, 1035, 1065, 1096, 1127, 1155, 1186, 1216, 1247, 1277,
1308, 1339, 1369, 1400, 1430, 1461, 1492, 1520, 1551, 1581, 1612,
1642, 1673, 1704, 1734, 1765, 1795, 1826, 1857, 1885, 1916, 1946,
1977, 2007, 2038, 2069, 2099, 2130, 2160, 2191, 2222, 2251, 2282,
2312, 2343, 2373, 2404, 2435, 2465, 2496, 2526, 2557, 2588, 2616,
2647, 2677, 2708, 2738, 2769, 2800, 2830, 2861, 2891, 2922, 2953,
2981, 3012, 3042, 3073, 3103, 3134, 3165, 3195, 3226, 3256, 3287,
3318, 3346, 3377, 3407, 3438, 3468, 3499, 3530, 3560, 3591, 3621,
3652, 3683, 3712, 3743, 3773, 3804, 3834, 3865, 3896, 3926, 3957,
3987, 4018, 4049, 4077, 4108, 4138, 4169, 4199, 4230, 4261, 4291,
4322, 4352, 4383, 4414, 4442, 4473, 4503, 4534, 4564, 4595, 4626,
4656, 4687, 4717, 4748, 4779, 4807, 4838, 4868, 4899, 4929, 4960,
4991, 5021, 5052, 5082, 5113, 5144, 5173, 5204, 5234, 5265, 5295,
5326, 5357, 5387, 5418, 5448, 5479, 5510, 5538, 5569, 5599, 5630,
5660, 5691, 5722, 5752, 5783, 5813, 5844, 5875, 5903, 5934, 5964,
5995, 6025, 6056, 6087, 6117, 6148, 6178, 6209, 6240, 6268, 6299,
6329, 6360, 6390, 6421, 6452, 6482, 6513, 6543, 6574, 6605, 6634,
6665, 6695, 6726, 6756, 6787, 6818, 6848, 6879, 6909, 6940, 6971,
6999, 7030, 7060, 7091, 7121, 7152, 7183, 7213, 7244, 7274), class = "Date"),
Obs = c(29.5, 1.6, 225.9, 305, 485.9, 392.6, 86.7, 422.1,
262.6, 22.6, 12.7, 40.3, 96.5, 1.4, 0, 40.1, 251.9, 494.4,
181.6, 86, 69.6, 128.4, 560.9, 55.8, 14.2, 94.1, 8.9, 28.2,
10.3, 1.4, 2.6, 9, 14.2, 5.6, 9.5, 1.6, 0, 195.1, 24.3, 18.9,
26, 34.3, 68.1, 144.1, 213.3, 99.2, 36.1, 17, 19.5, 13.3,
0, 352.7, 2812.7, 82, 311.9, 314.2, 397.5, 783.7, 388.7,
40.4, 1.3, 0, 2.1, 2.9, 2.1, 8.6, 1.2, 260.8, 494.4, 1125.1,
983.3, 20.9, 3.2, 0, 0.1, 1.1, 0.6, 32.9, 16.2, 124.1, 204.3,
340.6, 212.6, 42.8, 56.7, 2.2, 22.6, 78.3, 100.2, 786.4,
990.7, 330.2, 119.9, 2.7, 3.5, 5.7, 9.4, 17.6, 104.2, 168.9,
43, 118.4, 69.7, 479.3, 435.4, 101.4, 52.9, 104, 28.6, 0.8,
1.8, 13.1, 54.4, 26.2, 6.3, 24.8, 30.7, 53.9, 1.4, 0, 4.6,
0, 1.5, 14.5, 67.3, 217.4, 460.5, 251.2, 72.3, 29.3, 57.7,
29.7, 1.4, 1, 30.4, 3.6, 164.2, 378.4, 861.1, 982.5, 116.5,
68.4, 33.9, 1.5, 52.3, 7.5, 18.2, 70.4, 75.9, 158.9, 26.1,
2.3, 6, 8.4, 0.1, 43.9, 8.3, 0, 0.7, 8.6, 38.3, 24.2, 110.1,
164.1, 239, 120.8, 23.9, 24.7, 1.8, 1.4, 54.7, 75.6, 11.6,
19.6, 69.4, 199.7, 648.3, 260.9, 53.5, 4.5, 0.5, 0, 0.6,
60.9, 9, 130.9, 61.7, 539.5, 222.1, 31.6, 19.8, 288.6, 83.3,
2, 1.8, 104.4, 214, 108.3, 504.2, 152.6, 110.2, 103.3, 14.7,
128.2, 3.5, 2.5, 7.2, 47.4, 73.6, 116.2, 150.6, 161.1, 58.8,
32.9, 12.1, 33.3, 31.3, 0.7, 39.7, 0.3, 26, 102.2, 55.2,
46.3, 62.3, 15.4, 200.2, 98.9, 35.5, 0.4, 80.3, 286.5, 348.8,
646.5, 340.3, 1048.5, 558.6, 365.5, 129.4, 3.7), Mod = c(58.456732574,
0.647399496, 106.77816386, 267.838017351, 599.939323463,
250.80934844, 113.281660213, 241.663996002, 127.530387061,
52.687410089, 84.890244021, 41.364802773, 59.23208781, 8.497558874,
0.672761812, 15.465132304, 358.926445816, 399.9093607, 97.971842098,
42.72450411, 78.475537521, 267.696647395, 1499.730009232,
164.134543701, 15.739950594, 117.176571603, 0.29960511, 33.153451885,
71.35707594, 1.976493212, 38.99406048, 58.699745671, 88.893788732,
55.590919209, 17.675911123, 0.323688533, 0.802922429, 255.339027286,
86.973361482, 56.672316286, 195.494804037, 113.402888496,
88.016557451, 146.313739207, 141.11162499, 309.49712486,
42.342303882, 32.801816137, 9.804984811, 14.876734504, 0.741273571,
432.148407136, 2516.875488309, 47.539316029, 269.405152962,
183.64372206, 154.563624943, 467.720012557, 153.054373772,
32.514885627, 1.830055421, 0.066762771, 1.044433442, 1.346976081,
17.458179607, 49.907434727, 53.305731876, 353.57856375, 310.529543548,
962.398015832, 344.181844335, 30.810939684, 8.040785393,
0.377896164, 0.798674902, 0.801987649, 0.691369382, 13.928109124,
12.703685263, 137.85141766, 211.000002457, 444.374773665,
187.06473363, 56.579158088, 79.307114494, 1.185915374, 7.450495202,
350.92445957, 168.333585374, 1103.415013415, 530.738230571,
97.400577403, 120.218466778, 26.53863178, 4.95759286, 1.415953207,
1.349259407, 7.598631896, 31.687964985, 111.63067543, 253.033200389,
260.084267318, 174.328538378, 435.075601539, 266.057507136,
169.491413576, 370.501536962, 325.734910145, 52.804905885,
0.637640491, 0.749393501, 61.044014158, 236.352010674, 69.236802018,
50.981912279, 113.755615714, 68.015519965, 228.376481539,
1.35494224, 0.370446501, 1.782754512, 0.200525121, 0.567715904,
2.562157517, 66.360280078, 537.409598471, 548.857756317,
131.818783821, 79.38907511, 216.219977069, 86.85853468, 91.042441797,
1.310072508, 4.6784498, 49.359916771, 12.139100379, 792.36086926,
360.543361637, 674.819587278, 417.14625705, 71.213853069,
88.470327459, 26.501678301, 0.660446628, 1.983262203, 0.053393889,
2.116900185, 103.974625465, 146.1406309, 241.456322328, 41.761031962,
19.165518836, 61.329157567, 77.461701504, 0.717057613, 60.244865985,
2.038796249, 0.024612503, 1.15999722, 0.987871135, 66.752973657,
101.602951298, 207.507552152, 351.874694806, 239.490966404,
373.402963887, 83.392418938, 96.713198206, 2.471314963, 1.789748376,
23.642411238, 274.437164678, 27.196302352, 122.879115856,
203.243972815, 261.450286079, 674.337097864, 201.592587766,
66.457305017, 14.265446489, 11.688820111, 0.287104024, 0.498545345,
10.595714786, 64.36811409, 147.944544256, 105.263660789,
348.781394762, 115.965911604, 81.556952547, 35.877763907,
293.156577573, 122.052605838, 0.891615203, 0.201455399, 17.693507458,
191.862026713, 93.030313466, 379.074639489, 88.590763754,
138.225716958, 438.407332197, 11.107850781, 175.835916749,
0.793580574, 0.755295219, 1.253581528, 2.175241521, 126.829190302,
167.624256025, 261.538659971, 143.633607733, 58.216055381,
101.857571372, 37.192461414, 112.344312062, 100.262190061,
2.378722279, 4.946631624, 0.435401092, 51.481605801, 155.384067186,
153.115869623, 128.316180053, 153.07003862, 80.585921934,
221.89445498, 62.047224666, 105.157734971, 0.203008456, 51.168132113,
310.567488885, 238.329914336, 783.724869869, 193.016695288,
431.815627948, 143.854730373, 358.082995503, 84.620059176,
1.146042245)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-240L))
Your data is exactly the same before and after the rounding.
library(dplyr)
temp1 <- as.data.frame(read.csv("C:/Users/xxx/Documents/modops.csv"))
temp1$Date <- as.Date(temp1$Date, "%d/%m/%Y")
temp1$yearmonth <- lubridate::floor_date(as.Date(temp1$Date), 'month')
notfixed <- dplyr::group_by(temp1, yearmonth) %>% summarise(Mod = sum(Mod, na.rm=TRUE))
temp1$Obs <- round(temp1$Obs, 7)#this line fixes the problem
fixed <- dplyr::group_by(temp1, yearmonth) %>% summarise(Mod = sum(Mod, na.rm=TRUE))
> identical(fixed, notfixed)
[1] TRUE
I'm looking for help trying to fit a sigmoidal curve to this data. It is a naturally occurring dataset and should be sigmoidal in its nature.
Any help much appreciated.
x <- c(10.90, 15.80, 12.80, 12.70, 13.90, 8.45, 9.28, 7.13, 12.00, 10.20, 10.60, 23.70, 8.04, 9.72, 19.30, 9.75, 10.10, 9.84, 9.18, 9.61, 7.92, 13.80, 11.70, 7.30, 10.60, 20.60, 8.03, 12.60, 11.90, 13.30, 8.89, 6.20, 11.80, 13.80, 8.90, 8.53, 16.30, 15.50, 11.40, 9.11, 8.15, 8.82, 8.85, 7.26, 13.40, 10.70, 8.83, 12.50, 11.10, 8.70, 12.30, 10.40, 16.60, 11.40, 10.10, 8.55, 13.60, 8.71, 12.00, 10.50, 7.40, 18.00, 12.40, 26.30, 11.70, 12.10, 8.49, 6.51, 11.40, 33.20, 8.46, 13.00, 9.76, 11.40, 9.14, 11.00, 8.08, 20.90, 12.50, 9.52, 9.99, 17.50, 10.40, 8.56, 11.40, 15.80, 13.00, 16.20, 9.20, 8.28, 15.10, 9.41, 12.60, 8.28, 7.87, 10.90, 13.40, 21.80, 11.40, 12.70,11.20, 14.8, 9.42, 7.68, 10.90, 11.00, 7.99, 17.20)
y <- c(94.4, 98.5, 97.9, 97.1, 97.5, 94.1, 93.3, 90.6, 95.6, 96.3, 95.3, 99.1, 92.5, 95.9, 99.2, 95.9, 94.2, 95.2, 95.0, 95.2, 92.1, 97.4, 97.1, 92.2, 92.4, 98.8, 92.7, 97.5, 96.8, 95.3, 87.2, 82.5, 96.4, 98.4, 93.4, 89.7, 97.5, 98.8, 97.1, 93.4, 90.7, 93.7, 93.2, 93.2, 97.6, 96.7, 94.0, 97.1, 94.9, 94.3, 96.8, 96.4, 98.0, 96.1, 96.4, 93.9, 96.8, 92.9, 97.0, 96.6, 82.8, 98.5, 97.4, 99.4, 96.2, 96.8, 90.5, 84.7, 95.9, 100.0, 93.9, 96.0, 92.4, 96.7, 95.0, 96.2, 89.8, 97.7, 96.9, 96.9, 95.8, 98.7, 95.3, 92.5, 95.8, 98.8, 97.2, 98.6, 93.6, 93.3, 99.0, 95.3, 96.7, 91.6, 91.0, 96.7, 96.8, 99.0, 96.7, 97.5, 95.7, 97.0, 92.8, 93.1, 94.6, 97.9, 92.6, 98.5)
You can use geom_smooth with method = "nls"
library(ggplot2)
data %>%
ggplot(aes(x=x,y=y)) +
geom_point() +
geom_smooth(method = "nls", se = FALSE,
formula = y ~ a/(1+exp(-b*(x-c))),
method.args = list(start = c(a = 98, b = -1.5, c = 1.5),
algorithm='port'),
color = "blue")
Alternatively, you could use the self-starting model SSlogis.
data %>%
ggplot(aes(x=x,y=y)) +
geom_point() +
geom_smooth(method = "nls", se = FALSE,
formula = y ~ SSlogis(x, Asym, xmid, scal),
color = "blue")
I am trying to perform 6 months forecasting over production data for three power plants, I built my data as an hts object that has 3 levels. However, when I am performing the forecast function and then try to see the accuracy using test data I get the following error: "Error in x - fcasts: non-conformable arrays"
Furthermore, when I try to apply the "arima" as a forecasting method on the hts object I get the following (the warning message is repeated 9 times, as I have 9 time series in the hts object):
forecasts <- forecast(data,h = 6 , method = "bu" , fmethod = "arima")
I used the following instructions to get the hts object:
and the data has the following structure:
I am not sure where I am going wrong. Anyone can help with some thoughts??
Thank you!
The data:
structure(list(LarGroup1 = c(188.3, 187.2, 94.7, 109.2, 202.7,
146.6, 121.9, 151.3, 111.1, 103.4, 188.1, 168.1, 233.9, 230.7,
187.1, 0, 98.9, 173.5, 149.4, 168.6, 4.7, 14.8, 91.8, 166.5,
170.5, 123.6, 85.2, 64.4), LarGroup2 = c(159.1, 127.7, 210.3,
199.8, 113, 143.4, 144.5, 83.8, 41.6, 35.1, 95.2, 178.2, 241.1,
236.4, 181.9, 194.3, 196.1, 92.4, 154.6, 78.9, 35.7, 0, 74.5,
75.1, 140, 142.5, 3.8, 17.5), RibGroup1 = c(49.4, 102.4, 50.8,
118.8, 108.4, 139.5, 121.7, 69.6, 53.4, 28, 113.3, 96.3, 70.8,
124.4, 54.4, 128.7, 63.3, 2.1, 41.3, 0.4, 0.6, 0, 5.4, 57.9,
9.9, 30, 221, 167.2), RibGroup2 = c(32.7, 32, 98.1, 6.3, 85.5,
96.6, 41.1, 44.9, 50.4, 27.3, 0, 45.4, 199.1, 179.2, 86.1, 0,
58.4, 43.3, 41.8, 42.1, 22.1, 11.8, 71.8, 112, 204.1, 40.9, 24.5,
210.9), RibGroup3 = c(90.8, 15.4, 10.5, 124.4, 33.9, 8.4, 38.3,
56.9, 13.5, 0, 32.6, 132.8, 160.7, 168.7, 60.7, 131.9, 110.8,
29.2, 131.3, 62.1, 6.1, 0, 0, 3.4, 23.9, 192.7, 165.5, 0), SinGroup1 = c(235.2,
225.4, 226.1, 234.4, 222.1, 232.3, 233.4, 201.9, 195.3, 209.4,
233.6, 223.6, 222.2, 232, 224, 149.8, 201.6, 220.2, 203.1, 212.1,
71.9, 82.3, 183.2, 210.6, 198.6, 230.8, 218, 163.2), SinGroup2 = c(233.4,
225.6, 227, 51.6, 76, 230.7, 233.1, 202.7, 200.2, 207.2, 228.4,
226.2, 183.9, 230.4, 222.3, 227.7, 177.9, 152, 218.6, 210.6,
80.9, 63.2, 188.1, 209.5, 233.2, 210.1, 226.5, 200.5), SinGroup3 = c(233.2,
188.5, 226.9, 234.7, 222.8, 234.6, 220.6, 156.4, 209.2, 218.7,
232.9, 226.1, 215.4, 231, 222.7, 222.7, 183.7, 203.8, 216.8,
112, 0, 39.6, 180.8, 203.6, 221.1, 228.9, 202.8, 186.7), SinGroup4 = c(218,
215.5, 226.8, 235.6, 223.6, 234.8, 234.9, 69.3, 192, 207.8, 235.2,
217.2, 235.1, 231.8, 223.5, 230.5, 225.6, 220.1, 220, 211.9,
114.8, 44.5, 158.5, 206.3, 231.8, 179, 225.3, 198.6)), class = "data.frame", row.names = c(NA,
-28L))
In the accuracy function, you need to include test data, not training data. You ask for 6 steps ahead, but your test data only consists of 4 time periods.
The seasonal differencing error suggests you are using an old version of the forecast package. Please update your packages.
The following code works using current CRAN packages (forecast v8.4, hts v
library(hts)
Production_data <- data.frame(
LarGroup1 = c(
188.3, 187.2, 94.7, 109.2, 202.7,
146.6, 121.9, 151.3, 111.1, 103.4, 188.1, 168.1, 233.9, 230.7,
187.1, 0, 98.9, 173.5, 149.4, 168.6, 4.7, 14.8, 91.8, 166.5,
170.5, 123.6, 85.2, 64.4
), LarGroup2 = c(
159.1, 127.7, 210.3,
199.8, 113, 143.4, 144.5, 83.8, 41.6, 35.1, 95.2, 178.2, 241.1,
236.4, 181.9, 194.3, 196.1, 92.4, 154.6, 78.9, 35.7, 0, 74.5,
75.1, 140, 142.5, 3.8, 17.5
), RibGroup1 = c(
49.4, 102.4, 50.8,
118.8, 108.4, 139.5, 121.7, 69.6, 53.4, 28, 113.3, 96.3, 70.8,
124.4, 54.4, 128.7, 63.3, 2.1, 41.3, 0.4, 0.6, 0, 5.4, 57.9,
9.9, 30, 221, 167.2
), RibGroup2 = c(
32.7, 32, 98.1, 6.3, 85.5,
96.6, 41.1, 44.9, 50.4, 27.3, 0, 45.4, 199.1, 179.2, 86.1, 0,
58.4, 43.3, 41.8, 42.1, 22.1, 11.8, 71.8, 112, 204.1, 40.9, 24.5,
210.9
), RibGroup3 = c(
90.8, 15.4, 10.5, 124.4, 33.9, 8.4, 38.3,
56.9, 13.5, 0, 32.6, 132.8, 160.7, 168.7, 60.7, 131.9, 110.8,
29.2, 131.3, 62.1, 6.1, 0, 0, 3.4, 23.9, 192.7, 165.5, 0
), SinGroup1 = c(
235.2,
225.4, 226.1, 234.4, 222.1, 232.3, 233.4, 201.9, 195.3, 209.4,
233.6, 223.6, 222.2, 232, 224, 149.8, 201.6, 220.2, 203.1, 212.1,
71.9, 82.3, 183.2, 210.6, 198.6, 230.8, 218, 163.2
), SinGroup2 = c(
233.4,
225.6, 227, 51.6, 76, 230.7, 233.1, 202.7, 200.2, 207.2, 228.4,
226.2, 183.9, 230.4, 222.3, 227.7, 177.9, 152, 218.6, 210.6,
80.9, 63.2, 188.1, 209.5, 233.2, 210.1, 226.5, 200.5
), SinGroup3 = c(
233.2,
188.5, 226.9, 234.7, 222.8, 234.6, 220.6, 156.4, 209.2, 218.7,
232.9, 226.1, 215.4, 231, 222.7, 222.7, 183.7, 203.8, 216.8,
112, 0, 39.6, 180.8, 203.6, 221.1, 228.9, 202.8, 186.7
), SinGroup4 = c(
218,
215.5, 226.8, 235.6, 223.6, 234.8, 234.9, 69.3, 192, 207.8, 235.2,
217.2, 235.1, 231.8, 223.5, 230.5, 225.6, 220.1, 220, 211.9,
114.8, 44.5, 158.5, 206.3, 231.8, 179, 225.3, 198.6
)
)
Production_data_ts <- ts(Production_data, frequency = 12, start = c(2016, 7))
Production_data_hts <- hts(Production_data_ts, characters = c(3, 6))
data <- window(Production_data_hts, start = c(2016, 7), end = c(2018, 6))
test <- window(Production_data_hts, start = c(2018, 7), end = c(2018, 10))
forecasts <- forecast(data, h = 4, method = "bu")
accuracy(forecasts, test)
I have a data frame with Lat Lon mean_wind and wind_dir in each grid cells.
I am trying to make a spatial plot with mean wind in background and wind direction as arrow on each grid cells.
I have tried following on sample data-frame wind.dt
win.plt<- ggplot(wind.dt,aes(x=Lon,y=Lat))+
#Mean wind plot : OK
geom_tile(aes(fill=mean_wind),alpha=1)+
geom_tile(aes(color=mean_wind), fill=NA) +
scale_fill_gradientn(colours=(brewer.pal(9,rev("RdYlGn"))))+
scale_color_gradientn(colours=(brewer.pal(9,rev("RdYlGn"))),guide=F)
#Wind Direction : doesnot work
geom_segment(arrow = arrow(),aes(yend = Lon + wind_dir, xend = Lat + wind_dir))
win.plt
wind.dt<-structure(list(Lon = c(170.25, 171, 171.75, 172.5, 173.25, 174,
174.75, 175.5, 176.25, 177, 177.75, 178.5, 179.25, 180, 180.75,
181.5, 182.25, 183, 183.75, 184.5, 185.25, 186, 186.75, 187.5,
188.25, 189, 189.75, 190.5, 191.25, 192, 192.75, 193.5, 194.25,
170.25, 171, 171.75, 172.5, 173.25, 174, 174.75, 175.5, 176.25,
177, 177.75, 178.5, 179.25, 180, 180.75, 181.5, 182.25, 183,
183.75, 184.5, 185.25, 186, 186.75, 187.5, 188.25, 189, 189.75,
190.5, 191.25, 192, 192.75, 193.5, 194.25, 170.25, 171, 171.75,
172.5, 173.25, 174, 174.75, 175.5, 176.25, 177, 177.75, 178.5,
179.25, 180, 180.75, 181.5, 182.25, 183, 183.75, 184.5, 185.25,
186, 186.75, 187.5, 188.25, 189, 189.75, 190.5, 191.25, 192,
192.75, 193.5, 194.25, 170.25, 171, 171.75, 172.5, 173.25, 174,
174.75, 175.5, 176.25, 177, 177.75, 178.5, 179.25, 180, 180.75,
181.5, 182.25, 183, 183.75, 184.5, 185.25, 186, 186.75, 187.5,
188.25, 189, 189.75, 190.5, 191.25, 192, 192.75, 193.5, 194.25,
170.25, 171, 171.75, 172.5, 173.25, 174, 174.75, 175.5, 176.25,
177, 177.75, 178.5, 179.25, 180, 180.75, 181.5, 182.25, 183,
183.75, 184.5, 185.25, 186, 186.75, 187.5, 188.25, 189, 189.75,
190.5, 191.25, 192, 192.75, 193.5, 194.25, 170.25, 171, 171.75,
172.5, 173.25, 174, 174.75, 175.5, 176.25, 177, 177.75, 178.5,
179.25, 180, 180.75, 181.5, 182.25, 183, 183.75, 184.5, 185.25,
186, 186.75, 187.5, 188.25, 189, 189.75, 190.5, 191.25, 192,
192.75, 193.5, 194.25), Lat = c(14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25, 14.25,
14.25, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5,
13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5,
13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5, 13.5,
13.5, 13.5, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75,
12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75,
12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75,
12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12.75, 12, 12,
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25, 11.25,
11.25, 11.25, 11.25, 11.25, 11.25, 10.5, 10.5, 10.5, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5), mean_wind = c(8.34, 8.33,
8.31, 8.29, 8.27, 8.24, 8.22, 8.2, 8.19, 8.16, 8.14, 8.13, 8.1,
8.08, 8.06, 8.02, 7.99, 7.96, 7.93, 7.89, 7.85, 7.81, 7.78, 7.73,
7.7, 7.67, 7.63, 7.62, 7.6, 7.58, 7.56, 7.53, 7.54, 8.65, 8.64,
8.61, 8.59, 8.56, 8.53, 8.51, 8.48, 8.46, 8.43, 8.41, 8.39, 8.38,
8.37, 8.33, 8.31, 8.28, 8.24, 8.2, 8.15, 8.12, 8.07, 8.03, 8.01,
7.97, 7.94, 7.92, 7.89, 7.87, 7.85, 7.85, 7.83, 7.8, 8.85, 8.84,
8.81, 8.8, 8.77, 8.74, 8.72, 8.69, 8.67, 8.65, 8.63, 8.61, 8.59,
8.58, 8.55, 8.54, 8.5, 8.46, 8.44, 8.4, 8.37, 8.33, 8.29, 8.26,
8.21, 8.18, 8.16, 8.13, 8.12, 8.09, 8.06, 8.06, 8.03, 9.01, 8.99,
8.96, 8.94, 8.91, 8.89, 8.86, 8.83, 8.82, 8.79, 8.78, 8.77, 8.75,
8.75, 8.73, 8.7, 8.68, 8.66, 8.63, 8.59, 8.55, 8.52, 8.47, 8.43,
8.4, 8.38, 8.35, 8.32, 8.31, 8.29, 8.26, 8.25, 8.23, 9.07, 9.06,
9.04, 9.01, 8.99, 8.97, 8.94, 8.92, 8.91, 8.9, 8.89, 8.88, 8.88,
8.87, 8.86, 8.84, 8.83, 8.8, 8.75, 8.74, 8.7, 8.67, 8.63, 8.59,
8.57, 8.53, 8.52, 8.51, 8.47, 8.47, 8.45, 8.42, 8.41, 9.1, 9.08,
9.06, 9.04, 9.02, 9, 8.98, 8.97, 8.96, 8.96, 8.95, 8.95, 8.97,
8.96, 8.96, 8.94, 8.91, 8.89, 8.86, 8.84, 8.8, 8.76, 8.73, 8.69,
8.67, 8.64, 8.63, 8.63, 8.61, 8.59, 8.57, 8.54, 8.53), wind_dir = c(81.27,
81.34, 81.38, 81.44, 81.47, 81.34, 81.31, 81.51, 81.56, 81.46,
81.54, 81.53, 81.42, 81.53, 81.66, 81.76, 81.86, 81.96, 82.02,
82.28, 82.65, 82.77, 83.07, 83.46, 83.78, 84.15, 84.52, 84.92,
85.39, 85.87, 86.15, 86.38, 86.53, 81.34, 81.34, 81.38, 81.31,
81.2, 81.25, 81.39, 81.36, 81.31, 81.4, 81.47, 81.48, 81.59,
81.64, 81.58, 81.62, 81.75, 81.98, 82.13, 82.26, 82.52, 82.77,
82.97, 83.15, 83.49, 83.74, 84.23, 84.78, 85.04, 85.49, 85.73,
86.05, 86.35, 81.5, 81.41, 81.32, 81.28, 81.32, 81.31, 81.24,
81.17, 81.28, 81.33, 81.24, 81.3, 81.44, 81.46, 81.55, 81.76,
81.8, 81.88, 82.11, 82.31, 82.4, 82.61, 82.88, 82.95, 83.29,
83.59, 83.93, 84.46, 84.8, 85.26, 85.47, 85.78, 86.11, 81.3,
81.29, 81.29, 81.28, 81.32, 81.22, 81.24, 81.32, 81.31, 81.23,
81.34, 81.47, 81.37, 81.42, 81.5, 81.6, 81.78, 81.98, 82.06,
82.26, 82.49, 82.52, 82.7, 82.79, 83.05, 83.46, 83.79, 84.18,
84.5, 84.91, 85.23, 85.49, 85.7, 81.31, 81.33, 81.28, 81.19,
81.26, 81.29, 81.36, 81.24, 81.16, 81.18, 81.23, 81.23, 81.23,
81.47, 81.5, 81.55, 81.73, 81.99, 82.14, 82.18, 82.41, 82.46,
82.63, 82.83, 82.97, 83.27, 83.62, 84.01, 84.34, 84.64, 85.01,
85.38, 85.55, 81.14, 81.14, 81.1, 81.15, 81.2, 81.1, 81.14, 81.06,
81.21, 81.26, 81.13, 81.16, 81.17, 81.22, 81.28, 81.63, 81.71,
81.77, 82.13, 82.22, 82.37, 82.48, 82.56, 82.7, 82.92, 83.19,
83.43, 83.74, 84.15, 84.59, 84.89, 85.22, 85.39)), row.names = c(NA,
-198L), .Names = c("Lon", "Lat", "mean_wind", "wind_dir"), class = c("tbl_df",
"tbl", "data.frame"))
geom_spoke was made for this particular sort of plot. Cleaned up a little,
library(ggplot2)
ggplot(wind.dt,
aes(x = Lon ,
y = Lat,
fill = mean_wind,
angle = wind_dir,
radius = scales::rescale(mean_wind, c(.2, .8)))) +
geom_raster() +
geom_spoke(arrow = arrow(length = unit(.05, 'inches'))) +
scale_fill_distiller(palette = "RdYlGn") +
coord_equal(expand = 0) +
theme(legend.position = 'bottom',
legend.direction = 'horizontal')
Adjust scaling and sizes as desired.
Edit: Controlling the number of arrows
To adjust the number of arrows, a quick-and-dirty route is to subset one of the aesthetics passed to geom_spoke with a recycling vector that will cause some rows to be dropped, e.g.
library(ggplot2)
ggplot(wind.dt,
aes(x = Lon ,
y = Lat,
fill = mean_wind,
angle = wind_dir[c(TRUE, NA, NA, NA, NA)], # causes some values not to plot
radius = scales::rescale(mean_wind, c(.2, .8)))) +
geom_raster() +
geom_spoke(arrow = arrow(length = unit(.05, 'inches'))) +
scale_fill_distiller(palette = "RdYlGn") +
coord_equal(expand = 0) +
theme(legend.position = 'bottom',
legend.direction = 'horizontal')
#> Warning: Removed 158 rows containing missing values (geom_spoke).
This depends on your data frame being in order and is not infinitely flexible, but if it gets you a nice plot with minimal effort, can be useless nonetheless.
A more robust approach is to make a subsetted data frame for use by geom_spoke, say, selecting every other value of Lon and Lat, here using recycling subsetting on a vector of distinct values:
library(dplyr)
wind.arrows <- wind.dt %>%
filter(Lon %in% sort(unique(Lon))[c(TRUE, FALSE)],
Lat %in% sort(unique(Lat))[c(TRUE, FALSE)])
ggplot(wind.dt,
aes(x = Lon ,
y = Lat,
fill = mean_wind,
angle = wind_dir,
radius = scales::rescale(mean_wind, c(.2, .8)))) +
geom_raster() +
geom_spoke(data = wind.arrows, # this is the only difference in the plotting code
arrow = arrow(length = unit(.05, 'inches'))) +
scale_fill_distiller(palette = "RdYlGn") +
coord_equal(expand = 0) +
theme(legend.position = 'bottom',
legend.direction = 'horizontal')
This approach makes getting (and scaling) a grid fairly easy, but getting a diamond pattern will take a bit more logic:
wind.arrows <- wind.dt %>%
filter(( Lon %in% sort(unique(Lon))[c(TRUE, FALSE)] &
Lat %in% sort(unique(Lat))[c(TRUE, FALSE)] ) |
( Lon %in% sort(unique(Lon))[c(FALSE, TRUE)] &
Lat %in% sort(unique(Lat))[c(FALSE, TRUE)] ))
The data below shows 2 cycles or "loops". How can I get 1) the max (peak) and 2) last values of each cycle?
I need to calculate the difference between the peak of each cycle and the last value of the cycle immediately before [e.g. (peak of cycle 2) - (last value of cycle 1)]. I thought this was going to solve my problems: https://stats.stackexchange.com/questions/22974/how-to-find-local-peaks-valleys-in-a-series-of-data
But the peaks that I am getting with the findPeak function, quantmod package (after trying many threshold values) do not make sense. I tried other functions (e.g. the one suggested by Whuber here: https://stats.stackexchange.com/questions/36309/how-do-i-find-peaks-in-a-dataset), but I have not been able to accurately calculate the peaks and, more challenging to me, the last datapoint of each cycle. I would really appreciate any help,
x <- 0:239
y <- c(12.32, 13.01, 12.32, 12.32, 12.32, 12.32, 13.01, 13.01, 12.32,
12.32, 12.32, 12.32, 12.32, 13.01, 12.32, 12.32, 12.32, 13.01,
12.32, 12.32, 12.32, 13.69, 13.69, 24.65, 39.71, 50.67, 76.69,
80.1, 98.6, 106.8, 109.6, 115, 116.4, 119.1, 123.2, 123.9, 131.5,
141.7, 143.8, 165, 180.8, 191.7, 212.9, 215.7, 231.4, 239, 241.7,
247.9, 250.6, 252, 255.4, 255.4, 258.1, 259.5, 259.5, 260.2,
261.6, 261.6, 263.6, 262.2, 263.6, 264.3, 264.3, 265, 265, 265,
265.7, 265, 264.3, 264.3, 265, 265, 265, 265, 264.3, 265, 264.3,
264.3, 263.6, 263.6, 263.6, 264.3, 263.6, 263.6, 262.2, 262.9,
262.2, 262.9, 261.6, 261.6, 260.9, 261.6, 260.9, 260.9, 260.2,
260.2, 259.5, 258.8, 258.8, 260.2, 258.1, 258.1, 258.1, 258.1,
258.1, 256.8, 256.8, 256.8, 256.1, 255.4, 255.4, 254.7, 254.7,
254, 254, 252.7, 253.3, 252.7, 252.7, 252, 12.32, 12.32, 12.32,
13.01, 13.01, 12.32, 13.01, 12.32, 12.32, 12.32, 12.32, 12.32,
11.64, 12.32, 12.32, 12.32, 12.32, 12.32, 12.32, 12.32, 13.69,
13.01, 16.43, 18.49, 32.87, 58.2, 62.31, 90.4, 104.1, 110.2,
130.8, 135.6, 156.1, 170.5, 173.9, 186.2, 195.8, 202, 220.5,
223.2, 249.2, 274.6, 279.4, 302.6, 312.9, 319.1, 328, 328.7,
336.2, 338.9, 340.3, 343, 345.1, 346.5, 348.5, 349.2, 350.6,
351.2, 351.2, 352.6, 353.3, 353.3, 354, 354, 354.7, 354.7, 355.4,
354.7, 354, 354.7, 354.7, 354.7, 354, 354, 354, 353.3, 354, 353.3,
353.3, 353.3, 351.9, 352.6, 351.9, 351.2, 351.2, 351.2, 350.6,
350.6, 349.2, 349.2, 348.5, 348.5, 348.5, 348.5, 347.1, 347.8,
345.8, 346.5, 346.5, 345.8, 344.4, 345.1, 344.4, 344.4, 343,
341.7, 342.3, 341.7, 341.7, 340.3, 341, 341, 339.6, 338.9, 338.9,
338.9, 338.2, 337.6, 337.6, 337.6)
I think the question is mainly about how you want to define a cycle rather than coding it in R. For example, if you want a new cycle to start whenever the difference between two consecutive points is greater than a threshold (eg 100) you can do so as follows
thres <- 100
cuts <- which(abs(diff(y)) > thres)
idx <- Map(seq, c(1, cuts + 1), c(cuts, length(x)))
cycles <- lapply(seq_along(idx),
function(i) data.frame(cycle = i, x = x[idx[[i]]], y = y[idx[[i]]]))
This will give you a list each element of which will contain the x and y values of a cycle. From that point on you can calculate statistics/summaries as required, eg to find the maximum of each cycle you can do
library(dplyr)
cycles.df <- bind_rows(cycles)
cycles.df %>% group_by(cycle) %>% slice(which.max(y))
# Source: local data frame [2 x 3]
# Groups: cycle
#
# cycle x y
# 1 1 66 265.7
# 2 2 186 355.4
or to find the last value in each cycle
cycles.df %>% group_by(cycle) %>% slice(n())
# Source: local data frame [2 x 3]
# Groups: cycle
#
# cycle x y
# 1 1 119 252.0
# 2 2 239 337.6