/* OTAny.c
 *
 * Copyright (C) 1997-2002 Paul Boersma
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * See the GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 * pb 2001/08/02
 * pb 2002/07/16 GPL
 */

#include "OTAny.h"
#include "longchar.h"

#include "oo_DESTROY.h"
#include "OTAny_def.h"
#include "oo_COPY.h"
#include "OTAny_def.h"
#include "oo_EQUAL.h"
#include "OTAny_def.h"
#include "oo_WRITE_ASCII.h"   /* Needed for only some types... */
#include "OTAny_def.h"
#include "oo_READ_ASCII.h"
#include "OTAny_def.h"
#include "oo_WRITE_BINARY.h"
#include "OTAny_def.h"
#include "oo_READ_BINARY.h"
#include "OTAny_def.h"
#include "oo_DESCRIPTION.h"
#include "OTAny_def.h"

/* class OTConstraint */

static void classOTConstraint_info (I) {
	iam (OTConstraint);
	Melder_info ("Which: %d\nRanking: %f", my which, my ranking);
}

class_methods (OTConstraint, Data)
	class_method_local (OTConstraint, destroy)
	class_method_local (OTConstraint, description)
	class_method_local (OTConstraint, copy)
	class_method_local (OTConstraint, equal)
	class_method_local (OTConstraint, writeAscii)
	class_method_local (OTConstraint, readAscii)
	class_method_local (OTConstraint, writeBinary)
	class_method_local (OTConstraint, readBinary)
	class_method_local (OTConstraint, info)
class_methods_end

OTConstraint OTConstraint_create (int which, double ranking) {
	OTConstraint me = new (OTConstraint);
	if (! me) return NULL;
	my which = which;
	my ranking = ranking;
	return me;
}

/* class OTAnyGrammar */

static void classOTAnyGrammar_info (I) {
	iam (OTAnyGrammar);
	Melder_info ("Number of constraints: %ld", my constraints ? my constraints -> size : 0);
}

static int writeAscii (I, FILE *f) {
	iam (OTAnyGrammar);
	ascputi4 (my constraints ? my constraints -> size : 0, f, "constraints: size");
	if (my constraints) {
		long i;
		for (i = 1; i <= my constraints -> size; i ++) {
			char name [100], *q = & name [0];
			const char *p;
			OTConstraint constraint = my constraints -> item [i];
			ascputintro (f, "constraints [%ld]:", i);
			ascputi2 (constraint -> which, f, "which");
			name [0] = '\0';
			for (p = our constraintNames (me) [constraint -> which]; *p; p ++) {
				if (*p == '\n')
					*q++ = ' ';
				else if (*p == '\\' && p [1] == 's' && p [2] == '{')
					p += 2;
				else if (*p == '}')
					;
				else
					*q++ = *p;
			}
			*q = '\0';
			fprintf (f, " ! %s", name);
			ascputr8 (constraint -> ranking, f, "ranking");
			ascputr8 (constraint -> disharmony, f, "disharmony");
			ascexdent ();
		}
	}
	return 1;
}

static const char** constraintNames (I) {
	static const char *names [] = { "", NULL};
	(void) void_me;
	return & names [0];
}

static int evaluate (I, int which, const char *input, const char *output, long icand_hint) {
	(void) void_me;
	(void) which;
	(void) input;
	(void) output;
	(void) icand_hint;
	return 0;
}

static long gen (I, thou, const char *input) {
	(void) void_me;
	(void) void_thee;
	(void) input;
	return 0;
}

static void generateInput (I, char input []) {
	(void) void_me;
	(void) input;
}

static int locallyRanked (I, int c1, int c2) {
	(void) void_me;
	(void) c1;
	(void) c2;
	return 0;
}

