Related
I am trying to split the following list:
x <- c(1, 19, 25, 62, 38, 41, 52, 53, 60, 61, 1, 74, 72, 66, 1, 68, 5, 1)
What I would like to do is split the above using the number 1 as the break points.
x1 <- c(1, 19, 25, 62, 38, 41, 52, 53, 60, 61)
x2 <- c(1, 74, 72, 66)
x3 <- c(1, 68, 5)
There must be a simple method to use but I am drawing a blank and my search-fu is weak and coming up empty.
Thanks for your help.
Use split with cumsum:
x <- c(1, 19, 25, 62, 38, 41, 52, 53, 60, 61, 1, 74, 72, 66, 1, 68, 5, 1)
split(x, f=cumsum(x==1))
#> $`1`
#> [1] 1 19 25 62 38 41 52 53 60 61
#>
#> $`2`
#> [1] 1 74 72 66
#>
#> $`3`
#> [1] 1 68 5
#>
#> $`4`
#> [1] 1
I would like to add colour 'chunks' to the background of my graphs in R to highlight nesting periods. My x axis is in days, so I'd like the colours to be set 'from-to' certain days.
I've created a crude manual version of how I'd like it to look on my graph (see image) but am unsure how to implement this within my code. I'd ideally like to have different colours for different chunks e.g. orange for one period and blue for another period of interest which can also be displayed in a legend on the right. My data is distance per day, which was then converted to standard deviations for graphing.
Code below for distance to stdev, then graphing using the standard plot() function:
ig16 <- read.csv(file='ig16distance.csv')
ig16$stdDist <- (ig16$Distance - mean(ig16$Distance))/sd(ig16$Distance)
plot(ig16$stdDist, type = "o",col = "red", xlab = "Days", ylab = "Stdev",
main = "IG0016")
Sample data below:
Day Distance
1 1 20.396078
2 2 21.540659
3 3 4.000000
4 4 16.492423
5 5 16.000000
6 6 34.000000
7 7 34.234486
8 8 0.000000
9 9 4.000000
10 10 0.000000
11 11 0.000000
12 12 0.000000
13 13 0.000000
14 14 22.203603
15 15 0.000000
16 16 0.000000
17 17 2.280351
18 18 2.280351
19 19 2.280351
20 20 2.280351
Any advice on code to achieve this would be much appreciated!
Since you do not provide data, I will illustrate with some simple example data. You can just plot some transparent rectangles over the region that you want to highlight.
kings = c(60, 43, 67, 50, 56, 42, 50, 65, 68, 43, 65, 34, 47, 34, 49,
41, 13, 35, 53, 56, 16, 43, 69, 59, 48, 59, 86, 55, 68, 51, 33,
49, 67, 77, 81, 67, 71, 81, 68, 70, 77, 56)
plot(kings, type = "o",col = "red", xlab = "", ylab = "Years",
main = "Kings")
polygon(x=c(5,5,15,15), y=c(0,100,100,0), col="#0000FF22", border=F)
polygon(x=c(25,25,35,35), y=c(0,100,100,0), col="#FF990022", border=F)
you can also do this, a kind of an event plot:
kings = c(60, 43, 67, 50, 56, 42, 50, 65, 68, 43, 65, 34, 47, 34, 49,
41, 13, 35, 53, 56, 16, 43, 69, 59, 48, 59, 86, 55, 68, 51, 33,
49, 67, 77, 81, 67, 71, 81, 68, 70, 77, 56)
plot(kings, ylim=c(-25,100), type = "o",col = "red", xlab = "", ylab = "Years", main = "Kings")
rect(5, -10,15,-20,col=rgb(0,0,1,.133),border=NA)
rect(25,-10,35,-20,col=rgb(1,.6,0,.133),border=NA)
This question already has an answer here:
Pipe a data frame to a function whose argument pipes a dot
(1 answer)
Closed 3 years ago.
Using piping in R (with %>%), how can one pass specific vector elements from a function's output to feed the next function's arguments?
I've tried using the dot operator with position in braces (i.e., .[1], .[2]) to no avail.
The only way that was working for me was with sapply(), but I'm wondering whether there's a simpler solution I'm missing.
Example
#I have a vector containing a sequence of numbers, with some duplicates and gaps,
#and I want to use its start and end points to create an analogous consecutive sequence.
original_sequence <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27,
28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42,
43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,
58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72,
73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87,
88, 89, 90, 91, 92, 93, 94, 95, 96, 98, 98, 99, 100, 101,
102, 103, 104, 105, 106, 107, 108, 109, 110)
## unsuccessful attempt #1
original_sequence %>%
range() %>%
seq()
[1] 1 2 ## this result is equivalent to the output of `seq(2)`,
## but what I want is to compute `seq(1 ,110)`.
## unsuccessful attempt #2
original_sequence %>%
range() %>%
seq(.[1]), .[2])
Error: unexpected ',' in:
" range() %>%
seq(.[1]),"
## attempt #3: somewhat successful but I wonder whether there's a better way
original_sequence %>%
range() %>%
sapply(., seq)
[[1]]
[1] 1
[[2]]
[1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
[39] 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
[77] 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
Bottom line -- I was able to do it with sapply but I hope to figure out a solution in the spirit of my second attempt, because it's more handy to know a universal way to cherry-pick the specific vector elements you want to pass to the next function's arguments.
One way would be to use {} and pass input arguments to seq
library(dplyr)
original_sequence %>%
range() %>%
{seq(.[[1]], .[2])}
#[1] 1 2 3 4 5 6 7 8 9 10 11 12......
Or we can mix it with base R do.call
original_sequence %>% range() %>% {do.call(seq, as.list(.))}
Or as #Ozan147 mentioned if your sequence always starts with 1 we can use max
original_sequence %>% max %>% seq
We can use reduce
library(tidyverse)
original_sequence %>%
range %>%
reduce(seq)
#[1] 1 2 3 4 ...
Summary (tldr)
I need to perform a rolling regression on an irregular time series (i.e. the interval may not even be periodic and go from 0, 1, 2, 3... to ...7, 20, 24, 28...) that's simple numeric and does not necessarily require date/time, but the rolling window needs be by time. So if I have a timeseries that is irregularly sampled for 600 seconds and the window is 30, the regression is performed every 30 seconds, and not every 30 samples.
I've read examples, and while I could replicate doing rolling sums and medians by time, I can't seem to figure it out for regression.
The problem
First of all, I have read some of the other questions with regards to performing rolling functions on irregular time series data, such as this: optimized rolling functions on irregular time series with time-based window, and this: Rolling window over irregular time series.
The issue is that the examples provided, so far, are simple for equations like sum or median, but I have not yet figured out how to perform a simple rolling regression, i.e. using lm, that is still based on the same caveat that the window is based on an irregular time series. Also, my timeseries is much, much simpler; no date is necessary, it's simply time "elapsed".
Anyway, getting this right is important to me because with irregular time - for example, a skip in the time interval - may give an over- or underestimate of the coefficients in the rolling regression, as the sample window will include additional time.
So I was wondering if anyone can help me with creating a function that does this in the simplest way? The dataset is based on measuring a variable over time i.e. 2 variables: time, and response. Time is measured every x time elapsed units (seconds, minutes, so not date/time formatted), but once in a while it becomes irregular.
For every row in the function, it should perform a linear regression based on a width of n time units. The width should never exceed n units, but may be floored (i.e. reduced) to accomodate irregular time sampling. So for example, if the width is specified at 20 seconds, but time is sampled every 6 seconds, then the window will be rounded to 18, not 24 seconds.
I have looked at the question here: How to calculate the average slope within a moving window in R, and I tested that code on an irregular time series, but it looks like it's based on regular time series.
Sample data:
sample <-
structure(list(x = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28,
29, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 47, 48,
49), y = c(50, 49, 48, 47, 46, 47, 46, 45, 44, 43, 44, 43, 42,
41, 40, 41, 40, 39, 38, 37, 38, 37, 36, 35, 34, 35, 34, 33, 32,
31, 30, 29, 28, 29, 28, 27, 26, 25, 26, 25, 24, 23, 22, 21, 20,
19)), .Names = c("x", "y"), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -46L))
My current code (based on a previous question I referred to). I know it's not subsetting by time:
library(zoo)
clm <- function(z) coef(lm(y ~ x, as.data.frame(z)))
rollme <- rollapplyr(zoo(sample), 10, clm, by.column = F, fill = NA)
The expected output (manually calculated) is below. The output is different from a regular rolling regression -- the numbers are different as soon as the time interval skips at 29 (secs):
NA
NA
NA
NA
NA
NA
NA
NA
NA
-0.696969697
-0.6
-0.551515152
-0.551515152
-0.6
-0.696969697
-0.6
-0.551515152
-0.551515152
-0.6
-0.696969697
-0.6
-0.551515152
-0.551515152
-0.6
-0.696969697
-0.6
-0.551515152
-0.551515152
-0.6
-0.696969697
-0.605042017
-0.638888889
-0.716981132
-0.597560976
-0.528301887
-0.5
-0.521008403
-0.642857143
-0.566666667
-0.551515152
-0.551515152
-0.6
-0.696969697
-0.605042017
-0.638888889
-0.716981132
I hope I'm providing enough information, but let me know (or give me a guide to a good example somewhere) for me to try this?
Other things I have tried:
I've tried converting the time to POSIXct format but I don't know how to perform lm on that:
require(lubridate)
x <- as.POSIXct(strptime(sample$x, format = "%S"))
Update : Added tldr section.
Try this:
# time interval is 1
sz=10
pl2=list()
for ( i in 1:nrow(sample)){
if (i<sz) period=sz else
period=length(sample$x[sample$x>(sample$x[i]-sz) & sample$x<=sample$x[i]])-1
pl2[[i]]=seq(-period,0)
}
#update for time interval > 1
sz=10
tint=1
pl2=list()
for ( i in 1:nrow(sample)){
if (i<sz) period=sz else
period=length(sample$x[sample$x>(sample$x[i]-sz*tint) & sample$x<=sample$x[i]])-1
pl2[[i]]=seq(-period,0)
}
rollme3 <- rollapplyr(zoo(sample), pl2, clm, by.column = F, fill = NA)
> tail(rollme3)
(Intercept) x
41 47.38182 -0.5515152
42 49.20000 -0.6000000
43 53.03030 -0.6969697
44 49.26050 -0.6050420
45 50.72222 -0.6388889
46 54.22642 -0.7169811
For the sake of completeness, here is an answer which uses data.table to aggregate in a non-equi join.
Although there many similar questions, e.g., r calculating rolling average with window based on value (not number of rows or date/time variable), this question deserves an answer on its own as the OP is looking for the coefficients of a rolling regression.
library(data.table)
ws <- 10 # size of sliding window in time units
setDT(sample)[.(start = x - ws, end = x), on = .(x > start, x <= end),
as.list(coef(lm(y ~ x.x))), by = .EACHI]
x x (Intercept) x.x
1: -10 0 50.00000 NA
2: -9 1 50.00000 -1.0000000
3: -8 2 50.00000 -1.0000000
4: -7 3 50.00000 -1.0000000
5: -6 4 50.00000 -1.0000000
6: -5 5 49.61905 -0.7142857
7: -4 6 49.50000 -0.6428571
8: -3 7 49.50000 -0.6428571
9: -2 8 49.55556 -0.6666667
10: -1 9 49.63636 -0.6969697
11: 0 10 49.20000 -0.6000000
12: 1 11 48.88485 -0.5515152
13: 2 12 48.83636 -0.5515152
14: 3 13 49.20000 -0.6000000
15: 4 14 50.12121 -0.6969697
16: 5 15 49.20000 -0.6000000
17: 6 16 48.64242 -0.5515152
18: 7 17 48.59394 -0.5515152
19: 8 18 49.20000 -0.6000000
20: 9 19 50.60606 -0.6969697
21: 10 20 49.20000 -0.6000000
22: 11 21 48.40000 -0.5515152
23: 12 22 48.35152 -0.5515152
24: 13 23 49.20000 -0.6000000
25: 14 24 51.09091 -0.6969697
26: 15 25 49.20000 -0.6000000
27: 16 26 48.15758 -0.5515152
28: 17 27 48.10909 -0.5515152
29: 18 28 49.20000 -0.6000000
30: 19 29 51.57576 -0.6969697
31: 22 32 49.18487 -0.6050420
32: 23 33 50.13889 -0.6388889
33: 24 34 52.47170 -0.7169811
34: 25 35 48.97561 -0.5975610
35: 26 36 46.77358 -0.5283019
36: 27 37 45.75000 -0.5000000
37: 28 38 46.34454 -0.5210084
38: 29 39 50.57143 -0.6428571
39: 30 40 47.95556 -0.5666667
40: 31 41 47.43030 -0.5515152
41: 32 42 47.38182 -0.5515152
42: 33 43 49.20000 -0.6000000
43: 34 44 53.03030 -0.6969697
44: 37 47 49.26050 -0.6050420
45: 38 48 50.72222 -0.6388889
46: 39 49 54.22642 -0.7169811
x x (Intercept) x.x
Please note that rows 10 to 30 where the time series is regularly spaced are identical to OP's rollme.
The call to as.list() forces the result of coef(lm(...)) to appear in separate columns.
The code above uses a right aligned rolling window. However, the code can be easily adapted to support a left aligned window as well:
# left aligned window
setDT(sample)[.(start = x, end = x + ws), on = .(x >= start, x < end),
as.list(coef(lm(y ~ x.x))), by = .EACHI]
With runner one can apply any R function in irregular time series. User has to specify put data to x argument and vector of dates to idx argument (to make windows time dependent). Window width k can be a integer k = 30 or character like in seq.POSIXt k = "30 secs".
First example shows how to obtain both parameters from lm function - output will be a matrix
library(runner)
runner(
x = sample,
k = "30 secs",
idx = sample$datetime,
function(x) {
coefficients(lm(y ~ x, data = x))
}
)
Or one can execute runner separately for each parameter
library(runner)
sample$intercept <- runner(
sample,
k = "30 secs",
idx = sample$datetime,
function(x) {
coefficients(lm(y ~ x, data = x))[1]
}
)
sample$slope <- runner(
sample,
k = "30 secs",
idx = sample$datetime,
function(x) {
coefficients(lm(y ~ x, data = x))[2]
}
)
head(sample, 15)
# datetime x y intercept slope
# 1 2020-04-13 09:27:20 0 50 50.00000 NA
# 2 2020-04-13 09:27:21 1 49 50.00000 -1.0000000
# 3 2020-04-13 09:27:25 2 48 50.00000 -1.0000000
# 4 2020-04-13 09:27:29 3 47 50.00000 -1.0000000
# 5 2020-04-13 09:27:29 4 46 50.00000 -1.0000000
# 6 2020-04-13 09:27:32 5 47 49.61905 -0.7142857
# 7 2020-04-13 09:27:34 6 46 49.50000 -0.6428571
# 8 2020-04-13 09:27:38 7 45 49.50000 -0.6428571
# 9 2020-04-13 09:27:38 8 44 49.55556 -0.6666667
# 10 2020-04-13 09:27:41 9 43 49.63636 -0.6969697
# 11 2020-04-13 09:27:44 10 44 49.45455 -0.6363636
# 12 2020-04-13 09:27:47 11 43 49.38462 -0.6153846
# 13 2020-04-13 09:27:48 12 42 49.38462 -0.6153846
# 14 2020-04-13 09:27:49 13 41 49.42857 -0.6263736
# 15 2020-04-13 09:27:50 14 40 49.34066 -0.6263736
Data with datetime column
sample <- structure(
list(
datetime = c(3, 1, 4, 4, 0, 3, 2, 4, 0, 3, 3, 3, 1, 1, 1, 3, 0, 2, 4, 2, 2,
3, 0, 1, 2, 4, 0, 1, 4, 4, 1, 2, 1, 3, 0, 4, 4, 1, 3, 0, 0, 2,
1, 0, 2, 0) + Sys.time(),
x = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 32, 33, 34, 35, 36, 37, 38,
39, 40, 41, 42, 43, 44, 47, 48, 49),
y = c(50, 49, 48, 47, 46, 47, 46, 45, 44, 43, 44, 43, 42, 41, 40, 41, 40, 39,
38, 37, 38, 37, 36, 35, 34, 35, 34, 33, 32, 31, 30, 29, 28, 29, 28, 27,
26, 25, 26, 25, 24, 23, 22, 21, 20,19)
),
.Names = c("x", "y"),
class = c("tbl_df", "tbl", "data.frame"),
row.names = c(NA, -46L)
)
So I am trying to label a data matrix with conditions; however, when I did my experiment, I had 3 tubes where I repeated the first two 7 times and the third tube 6 times. How can I code the matrix to be re-written and ignore that there is "missing" data:
dm$Strain<-dm$variable
dm$Strain<-rep(c("446-1", "446-2", "446-3"), each.out=193)
dm$Strain<-factor(dm$Strain)
levels(dm$Strain)
Error in $<-.data.frame(*tmp*, "Strain", value = c("446-1", "446-2", :
replacement has 3 rows, data has 19300
Data Setup in Wells:
1) Control = 1, 16, 31, 46, 61, 76, 91
2) LI 446-1 tube = 2, 17, 32, 47, 62, 77, 92
3) LI 446-1 10^7 = 3, 18, 33, 48, 63, 78, 93
4) LI 446-1 10^6 = 4, 19, 34, 49, 64, 79, 94
5) LI 446-1 10^5 = 5, 20, 35, 50, 65, 80, 95
6) Control = 6, 21, 36, 51, 66, 81, 96
7) LI-446-2 tube = 7, 22, 37, 52, 67, 82, 97
8) LI-446-2 10^7 = 8, 23, 38, 53, 68, 83, 98
9) LI-446-2 10^6 = 9, 24, 39, 54, 69, 84, 99
10) LI-446-2 10^5 = 10, 25, 40 ,55, 70, 85, 100
11) Control = 11, 26, 41, 56, 71, 86
12) LI-446-3 tube = 12, 27, 42, 57, 72, 87
13) LI-446-3 10^7 = 13, 28, 43, 58, 73, 88
14) LI-446-3 10^6 = 14, 29, 44, 59, 74, 89
15) LI-446-3 10^5 = 15, 30, 45, 60, 75, 90
I have 19300 columns of data, where 1:193 correspond to Well 1 at 15min intervals, 194:386 are Well 2 at 15 min intervals, etc up to Well 100. However, 446-3 (AKA 11-15 above) are repeated 6 times and 446-1 and 446-2 are repeated 7 times.
str(dm)
'data.frame': 19300 obs. of 4 variables:
$ Time..mins.: int 15 30 45 60 75 90 105 120 135 150 ...
$ variable : Factor w/ 100 levels "Well_1","Well_2",..: 1 1 1 1 1 1 1 1 1 1 ...
$ value : num 0.439 0.204 0.191 0.187 0.185 0.19 0.187 0.19 0.188 0.191 ...
$ Media : Factor w/ 2 levels "BHI","BHI_salt": 1 1 1 1 1 1 1 1 1 1 ...