I am encoutering s similar problem to the one described before in
"specifying a function in nls".
I defined a function "plot_it2" in the following way:
plot_it2<-function(SOA,t1weight, t2weight, d1weight, d2weight){
sapply(SOA,plot_it,t1weight, t2weight, d1weight, d2weight)
}
fit should deliver a fit of my set data1 by calling the function
"plot_it2":
fit<-nls(data1$T2~plot_it2(SOA,t1weight, t2weight, d1weight, d2weight),
start=list(t1weight=1, t2weight=1, d1weight=1, d2weight=1), data=data1,
trace=TRUE)
As you can see "plot_it2" applies its parameters on
"plot_it" (see
below) but i get the following error message:
Error in lhs - rhs : non-numeric argument to binary operator
plot_it <- function(SOA, t1weight, t2weight, d1weight, d2weight){
decay <- function(x){t1fordecay*exp(-x/q)}
decay_t2 <- function(x){exp(-x/q)}
t1fordecay <- t1weight
#T1
t1weight <-1
decay_functionT1_1 <- 0
decay_functionT1_2 <- rep(t1weight,ttime)
decay_functionT1_3 <- decay(x1)
decay_functionT1_3[decay_functionT1_3<threshold]<- 0
T1 <- c(decay_functionT1_1, decay_functionT1_2, decay_functionT1_3)
#D1
decay_functionD1_1 <- rep(0,ttime+ddelay)
decay_functionD1_2 <- rep(d1weight,dtime)
decay_functionD1_3 <- d1weight*decay_t2(x1)
decay_functionD1_3[decay_functionD1_3<threshold]<- 0
D1 <- c(decay_functionD1_1, decay_functionD1_2, decay_functionD1_3)
decay_functionT2_1 <- rep(0,SOA)
decay_functionT2_2 <- rep (1,ttime)
decay_functionT2_3 <- decay_t2(x1)
decay_functionT2_3[decay_functionT2_3<threshold]<- 0
T2 <- c(decay_functionT2_1, decay_functionT2_2, decay_functionT2_3)
#D2
decay_functionD2_1 <- rep(0,SOA + ttime + ddelay)
decay_functionD2_2 <- rep(d2weight,dtime)
decay_functionD2_3 <- d2weight*decay_t2(x1)
decay_functionD2_3[decay_functionD2_3<threshold]<- 0
D2 <- c(decay_functionD2_1, decay_functionD2_2, decay_functionD2_3)
#Compute probability density function f
T1_f <- T1*exp(T1)
D1_f <- D1*exp(D1)
T2_f <- T2*exp(T2)
D2_f <- D2*exp(D2)
#Compute probability function F (unlimited capacity)
T1_F <- cumsum(T1_f)
D1_F <- cumsum(D1_f)
T2_F <- cumsum(T2_f)
D2_F <- cumsum(D2_f)
# Limit the relative weights according to thresholded processing of
absolute weights
dummy <- T2[1000:2000]
dummy <- dummy[dummy>0]
dummy <- length(dummy)+1000
T1 <- T1[1:dummy]
D1 <- D1[1:dummy]
T2 <- T2[1:dummy]
D2 <- D2[1:dummy]
#Compute weights (for limited capacity)
T1_r <-(T1+D1+T2+D2); T1_r <- T1/T1_r
D1_r <-(T1+D1+T2+D2); D1_r <- D1/D1_r
T2_r <-(T1+D1+T2+D2); T2_r <- T2/T2_r
D2_r <-(T1+D1+T2+D2); D2_r <- D2/D2_r
#Compute probability density (for limited capacity)
T1_f_r <- T1_r*exp(T1_r)
D1_f_r <- D1_r*exp(D1_r)
T2_f_r <- T2_r*exp(T2_r)
D2_f_r <- D2_r*exp(D2_r)
# Remove na elements
T1_f_r <- T1_f_r[!is.na(T1_f_r)]
D1_f_r <- D1_f_r[!is.na(D1_f_r)]
T2_f_r <- T2_f_r[!is.na(T2_f_r)]
D2_f_r <- D2_f_r[!is.na(D2_f_r)]
#Compute probability (for limited capacity)
T1_F_r <- cumsum(T1_f_r)
D1_F_r <- cumsum(D1_f_r)
T2_F_r <- cumsum(T2_f_r)
D2_F_r <- cumsum(D2_f_r)
mu<- 700
T1_F_r <- 1-exp(-T1_F_r/mu)
D1_F_r <- 1-exp(-D1_F_r/mu)
T2_F_r <- 1-exp(-T2_F_r/mu)
D2_F_r <- 1-exp(-D2_F_r/mu)
T2_F_r <- T2_F_r[0:dummy]
T2_F_r[dummy-10]
Result<-T2_F_r
Result
}