/*- This file is part of the RKWard project (https://rkward.kde.org).
SPDX-FileCopyrightText: by Thomas Friedrichsmeier <thomas.friedrichsmeier@kdemail.net>
SPDX-FileContributor: The RKWard Team <rkward@kde.org>
SPDX-License-Identifier: GPL-2.0-or-later
*/
function preview() {
	doPrintout(false);
}

function printout() {
	doPrintout(true);
}

function doPrintout(full) {
	var grouped_mode = getValue("data_mode_grouped.numeric");
	var dodged = grouped_mode && getValue("dodges");
	var names_mode = getValue("names_mode");
	var do_mean = getValue("mean.checked");
	var pch_mean = getValue("pch_mean");
	var do_sd = getValue("sd.checked");
	var pch_sd_high = getValue("pch_sd_high");
	var pch_sd_low = getValue("pch_sd_low");
	var horizontal = getValue("orientation") == "TRUE";
	var boxwex = getValue("boxwex");
	if (!dodged && (Number(boxwex) != .8)) boxwex = ", boxwex=" + boxwex;
	else boxwex = "";
	var positions = "";

	if (grouped_mode) {
		var groups_a = getValue("groups").split("\n");
		var n_dodges = getValue("dodges");
		var dodges = groups_a.slice(0, n_dodges);
		var groups = groups_a.slice(n_dodges);
		echo('groups <- rk.list (' + dodges.concat(groups).join(", ") + ')\n');
		echo('data_list <- split (' + getValue("outcome") + ', groups)		');
		comment('split sample by grouping variables');
		if (dodged) {
			comment('adjust width and position of boxes to achieve dodging');
			echo('dodge_size <- nlevels (interaction (' + dodges.join(", ") + '))\n');
			echo('box_width <- ' + getValue("boxwex") + ' / dodge_size\n');
			boxwex = ', boxwex=box_width';
			echo('box_positions <- (rep (1:(length (data_list) / dodge_size), each=dodge_size) + (1:dodge_size)*(box_width))\n')
			positions = ', at=box_positions, xlim=c(min(box_positions)-box_width, max(box_positions)+box_width)';
		}
	} else {
		echo('data_list <- rk.list (' + getValue("x").split("\n").join(", ") + ')		');
		comment('convert single sample variables to list');
	}
	if (names_mode == "rexp") {
		echo("names(data_list) <- " + getValue("names_exp") + "\n");
	} else if (names_mode == "custom") {
		echo("names(data_list) <- c (\"" + str_replace(";", "\", \"", trim(getValue("names_custom"))) + "\")\n");
	}

	if (full) {
		if (grouped_mode) {
			new Header(i18n("Boxplot")).add(i18n("Outcome variable"), noquote('rk.get.description (' + getValue("outcome") + ')')).add(i18n("Grouping variable(s)"), noquote("paste (names (groups), collapse=\", \")")).print();
		} else {
			new Header(i18n("Boxplot")).add(i18n("Variable(s)"), noquote("paste (names (data_list), collapse=\", \")")).print();
		}
		echo('rk.graph.on()\n');
	}

	echo('try ({\n');
	printIndentedUnlessEmpty("\t", getValue("plotoptions.code.preprocess"), '', '\n');

	echo('	boxplot (data_list' + boxwex + positions + ', notch = ' + getValue("notch") + ', outline = ' + getValue("outline") + ', horizontal = ' + getValue("orientation") + getValue("plotoptions.code.printout") + ') ');
	comment("actual boxplot function");
	if (do_mean) {
		var mean_fun = "mean, na.rm=TRUE";
		if (getValue("type_of_mean") == "geometric_mean") {
			echo('	geo_mean <- function (x) {prod(na.omit(x))^(1/length(na.omit(x)))}	');
			comment('Calculate geometric mean');
			mean_fun = "geo_mean";
		} else if (getValue("type_of_mean") == "harmonic_mean") {
			echo('	har_mean <- function (x) {(1 / mean(1 / na.omit(x)))}	');
			comment('Calculate harmonic mean');
			mean_fun = "har_mean";
		} else if (getValue("type_of_mean") == "interquartile_mean") {
			echo('	interq_mean <- function (x) {sum(quantile(x, probs=c(0.25), na.rm=TRUE), quantile(x, probs=c(0.75), na.rm=TRUE)) / 2}	');
			comment('Calculate the interquartile mean');
			mean_fun = "interq_mean";
		} else {                          // arithmetic mean
			var trimp = getValue("trim"); // NOTE: avoid name clash with utility function trim()!
			if (trimp != 0) mean_fun += ", trim=" + trimp;
		}

		if (horizontal) {
			echo('	points(1:length(data_list) ~ sapply(data_list, ' + mean_fun + '), pch=' + pch_mean + ', cex = ' + getValue("cex_sd_mean") + getValue("sd_mean_color.code.printout") + ') ');
			comment('calculates the mean for all data and adds a point at the corresponding position');
		} else {
			echo('	points(sapply(data_list, ' + mean_fun + '), pch=' + pch_mean + ', cex = ' + getValue("cex_sd_mean") + getValue("sd_mean_color.code.printout") + ') ');
			comment('calculates the mean for all data and adds a point at the corresponding position');
		}
	}

	if (do_sd) {
		echo('	sd_low <- (sapply(data_list, mean, na.rm = TRUE)) - (sapply(data_list,sd,na.rm = TRUE))\n');
		echo('	sd_high <- (sapply(data_list, mean, na.rm = TRUE)) + (sapply(data_list,sd,na.rm = TRUE))\n');
		if (horizontal) {
			echo('	points(1:length(data_list) ~ sd_low, pch=' + pch_sd_low + ', cex = ' + getValue("cex_sd_mean") + getValue("sd_mean_color.code.printout") + ')\n');
			echo('	points(1:length(data_list) ~ sd_high, pch=' + pch_sd_high + ', cex = ' + getValue("cex_sd_mean") + getValue("sd_mean_color.code.printout") + ')\n');
		} else {
			echo('	points(sd_low, pch=' + pch_sd_low + ', cex = ' + getValue("cex_sd_mean") + getValue("sd_mean_color.code.printout") + ')\n');
			echo('	points(sd_high, pch=' + pch_sd_high + ', cex = ' + getValue("cex_sd_mean") + getValue("sd_mean_color.code.printout") + ')\n');
		}
	}

	printIndentedUnlessEmpty("\t", getValue("plotoptions.code.calculate"), '\n');
	echo('})\n'); // end of try ()

	if (full) {
		echo('rk.graph.off ()\n');
	}
}
