[R] R: specifying a function in nls

[Joseph Kambeitz]

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
}