### This analysis of the language test data.
### $Revision: 1.1.1.1 $
### $Date: 2005/01/06 14:58:12 $

###Parameters:
asp.user <- "ralmond"
#asp.dbname <- "ICT_evalNoContext3"
#prefix <- "eNC_"
asp.dbname <- "ICT_exp1"
prefix <- "HD3mirror_"

## Set this to false if you are shipping graphs to a file, 
#onscreen <- TRUE

sink(paste(prefix,asp.dbname,".out",sep=""))
#pdf(paste(asp.dbname,".pdf",sep=""))
onscreen <- FALSE
par(ask=onscreen)


### Set things up
library("RMySQL")
asp.driver <- MySQL()
if(.Platform$OS.type == "unix") {
  StatShop <- system("echo $STATSHOP", intern=TRUE)
} else if(.Platform$OS.type == "windows") {
  StatShop <- system(paste(Sys.getenv("COMSPEC"),"/c","echo %STATSHOP%"),
                     intern=TRUE)
} 
source(paste(StatShop,"R","Asp","access.q",sep=.Platform$file.sep))
source(paste(StatShop,"R","Asp","RejectionRatio.r",sep=.Platform$file.sep))
source(paste(StatShop,"R","Asp","batchSE.r",sep=.Platform$file.sep))

###Connect to database
asp.dbConnect()

###List available tables
asp.listModels()
models <- asp.listModels()

###Check number of chains and cycles
chains <- asp.getChains()
goodChains <- chains[asp.getCycles()[,"chain_last_cycle"]>0]
window <- c(1001, min(asp.getCycles()[goodChains,"chain_last_cycle"]))
#window <-c(1,2000)

### find student model and link models
## Student Models names always start with Correlation2PM
sm.name <- asp.listStudentModels()
lms.name <- asp.listLinkModels()
## Remove pinned models which start with "brain"
pinindex <- grep("Pin",lms.name)
if (length(pinindex)>0) {
  lms.name <- lms.name [-pinindex]
}



###List available parameters
sm.pnames <- asp.listParameterNames(sm.name)
lms.pnames <- sapply(lms.name,asp.listParameterNames)


###Load parameters
sm.parameters <- asp.getAllParameters(sm.name,
                                     iterations=window,chain=goodChains)


lms.parameters <- lapply(lms.name, function (model) {
  asp.getAllParameters(model, iterations=window,chain=goodChains)
})
names(lms.parameters) <- lms.name

## Summaries
cat ("Student Model\n")
for(pname in names(sm.parameters)) {
  cat("Summary for parameter ",pname,"\n")
  param <- sm.parameters[[pname]]
  print(try(summary(param)))
  print(try(gelman.diag(param,transform=TRUE)))
  cat ("Autocorrelations\n")
  print(try(autocorr.diag(param)))
  cat ("Effective Sizes\n")
  print(try(effectiveSize(param)))
  cat ("RejectionRate\n")
  print(try(rejectionRate(param)))
  cat("\n")
}

for (model in lms.name[c(1,4)]) {
  cat ("\n\nLink Model ",model,"\n")
  for (pname in names(lms.parameters[[model]])) {
    cat("Summary for parameter ",pname,"\n")
    param <- lms.parameters[[model]][[pname]]
    print(try(summary(param)))
    print(try(gelman.diag(param,transform=TRUE)))
    cat ("Autocorrelations\n")
    print(try(autocorr.diag(param)))
    cat ("Effective Sizes\n")
    print(try(effectiveSize(param)))
    cat ("RejectionRate\n")
    print(try(rejectionRate(param)))
    cat("\n")
  }
}
  
       
## Plots
## Summaries
if (!onscreen) {
  pdf(paste(prefix,sm.name,".pdf",sep=""))
}
for(pname in names(sm.parameters)) {
  param <- sm.parameters[[pname]]
  plot(param, ask=onscreen,
       sub=paste("Student Model Parameter: ",pname))
  try(gelman.plot(param, ask=onscreen, transform=TRUE,
                  sub=paste("Student Model Parameter: ",pname)))
  try(autocorr.plot(param, ask=onscreen,
                    sub=paste("Student Model Parameter: ",pname)))
}



for (model in lms.name[c(1,4)]) {
  if (!onscreen) {
    dev.off()
    pdf(paste(prefix,model,".pdf",sep=""))
  }
  for (pname in names(lms.parameters[[model]])) {
    param <- lms.parameters[[model]][[pname]]
    plot(param, ask=onscreen,
         sub=paste("Model: ", model,
                   " Parameter: ",pname))
    try(gelman.plot(param, ask=onscreen, transform=TRUE,
                    sub=paste("Model: ", model,
                      " Parameter: ",pname)))
    try(autocorr.plot(param, ask=onscreen,
                      sub=paste("Model: ", model,
                                " Parameter: ",pname)))
  }
}
if (!onscreen) {
  dev.off()
}

# ## Starting Values
# cat ("\n\nStarting Values\n")
# cat ("Student Model\n")
# lapply(names(sm.parameters), function (pname) {
#   cat("Starting Values for parameter ",pname,"\n")
#   param <- sm.parameters[[pname]]
#   print(param[1:2,])
#   cat("\n")
# })

# lapply(lms.name, function (model) {
#   cat ("\n\nLink Model ",model,"\n")
#   lapply(names(lms.parameters[[model]]), function(pname) {
#     cat("Starting Values for parameter ",pname,"\n")
#     param <- lms.parameters[[model]][[pname]]
#     print(param[1:2,])
#     cat("\n")
#   })
# })
sink()

daCapoApply <- function(FUN,...) {
  FUN <- match.fun(FUN)
  cat ("Student Model\n")
  for (pname in names(sm.parameters)) {
    cat("Values for parameter ",pname,"\n")
    param <- sm.parameters[[pname]]
    print(try(FUN(param,...)))
    cat("\n")
  }

  for (model in lms.name) {
    cat ("\n\nLink Model ",model,"\n")
    for (pname in names(lms.parameters[[model]])) {
      cat("Starting Values for parameter ",pname,"\n")
      param <- lms.parameters[[model]][[pname]]
      print(try(FUN(param,...)))
      cat("\n")
    }
  }
}

daCapoApply1 <- function(FUN,...,which=1) {
  FUN <- match.fun(FUN)
  cat ("Student Model\n")
  for (pname in names(sm.parameters)) {
    cat("Values for parameter ",pname,"\n")
    param <- sm.parameters[[pname]]
    print(try(FUN(param,...)))
    cat("\n")
  }

  for (model in lms.name[which]) {
    cat ("\n\nLink Model ",model,"\n")
    for (pname in names(lms.parameters[[model]])) {
      cat("Starting Values for parameter ",pname,"\n")
      param <- lms.parameters[[model]][[pname]]
      print(try(FUN(param,...)))
      cat("\n")
    }
  }
}




###When done, disconnect
##asp.dbDisconnect()