class_methods (OTAnyGrammar, Data)
	class_method_local (OTAnyGrammar, destroy)
	class_method_local (OTAnyGrammar, description)
	class_method_local (OTAnyGrammar, copy)
	class_method_local (OTAnyGrammar, equal)
	class_method (writeAscii)
	class_method_local (OTAnyGrammar, readAscii)
	class_method_local (OTAnyGrammar, writeBinary)
	class_method_local (OTAnyGrammar, readBinary)
	class_method_local (OTAnyGrammar, info)
	class_method (constraintNames)
	class_method (evaluate)
	class_method (gen)
	class_method (generateInput)
	class_method (locallyRanked)
class_methods_end

OTAnyGrammar OTAnyGrammar_create (void *klas) {
	int icons;
	OTAnyGrammar me = Thing_new (klas); cherror
	my constraints = Ordered_create (); cherror
	for (icons = 1; our constraintNames (me) [icons]; icons ++) {
		OTAnyGrammar_addConstraint (me, icons, 100.0); cherror
	}
end:
	iferror forget (me);
	return me;
}

const char * OTAnyGrammar_constraintName (OTAnyGrammar me, int which) {
	return our constraintNames (me) [which];
}

int OTAnyGrammar_addConstraint (OTAnyGrammar me, int which, double ranking) {
	OTConstraint constraint = OTConstraint_create (which, ranking); cherror
	Collection_addItem (my constraints, constraint); cherror
end:
	iferror return 0;
	return 1;
}

static void newDisharmonies (OTAnyGrammar me, double spreading) {
	int i, n = my constraints -> size;
	OTConstraint *c = (OTConstraint *) my constraints -> item;
	for (i = 1; i <= n; i ++) c [i] -> disharmony = c [i] -> ranking + NUMrandomGauss (0, spreading)
		/*NUMrandomUniform (-spreading, spreading)*/;
}

static void sortByDisharmonies (OTAnyGrammar me) {
	int i, j, n = my constraints -> size;
	OTConstraint *c = (OTConstraint *) my constraints -> item, dummy;
	for (i = 1; i < n; i ++) {
		double maximum = c [i] -> disharmony;
		int jmax = i;
		for (j = i + 1; j <= n; j ++) {
			double disharmonyj = c [j] -> disharmony;
			if (disharmonyj > maximum || disharmonyj == maximum && NUMrandomInteger (1, 2) == 2) {
				maximum = disharmonyj;
				jmax = j;
			}
		}
		dummy = c [i]; c [i] = c [jmax]; c [jmax] = dummy;   /* Swap. */
	}
}

void OTAnyGrammar_sort (OTAnyGrammar me, double spreading) {
	newDisharmonies (me, spreading);
	sortByDisharmonies (me);
}

int OTAnyGrammar_evaluateConstraint (OTAnyGrammar me, int which, const char *input, const char *output, long icand_hint) {
	return our evaluate (me, which, input, output, icand_hint);
}

/* class OTAnyTableau */

static void classOTAnyTableau_info (I) {
	iam (OTAnyTableau);
	Melder_info ("Number of constraints: %ld\nNumberOfCandidates: %ld",
		my numberOfConstraints, my numberOfCandidates);
}

class_methods (OTAnyTableau, Data)
	class_method_local (OTAnyTableau, destroy)
	class_method_local (OTAnyTableau, description)
	class_method_local (OTAnyTableau, copy)
	class_method_local (OTAnyTableau, equal)
	class_method_local (OTAnyTableau, writeAscii)
	class_method_local (OTAnyTableau, readAscii)
	class_method_local (OTAnyTableau, writeBinary)
	class_method_local (OTAnyTableau, readBinary)
	class_method_local (OTAnyTableau, info)
class_methods_end

