# Functions accompanying the paper
# Kozak M, Wnuk A, Krzanowski WJ (2010) 'A simple R function for inspecting multivariate data',
# Communications in Biometry and Crop Science 5(1), 34-40
#
# Refer to the paper above and visit http://agrobiol.sggw.waw.pl/~cbcs/articles/5_1_6/demo_www.R to see how they work.

cat("Based on:\nKozak M, Wnuk A, Krzanowski WJ (2010) \'A simple R function for inspecting multivariate data',\n Communications in Biometry and Crop Science 5(1), 34-40\n")
require(hwriter)

symb.mv <- function(x, grouping.variables = NULL, 
    cols.for.order = 1:ncol(x), ord.method = "sum.abs", cutoff = NULL,
    ...) {
    if (nrow(x) < 2) stop("The matrix must have at least two cases")
	rn <- rownames(x)
    x <- trunc(scale(x))
    if (is.null(cutoff) == F) {
		sums <- rowSums(abs(x))
		o <- which(sums >= cutoff)
		if (length(o) < 2) {
		 info <- ifelse(length(o) == 0, "No cases", "Only one case")
		info <- paste(info, "left after applying this cutoff value\n")
		cat(info)
		if (length(o) == 1) {
			if (is.null(grouping.variables) == F) x.print <- c(as.character(x[o,]), as.character(grouping.variables[o, ]))
    		print(x.print, quote = F)}
		stop("Please change the cutoff value")
		} 
		x <- x[o,]
	}	
			
	if (is.null(cols.for.order)) {o <- 1:nrow(x) }
		else if (length(cols.for.order) == 1) {
        if (ord.method == "sum.abs") 
            o <- rev(order(abs(x[, cols.for.order])))
				else o <- rev(order(x[, cols.for.order]))
    }
    else if (ord.method == "sum.abs") 
        {o <- rev(order(rowSums(abs(x[, cols.for.order]), na.rm = TRUE)))} else 
			o <- rev(order(rowSums(x[, cols.for.order], na.rm = TRUE)))
    x <- x[o, ]
    rownames(x) <- rn[o]
	x[x < -20] <- -20; x[x > 20] <- 20
    sr <- symnum(x, cutpoints = c((-21:-1) + 0.001, (1:21) - 
        0.001), symbols = c(-20:-1, "", 1:20), legend = F, ...)
    srr <- data.frame(matrix(as.character(sr), byrow = F, ncol = ncol(sr)))
    if (is.null(grouping.variables) == F) 
        srr <- cbind(srr, grouping.variables[o, ])
    colnames(srr) <- c(attributes(sr)$dimnames[[2]], colnames(grouping.variables))
    rownames(srr) <- rownames(x)
    print(srr)
    if (any(srr == "?")) 
        cat("NOTE: \"?\" indicates a missing value.\n")
    invisible(srr)
}

symb.mv.www <- function(x, grouping.variables = NULL, 
    cols.for.order = 1:ncol(x), ord.method = "sum.abs", 
    css = "http://agrobiol.sggw.waw.pl/~cbcs/articles/5_1_6/css_MK_CBCS.css", ...) {
    a <- symb.mv(x, grouping.variables, cols.for.order, ord.method, 
        ...)
    aa <- as.matrix(a)
    rownames(aa) <- rownames(a)
    colnames(aa) <- colnames(a)
    p <- openPage("symb.html", title = "Symbolic representation of\nmultivariate data", 
        link.css = css)
    if (any(aa == "?")) 
        hwrite("\"?\" indicates a missing value", p, br = T)
    hwrite("<br><br>", p)
    hwrite(aa, p, border = 0)
    if (any(aa == "?")) 
        hwrite("\"?\" indicates a missing value", p, br = T)
    hwrite("<br>Based on Kozak M., Wnuk A., Krzanowski W.J. (2010). A simple R function for inspecting multivariate data. Communications in Biometry and Crop Science 5 (1), 34-40", 
        p, br = T)
    closePage(p, splash = F)
    if (interactive()) 
        try(browseURL(file.path(paste(getwd(), "/symb.html", 
            sep = ""))))
    else print(paste("Open the URL from", paste(getwd(), "/symb.html", 
        sep = "")))
}