density.R 1.47 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
##----------------------------------------------------------------------
## Definições da sessão.

require(gWidgetstcltk)
options(guiToolkit="tcltk")
## options(guiToolkit="RGtk2")

## Vetor de valores para o qual será feito o histograma.
x <- precip

##-------------------------------------------
## Função reativa. Sem argumentos!

density.reactive <- function(...){
    dn <- density(x,
                  kernel=svalue(sk),
                  width=svalue(sw))
    plot(dn, main=NA, xlab="Precipitação", ylab="Densidade")
    if (svalue(rg)){
        rug(x)
    }
}

##-------------------------------------------
## Interface.

w <- gwindow("Densidade empírica")
tbl <- glayout(container=w)
kf <- eval(formals(density.default)$kernel) ## Funções kernel.
tbl[1, 1] <- "Escolha uma função kernel:"
tbl[2, 1, expand=TRUE] <- (
    sk <- gcombobox(items=kf,
                    ## selected="gaussian",
                    coerce.with="as.character",
                    container=tbl, handler=density.reactive))
dn <- density(x, kernel="gaussian")
dn$w <- (dn$bw*4)*c(0.5, 3, 1)
tbl[3, 1] <- "Largura de banda"
tbl[4, 1, expand=TRUE] <- (
    sw <- gslider(from=dn$w[1], to=dn$w[2],
                  by=diff(dn$w[-3])/100, value=dn$w[3],
                  container=tbl, handler=density.reactive))
tbl[5, 1, expand=TRUE] <- (
    rg <- gcheckbox("Colocar rug?",
                    container=tbl, handler=density.reactive))

##----------------------------------------------------------------------