OTAnyTableau OTAnyGrammar_to_Tableau (OTAnyGrammar me, const char *input) {
	OTAnyTableau thee = new (OTAnyTableau);
	long icand, icons;
	cherror
	thy input = Melder_strdup (input); cherror
	thy grammar = Data_copy (me); cherror
	thy candidates = NUMpvector (1, 1000); cherror
	thy numberOfCandidates = our gen (me, thee, input); cherror
	if (thy numberOfCandidates < 1) { Melder_error ("(OTAnyGrammar_to_Tableau:) GEN found no candidates for input \"%s\".", input); goto end; }
	thy numberOfConstraints = my constraints -> size;
	thy marks = NUMimatrix (1, thy numberOfCandidates, 1, thy numberOfConstraints); cherror
	for (icand = 1; icand <= thy numberOfCandidates; icand ++) for (icons = 1; icons <= thy numberOfConstraints; icons ++) {
		OTConstraint constraint = thy grammar -> constraints -> item [icons];
		thy marks [icand] [icons] = OTAnyGrammar_evaluateConstraint
			(thy grammar,  constraint -> which, input, thy candidates [icand], icand);
	}
end:
	iferror forget (thee);
	return thee;
}

static OTAnyTableau OTAnyGrammar_to_Tableau_simple (OTAnyGrammar me, const char *input) {
	OTAnyTableau thee = new (OTAnyTableau);
	long icand, icons;
	cherror
	thy input = Melder_strdup (input); cherror
	thy candidates = NUMpvector (1, 1000); cherror
	thy numberOfCandidates = our gen (me, thee, input); cherror
	if (thy numberOfCandidates < 1) { Melder_error ("(OTAnyGrammar_to_Tableau:) GEN found no candidates for input \"%s\".", input); goto end; }
	thy numberOfConstraints = my constraints -> size;
	thy marks = NUMimatrix (1, thy numberOfCandidates, 1, thy numberOfConstraints); cherror
	for (icand = 1; icand <= thy numberOfCandidates; icand ++) for (icons = 1; icons <= thy numberOfConstraints; icons ++) {
		OTConstraint constraint = my constraints -> item [icons];
		thy marks [icand] [icons] = OTAnyGrammar_evaluateConstraint
			(me,  constraint -> which, input, thy candidates [icand], icand);
	}
end:
	iferror forget (thee);
	return thee;
}

long OTAnyTableau_getWinner (OTAnyTableau me) {
	long best = 1, icand, icons;
	if (my numberOfCandidates < 1) return 0;
	for (icand = 2; icand <= my numberOfCandidates; icand ++) {
		int *bestMarks = my marks [best], *currentMarks = my marks [icand];
		for (icons = 1; icons <= my numberOfConstraints; icons ++) {
			if (bestMarks [icons] < currentMarks [icons]) break;
			if (bestMarks [icons] > currentMarks [icons]) { best = icand; break; }
		}
	}
	return best;
}

static int OTAnyTableau_crucialCell (OTAnyTableau me, long icand, long winner) {
	int icons;
	if (my numberOfCandidates < 2) return 0;
	if (icand == winner) {
		long secondBest = winner == 1 ? 2 : 1;
		for (icand = 1; icand <= my numberOfCandidates; icand ++) if (icand != winner) {
			int *secondBestMarks = my marks [secondBest], *currentMarks = my marks [icand];
			for (icons = 1; icons <= my numberOfConstraints; icons ++) {
				if (secondBestMarks [icons] < currentMarks [icons]) break;
				if (secondBestMarks [icons] > currentMarks [icons]) { secondBest = icand; break; }
			}
		}
		return OTAnyTableau_crucialCell (me, secondBest, winner);
	} else {
		for (icons = 1; icons <= my numberOfConstraints; icons ++)
			if (my marks [icand] [icons] > my marks [winner] [icons])
				return icons;
	}
	return my numberOfConstraints + 1;
}

static double OTAnyGrammar_constraintWidth (OTAnyGrammar me, Graphics g, int which) {
	char text [100], *newLine;
	strcpy (text, OTAnyGrammar_constraintName (me, which));
	newLine = strchr (text, '\n');
	if (newLine) {
		double firstWidth, secondWidth;
		*newLine = '\0';
		firstWidth = Graphics_textWidth (g, text);
		secondWidth = Graphics_textWidth (g, newLine + 1);
		return firstWidth > secondWidth ? firstWidth : secondWidth;
	}
	return Graphics_textWidth (g, text);
}

