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