###################################################
### chunk number 1: 
###################################################
    options(width=35)


###################################################
### chunk number 2: 
###################################################
options(prompt=" ")
options(continue=" ")
options(guiToolkit="RGtk2")


###################################################
### chunk number 3: 
###################################################
library(gWidgets)


###################################################
### chunk number 4: 
###################################################
gconfirm("Are we having fun?")


###################################################
### chunk number 5: 
###################################################
options(error = function() {
  err = geterrmessage()
  gmessage(err, icon="error")
})


###################################################
### chunk number 6: 
###################################################
options(error=NULL)


###################################################
### chunk number 7:  eval=FALSE
###################################################
## source(gfile())


###################################################
### chunk number 8: 
###################################################
setCRAN <- function(URL) {
  repos = getOption("repos")
  repos["CRAN"] <- gsub("/$", "", URL)
  options(repos=repos)
}


###################################################
### chunk number 9: 
###################################################
win <- gwindow("Select a CRAN mirror")


###################################################
### chunk number 10: 
###################################################
handler = function(h,...) {
  URL <- svalue(tbl) # get value  widget
  setCRAN(URL)       # set URL
  dispose(win)       # close window
}


###################################################
### chunk number 11: 
###################################################
tbl <- gtable(
  items=utils:::getCRANmirrors(),
  chosencol=4,     
  filter.column=2,
  container=win,
  handler=handler
)


###################################################
### chunk number 12: 
###################################################
win <- gwindow("test")
b <- gbutton("click me", cont=win)


###################################################
### chunk number 13:  eval=FALSE
###################################################
## win <- gwindow("test")
## add(win, gbutton("click me"))


###################################################
### chunk number 14: 
###################################################
win <- gwindow("Expanding group")
g <- ggroup(horizontal=FALSE, cont=win)


###################################################
### chunk number 15: 
###################################################
g1 <- ggroup(horizontal=TRUE, cont=g)
button <- gbutton("V",cont=g1)
label <- glabel("Expand group example", 
  cont=g1)


###################################################
### chunk number 16: 
###################################################
g2 <- ggroup(cont=g, expand=TRUE)
e <- gedit("Hide this with button", 
 cont=g2)


###################################################
### chunk number 17: 
###################################################
expandGroup = function() 
  add(g,g2, expand=TRUE)
hideGroup = function() delete(g,g2)


###################################################
### chunk number 18: 
###################################################
state <- TRUE  # a global
changeState <- function(h,...) {
  if(state) {
    hideGroup()
    svalue(button) <- ">"
  }  else {
    expandGroup()
    svalue(button) <- "V"
  }
  state <<- !state
}


###################################################
### chunk number 19: 
###################################################
ID <- addHandlerClicked(button, 
  handler=changeState)
ID <- addHandlerClicked(label, 
  handler=changeState)


###################################################
### chunk number 20: 
###################################################
win <- gwindow("Mock up")
bg <- ggroup(cont=win, expand=TRUE)
addSpring(bg)    # push to right


###################################################
### chunk number 21: 
###################################################
b1 <- gbutton("cancel", cont=bg)
addSpace(bg,10)  # add some space
b2 <- gbutton("ok", cont=bg)


###################################################
### chunk number 22: 
###################################################
win <- gwindow("CI example")
tbl <- glayout(cont=win)


###################################################
### chunk number 23: 
###################################################
tbl[1,1] <- "mu"
tbl[1,2] <- 
  (mu <- gedit("0",  cont=tbl, 
    coerce.with=as.numeric))
tbl[2,1] <- "sigma"
tbl[2,2] <-
  (sigma <- gdroplist(c(1,5,10), 
    cont=tbl))
tbl[3,1] <- "n"
tbl[3,2] <- (
  n <- gslider(from=5,to=100, by=1,
  value = 10, cont=tbl))
tbl[4,1] <- "conf. level"
tbl[4,2, expand=TRUE] <-
  (confLevel <-  gspinbutton(
    from=0.5, to=0.99, by=0.01, 
    value=0.95, cont=tbl))
