[R] SSfpl self-start sometimes fails... workaround proposed

Philippe Grosjean phgrosje at ulb.ac.be
Tue May 1 13:05:43 CEST 2001


Hello,

nls library provides 6 self-starting models, among them: SSfp, a four
parameters logistic function. Its self-starting procedure involves several
steps. One of these steps is:
pars <- as.vector(coef(nls(y ~ cbind(1, 1/(1 + exp((xmid - x)/exp(lscal)))),
data = xydata, start = list(lscal = 0), algorithm = "plinear")))
which assumes an initial value of lscal equal to 0. If lscal is very
different to 0, the evaluation could fail (singular gradient,...), as it is
the case with the dataset provided hereunder (see end of this message).

As a workaround, I propose a modified self-start function for SSfpl that
remedy to this:
---------------------------------------
fpl <- function (input, A, B, xmid, scal)
{
    .expr1 <- B - A
    .expr2 <- xmid - input
    .expr4 <- exp((.expr2/scal))
    .expr5 <- 1 + .expr4
    .expr8 <- 1/.expr5
    .expr13 <- .expr5^2
    .value <- A + (.expr1/.expr5)
    .actualArgs <- as.list(match.call()[c("A", "B", "xmid", "scal")])
    if (all(unlist(lapply(.actualArgs, is.name)))) {
        .grad <- array(0, c(length(.value), 4), list(NULL, c("A", "B",
"xmid", "scal")))
        .grad[, "A"] <- 1 - .expr8
        .grad[, "B"] <- .expr8
        .grad[, "xmid"] <- -((.expr1 * (.expr4 * (1/scal)))/.expr13)
        .grad[, "scal"] <- (.expr1 * (.expr4 * (.expr2/(scal^2))))/.expr13
        dimnames(.grad) <- list(NULL, .actualArgs)
        attr(.value, "gradient") <- .grad
    }
    .value
}
# Self-starting function for fpl
fpl.ival <- function (mCall, data, LHS)
{
    xy <- sortedXyData(mCall[["input"]], LHS, data)
    if (nrow(xy) < 5) {
        stop("Too few distinct input values to fit a four-parameter
logistic")
    }
    xydata <- c(as.list(xy), xmid = NLSstClosestX(xy,
mean(range(xy[["y"]]))))
    xydata <- as.list(xydata)
    options(show.error.messages = FALSE)
    # Sometimes, the following evaluation gives an error (singular gradient,
...). Try another way to estimate initial parameters
    pars <- try(as.vector(coef(nls(y ~ cbind(1, 1/(1 + exp((xmid -
x)/exp(lscal)))), data = xydata, start = list(lscal = 0), algorithm =
"plinear"))))
    if (!is.null(class(pars)) && class(pars) == "try-error") {
        cat("Using second alternative for initial parameters estimation\n")
        options(show.error.messages = TRUE)
        pars <- as.vector(coef(nls(y ~ SSlogis(x, Asym, xmid, scal),
data=xydata)))
        xydata$xmid <- pars[2]
        pars[1] <- log(pars[3])
    } else { options(show.error.messages = TRUE)}
    pars <- as.vector(coef(nls(y ~ cbind(1, 1/(1 + exp((xmid -
x)/exp(lscal)))), data = data.frame(xy), start = list(xmid = xydata$xmid,
lscal = pars[1]), algorithm = "plinear")))
    value <- c(pars[3], pars[3] + pars[4], pars[1], exp(pars[2]))
    names(value) <- mCall[c("A", "B", "xmid", "scal")]
    value
}
# Self-Starting four-parameter logistic, combining fpl and fpl.ival
SSfpl <- selfStart(fpl, fpl.ival)
remove(fpl, fpl.ival)
attr(SSfpl,"pnames") <- c("A", "B", "xmid", "scal")
---------------------------------------

Now the self-starting function succeed with the faulty dataset (if it is
loaded under "Sample", we got):
> Sample.nls <- nls(y ~ SSfpl(x, A, B, xmid, scal), data=Sample, trace=T)
Using second alternative for initial parameters estimation
3912.605 :    -6.838615   97.175628 1079.915732  345.051411

