I'm new to R, and I'm trying to code a function which requires it only chooses values in a certain interval, so I have decided to go with k=1 if it lies in [lower, upper] and 0 if it lies elsewhere (where lower and upper have been defined earlier in the function. However, when I try to assign values to the function, it always comes back with this
myfun(10,0.5,0.05)
#Error in k[i] <- function(p) ifelse(p >= lower & p <= upper, 1, 0) :
# incompatible types (from closure to double) in subassignment type fix
I don't really know what this means, I've tried finding an answer, but most pages just say how to fix their particular problem rather than saying what it actually means. Maybe I haven't been looking hard enough, and I apologise if I haven't, but any help would be greatly appreciated. Here is the full function, if it would help:
myfun <- function(a, q, m) {
k <- rep(0,a+1)
bin.prob <- rep(0,a+1)
for (i in 1:(a+1)) {
x <- i-1
qhat <- x/a
z <- qnorm(1-m/2)
upper <- qhat+(z*sqrt(qhat*(1-qhat)*(a^-1)))
lower <- qhat-(z*sqrt(qhat*(1-qhat)*(a^-1)))
k[i] <- function(q) ifelse(q>=lower & q<=upper, 1, 0)
bin.prob[i] <- dbinom(x,a,q)
}
C <- sum(k*bin.prob)
return(C)
}
myfun(10,0.5,0.05)
#Error in k[i] <- function(q) ifelse(q >= lower & q <= upper, 1, 0) :
# incompatible types (from closure to double) in subassignment type fix
NEW PROBLEM
Hey, I'm encountering a new problem when trying to adjust this function when trying to adjust the data set, i.e a becomes a+4 and x becomes x+2
> myfun2 <- function(a,q,m) {
+ fn <- function(a) a+4
+ abar <- fn(a)
+ kadj <- rep(0,abar+1)
+ bin.prob.adj <- rep(0,abar+1)
+ for (j in 1:(abar+1)) {
+ x <- j-1
+ fx <- function(x) x+2
+ xbar <- fx(x)
+ qhatadj <- xbar/abar
+ z <- (1-(m/2))
+ upperadj <- qhatadj+(z*sqrt(qhatadj*(1-qhatadj)*(abar^-1)))
+ loweradj <- qhatadj-(z*sqrt(qhatadj*(1-qhatadj)*(abar^-1)))
+ kadj[j] <- q>=loweradj & q<=upperadj
+ bin.prob.adj[j] <- dbinom(xbar,abar,q)
+ }
+ D <- sum(kadj*bin.prob.adj)
+ return(D)
+ }
> myfun2(10,0.5,0.05)
[1] NA
Warning messages:
1: In sqrt(qhatadj * (1 - qhatadj) * (abar^-1)) : NaNs produced
2: In sqrt(qhatadj * (1 - qhatadj) * (abar^-1)) : NaNs produced
3: In sqrt(qhatadj * (1 - qhatadj) * (abar^-1)) : NaNs produced
4: In sqrt(qhatadj * (1 - qhatadj) * (abar^-1)) : NaNs produced
I've been trying to find an answer as to why this has arised, and have found that the NaNs warning could mean there is a negative square root? However I can't see why that would have arisen. It may be bad coding on my part, or could be something else entirely (I'm new to R). Thanks for any help.
As the error message suggests, the problem starts at the line:
k[i] <- function(q) ifelse(q >= lower & q <= upper, 1, 0)
In the line above you are assigning a function function(q) ifelse(q >= lower & q <= upper, 1, 0) to each element of the vector k, when you really want to be assigning the result of evaluating this function on the scalar q given as an argument to the original function. Note also that the closure function(q) has an environment separate from that of the function in which it is defined. It must be explicitly called with an argument in order for it to evaluate. Hence, when you hit the line:
C <- sum(k * bin.prob)
R tries to multiply the function function(q) itself by bin.prob, throwing an error, when what you want to be doing is multiplying the result of evaluating function(q) for the scalar q defined in the arguments to the original function. In this case, there appears to be no need for you to define function(q) at all. The assignment can be replaced with:
k[i] <- ifelse(q >= lower & q <= upper, 1, 0)
Since R coerces logical vectors to numeric vectors where necessary, treating TRUE as 1 and FALSE as 0, the above assigment can be expressed more succinctly as:
k[i] <- q >= lower & q <= upper
Related
The problem is to simulate an equation with variables that change. All the variables are fixed, expect for lower case s and treat_date. Here is the error message:
Error in checkFunc(Func2, times, y, rho) : The number of derivatives
returned by func() (202) must equal the length of the initial
conditions vector (2)
I have tried moving things around but I honestly have no idea what I am doing
seasonal_SI <- function (t, y, parameters) {
S <- y[1]
I <- y[2]
with(as.list(parameters), {
julian_date <- t %% 365
v <- ifelse(julian_date >= treat_date &
julian_date < (treat_date + 10) &
treatment, 0.9, v)
beta <- beta0 + s*beta0*sin(2*pi*(julian_date)/365)
dSdt <- b*(1-c*(S+I))*(S+rho*I)-d*S-beta*S*I
dIdt <- beta*S*I-(d+v)*I
res <- c(dSdt, dIdt)
list(res)
})
}
initials <- c(S=99, I=1)
params <- c(b=.5, c=.01, beta0=5e-3, v=.05, rho=.3, treatment=TRUE,
s=as.numeric(seq(from=0, to=1, by=.01)),
treat_date=as.numeric(seq(from=0, to=355, length.out=101)))
t <- 0:1
library("deSolve")
lsoda(y=initials, times=t, parms=params, func=seasonal_SI)
I would like for it to run and return a graph.
I agree with the former comment, that you may consider to use a parameter list. However, you may also consider to use a forcing function or the event mechanism.
You find help pages in deSolve:
?forcings
?events
and a short tutorial here: https://tpetzoldt.github.io/deSolve-forcing/deSolve-forcing.html
I am re-writting an algorithm I did in C++ in R for practice called the Finite Difference Method. I am pretty new with R so I don't know all the rules regarding vector/matrix multiplication. For some reason I am getting a non-conformable arguments error when I do this:
ST_u <- matrix(0,M,1)
ST_l <- matrix(0,M,1)
for(i in 1:M){
Z <- matrix(gaussian_box_muller(i),M,1)
ST_u[i] <- (S0 + delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
ST_l[i] <- (S0 - delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
}
I get this error:
Error in sqrt(T) %*% Z : non-conformable arguments
Here is my whole code:
gaussian_box_muller <- function(n){
theta <- runif(n, 0, 2 * pi)
rsq <- rexp(n, 0.5)
x <- sqrt(rsq) * cos(theta)
return(x)
}
d_j <- function(j, S, K, r, v,T) {
return ((log(S/K) + (r + (-1^(j-1))*0.5*v*v)*T)/(v*(T^0.5)))
}
call_delta <- function(S,K,r,v,T){
return (S * dnorm(d_j(1, S, K, r, v, T))-K*exp(-r*T) * dnorm(d_j(2, S, K, r, v, T)))
}
Finite_Difference <- function(S0,K,r,sigma,T,M,delta_S){
ST_u <- matrix(0,M,1)
ST_l <- matrix(0,M,1)
for(i in 1:M){
Z <- matrix(gaussian_box_muller(i),M,1)
ST_u[i] <- (S0 + delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
ST_l[i] <- (S0 - delta_S)*exp((r - (sigma*sigma)/(2.0))*T + sigma*sqrt(T)%*%Z)
}
Delta <- matrix(0,M,1)
totDelta <- 0
for(i in 1:M){
if(ST_u[i] - K > 0 && ST_l[i] - K > 0){
Delta[i] <- ((ST_u[i] - K) - (ST_l[i] - K))/(2*delta_S)
}else{
Delta <- 0
}
totDelta = totDelta + exp(-r*T)*Delta[i]
}
totDelta <- totDelta * 1/M
Var <- 0
for(i in 1:M){
Var = Var + (Delta[i] - totDelta)^2
}
Var = Var*1/M
cat("The Finite Difference Delta is : ", totDelta)
call_Delta_a <- call_delta(S,K,r,sigma,T)
bias <- abs(call_Delta_a - totDelta)
cat("The bias is: ", bias)
cat("The Variance of the Finite Difference method is: ", Var)
MSE <- bias*bias + Var
cat("The marginal squared error is thus: ", MSE)
}
S0 <- 100.0
delta_S <- 0.001
K <- 100.0
r <- 0.05
sigma <- 0.2
T <- 1.0
M <- 10
result1 <- Finite_Difference(S0,K,r,sigma,T,M,delta_S)
I can't seem to figure out the problem, any suggestions would be greatly appreciated.
In R, the %*% operator is reserved for multiplying two conformable matrices. As one special case, you can also use it to multiply a vector by a matrix (or vice versa), if the vector can be treated as a row or column vector that conforms to the matrix; as a second special case, it can be used to multiply two vectors to calculate their inner product.
However, one thing it cannot do is perform scalar multipliciation. Scalar multiplication of vectors or matrices always uses the plain * operator. Specifically, in the expression sqrt(T) %*% Z, the first term sqrt(T) is a scalar, and the second Z is a matrix. If what you intend to do here is multiply the matrix Z by the scalar sqrt(T), then this should just be written sqrt(T) * Z.
When I made this change, your program still didn't work because of another bug -- S is used but never defined -- but I don't understand your algorithm well enough to attempt a fix.
A few other comments on the program not directly related to your original question:
The first loop in Finite_Difference looks suspicious: guassian_box_muller(i) generates a vector of length i as i varies in the loop from 1 up to M, and forcing these vectors into a column matrix of length M to generate Z is probably not doing what you want. It will "reuse" the values in a cycle to populate the matrix. Try these to see what I mean:
matrix(gaussian_box_muller(1),10,1) # all one value
matrix(gaussian_box_muller(3),10,1) # cycle of three values
You also use loops in many places where R's vector operations would be easier to read and (typically) faster to execute. For example, your definition of Var is equivalent to:
Var <- sum((Delta - totDelta)^2)/M
and the definitions of Delta and totDelta could also be written in this simplified fashion.
I'd suggest Googling for "vector and matrix operations in r" or something similar and reading some tutorials. Vector arithmetic in particular is idiomatic R, and you'll want to learn it early and use it often.
You might find it helpful to consider the rnorm function to generate random Gaussians.
Happy R-ing!
I'm new in R. And I want to write a function that generates two vectors in R^2
And this function does the following:
1.It takes these two R^2 vectors as the two arguments.
2.It calculates the distance and angle between the two vectors.
3.It projects the first vector onto the second vector.
4.It visualize the projection result.
I tried the codes:
x <- function(x)
y <- function(y)
distance <- (sqrt(sum(x*x))*sqrt(sum(y*y)))
theta <- -acos(sum(x*x)/distance)
proj <- (x%*%y)/norm(y)%*%y
if (length(x)==2 & length (y) ==2)
{ print(distance) &
print(theta) &
print(proj)
}else {
print("Not R^2 vectors")
}
And I got the error message:
> x <- function(x)
+ y <- function(y)
+ distance <- (sqrt(sum(x*x))*sqrt(sum(y*y)))
> theta <- -acos(sum(x*x)/distance)
**Error in x * x : non-numeric argument to binary operator**
> proj <- (x%*%y)/norm(y)%*%y
**Error: object 'y' not found**
> if (length(x)==2 & length (y) ==2)
+ { print(distance) &
+ print(theta) &
+ print(proj)
+
+ }else {
+ print("Not R^2 vectors")
+ }
**Error: object 'y' not found**
I've tried to fix my code for hours and it still didn't work. Also, I don't know which command to use to visualize the projection result. Could anyone please help me with this? I'd really appreciate that!
Are you planning to call this as a single function? Maybe you'd be better served with a single function with multiple input parameters, rather than multiple functions:
func <- function(x, y) {
distance <- (sqrt(sum(x*x))*sqrt(sum(y*y)))
theta <- -acos(sum(x*x)/distance)
proj <- (x%*%y)/norm(y)%*%y
if (length(x)==2 & length (y) ==2)
{ print(distance) &
print(theta) &
print(proj)
}else {
print("Not R^2 vectors")
}
}
So you'd call it with something like:
output <- func( x, y )
Or, perhaps more clearly:
output <- func( x = x, y = y )
Note: I'm not addressing anything within your function, only the way it's created and called. The function itself doesn't make a lot of sense to me, so I won't try to edit that.
I have an exercise to do where I have to run the following AR(1) model:
xi =c+φxi−1+ηi (i=1,...,T)
I know that ni ~ N(0,1) ; x0 ~ N(c/(1-φ),1/(1-φˆ2)); c= 2 ; φ = 0.6
I am trying to do a for loop. My code is the following:
n <- rnorm(T, 0, 1)
c <- 2
phi <- 0.6
x_0 <- rnorm(1,c/(1-phi), 1/(1-phi**2))
v <- vector("numeric", 0)
#for (i in 2:T){
name <- paste("x", i, sep="_")
v <- c(v,name)
v[1] <- c + phi*x_0 + n[1]
v[i] <- c + phi*v[i-1] + n[i]
}
However, I keep getting this error:
Error in phi * v[i - 1] : non-numeric argument to binary operator
I understand what this error is, but I can't find any solutions to solve it. Could someone please enlighten me? How could I assign numeric values to the name vector?
Thank you!
You're defining v as a numeric vector, but then v <- c(v, name) turns v into a character vector since name is character. That's what's causing the error.
If I'm not mistaken, your intent is to assign names to the values in a numeric vector. That's fine, you just need a different approach.
n <- rnorm(t)
c <- 2
phi <- 0.6
x_0 <- rnorm(1, c/(1-phi), 1/(1-phi^2))
v <- c + phi*x_0 + n[1]
for (i in 2:t) {
v[i] <- c + phi*v[i-1] + n[i]
}
names(v) <- paste("x", 1:t, sep="_")
Vectors in R don't have a static size; they're dynamically resized as needed. So even though we're initializing v with a scalar value, it grows to fit each new value in the loop.
The final step is to give v a list of names. This can be accomplished using names(v) <-. Take a look at v now--it has names!
And as an aside, since T is a synonym for TRUE in R, it's best not to use T as a variable name. Thus I've used t here instead.
I guess you seem to need the following. It'll produces 11 elements including the initial x value. You may exclude it later.
set.seed(1237)
t <- 10
n <- rnorm(t, 0, 1)
c <- 2
phi <- 0.6
x0 <- rnorm(1, c/(1-phi), 1/(1-phi**2))
v <- c(x0, rep(0, t))
for(i in 2:length(v)) {
v[i] <- c + phi * v[i-1] + n[i-1]
}
v
[1] 4.967833 4.535847 2.748292 2.792992 5.389548 6.173001 4.526824 3.790483 4.307981 5.442913 4.958193
I would like to remove outliers from each column of my dataset... By searching the web, seems the Hampel Identifier should be a good solution to my problem, which has an outlier detection technique: [median – t * MAD, median + t * MAD].
With the instruction provided by: http://exploringdatablog.blogspot.com/2012/01/moving-window-filters-and-pracma.html I would like to use the "outlierMAD" command to fulfill my task:
outlierMAD <- function (x, k){
n <- length(x)
y <- x
ind <- c()
L <- 1.4826
t0 <- 3
for (i in (k + 1):(n - k)) {
x0 <- median(x[(i - k):(i + k)])
S0 <- L * median(abs(x[(i - k):(i + k)] - x0))
if (abs(x[i] - x0) > t0 * S0) {
y[i] <- x0
ind <- c(ind, i)
}
}
list(y = y, ind = ind)
}
But I got an error when I try:
Error in if (abs(x[i] - x0) > t0 * S0) { :
missing value where TRUE/FALSE needed
Can anyone help me on this? How can I avoid NAs in my data?
A link of my sample data can be found at:
https://drive.google.com/file/d/0B86_a8ltyoL3NHNaeWk3d1QyQms/view?usp=sharing
The logical value of abs(x[i] - x0) > t0 * S0 should be True or False. The error could happen if any of variables are NA or treated as non-numeric.
In NA presence case, the median could produce NA instead of the median value if na.rm=FALSE. Setting up na.rm=TRUE for median will fix X0 and S0, but doesn't help in logical expression above if x[I]=NA itself.
Try to check your data on NA or some other non-numeric values. Hope this helps.
I got the same error using the hampel function of the 'pracma' package. The problem was caused by my time-series which has less than 5 observations. Check if yours is long enough.
need to reduce the K value or else kept one condition if the nrow(df) > 5 then apply hample otherwise skip the hample and proceed the mean for those 5 sets