Related
I have a matrix where I would like to estimate 4 values:
M = [ var1 corr 0]
[ corr var2 0]
[ 0 0 0]
Basically, the matrix has two variances and a correlation in the position M[1,2] and M[2,1] which should be equal. To this end, I wrote a function for optim as follows:
M <- matrix(c(NA,NA,0,NA,NA,0,0,0,0),3,3,byrow=TRUE)
objf <- function(pars, model, estimate = TRUE) {
model$M[is.na(model$M)] <- pars[1:4]
if (estimate) {
-logLik(model)
} else {
model
}
}
However, when I run my code the output for the two correlation values is different, so I was wondering if there is a better way to write my code such that I have M[1,2] = M[2,1]. I think using the line model$M[is.na(model$M)] is the issue but I'm not sure how to write the code better, so if anyone could help me out I'd appreciate it, thanks!
You could change your objective function to have only 3 parameters and replace
model$M[is.na(model$M)] <- pars[1:4]
with
model$M[is.na(model$M)] <- pars[c(1,2,2,3)]
An illustration
M <- matrix(c(NA,NA,0,
NA,NA,0,
0, 0,0), 3, 3, byrow=TRUE)
pars <- 1:3
M[is.na(M)] <- pars[c(1,2,2,3)]
M
[,1] [,2] [,3]
[1,] 1 2 0
[2,] 2 3 0
[3,] 0 0 0
I want to compute cumulative sum for the first (n-1) columns(if we have n columns matrix) and subsequently average the values. I created a sample matrix to do this task. I have the following matrix
ma = matrix(c(1:10), nrow = 2, ncol = 5)
ma
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 5 7 9
[2,] 2 4 6 8 10
I wanted to find the following
ans = matrix(c(1,2,2,3,3,4,4,5), nrow = 2, ncol = 4)
ans
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
The following are my r function.
ColCumSumsAve <- function(y){
for(i in seq_len(dim(y)[2]-1)) {
y[,i] <- cumsum(y[,i])/i
}
}
ColCumSumsAve(ma)
However, when I run the above function its not producing any output. Are there any mistakes in the code?
Thanks.
There were several mistakes.
Solution
This is what I tested and what works:
colCumSumAve <- function(m) {
csum <- t(apply(X=m, MARGIN=1, FUN=cumsum))
res <- t(Reduce(`/`, list(t(csum), 1:ncol(m))))
res[, 1:(ncol(m)-1)]
}
Test it with:
> colCumSumAve(ma)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
which is correct.
Explanation:
colCumSumAve <- function(m) {
csum <- t(apply(X=m, MARGIN=1, FUN=cumsum)) # calculate row-wise colsum
res <- t(Reduce(`/`, list(t(csum), 1:ncol(m))))
# This is the trickiest part.
# Because `csum` is a matrix, the matrix will be treated like a vector
# when `Reduce`-ing using `/` with a vector `1:ncol(m)`.
# To get quasi-row-wise treatment, I change orientation
# of the matrix by `t()`.
# However, the output, the output will be in this transformed
# orientation as a consequence. So I re-transform by applying `t()`
# on the entire result at the end - to get again the original
# input matrix orientation.
# `Reduce` using `/` here by sequencial list of the `t(csum)` and
# `1:ncol(m)` finally, has as effect `/`-ing `csum` values by their
# corresponding column position.
res[, 1:(ncol(m)-1)] # removes last column for the answer.
# this, of course could be done right at the beginning,
# saving calculation of values in the last column,
# but this calculation actually is not the speed-limiting or speed-down-slowing step
# of these calculations (since this is sth vectorized)
# rather the `apply` and `Reduce` will be rather speed-limiting.
}
Well, okay, I could do then:
colCumSumAve <- function(m) {
csum <- t(apply(X=m[, 1:(ncol(m)-1)], MARGIN=1, FUN=cumsum))
t(Reduce(`/`, list(t(csum), 1:ncol(m))))
}
or:
colCumSumAve <- function(m) {
m <- m[, 1:(ncol(m)-1)] # remove last column
csum <- t(apply(X=m, MARGIN=1, FUN=cumsum))
t(Reduce(`/`, list(t(csum), 1:ncol(m))))
}
This is actually the more optimized solution, then.
Original Function
Your original function makes only assignments in the for-loop and doesn't return anything.
So I copied first your input into a res, processed it with your for-loop and then returned res.
ColCumSumsAve <- function(y){
res <- y
for(i in seq_len(dim(y)[2]-1)) {
res[,i] <- cumsum(y[,i])/i
}
res
}
However, this gives:
> ColCumSumsAve(ma)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1.5 1.666667 1.75 9
[2,] 3 3.5 3.666667 3.75 10
The problem is that the cumsum in matrices is calculated in column-direction instead row-wise, since it treats the matrix like a vector (which goes columnwise through the matrix).
Corrected Original Function
After some frickeling, I realized, the correct solution is:
ColCumSumsAve <- function(y){
res <- matrix(NA, nrow(y), ncol(y)-1)
# create empty matrix with the dimensions of y minus last column
for (i in 1:(nrow(y))) { # go through rows
for (j in 1:(ncol(y)-1)) { # go through columns
res[i, j] <- sum(y[i, 1:j])/j # for each position do this
}
}
res # return `res`ult by calling it at the end!
}
with the testing:
> ColCumSumsAve(ma)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
Note: dim(y)[2] is ncol(y) - and dim(y)[1] is nrow(y) -
and instead seq_len(), 1: is shorter and I guess even slightly faster.
Note: My solution given first will be faster, since it uses apply, vectorized cumsum and Reduce. - for-loops in R are slower.
Late Note: Not so sure that the first solution is faster. Since R-3.x it seems that for loops are faster. Reduce will be the speed limiting funtion and can be sometimes incredibly slow.
k <- t(apply(ma,1,cumsum))[,-ncol(k)]
for (i in 1:ncol(k)){
k[,i] <- k[,i]/i
}
k
This should work.
All you need is rowMeans:
nc <- 4
cbind(ma[,1],sapply(2:nc,function(x) rowMeans(ma[,1:x])))
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
Here's how I did it
> t(apply(ma, 1, function(x) cumsum(x) / 1:length(x)))[,-NCOL(ma)]
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
This applies the cumsum function row-wise to the matrix ma and then divides by the correct length to get the average (cumsum(x) and 1:length(x) will have the same length). Then simply transpose with t and remove the last column with [,-NCOL(ma)].
The reason why there is no output from your function is because you aren't returning anything. You should end the function with return(y) or simply y as Marius suggested. Regardless, your function doesn't seem to give you the correct response anyway.
I am trying to do something that I am sure should be quite simple: I am trying to make a function which turns a list of number pairs (pairedList) and a vector (botList) into a series of vectors (one for each pair) of length(botlist) where the numbers in those vectors are all equal to zero except for those corresponding to the index points identified by the pair which will be 1.
#generating mock data to simulate my application:
pair1 <- c(2,4)
pair2 <- c(1,3)
pair3 <- c(5,6)
pairedList <- c(pair1, pair2, pair3)
botList <- c(1:length(pairedList))
Here is what the output should ultimately look like:
[1] 0 1 0 1 0 0
[1] 1 0 1 0 0 0
[1] 0 0 0 0 1 1
The code below allows me to print the vectors in the right manner (by replacing the line in the if loop with print(prob) and commenting out the final print statement):
library(gtools)
test <- function() {
#initialising empty list
output <- list()
for (i in botList) {
x <- rep(0, length(pairedList))
ind <- pairedList[i:(i+1)]
ind.inv <- sort(ind, decreasing=T)
val <- rep(1,length(ind))
new.x <- vector(mode="numeric",length(x)+length(val))
new.x <- new.x[-ind]
new.x[ind] <- val
prob <- new.x
if (odd(i)) {
output[i] <- prob
}
print(output)
}
}
However I need to return this list of vectors from my function rather than printing it and when I do so, I get the following output and am met with an error and a number of warnings:
[[1]]
[1] 0
[[1]]
[1] 0
[[1]]
[1] 0
[[2]]
NULL
[[3]]
[1] 1
[[1]]
[1] 0
[[2]]
NULL
[[3]]
[1] 1
[[1]]
[1] 0
[[2]]
NULL
[[3]]
[1] 1
[[4]]
NULL
[[5]]
[1] 0
Error in new.x[-ind] : only 0's may be mixed with negative subscripts
In addition: Warning messages:
1: In output[i] <- prob :
number of items to replace is not a multiple of replacement length
2: In output[i] <- prob :
number of items to replace is not a multiple of replacement length
3: In output[i] <- prob :
number of items to replace is not a multiple of replacement length
My question is:
How can I change my code to output what I need from this function? I thought this was going to be a five minute job, and after hours on this one little thing I am stuck!
Thanks in advance
Something you can try, although there must be nicer ways:
# create a list with all the "pair1", "pair2", ... objects
l_pairs <- mget(ls(pattern="^pair\\d+"))
# compute maximum number among the values of pair., it determines the number of columns of the results
n_max <- max(unlist(l_pairs))
# finally, create for each pair. a vector of 0s and put 1s at the positions specified in pair.
res <- t(sapply(l_pairs, function(x){y <- rep(0, n_max); y[x]<-1; y}))
res
# [,1] [,2] [,3] [,4] [,5] [,6]
#pair1 0 1 0 1 0 0
#pair2 1 0 1 0 0 0
#pair3 0 0 0 0 1 1
You could use row/col indexing
m1 <- matrix(0, ncol=max(pairedList), nrow=3)
m1[cbind(rep(1:nrow(m1),each=2), pairedList)] <- 1
m1
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0 1 0 1 0 0
#[2,] 1 0 1 0 0 0
#[3,] 0 0 0 0 1 1
James, the following should work. I've just tested it.
pair1 <- c(2,4)
pair2 <- c(1,3)
pair3 <- c(5,6)
pairedList <- c(pair1, pair2, pair3)
botList <- c(1:(length(pairedList)/2)
library(gtools)
test <- function(pairedList, botList) {
#initialising empty list
output <- list()
for (i in botList) {
x <- rep(0, length(pairedList))
ind <- pairedList[i:(i+1)]
ind.inv <- sort(ind, decreasing=T)
val <- rep(1,length(ind))
new.x <- vector(mode="numeric",length(x)+length(val))
new.x <- new.x[-ind]
new.x[ind] <- val
prob <- new.x
output[[i]] <- prob
print(prob)
}
return(output)
}
The reason for the strange error is that botList was being created as length 6 rather than length 3. Also if you want to assign a value to a list within a function you need to use double [[]] rather than []
Once you've removed them from the function rbind them all together as follows:
output <- test(pairedList, botList)
result <- do.call(rbind,output)
I would like to save the output of every function call of the following recursive function to a list. Moreover, I need to know which (j,l)-pair correspond to which entry of the resulting list.
I have created a stripped down version to reproduce the problem. Please let me know if I should provide more information to help solve the problem. Any help is highly appreciated. Thank you.
#the recursive function
phi <- function(phik,j,l,k,d) {
if(j==0) {
diag(d)
}
else{
if(j==1) {
if(l>k) {
0 * diag(d)
}
else{
phik[[l]]
}
}
else {
if(l>k) {
0 + phi(phik,j-1,l,k,d) %*% phik[[1]]
}
else {
phi(phik,j-1,l+1,k,d) + phi(phik,j-1,l,k,d) %*% phik[[1]]
}
}
}
}
#related stuff
set.seed(123456)
phik <- vector(mode="list", length=3)
phik[[1]] <- matrix(rnorm(n=16,mean=0,s=1),nrow=4)
phik[[2]] <- matrix(rnorm(n=16,mean=0,s=1),nrow=4)
phik[[3]] <- matrix(rnorm(n=16,mean=0,s=1),nrow=4)
d <- nrow(phik[[1]])
k <- length(phik)
#function call
phiout <- phi(phik,j=10,l=1,k=k,d=d)
So, it is a little tricky with recursive functions, because if you want the results of the intermediate steps, you have glue them together in a list. Of course, that means when you use the results of the recursion in the function, you have to dig out the value that you want. That sounds a little convoluted, but in your case, I just mean that you have to return a little list of phi, j, and l at every step, but pull out just phi when you do the multiplications. Here is a little example:
#the recursive function
phi <- function(phik,j,l,k,d) {
if(j==0)
list(list(phi=diag(d),j=j,l=l))
else{
if(j==1) {
if(l>k)
list(list(phi=0 * diag(d),j=j,l=l))
else
list(list(phi=phik[[l]],j=j,l=l))
}
else {
if(l>k) {
first<-phi(phik,j-1,l,k,d)
second<-list(list(phi=0 + first[[1]]$phi %*% phik[[1]], j=j,l=l))
c(second,first)
}
else {
first<-phi(phik,j-1,l+1,k,d)
second<-phi(phik,j-1,l,k,d)
third<-list(list(phi=first[[1]]$phi+(second[[1]]$phi %*% phik[[1]]), j=j, l=l))
c(third,first,second)
}
}
}
}
You might be interested in why I nested the results in the first to third cases (when j is 0 or 1). If you look at the other cases, it might become clear. When l>k (and j is not 0 or 1), then there are two calls phi made. In this case, there will be a list returned, with two sets of phi, i, and j, so it is necessarily a list of lists. When I want to pull out phi from a returned value, it is difficult to tell whether it was going to be just a list or a list of lists, so I just standardized them all to the same thing.
I think return statements are ugly, but others disagree. You can add them in if you like, but they are strictly unnecessary (in this case).
Some sample output:
set.seed(123456)
phik <- vector(mode="list", length=3)
phik[[1]] <- matrix(rnorm(n=16,mean=0,s=1),nrow=4)
phik[[2]] <- matrix(rnorm(n=16,mean=0,s=1),nrow=4)
phik[[3]] <- matrix(rnorm(n=16,mean=0,s=1),nrow=4)
d <- nrow(phik[[1]])
k <- length(phik)
phi(phik,j=2,l=3,k,d)
# [[1]]
# [[1]]$phi
# [,1] [,2] [,3] [,4]
# [1,] -0.9087417 -2.064341 -0.9962198 0.7713081
# [2,] -2.9595280 -5.330120 -4.0488408 2.3357631
# [3,] -1.3754167 -3.866457 -0.8592336 1.4135614
# [4,] -0.1021518 -4.332802 0.4883886 -2.2130314
#
# [[1]]$j
# [1] 2
#
# [[1]]$l
# [1] 3
#
#
# [[2]]
# [[2]]$phi
# [,1] [,2] [,3] [,4]
# [1,] 0 0 0 0
# [2,] 0 0 0 0
# [3,] 0 0 0 0
# [4,] 0 0 0 0
#
# [[2]]$j
# [1] 1
#
# [[2]]$l
# [1] 4
#
#
# [[3]]
# [[3]]$phi
# [,1] [,2] [,3] [,4]
# [1,] -1.0461983 1.560074 -1.0713045 0.1582893
# [2,] -2.7488684 1.015088 0.9678209 -0.5019485
# [3,] -1.1298596 1.043994 0.1710325 -0.9659226
# [4,] -0.8616848 -1.115905 -0.8962503 -0.1137341
#
# [[3]]$j
# [1] 1
#
# [[3]]$l
# [1] 3
I'm trying to generate buy/sell signals using MFI to test a strategy. it's should actually be pretty simple but R is giving me a hard time.
Here's my code:
q <- get(getSymbols('spy',src='yahoo'))
q$mfi <- MFI(q[,2:4],q[,5],5)
sig <- function(row) {
if (row$mfi < 20) { return (1)}
else if (row$mfi > 80) { return (-1)}
else { return (0)}}
q$result<-apply(q,1,sig)
The error that I'm getting is:
Error in row$mfi : $ operator is invalid for atomic vectors
if there are better ways of testing strategies using simple conditions i would appreciate it...
here no need to use apply, use ifelse, it is vectorized
mfi <- c(10,15,20,50,70,90,100)
res <- ifelse(mfi < 20, 1, ifelse( mfi < 80,0,-1))
rbind(mfi,res) ## rbind here just to show you the result and you can compare
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
mfi 10 15 20 50 70 90 100
res 1 1 0 0 0 -1 -1
EDIT dut to the calrify to the OP
q <- getSymbols('XXX')
q$mfi <- ....
q$rsi <- ....
sig <- function(q,...) {
if('mfi' %in% names(q))
res <- ifelse(mfi < 20, 1,
ifelse( mfi < 80,0,-1))
else
res <- NULL
res
}
sig(q)
[1] 1 1 0 0 0 -1 -1