Hello RHelpers,
This may already have been answered, but despite days of scouring through the
archives I haven't found it.
My goal is to add multiple fitted curves to a plot.
An example data set (a data frame named df in following code) is:
x1 y1 factor1
4 1298.25 0.00000000 1
5 1393.25 0.00000000 1
6 1471.50 0.04597701 1
7 1586.70 2.56908046 1
8 1692.10 11.14080460 1
9 1832.55 45.50459770 1
10 1928.30 65.56000000 1
11 2092.40 100.00000000 1
31 1202.90 0.00000000 2
41 1298.25 0.00000000 2
51 1393.25 0.37885057 2
61 1471.50 0.76839080 2
71 1586.70 7.75206897 2
81 1692.10 50.19448276 2
91 1832.55 94.08045977 2
101 1928.30 100.00000000 2
111 2092.40 100.00000000 2
14 1028.50 0.11111111 3
22 1106.40 0.04938272 3
32 1202.90 0.03448276 3
42 1298.25 0.34482759 3
52 1393.25 1.43850575 3
62 1471.50 1.96850575 3
72 1586.70 36.80597701 3
82 1692.10 92.83390805 3
92 1832.55 100.00000000 3
15 1028.50 0.09638554 4
23 1106.40 0.39988506 4
33 1202.90 0.49321839 4
43 1298.25 1.66045977 4
53 1393.25 7.51137931 4
63 1471.50 42.02724138 4
73 1586.70 99.12068966 4
83 1692.10 100.00000000 4
I plot this with xyplot:
trellis.par.set("background","white")
trellis.par.set(list(superpose.symbol=list(pch=c(15:17,21,25))))
xyplot(y1 ~ x1, data=df, groups=factor1,
type = "p",
auto.key list(space = "right", points = TRUE,
lines = FALSE))
For each level of factor1 I fit a growth curve:
fit.curve<-function(tab)
{
res.fit<-nls(y1 ~ 100/(1+exp(((-log(81))/a)*(x1-b))),
start=list(a=min(tab$x1[tab$y1>76],na.rm=T)-max(tab$x1[tab$y1<15],na.rm=T),b=tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)][!is.na(tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)])]),data=tab)
coef(res.fit)
}
by(df,list(df$factor1),fit.curve)
I would like to add the 4 curves corresponding to these 4 fits to my graphic.
The elegant way would be a custom panel function I suppose, but I haven't
been able to write one up...
Could someone help me out on this please?
In advance thanks very much!!!
David Gouache
Arvalis - Institut du V?g?tal
Station de La Mini?re
78280 Guyancourt
Tel: 01.30.12.96.22 / Port: 06.86.08.94.32
Gabor Grothendieck
2006-Aug-16 14:50 UTC
[R] adding multiple fitted curves to xyplot graph
Try this after displaying the xyplot:
# this fit.curve returns the whole nls object, not the coefs
fit.curve<-function(tab) {
nls(y1 ~ 100/(1+exp(((-log(81))/a)*(x1-b))),
start=list(a=min(tab$x1[tab$y1>76],na.rm=T)-max(tab$x1[tab$y1<15],na.rm=T),b=tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)][!is.na(tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)])]),data=tab)
}
trellis.focus("panel", 1, 1)
f <- function(x) panel.lines(x$x1, fitted(fit.curve(x)), col = 1)
junk <- by(df, df$factor1, f)
trellis.unfocus()
On 8/16/06, GOUACHE David <D.GOUACHE at arvalisinstitutduvegetal.fr>
wrote:> Hello RHelpers,
>
> This may already have been answered, but despite days of scouring through
the archives I haven't found it.
> My goal is to add multiple fitted curves to a plot.
> An example data set (a data frame named df in following code) is:
>
> x1 y1 factor1
> 4 1298.25 0.00000000 1
> 5 1393.25 0.00000000 1
> 6 1471.50 0.04597701 1
> 7 1586.70 2.56908046 1
> 8 1692.10 11.14080460 1
> 9 1832.55 45.50459770 1
> 10 1928.30 65.56000000 1
> 11 2092.40 100.00000000 1
> 31 1202.90 0.00000000 2
> 41 1298.25 0.00000000 2
> 51 1393.25 0.37885057 2
> 61 1471.50 0.76839080 2
> 71 1586.70 7.75206897 2
> 81 1692.10 50.19448276 2
> 91 1832.55 94.08045977 2
> 101 1928.30 100.00000000 2
> 111 2092.40 100.00000000 2
> 14 1028.50 0.11111111 3
> 22 1106.40 0.04938272 3
> 32 1202.90 0.03448276 3
> 42 1298.25 0.34482759 3
> 52 1393.25 1.43850575 3
> 62 1471.50 1.96850575 3
> 72 1586.70 36.80597701 3
> 82 1692.10 92.83390805 3
> 92 1832.55 100.00000000 3
> 15 1028.50 0.09638554 4
> 23 1106.40 0.39988506 4
> 33 1202.90 0.49321839 4
> 43 1298.25 1.66045977 4
> 53 1393.25 7.51137931 4
> 63 1471.50 42.02724138 4
> 73 1586.70 99.12068966 4
> 83 1692.10 100.00000000 4
>
> I plot this with xyplot:
>
> trellis.par.set("background","white")
> trellis.par.set(list(superpose.symbol=list(pch=c(15:17,21,25))))
> xyplot(y1 ~ x1, data=df, groups=factor1,
> type = "p",
> auto.key > list(space = "right", points
= TRUE, lines = FALSE))
>
> For each level of factor1 I fit a growth curve:
>
> fit.curve<-function(tab)
> {
> res.fit<-nls(y1 ~ 100/(1+exp(((-log(81))/a)*(x1-b))),
start=list(a=min(tab$x1[tab$y1>76],na.rm=T)-max(tab$x1[tab$y1<15],na.rm=T),b=tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)][!is.na(tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)])]),data=tab)
> coef(res.fit)
> }
> by(df,list(df$factor1),fit.curve)
>
> I would like to add the 4 curves corresponding to these 4 fits to my
graphic.
> The elegant way would be a custom panel function I suppose, but I
haven't been able to write one up...
> Could someone help me out on this please?
>
> In advance thanks very much!!!
>
> David Gouache
> Arvalis - Institut du V?g?tal
> Station de La Mini?re
> 78280 Guyancourt
> Tel: 01.30.12.96.22 / Port: 06.86.08.94.32
>
> ______________________________________________
> 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.
>
On 8/16/06, GOUACHE David <D.GOUACHE at arvalisinstitutduvegetal.fr> wrote:> Hello RHelpers, > > This may already have been answered, but despite days of scouring through the archives I haven't found it. > My goal is to add multiple fitted curves to a plot. > An example data set (a data frame named df in following code) is: > > x1 y1 factor1 > 4 1298.25 0.00000000 1 > 5 1393.25 0.00000000 1 > 6 1471.50 0.04597701 1 > 7 1586.70 2.56908046 1 > 8 1692.10 11.14080460 1 > 9 1832.55 45.50459770 1 > 10 1928.30 65.56000000 1 > 11 2092.40 100.00000000 1 > 31 1202.90 0.00000000 2 > 41 1298.25 0.00000000 2 > 51 1393.25 0.37885057 2 > 61 1471.50 0.76839080 2 > 71 1586.70 7.75206897 2 > 81 1692.10 50.19448276 2 > 91 1832.55 94.08045977 2 > 101 1928.30 100.00000000 2 > 111 2092.40 100.00000000 2 > 14 1028.50 0.11111111 3 > 22 1106.40 0.04938272 3 > 32 1202.90 0.03448276 3 > 42 1298.25 0.34482759 3 > 52 1393.25 1.43850575 3 > 62 1471.50 1.96850575 3 > 72 1586.70 36.80597701 3 > 82 1692.10 92.83390805 3 > 92 1832.55 100.00000000 3 > 15 1028.50 0.09638554 4 > 23 1106.40 0.39988506 4 > 33 1202.90 0.49321839 4 > 43 1298.25 1.66045977 4 > 53 1393.25 7.51137931 4 > 63 1471.50 42.02724138 4 > 73 1586.70 99.12068966 4 > 83 1692.10 100.00000000 4 > > I plot this with xyplot: > > trellis.par.set("background","white")This doesn't do what you probably think it does.> trellis.par.set(list(superpose.symbol=list(pch=c(15:17,21,25)))) > xyplot(y1 ~ x1, data=df, groups=factor1, > type = "p", > auto.key > list(space = "right", points = TRUE, lines = FALSE)) > > For each level of factor1 I fit a growth curve: > > fit.curve<-function(tab) > { > res.fit<-nls(y1 ~ 100/(1+exp(((-log(81))/a)*(x1-b))), start=list(a=min(tab$x1[tab$y1>76],na.rm=T)-max(tab$x1[tab$y1<15],na.rm=T),b=tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)][!is.na(tab$x1[abs(tab$y1-50)==min(abs(tab$y1-50),na.rm=T)])]),data=tab) > coef(res.fit) > } > by(df,list(df$factor1),fit.curve) > > I would like to add the 4 curves corresponding to these 4 fits to my graphic. > The elegant way would be a custom panel function I suppose, but I haven't been able to write one up... > Could someone help me out on this please?Here's one solution: xyplot(y1 ~ x1, data=df, groups=factor1, type = "p", panel = panel.superpose, panel.groups = function(x, y, ...) { panel.xyplot(x, y, ...) fm <- nls(y ~ 100 / (1 + exp(((-log(81)) / a) * (x - b))), start list(a = min(x[y > 76], na.rm = TRUE) - max(x[y < 15], na.rm = TRUE), b = x[abs(y-50) == min(abs(y - 50), na.rm = TRUE)][ !is.na(x[abs(y - 50) == min(abs(y-50), na.rm = TRUE)])])) fit.fun <- function(x) predict(fm, newdata = list(x = x)) panel.curve(fit.fun, ...) }, auto.key list(space = "right", points = TRUE, lines = FALSE)) -Deepayan