.packageName <- "grasper"
"grasp.GRASS" <-
function (layername, Y = gr.selY, predmat = gr.predmat) 
{
    assign("gr.Yi", Y, pos = 1)
    Yname <- names(YYY)[gr.Yi]
    cat("\n")
    cat(" vvvvvvvvvv GraspeR export to GRASS vvvvvvvvvv ", "\n")
    cat(date(), "\n")
    cat("RESPONSE NAME: ", Yname, "\n")
    cat("Layer name: ", layername, "\n")
    require(GRASS)
    G <- gmeta()
    summary(G)
    resolution <- 1000
    maxX <- (ceiling(max(XXXpred$x)/resolution) * resolution) + 
        resolution
    minX <- (floor(min(XXXpred$x)/resolution) * resolution)
    maxY <- (ceiling(max(XXXpred$y)/resolution) * resolution) + 
        resolution
    minY <- (floor(min(XXXpred$y)/resolution) * resolution)
    half <- resolution/2
    cat("maxX: ", maxX, "\n")
    cat("minX: ", minX, "\n")
    cat("maxY: ", maxY, "\n")
    cat("minY: ", minY, "\n")
    Nrow <- (maxX - minX)/resolution
    Ncol <- (maxY - minY)/resolution
    cat("nrow =", Nrow, "and ncol =", Ncol, "\n")
    filename <- paste("pred_", names(YYY[gr.Yi]), ".asc", sep = "")
    fred1 <- round((XXXpred$x - (minX - half))/resolution)
    fred2 <- round(Ncol - ((XXXpred$y - (minY + half))/resolution))
    fred3 <- zapsmall(predmat[, Y])
    cat("nrow =", Nrow, "and ncol =", Ncol, "\n")
    mapGRASS <- matrix(NA, nrow = Nrow, ncol = Ncol)
    temp <- as.data.frame(cbind(fred1, fred2, fred3))
    print(temp[1:10, ])
    noduplicates <- all(!(duplicated(paste(temp$fred1, temp$fred2, 
        sep = "x"))))
    if (noduplicates) 
        cat("INFO: There are no duplicated X and Y coordinates in prediction set !", 
            "\n")
    else if (dim(temp)[1] < 10000) {
        temp <<- aggregate(temp, by = list(temp$fred1, temp$fred2), 
            mean)
        cat("AGGREGATION: The mean of predicted value found for each combination of Xs and Ys is returned !!!", 
            "\n")
    }
    else cat("AGGREGATION (>10000 predictions): Only the first predicted value found for each combination of Xs and Ys is returned !!!", 
        "\n")
    cat("Creating freds...")
    fred1 <- temp$fred1
    fred2 <- temp$fred2
    fred3 <- temp$fred3
    cat("done\n")
    cat("Doing temp...")
    assign("temp", temp, pos = 1)
    for (r in 1:nrow(temp)) {
        mapGRASS[fred1[r], fred2[r]] <- fred3[r]
    }
    cat("done\n")
    cat("Converting mapGRASS...")
    mapGRASS <- as.vector(mapGRASS)
    mapGRASS <- mapGRASS * 100
    mapGRASS <<- as.integer(mapGRASS)
    assign("mapGRASS", mapGRASS, pos = 1)
    cat("done\n")
    cat("rast.put(G, lname=layername, mapGRASS)")
    cat("\n")
    cat(" ********** GRASP ASCII END ********** ", "\n")
}
"grasp.GUI" <-
function (grass.on = FALSE) 
{
    require(tcltk) || stop("Tcl/Tk is not available, see README for installation and configuration...")
    require(mgcv) || stop("Mgcv library is not available, install it from CRAN...")
    require(MASS) || stop("MASS library is not available, install it from CRAN...")
    require(modreg) || stop("Modreg library is not available, install it from CRAN...")
    if (grass.on) 
        require(GRASS)
    d.show.sites <- function(...) {
	G<-gmeta()
        x <- XXX[YYY[, 2] == 1, 2]
        y <- XXX[YYY[, 2] == 1, 3]
        z <- rep(1, length(XXX[YYY[, 2] == 1, 1]))
        system("g.remove sites=test")
        sites.put(G, "test", x, y, z)
        system("d.sites type=+ sitefile=test color=red")
    }
    grasp.lut.create <- function(...) {
        grasp.lut(gr.Yi)
    }    
    d.erase <- function(...) {
        system("d.erase")
    }
    g.list.rast <- function(...) {
        system("g.list rast")
    }
    d.vect.area <- function(...) {
        system("d.vect map=rivers color=blue")
        system("d.area map=lacs fillcolor=blue linecolor=blue")
    }
    startmon <- function(...) {
        system("d.mon x0")
    }
    stopmon <- function(...) {
        system("d.mon stop=x0")
    }
    selectgrid.export <- function(...) {
        GRASS.export <- function(...) {
            grasp.GRASS(tclvalue(YYname))
            tkdestroy(gridselexport)
        }
        gridselexport <- tktoplevel()
        tktitle(gridselexport) <- "Select grid"
        Yname <- names(YYY[, gr.Yi])
        YYname <- tclVar(paste(Yname, "_pred"))
        gridselexport.label <- tklabel(gridselexport, text = "Grid name to export to:")
        gridselexport.entry <- tkentry(gridselexport, textvariable = YYname, 
            width = 10)
        gridselexport.but <- tkbutton(gridselexport, text = "Export", 
            command = GRASS.export)
        tkpack(gridselexport.label, gridselexport.entry, gridselexport.but, 
            fill = "x")
    }
    selectgrid.show <- function(...) {
        GRASS.show <- function(...) {
            Gname <- tclvalue(YYname)
            Gfunct <- paste("system(", "\"", "d.rast ", Gname, 
                "\"", ")", sep = "")
            eval(parse(text = Gfunct))
            tkdestroy(gridselshow)
        }
        gridselshow <- tktoplevel()
        tktitle(gridselshow) <- "Select grid"
        Yname <- names(YYY[, gr.Yi])
        YYname <- tclVar(paste(Yname, "pred", sep = ""))
        gridselshow.label <- tklabel(gridselshow, text = "Grid name to show:")
        gridselshow.entry <- tkentry(gridselshow, textvariable = YYname, 
            width = 10)
        gridselshow.but <- tkbutton(gridselshow, text = "Show", 
            command = GRASS.show)
        tkpack(gridselshow.label, gridselshow.entry, gridselshow.but, 
            fill = "x")
    }
    XXX.fix <- function(..) fix(XXX)
    grasp.limits.GUI.spec <- function(...) grasp.limits.GUI()
    grasp.corlim.plot <- function(...) lapply(gr.selY, grasp.corlim)
    grasp.update.packages <- function(...) update.packages()
    close.all <- function(...) q("yes")
    grasp.ascii.export <- function(...) grasp.ascii()
    grasp.export.txt <- function() grasp.export()
    YYY.fix <- function(...) fix(YYY)
    XXXpred.fix <- function(...) fix(XXXpred)
    WEIGHTS.fix <- function(...) fix(WEIGHTS)
    grasp.pred.gui <- function(...) grasp.pred()
    test.apply.ok <- function(...) {
        if (apply.ok == FALSE) 
            stop("Set options first...")
    }
    grasp.histo.plot <- function(...) {
        lapply(gr.selY, grasp.histo)
    }
    grasp.RvsP.plot <- function(...) {
        lapply(gr.selY, grasp.RvsP)
    }
    grasp.pred.plot.plot <- function(...) {
        par(mfrow = c(1, 1), mai = c(0.5, 0.5, 0.5, 0.5), tcl = 0.25)
        grasp.pred.plot(gr.predmat)
    }
    grasp.model.plot <- function(...) {
        par(cex = 0.8, mai = c(0.5, 0.5, 0.5, 0.75))
        plot.gam(gam.start, pages = 1, scale = 0, n = 1000)
        title(main = "GRASP MODEL PLOTS", sub = gam.start$formula)
    }
    grasp.cormat.plot <- function(...) lapply(gr.selY, grasp.cormat)
    grasp.datamap.plot <- function(...) lapply(gr.selY, grasp.datamap)
    grasp.model.go <- function(...) lapply(gr.selY, grasp.model)
    about.msgbox <- function(...) tkmessageBox(icon = "info", 
        message = "R-GRASP - By A. Lehmann. Ported to R by F. Fivaz", 
        type = "ok", parent = main, title = "About...")
    main.close <- function(...) tkdestroy(main)
    grasp.persp.plot <- function(...) vis.gam(gam.start)
    grasp.model.summary <- function(...) {
        cat("Warning : this function only works if you already have created a model", 
            "\n")
        sum.gam <- summary.gam(gam.start)
        print(sum.gam)
    }
    grasp.model.check <- function(...) gam.check(gam.start)
    grasp.step.anova <- function(...) grasp.step.gam(gam.start, 
        direction = "both")
    grasp.scope.list <- function(...) grasp.scope(gr.selX)
    grasp.summary.gui <- function(...) lapply(gr.selY, grasp.summary)
    main <- tktoplevel()
    tktitle(main) <- "GRASP-R - Generalized Regression Analysis and Spatial Predictions for R"
    main.statusbar <- tkframe(main)
    main.statusbar.label <- tklabel(main.statusbar, text = "Welcome to GRASP-R", 
        relief = "sunken", anchor = "w")
    tkpack(main.statusbar.label, side = "left", padx = 2, expand = "yes", 
        fill = "both")
    tkpack(main.statusbar, side = "bottom", fill = "x", pady = 2)
    main.menu <- tkmenu(main, tearoff = 0)
    main.menu.file <- tkmenu(main, tearoff = 0)
    tkadd(main.menu, "cascade", menu = main.menu.file, label = "File", 
        underline = 0)
    tkadd(main.menu.file, "command", label = "Import...", command = grasp.import.GUI)
    tkadd(main.menu.file, "command", label = "grasp.in...", command = grasp.in.GUI)
    tkadd(main.menu.file, "separator")
    tkadd(main.menu.file, "command", label = "Close GUI", command = main.close)
    tkadd(main.menu.file, "command", label = "Save workspace and exit", 
        command = close.all)
    main.menu.edit <- tkmenu(main, tearoff = 0)
    tkadd(main.menu, "cascade", menu = main.menu.edit, label = "Edit", 
        underline = 0)
    tkadd(main.menu.edit, "command", label = "Set options...", 
        command = grasp.options.GUI)
    tkadd(main.menu.edit, "command", label = "Set responses...", 
        command = grasp.select.responses)
    tkadd(main.menu.edit, "command", label = "Set predictors...", 
        command = grasp.select.predictors)
    tkadd(main.menu.edit, "command", label = "Set limits...", 
        command = grasp.limits.GUI.spec)
    tkadd(main.menu.edit, "separator")
    tkadd(main.menu.edit, "command", label = "YYY", command = YYY.fix)
    tkadd(main.menu.edit, "command", label = "XXX", command = XXX.fix)
    tkadd(main.menu.edit, "command", label = "XXXpred", command = XXXpred.fix)
    tkadd(main.menu.edit, "command", label = "WEIGHTS", command = WEIGHTS.fix)
    main.menu.analysis <- tkmenu(main, tearoff = 0)
    tkadd(main.menu, "cascade", menu = main.menu.analysis, label = "Analysis", 
        underline = 0)
    tkadd(main.menu.analysis, "command", label = "Summary", command = grasp.summary.gui)
    tkadd(main.menu.analysis, "command", label = "Summary of model", 
        command = grasp.model.summary)
    tkadd(main.menu.analysis, "separator")
    tkadd(main.menu.analysis, "command", label = "Model", command = grasp.model.go)
    tkadd(main.menu.analysis, "command", label = "Create scope list", 
        command = grasp.scope.list)
    tkadd(main.menu.analysis, "command", label = "Stepwise selection using ANOVA (EXPERIMENTAL)", 
        command = grasp.step.anova)
    tkadd(main.menu.analysis, "command", label = "Predict", command = grasp.pred.gui)
    tkadd(main.menu.analysis, "command", label = "Check GAM model", 
        command = grasp.model.check)
    tkadd(main.menu.analysis, "separator")
    tkadd(main.menu.analysis, "command", label = "Automated selection, model and predict...", 
        command = grasp.model.GUI)
    main.menu.plot <- tkmenu(main, tearoff = 0)
    tkadd(main.menu, "cascade", menu = main.menu.plot, label = "Plot", 
        underline = 0)
    tkadd(main.menu.plot, "command", label = "Data map", command = grasp.datamap.plot)
    tkadd(main.menu.plot, "command", label = "Histograms", command = grasp.histo.plot)
    tkadd(main.menu.plot, "command", label = "Response vs. predictors", 
        command = grasp.RvsP.plot)
    tkadd(main.menu.plot, "command", label = "Correlations", 
        command = grasp.cormat.plot)
    tkadd(main.menu.plot, "command", label = "Covariate space", 
        command = grasp.corlim.plot)
    tkadd(main.menu.plot, "separator")
    tkadd(main.menu.plot, "command", label = "Model", command = grasp.model.plot)
    tkadd(main.menu.plot, "command", label = "Perspective plot of model", 
        command = grasp.persp.plot)
    tkadd(main.menu.plot, "command", label = "Predictions", command = grasp.pred.plot.plot)
    main.menu.export <- tkmenu(main, tearoff = 0)
    tkadd(main.menu, "cascade", menu = main.menu.export, label = "Export", underline = 0)
    tkadd(main.menu.export, "command", label = "Export to ASCII...", command = grasp.ascii.export)
    tkadd(main.menu.export, "command", label = "Export to points...", command = grasp.export.txt)
    tkadd(main.menu.export, "command", label = "Create lookup tables", command = grasp.lut.create)
   if (grass.on) {
        main.menu.GRASS <- tkmenu(main, tearoff = 0)
        tkadd(main.menu, "cascade", menu = main.menu.GRASS, label = "GRASS", 
            underline = 0)
        tkadd(main.menu.GRASS, "command", label = "Start monitor X0", 
            command = startmon)
        tkadd(main.menu.GRASS, "command", label = "Stop monitor X0", 
            command = stopmon)
        tkadd(main.menu.GRASS, "command", label = "GraspeR.GRASS (Create grid)...", 
            command = selectgrid.export)
        tkadd(main.menu.GRASS, "command", label = "Convert grid to integer...")
        tkadd(main.menu.GRASS, "command", label = "Display grid...", 
            command = selectgrid.show)
        tkadd(main.menu.GRASS, "command", label = "Display presences on the map", 
            command = d.show.sites)
        tkadd(main.menu.GRASS, "command", label = "Display rivers and lakes", 
            command = d.vect.area)
        tkadd(main.menu.GRASS, "command", label = "Erase currently selected monitor", 
            command = d.erase)
        tkadd(main.menu.GRASS, "command", label = "Change grid colors...")
        tkadd(main.menu.GRASS, "command", label = "List available grids", 
            command = g.list.rast)
    }
    main.menu.help <- tkmenu(main, tearoff = 0)
    tkadd(main.menu, "cascade", menu = main.menu.help, label = "Help", 
        underline = 0)
    tkadd(main.menu.help, "command", label = "Contents")
    tkadd(main.menu.help, "command", label = "TODO", command = grasp.TODO.GUI)
    tkadd(main.menu.help, "command", label = "README...", command = grasp.README.GUI)
    tkadd(main.menu.help, "command", label = "License...", command = grasp.gpl.GUI)
    tkadd(main.menu.help, "separator")
    tkadd(main.menu.help, "command", label = "About...", command = grasp.about.GUI)
    tkadd(main.menu.help, "separator")
    tkadd(main.menu.help, "command", label = "Update packages", 
        command = grasp.update.packages)
    tkconfigure(main, menu = main.menu)
    assign("main", main, pos = 1)
    frame1 <- tkframe(main, relief = "groove", borderwidth = 2)
    main.backgrd.label.main <- tklabel(frame1, text = "GRASP-R", 
        anchor = "w", font = "arial 20", justify = "left")
    main.backgrd.label.sub <- tklabel(frame1, text = "Generalized Regression Analysis and Spatial Prediction for R", 
        anchor = "w", font = "arial 14", justify = "left")
    tkpack(frame1, main.backgrd.label.main, main.backgrd.label.sub, 
        side = "top", fill = "x")
}
"grasp.README.GUI" <-
function () 
{
    README.close <- function() tkdestroy(README)
    README <- tktoplevel()
    tktitle(README) <- "README for GraspeR"
    frame1 <- tkframe(README)
    frame2 <- tkframe(README)
    frame1.yscroll <- tkscrollbar(frame1)
    frame1.text <- tktext(frame1, font = "Arial 10", yscrollcommand = paste(.Tk.ID(frame1.yscroll), 
        "set"), height = 20)
    tkconfigure(frame1.yscroll, command = paste(.Tk.ID(frame1.text), 
        "yview"))
    tkpack(frame1, frame1.text, side = "left", fill = "x")
    tkpack(frame1, frame1.yscroll, side = "right", fill = "y")
    zz <- tkopen("README")
    zy <- tkread(zz)
    tkclose(zz)
    tkinsert(frame1.text, "end", zy)
    tkpack(frame2, tkbutton(frame2, text = "Close", font = "Arial 10", 
        command = README.close))
}
"grasp.RvsP" <-
function (gr.Yi = gr.selY, sX = gr.selX) 
{
    Yname <- names(YYY)[gr.Yi]
    cat("\n")
    cat("********** GRASP RESPONSE VS PREDICTORS **********", 
        "\n")
    cat(date(), "\n")
    cat("RESPONSE NAME: ", Yname, "\n")
    par(mfrow = c(4, 2), mai = c(0.5, 0.5, 0.5, 0.5))
    first <- TRUE
    YYY <- YYY[gr.modmask[, gr.Yi], ]
    XXX <- XXX[gr.modmask[, gr.Yi], ]
    for (xi in sX) {
        plot(XXX[, xi], YYY[, gr.Yi], xlab = names(XXX)[xi], 
            ylab = names(YYY)[gr.Yi])
        if (!is.factor(XXX[, xi])) 
            lines(smooth.spline(XXX[, xi], YYY[, gr.Yi], df = 3))
        if (first) 
            title(paste(OPT$TITLE, "RESPONSE vs. PREDICTIONS", 
                sep = " "))
        first <- FALSE
    }
    cat("\n")
    cat(" ********** GRASP RESPONSE VS PREDICTORS END ********** ", 
        "\n")
    cat("\n")
}
"grasp.TODO.GUI" <-
function () 
{
    TODO.close <- function() tkdestroy(TODO)
    TODO <- tktoplevel()
    tktitle(TODO) <- "TODO list for GraspeR"
    frame1 <- tkframe(TODO)
    frame2 <- tkframe(TODO)
    frame1.yscroll <- tkscrollbar(frame1)
    frame1.text <- tktext(frame1, font = "Arial 10", yscrollcommand = paste(.Tk.ID(frame1.yscroll), 
        "set"), height = 20)
    tkconfigure(frame1.yscroll, command = paste(.Tk.ID(frame1.text), 
        "yview"))
    tkpack(frame1, frame1.text, side = "left", fill = "x")
    tkpack(frame1, frame1.yscroll, side = "right", fill = "y")
    zz <- tkopen("todo.txt")
    zy <- tkread(zz)
    tkclose(zz)
    tkinsert(frame1.text, "end", zy)
    tkpack(frame2, tkbutton(frame2, text = "Close", font = "Arial 10", 
        command = TODO.close))
}
"grasp.in.GUI" <-
function () 
{
    graspin.close <- function(...) {
        tkdestroy(graspin)
    }
    grasp.init <- function(...) {
        YYYvar.local <- as.character(tclvalue(YYYvar))
        YYYparse <- eval(parse(text = YYYvar.local))
        XXXvar.local <- as.character(tclvalue(XXXvar))
        XXXparse <- eval(parse(text = XXXvar.local))
        XXXpredvar.local <- as.character(tclvalue(XXXpredvar))
        XXXpredparse <- eval(parse(text = XXXpredvar.local))
        cat("YYY = ", YYYvar.local, "\n")
        cat("XXX = ", XXXvar.local, "\n")
        cat("XXXpred = ", XXXpredvar.local, "\n")
        grasp.in(YYYparse, XXXparse, XXXpredparse)
        cat("initializing done", "\n")
    }
    graspin <- tktoplevel()
    tktitle(graspin) <- "GraspeR in"
    YYYvar <- tclVar("YYY")
    XXXvar <- tclVar("XXX")
    XXXpredvar <- tclVar("XXXpred")
    frame1 <- tkframe(graspin, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(graspin, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(graspin, relief = "groove", borderwidth = 2)
    frame1.label1 <- tklabel(frame1, text = "GraspeR.in - Data initializing")
    frame1.label2 = tklabel(frame1, text = "Warning: Apply will reinitialize all your precedent choices...!", 
        wraplength = 200)
    tkpack(frame1, frame1.label1, frame1.label2, fill = "x")
    frame2.label1 <- tklabel(frame2, text = "YYY:")
    frame2.label2 <- tklabel(frame2, text = "XXX:")
    frame2.label3 <- tklabel(frame2, text = "XXXpred:")
    frame2.entry1 <- tkentry(frame2, textvariable = YYYvar, width = 10)
    frame2.entry2 <- tkentry(frame2, textvariable = XXXvar, width = 10)
    frame2.entry3 <- tkentry(frame2, textvariable = XXXpredvar, 
        width = 10)
    tkgrid(frame2.label1, frame2.entry1, sticky = "w")
    tkgrid(frame2.label2, frame2.entry2, sticky = "w")
    tkgrid(frame2.label3, frame2.entry3, sticky = "w")
    tkpack(frame2, fill = "x")
    frame3.but1 <- tkbutton(frame3, text = "Apply", padx = 20, 
        command = grasp.init)
    frame3.but2 <- tkbutton(frame3, text = "Close", padx = 20, 
        command = graspin.close)
    tkgrid(frame3.but1, frame3.but2, sticky = "w")
    tkpack(frame3)
}
"grasp.about.GUI" <-
function () 
{
    about.close <- function() {
        tkdestroy(about)
    }
    about <- tktoplevel()
    tktitle(about) <- "About GraspeR"
    about.platform <- version[[1]]
    about.version <- paste(version[[6]], version[[7]], sep = ".")
    about.date <- paste(version[[10]], version[[9]], version[[8]], 
        sep = "/")
    frame1 <- tkframe(about, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(about, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(about, relief = "groove", borderwidth = 2)
    frame1.label1 <- tklabel(frame1, text = "GraspeR version 0.4-2", 
        font = "Arial 12")
    frame1.label2 <- tklabel(frame1, text = "Written by F. Fivaz (fabien.fivaz@bluewin.ch)", 
        font = "Arial 11")
    frame1.label3 <- tklabel(frame1, text = "Original programming on S-Plus by Anthony Lehmann,", 
        font = "Arial 11")
    frame1.label12 <- tklabel(frame1, text = "John Leathwich and Jake McOverton (Landcare Research Institute, NZ)", 
        font = "Arial 11")
    frame1.label4 <- tklabel(frame1, text = "http://www.cscf.ch/grasp", 
        font = "Arial 11")
    frame1.label5 <- tklabel(frame1, text = "Released under the terms of the GPL license", 
        font = "Arial 11")
    frame1.label6 <- tklabel(frame1, text = "Swiss Center of Faunal Cartography", 
        font = "Arial 10")
    frame1.label7 <- tklabel(frame1, text = "Terreaux 14", font = "Arial 9")
    frame1.label8 <- tklabel(frame1, text = "2000 Neuchtel", 
        font = "Arial 10")
    frame1.label9 <- tklabel(frame1, text = "Switzerland", font = "Arial 9")
    frame1.label10 <- tklabel(frame1, text = "+41 32 725 72 57", 
        font = "Arial 10")
    frame1.label11 <- tklabel(frame1, text = "http://www.cscf.ch/", 
        font = "Arial 10")
    tkpack(frame1, frame1.label1, frame1.label2, frame1.label3, 
        frame1.label12, frame1.label4, frame1.label5, frame1.label6, 
        frame1.label7, frame1.label8, frame1.label9, frame1.label10, 
        frame1.label11, fill = "x")
    frame2.label1 <- tklabel(frame2, text = "Platform", font = "Arial 11")
    frame2.label11 <- tklabel(frame2, text = about.platform, 
        font = "Courrier 11")
    tkgrid(frame2.label1, frame2.label11)
    frame2.label2 <- tklabel(frame2, text = "Version of R", font = "Arial 11")
    frame2.label21 <- tklabel(frame2, text = about.version, font = "Courrier 11")
    tkgrid(frame2.label2, frame2.label21)
    frame2.label3 <- tklabel(frame2, text = "R release date", 
        font = "Arial 11")
    frame2.label31 <- tklabel(frame2, text = about.date, font = "Courrier 10")
    tkgrid(frame2.label3, frame2.label31)
    tkpack(frame2, fill = "x")
    frame3.button1 <- tkbutton(frame3, text = "Close", command = about.close, 
        padx = 30, font = "Arial 11")
    frame3.button2 <- tkbutton(frame3, text = "License", command = grasp.gpl.GUI, 
        padx = 30, font = "Arial 11")
    tkgrid(frame3.button1, frame3.button2)
    tkpack(frame3)
}
"grasp.anova.gam" <-
function (object, ..., dispersion = NULL, test = NULL) 
{
    object$df.residual <- object$df.null - sum(object$edf) - 
        object$nsdf
    dotargs <- list(...)
    named <- if (is.null(names(dotargs))) 
        rep(FALSE, length(dotargs))
    else (names(dotargs) != "")
    if (any(named)) 
        warning(paste("The following arguments to anova.glm(..)", 
            "are invalid and dropped:", paste(deparse(dotargs[named]), 
                collapse = ", ")))
    dotargs <- dotargs[!named]
    is.gam <- unlist(lapply(dotargs, function(x) inherits(x, 
        "gam")))
    dotargs <- dotargs[is.gam]
    if (length(dotargs) == 0) 
        stop("need two or more models to compare")
    for (i in 1:length(dotargs)) {
        class(dotargs[[i]]) <- c(class(dotargs[[i]]), "glm")
        dotargs[[i]]$df.residual <- dotargs[[i]]$df.null - sum(dotargs[[i]]$edf) - 
            dotargs[[i]]$nsdf
    }
    grasp.anova.glmlist(c(list(object), dotargs), test = test, 
        dispersion = dispersion)
}
"grasp.anova.glmlist" <-
function (object, ..., dispersion = NULL, test = NULL) 
{
    responses <- as.character(lapply(object, function(x) {
        deparse(formula(x)[[2]])
    }))
    sameresp <- responses == responses[1]
    if (!all(sameresp)) {
        object <- object[sameresp]
        warning(paste("Models with response", deparse(responses[!sameresp]), 
            "removed because response differs from", "model 1"))
    }
    ns <- sapply(object, function(x) length(x$residuals))
    if (any(ns != ns[1])) 
        stop("models were not all fitted to the same size of dataset")
    nmodels <- length(object)
    if (nmodels == 1) 
        return(anova.glm(object[[1]], dispersion = dispersion, 
            test = test))
    resdf <- as.numeric(lapply(object, function(x) x$df.residual))
    resdev <- as.numeric(lapply(object, function(x) x$deviance))
    table <- data.frame(resdf, resdev, c(NA, -diff(resdf)), c(NA, 
        -diff(resdev)))
    variables <- lapply(object, function(x) paste(deparse(formula(x)), 
        collapse = "\n"))
    dimnames(table) <- list(1:nmodels, c("Resid. Df", "Resid. Dev", 
        "Df", "Deviance"))
    title <- "Analysis of Deviance Table\n"
    topnote <- paste("Model ", format(1:nmodels), ": ", variables, 
        sep = "", collapse = "\n")
    if (!is.null(test)) {
        bigmodel <- object[[order(resdf)[1]]]
        df.dispersion <- if (dispersion == 1) 
            Inf
        else min(resdf)
        table <- grasp.stat.anova(table = table, test = test, 
            scale = dispersion, df.scale = df.dispersion, n = length(bigmodel$residuals))
    }
    structure(table, heading = c(title, topnote), class = c("anova", 
        "data.frame"))
}
"grasp.ascii" <-
function (gr.Yi = gr.selY, var = gr.predmat, resolution = 1000) 
{
    assign("gr.Yi", gr.Yi, pos = 1)
    if (length(gr.Yi) > 2) {
        stop("This function accepts only one varible in gr.Yi. Use lapply(gr.Yi, grasp.ascii) if you want to run it many times!")
    }
    else {
        Y <- as.numeric(gr.Yi)
    }
    Yname <- names(YYY)[gr.Yi]
    cat("\n")
    cat(" vvvvvvvvvv GRASP ASCII vvvvvvvvvv ", "\n")
    cat(date(), "\n")
    cat("RESPONSE NAME: ", Yname, "\n")
    maxX <- (ceiling(max(XXXpred$x)/resolution) * resolution) + 
        resolution
    minX <- (floor(min(XXXpred$x)/resolution) * resolution)
    maxY <- (ceiling(max(XXXpred$y)/resolution) * resolution) + 
        resolution
    minY <- (floor(min(XXXpred$y)/resolution) * resolution)
    half <- resolution/2
    cat("maxX: ", maxX, "\n")
    cat("minX: ", minX, "\n")
    cat("maxY: ", maxY, "\n")
    cat("minY: ", minY, "\n")
    Nrow <- (maxX - minX)/resolution
    Ncol <- (maxY - minY)/resolution
    cat("nrow =", Nrow, "and ncol =", Ncol, "\n")
    filename <- paste("pred_", names(YYY[gr.Yi]), ".asc", sep = "")
    fred1 <- round((XXXpred$x - (minX - half))/resolution)
    fred2 <- round(Ncol - ((XXXpred$y - (minY + half))/resolution))
    fred3 <- zapsmall(var[, Y], 4)
    map <- matrix(-99.9, nrow = Nrow, ncol = Ncol)
    temp <- as.data.frame(cbind(fred1, fred2, fred3))
    print(temp[1:10, ])
    noduplicates <- all(!(duplicated(paste(temp$fred1, temp$fred2, 
        sep = "x"))))
    if (noduplicates) 
        cat("INFO: There are no duplicated X and Y coordinates in prediction set !", 
            "\n")
    else if (dim(temp)[1] < 10000) {
        temp <- aggregate(temp, by = list(temp$fred1, temp$fred2), 
            mean)
        cat("AGGREGATION: The mean of predicted value found for each combination of Xs and Ys is returned !!!", 
            "\n")
    }
    else cat("AGGREGATION (>10000 predictions): Only the first predicted value found for each combination of Xs and Ys is returned !!!", 
        "\n")
    fred1 <- temp$fred1
    fred2 <- temp$fred2
    fred3 <- temp$fred3
    for (r in 1:nrow(temp)) {
        map[fred1[r], fred2[r]] <- fred3[r]
    }
    write(paste("ncols", Nrow), file = filename)
    write(paste("nrows", Ncol), file = filename, append = TRUE)
    write(paste("xllcorner", minX), file = filename, append = TRUE)
    write(paste("yllcorner", minY), file = filename, append = TRUE)
    write(paste("cellsize", resolution), file = filename, append = TRUE)
    write("NODATA_value -99.9", file = filename, append = TRUE)
    write(map, file = filename, ncol = Ncol, append = TRUE)
    cat("prediction exported to: ", "\n")
    cat(filename, "\n")
    assign("map", map, pos = 1)
    cat("\n")
    cat(" ********** GRASP ASCII END ********** ", "\n")
}
"grasp.corlim" <-
function(gr.Yi = gr.selY, cols = gr.selX, thin = 1)
{
    x11()
    Yname <- names(YYY)[gr.Yi]
    cat("\n")
    cat("*********** GRASP COVARIATE SPACE PLOT ***********", "\n")
    cat(date(), "\n")
    cat("\n")
    cat("RESPONSE NAME: ", Yname, "\n")
    #data <- XXX
    data <- XXX[gr.modmask[, gr.Yi],  ]
    assign("data", data, pos=1)
    gr.selXCOR <- gr.selXCOR
    panel <- function(x, y)
    {
        ind <- YYY[,gr.Yi]==1
        points(x, y)
        points(x[ind], y[ind], col = 2)
    }
    ndata <- thin * nrow(data)
    index <- ((1:ndata) * 1)/thin
    thindata <- data[index,  ]
    pairs(thindata[, cols], panel = panel)
    text(0, 1.17, paste("GRASP: ", " ", Yname), adj = 0, cex = 0.7)
    cat("Red points are presences (1), black points absences(0)", "\n")
    cat("\n")
    cat(" ********** GRASP COAVRIATE SPACE PLOT END ********** ", "\n")
    cat("\n")
    cat("\n")
}
"grasp.cormat" <-
function (gr.Yi = gr.selY, cols = gr.selX, thin = 1) 
{
    x11()
    Yname <- names(YYY)[gr.Yi]
    cat("\n")
    cat("********** GRASP CORRELATION MATRIX CALCULATION **********", 
        "\n")
    cat(date(), "\n")
    cat("\n")
    cat("RESPONSE NAME: ", Yname, "\n")
    data <- XXX[gr.modmask[, gr.Yi], ]
    XXX <- XXX[gr.modmask[, gr.Yi], ]
    assign("data", data, pos = 1)
    gr.selXCOR <- gr.selXCOR
    panel <- function(x, y) {
        points(x, y, col = 2)
        corr <- zapsmall(cor(x, y), 2)
        text(min(x), max(y), cex = 1.2, as.character(corr), adj = 0)
    }
    ndata <- thin * nrow(data)
    index <- ((1:ndata) * 1)/thin
    thindata <- data[index, ]
    pairs(thindata[, cols], panel = panel)
    text(0, 1.17, paste("GRASP: ", " ", Yname), adj = 0, cex = 0.7)
    gr.selXcor <- NULL
    gr.selXfac <- NULL
    for (i in gr.selX) {
        if (!is.factor(XXX[, i])) 
            gr.selXcor <- c(gr.selXcor, i)
        else gr.selXfac <- gr.selXfac <- c(gr.selXfac, i)
    }
    gr.selXorder <- match(gr.selXcor, gr.selXcor)
    cortemp <- cor(XXX[, gr.selXcor])
    cortemp[cortemp == 1] <- 0
    cat("STARTING MATRIX:", "\n")
    print(cortemp)
    assign("CorMatrix", cortemp, pos = 1)
    cat(names(XXX)[gr.selXcor], "\n")
    while (max(abs(cortemp)) > 0.05) {
        cormax <- abs(cortemp) == max(abs(cortemp))
        selCor <- apply(cormax, 2, sum) * gr.selXorder
        gr.selXcor <- gr.selXcor[-match(max(selCor), selCor)]
        gr.selXorder <- gr.selXorder[-match(max(selCor), selCor)]
        cortemp <- cor(XXX[, gr.selXcor])
        cortemp[cortemp == 1] <- 0
    }
    cat("UNCORRELATED MATRIX:", "\n")
    print(cortemp)
    gr.selXCOR[[gr.Yi]] <- c(gr.selXcor, gr.selXfac)
    assign("gr.selXCOR", gr.selXCOR, pos = 1)
    cat("\n")
    cat("Matrix has been saved under CorMatrix!", "\n")
    cat("\n")
    cat(" ********** GRASP CORMAT END ********** ", "\n")
    cat("\n")
    cat("\n")
}
"grasp.datamap" <-
function (gr.Yi) 
{
    cat("\n")
    cat("*****************************************************", "\n")
    cat("**********       GRASP-R grasp.datamap()   **********", "\n")
    cat("********** Graph of datamap with pres/abs  **********", "\n")
    cat("**********        GRASP by A. Lehmann      **********", "\n")
    cat("**********      Ported to R by F. Fivaz    **********", "\n")
    cat("*****************************************************", "\n")
    cat("\n")
    cat(date(), "\n")
    cat("\n")
    x11()
    Yname <- names(YYY)[gr.Yi]
    cat("RESPONSE NAME: ", Yname, "\n")
    longitude <- XXX$x
    latitude <- XXX$y
    rangex <- max(longitude) - min(longitude)
    rangey <- max(latitude) - min(latitude)
    XMIN <- min(longitude) - 0.1 * rangex
    XMAX <- max(longitude) + 0.1 * rangex
    YMIN <- min(latitude) - 0.1 * rangey
    YMAX <- max(latitude) + 0.1 * rangey
    par(mfrow = c(1, 1), cex = 0.8, mai = c(0.75, 0.75, 0.75, 
        0.75))
    plot(longitude[YYY[, gr.Yi] > 0], latitude[YYY[, gr.Yi] > 
        0], pch = 1, cex = 1, xlim = c(XMIN, XMAX), ylim = c(YMIN, 
        YMAX), bty = "n", col = 2)
    points(longitude[YYY[, gr.Yi] == 0][gr.modmask[, gr.Yi] == 
        TRUE], latitude[YYY[, gr.Yi] == 0][gr.modmask[, gr.Yi] == 
        TRUE], pch = 1, col = 1, cex = 0.6)
    nbp <- as.character(length((YYY[(YYY[, gr.Yi] > 0), gr.Yi])))
    nba <- as.character(length((YYY[(YYY[, gr.Yi] == 0), gr.Yi])))
    legend(x = c(0, 0), y = c(XMAX, YMAX), legend = c(paste("Present: ", 
        nbp), paste("Absent: ", nba)), pch = c("+ . "), bty = "n", 
        cex = 0.6)
    title(main = paste(OPT$TITLE," Datamap"), cex = 0.5)
    cat("\n")
    cat("**********        R-GRASP DATAMAP END      **********", 
        "\n")
    cat("\n")
}
"grasp.dump" <-
function () 
{
dump("grasp.in", file="./build/grasper/R/grasp.in.R")
dump("grasp.GUI", file="./build/grasper/R/grasp.GUI.R")
dump("grasp.import.GUI", file="./build/grasper/R/grasp.import.GUI.R")
dump("grasp.validate", file="./build/grasper/R/grasp.validate.R")
dump("grasp.histo", file="./build/grasper/R/grasp.histo.R")
dump("grasp.RvsP", file="./build/grasper/R/grasp.RvsP.R")
dump("grasp.datamap", file="./build/grasper/R/grasp.datamap.R")
dump("grasp.cormat", file="./build/grasper/R/grasp.cormat.R")
dump("grasp.corlim", file="./build/grasper/R/grasp.corlim.R")
dump("grasp.GRASS", file="./build/grasper/R/grasp.GRASS.R")
dump("grasp.model", file="./build/grasper/R/grasp.model.R")
dump("grasp.start", file="./build/grasper/R/grasp.start.R")
dump("grasp.scope", file="./build/grasper/R/grasp.scope.R")
dump("grasp.pred", file="./build/grasper/R/grasp.pred.R")
dump("grasp.pred.plot", file="./build/grasper/R/grasp.pred.plot.R")
dump("grasp.lut", file="./build/grasper/R/grasp.lut.R")
dump("grasp.ascii", file="./build/grasper/R/grasp.ascii.R")
dump("grasp.import", file="./build/grasper/R/grasp.import.R")
dump("grasp.about.GUI", file="./build/grasper/R/grasp.about.GUI.R")
dump("grasp.model.GUI", file="./build/grasper/R/grasp.model.GUI.R")
dump("grasp.roc", file="./build/grasper/R/grasp.roc.R")
dump("grasp.options.GUI", file="./build/grasper/R/grasp.options.GUI.R")
dump("grasp.export", file="./build/grasper/R/grasp.export.R")
dump("grasp.limits", file="./build/grasper/R/grasp.limits.R")
dump("grasp.README.GUI", file="./build/grasper/R/grasp.README.GUI.R")
dump("grasp.gpl.GUI", file="./build/grasper/R/grasp.gpl.GUI.R")
dump("grasp.TODO.GUI", file="./build/grasper/R/grasp.TODO.GUI.R")
dump("grasp.select.responses", file="./build/grasper/R/grasp.select.responses.R")
dump("grasp.select.predictors", file="./build/grasper/R/grasp.select.predictors.R")
dump("grasp.TODO.GUI", file="./build/grasper/R/grasp.TODO.GUI.R")
dump("grasp.in.GUI", file="./build/grasper/R/grasp.TODO.in.R")
dump("grasp.limits.GUI", file="./build/grasper/R/grasp.limits.GUI.R")
dump("grasp.dump", file="./build/grasper/R/grasp.dump.R")
dump("grasp.anova.gam", file="./build/grasper/R/grasp.anova.gam.R")
dump("grasp.anova.glmlist", file="./build/grasper/R/grasp.anova.glmlist.R")
dump("grasp.stat.anova", file="./build/grasper/R/grasp.stat.anova.R")
dump("grasp.step.gam", file="./build/grasper/R/grasp.step.gam.R")
dump("grasp.summary", file="./build/grasper/R/grasp.summary.R")
}
"grasp.export" <-
function (var = gr.predmat) 
{
    cat("*****************************************************", 
        "\n")
    cat("**********        R-GRASP EXPORT           **********", 
        "\n")
    cat("********** Exporting results in txt format **********", 
        "\n")
    cat("**********      GRASP by A. Lehmann        **********", 
        "\n")
    cat("**********    Ported to R by F. Fivaz      **********", 
        "\n")
    cat("*****************************************************", 
        "\n")
    cat("\n")
    cat(date(), "\n")
    cat("\n")
    gr.Yi <- gr.selY
    Yname <- names(YYY[gr.Yi])
    cat("Response name:", Yname, "\n")
    cat("\n")
    file <- paste("pred_", Yname, ".txt", sep = "")
    gr.export <- var[, gr.Yi]
    glmax <- max(var)
    glength <- length(var)
    cat("Converting to percents (and integer)...", "\n")
    gr.export <- gr.export * 100
    gr.export <- as.integer(gr.export)
    to.export <- data.frame(x = XXXpred$x, y = XXXpred$y, pred = gr.export)
    cat("Writing file", file, "to disk...", "\n")
    write.table(to.export, file = file, sep = ",", row.names = F)
    cat("\n")
    cat("**********      R-GRASP EXPORT END         **********", 
        "\n")
    cat("\n")
}
"grasp.gpl.GUI" <-
function () 
{
    gpl.close <- function() tkdestroy(gpl)
    gpl <- tktoplevel()
    tktitle(gpl) <- "GPL Licence"
    frame1 <- tkframe(gpl)
    frame2 <- tkframe(gpl)
    frame1.yscroll <- tkscrollbar(frame1)
    frame1.text <- tktext(frame1, font = "Arial 10", yscrollcommand = paste(.Tk.ID(frame1.yscroll), 
        "set"), height = 20)
    tkconfigure(frame1.yscroll, command = paste(.Tk.ID(frame1.text), 
        "yview"))
    tkpack(frame1, frame1.text, side = "left", fill = "x")
    tkpack(frame1, frame1.yscroll, side = "right", fill = "y")
    zz <- tkopen("gpl.txt")
    zy <- tkread(zz)
    tkclose(zz)
    tkinsert(frame1.text, "end", zy)
    tkpack(frame2, tkbutton(frame2, text = "Close", font = "Arial 10", 
        command = gpl.close))
}
"grasp.histo" <-
function (gr.Yi, sX = gr.selX, nbar = 10) 
{
    cat("\n")
    cat("*****************************************************", "\n")
    cat("**********           grasp.histo()         **********", "\n")
    cat("**********         GRASP-R Histograms      **********", "\n")
    cat("**********     GRASP by A. Lehmann et al.  **********", "\n")
    cat("**********      Ported to R by F. Fivaz    **********", "\n")
    cat("*****************************************************", "\n")
    cat("\n")
    cat(date(), "\n")
    cat("\n")
    cat("Initializing variables... ")
    x11()
    Yname <- names(YYY)[gr.Yi]
    y <- YYY[gr.modmask[, gr.Yi], gr.Yi]
    XX <- XXX[gr.modmask[, gr.Yi], ]
    first <- TRUE
    cat("done", "\n")
    cat("Response name: ", Yname, "\n")
    cat("Opening graph window... ")
    numgr <- length(gr.selX) - 3
    par(mfrow = c(2, 4), cex = 0.65)
    prop <- length(y[y > 0])/length(y)
    cat("done", "\n")
    cat("Drawing histograms...")
    for (i in sX) {
        if (is.numeric(XX[, i])) {
            Xmin <- round(min(XX[!is.na(XX[, i]), i]), 2)
            Xlag <- (max(XX[!is.na(XX[, i]), i]) - Xmin)/nbar
            Xbreaks <- as.character(Xmin)
            for (nb in 1:(nbar - 1)) {
                Xnew <- round(Xmin + (nb * Xlag), 2)
                Xbreaks <- c(Xbreaks, as.character(Xnew))
            }
            temp <- table(factor(cut(y[!is.na(XX[, i])], c(-1, 1e-05, 500))), cut(XX[!is.na(XX[, i]), i], nbar))
            loc <- barplot(temp, xlab = names(XX[i]), ylab = "count", names = Xbreaks)
            nbp <- as.character(length(y[y > 0]))
            if (prop < 1) {
                par(new = T)
                temp[1, temp[1, ] == 0] <- 1e-08
                fred2 <- (temp[2, ]/(temp[1, ] + temp[2, ])) / prop
                barplot(fred2, axes = FALSE, axisnames = FALSE, density = NULL, space = 0, lwd = 0.5, col = NULL)
                abline(h = 1, lty = 2)
            }
            if (first) {
                title(paste(OPT$TITLE," histograms"))
                first <- FALSE
            }
        }
    }
    cat("done", "\n")
    cat("\n")
    cat("**********        grasp.histo() end        **********", 
        "\n")
    cat("\n")
}
"grasp.import.GUI" <-
function () 
{
    opendlgYYY <- function(...) {
        file.select.YYY <- tclvalue(tkgetOpenFile(parent = import))
        print(file.select.YYY)
        assign("file.select.YYY", file.select.YYY, pos = 1)
        YYY.local <- read.delim(file = file.select.YYY, sep=OPT$SEL)
        cat("Responses saved into YYY.local", "\n")
        assign("YYY.local", YYY.local, pos = 1)
        YYY.done <- TRUE
        assign("YYY.done", YYY.done, pos = 1)
        label1.full <- paste("YYY saved from ", file.select.YYY, 
            sep = " ")
        tkinsert(frame5.lstbox, "end", label1.full)
    }
    opendlgXXX <- function(...) {
        file.select.XXX <- tclvalue(tkgetOpenFile(parent = import))
        print(file.select.XXX)
        XXX.local <- read.delim(file = file.select.XXX, sep=OPT$SEL)
        cat("Responses saved into XXX.local", "\n")
        assign("XXX.local", XXX.local, pos = 1)
        label2.full <- paste("XXX saved from ", file.select.XXX, 
            sep = " ")
        tkinsert(frame5.lstbox, "end", label2.full)
        XXX.done <- TRUE
        assign("XXX.done", XXX.done, pos = 1)
    }
    opendlgXXXpred <- function(...) {
        file.select.XXXpred <- tclvalue(tkgetOpenFile(parent = import))
        print(file.select.XXXpred)
        XXXpred.local <- read.delim(file = file.select.XXXpred, 
sep=OPT$SEL)
        cat("Responses saved into XXXpred.local", "\n")
        assign("XXXpred.local", XXXpred.local, pos = 1)
        label3.full <- paste("XXXpred saved from ", file.select.XXXpred, 
            sep = " ")
        tkinsert(frame5.lstbox, "end", label3.full)
        XXXpred.done <- TRUE
        assign("XXXpred.done", XXXpred.done, pos = 1)
    }
    destroy.import <- function(...) {
        tkdestroy(import)
    }
    apply.import <- function(...) {
        label.applied <- NULL
        assign("YYY", YYY.local, pos = 1)
        label.applied <- paste(label.applied, "YYY", sep = " ")
        cat("YYY created...", "\n")
        assign("XXX", XXX.local, pos = 1)
        label.applied <- paste(label.applied, "XXX", sep = " ")
        cat("XXX created...", "\n")
        assign("XXXpred", XXXpred.local, pos = 1)
        label.applied <- paste(label.applied, "XXXpred", sep = " ")
        cat("XXXpred created...", "\n")
        label.applied <- paste("Import done for:", label.applied, 
            sep = " ")
        assign("label.applied", label.applied, pos = 1)
        tkinsert(frame5.lstbox, "end", label.applied)
        WEIGHTS <- data.frame(index = YYY[1], ours = rep(1, dim(XXX)[1]))
        assign("WEIGHTS", WEIGHTS, pos = 1)
        tkinsert(frame5.lstbox, "end", "Starting grasp.in...")
        grasp.in(YYY, XXX, XXXpred)
        tkinsert(frame5.lstbox, "end", "Initializing done!")
    }
    import <- tktoplevel()
    tktitle(import) <- "GraspeR data import"
    YYY.done <- FALSE
    assign("YYY.done", YYY.done, pos = 1)
    XXX.done <- FALSE
    assign("XXX.done", XXX.done, pos = 1)
    XXXpred.done <- FALSE
    assign("XXXpred.done", XXXpred.done, pos = 1)
    frame1 <- tkframe(import, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(import, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(import, relief = "groove", borderwidth = 2)
    frame4 <- tkframe(import, relief = "groove", borderwidth = 2)
    frame5 <- tkframe(import, relief = "groove", borderwidth = 2)
    frame1.label <- tklabel(frame1, text = "Import files into GraspeR")
    tkpack(frame1, frame1.label, fill = "x")
    frame2.label1 <- tklabel(frame2, text = "Responses (YYY):")
    frame2.label2 <- tklabel(frame2, text = "Predictors from (XXX):")
    frame2.label3 <- tklabel(frame2, text = "Predict to (XXXpred):")
    frame2.but1 <- tkbutton(frame2, text = "Import...", padx = 20, 
        command = opendlgYYY)
    frame2.but2 <- tkbutton(frame2, text = "import...", padx = 20, 
        command = opendlgXXX)
    frame2.but3 <- tkbutton(frame2, text = "import...", padx = 20, 
        command = opendlgXXXpred)
    tkgrid(frame2.label1, frame2.but1, sticky = "w")
    tkgrid(frame2.label2, frame2.but2, sticky = "w")
    tkgrid(frame2.label3, frame2.but3, sticky = "w")
    tkpack(frame2, fill = "x")
    frame5.lstbox <- tklistbox(frame5, selectmode = "single")
    tkpack(frame5, frame5.lstbox, fill = "x")
    apply.but.import <- tkbutton(frame4, text = "Apply", padx = 30, 
        command = apply.import)
    close.but.import <- tkbutton(frame4, text = "Close", padx = 30, 
        command = destroy.import)
    tkgrid(apply.but.import, close.but.import, sticky = "w")
    tkpack(frame4)
}
"grasp.import" <-
function () 
{
}
"grasp.in" <-
function (Ymat, Xmat, Xpred) 
{
    cat("\n")
    cat("*****************************************************", 
        "\n")
    cat("**********           R-GRASP IN            **********", 
        "\n")
    cat("**********       Initializes variables     **********", 
        "\n")
    cat("**********        GRASP by A. Lehmann      **********", 
        "\n")
    cat("**********      Ported to R by F. Fivaz    **********", 
        "\n")
    cat("*****************************************************", 
        "\n")
    cat("\n")
    cat(date(), "\n")
    cat("\n")
    cat("Loading libraries... ")
    library(mgcv)
    library(MASS)
    library(modreg)
    cat("done", "\n")
    cat("Creating YYY... ")
    assign("YYY", Ymat, pos = 1)
    cat("done", "\n")
    cat("Creating STEPMODEL... ")
    STEPMODEL <- list(gam(rep(c(0, 1), 50) ~ runif(100, 0, 10), 
        family = binomial()))
    assign("STEPMODEL", STEPMODEL, pos = 1)
    assign("gam.start", STEPMODEL, pos = 1)
    cat("done", "\n")
    cat("Creating gr.selim...")
    assign("gr.selim", c(0), pos = 1)
    cat("done", "\n")
    cat("Creating XXX... ")
    XXX <- Xmat
    assign("XXX", Xmat, pos = 1)
    cat("done", "\n")
    cat("Creating XXXpred... ")
    assign("XXXpred", Xpred, pos = 1)
    cat("done", "\n")
    cat("Initializing gr.selX and gr.selY... ")
    SELXCOR <- NULL
    assign("gr.selY", c(2:length(Ymat)), pos = 1)
    assign("gr.selX", c(4:length(Xmat)), pos = 1)
    assign("selX", gr.selX, pos = 1)
    cat("done", "\n")
    cat("Selected responses (gr.selY): ", gr.selY, "\n")
    cat("Selected predictors (gr.selX): ", gr.selX, "\n")
    cat("Removing past variables if exist... ")
    OPT <- NULL
    assign("OPT", OPT, pos = 1)
    gr.selXCOR = XXX
    assign("gr.selXCOR", gr.selXCOR, pos = 1)
    gr.selXCOR <- XXX
    cat("done", "\n")
    cat("Creating gr.modmask...")
    modcol <- length(YYY)
    modrow <- length(YYY[, 1])
    gr.modmask <- matrix(TRUE, ncol = dim(YYY)[2], nrow = dim(YYY)[1])
    assign("gr.modmask", gr.modmask, pos = 1)
    cat("done", "\n")
    cat("Creating gr.predmask...")
    gr.predmask <- matrix(rep(T, dim(XXXpred)[1] * dim(YYY)[2]), 
        ncol = dim(YYY)[2])
    assign("gr.predmask", gr.predmask, pos = 1)
    cat("done", "\n")
    cat("Creating gr.predmat...")
    gr.predmat <- as.data.frame(matrix(as.single(rep(-99.9, dim(XXXpred)[1] * 
        dim(YYY)[2])), ncol = dim(YYY)[2]))
    assign("gr.predmat", gr.predmat, pos = 1)
    fixed <- rep(1, dim(XXX)[1] * dim(YYY)[2])
    assign("fixed", fixed, pos = 1)
    cat("done", "\n")
    Yname <- names(YYY[gr.selY])
    cat("SELECTED RESPONSES:", Yname, "\n")
    WEIGHTS <- data.frame(index = YYY[1], Yname = rep(1, dim(XXX)[1]))
    assign("WEIGHTS", WEIGHTS, pos = 1)
    cat("GRASP-R initialized!", "\n")
    cat("\n")
    cat("**********         R-GRASP IN END          **********", 
        "\n")
    cat("\n")
}
"grasp.limits.GUI" <-
function () 
{
    limits.close <- function(...) {
        tkdestroy(limits)
    }
    apply.limits <- function() {
        nlim <- tkcurselection(frame2.lstbox1)
        nlim <- tclvalue(nlim)
        write(nlim, file = "lim")
        nlim <- scan(file = "lim")
        sX.loc <- nlim + 1
        npast.loc <- as.numeric(tclvalue(npast))
        grasp.limits(gr.selY, sX = sX.loc, npast = npast.loc)
        assign("gr.selim", sX.loc, pos = 1)
        cat("Limits applied!", "\n")
    }
    limits <- tktoplevel()
    tktitle(limits) <- "GraspeR: Set limits"
    npast <- tclVar("10")
    frame1 <- tkframe(limits, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(limits, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(limits, relief = "groove", borderwidth = 2)
    frame4 <- tkframe(limits, relief = "groove", borderwidth = 2)
    frame1.label1 <- tklabel(frame1, text = "Set limits", justify = "left", 
        wraplength = 200, font = "Arial 11")
    tkgrid(frame1.label1, columnspan = 2)
    frame1.label2 <- tklabel(frame1, text = "This function restricts the data within limits defined for the below selected response variables (min. 2) by keeping the below given number of zeroes observations on each side of the last presence along selected predictors.", 
        font = "Arial 9", wraplength = 200)
    tkgrid(frame1.label2, columnspan = 2)
    tkpack(frame1, fill = "x")
    frame4.label3 <- tklabel(frame4, text = "npast", font = "Arial 9")
    frame4.entry1 <- tkentry(frame4, textvariable = npast, font = "Arial 9")
    tkgrid(frame4.label3, frame4.entry1)
    tkpack(frame4, fill = "x")
    frame2.yscroll <- tkscrollbar(frame2)
    frame2.lstbox1 <- tklistbox(frame2, selectmode = "multiple", 
        exportselection = FALSE)
    tkconfigure(frame2.lstbox1, yscrollcommand = paste(.Tk.ID(frame2.yscroll), 
        "set"))
    tkconfigure(frame2.yscroll, command = paste(.Tk.ID(frame2.lstbox1), 
        "yview"))
    for (i in c(1:length(XXX))) {
        tkinsert(frame2.lstbox1, "end", names(XXX)[i])
    }
    gr.selim0 <- gr.selim - 1
    for (i in gr.selim0) tkselection.set(frame2.lstbox1, i)
    tkgrid(frame2.lstbox1, frame2.yscroll)
    tkpack(frame2, fill = "y")
    apply.but <- tkbutton(frame3, text = "Apply", command = apply.limits)
    close.but <- tkbutton(frame3, text = "Close", command = limits.close)
    tkgrid(apply.but, close.but, sticky = "w")
    tkpack(frame3, fill = "x")
}
"grasp.limits" <-
function (gr.Yi, sX = OPTIONS$SELXLIM, npast = OPTIONS$NPAST, 
    lim = "and") 
{
    gr.modmask <- gr.modmask
    gr.predmask <- gr.predmask
    Yname <- names(YYY)[gr.Yi]
    cat("\n")
    cat(" vvvvvvvvvv GRASP LIMITS vvvvvvvvvv ", "\n")
    cat(date(), "\n")
    cat("RESPONSE NAME: ", Yname, "\n")
    cat("\n")
    response <- YYY[, gr.Yi]
    if (is.na(sX)) 
        stop("no limiting predictors were defined in GRASP OPTIONS")
    if (min(response) != 0) 
        stop("there is no response equal to 0, limits can not be calculated !", 
            "\n")
    predictor <- XXX[, sX]
    n.numerics <- 0
    n.factors <- 0
    max.levels <- 0
    limitlabels <- NULL
    countlabels <- NULL
    for (i in 1:length(sX)) {
        if (i == 1) {
            limitlabels <- append(limitlabels, names(predictor)[i], 
                n.numerics)
            n.numerics <- n.numerics + 1
        }
        else {
            limitlabels <- append(limitlabels, names(predictor)[i], 
                n.numerics)
            n.numerics <- n.numerics + 1
        }
    }
    cat("Number of variables: ", length(sX), fill = T)
    cat("Number of numerics: ", n.numerics, fill = T)
    cat("Number of factors: ", n.factors, fill = T)
    if (lim == "or") {
        mask <- rep(FALSE, length(response))
        predict.template <- rep(0, length(XXXpred[, 1]))
    }
    else {
        mask <- rep(TRUE, length(response))
        predict.template <- rep(1, length(XXXpred[, 1]))
    }
    if (lim == "mixte") {
        mask2 <- rep(FALSE, length(response))
        predict.template2 <- rep(0, length(XXXpred[, 1]))
    }
    limits <- matrix(0, nrow = n.numerics, ncol = 3)
    dimnames(limits) <- list(limitlabels, c("lower", "upper", 
        "mean"))
    counts <- matrix(0, nrow = n.factors, ncol = max.levels)
    dimnames(counts) <- list(countlabels, NULL)
    n.numerics <- 0
    n.factors <- 0
    for (i in 1:length(sX)) {
        n.numerics <- n.numerics + 1
        sorted <- cbind(predictor[order(predictor[, i], response), 
            i], response[order(predictor[, i], response)])
        j <- seq(along = sorted[, 1])
        min.pos <- min(j[sorted[, 2] > 0])
        min.pos2 <- max(1, min.pos)
        min.pos <- max(1, min.pos - npast)
        lower.limit <- sorted[min.pos, 1]
        lower.limit2 <- sorted[min.pos2, 1]
        sorted <- cbind(predictor[order(predictor[, i], 0 - response), 
            i], response[order(predictor[, i], 0 - response)])
        j <- seq(along = sorted[, 1])
        max.pos <- max(j[sorted[, 2] > 0])
        max.pos2 <- min(length(sorted[, 1]), max.pos)
        max.pos <- min(length(sorted[, 1]), max.pos + npast)
        upper.limit <- sorted[max.pos, 1]
        upper.limit2 <- sorted[max.pos2, 1]
        if (lim == "and") {
            mask[predictor[, i] < lower.limit] <- FALSE
            mask[predictor[, i] > upper.limit] <- FALSE
            k <- match(names(predictor)[i], names(XXXpred))
            predict.template[XXXpred[, k] > upper.limit] <- 0
            predict.template[XXXpred[, k] < lower.limit] <- 0
        }
        if (lim == "or") {
            mask[(predictor[, i] > lower.limit) & (predictor[, 
                i] < upper.limit)] <- TRUE
            k <- match(names(predictor)[i], names(XXXpred))
            predict.template[(XXXpred[, k] > lower.limit) & (XXXpred[, 
                k] < upper.limit)] <- 1
        }
        if (lim == "mixte") {
            mask[predictor[, i] < lower.limit2] <- FALSE
            mask[predictor[, i] > upper.limit2] <- FALSE
            mask2[(predictor[, i] > lower.limit) & (predictor[, 
                i] < lower.limit2)] <- TRUE
            mask2[(predictor[, i] > upper.limit2) & (predictor[, 
                i] < upper.limit)] <- TRUE
            k <- match(names(predictor)[i], names(XXXpred))
            predict.template[XXXpred[, k] > upper.limit2] <- 0
            predict.template[XXXpred[, k] < lower.limit2] <- 0
            predict.template2[(XXXpred[, k] > lower.limit) & 
                (XXXpred[, k] < lower.limit2)] <- 1
            predict.template2[(XXXpred[, k] > upper.limit2) & 
                (XXXpred[, k] < upper.limit)] <- 1
        }
        limits[n.numerics, ] <- c(zapsmall(lower.limit, 4), zapsmall(upper.limit, 
            4), zapsmall(mean(predictor[response > 0, i]), 4))
        cat("Lower and upper limits, and occupied mean for ", 
            names(predictor[i]), " are ", limits[n.numerics, 
                ], fill = T)
        limits2 <- limits
        limits2[n.numerics, ] <- c(zapsmall(lower.limit2, 4), 
            zapsmall(upper.limit2, 4), zapsmall(mean(predictor[response > 
                0, i]), 4))
    }
    if (lim == "mixte") {
        mask <- mask | mask2
        predict.template <- predict.template | predict.template2
    }
    excluded <- length(mask[mask == FALSE])
    cat("Limits of models (gr.modmask) set and ", excluded, " cases excluded", 
        fill = T)
    gr.modmask[, gr.Yi] <- as.logical(mask)
    assign("gr.modmask", gr.modmask, pos = 1)
    excluded2 <- length(predict.template[predict.template == 
        FALSE])
    cat("Limits of prediction (gr.predmask) set and ", excluded2, 
        " cases excluded", fill = T)
    gr.predmask[, gr.Yi] <- as.logical(predict.template)
    assign("gr.predmask", gr.predmask, pos = 1)
    cat("\n")
    cat(" ********** GRASP LIMITS END ********** ", "\n")
    cat("\n")
}
"grasp.lut" <-
function (gr.Yi, gam.model = gam.start, path = "pred1.lut")
{
Yname <- names(YYY)[gr.Yi]
cat("\n")
cat(" vvvvvvvvvv GRASP LOOKUP vvvvvvvvvv ", "\n")
cat(date(), "\n")
cat("RESPONSE NAME: ", Yname, "\n")
artificial <- as.data.frame(matrix(rep(1, 200 * length(gr.selX)), 200, length(gr.selX)))
flist <- list(c(0, 0))
for (i in 1:length(gr.selX))
if (!is.factor(XXX[, gr.selX[i]])) {
	artificial[, i] <- seq(min(XXXpred[, gr.selX[i]]), max(XXXpred[, gr.selX[i]]), length = 200)
}
else {
cat("INFO: !!! your factor map in Arcview will have to be reclassify according to the factor levels presented here:", "\n")
print(levels(XXX[gr.modmask[, gr.Yi], gr.selX[i]]))
for (f in 1:length(levels(XXX[, gr.selX[i]]))) {
if (summary(XXX[gr.modmask[, gr.Yi], gr.selX[i]])[f][1] > 0) {
	artificial[f, i] <- levels(XXX[, gr.selX[i]])[f]
	flist[[gr.selX[i]]] <- c(flist[[gr.selX[i]]], f)
}
}
for (f in 1:length(levels(XXX[, gr.selX[i]]))) {
if (summary(XXX[gr.modmask[, gr.Yi], gr.selX[i]])[f][1] == 0)
	artificial[f, i] <- levels(XXX[, gr.selX[i]])[flist[[gr.selX[i]]][1]]
}
artificial[-flist[[gr.selX[i]]], i] <- levels(XXX[, gr.selX[i]])[flist[[gr.selX[i]]][1]]
artificial[, i] <- as.factor(artificial[, i])
print(flist[[gr.selX[i]]])
}
      dimnames(artificial) <- list(1:200, names(XXX[, gr.selX]))
      print(artificial[c(1:5), ])
      cat("", "\n")
      print(artificial[c(196:200), ])
      assign("artificial", artificial, pos = 1)
      LUT <- matrix(0, nrow = 204, ncol = length(gr.selX) + 1)
      LUT[1:204, 1] <- seq(1, 204)
      LUT.SE <- LUT
      tempse <- predict(gam.model, artificial, se.fit = T, type = "terms")
      term.matrix <- tempse$fit
      se.matrix <- tempse$se.fit
      assign("term.matrix", term.matrix, pos = 1)
      assign("se.matrix", se.matrix, pos = 1)
      mod.terms <- dimnames(gam.model$model)[[2]]
      j <- 0
      for (term1 in names(XXX[gr.selX])) {
            pos1 <- grep(term1, names(XXX[gr.selX])) + 1
            testx <- term1
            pos2 <- pmatch(testx, mod.terms)
            pos3 <- pmatch(term1, names(XXX))
            if (!(pmatch(testx, mod.terms, nomatch = "nomatch") == "nomatch")) {
                  LUT[1:200, pos1] <- zapsmall(term.matrix[pos2, 1:200], 6)
                  j <- j + 1
                  LUT.SE[1:200, pos1] <- zapsmall(se.matrix[pos2, 1:200], 6)
         }
            else {
                  LUT[1:200, pos1] <- rep(0, 200)
                  LUT.SE[1:200, pos1] <- rep(0, 200)
         }
            if (!is.factor(XXX[, pos3])) {
                  LUT[201, pos1] <- min(XXXpred[, pos3])
                  LUT[202, pos1] <- max(XXXpred[, pos3])
                  LUT[203, pos1] <- 200
                  LUT[204, pos1] <- zapsmall(term.matrix[1, 1], 6)
         }
            else {
                  pos4 <- pmatch(term1, mod.terms)
                  LUT[, pos1] <- as.single(LUT[, pos1])
                  LUT.SE[, pos1] <- as.single(LUT[1:200, pos1])
                  if (!is.na(pmatch(term1, mod.terms))) {
                        print(term1)
                        LUT[1:200, pos1] <- zapsmall(term.matrix[1:200, pos4], 6)
                        LUT[-flist[[gr.selX[pos1]]], pos1] <- 0
                        j <- j + 1
                        fac.se <- NULL
                        ranklevel <- 1
                        for (level in levels(XXX[, pos3])) {
                           fac.se[ranklevel] <- tempse[[pos4]]$se.y[tempse[[pos4]]$x == level][1]
                           ranklevel <- ranklevel + 1
                     }
                        LUT.SE[1:length(levels(XXX[, pos3])), pos1] <- zapsmall(fac.se, 6)
                        LUT.SE[-flist[[gr.selX[pos1]]], pos1] <- 0
              }
                  else {
                        cat(term1, "\n")
                        cat("FACTOR OUT", "\n")
                        LUT[1:200, pos1] <- rep(0, 200)
                        LUT.SE[1:200, pos1] <- rep(0, 200)
              }
                  LUT[201, pos1] <- 1
                  LUT[202, pos1] <- length(levels(XXX[, pos3]))
                  LUT[203, pos1] <- length(levels(XXX[, pos3]))
                  LUT[204, pos1] <- zapsmall(attr(term.matrix, "constant"), 6)
        }
}
      LUT.SE[201:204, ] <- LUT[201:204, ]
      dimnames(LUT) <- list(NULL, c("row.names", names(XXX)[gr.selX]))
      dimnames(LUT.SE) <- list(NULL, c("row.names", names(XXX)[gr.selX]))
      cat("LUT prediction:", "\n")
      print(LUT[c(1:5), ])
      cat("", "\n")
      print(LUT[c(196:200), ])
      cat("LUT standard error:", "\n")
      print(LUT.SE[c(1:5), ])
      cat("", "\n")
      print(LUT.SE[c(196:200), ])
      pathlut <- paste(path, Yname, "_lut.txt", sep = "")
      print(pathlut)
      write.table(LUT, file = pathlut, sep = "    ", quote = FALSE, row.names = FALSE)
      pathse <- paste(path, Yname, "_se.txt", sep = "")
      print(pathse)
      write.table(LUT.SE, file = pathse, sep = "  ", quote = FALSE, row.names = FALSE)
}
"grasp.model.GUI" <-
function () 
{
    kill.MODEL <- function() {
        tkdestroy(MODEL)
    }
    go.model <- function(...) {
        step.fam <- c("gaussian()", "quasibinomial()", "quasibinomial()", 
            "quasipoisson()")
        step.test <- c("Chisq", "F", "F", "F")
        model.auto$test <- tkcurselection(frame2.list1)
        model.auto$test <- tclvalue(model.auto$test)
        model.auto$family <- step.fam[as.numeric(model.auto$test) + 
            1]
        model.auto$test <- step.test[as.numeric(model.auto$test) + 
            1]
        model.auto$direction <- tkcurselection(frame2.list2)
        model.auto$direction <- tclvalue(model.auto$direction)
        model.auto$direction <- dirselect[as.numeric(model.auto$direction) + 
            1]
        model.auto$resolution <- as.numeric(tclvalue(MODEL.RESOLUTION))
        model.auto$plimit <- as.numeric(tclvalue(MODEL.P.LIMIT))
        model.auto$steps <- as.numeric(tclvalue(MODEL.STEPS))
        model.auto$df <- as.numeric(tclvalue(MODEL.DF))
        model.auto$stepit <- as.logical(tclvalue(MODEL.STEP.IT))
        model.auto$verbose <- as.logical(tclvalue(MODEL.VERBOSE))
        model.auto$auto.df <- as.logical(tclvalue(MODEL.AUTO.DF))
        model.auto$predictit <- as.logical(tclvalue(MODEL.DO.PRED))
        model.auto$plotpredictit <- as.logical(tclvalue(MODEL.PLOT.PRED))
        assign("model.auto", model.auto, pos = 1)
        grasp.model(gr.Yi,trace = model.auto$verbose, df = model.auto$df, 
            calcdf = model.auto$auto.df, stepfam = model.auto$family)
        grasp.scope(gr.selX, df = model.auto$df, calcdf = model.auto$auto.df)
        if (model.auto$stepit) 
            grasp.step.gam(direction = model.auto$direction, 
                steps = model.auto$steps, trace = model.auto$model.auto$verbose, 
                limit = model.auto$plimit, test = model.auto$test)
        if (model.auto$predictit) 
            grasp.pred()
        if (model.auto$plotpredictit) 
            grasp.pred.plot(gr.predmat, resolution = model.auto$resolution)
	assign("model.auto", model.auto, pos = 1)
    }
    MODEL <- tktoplevel()
    tktitle(MODEL) <- "GraspeR variable selection, model and predictions"
    model.auto <- vector("list", 12)
    names(model.auto) <- c("stepit", "predictit", "plotpredictit", 
        "direction", "test", "plimit", "steps", "verbose", "family", 
        "df", "auto.df", "resolution")
    stepselect <- c("Biomass, size, ...", "Presence / absence", 
        "Cover, %, ...", "Richness, Abundance, ...")
    dirselect <- c("both", "backward", "forward")
    famselect <- c("Gaussian", "Poisson", "Binomial", "Quasibinomial")
    MODEL.P.LIMIT <- tclVar("0.05")
    MODEL.STEPS <- tclVar(1000)
    MODEL.VERBOSE <- tclVar("FALSE")
    MODEL.STEP.IT <- tclVar("TRUE")
    MODEL.DF <- tclVar(4)
    MODEL.AUTO.DF <- tclVar("FALSE")
    MODEL.DO.PRED <- tclVar("TRUE")
    MODEL.PLOT.PRED <- tclVar("TRUE")
    MODEL.RESOLUTION <- tclVar(1000)
    frame1 <- tkframe(MODEL, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(MODEL, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(MODEL, relief = "groove", borderwidth = 2)
    frame4 <- tkframe(MODEL, relief = "groove", borderwidth = 2)
    frame5 <- tkframe(MODEL, relief = "groove", borderwidth = 2)
    frame1.label1 <- tklabel(frame1, text = "GraspeR Modeling", 
        font = "Arial 11")
    frame1.label2 <- tklabel(frame1, text = "This window lets you define and execute the modelling steps", 
        font = "Arial 10", wraplength = 280)
    tkpack(frame1, frame1.label1, frame1.label2, fill = "x")
    frame2.label1 <- tklabel(frame2, text = "Stepwise selection", 
        font = "Arial 11")
    tkgrid(frame2.label1, columnspan = 2)
    frame2.label21 <- tklabel(frame2, text = "Check to do the stepwise selection", 
        font = "Arial 10")
    frame2.check2 <- tkcheckbutton(frame2, variable = MODEL.STEP.IT, 
        height = 1, offvalue = "FALSE", onvalue = "TRUE")
    tkgrid(frame2.label21, frame2.check2)
    frame2.label2 <- tklabel(frame2, text = "Select the kind of data you have", 
        font = "Arial 10")
    tkgrid(frame2.label2, columnspan = 2)
    frame2.list1 <- tklistbox(frame2, selectmode = "single", 
        height = 4, font = "Arial 10", exportselection = FALSE, 
        width = 25)
    for (i in 1:4) {
        tkinsert(frame2.list1, "end", stepselect[i])
    }
    tkselection.set(frame2.list1, 1)
    tkgrid(frame2.list1, columnspan = 2)
    frame2.labela <- tklabel(frame2, text = "Double-click on the selection above to see test and family for the associated data type", 
        font = "Arial 10", wraplength = 250)
    tkgrid(frame2.labela, columnspan = 2)
    frame2.entrya <- tkentry(frame2, width = 10, font = "Arial 10", 
        state = "disabled", text = "Quasibinomial")
    frame2.entryb <- tkentry(frame2, width = 15, font = "Arial 10", 
        state = "disabled", text = "F")
    tkgrid(frame2.entrya, frame2.entryb)
    frame2.label3 <- tklabel(frame2, text = "Direction", font = "Arial 10")
    tkgrid(frame2.label3, columnspan = 2)
    frame2.list2 <- tklistbox(frame2, selectmode = "single", 
        height = 3, font = "Arial 10", exportselection = FALSE)
    for (i in 1:3) {
        tkinsert(frame2.list2, "end", dirselect[i])
    }
    tkselection.set(frame2.list2, 0)
    tkgrid(frame2.list2, columnspan = 2)
    frame2.label4 <- tklabel(frame2, text = "P.limit for selection", 
        font = "Arial 10")
    frame2.entry1 <- tkentry(frame2, textvariable = MODEL.P.LIMIT, 
        width = 10, justify = "left", font = "Arial 10")
    tkgrid(frame2.label4, frame2.entry1)
    frame2.label5 <- tklabel(frame2, text = "Number of steps", 
        font = "Arial 10")
    frame2.entry2 <- tkentry(frame2, textvariable = MODEL.STEPS, 
        width = 10, justify = "left", font = "Arial 10 ")
    tkgrid(frame2.label5, frame2.entry2)
    frame2.label6 <- tklabel(frame2, text = "Check to force verbose output", 
        font = "Arial 10")
    frame2.check1 <- tkcheckbutton(frame2, variable = MODEL.VERBOSE, 
        height = 1, offvalue = "FALSE", onvalue = "TRUE")
    tkgrid(frame2.label6, frame2.check1)
    tkpack(frame2, fill = "x")
    frame3.label1 <- tklabel(frame3, text = "Modeling using GAMs", 
        font = "Arial 11")
    tkgrid(frame3.label1, columnspan = 2)
    frame3.label2 <- tklabel(frame3, text = "Family depends on the selections above", 
        font = "Arial 10")
    tkgrid(frame3.label2, columnspan = 2)
    frame3.label3 <- tklabel(frame3, text = "Smoothing degrees of freedom", 
        font = "Arial 10")
    frame3.entry1 <- tkentry(frame3, textvariable = MODEL.DF, 
        width = 10, justify = "left", font = "Arial 10")
    tkgrid(frame3.label3, frame3.entry1)
    frame3.label4 <- tklabel(frame3, text = "Let the gam function calculate df", 
        font = "Arial 10")
    frame3.check3 <- tkcheckbutton(frame3, variable = MODEL.AUTO.DF, 
        height = 1, offvalue = "FALSE", onvalue = "TRUE")
    tkgrid(frame3.label4, frame3.check3)
    tkpack(frame3, fill = "x")
    frame4.label1 <- tklabel(frame4, text = "Predict", font = "Arial 11")
    tkgrid(frame4.label1, columnspan = 2)
    frame4.label2 <- tklabel(frame4, text = "Check to calculate predictions", 
        font = "Arial 10")
    frame4.check1 <- tkcheckbutton(frame4, variable = MODEL.DO.PRED, 
        height = 1, offvalue = "FALSE", onvalue = "TRUE")
    tkgrid(frame4.label2, frame4.check1)
    frame4.label3 <- tklabel(frame4, text = "Check to plot predictions", 
        font = "Arial 10")
    frame4.check2 <- tkcheckbutton(frame4, variable = MODEL.PLOT.PRED, 
        height = 1, offvalue = "FALSE", onvalue = "TRUE")
    tkgrid(frame4.label3, frame4.check2)
    frame4.label4 <- tklabel(frame4, text = "Resolution for output", 
        font = "Arial 10")
    frame4.entry1 <- tkentry(frame4, textvariable = MODEL.RESOLUTION, 
        width = 10, justify = "left", font = "Arial 10")
    tkgrid(frame4.label4, frame4.entry1)
    tkpack(frame4, fill = "x")
    frame5.but1 <- tkbutton(frame5, text = "Gogogooo!", padx = 40, 
        font = "Arial 10", command = go.model)
    frame5.but2 <- tkbutton(frame5, text = "Loosing my time!", 
        padx = 40, font = "Arial 10", command = kill.MODEL)
    tkgrid(frame5.but1, frame5.but2)
    tkpack(frame5, fill = "x")
    tkbind(frame2.list1, "<1>", function() {
        step.fam <- c("Gaussian", "Quasibinomial", "Quasibinomial", 
            "Quasipoisson")
        step.test <- c("Chisq", "F", "F", "F")
        mod.test <- tkcurselection(frame2.list1)
        mod.test <- tclvalue(mod.test)
        mod.test.local <- tclVar(step.test[as.numeric(mod.test) + 
            1])
        mod.fam <- tclVar(step.fam[as.numeric(mod.test) + 1])
        tkconfigure(frame2.entrya, textvariable = mod.test.local)
        tkconfigure(frame2.entryb, textvariable = mod.fam)
    })
}
"grasp.model" <-
function (gr.Yi=gr.Yi, cX = gr.selX, optest = "F", df = 4, trace = TRUE, 
    calcdf = FALSE, stepfam = "quasibinomial()") 
{
    if (trace) {
        cat("\n")
        cat("*****************************************************", 
            "\n")
        cat("**********          R-GRASP MODEL          **********", 
            "\n")
        cat("**********       Modelling using gam()     **********", 
            "\n")
        cat("**********        GRASP by A. Lehmann      **********", 
            "\n")
        cat("**********      Ported to R by F. Fivaz    **********", 
            "\n")
        cat("*****************************************************", 
            "\n")
        cat("\n")
        cat(date(), "\n")
        cat("\n")
        cat("Initializing variables... ")
    }
    Yname <- names(YYY[gr.Yi])
    gr.selYCOR <- gr.Yi
    gr.selXCOR <- list(gr.selY)
    for (i in gr.Yi) {
        gr.selXCOR[[i]] <- gr.selX
    }
    gr.selXCOR <- gr.selXCOR
    assign("gr.selXCOR", gr.selXCOR, pos = 1)
    assign("gr.Yi", gr.Yi, pos = 1)
    if (trace) {
        cat("done", "\n")
        cat("\n")
        assign("Yname", Yname, pos = 1)
        cat("RESPONSE NAME: ", Yname, "\n")
    }
    if (((stepfam == "binomial") | (stepfam == "quasi")) & ((max(YYY[, 
        gr.Yi]) > 1) | (min(YYY[, gr.Yi]) < 0))) {
        stop("DATA OUT OF RANGE [0,1] TO USE A BINOMIAL MODEL !")
    }
    mkt.keep.AIC <- function(object, AIC) {
        list(df.resid = object$df.resid, deviance = object$deviance, 
            term = as.character(object$formula)[3], AIC = AIC)
    }
    mkt.keep.p <- function(object, pvalue) {
        list(df.resid = object$df.resid, deviance = object$deviance, 
            term = as.character(object$formula)[3], pvalue = pvalue)
    }
    for (xi in gr.selXCOR[[gr.Yi]]) {
        if (is.factor(XXX[, xi]) & length(levels(XXX[, xi])) < 
            2) {
            gr.selXCOR[[gr.Yi]] <- gr.selXCOR[[gr.Yi]][-match(xi, 
                gr.selXCOR[[gr.Yi]])]
            print(paste("factor", names(XXX)[xi], "was removed from the potential predictors of", 
                names(YYY)[gr.Yi], "because it has less than two levels"))
        }
    }
    grasp.scope(gr.selXCOR[[gr.Yi]], trace = FALSE)
    grasp.start(cX, sX = gr.selXCOR[[gr.Yi]], 
        df = df, trace = FALSE, calcdf = calcdf)
    START <- model.formula
    assign("model.formula", model.formula, pos = 1)
    XXX <- XXX[gr.modmask[, gr.Yi], ]
    YYY <- YYY[gr.modmask[, gr.Yi], ]
    WEIGHTS.df <- paste("WEIGHTS[gr.modmask[, ", gr.Yi, "], ", 
        gr.Yi, "]")
    gam.start <- eval(parse(text = paste("gam(", as.character(START[2]), 
        "~", as.character(START[3]), ", family = ", stepfam, 
        ",data = XXX", ", weights = ", WEIGHTS.df, ", control = gam.control(maxit = 50, epsilon=0.001))")))
    assign("gam.start", gam.start, pos = 1)
    STEPMODEL[[gr.Yi]] <- gam.start
    assign("STEPMODEL", STEPMODEL, pos = 1)
    if (trace) 
        cat("Ploting results...", "\n")
    plot.gam(gam.start, pages = 1, scale = 0, n = 1000)
    if (trace) {
        cat("SUMMARY OF MODEL", "\n")
        summary.gam(gam.start)
        cat("\n")
        cat("**********        R-GRASP MODEL END        **********", 
            "\n")
        cat("\n")
    }
}
"grasp.options.GUI" <-
function (...) 
{
    options.apply <- function(...) {
        apply.ok <- TRUE
        assign("apply.ok", apply.ok, pos = 1)
        OPT<-list()
        OPT$TITLE <- as.character(tclvalue(OPTIONS.TITLE))
        OPT$LAYOUT <- eval(parse(text = as.character(tclvalue(OPTIONS.LAYOUT))))
        OPT$NBBARS <- as.integer(tclvalue(OPTIONS.NBBARS))
        OPT$WEIGHTS <- as.character(tclvalue(OPTIONS.WEIGHTS))
        OPT$RESOLUTION <- as.numeric(tclvalue(OPTIONS.RESOLUTION))
	OPT$SEP <- as.character(tclvalue(OPTIONS.SEP))
        print(OPT)
        assign("OPT", OPT, pos = 1)
        cat("Options set!", "\n")
    }
    options.default <- function(...) {
        OPT.DEFAULT <- NULL
        OPT <- OPT.DEFAULT
        assign("OPT", OPT, pos = 1)
        cat("Options set to default", "\n")
    }
    options.close <- function() {
        tkdestroy(OPTIONS)
    }
    OPTIONS <- tktoplevel()
    tktitle(OPTIONS) <- "R-GRASP options"
    apply.ok <- FALSE
    assign("apply.ok", apply.ok, pos = 1)
    OPTIONS.TITLE <- tclVar("R-GRASP: ")
    OPTIONS.LAYOUT <- tclVar("c(3,3)")
    OPTIONS.NBBARS <- tclVar(10)
    OPTIONS.WEIGHTS <- tclVar("WEIGHTS")
    OPTIONS.RESOLUTION <- tclVar(1000)
    OPTIONS.SELX <- tclVar("c(4,5,6,7,8,9,10,11)")
    OPTIONS.SEP <- tclVar(" ")
    frame1 <- tkframe(OPTIONS, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(OPTIONS, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(OPTIONS, relief = "groove", borderwidth = 2)
    frame1.label1 <- tklabel(frame1, text = "GraspeR Options", 
        font = "Arial 11")
    frame1.label2 <- tklabel(frame1, text = "This window lets you define the options", 
        font = "arial 10")
    tkpack(frame1, frame1.label1, frame1.label2, fill = "x")
    frame2.main <- tklabel(frame2, text = "General options", 
        font = "arial 10", justify = "center")
    frame2.label1 <- tklabel(frame2, text = "Title", font = "arial 10")
    frame2.label2 <- tklabel(frame2, text = "Layout", font = "arial 10")
    frame2.label3 <- tklabel(frame2, text = "Nb. of bars", font = "arial 10")
    frame2.label4 <- tklabel(frame2, text = "Weights", font = "arial 10")
    frame2.label5 <- tklabel(frame2, text = "Resolution", font = "arial 10")
    frame2.label6 <- tklabel(frame2, text = "Separator for text files", 
font="arial 10")
    frame2.entry1 <- tkentry(frame2, textvariable = OPTIONS.TITLE, 
        width = 20, justify = "left")
    frame2.entry2 <- tkentry(frame2, textvariable = OPTIONS.LAYOUT, 
        width = 20, justify = "left")
    frame2.entry3 <- tkentry(frame2, textvariable = OPTIONS.NBBARS, 
        width = 20, justify = "left")
    frame2.entry4 <- tkentry(frame2, textvariable = OPTIONS.WEIGHTS, 
        width = 20, justify = "left")
    frame2.entry5 <- tkentry(frame2, textvariable = OPTIONS.RESOLUTION, 
        width = 20, justify = "left")
    frame2.entry6 <- tkentry(frame2, textvariable = OPTIONS.SEP, width = 
20, justify = "left")
    tkgrid(frame2.main, columnspan = 2, sticky = "w")
    tkgrid(frame2.label1, frame2.entry1, sticky = "w")
    tkgrid(frame2.label2, frame2.entry2, sticky = "w")
    tkgrid(frame2.label3, frame2.entry3, sticky = "w")
    tkgrid(frame2.label4, frame2.entry4, sticky = "w")
    tkgrid(frame2.label5, frame2.entry5, sticky = "w")
    tkgrid(frame2.label6, frame2.entry6, sticky = "w")
    tkpack(frame2, fill = "x")
    apply.but <- tkbutton(frame3, text = "Apply", command = options.apply, 
        padx = 40, font = "arial 10")
    defaults.but <- tkbutton(frame3, text = "Defaults", command = options.default, 
        padx = 40, font = "arial 10")
    close.but <- tkbutton(frame3, text = "Close", command = options.close, 
        padx = 40, font = "arial 10")
    tkgrid(apply.but, defaults.but, close.but, sticky = "w")
    tkpack(frame3, fill = "x")
}
"grasp.pred" <-
function (gr.Yi = gr.selY) 
{
    cat("\n")
    cat("*****************************************************", "\n")
    cat("**********           GRASP PREDICT         **********", "\n")
    cat("**********         Predicts responses      **********", "\n")
    cat("**********        GRASP by A. Lehmann      **********", "\n")
    cat("**********      Ported to R by F. Fivaz    **********", "\n")
    cat("*****************************************************", "\n")
    cat("\n")
    cat(date(), "\n")
    cat("\n")
    Yname <- names(YYY)[gr.Yi]
    cat("Response name: ", Yname, "\n")
    print(gam.start)
    cat("predicting... ")
    prediction <- rep(1, length(XXXpred[, 1]))
    prediction[gr.predmask[, gr.Yi] == FALSE] <- -99.9
    prediction[prediction == 1] <- predict.gam(gam.start, XXXpred[prediction == 1, ], type = "response")
    cat("done", "\n")
    cat("Saving predictions...")
    print(prediction[1:10])
    gr.predmat[, gr.Yi] <- round(prediction, 4)
    assign("gr.predmat", gr.predmat, pos = 1)
    cat("done", "\n")
    cat("\n")
    cat("**********         GRASP PREDICT END       **********", 
        "\n")
}
"grasp.pred.plot" <-
function (predmat = gr.predmat, gr.Yi = gr.selY, resolution = 1000) 
{
    cat("\n")
    cat("*****************************************************", 
        "\n")
    cat("**********       GRASP PREDICTION PLOT     **********", 
        "\n")
    cat("**********         Plots predictions       **********", 
        "\n")
    cat("**********        GRASP by A. Lehmann      **********", 
        "\n")
    cat("**********      Ported to R by F. Fivaz    **********", 
        "\n")
    cat("*****************************************************", 
        "\n")
    cat("\n")
    cat(date(), "\n")
    cat("\n")
    Yname <- names(YYY)[gr.Yi]
    cat("Response name: ", Yname, "\n")
    TITLE <- "GraspeR"
    maxX <- (ceiling(max(XXXpred$x)/resolution) * resolution) + 
        resolution
    minX <- (floor(min(XXXpred$x)/resolution) * resolution)
    maxY <- (ceiling(max(XXXpred$y)/resolution) * resolution) + 
        resolution
    minY <- (floor(min(XXXpred$y)/resolution) * resolution)
    half <- resolution/2
    Nrow <- (maxX - minX)/resolution
    Ncol <- (maxY - minY)/resolution
    if ((Nrow * Ncol) > 1e+07) {
        cat("ERROR: too many pixels (", Nrow * Ncol, ")>> increase your resolution in the options", 
            "\n")
        return(invisible())
    }
    cat("\n")
    cat("maxX: ", maxX, "\n")
    cat("minX: ", minX, "\n")
    cat("maxY: ", maxY, "\n")
    cat("minY: ", minY, "\n")
    cat("Nrow: ", Nrow, "\n")
    cat("Ncol: ", Ncol, "\n")
    rangeX <- maxX - minX
    rangeY <- maxY - minY
    par(mfrow = c(1, 1), mai = c(0.5, 0.5, 0.5, 0.5))
    fred0 <- (predmat[, gr.Yi] != -99.9)
    fred1 <- XXXpred$x
    fred2 <- XXXpred$y
    fred1 <- round((fred1[fred0] - (minX - half))/resolution)
    fred2 <- round((fred2[fred0] - (minY + half))/resolution)
    fred3 <- predmat[fred0, gr.Yi]
    temp <- as.data.frame(cbind(fred1, fred2, fred3))
    cat("\n")
    cat("Temp:", "\n")
    print(temp[1:10, ])
    temp.temp <- temp
    noduplicates <- all(!(duplicated(paste(temp$fred1, temp$fred2, 
        sep = "x"))))
    cat("\n")
    if (noduplicates) 
        cat("There are no duplicated X and Y coordinates in prediction set !", 
            "\n")
    else if (dim(temp)[1] < 10000) {
        temp <- aggregate(temp, by = list(temp$fred1, temp$fred2), 
            mean)
        cat("AGGREGATION: The mean of predicted value found for each combination of Xs and Ys is returned !!!", 
            "\n")
    }
    else cat("AGGREGATION (>10000 predictions): Only the first predicted value found for each combination of Xs and Ys is returned !!!", 
        "\n")
    fred1 <- temp$fred1
    fred2 <- temp$fred2
    fred3 <- temp$fred3
    map <- NULL
    map <- matrix(NA, nrow = Nrow, ncol = Ncol)
    for (r in 1:length(temp[, 1])) {
        map[fred1[r], fred2[r]] <- fred3[r]
    }
    plot(fred1, fred2, pch = " ", ylim = c(0, Ncol + 0.1 * Ncol), 
        xlim = c(0, Nrow + 0.1 * Nrow))
    image(map, col = heat.colors(12))
    title(paste(TITLE, " ", "\n Grid resolution : ", 1000), cex = 0.6)
    cat("\n")
    cat("**********     GRASP PREDICTION PLOT END   **********", 
        "\n")
    cat("\n")
}
"grasp.roc" <-
function (z1, z2) 
{
# Fonction roc.plot written by Antoine Guisan (Swiss Center for Faunal Cartography, 1999)
# See table 2 in Fielding & Bell (1997), Environmental Conservation 24(1): 41
# sens = sensitivity, spec = specificity;
# z1 = vector of predicted values between 0 and 1; z2 = vector of observed values 0/1
grasp.roc.auc <- function(x)
{
    x1 <- 1 - x$spec
    y1 <- x$sens
    trapezint(x1, y1, 0, 1)
	
}

eva <- data.frame(seuil = 0, sens = 1, spec = 1)
k <- 0.01
i <- 2
while(k < 0.9) {
 	a <- table(z1 >= k, z2)[4]
	assign("a", a, pos = 1)
	b <- table(z1 >= k, z2)[2]
	c <- table(z1 >= k, z2)[3]
	assign("c", c, pos = 1)
	d <- table(z1 >= k, z2)[1]
	eva[i,"seuil"] <- k
	eva[i,"sens"] <- ifelse(is.na((a / (a + c))), 0, a / (a + c))
	eva[i,"spec"] <- d / (b + d)
	k <- k + 0.01
	i <- i + 1
}
eva[i,"seuil"] <- 1
eva[i,"sens"] <- 0
eva[i,"spec"] <- 1
assign("eva", eva, pos = 1)
return(list(data = eva, auc = grasp.roc.auc(eva)))
}
"grasp.scope" <-
function (sX = gr.selX, df = 4, calcdf = FALSE, trace = TRUE) 
{
    if (trace) {
        cat("\n")
        cat("*****************************************************", 
            "\n")
        cat("**********        R-GRASP SCOPE            **********", 
            "\n")
        cat("**********      Creates scope list         **********", 
            "\n")
        cat("**********      GRASP by A. Lehmann        **********", 
            "\n")
        cat("**********    Ported to R by F. Fivaz      **********", 
            "\n")
        cat("*****************************************************", 
            "\n")
        cat("\n")
        cat(date(), "\n")
        cat("\n")
        cat("Initializing variables... ")
    }
    vnames <- names(XXX[, sX])
    step.list <- as.list(vnames)
    names(step.list) <- vnames
    assign("vnames", vnames, pos = 1)
    if (trace) {
        cat("done", "\n")
        cat("\n")
        cat("Scope list: ", "\n")
        cat("\n")
    }
    if (calcdf == FALSE) {
        for (Xi in sX) {
            vname <- names(XXX)[Xi]
            junk <- c("1")
            if (!is.factor(XXX[[vname]])) 
                junk <- c("1", paste("s", "(", vname, ", ", df + 
                  1, ", fx = T)", sep = ""))
            junk <- eval(parse(text = paste(" ~ ", paste(junk, 
                collapse = "+"))))
            step.list[[vname]] <- junk
        }
    }
    else {
        for (Xi in sX) {
            vname <- names(XXX)[Xi]
            junk <- c("1")
            if (!is.factor(XXX[[vname]])) 
                junk <- c("1", paste("s", "(", vname, ")", sep = ""))
            junk <- eval(parse(text = paste(" ~ ", paste(junk, 
                collapse = "+"))))
            step.list[[vname]] <- junk
        }
    }
    if (trace) 
        print(step.list)
    assign("step.list", step.list, pos = 1)
    if (trace) 
        cat("**********      R-GRASP SCOPE END          **********", 
            "\n")
}
"grasp.select.predictors" <-
function () 
{
    predsel.close <- function(...) {
        tkdestroy(predsel)
    }
    apply.predictors <- function() {
        pred.sel <- tkcurselection(frame2.lstbox1)
        pred.sel <- tclvalue(pred.sel)
        write(pred.sel, file = "resp")
        pred.sel <- scan(file = "resp")
        gr.selX <- pred.sel + 4
        assign("gr.selX", gr.selX, pos = 1)
        assign("gr.Xi", gr.selX, pos = 1)
        assign("SelX", gr.selX, pos = 1)
        for (i in gr.selX) {
            Yname <- names(XXX[i])
            print(Yname)
        }
    }
    predsel <- tktoplevel()
    tktitle(predsel) <- "R-GRASP Select"
    frame1 <- tkframe(predsel, relief = "groove", borderwidth = 2)
    frame2 <- tkframe(predsel, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(predsel, relief = "groove", borderwidth = 2)
    frame1.label <- tklabel(frame1, text = "Select predictors", 
        justify = "left", wraplength = 200)
    tkpack(frame1, frame1.label, fill = "x")
    frame2.yscroll <- tkscrollbar(frame2, repeatinterval=5, command=function(...)tkyview(frame2.lstbox1,...))
    frame2.lstbox1 <- tklistbox(frame2, selectmode = "multiple", 
        exportselection = FALSE,yscrollcommand=function(...)tkset(frame2.yscroll,...))
    for (i in c(4:length(XXX))) {
        tkinsert(frame2.lstbox1, "end", names(XXX)[i])
    }
    gr.selX0 <- gr.selX - 4
    for (i in gr.selX0) tkselection.set(frame2.lstbox1, i)
    tkgrid(frame2.lstbox1, frame2.yscroll)
    tkgrid.configure(frame2.yscroll, rowspan=4, sticky="nsw")
    tkpack(frame2, fill = "y")
    apply.but <- tkbutton(frame3, text = "Apply", command = apply.predictors)
    close.but <- tkbutton(frame3, text = "Close", command = predsel.close)
    tkgrid(apply.but, close.but, sticky = "w")
    tkpack(frame3, fill = "x")
}
"grasp.select.responses" <-
function () 
{
    respsel.close <- function(...) {
        tkdestroy(respsel)
    }
    apply.response <- function() {
        resp.sel <- tkcurselection(frame4.lstbox2)
        resp.sel <- tclvalue(resp.sel)
        write(resp.sel, file = "resp")
        resp.sel <- scan(file = "resp")
        gr.selY <- resp.sel + 2
        assign("gr.selY", gr.selY, pos = 1)
        assign("gr.Yi", gr.selY, pos = 1)
        assign("OPT$SELY", gr.selY, pos = 1)
        for (i in gr.selY) {
            Yname <- names(YYY[i])
            print(Yname)
        }
    }
    respsel <- tktoplevel()
    tktitle(respsel) <- "R-GRASP Select"
    frame1 <- tkframe(respsel, relief = "groove", borderwidth = 2)
    frame4 <- tkframe(respsel, relief = "groove", borderwidth = 2)
    frame3 <- tkframe(respsel, relief = "groove", borderwidth = 2)
    frame1.label <- tklabel(frame1, text = "Select response variables", 
        justify = "left", wraplength = 200)
    tkpack(frame1, frame1.label, fill = "x")
    frame4.lstbox2 <- tklistbox(frame4, selectmode = "multiple", 
        exportselection = FALSE)
    for (i in c(2:length(YYY))) {
        tkinsert(frame4.lstbox2, "end", names(YYY)[i])
    }
    tkpack(frame4, frame4.lstbox2, fill = "x")
    apply.but <- tkbutton(frame3, text = "Apply", command = apply.response)
    close.but <- tkbutton(frame3, text = "Close", command = respsel.close)
    tkgrid(apply.but, close.but, sticky = "w")
    tkpack(frame3, fill = "x")
}
"grasp.start" <-
function (cX, sX, df = 4, calcdf = FALSE, trace = TRUE) 
{
    if (trace) {
        cat("\n")
        cat("*****************************************************", 
            "\n")
        cat("**********        R-GRASP START            **********", 
            "\n")
        cat("**********    Creates starting formula     **********", 
            "\n")
        cat("**********      GRASP by A. Lehmann        **********", 
            "\n")
        cat("**********    Ported to R by F. Fivaz      **********", 
            "\n")
        cat("*****************************************************", 
            "\n")
        cat("\n")
        cat(date(), "\n")
        cat("\n")
        cat("Initializing variables... ")
    }
    sX <- intersect(sX, cX)
    vnames <- names(XXX[, c(1, sX)])
    model.formula <- NULL
    if (trace) {
        cat("done", "\n")
        cat("\n")
        cat("Variables used:", "\n")
    }
    if (calcdf == FALSE) {
        for (Xi in sX) {
            if (trace) 
                cat(names(XXX)[Xi], "\n")
            vname <- names(XXX)[Xi]
            if (is.factor(XXX[[vname]])) 
                model.formula <- c(model.formula, paste("s", 
"(",vname,")"))
            else model.formula <- c(model.formula, paste("s", 
                "(", vname, ", k=", df + 1, ", fx = TRUE)"))
        }
    }
    else {
        for (Xi in sX) {
            if (trace) 
                cat(names(XXX)[Xi], "\n")
            vname <- names(XXX)[Xi]
            if (is.factor(XXX[[vname]])) 
                model.formula <- c(model.formula, 
paste("s","(",vname,")"))
            else model.formula <- c(model.formula, paste("s", 
                "(", vname, ")"))
        }
    }
    gam.formula <- model.formula
    assign("gam.formula", gam.formula, pos = 1)
    model.formula <- c(model.formula)
    if (length(sX) > 1) {
        model.formula <- eval(parse(text = paste("YYY$", names(YYY)[gr.Yi], 
            "~", paste(model.formula, collapse = "+"))))
    }
    else {
        if (length(sX) == 0) {
            model.formula <- eval(parse(text = paste("YYY$", 
                names(YYY)[gr.Yi], "~", "0")))
        }
        else {
            model.formula <- eval(parse(text = paste("YYY$", 
                names(YYY)[gr.Yi], "~", model.formula)))
        }
    }
    model.formula
    cat("\n")
    assign("model.formula", model.formula, pos = 1)
    if (trace) {
        print(model.formula)
        cat("\n")
        cat("Formula created!", "\n")
        cat("\n")
        cat("**********        R-GRASP START END         **********", 
            "\n")
        cat("\n")
    }
}
"grasp.stat.anova" <-
function (table, test = c("Chisq", "F", "Cp"), scale, df.scale, 
    n) 
{
    test <- match.arg(test)
    dev.col <- match("Deviance", colnames(table))
    if (is.na(dev.col)) 
        dev.col <- match("Sum of Sq", colnames(table))
    if (is.na(dev.col)) 
        stop("Anova objects need a \"Deviance\" or a \"Sum of Sq\" columns for the F test")
    switch(test, Chisq = {
        cbind(table, "P(>|Chi|)" = pchisq(abs(table[, dev.col]/scale), 
            abs(table[, "Df"]), lower.tail = FALSE))
    }, F = {
        Fvalue <- abs((table[, dev.col]/table[, "Df"])/scale)
        Fvalue[table[, "Df"] == 0] <- NA
        cbind(table, F = Fvalue, "Pr(>F)" = pf(Fvalue, abs(table[, 
            "Df"]), abs(df.scale), lower.tail = FALSE))
    }, Cp = {
        cbind(table, Cp = table[, "Resid. Dev"] + 2 * scale * 
            (n - table[, "Resid. Df"]))
    })
}
"grasp.step.gam" <-
function (object = gam.start, scope = step.list, scale, direction = c("both", 
    "backward", "forward"), trace = TRUE, keep = NULL, steps = 1000, 
    limit = 0.05, test = "F") 
{
    LIMIT = limit
    OPT$test <- test
    cat("direction =", direction, "\n")
    cat("steps =", steps, "\n")
    cat("limit =", limit, "\n")
    cat("test =", test, "\n")
    XXX <- XXX[gr.modmask[, gr.Yi], ]
    YYY <- YYY[gr.modmask[, gr.Yi], ]
    convert.gam <- function(object) {
        objgam <- vector("list", 3)
        names(objgam) <- c("family", "formula", "terms")
        objgam$formula <- formula(object)
        objgam$family <- vector("list", 3)
        names(objgam$family) <- c("name", "link", "variance")
        objgam$family$name <- object$family[[1]]
        objgam$family$link <- object$family[[2]]
        objgam$family$variance <- object$family[[5]]
        objgam$terms <- vector("list", 2)
        names(objgam$terms) <- c("response", "term.labels")
        objgam$terms$response <- 1
        objgam$terms$term.labels <- gam.formula
        return(objgam)
    }
    scope.char <- function(form) {
        for (i in 1:length(form)) {
            form[[i]] <- c("1", gam.formula[i])
        }
        return(form)
    }
    untangle.scope <- function(terms, regimens) {
        a <- attributes(terms)
        response <- deparse(terms[[2]])
        term.labels <- a$term.labels
        nt <- length(regimens)
        Select <- integer(nt)
        for (i in seq(nt)) {
            j <- match(regimens[i], term.labels, 0)
            if (any(j)) {
                if (sum(j > 0) > 1) 
                  stop("problem")
                Select[i] <- seq(j)[j > 0]
                term.labels <- term.labels[-sum(j)]
            }
            else {
                if (!(j <- match("1", regimens[[i]], 0))) 
                  stop("problem 2")
                Select[i] <- j
            }
        }
        if (length(term.labels)) 
            term.labels <- paste(term.labels, "+")
        return(list(response = paste(response, term.labels, sep = " ~ "), 
            Select = Select))
    }
    make.step <- function(models, fit, scale, object) {
        chfrom <- sapply(models, "[[", "from")
        chfrom[chfrom == "1"] <- ""
        chto <- sapply(models, "[[", "to")
        chto[chto == "1"] <- ""
        dev <- sapply(models, "[[", "deviance")
        df <- sapply(models, "[[", "df.resid")
        ddev <- c(NA, diff(dev))
        ddf <- c(NA, diff(df))
        pvalue <- sapply(models, "[[", "pvalue")
        heading <- as.list(c("Stepwise Model Path", "\nAnalysis of deviance Table", 
            "\nInitial Model: ", deparse(as.vector(formula(object))), 
            "\nFinal Model: ", deparse(as.vector(formula(fit))), 
            paste("\nScale: ", format(scale), "\n", sep = "")))
        aod <- data.frame(From = chfrom, To = chto, Df = ddf, 
            Deviance = ddev, "Resid. Df" = df, "Resid. Dev" = dev, 
            pvalue = pvalue, check.names = F)
        cat("\n")
        print(aod)
        cat("\n")
        cat(unlist(heading))
        cat("\n")
        cat("Creating new gam.start model, with results from stewise selection...")
        gam.start <- update(gam.start, formula(fit))
        assign("gam.start", gam.start, pos = 1)
        cat("done", "\n")
    }
    direction <- match.arg(direction)
    scope <- scope.char(scope)
    object.real <- object
    object <- convert.gam(object)
    response <- untangle.scope(object$formula, scope)
    object <- object.real
    form.y <- response$response
    backward <- direction == "both" | direction == "backward"
    forward <- direction == "both" | direction == "forward"
    items <- response$Select
    family <- object$family
    cat("\n")
    Call <- object$call
    term.lengths <- sapply(scope, length)
    n.items <- length(items)
    visited <- array(F, term.lengths)
    visited[array(items, c(1, n.items))] <- T
    models <- vector("list", length(visited))
    nm <- 2
    form.vector <- character(n.items)
    items <- items + 1
    for (i in seq(n.items)) {
        form.vector[i] <- scope[[i]][items[i]]
    }
    form <- deparse(object$formula)
    cat("form.vector passed", "\n")
    fit <- object
    fit$df.resid <- length(fit$y) - fit$nsdf - sum(fit$edf)
    n <- length(fit$fitted)
    scale <- fit$sig2
    cat("Scale est. =", scale, "\n")
    bAIC <- deviance(fit) + 2 * (n - fit$df.null) * scale
    models[[1]] <- list(deviance = deviance(fit), df.resid = fit$df.resid, 
        pvalue = LIMIT, from = "", to = "")
    STOP <- 1
    bFRED <- 1
    if (test == "Chisq") 
        scale <- 1
    while (STOP > LIMIT && steps > 0) {
        steps <- steps - 1
        STOP <- bFRED
        bFRED <- LIMIT
        kFRED <- LIMIT
        bitems <- items
        bfit <- fit
        Nstep <- 0
        for (i in seq(n.items)) {
            if (backward) {
                cat("Start backward...", "\n")
                trial <- items
                trial[i] <- trial[i] - 1
                if (trial[i] > 0 && !visited[array(trial, c(1, 
                  n.items))]) {
                  visited[array(trial, c(1, n.items))] <- T
                  tform.vector <- form.vector
                  tform.vector[i] <- scope[[i]][trial[i]]
                  cat("Trial:", form, "\n")
                  form <- paste(form.y, paste(tform.vector, collapse = " + "))
                  tfit <- update(object.real, eval(parse(text = form)))
                  TEST <- grasp.anova.gam(fit, tfit, test = test, 
                    dispersion = scale)
                  fit$df.resid <- length(fit$y) - fit$nsdf - 
                    sum(fit$edf)
                  tfit$df.resid <- length(tfit$y) - tfit$nsdf - 
                    sum(tfit$edf)
                  bfit$df.resid <- length(bfit$y) - bfit$nsdf - 
                    sum(bfit$edf)
                  assign("fit", fit, pos = 1)
                  assign("tfit", tfit, pos = 1)
                  if (test == "Chisq") 
                    tFRED <- TEST[2, 5]
                  if (test == "F") 
                    tFRED <- TEST[2, 6]
                  if (tFRED > bFRED) {
                    bFRED <- tFRED
                    kFRED <- tFRED
                    bitems <- trial
                    bfit <- tfit
                    bform.vector <- tform.vector
                    bfrom <- form.vector[i]
                    bto <- tform.vector[i]
                    Nstep <- i
                  }
                }
            }
            if (forward) {
                cat("Start forward...", "\n")
                trial <- items
                trial[i] <- trial[i] + 1
                if (trial[i] <= term.lengths[i] && !visited[array(trial, 
                  c(1, n.items))]) {
                  visited[array(trial, c(1, n.items))] <- T
                  tform.vector <- form.vector
                  tform.vector[i] <- scope[[i]][trial[i]]
                  form <- paste(form.y, paste(tform.vector, collapse = " + "))
                  tfit <- update(object.real, eval(parse(text = form)))
                  TEST <- grasp.anova.gam(fit, tfit, test = test, 
                    dispersion = scale)
                  fit$df.resid <- length(fit$y) - fit$nsdf - 
                    sum(fit$edf)
                  tfit$df.resid <- length(tfit$y) - tfit$nsdf - 
                    sum(tfit$edf)
                  bfit$df.resid <- length(bfit$y) - bfit$nsdf - 
                    sum(bfit$edf)
                  tFRED <- TEST[2, 5]
                  if (tFRED < kFRED & tFRED < LIMIT) {
                    bFRED <- LIMIT + 0.001
                    kFRED <- tFRED
                    bitems <- trial
                    bfit <- tfit
                    bform.vector <- tform.vector
                    bfrom <- form.vector[i]
                    bto <- tform.vector[i]
                    Nstep <- i
                  }
                }
            }
        }
        if (STOP <= LIMIT | steps == 0 | Nstep == 0) {
            return(make.step(models[seq(nm - 1)], fit, scale, 
                object))
        }
        else {
            items <- bitems
            models[[nm]] <- list(deviance = deviance(bfit), df.resid = bfit$df.resid, 
                pvalue = kFRED, from = bfrom, to = bto)
            nm <- nm + 1
            fit <- bfit
            form.vector <- bform.vector
        }
    }
    assign("models", models, pos = 1)
}
"grasp.summary" <-
function (gr.Yi=gr.selY) 
{
    cat("********* GraspeR.summary **********", "\n")
    cat(date(), "\n")
    cat("\n")
    cat("Ys...", "\n")
    dimYYY <- dim(YYY)
    cat("Dimension of YYY:", dimYYY, "\n")
    Yname <- names(YYY)[gr.Yi]
    cat("Selected response: ", gr.Yi, "\n")
    cat("Response name: ", Yname, "\n", "\n")
    selection <- gr.modmask[, gr.Yi]
    if (length(gr.Yi) > 1) {
        cat("More than one VOI to summarize, doing lapply()", 
            "\n")
        lapply(gr.Yi, grasp.summary)
    }
    else {
        print(summary(YYY[selection, gr.Yi]))
        cat("\n")
        cat("XXX:", "\n")
        print(summary(XXX[selection, gr.selX]))
    }
    cat("\n")
    cat("************************************", "\n")
}
"grasp.validate" <-
function ()
{
    STEPMODEL <- gam.start
    OPTIONS$CVGROUPS <- 5
    assign("OPTIONS", OPTIONS, pos = 1)
    Yname <- names(YYY)[gr.Yi]
    cat("RESPONSE NAME: ", Yname, "\n")
    par(mfrow = c(2, 2), mai = c(0.75, 0.75, 0.75, 0.75))
    subsets <- rep(1:OPTIONS$CVGROUPS, length.out = length(XXX[, 1]))
    temppredict <- rep(NA, length(XXX[, 1]))
    assign("temppredict", temppredict, pos = 1)
    for (Nloop in 1:OPTIONS$CVGROUPS) {
        OPTIONS$SUBSET1 <- subsets != Nloop
	if (OPTIONS$CVGROUPS ==1)
		OPTIONS$SUBSET1 <- !OPTIONS$SUBSET1
	OPTIONS$SUBSET1 <- (as.logical(gr.modmask[, gr.Yi]) & OPTIONS$SUBSET1)		
        tempmodel <- update(STEPMODEL)
	if (OPTIONS$CVGROUPS ==1)
		OPTIONS$SUBSET2 <- OPTIONS$SUBSET1
	else OPTIONS$SUBSET2 <- (as.logical(gr.modmask[, gr.Yi]) & !OPTIONS$SUBSET1)		
        temppredict[OPTIONS$SUBSET2] <- predict.gam(tempmodel, XXX[OPTIONS$SUBSET2,], type = "response")
    }
    temp1 <- YYY[!is.na(temppredict), gr.Yi]
    temp2 <- temppredict[!is.na(temppredict)]
    plot(temp1, temp2, ylab = "cross-predicted", xlab = paste("observed ", Yname), pch = "*")
    BIN <- gam.start$family[1] == "quasibinomial"
    if (BIN)
    	if (BIN) {
		nbgroups <- 10
		cvROC <- grasp.roc(temp2, temp1)
		legend(min(YYY[!is.na(YYY[, gr.Yi]), gr.Yi]), max(temp2), paste("N groups : ", OPTIONS$CVGROUPS, ", cvROC =", zapsmall(cvROC$auc, 2)), cex = 0.7)
	}
	else
	{
		legend(min(YYY[!is.na(YYY[, gr.Yi]), gr.Yi]), max(temp2), paste("N groups : ", OPTIONS$CVGROUPS, ", cvROC =", zapsmall(cor(temp1, temp2), 2)), cex = 0.7)
	}
    STEPMODEL.local <- STEPMODEL
    STEPMODEL.local[[gr.Yi]]$crosspred <- temppredict
    assign("STEPMODEL", STEPMODEL.local, pos = 1)
    title("CROSS-VALIDATION", cex = 0.5)
    CVGROUPS <- 1
    subsets <- rep(1:CVGROUPS, length.out = length(XXX[, 1]))
    temppredict <- rep(NA, length(XXX[, 1]))
    for (Nloop in 1:CVGROUPS) {
        OPTIONS$SUBSET1 <- subsets != Nloop
        if (CVGROUPS == 1) 
            OPTIONS$SUBSET1 <- !OPTIONS$SUBSET1
	OPTIONS$SUBSET1 <- (as.logical(gr.modmask[, gr.Yi]) & OPTIONS$SUBSET1)	
        assign("OPTIONS", OPTIONS, pos = 1)
        tempmodel <- update(STEPMODEL)
        if (CVGROUPS == 1) 
            OPTIONS$SUBSET2 <- OPTIONS$SUBSET1
        else OPTIONS$SUBSET2 <- (as.logical(gr.modmask[, gr.Yi]) & !OPTIONS$SUBSET1)
        assign("OPTIONS", OPTIONS, pos = 1)
        temppredict[OPTIONS$SUBSET2] <- predict.gam(tempmodel, XXX[OPTIONS$SUBSET2, ], type = "response")
    }
    temp1 <- YYY[!is.na(temppredict), gr.Yi]
    temp2 <- temppredict[!is.na(temppredict)]
    plot(temp1, temp2, ylab = "predicted", xlab = paste("observed ", Yname), pch = "*")
    if (BIN)
    	if (BIN) {
		nbgroups <- 10
		ROC <- grasp.roc(temp2, temp1)
		legend(min(YYY[!is.na(YYY[, gr.Yi]), gr.Yi]), max(temp2), paste("N groups : ", CVGROUPS, ", ROC =", zapsmall(ROC$auc, 2)), cex = 0.7)
	}
	else
	{
		legend(min(YYY[!is.na(YYY[, gr.Yi]), gr.Yi]), max(temp2), paste("N groups : ", CVGROUPS, ", ROC =", zapsmall(cor(temp1, temp2), 2)), cex = 0.7)
	}
    COR <- cor(temp1, temp2)
    if (exists("DROP.CONTRIB")) {
        DROP.CONTRIB <- DROP.CONTRIB
        endline <- length(gr.selX) + 7
        DROP.CONTRIB[endline + 1, gr.Yi] <- COR
        DROP.CONTRIB[endline + 2, gr.Yi] <- cvCOR
        row.names(DROP.CONTRIB)[c(endline + 1, endline + 2)] <- c("Cor", "cvCor")
        dump(c("DROP.CONTRIB", "ALONE.CONTRIB"), fileout = paste(OPTIONS$PATH, "contributions.txt", sep = ""))
        assign("DROP.CONTRIB", DROP.CONTRIB, pos = 1)
    }
    title("VALIDATION", cex = 0.5)
    qqnorm(resid(gam.start))
    cat("\n")
    cat(" ********** GRASP VALIDATE END ********** ", "\n")
    cat("\n")
}
