.First <- function()
{
	assign("lib.loc", "E:/SDM/soft", w = 0)
	library(MASS, first = T)
	library(nnet)
}


showcuts <- function(obj)
{
  tmp <- obj$cuts[obj$sel, ]
  dimnames(tmp) <- list(NULL, dimnames(Xin)[[2]])
  tmp
}

cush <- log(as.matrix(Cushings[, -3]))
tp <- factor(Cushings$Type[1:21])
Cf <- data.frame(tp = tp, 
   Tetrahydrocortisone = log(Cushings[1:21,1]),
   Pregnanetriol = log(Cushings[1:21,2]) )
cush <- cush[1:21,]; tpi <- class.ind(tp)
xp <- seq(0.6, 4.0, length=100); np <- length(xp)
yp <- seq(-3.25, 2.45, length=100)
cushT <- expand.grid(Tetrahydrocortisone=xp,
     Pregnanetriol=yp)

pltnn <- function(...)  
{
  plot(Cushings[, 1], Cushings[, 2], log = "xy", type = "n", xlab = 
       "Tetrahydrocortisone", ylab = "Pregnanetriol", ...)
  for(il in 1:4) {
    set <- Cushings$Type == levels(Cushings$Type)[il]
    text(Cushings[set, 1], Cushings[set, 2],
         as.character(Cushings$Type[set]), col = 2 + il)
  }
}

plt.bndry <- function(size = 0, decay = 0, ...)
{
  cush.nn <- nnet(cush, tpi, skip = T, softmax = T, size = size, 
                  decay = decay, maxit = 1000)
  invisible(b1(predict(cush.nn, cushT), ...))
}

b1 <- function(Z, ...)
{
  zp <- Z[, 3] - pmax(Z[, 2], Z[, 1])
  contour(xp/log(10), yp/log(10), matrix(zp, np), add = T, levels = 
          0, labex = 0, ...)
  zp <- Z[, 1] - pmax(Z[, 3], Z[, 2])
  contour(xp/log(10), yp/log(10), matrix(zp, np), add = T, levels = 
          0, labex = 0, ...)
}

p0 <- function(x,y){
	d <- (x - 0.4)^2 + (y - 0.7)^2
	p <- exp(-d/f)
	d <- (x + 0.3)^2 + (y - 0.7)^2
	q <- exp(-d/f)
	(p+q)/(2*f*pi)
}
p1 <- function(x,y){
	d <- (x + 0.7)^2 + (y - 0.3)^2
	p <- exp(-d/f)
	d <- (x - 0.3)^2 + (y - 0.3)^2
	q <- exp(-d/f)
	(p+q)/(2*f*pi)
}
p0val <- matrix(0,57,66)
p1val <- matrix(0,57,66)
x <- seq(-1.24,1, 0.04)
y <- seq(-0.2,1.1,0.02)
f <- 0.06
for(i in 1:66) p0val[,i] <- p0(x, y[i])
for(i in 1:66) p1val[,i] <- p1(x, y[i])

synth.set <- function()
{
  x <- seq(-1.24,1, 0.04)
  y <- seq(-0.2,1.1,0.02)
  attach(synth.tr)
  eqscplot(range(x),range(y),type="n")
  contour(x,y,log(p1val)-log(p0val), add=T, levels=0, labex=0, col=2)
  points(xs[1:125], ys[1:125], col=6,cex=0.5, pch=16)
  points(xs[126:250],ys[126:250],col=8,cex=0.5, pch=16)
  detach()
  invisible("Synth set up")
}

XTest <- expand.grid(xs=seq(-1.24,1, 0.04), ys=seq(-0.2,1.1,0.02))

synth.fit <- function(col=4, skip=T, ...)
{
  fit <- nnet(yc ~ xs + ys, data=synth.tr, trace=F, skip=skip, ...)
  print(fit$value)
  pred <- predict(fit, XTest)
  prf <- predict(fit, synth.te)
  contour(seq(-1.24,1, 0.04), seq(-0.2,1.1,0.02),matrix(pred,57,66),
          add=T, levels=0.5, labex=0, col=col)
  err <- sum((prf > 0.5) != (synth.te$yc == 1))/10
  cat("\nError rate:", err,"%\n\n")
  invisible()
}

synth.aver <- function(naver=25, col=3, skip=T, ...)
{
  pred <- matrix(0, 57, 66)
  for(i in 1:naver) {
	 cat(" ", i)
    fit <- nnet(yc ~ xs + ys, data=synth.tr, trace=F, skip=skip, ...)
    pred1 <- predict(fit, XTest)
    pred <- pred + matrix(pred1,57,66)
    contour(seq(-1.24,1, 0.04), seq(-0.2,1.1,0.02), matrix(pred1,57,66),
            add=T, levels=0.5, labex=0, col=2)
    guiLocator(0)
  }
  contour(seq(-1.24,1, 0.04), seq(-0.2,1.1,0.02), pred, add=T,
          levels=0.5*naver, labex=0, col=col)
  invisible()
}

ird <- data.frame(rbind(iris[,,1], iris[,,2],iris[,,3]),
           Species=c(rep("s",50), rep("c",50), rep("v",50)))

predplot <- function(object, main="", len=50, ...) 
{
   plot(Cushings[,1], Cushings[,2], log="xy", type="n", 
     xlab="Tetrahydrocortisone", ylab = "Pregnanetriol", main)
  for(il in 1:4) {
    set <- Cushings$Type == levels(Cushings$Type)[il]
    text(Cushings[set, 1], Cushings[set, 2],
         as.character(Cushings$Type[set]), col = 2 + il)
  }
   xp <- seq(0.6, 4.0, length=len)
   yp <- seq(-3.25, 2.45, length=len)
   cushT <- expand.grid(Tetrahydrocortisone=xp, Pregnanetriol=yp)
   Z <- predict(object, cushT, ...); zp <- unclass(Z$class)
   zp <- Z$post[,3] - pmax(Z$post[,2], Z$post[,1])
   contour(xp/log(10), yp/log(10), matrix(zp, len), add=T, levels=0, labex=0)
   zp <- Z$post[,1] - pmax(Z$post[,2], Z$post[,3])
   contour(xp/log(10), yp/log(10), matrix(zp, len), add=T, levels=0, labex=0)
   plot(Cushings[,1], Cushings[,2], log="xy", type="n", 
     xlab="Tetrahydrocortisone", ylab = "Pregnanetriol", main)
   zp <- apply(Z$post, 1, max)
   image(xp/log(10), yp/log(10), matrix(zp, len), add=T)
   text(Cushings[1:21,1], Cushings[1:21,2], as.character(tp))
   text(Cushings[22:27,1], Cushings[22:27,2], "u")
   invisible()
}