void OTAnyTableau_draw (OTAnyTableau me, Graphics g) {
	long icand, icons, imark, winner;
	double candWidth, margin, fingerWidth, doubleLineDx, doubleLineDy;
	double tableauWidth, rowHeight, headerHeight, descent, x, y;
	char text [200];
	Graphics_setWindow (g, 0.0, 1.0, 0.0, 1.0);
	margin = Graphics_dxMMtoWC (g, 1.0);
	fingerWidth = Graphics_dxMMtoWC (g, 7.0);
	doubleLineDx = Graphics_dxMMtoWC (g, 0.9);
	doubleLineDy = Graphics_dyMMtoWC (g, 0.9);
	rowHeight = Graphics_dyMMtoWC (g, 1.5 * Graphics_inqFontSize (g) * 25.4 / 72);
	descent = rowHeight * 0.5;
	winner = OTAnyTableau_getWinner (me);
	/*
	 * Compute height of header row.
	 */
	headerHeight = rowHeight;
	for (icons = 1; icons <= my numberOfConstraints; icons ++) {
		OTConstraint constraint = my grammar -> constraints -> item [icons];
		if (strchr (OTAnyGrammar_constraintName (my grammar, constraint -> which), '\n')) {
			headerHeight *= 1.6;
			break;
		}
	}
	/*
	 * Compute longest candidate string.
	 */
	candWidth = Graphics_textWidth (g, my input) + Graphics_textWidth (g, "//");
	for (icand = 1; icand <= my numberOfCandidates; icand ++) {
		double width = Graphics_textWidth (g, my candidates [icand]);
		if (icand == winner) width += fingerWidth;
		if (width > candWidth) candWidth = width;
	}
	candWidth += margin * 2;
	/*
	 * Compute tableau width.
	 */
	tableauWidth = candWidth + doubleLineDx;
	for (icons = 1; icons <= my numberOfConstraints; icons ++) {
		OTConstraint constraint = my grammar -> constraints -> item [icons];
		tableauWidth += OTAnyGrammar_constraintWidth (my grammar, g, constraint -> which);
	}
	tableauWidth += margin * 2 * my numberOfConstraints;
	/*
	 * Draw box.
	 */
	x = doubleLineDx;   /* Left side of tableau. */
	y = 1.0 - doubleLineDy;
	Graphics_rectangle (g, x, x + tableauWidth,
		y - headerHeight - my numberOfCandidates * rowHeight - doubleLineDy, y);
	/*
	 * Draw input.
	 */
	y -= headerHeight;
	Graphics_setTextAlignment (g, Graphics_CENTRE, Graphics_HALF);
	Graphics_printf (g, x + 0.5 * candWidth, y + 0.5 * headerHeight, "/%s/", my input);
	Graphics_rectangle (g, x, x + candWidth, y, y + headerHeight);
	/*
	 * Draw constraint names.
	 */
	x += candWidth + doubleLineDx;
	for (icons = 1; icons <= my numberOfConstraints; icons ++) {
		OTConstraint constraint = my grammar -> constraints -> item [icons];
		const char *constraintName = OTAnyGrammar_constraintName (my grammar, constraint -> which);
		double width = OTAnyGrammar_constraintWidth (my grammar, g, constraint -> which) + margin * 2;
		if (strchr (constraintName, '\n')) {
			char *newLine;
			strcpy (text, constraintName);
			newLine = strchr (text, '\n');
			*newLine = '\0';
			Graphics_setTextAlignment (g, Graphics_CENTRE, Graphics_TOP);
			Graphics_text (g, x + 0.5 * width, y + headerHeight, text);
			Graphics_setTextAlignment (g, Graphics_CENTRE, Graphics_BOTTOM);
			Graphics_text (g, x + 0.5 * width, y, newLine + 1);
		} else {
			Graphics_setTextAlignment (g, Graphics_CENTRE, Graphics_HALF);
			Graphics_text (g, x + 0.5 * width, y + 0.5 * headerHeight, constraintName);
		}
		Graphics_rectangle (g, x, x + width, y, y + headerHeight);
		x += width;
	}
	/*
	 * Draw candidates.
	 */
	y -= doubleLineDy;
	for (icand = 1; icand <= my numberOfCandidates; icand ++) {
		long crucialCell = OTAnyTableau_crucialCell (me, icand, winner);
		/*
		 * Draw candidate transcription.
		 */
		x = doubleLineDx;
		y -= rowHeight;
		Graphics_setTextAlignment (g, Graphics_RIGHT, Graphics_HALF);
		Graphics_text (g, x + candWidth - margin, y + descent, my candidates [icand]);
		if (icand == winner) {
			Graphics_setTextAlignment (g, Graphics_LEFT, Graphics_HALF);
			Graphics_text (g, x + margin, y + descent, "#\\Vr");
		}
		Graphics_rectangle (g, x, x + candWidth, y, y + rowHeight);
		/*
		 * Draw mark cells.
		 */
		x += candWidth + doubleLineDx;
		Graphics_setTextAlignment (g, Graphics_CENTRE, Graphics_HALF);
		for (icons = 1; icons <= my numberOfConstraints; icons ++) {
			OTConstraint constraint = my grammar -> constraints -> item [icons];
			double width = OTAnyGrammar_constraintWidth (my grammar, g, constraint -> which) + margin * 2;
			char markString [40];
			markString [0] = '\0';
			if (icons == crucialCell && icand != winner) {
				int winnerMarks = my marks [winner] [icons];
				for (imark = 1; imark <= winnerMarks + 1; imark ++)
					strcat (markString, "*");
				strcat (markString, "!");
				for (imark = winnerMarks + 2; imark <= my marks [icand] [icons]; imark ++)
					strcat (markString, "*");
			} else {
				for (imark = 1; imark <= my marks [icand] [icons]; imark ++)
					strcat (markString, "*");
			}
			if (icons > crucialCell) {
				Graphics_setGrey (g, 0.9);
				Graphics_fillRectangle (g, x, x + width, y, y + rowHeight);
				Graphics_setGrey (g, 0.0);
			}
			Graphics_text (g, x + 0.5 * width, y + descent, markString);
			Graphics_rectangle (g, x, x + width, y, y + rowHeight);
			x += width;
		}
	}
}