This method succeed also when A is very different to 0, as in:
> Sample$y <- Sample$y - 30
>Sample.nls <- nls(y ~ SSfpl(x, A, B, xmid, scal), data=Sample, trace=T)
Using second alternative for initial parameters estimation
3912.605 :   -36.83861   67.17563 1079.91578  345.05135
> Sample$y <- Sample$y + 60
> Sample.nls <- nls(y ~ SSfpl(x, A, B, xmid, scal), data=Sample, trace=T)
Using second alternative for initial parameters estimation
3912.605 :    23.16139  127.17563 1079.91574  345.05139

Here is the Sample dataset that causes failure in original self-start
function of SSfpl:
--------------------------------------------
       x           y
1    100   3.0993441
2    200   7.1703742
3    300   2.6698554
4    400  -1.1030135
5    500   3.1997802
6    600  13.4839286
7    700  17.5247783
8    800  25.3965763
9    900  32.7809024
10  1000  42.8638906
11  1100  49.7806380
12  1200  53.3720730
13  1300  57.1732873
14  1400  69.1322680
15  1500  74.2821286
16  1600  84.7223610
17  1700  87.1016435
18  1800  83.7785903
19  1900  82.6630488
20  2000  85.6699881
21  2100  93.6834595
22  2200  87.6399878
23  2300  98.0706325
24  2400  87.7090574
25  2500  87.8427111
26   100   6.1086982
27   200  -0.2703793
28   300   1.1789864
29   400   8.4005067
30   500   7.5632783
31   600  16.4558476
32   700  15.3683658
33   800  25.4356474
34   900  36.7496044
35  1000  46.2637329
36  1100  49.4245916
37  1200  49.2426203
38  1300  67.6765838
39  1400  72.1293952
40  1500  72.6686691
41  1600  73.1239807
42  1700  83.2326747
43  1800  83.4350708
44  1900  92.0119974
45  2000  88.1731913
46  2100  92.6361306
47  2200  87.6798161
48  2300  89.8388569
49  2400  99.9118565
50  2500  94.0181265
51   100  -8.5761223
52   200  -2.8684148
53   300  -5.0846235
54   400   8.0067485
55   500  15.9500212
56   600   7.8298746
57   700  14.8714996
58   800  31.1773970
59   900  25.5603584
60  1000  36.6270604
61  1100  49.1396008
62  1200  55.1484732
63  1300  55.6742251
64  1400  63.0085688
65  1500  73.7323245
66  1600  79.7760679
67  1700  78.0336433
68  1800  88.3090297
69  1900  91.4579878
70  2000  89.4620021
71  2100  86.0521263
72  2200  92.4597165
73  2300 102.3826961
74  2400  89.6810273
75  2500 104.4345010
76   100   4.1908793
77   200   1.1663101
78   300   1.2138565
79   400   4.6746695
80   500  10.6366307
81   600  13.5696400
82   700  19.4830518
83   800  24.9596299
84   900  39.2800245
85  1000  33.1233443
86  1100  45.4346350
87  1200  58.0112784
88  1300  57.4907772
89  1400  66.8782190
90  1500  76.1078100
91  1600  77.9702662
92  1700  86.4002619
93  1800  90.8551005
94  1900  93.0494288
95  2000  91.3292011
96  2100  92.8803548
97  2200  95.3348279
98  2300  93.3454901
99  2400  89.4888304
100 2500 101.6825561
101  100  -2.6463179
102  200   2.4626755
103  300   8.8313503
104  400   8.1322231
105  500  11.2579274
106  600   7.6675020
107  700  22.8678546
108  800  18.4455407
109  900  30.8940806
110 1000  41.5778433
111 1100  44.4458981
112 1200  58.2412531
113 1300  60.1528031
114 1400  66.8289217
115 1500  74.2174892
116 1600  82.1478187
117 1700  87.0719569
118 1800  86.3247909
119 1900  77.6874618
120 2000  89.9793056
121 2100  91.5725152
122 2200  86.8773791
123 2300  90.9528753
124 2400  94.8046681
125 2500  96.2915658
126  100   3.3783906
127  200  -3.7782437
128  300  -5.3800214
129  400   8.5946633
130  500  10.1502830
131  600  14.4726541
132  700  25.4276710
133  800  26.1740854
134  900  32.4392613
135 1000  36.8220085
136 1100  45.3711596
137 1200  55.1290544
138 1300  60.0386737
139 1400  72.9271852
140 1500  74.7238370
141 1600  78.0457813
142 1700  73.7611185
143 1800  90.1935669
144 1900  89.8282116
145 2000  93.3865092
146 2100  96.5737605
147 2200  91.2951522
148 2300  93.1026883
149 2400  97.9327117
150 2500  96.5161475
151  100  -3.1399066
152  200   4.2818480
153  300   2.1415215
154  400   6.9593208
155  500   5.7589779
156  600  16.9917719
157  700  20.5212153
158  800  24.9654495
159  900  41.4699654
160 1000  44.7710150
161 1100  42.1270085
162 1200  57.5482135
163 1300  57.2669363
164 1400  68.3427189
165 1500  68.6810161
166 1600  71.9176212
167 1700  81.1582222
168 1800  92.1411063
169 1900  88.6745264
170 2000  95.1665112
171 2100  91.1493740
172 2200  93.8791498
173 2300  98.9862266
174 2400  94.7733683
175 2500 101.4603052
176  100   4.0875772
177  200  -2.5260400
178  300  -2.4073486
179  400   5.3199050
180  500  10.4923312
181  600  17.7314494
182  700  14.8992854
183  800  28.1606941
184  900  31.1065127
185 1000  38.3060603
186 1100  43.7539674
187 1200  55.7475726
188 1300  52.3597949
189 1400  67.9419737
190 1500  69.4292643
191 1600  78.9012221
192 1700  83.6830419
193 1800  93.1557145
194 1900  92.4328677
195 2000  81.7399979
196 2100  95.5528195
197 2200  94.2200239
198 2300  91.2460136
199 2400  96.5153395
200 2500  99.5341194
201  100   1.0072133
202  200   1.9475437
203  300   0.8895067
204  400   7.2445463
205  500   5.8782348
206  600  10.8238589
207  700  16.0272159
208  800  19.8050738
209  900  36.4075759
210 1000  44.4547541
211 1100  43.7834169
212 1200  55.6825097
213 1300  61.4506170
214 1400  73.7791672
215 1500  68.0171640
216 1600  70.7886840
217 1700  85.1198613
218 1800  85.9437649
219 1900  91.6470669
220 2000  90.6371665
221 2100  89.6053979
222 2200  90.6202220
223 2300  95.5400639
224 2400  93.7101926
225 2500  98.8553117
226  100  -3.2451954
227  200   4.0275414
228  300   5.3651481
229  400   1.9235670
230  500  12.6634105
231  600  19.4137491
232  700  13.5260270
233  800  25.0315762
234  900  30.3619952
235 1000  37.0424986
236 1100  44.4159204
237 1200  57.9005269
238 1300  57.0619045
239 1400  66.1205699
240 1500  75.6204362
241 1600  74.8793775
242 1700  84.2891345
243 1800  83.3223266
244 1900  84.4328447
245 2000  92.2704318
246 2100  96.6705120
247 2200  90.5756019
248 2300  86.6116323
249 2400  97.2501922
250 2500  95.2831440
-------------------------------------------

Sincerely,

Philippe Grosjean

...........]<(({°<...............<°}))><...............................
 ) ) ) ) )	 __               	 __
( ( ( ( ( 	|__)              	|  _
 ) ) ) ) )	|   hilippe       	|__)rosjean
( ( ( ( ( 	Marine Biol. Lab., ULB, Belgium
 ) ) ) ) )	                  	 __
( ( ( ( ( 	|\  /|            	|__)
 ) ) ) ) )	| \/ |ariculture &	|__)iostatistics
( ( ( ( (
 ) ) ) ) )	e-mail: phgrosje at ulb.ac.be or phgrosjean at sciviews.org
( ( ( ( ( 	SciViews project coordinator (http://www.sciviews.org)
 ) ) ) ) )      tel: 00-32-2-650.29.70 (lab), 00-32-2-673.31.33 (home)
( ( ( ( (
 ) ) ) ) )      "I'm 100% confident that p is between 0 and 1"
( ( ( ( (                                  L. Gonick & W. Smith (1993)
 ) ) ) ) )
.......................................................................


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._



More information about the R-help mailing list