tbl[5,1] <- "No. intervals"
tbl[5,2] <- 
  (noIntervals <- gradio(c(10,25,
    50,100), cont=tbl))
tbl[6,2] <- 
  (resample <- gbutton("resample", 
    cont=tbl))
visible(tbl) <- TRUE


###################################################
### chunk number 24:  eval=FALSE
###################################################
## tbl[1:2,2:3] <- "testing"


###################################################
### chunk number 25: 
###################################################
  makeCIs <- function(mu,sigma,m,n,confLevel,...) {
  res <- matrix(NA,nrow=2,ncol=m)
  for(i in 1:m) res[,i]= t.test(rnorm(n,mu,sigma),conf.level=confLevel)$conf.int
  
  missed = 1 + (res[1,] >= mu | res[2,] <= mu)
  
  ## make plot
  matplot(res,rbind(1:m,1:m)/m,
          type="l",
          col=c("black","red")[missed],
          lwd=missed,
          lty=missed,
          yaxt="n",
          xlab="",ylab="",
          main=paste(m," ",100*confLevel,"% confidence intervals")  
          )
  abline(v=mu)
}


###################################################
### chunk number 26: 
###################################################
allWidgets <- list(mu,sigma,noIntervals,
  n, confLevel, resample)
plotCI <- function(h, ...) {
  lst <- lapply(allWidgets,svalue)
  do.call(makeCIs,lst)
}


###################################################
### chunk number 27: 
###################################################
invisible(sapply(allWidgets,function(i)
  addHandlerChanged(i,handler=plotCI))
)


###################################################
### chunk number 28: 
###################################################
win <- gwindow("methods example")
g <- ggroup(cont=win)


###################################################
### chunk number 29: 
###################################################
cb <- gcheckboxgroup(items=letters[1:5],
  cont=g)
dl <- gdroplist(items="", cont=g)


###################################################
### chunk number 30: 
###################################################
ID <- addHandlerChanged(cb, 
 function(h,...) {
   dl[] <- svalue(cb)
})


###################################################
### chunk number 31: 
###################################################
  options(prompt="> ")
  options(continue="+ ")


###################################################
### chunk number 32: 
###################################################
x = gbutton("test", cont=gwindow())
tag(x,"ex") <- attr(x,"ex") <- "a"
f = function(y) 
  tag(y,"ex") <- attr(y,"ex") <- "b"
c(tag(x,"ex"),attr(x,"ex"))
f(x)
c(tag(x,"ex"),attr(x,"ex"))


###################################################
### chunk number 33: 
###################################################
  options(prompt=" ")
  options(continue=" ")


###################################################
### chunk number 34: 
###################################################
g = ggroup(cont=gwindow("DnD example"))
l1 <- gbutton("drag me", cont=g)
l2 <- glabel("drop here", cont=g)
ID <- addDropSource(l1, handler=
   function(h,...) svalue(h$obj))
ID <- addDropTarget(l2, handler = 
  function(h,...)
   svalue(h$obj) <- h$dropdata)


###################################################
### chunk number 35: 
###################################################
invisible(require(tseries))


###################################################
### chunk number 36: 
###################################################
e <- new.env()


###################################################
### chunk number 37: 
###################################################
getQuotes = function(
  inst = "GOOG",
  quote = c("Open","High","Low","Close"),
  start, end) 
get.hist.quote(inst, start=start, 
  end=end, quote=quote)


###################################################
### chunk number 38: 
###################################################
showTrend <- function(stock) {
  trendPlotFile <- e$trendPlotFile
  png(trendPlotFile)
  plot(stock, main="Trend plot")
  lines(rollmean(stock, k = 30), lwd=2, 
    lty=2, col=gray(.7))
  lines(rollmean(stock, k = 90), lwd=2, 
    lty=3, col=gray(.7))
  legend(index(stock)[length(stock)],
   min(stock),
   legend=c("30 day MA","90 day MA"),
   lty=2:3,xjust=1, yjust=0)
  dev.off()
  ## create a gif file
  system(paste("convert ",
    trendPlotFile," ",
    trendPlotFile,".gif",sep=""))
  svalue(e$trendPlot) = paste(
    trendPlotFile,".gif",sep="")
}