static double demotionStep (double mean, double relativeSpreading) {
	return relativeSpreading == 0.0 ? mean : NUMrandomGauss (mean, relativeSpreading * mean);
}

void OTAnyGrammar_generateOneInput (OTAnyGrammar me, char *input) {
	our generateInput (me, input);
}

Strings OTAnyGrammar_generateInputs (OTAnyGrammar me, long n) {
	Strings inputs = new (Strings);
	long i;
	cherror
	inputs -> numberOfStrings = n;
	inputs -> strings = NUMpvector (1, n); cherror
	for (i = 1; i <= n; i ++) {
		char input [100];
		/*
		 * Generate a random adult underlying form (richness of the base).
		 */
		our generateInput (me, input);
		inputs -> strings [i] = Melder_strdup (input); cherror
	}
end:
	iferror { forget (inputs); return Melder_errorp ("(OTAnyGrammar_generateInputs:) Not performed."); }
	return inputs;
}

int OTAnyGrammar_inputToOutput (OTAnyGrammar me, const char *input, char *output, double rankingSpreading) {
	OTAnyTableau tableau;
	long winner;
	OTAnyGrammar_sort (me, rankingSpreading);
	tableau = OTAnyGrammar_to_Tableau_simple (me, input); cherror
	winner = OTAnyTableau_getWinner (tableau);
	if (! winner) { Melder_error ("No winner"); goto end; }
	strcpy (output, tableau -> candidates [winner]);
end:
	forget (tableau);
	iferror return Melder_error ("(OTAnyGrammar_inputToOutput:) Not performed.");
	return 1;
}

