I need to develop a function in R which can be used to compute time varying variable API which is defines as: api(t)=k*api(t-1)+ppt(t).
ppt=round(c(0.0,0.0,0.0,runif(25, 0.0, 15.5),0.0,0.0),digit=1)
api=c(5.75,rep(NA,29))
k=0.85
f <- function(k,api,ppt,...){
for (i in 2:30){
api[i]=k*api[i-1]+ppt[i]
return(api)}}
f(k=k,api=api,ppt=ppt)
when I apply the above function I am only getting the first value.
I appreciate you help.
You can use simple recursion:
calculateP <- function(startP, t, k, j) {
if (t == 0) {
return (stp)
}
return (k[t]*calcP(stp, t-1, k,j) + j[t])
}
Seems to work pretty well.
Related
I would like to build a function which runs a chi square test if calc=TRUE. The problem appears to be targeting the variables used within the wtd.chi.sq function.
Thank you very much in advance.
library(weights); library(sjstats)
testfunction <- function(dta, x, y, calc=TRUE, annotate=note){
if(isTRUE(calc)){
testresult<-wtd.chi.sq(dta[[x]], dta[[y]])
return(testresult["p.value"])
}
else {
annotate <- paste0(note, "... and no calc necessary")
}
return(annotate)
}
testfunction(dta=df, x=f1, y=s12x, calc=TRUE, annotate=note)
Error in tbl_subset2(x, j = i, j_arg = substitute(i)) :
object 'f1' not found
I am trying to define a function with a for loop and inside a conditional in R studio. Yesterday I was able with the help of another thread to devise this piece of code. The problem is that I want to sum the vector elements ma for any possible x, so that is inside the function l. This is a simpler case which I am trying to solve to adapt the original model. However, I do not know how to proceed.
ma<-rep(0,20)
l <- function(x, ma) {
for(i in seq_along(ma)) {
if(i %% 2 == 1) {
ma[i] <- i + x
} else {
ma[i] <- 0
}
}
return(ma)
}
My problem is that I would like to have the sum of i+x+0+i+x... for any possible x. I mean a function of the kind for any possible x.
Question:
Can someone explain to me how to implement such a function in R?
Thanks in advance!
I am going to update the original function:
Theta_alpha_s<-function(s,alpha,t,Basis){
for (i in seq_along(Basis)){
if(i%% 2==1) {Basis[i]=s*i^{-alpha-0.5}*sqrt(2)*cos(2*pi*i*t)}
else{Basis[i]=s*i^{-alpha-0.5}*sqrt(2)*sin(2*pi*i*t)}
}
return(Basis)
}
If you don't want to change the values in Basis, you can create a new vector in the function (here result) that you will return:
l = function(s,alpha,t,Basis){
is.odd = which(Basis %% 2 == 1)
not.odd = which(Basis %% 2 == 0)
result = rep(NA, length(Basis))
result[is.odd] = s*is.odd^{-alpha-0.5}*sqrt(2)*cos(2*pi*is.odd*t)
result[not.odd] = s*not.odd^{-alpha-0.5}*sqrt(2)*sin(2*pi*not.odd*t)
#return(result)
return(c(sum(result[is.odd]), sum(result[not.odd])))
}
I have no trouble implementing a code to find the biggest eigenvalue, and corresponding eigenvector of a matrix using the power method.
What I have more trouble with, is thinking of a code that can output all eigenvalues and eigenvectors of a given matrix at once. I am able to do it manually on a small matrix, but can't seem to properly generalize it.
I suspect it can be done in a beautiful way with some recursion but I'd need some help on that.
EDIT: Also I don't have trouble finding all the eigenvalues either, it's the eigenvectors that cause me trouble
Here would be the code that does it manually:
#Example matrix
test.set=matrix(0,4,4)
test.set[1,]=c(-2,2,1,5)
test.set[2,]=c(2,5,8,8)
test.set[3,]=c(4,2,6,3)
test.set[4,]=c(5,-2,4,9)
The function to get one Eigenvalue/Eigenvector
#Power method simple : return biggest egeinvalue and corresponding eigenvector
power_method_simple=function(A,n_rep) {
#Initialize with a random column of the matrix
b_0=A[,sample(1:ncol(A),size=1)]
for (k in 1:n_rep) {
b_0=A%*%b_0
b_0_norm=sqrt(t(b_0)%*%b_0)
b_0=b_0/b_0_norm[1,1]
print(b_0)
}
eigenvalue=(t(b_0)%*%A%*%b_0)[1,1]
res_list=list(b_0,eigenvalue)
names(res_list)=c("vector","eigenvalue")
return(res_list)
}
Now the example by hand:
#################
#By hand
#First
res1=power_method_simple(test.set,n_rep=1000)
first_ev=res1$vector
first_value=res1$eigenvalue
#Second
residual_matrix1=test.set-first_value*first_ev%*%t(first_ev)
res2=power_method_simple(residual_matrix1,n_rep=1000)
second_value=res2$eigenvalue
second_ev=(second_value-first_value)*res2$vector + first_value*((t(first_ev)%*%res2$vector)[1,1])*first_ev
second_ev=second_ev/sqrt((t(second_ev)%*%second_ev)[1,1])
#Third
residual_matrix2=residual_matrix1-second_value*res2$vector%*%t(res2$vector)
res3=power_method_simple(residual_matrix2,n_rep=1000)
third_value=res3$eigenvalue
u3=(third_value-second_value)*res3$vector + second_value*((t(res2$vector)%*%res3$vector)[1,1])*res2$vector
u3=u3/sqrt((t(u3)%*%u3)[1,1])
third_ev=(third_value-first_value)*u3 + first_value*((t(first_ev)%*%u3)[1,1])*first_ev
third_ev=third_ev/sqrt((t(third_ev)%*%third_ev)[1,1])
#I works for first three
print(eigen(test.set)$vector)
print(cbind(first_ev,second_ev,third_ev))
I am using the answer to the following question to do this:
Answer to: Power method for finding all eigenvectors
How to make a clean function that does everything at one out of that?
A recursive function like this seems to work:
find_vals=function(matrix, values=list(), vectors=list(), evs=list(), n=nrow(matrix)) {
if (n<1) return(list(values, evs))
res=power_method_simple(matrix,n_rep=1000)
curr_val = res$eigenvalue
res_v = res$vector
i = nrow(matrix) - n + 1
values[i] = curr_val
vectors[[i]] = res_v
if (i == 1) {
evs[[i]] = res_v
} else {
curr_v = vectors[[i]]
for (k in (i-1):1) {
curr_v = (values[[i]] - values[[k]])*curr_v + values[[k]]*((t(vectors[[k]])%*%curr_v)[1,1])*vectors[[k]]
curr_v=curr_v/sqrt((t(curr_v)%*%curr_v)[1,1])
}
evs[[i]] = curr_v
}
matrix=matrix-curr_val*res_v%*%t(res_v)
return (find_vals(matrix, values, vectors, evs, n-1))
}
My custom iterator is a bit slow. I hope to get a speed up when I use the unlist(as.list(ic, n=2000)) construct. However, I do not know how to implement this functionality. I only found the nextElem and hasNext methods. The iterator looks like this:
library(itertools)
fibonacci <- function(count = NA) {
ab = c(0, 1)
n <- function() {
if (!is.na(count)) {
if (count > 0) count <<- count -1
else stop('StopIteration')
}
#
ab <<- c(ab[2], sum(ab))
ab[1]
}
obj <- list(nextElem = n)
class(obj) <- c('fibonacci', 'abstractiter', 'iter')
obj
}
I can use it like this:
ic <- fibonacci ()
print (nextElem (ic))
Now I would like to get the next 10 fibonacci numbers at once, via
print(unlist(as.list(ic, n=10)))
But this of course needs to be implemented. How would I do this?
The fibonacci iterator serves as an example. Actually, I work on an iterator that gives all k-combinations of an n-set, i.e. a memory-friendly version of combn.
I have been working with the proxy package in R to implement a distance measure that weights Euclidean distance by the propagated errors of each individual point. The formula to do this is
sqrt((xi - xj)2) + (yi - yj)2) + ...(ni - nj)2) ÷ sqrt((σxi2 + σxj2) + (σyi2 + σyj2) + ...(σni2 + σnj2)).
I was able to get proxy to work for me in a basic sense (see proxy package in R, can't make it work) and replicated plain Euclidean distance functionality, hooray for the amateur.
However, once I started writing the function for the error-weighted distance, I immediately ran into a difficulty: I need to read in the errors as distinct from the points and have them processed distinctly.
I know that R has very strong functionality and I'm sure it can do this, but for the life of me, I don't know how. It looks like proxy's dist can handle two matrix inputs, but how would I tell it that matrix X is the points and matrix Y is the errors, and then have each go to its appropriate part of the function before being ultimately combined into the distance measure?
I had been hoping to use proxy directly, but I also realized that it looks like I can't. I believe I was able to come up with a function that works. First, the distance function:
DistErrAdj <- function(x,y) {
sing.err <- sqrt((x^2) + (y^2))
sum(sing.err)
}
Followed, of course, by
library(proxy)
pr_DB$set_entry(FUN=DistErrAdj,names="DistErrAdj")
Then, I took code already kindly written from augix (http://augix.com/wiki/Make%20trees%20in%20R,%20test%20its%20stability%20by%20bootstrapping.html) and altered it to suit my needs, to wit:
boot.errtree <- function(x, q, B = 1001, tree = "errave") {
library(ape)
library(protoclust)
library(cluster)
library(proxy)
func <- function(x,y) {
tr = agnes((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss = TRUE, method = "average")
tr = as.phylo(as.hclust(tr))
return(tr)
}
if (tree == "errprot") {
func <- function(x,y) {
tr = protoclust((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")))
tr = as.phylo(tr)
return(tr)
}
}
if (tree == "errdiv") {
func <- function(x,y) {
tr = diana((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss=TRUE)
tr = as.phylo(as.hclust(tr))
return(tr)
}
}
tr_real = func(x)
plot(tr_real)
bp <- boot.phylo(tr_real, x, FUN=func, B=B)
nodelabels(bp)
return(bp)
}
It seems to work.