[R] nls
Spencer Graves
spencer.graves at pdf.com
Sat Sep 23 09:52:30 CEST 2006
I used "debug" to walk through your example line by line, I found
that the error message was misleading. By making
as.vector(semivariance) and as.vector(h) columns of a data.frame, I got
it to work. My revised code appears below.
Thanks for providing a self-contained and relatively simple
example. Without it, I could have done little more that suggest
'traceback' (which provided zero information when I tried it) and 'debug'.
Hope this helps.
Spencer Graves
fit.gaus<-function(coordinates,values,guess.c0,guess.c1,guess.a)
{
long<-rep(coordinates[,1],each=length(coordinates[,1]))
lag.long<-t(matrix(long,nrow=length(coordinates[,1]),byrow=TRUE))
dif.long <-(lag.long-t(lag.long))^2
lat <-rep(coordinates[,2],each=length(coordinates[,2]))
lag.lat<-t(matrix(lat,nrow=length(coordinates[,2]),byrow=TRUE))
dif.lat <-(lag.lat-t(lag.lat))^2
h <-sqrt(dif.long+dif.lat)
if( length(values[1,])>1)
{
y.m <-apply(values,1,sum,na.rm=TRUE)
y.m <-as.matrix(y.m)
y.mod <-(1/length(values[1,]))*(y.m)
}
else
{
y.mod <-as.matrix(values)
}
semi <-rep(y.mod,each=length(y.mod))
mat1<-t(matrix(semi,nrow=length(y.mod),byrow=TRUE))
mat2<-t(mat1)
semivariance <-(1/2)*(mat1-mat2)^2
# model <-semivariance ~c0+c1*(1-exp(-(h^2)/a^2))
DF <- data.frame(smvar=as.vector(semivariance),
h.=as.vector(h) )
mdl <- smvar~c0+c1*(1-exp(-(h.^2)/a^2))
# parameters <-nls(model,start =
#list(c0=guess.c0,c1=guess.c1,a=guess.a),trace=TRUE)
parameters <-nls(mdl,start =
list(c0=guess.c0,c1=guess.c1,a=guess.a),trace=TRUE,
data=DF )
results <-summary(parameters)
print(results)
}
################################
mzabalazo ngwenya wrote:
> Hello everyone !
>
> I am trying to write a short program to estimate semivariogram
> parameters. But I keep running into a problem when using the nls
> function.
>
> Could you please shed some light. I have put a sample of one of the
> codes and ran a short example so you see what I mean.
>
> -----------------
>
>
>
> fit.gaus<-function(coordinates,values,guess.c0,guess.c1,guess.a)
> {
> long<-rep(coordinates[,1],each=length(coordinates[,1]))
>
> lag.long<-t(matrix(long,nrow=length(coordinates[,1]),byrow=TRUE))
> dif.long <-(lag.long-t(lag.long))^2
> lat <-rep(coordinates[,2],each=length(coordinates[,2]))
> lag.lat<-t(matrix(lat,nrow=length(coordinates[,2]),byrow=TRUE))
> dif.lat <-(lag.lat-t(lag.lat))^2
> h <-sqrt(dif.long+dif.lat)
>
>
> if( length(values[1,])>1)
> {
> y.m <-apply(values,1,sum,na.rm=TRUE)
> y.m <-as.matrix(y.m)
> y.mod <-(1/length(values[1,]))*(y.m)
> }
> else
> {
> y.mod <-as.matrix(values)
> }
>
> semi <-rep(y.mod,each=length(y.mod))
> mat1<-t(matrix(semi,nrow=length(y.mod),byrow=TRUE))
> mat2<-t(mat1)
> semivariance <-(1/2)*(mat1-mat2)^2
>
> model <-semivariance ~c0+c1*(1-exp(-(h^2)/a^2))
> parameters <-nls(model,start =
> list(c0=guess.c0,c1=guess.c1,a=guess.a),trace=TRUE)
> results <-summary(parameters)
> print(results)
> }
> --------------------------
>
>
>> don <-matrix(c(2,3,9,6,5,2,7,9,5,3),5,2)
>> don
>>
> [,1] [,2]
> [1,] 2 2
> [2,] 3 7
> [3,] 9 9
> [4,] 6 5
> [5,] 5 3
>
>> data <-matrix(c(3,4,2,4,6))
>> data
>>
> [,1]
> [1,] 3
> [2,] 4
> [3,] 2
> [4,] 4
> [5,] 6
>
>> fit.gaus(don,data,2,3,5)
>>
> [,1] [,2] [,3] [,4] [,5]
> [1,] 0.000000 5.099020 9.899495 5.000000 3.162278
> [2,] 5.099020 0.000000 6.324555 3.605551 4.472136
> [3,] 9.899495 6.324555 0.000000 5.000000 7.211103
> [4,] 5.000000 3.605551 5.000000 0.000000 2.236068
> [5,] 3.162278 4.472136 7.211103 2.236068 0.000000
> 178.9113 : 2 3 5
> Error in qr.qty(QR, resid) : 'qr' and 'y' must have the same number of
> rows
>
>
> ______________________________________________
> R-help at stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
More information about the R-help
mailing list