Strings OTAnyGrammar_inputsToOutputs (OTAnyGrammar me, Strings inputs, double rankingSpreading) {
	Strings outputs = new (Strings);
	long i, n = inputs -> numberOfStrings;
	cherror
	outputs -> numberOfStrings = n;
	outputs -> strings = NUMpvector (1, n); cherror
	for (i = 1; i <= n; i ++) {
		char output [100];
		OTAnyGrammar_inputToOutput (me, inputs -> strings [i], output, rankingSpreading); cherror
		outputs -> strings [i] = Melder_strdup (output); cherror
	}
end:
	iferror { forget (outputs); return Melder_errorp ("(OTAnyGrammar_inputsToOutputs:) Not performed."); }
	return outputs;
}

Strings OTAnyGrammar_inputToOutputs (OTAnyGrammar me, const char *input, long n, double rankingSpreading) {
	Strings outputs = new (Strings);
	long i;
	cherror
	outputs -> numberOfStrings = n;
	outputs -> strings = NUMpvector (1, n); cherror
	for (i = 1; i <= n; i ++) {
		char output [100];
		OTAnyGrammar_inputToOutput (me, input, output, rankingSpreading); cherror
		outputs -> strings [i] = Melder_strdup (output); cherror
	}
end:
	iferror return Melder_errorp ("(OTAnyGrammar_inputToOutputs:) Not performed.");
	return outputs;
}

int OTAnyGrammar_learnOne_ts (OTAnyGrammar me, const char *adultUnderlyingForm, const char *adultOutput) {
	int icons, highestUncancelledWinnerMark;
	double ceiling;
	long winner, loser;
	OTAnyTableau tableau = NULL;
	OTAnyGrammar_sort (me, 0.0);
	/*
	 * Evaluate the input in the learner's hypothesis.
	 */
	tableau = OTAnyGrammar_to_Tableau_simple (me, adultUnderlyingForm);
	winner = OTAnyTableau_getWinner (tableau);

	/*
	 * Error-driven: compare the adult winner (the correct candidate) and the learner's winner.
	 */
	if (strequ (tableau -> candidates [winner], adultOutput)) goto end;
	/*
	 * Now we know that the current hypothesis prefers the (wrong) learner's winner over the (correct) adult output.
	 * The grammar will have to change.
	 */

	/*
	 * Find adult winner in own tableau.
	 */
	for (loser = 1; loser <= tableau -> numberOfCandidates; loser ++)
		if (strequ (tableau -> candidates [loser], adultOutput)) break;
	if (loser > tableau -> numberOfCandidates)
		{ Melder_error ("Cannot generate adult output \"%s\".", adultOutput); goto end; }

	/*
	 * Demote all adult-winner constraints that are not lower than the highest uncancelled learner-winner mark.
	 */
	for (icons = 1; icons <= my constraints -> size; icons ++)
		if (tableau -> marks [winner] [icons] > tableau -> marks [loser] [icons]) break;
	if (icons > my constraints -> size)
		{ Melder_error ("(OTAnyGrammar_step:) Conflicting data."); goto end; }
	highestUncancelledWinnerMark = icons;
	ceiling = ((OTConstraint) my constraints -> item [highestUncancelledWinnerMark]) -> ranking;
	/*
	 * Demote all constraints with uncancelled correct-adult-output marks not below 'ceiling'.
	 */
	for (icons = 1; icons <= my constraints -> size; icons ++) {
		if (tableau -> marks [loser] [icons] > tableau -> marks [winner] [icons]) {
			OTConstraint constraint = my constraints -> item [icons];
			if (constraint -> ranking >= ceiling)
				constraint -> ranking -= 1.0;
		}
	}
	OTAnyGrammar_sort (me, 0.0);
end:
	forget (tableau);
	iferror return 0;
	return 1;
}

