1### Interactive density plots. Based on Tcl version by Guido Masarotto
2
3#  Copyright (C) 2000-2009 The R Core Team
4
5require(tcltk) || stop("tcltk support is absent")
6require(graphics); require(stats)
7local({
8    have_ttk <- as.character(tcl("info", "tclversion")) >= "8.5"
9    if(have_ttk) {
10        tkbutton <- ttkbutton
11        tkframe <- ttkframe
12        tklabel <- ttklabel
13        tkradiobutton <- ttkradiobutton
14    }
15
16    y <- NULL
17    xlim <- NULL
18    size  <- tclVar(50)
19    dist  <- tclVar(1)
20    kernel<- tclVar("gaussian")
21    bw    <- tclVar(1)
22    bw.sav <- 1 # in case replot.maybe is called too early
23
24    replot <- function(...) {
25        if (is.null(y)) return() # too early...
26        bw.sav <<- b <- as.numeric(tclObj(bw))
27        k <- as.character(tclObj(kernel))
28        sz <- as.numeric(tclObj(size))
29        eval(substitute(plot(density(y, bw=b, kernel=k),xlim=xlim)))
30        points(y,rep(0,sz))
31    }
32
33    replot.maybe <- function(...)
34    {
35        if (as.numeric(tclObj(bw)) != bw.sav) replot()
36    }
37
38    regen <- function(...) {
39        if (tclvalue(dist)=="1") y<<-rnorm(as.numeric(tclObj(size)))
40        else y<<-rexp(as.numeric(tclObj(size)))
41        xlim <<- range(y) + c(-2,2)
42        replot()
43    }
44
45    grDevices::devAskNewPage(FALSE) # override setting in demo()
46    tclServiceMode(FALSE)
47    base <- tktoplevel()
48    tkwm.title(base, "Density")
49
50    spec.frm <- tkframe(base,borderwidth=2)
51    left.frm <- tkframe(spec.frm)
52    right.frm <- tkframe(spec.frm)
53
54    ## Two left frames:
55    frame1 <- tkframe(left.frm, relief="groove", borderwidth=2)
56    tkpack(tklabel(frame1, text="Distribution"))
57    tkpack(tkradiobutton(frame1, command=regen, text="Normal",
58                         value=1, variable=dist), anchor="w")
59    tkpack(tkradiobutton(frame1, command=regen, text="Exponential",
60                         value=2, variable=dist), anchor="w")
61
62    frame2 <- tkframe(left.frm, relief="groove", borderwidth=2)
63    tkpack(tklabel(frame2, text="Kernel"))
64    for ( i in c("gaussian", "epanechnikov", "rectangular",
65                 "triangular", "cosine") ) {
66        tmp <- tkradiobutton(frame2, command=replot,
67                             text=i, value=i, variable=kernel)
68        tkpack(tmp, anchor="w")
69    }
70
71    ## Two right frames:
72    frame3 <-tkframe(right.frm, relief="groove", borderwidth=2)
73    tkpack(tklabel(frame3, text="Sample size"))
74    for ( i in c(50,100,200,300) ) {
75        tmp <- tkradiobutton(frame3, command=regen,
76                             text=i,value=i,variable=size)
77        tkpack(tmp, anchor="w")
78
79    }
80
81    frame4 <-tkframe(right.frm, relief="groove", borderwidth=2)
82    tkpack(tklabel (frame4, text="Bandwidth"))
83    tkpack(tkscale(frame4, command=replot.maybe, from=0.05, to=2.00,
84                   showvalue=FALSE, variable=bw,
85                   resolution=0.05, orient="horiz"))
86
87    tkpack(frame1, frame2, fill="x")
88    tkpack(frame3, frame4, fill="x")
89    tkpack(left.frm, right.frm,side="left", anchor="n")
90
91    ## `Bottom frame' (on base):
92    q.but <- tkbutton(base,text="Quit",
93                      command=function() tkdestroy(base))
94
95    tkpack(spec.frm, q.but)
96    tclServiceMode(TRUE)
97
98    cat("******************************************************\n",
99        "The source for this demo can be found in the file:\n",
100        file.path(system.file(package = "tcltk"), "demo", "tkdensity.R"),
101        "\n******************************************************\n")
102
103    regen()
104})
105