## ----------------------------------------------------------------------------
##   R scripts for Haerdle/Mueller/Sperlich/Werwatz: "Nonparametric and
##   Semiparametric Modelling", Springer Series in Statistics, 2004
## ----------------------------------------------------------------------------
##   Script      SPMhistogram-Sliders
## ----------------------------------------------------------------------------
##   Description computes a histogram for stock returns data (with additional
##               slider to choose binwidth and origin)
## ----------------------------------------------------------------------------
##   Author      Marlene Mueller, 2010/07/11
## ----------------------------------------------------------------------------

library(tcltk)
library(TeachingDemos)

x <- read.csv("stockres.txt")
x <- unlist(x)

breaks <- function(x,x0,h){
  ##print(c(x0,h))
  b <- floor((min(x)-x0)/h) : ceiling((max(x)-x0)/h)
  b <- b*h+x0
  return(b)
}

## the following is adapted from TeachingDemos

xr <- range(x)
xd <- diff(xr)

xr[1] <- min(x) - xd/5
xr[2] <- max(x) + xd/5
xd <- diff(xr)

hist.refresh <- function(...) {
  breaks <- breaks(xr,slider(no=2),slider(no=1))
  hist(x,freq=FALSE,breaks=breaks,main="Histogram of Stock Returns",
       xlab="Data x",ylab="Histogram",xlim=xr)
  rug(x,col="blue")
}

slider(sl.functions=hist.refresh,
       sl.names=c("Binwidth", "Origin"),
       sl.mins=c(xd/10000, xr[1]),
       sl.maxs=c(xd, xr[2]),
       sl.deltas=c(xd/10000,xd/10000),
       sl.defaults=c(xd/10,0),
       title = "Choose Histogram Parameters")