int OTAnyGrammar_learnOne_mgla (OTAnyGrammar me, const char *underlyingForm, const char *adultOutput,
	double rankingSpreading, int strategy, int honourLocalRankings,
	double demotionMean, double relativeDemotionSpreading)
{
	int icons, crucialLoserMark;
	long winner, loser;
	OTAnyTableau tableau = NULL;
	OTConstraint offendingConstraint;
	double step;
	OTAnyGrammar_sort (me, rankingSpreading);

	/*
	 * Evaluate the input in the learner's hypothesis.
	 */
	tableau = OTAnyGrammar_to_Tableau_simple (me, underlyingForm); cherror
	winner = OTAnyTableau_getWinner (tableau);

	/*
	 * Error-driven: compare the adult winner (the correct candidate) and the learner's winner.
	 */
	if (strequ (tableau -> candidates [winner], adultOutput)) goto end;

	/*
	 * Find adult winner in own tableau.
	 */
	for (loser = 1; loser <= tableau -> numberOfCandidates; loser ++)
		if (strequ (tableau -> candidates [loser], adultOutput)) break;
	if (loser > tableau -> numberOfCandidates)
		{ Melder_error ("Cannot generate adult output \"%s\".", adultOutput); goto end; }

	/*
	 * Determine the crucial loser mark.
	 */
	for (icons = 1; icons <= my constraints -> size; icons ++) {
		if (tableau -> marks [loser] [icons] < tableau -> marks [winner] [icons])
			{ Melder_error ("(OTAnyGrammar_step:) Loser wins! Can never happen."); goto end; }
		if (tableau -> marks [loser] [icons] > tableau -> marks [winner] [icons]) break;
	}
	if (icons > my constraints -> size)   /* Completed the loop? */
		{ Melder_error ("(OTAnyGrammar_step:) Loser equals correct candidate."); goto end; }
	crucialLoserMark = icons;

	/*
	 * Now we know that the current hypothesis prefers the (wrong) learner's winner over the (correct) adult output.
	 * The grammar will have to change.
	 */
	if (strategy == OTAnyGrammar_SYMMETRIC_ALL) {
		step = demotionStep (demotionMean, relativeDemotionSpreading);
		for (icons = 1; icons <= my constraints -> size; icons ++) {
	 		OTConstraint constraint = my constraints -> item [icons];
			int winnerMarks = tableau -> marks [winner] [icons];
			int loserMarks = tableau -> marks [loser] [icons];
			if (loserMarks > winnerMarks) constraint -> ranking -= step;
			if (winnerMarks > loserMarks) constraint -> ranking += step;
		}
	} else if (strategy == OTAnyGrammar_WEIGHTED_UNCANCELLED) {
		int winningConstraints = 0, losingConstraints = 0;
		step = demotionStep (demotionMean, relativeDemotionSpreading);
		for (icons = 1; icons <= my constraints -> size; icons ++) {
			int winnerMarks = tableau -> marks [winner] [icons];
			int loserMarks = tableau -> marks [loser] [icons];
			if (loserMarks > winnerMarks) losingConstraints ++;
			if (winnerMarks > loserMarks) winningConstraints ++;
		}
		for (icons = 1; icons <= my constraints -> size; icons ++) {
	 		OTConstraint constraint = my constraints -> item [icons];
			int winnerMarks = tableau -> marks [winner] [icons];
			int loserMarks = tableau -> marks [loser] [icons];
			if (loserMarks > winnerMarks) constraint -> ranking -= step / losingConstraints;
			if (winnerMarks > loserMarks) constraint -> ranking += step / winningConstraints;
		}
	} else if (strategy == OTAnyGrammar_WEIGHTED_ALL) {
		int winningConstraints = 0, losingConstraints = 0;
		step = demotionStep (demotionMean, relativeDemotionSpreading);
		for (icons = 1; icons <= my constraints -> size; icons ++) {
			int winnerMarks = tableau -> marks [winner] [icons];
			int loserMarks = tableau -> marks [loser] [icons];
			if (loserMarks > 0) losingConstraints ++;
			if (winnerMarks > 0) winningConstraints ++;
		}
		for (icons = 1; icons <= my constraints -> size; icons ++) {
	 		OTConstraint constraint = my constraints -> item [icons];
			int winnerMarks = tableau -> marks [winner] [icons];
			int loserMarks = tableau -> marks [loser] [icons];
			if (loserMarks > 0) constraint -> ranking -= step / losingConstraints;
			if (winnerMarks > 0) constraint -> ranking += step / winningConstraints;
		}
	} else {
		/*
		 * Demote the highest uniquely violated constraint in the loser.
		 */
		offendingConstraint = my constraints -> item [crucialLoserMark];
		step = demotionStep (demotionMean, relativeDemotionSpreading);
		offendingConstraint -> ranking -= step;
		/*
		 * Promote the highest uniquely violated constraint in the (incorrect) winner.
		 */
		if (strategy == OTAnyGrammar_SYMMETRIC_HIGHEST) {
		 	int highestUncancelledWinnerMark;
		 	OTConstraint highestUncancelledConstraint;
			/*
			 * Search for the highest uncancelled winner mark.
			 */
			for (icons = 1; icons <= my constraints -> size; icons ++)
				if (tableau -> marks [winner] [icons] > tableau -> marks [loser] [icons]) break;
			if (icons > my constraints -> size)
				{ Melder_error ("(OTAnyGrammar_step:) Conflicting data."); goto end; }
			highestUncancelledWinnerMark = icons;
			/*
			 * Promote the constraint.
			 */
			highestUncancelledConstraint = my constraints -> item [highestUncancelledWinnerMark];
			highestUncancelledConstraint -> ranking += step;
		}
	}

	if (honourLocalRankings) {
		int icons, jcons, improved;
		do {
			improved = FALSE;
			for (icons = 1; icons <= my constraints -> size; icons ++) {
				OTConstraint consi = my constraints -> item [icons];
				for (jcons = 1; jcons <= my constraints -> size; jcons ++) {
					OTConstraint consj = my constraints -> item [jcons];
					if (our locallyRanked (me, consi -> which, consj -> which) == -1 && consj -> ranking > consi -> ranking) {
						do {
							consj -> ranking -= demotionStep (demotionMean, relativeDemotionSpreading);
						} while (consj -> ranking >= consi -> ranking);
						improved = TRUE;
					}
				}
			}
		} while (improved);
	}
end:
	forget (tableau);
	iferror return 0;
	return 1;
}

