.packageName <- "grnnR"
"compute_SIGMA" <-
function (C) {

    # INITIALIZATION

    n <- dim (C)[2];

    # MAIN

    dist1 <- abs (2*max ( max (C), min (C)));
    SIGMA <- dist1 / ( sqrt (2*n));

    # RESULTS

    rslt <- list (SIGMA=SIGMA);

}

"grnn" <-
function (P, C, W, SIGMA, BATCH=1) {

    # INITIALIZATION

    n <- dim (C)[2];
    r <- dim (W)[1];

    if (BATCH==1) {

        #   batch mode inits

        N <- dim (P)[2];
        d <- dim (P)[1];
        T_hat <- matrix (nrow=r, ncol=N);

    } else {

        #   on-line mode inits
 
        N <- 1;
        d <- length (P);
        T_hat <- numeric (N);

    }

    # MAIN

    #   present pattern(s), compute output
 
    for (j in 1:N) {

        #   initialize parameters

        if (BATCH==1) {

            p <- P[ ,j];

        } else {

            p <- P;

        }

        s <- 0;
        expRes <- numeric (n);

        #   compute summation neuron output

        for (i in 1:n) {

            normArg <- (p - C[ ,i]);
            normRes <- drop ( sqrt (normArg %*% normArg));
            expArg <- (-(normRes / SIGMA^2));
            expRes[i] <- exp (expArg);
            s <- s + expRes[i];

        }

        rbf_Out <- numeric (r);

        #   compute numerator

        for (i in 1:n) {

            sumArg <- expRes[i] * W[ ,i];
            rbf_Out <- rbf_Out + sumArg;

        }

        #   compute output

        if (BATCH==1) {

            T_hat[ ,j] <- rbf_Out / s;

        } else {

            T_hat <- rbf_Out / s;

        }

    }

    # RESULTS

    rslt <- list (T_hat=T_hat);
    
}

"grnn_Train" <-
function (P, T, SIGMA_flag=1, SIGMA_inp=1) {

    # INITIALIZATION

    # MAIN

    #   store training set in network (centers, weights)

    C <- P;
    W <- T;

    #   if required (SIGMA_flag=1), compute spread, SIGMA

    if (SIGMA_flag==1) {

        SS <- compute_SIGMA (C);
        SIGMA <- SS$SIGMA;

    } else {

        SIGMA <- SIGMA_inp;
    }

    # RESULTS

    rslt <- list (C=C, W=W, SIGMA=SIGMA);

}

"mean_center_X" <-
function (X) {
  
    # INITIALIZATION

    d <- dim (X)[1];
    X_mc <- X;
    mn_Vect <- numeric (d);

    # MAIN

    #   for each variable, subtract row mean from each element

    for (k in 1:d) {

        mn_Vect[k] <- mean ( unlist (X[k, ]));
        X_mc[k, ] <- unlist (X[k, ]) - mn_Vect[k];

    }

    # RESULTS

    rslt <- list (X_mc=X_mc, mn_Vect=mn_Vect);

}

"plot_Box" <-
function (T, T_hat, NOVAL=NA) {

    # INITIALIZATION

    ERR <- abs (T-T_hat);
    ERR [is.na(ERR)] <- NOVAL;
    m <- min (ERR);  
    n <- max (ERR);

    # MAIN

    box1 <- boxplot (ERR, plot=FALSE);

        l1 <- box1$n;
        l2 <- box1$stats[1,1];
        l3 <- box1$stats[2,1];
        l4 <- box1$stats[3,1];
        l5 <- box1$stats[4,1];
        l6 <- box1$stats[5,1];
        l7 <- box1$conf[1,1];
        l8 <- box1$conf[2,1];
        l9 <- max (box1$out);

        box1stats1 <- prettyNum ( c(l3, l4, l5, l6, max (T)), trim=TRUE, 
                digits=3);
        box1text1 <- c("- lower hinge", "- median", "- upper hinge", 
                "- upper wisker extreme");
        box1stats2 <- prettyNum ( c(l1, l2, l7, l8), trim=TRUE, digits=3);
        box1text2 <- c("observations: ", "lwr wisk extrm: ", "lwr notch: ", 
                "upr notch: ");   


    bxp1 <- bxp (box1, notch=FALSE, boxwex=0.2, axes=FALSE);

    box ();

        axis (2, at=box1stats1, labels=TRUE, tick=TRUE, cex.axis=0.6, las=2);
        mtext ( paste ("NOVAL parameter = ", NOVAL), side=3, adj=0.5, cex=0.6);
        text (x= c(1.1,1.1,1.1,1.1), y= c(l3,l4,l5,l6), labels=box1text1, 
                cex=0.6, xpd=NA, pos=4);
                legMatrix <- matrix ( t( c(box1text2, box1stats2)), nrow=4, 
                        ncol=2, byrow=FALSE );
        legend ( 1.1, y=l9, legend=legMatrix, pch=NULL, bty="n", ncol=2, 
                xjust=1, y.intersp=0.9, cex=0.6 );
        title ( "grnnR test-error box/whisker plot" );

}

"plot_Targets" <-
function (T, T_hat, BATCH) {

    # INITIALIZATION

    if (BATCH==1) {

        r <- dim (T_hat)[1];
        m <- dim (T_hat)[2];

    } else {

        r <- length (T);
        m <- 1;

    }

    # MAIN
  
    A1 <- range (T);
    A2 <- range (T_hat);
    a <- min ( c(A1[1], A2[1]));
    b <- max ( c(A1[2], A2[2]));
    p <- 1;
    x <- seq (from=a, to=b, length.out=2);

    plot (x, x, , xlab="Target value", ylab="grnnR estimate", type="n");

        lines (x, x, col="gray");

        for (i in 1:r){

            if (BATCH==1) {

                points ( unlist (T[i, ]), unlist (T_hat[i, ]), pch=p);
                legend (a, (b-((i-1)*par ("cxy")[2])), 
                        paste ("- dimension ", i), bty="n", pch=p, cex=0.6);

            } else {

                points (T[i], T_hat[i], pch=p);

            }

        p=p+1;

        if (p>25) p=1;

        }

    mtext ( paste ("Total Nr targets = ", r*m), side=3, adj=0.5, cex=0.8);
    title ("Test data targets vs. grnnR estimates");

}

"test_Stats" <-
function (T, T_hat, NOVAL=NA) {

    # INITIALIZATION

    ERR <- abs (T-T_hat);
    ERR [is.na(ERR)] <- NOVAL;
    m <- dim (ERR)[1];  
    n <- dim (ERR)[2];

    # MAIN

    par (mfrow= c(2,2));

        plot_Targets (T, T_hat, 1);

        plot_Box (T, T_hat, NOVAL);

        hist1 <- hist (ERR, probability=FALSE);

        stats1 <- density (ERR);
        plot (stats1);

    dev.print (device=postscript, "grnnR_plot.eps", onefile=FALSE, 
        horizontal=FALSE, paper="special");
 
    par (mfrow= c(1,1));

}

"var_scale_X" <-
function (X) {

    # INITIALIZATION

    d <- dim (X)[1];
    X_var <- X;
    var_Vect <- numeric (d);

    # MAIN

    #   divide row elements by std. dev. of variable (row)

    for (k in 1:d) {

        var_Vect[k] <- var ( unlist (X[k, ]));
        X_var[k, ] <- unlist (X[k, ]) / var_Vect[k];
 
    }

    # RESULTS

    rslt <- list (X_var=X_var, var_Vect=var_Vect);

}

