As a reaction on :Timeseries Crossvalidation in R: using tsCV() with tslm()-Models
I tried to use it with multiple predictor variables, i made a matrix of them, but it is not working.
fcTslm <- function(y, h, xreg)
{
if(NROW(xreg) < length(y) + h)
stop("Not enough xreg data for forecasting")
X <- head(xreg, length(y))
fit <- tslm(y ~ X)
X <- subset(xreg, start=length(y)+1, end=length(y)+h)
forecast(fit, newdata=X)
}
> pred <- ts(cbind(rnorm(length(AirPassengers)),rnorm(length(AirPassengers))), start=start(AirPassengers),
+ frequency=frequency(AirPassengers))
> tsCV(AirPassengers, fcTslm, xreg=matrix(pred,ncol=2))
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
1949 NA NA NA NA NA NA NA NA NA NA NA NA
1950 NA NA NA NA NA NA NA NA NA NA NA NA
1951 NA NA NA NA NA NA NA NA NA NA NA NA
1952 NA NA NA NA NA NA NA NA NA NA NA NA
1953 NA NA NA NA NA NA NA NA NA NA NA NA
1954 NA NA NA NA NA NA NA NA NA NA NA NA
1955 NA NA NA NA NA NA NA NA NA NA NA NA
1956 NA NA NA NA NA NA NA NA NA NA NA NA
1957 NA NA NA NA NA NA NA NA NA NA NA NA
1958 NA NA NA NA NA NA NA NA NA NA NA NA
1959 NA NA NA NA NA NA NA NA NA NA NA NA
1960 NA NA NA NA NA NA NA NA NA NA NA NA
How can i make it working?
function(y, h, xreg)
{
X <- xreg[1:length(y),]
if(NROW(xreg) < length(y) + h)
stop("Not enough xreg data for forecasting")
newX <- xreg[length(y)+(1:h),]
fit <- tslm(y ~ X)
forecast(fit, newdata=newX)
}
tsCV(AirPassengers, fcTSLM, xreg=matrix(pred,ncol=1))
Related
I want to solve a statistical problem with R. I already have a working approach, but it takes too much time to get it through. Maybe someone of you has an idea how to program smarter, possibly without loops.
There is a field "Orders". Orders[, 1] contain the order number and Orders[, 2: 200] contain the article numbers ordered in the order.
I would like to fill in the field "Result". In Result[, 1] are all article numbers. The field to be filled is Result[, 2: 1000] with article numbers, which were purchased together with Result[, 1].
Since both (the i- and j-loop) goes up to more than 100000, the whole course takes ... Projected about 60 days. Does anyone have an idea to improve the performance?
My working code is:
for (i in 1:length(Result$Artiklenumber)) {
for (j in 1:length(Orders$Ordernumber)) {
if (length(which(Orders[j,]==Result[i,1])) == 0){
next
}
for (k in 2:(min(which(is.na(Orders[j,])))-1) ) {
if ( Orders[j,k]!=Result[i,1] ){
Result[i,min(which(is.na(Result[i,])))] <- Orders[j,k]
}
}
}
}
Example for "Orders":
0011566702 10131925 10131927 10136287 10136292 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011677781 16320 16800 16810 18270 18280 807310 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011724272 204520 204590 1083740 1083880 1111150 1111640 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011760684 10149459 10149460 10149461 10149462 10149463 10149464 10149465 10149466 10149467 10149468 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011784677 10151542 10151543 10151545 10151549 10151551 10151552 10151555 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011804598 10107450 10123183 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011811507 31540 4028890 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011813716 6670 16800 10050265 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
0011818851 16800 16810 807310 4229030 10050265 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
Example for "Result":
16610 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16620 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16630 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16670 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16710 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16720 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16740 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16800 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16810 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
16820 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
Here a solution which works without loops. First I generate some small test data:
orders = cbind(1001:1008, matrix(sample(1:6, 8*3, replace=TRUE), 8, 3))
orders[1:2, 4] = orders[4, 3:4] = NA
> orders
[,1] [,2] [,3] [,4]
[1,] 1001 2 4 NA
[2,] 1002 2 3 NA
...
then I extract the unique articles:
articles = unique(as.vector(orders[, -1]))
Finally I create a function which finds articles together in some basket and apply it:
findBaskets = function(article) {
ordersIncludingArticle = apply(orders[, -1] == article, 1, any)
articlesTogether = unique(as.vector(orders[ordersIncludingArticle, -1]))
articlesTogether[articlesTogether != article & !is.na(articlesTogether)]
}
sapply(articles, findBaskets)
However, this gives the solution in list format:
> res = sapply(articles, findBaskets)
> names(res) = articles
> res
$`2`
[1] 4 6 3 5 1
$`6`
[1] 3 2 1 5
...
To put this into an array you can create an empty matrix with the right dimensions and then fill the matrix by a loop or so. This should for sure not hurt the performance.
My code is as below:
Form_CharSizePorts2 <- function(main, size, var, wght, ret) {
main.cln <- main %>%
select(date, permno, exchcd, eval(parse(text=size)), eval(parse(text=var)), eval(parse(text=wght)), eval(parse(text=ret))) %>%
data.table
Bkpts.NYSE <- main.cln %>%
filter(exchcd == 1) %>%
group_by(date) %>%
summarize(var.P70 = quantile(.[[var]], probs=.7, na.rm=TRUE),
var.P30 = quantile(.[[var]], probs=.3, na.rm=TRUE),
size.Med = quantile(.[[size]], probs=.5, na.rm=TRUE))
main.rank <- main.cln %>%
merge(Bkpts.NYSE, by="date", all.x=TRUE) %>%
mutate(Size = ifelse(.[[size]]<size.Med, "Small", "Big"),
Var = ifelse(.[[var]]<var.P30, "Low", ifelse(.[[var]]>var.P70, "High", "Neutral")),
Port = paste(Size, Var, sep="."))
Ret <- main.rank %>%
group_by(date, Port) %>%
summarize(ret.port = weighted.mean(.[[ret]], .[[wght]], na.rm=TRUE)) %>%
spread(Port, ret.port) %>%
mutate(Small = (Small.High + Small.Neutral + Small.Low)/3,
Big = (Big.High + Big.Neutral + Big.Low)/3,
SMB = Small - Big,
High = (Small.High + Big.High)/2,
Low = (Small.Low + Big.Low)/2,
HML = High - Low)
return(Ret)
}
Form_FF4Ports <- function(dt) {
dt.cln <- dt %>%
group_by(permno) %>%
mutate(lag.ret.12t2 = lag(ret.12t2, 1))
output <- dt.cln %>%
group_by(date) %>%
summarize(MyMkt = weighted.mean(retadj.1mn, w=port.weight, na.rm=TRUE)) %>%
as.data.frame %>%
merge(Form_CharSizePorts2(dt.cln, "lag.ME.Jun", "lag.BM.FF", "port.weight", "retadj.1mn"),
by="date", all.x=TRUE) %>%
transmute(date, MyMkt, MySMB=SMB, MySMBS=Small, MySMBB=Big, MyHML=HML, MyHMLH=High, MyHMLL=Low) %>%
merge(Form_CharSizePorts2(dt.cln, "lag.ME.Jun", "lag.ret.12t2", "port.weight", "retadj.1mn"),
by="date", all.x=TRUE) %>%
transmute(date, MyMkt, MySMB, MySMBS, MySMBB, MyHML, MyHMLH, MyHMLL, MyUMD=HML, MyUMDU=High, MyUMDD=Low)
return(output)
}
dt.myFF4.m <- Form_FF4Ports(data.both.FF.m)
Part of my data is as below:
date permno shrcd exchcd cfacpr cfacshr shrout prc vol retx retadj.1mn me port.weight datadate
1 Dec 1925 10006 10 1 7.412625 7.260000 600 109.00 NA NA NA 65.40000 NA <NA>
2 Dec 1925 10022 10 1 9.365437 9.365437 200 56.00 NA NA NA 11.20000 NA <NA>
3 Dec 1925 10030 10 1 9.969793 9.155520 156 150.00 NA NA NA 23.40000 NA <NA>
4 Dec 1925 10057 11 1 4.000000 4.000000 500 12.25 NA NA NA 6.12500 NA <NA>
5 Dec 1925 10073 10 1 0.200000 0.200000 138 17.50 NA NA NA 2.41500 NA <NA>
6 Dec 1925 10081 10 1 1.000000 1.000000 1192 9.00 NA NA NA 10.72800 NA <NA>
7 Dec 1925 10102 10 1 18.137865 18.000000 201 109.75 NA NA NA 22.05975 NA <NA>
8 Dec 1925 10110 10 1 1.010000 1.000000 500 10.50 NA NA NA 5.25000 NA <NA>
9 Dec 1925 10129 10 1 1.000000 1.000000 270 -132.00 NA NA NA 35.64000 NA <NA>
10 Dec 1925 10137 11 1 21.842743 20.920870 613 71.75 NA NA NA 43.98275 NA <NA>
comp.count at revt ib dvc BE OpProf GrProf Cflow Inv AstChg Davis.bkeq d.shares ret.12t2 ME.Dec ME.Jun BM.FF OpIB
1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
2 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
3 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
4 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
5 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
6 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
7 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
GrIA CFP.FF BM.m CFP.m lag.ME.Jun lag.BM.FF lag.OpIB lag.AstChg
1 NA NA NA NA NA NA NA NA
2 NA NA NA NA NA NA NA NA
3 NA NA NA NA NA NA NA NA
4 NA NA NA NA NA NA NA NA
5 NA NA NA NA NA NA NA NA
6 NA NA NA NA NA NA NA NA
7 NA NA NA NA NA NA NA NA
8 NA NA NA NA NA NA NA NA
9 NA NA NA NA NA NA NA NA
10 NA NA NA NA NA NA NA NA
When I run the rode, I got the error message Error in eval(expr, envir, enclos) : object 'lag.ME.Jun' not found.
I guess the reason could be that I used the eval(parse(text = )) function here, and the environment is not set up correctly. However, other than this function, I am not sure which approach I should use when creating a universal purpose function suitable for data with different column names.
Specifically, I would like to know how I can use my function for different data frames without having to change the column names before I use them in my function.
Your issue is discussed, and solved, in the 'Programming with dplyr' vignette.
The bottomline is instead of quoting lag.ME.Jun yourself by referring to it using "lag.ME.Jun", you should rely on enquo(lag.ME.Jun) and !!lag.ME.Jun. However, this would mean that it should be in the function call.
Your function at several other points also refers to variables that are not created in the function environment (e.g. exchcd, date), so R will currently throw errors on any dataset that does not contain these variables. In general, it is unwise for functions to rely on inputs that were not part of the function call.
I have a vector:
x <- c(1,2,3,4)
I would like to add 23 NA elements before each element of x
Maybe like this?
c(sapply(x, function(x) c(rep(NA,23),x)))
We can do this with vectorization
replace(rep(NA, 23*length(x) + length(x)), rep(c(FALSE, TRUE), c(23, 1)), x)
#[1] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
#[43] NA NA NA NA NA 2 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3 NA NA NA NA NA NA NA NA NA NA NA NA
#[85] NA NA NA NA NA NA NA NA NA NA NA 4
Or another option is to create a matrix, replace the last row with 'x' and convert it to vector
m1 <- matrix(rep(rep(NA, 24), length(x)), nrow = length(x))
m1[,24] <- x
c(t(m1))
I'm trying to subset a raster based on cell numbers. I want to provide a vector of cell numbers and return a raster with the original cell values for those cells referenced in the cell numbers vector. I tried the rasterFromCells() function but this seems to interpolate between cell numbers and doesn't return values, but rather cell numbers. I've tried:
#original raster loaded with 400 sample values ranging from 1:24
foo <- raster(ncol=20, nrow=20)
foo[] <- sample(seq(1,24),400,replace = TRUE)
#vector of desired cell numbers
my.pts <- c(2,20,200)
#rasterFromCells attempt
bar<-rasterFromCells(foo, my.pts, values=TRUE)
How can I return a raster layer with foo's values for cell numbers 2, 20 and 200 and all other cells asNA?
If you want to create a new raster with the values at only the cell locations in my.pts replaced by the values at those cell locations in foo and all other cell values set to NA, you just have to:
create a raster (i.e., bar) the same size as foo.
fill it with NAs
Use bar[my.pts] <- foo[my.pts]
For example:
library(raster)
set.seed(123) ## for reproducible results
foo <- raster(ncols=20, nrows=20)
foo[] <- sample(seq(1,24),400,replace = TRUE)
#vector of desired cell numbers
my.pts <- c(2,20,200)
## create raster the same size as foo filled with NAs
bar <- raster(ncols=ncol(foo), nrows=nrow(foo))
bar[] <- NA
## replace the values with those in foo
bar[my.pts] <- foo[my.pts]
foo[my.pts]
##[1] 19 23 14
bar[]
## [1] NA 19 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 23 NA NA NA NA NA NA NA NA NA NA NA
## [32] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [63] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [94] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[125] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[156] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[187] NA NA NA NA NA NA NA NA NA NA NA NA NA 14 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[218] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[249] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[280] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[311] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[342] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##[373] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
Another approach to accomplish the same result is to copy foo to bar and then set all cells locations not in my.pts to NAs:
bar <- foo
bar[setdiff(1:ncell(foo),my.pts)] <- NA
The advantage of rasterFromCells is that it returns a smaller raster, as it contains only the cropped version of what you want.
So what you need to do is to feed again the value of your initial raster (r) in the new one (r2), which is eased by the fact that the new one (r2) returns the original cell numbers:
r <- raster(ncols=100, nrows=100)
r[] <- rnorm(ncell(r))
cells <- c(3:5, 210)
r2 <- rasterFromCells(r, cells, values=TRUE)
ini_cells <- getValues(r2)
Simply feed the values according to the index:
r2[] <- r[ini_cells]
This results in a raster of 24 cells instead of 10'000!
c(ncell(r), ncell(r2))
Let us compare the results:
data.frame(Orig=getValues(r)[cells], New=getValues(r2)[ini_cells %in% cells])
[,1] [,2]
[1,] -0.5081512 -0.5081512
[2,] -0.8799739 -0.8799739
[3,] 0.3722788 0.3722788
[4,] -0.7661364 -0.7661364
Note: you wanted to set all others to NA. You would do this with:
r2[!ini_cells %in% cells] <- NA
head(getValues(r2))
-0.5081512 -0.8799739 0.3722788 NA NA NA
I have a big table in R with lots of NA values.
The first lines:
"tm1" "score1" "score2" "score3" "score4" "score5" "score6" "score7" "score8" "score9" "score10" "score11" "score12" "score13" "score14" "score15" "score16" "score17" "score18" "score19" "score20" "score21" "score22" "score23" "score24" "score25" "score26" "score27" "score28" "score29" "score30" "score31" "score32" "score33" "score34" "score35" "score36" "score37" "score38" "score39" "score40" "score41" "score42" "score43" "score44" "score45" "score46" "score47" "score48" "score49" "score50" "score51" "score52" "score53" "score54" "score55" "score56" "score57" "score58" "score59" "score60" "score61" "score62" "score63" "score64" "score65" "score66" "score67" "score68" "score69" "score70" "score71" "score72" "score73" "score74" "score75" "score76" "score77" "score78" "score79" "score80" "score81" "score82" "score83" "score84" "score85" "score86" "score87" "score88" "score89" "score90" "score91" "score92" "score93" "score94" "score95" "score96" "score97" "score98" "score99" "score100"
"1" 7289 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 35177.5 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"2" 7290 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 37149 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"3" 7296 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 33172.3 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"4" 7297 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 45095.7 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"5" 7298 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 44116.1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"6" 7300 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 37162.1 NA 36188.6 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"7" 7302 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 35188 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"8" 7303 NA NA NA NA NA NA NA NA 37146.9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"9" 7304 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 41134.4 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 32172.8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 35154.6 NA NA NA NA NA NA
"10" 7306 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 38147 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 36155.7 NA NA 46104.1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
"11" 7308 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 33167.1 NA 27211.4 NA NA NA NA NA NA NA NA NA NA NA NA NA
"12" 7310 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 46097.1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
I want to replace each scoreX NA value with the previously known value. I wanted to do it using locf from the zoo package:
newdata$score1 <- zoo::na.locf(newdata$score1 )
newdata$score2 <- zoo::na.locf(newdata$score2 )
newdata$score3 <- zoo::na.locf(newdata$score3 )
newdata$score4 <- zoo::na.locf(newdata$score4 )
newdata$score5 <- zoo::na.locf(newdata$score5 )
newdata$score6 <- zoo::na.locf(newdata$score6 )
newdata$score7 <- zoo::na.locf(newdata$score7 )
newdata$score8 <- zoo::na.locf(newdata$score8 )
newdata$score9 <- zoo::na.locf(newdata$score9 )
newdata$score10 <- zoo::na.locf(newdata$score10 )
newdata$score11 <- zoo::na.locf(newdata$score11 )
newdata$score12 <- zoo::na.locf(newdata$score12 )
newdata$score13 <- zoo::na.locf(newdata$score13 )
newdata$score14 <- zoo::na.locf(newdata$score14 )
newdata$score15 <- zoo::na.locf(newdata$score15 )
newdata$score16 <- zoo::na.locf(newdata$score16 )
newdata$score17 <- zoo::na.locf(newdata$score17 )
newdata$score18 <- zoo::na.locf(newdata$score18 )
newdata$score19 <- zoo::na.locf(newdata$score19 )
newdata$score20 <- zoo::na.locf(newdata$score20 )
newdata$score21 <- zoo::na.locf(newdata$score21 )
newdata$score22 <- zoo::na.locf(newdata$score22 )
newdata$score23 <- zoo::na.locf(newdata$score23 )
newdata$score24 <- zoo::na.locf(newdata$score24 )
newdata$score25 <- zoo::na.locf(newdata$score25 )
newdata$score26 <- zoo::na.locf(newdata$score26 )
newdata$score27 <- zoo::na.locf(newdata$score27 )
newdata$score28 <- zoo::na.locf(newdata$score28 )
newdata$score29 <- zoo::na.locf(newdata$score29 )
newdata$score30 <- zoo::na.locf(newdata$score30 )
newdata$score31 <- zoo::na.locf(newdata$score31 )
newdata$score32 <- zoo::na.locf(newdata$score32 )
newdata$score33 <- zoo::na.locf(newdata$score33 )
newdata$score34 <- zoo::na.locf(newdata$score34 )
newdata$score35 <- zoo::na.locf(newdata$score35 )
newdata$score36 <- zoo::na.locf(newdata$score36 )
newdata$score37 <- zoo::na.locf(newdata$score37 )
newdata$score38 <- zoo::na.locf(newdata$score38 )
newdata$score39 <- zoo::na.locf(newdata$score39 )
newdata$score40 <- zoo::na.locf(newdata$score40 )
newdata$score41 <- zoo::na.locf(newdata$score41 )
newdata$score42 <- zoo::na.locf(newdata$score42 )
newdata$score43 <- zoo::na.locf(newdata$score43 )
newdata$score44 <- zoo::na.locf(newdata$score44 )
newdata$score45 <- zoo::na.locf(newdata$score45 )
newdata$score46 <- zoo::na.locf(newdata$score46 )
newdata$score47 <- zoo::na.locf(newdata$score47 )
newdata$score48 <- zoo::na.locf(newdata$score48 )
newdata$score49 <- zoo::na.locf(newdata$score49 )
newdata$score50 <- zoo::na.locf(newdata$score50 )
newdata$score51 <- zoo::na.locf(newdata$score51 )
newdata$score52 <- zoo::na.locf(newdata$score52 )
newdata$score53 <- zoo::na.locf(newdata$score53 )
newdata$score54 <- zoo::na.locf(newdata$score54 )
newdata$score55 <- zoo::na.locf(newdata$score55 )
newdata$score56 <- zoo::na.locf(newdata$score56 )
newdata$score57 <- zoo::na.locf(newdata$score57 )
newdata$score58 <- zoo::na.locf(newdata$score58 )
newdata$score59 <- zoo::na.locf(newdata$score59 )
newdata$score60 <- zoo::na.locf(newdata$score60 )
newdata$score61 <- zoo::na.locf(newdata$score61 )
newdata$score62 <- zoo::na.locf(newdata$score62 )
newdata$score63 <- zoo::na.locf(newdata$score63 )
newdata$score64 <- zoo::na.locf(newdata$score64 )
newdata$score65 <- zoo::na.locf(newdata$score65 )
newdata$score66 <- zoo::na.locf(newdata$score66 )
newdata$score67 <- zoo::na.locf(newdata$score67 )
newdata$score68 <- zoo::na.locf(newdata$score68 )
newdata$score69 <- zoo::na.locf(newdata$score69 )
newdata$score70 <- zoo::na.locf(newdata$score70 )
newdata$score71 <- zoo::na.locf(newdata$score71 )
newdata$score72 <- zoo::na.locf(newdata$score72 )
newdata$score73 <- zoo::na.locf(newdata$score73 )
newdata$score74 <- zoo::na.locf(newdata$score74 )
newdata$score75 <- zoo::na.locf(newdata$score75 )
newdata$score76 <- zoo::na.locf(newdata$score76 )
newdata$score77 <- zoo::na.locf(newdata$score77 )
newdata$score78 <- zoo::na.locf(newdata$score78 )
newdata$score79 <- zoo::na.locf(newdata$score79 )
newdata$score80 <- zoo::na.locf(newdata$score80 )
newdata$score81 <- zoo::na.locf(newdata$score81 )
newdata$score82 <- zoo::na.locf(newdata$score82 )
newdata$score83 <- zoo::na.locf(newdata$score83 )
newdata$score84 <- zoo::na.locf(newdata$score84 )
newdata$score85 <- zoo::na.locf(newdata$score85 )
newdata$score86 <- zoo::na.locf(newdata$score86 )
newdata$score87 <- zoo::na.locf(newdata$score87 )
newdata$score88 <- zoo::na.locf(newdata$score88 )
newdata$score89 <- zoo::na.locf(newdata$score89 )
newdata$score90 <- zoo::na.locf(newdata$score90 )
newdata$score91 <- zoo::na.locf(newdata$score91 )
newdata$score92 <- zoo::na.locf(newdata$score92 )
newdata$score93 <- zoo::na.locf(newdata$score93 )
newdata$score94 <- zoo::na.locf(newdata$score94 )
newdata$score95 <- zoo::na.locf(newdata$score95 )
newdata$score96 <- zoo::na.locf(newdata$score96 )
newdata$score97 <- zoo::na.locf(newdata$score97 )
newdata$score98 <- zoo::na.locf(newdata$score98 )
newdata$score99 <- zoo::na.locf(newdata$score99 )
newdata$score100 <- zoo::na.locf(newdata$score100 )
I get an error, probably due to the fact the the first values do not have a previous value!
Error in $<-.data.frame(*tmp*, "score1", value = c(32189.8, 32189.8, :
replacement has 459744 rows, data has 459772
I guess I could rerun my experiment and add a nice tm1=0 value for each run, but I was wondering if there is a way to circumvent this. Say, leave the NA value for the rows that do not have a previous value?
You definitely must set some default value, if there is no value in front of first NA. In following example, I set it to 0.
# create new data.frame with score0 = 0 as first column
newdata <- data.frame(newdata$tm1, score0=rep(0,nrow(newdata)), newdata[,-1])
# apply function na.locf to every row
a <- t(apply(newdata[,-c(1)], 1, na.locf))
# append to original data.frame (this will keep the column score0)
newdata[,2:ncol(newdata)] <- a