int OTAnyGrammar_learn_ts (OTAnyGrammar me, Strings inputs, Strings outputs) {
	long n = inputs -> numberOfStrings, i;
	if (! inputs) inputs = outputs;
	if (outputs -> numberOfStrings != n)
		{ Melder_error ("Numbers of strings in input and output do not match."); goto end; }
	for (i = 1; i <= n; i ++)
		if (! OTAnyGrammar_learnOne_ts (me, inputs -> strings [i], outputs -> strings [i])) return 0;
end:
	iferror return Melder_error ("(OTAnyGrammar_learn_ps:) Not completed.");
	return 1;
}

int OTAnyGrammar_learn_mgla (OTAnyGrammar me, Strings inputs, Strings outputs,
	double rankingSpreading, int promoteWinner, int honourLocalRankings,
	double demotionMean, double relativeDemotionSpreading)
{
	long n = inputs -> numberOfStrings, i;
	if (! inputs) inputs = outputs;
	if (outputs -> numberOfStrings != n)
		{ Melder_error ("Numbers of strings in input and output do not match."); goto end; }
	for (i = 1; i <= n; i ++)
		if (! OTAnyGrammar_learnOne_mgla (me, inputs -> strings [i], outputs -> strings [i],
			rankingSpreading, promoteWinner, honourLocalRankings,
			demotionMean, relativeDemotionSpreading)) return 0;
end:
	iferror return Melder_error ("(OTAnyGrammar_learn_mgla:) Not completed.");
	return 1;
}

/* End of file OTAny.c */