###################################################
### chunk number 39: 
###################################################
showDiscount = function(stock, r) {
  discount = zoo(exp(-(r/100)/365*
     (as.numeric(index(stock)) - as.numeric(index(stock)[1]))), 
     order.by=index(stock))
  
  ## update time series plot
  tsPlotFile = e$tsPlotFile
  png(tsPlotFile)
  plot(discount*stock, main="Discounted time series plot")
  dev.off()
  ## needed for gWidgetstcltk
  system(paste("convert ",tsPlotFile," ",tsPlotFile,".gif",sep=""))
  svalue(e$tsPlot) = paste(tsPlotFile,".gif",sep="") ## update graphic
}


###################################################
### chunk number 40: 
###################################################
updateNB <- function(h,...) {
  ## update data set
  ifelse(e$curDSName != "",
         e$curDS <- get(e$curDSName),
         return())
  ## get data within specified range
  start <- svalue(e$startD)
  if(start == "") start=NULL
  end <- svalue(e$endD)
  if(end == "") end = NULL
  dataSet = window(e$curDS,
    start=start,end=end)
  ## update summaries
  svalue(e$noSum) = 
    capture.output(summary(dataSet))  
  showDiscount(dataSet, 
    svalue(e$discRate))
  showTrend(dataSet)
}


###################################################
### chunk number 41: 
###################################################
e$curDSName <- ""
e$curDS <- NA
e$tsPlotFile <- tempfile()
e$trendPlotFile <- tempfile()


###################################################
### chunk number 42: 
###################################################
## layout
e$win <- gwindow("Stock browser")
e$gp <- ggroup(horizontal=FALSE, 
  cont=e$win)


###################################################
### chunk number 43: 
###################################################
## Set up simple toolbar
tb <- list()
tb$"Get quotes"$handler <- function(...)
  ggenericwidget("getQuotes",
    container=gwindow("Get quotes"))
tb$"Get quotes"$icon <- "ts"
tb$Quit$handler <- function(...) 
  dispose(e$win)
tb$Quit$icon <- "cancel"
theTB <- gtoolbar(tb, cont=e$gp)


###################################################
### chunk number 44: 
###################################################
## Now add parameters
e$pg <- ggroup(horizontal=TRUE,  
  cont = e$gp)
## the widgets
l <- glabel("Discount rate (%):", 
  cont=e$pg)
e$discRate <- gedit(0, cont=e$pg,
  coerce.with=as.numeric, 
  handler=updateNB)
e$pg <- ggroup(horizontal=TRUE, 
  cont = e$gp) 
l <- glabel("Range of dates:",
  cont=e$pg)

curDate <- Sys.Date()
l <- glabel("from=", cont=e$pg)
e$startD <- 
  gcalendar(as.character(curDate-365), 
  handler=updateNB, cont=e$pg)
l <- glabel("to=", cont=e$pg)
e$endD <- 
  gcalendar(as.character(curDate), 
  handler=updateNB, cont=e$pg)


###################################################
### chunk number 45: 
###################################################
e$gpg <- gpanedgroup(cont=e$gp, 
  expand=TRUE)
e$varSel <- gvarbrowser(
  cont= e$gpg,
  handler = function(h,...) {
    e$curDSName <- svalue(e$varSel)
    updateNB()
  })


###################################################
### chunk number 46: 
###################################################
e$nb <- gnotebook(cont=e$gpg)


###################################################
### chunk number 47: 
###################################################
## A numeric summary of the data set
e$noSum <- gtext("Numeric summary", 
  cont=e$nb, label="Summary")
## First graphic summary
e$tsPlot <- gimage(e$tsPlotFile, 
  cont=e$nb, label="Time series plot")
size(e$tsPlot)  <- c(480,480)
## secondGraphicSummary
e$trendPlot <- gimage(e$trendPlotFile, 
  cont=e$nb, label="Trend plot")