SCM

SCM Repository

[latticeextra] Annotation of /pkg/R/rootogram.R
ViewVC logotype

Annotation of /pkg/R/rootogram.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 189 - (view) (download)

1 : deepayan 2
2 :    
3 :    
4 :    
5 :     prepanel.rootogram <-
6 :     function(x, y = table(x),
7 :     dfun = NULL,
8 :     transformation = sqrt,
9 :     hang = TRUE,
10 : deepayan 185 probability = TRUE,
11 : deepayan 2 ...)
12 :     {
13 :     plot.line <- trellis.par.get("plot.line")
14 :     stopifnot(is.function(dfun))
15 : deepayan 185 if (probability) y <- y / sum(y)
16 :     yy <- transformation(y)
17 : deepayan 2 xx <- sort(unique(x))
18 :     dotArgs <- list(...)
19 :     dfunArgs <- names(formals(dfun))
20 :     if (!("..." %in% dfunArgs))
21 :     dotArgs <- dotArgs[dfunArgs[-1]]
22 :     dd <- transformation(do.call(dfun, c(list(xx), dotArgs)))
23 :     list(xlim = range(xx),
24 :     ylim =
25 :     if (hang) range(dd, dd-yy, 0)
26 :     else range(dd, yy, 0),
27 :     dx = diff(xx),
28 :     dy = diff(dd))
29 :     }
30 :    
31 :    
32 :     panel.rootogram <-
33 :     function(x, y = table(x),
34 :     dfun = NULL,
35 :     col = plot.line$col,
36 :     lty = plot.line$lty,
37 :     lwd = plot.line$lwd,
38 :     alpha = plot.line$alpha,
39 :     transformation = sqrt,
40 :     hang = TRUE,
41 : deepayan 185 probability = TRUE,
42 : deepayan 189 type = "l", pch = 16,
43 : deepayan 2 ...)
44 :     {
45 :     plot.line <- trellis.par.get("plot.line")
46 :     ref.line <- trellis.par.get("reference.line")
47 :     stopifnot(is.function(dfun))
48 : deepayan 185 if (probability) y <- y / sum(y)
49 :     yy <- transformation(y)
50 : deepayan 2 xx <- sort(unique(x))
51 :     dotArgs <- list(...)
52 :     dfunArgs <- names(formals(dfun))
53 :     if (!("..." %in% dfunArgs))
54 :     dotArgs <- dotArgs[dfunArgs[-1]]
55 :     dd <- transformation(do.call(dfun, c(list(xx), dotArgs)))
56 :     panel.abline(h = 0,
57 :     col = ref.line$col,
58 :     lty = ref.line$lty,
59 :     lwd = ref.line$lwd,
60 :     alpha = ref.line$alpha)
61 :     panel.segments(xx,
62 :     if (hang) dd else 0,
63 :     xx,
64 :     if (hang) (dd - yy) else yy,
65 :     col = col,
66 :     lty = lty,
67 :     lwd = lwd,
68 :     alpha = alpha,
69 :     ...)
70 : deepayan 189 if ("l" %in% type) panel.lines(xx, dd)
71 :     if ("p" %in% type) panel.points(xx, dd, pch = pch)
72 : deepayan 2 }
73 :    
74 :    
75 :     rootogram <-
76 :     function(x, ...)
77 :     UseMethod("rootogram")
78 :    
79 :    
80 :    
81 :    
82 :    
83 :     rootogram.formula <-
84 :     function(x, data = parent.frame(),
85 :     ylab = expression(sqrt(P(X == x))),
86 :     prepanel = prepanel.rootogram,
87 :     panel = panel.rootogram,
88 : deepayan 185 ...,
89 :     probability = TRUE)
90 : deepayan 2 {
91 : deepayan 185 if (!probability && missing(ylab)) ylab <- NULL
92 : deepayan 2 if (length(x) == 2) ## formula like ~ x
93 : felix 107 foo <-
94 :     densityplot(x, data,
95 : deepayan 185 prepanel = prepanel,
96 :     panel = panel,
97 :     ylab = ylab,
98 :     ...,
99 :     probability = probability)
100 : deepayan 2 else ## formula like y ~ x
101 : felix 107 foo <-
102 :     xyplot(x, data,
103 : deepayan 185 prepanel = prepanel,
104 :     panel = panel,
105 :     ylab = ylab,
106 :     ...,
107 :     probability = probability)
108 : felix 107 foo$call <- sys.call(sys.parent()); foo$call[[1]] <- quote(rootogram)
109 :     foo
110 : deepayan 2 }
111 :    

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge