program TCinfo2;

{
TCinfo2 is a program that implements the Allele Intersection Analysis (AIA) algortihm,
a method to assign MLST alleles in multiply Wolbachia infected arthropod species.

AIA was developed by Wolfgang Arthofer, Markus Riegler, Hannes Schuler, Daniela Schneider, 
Karl Moder, Wolfgang J. Miller and Christian Stauffer and published in PLoS one.

TCinfo2 was coded by Wolfgang Arthofer using the Notepad++ editor and compiled with
FreePascal.

(c) 2010 Wolfgang Arthofer

TCinfo2 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, version 3 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. 
}

const	maxtypes		= 256;						{maximum number of allowed type combinations}
		maxstrains		= 16;						{maximum number of allowed strains, never > 7 in real life}


var	out				: text;
	n_strains		: integer;					{number of wolbachia strains}
	n_types			: integer;					{number of identified type combinations}
	strains			: string[maxstrains];				{one character identifier for each strain}
	tc				: array [1..maxtypes] of string[maxstrains];	{a string for each identified type combination}
	a, b, c			: integer;					{counters}
	info, x, y		: boolean;
	ch1, ch2, ch	: string[maxstrains];
	rep				: string[4];
	instr			: string[15];
	valerr			: integer;



function intersect (s1, s2 : string[maxstrains]) : string[maxstrains];
{this function calculates the intersect of two sets represented as strings}

var 	lca				: integer;
		buffer			: string[maxstrains];

begin
	intersect := '';
	
	if length (s1) < length (s2) then begin
		buffer := s1; s1 := s2; s2 := buffer
	end;

	for lca := 1 to length (s1) do begin
		if pos (s1[lca], s2) <> 0 then intersect := intersect + s1[lca]
	end;
	
end;


function complement (s1, s2 : string[maxstrains]) : string[maxstrains];
{this function calculates the complement s2 \ s1}

var		lca				: integer;

begin
	complement := '';
	
	for lca := 1 to length (s2) do begin
		if pos (s2[lca], s1) = 0 then complement := complement + s2[lca]
	end;
	
end;
		

function chkstrains (var s1 : string[maxstrains]) : boolean;
{this function performs some basic tests on the integrity of the input string}

var	lca, slen		: integer;
	testch			: char;
	instr			: string[maxstrains];
	
begin

	chkstrains := false; 
	slen := length (s1);
	instr := s1;

	for lca := 1 to slen do begin
		testch := instr[lca];
		if pos (testch, s1) < lca then delete (s1, pos (testch, s1), 1)
	end;
	
	if length (s1) < 2 then writeln ('Just one strain? No need to do allele intersection analysis!')

	else begin

		chkstrains := true;
		writeln; writeln (out);
		writeln (length (s1), ' Wolbachia strains identified:'); writeln;
		writeln (' ':10, 'strain #':10, 'strain ID':10);
		writeln ('            ------------------');
		writeln (out, length (s1), ' Wolbachia strains identified:'); writeln (out);
		writeln (out, ' ':10, 'strain #':10, 'strain ID':10);
		writeln (out, '            ------------------');

		for lca := 1 to length (s1) do begin
			writeln (' ':10, lca:10, s1[lca]:10);
			writeln (out, ' ':10, lca:10, s1[lca]:10)
		end;
		writeln ('            ------------------');
		writeln (out, '            ------------------');
		writeln; writeln (out);
	end
end;

function chktc (s1 : string [maxstrains]) : boolean;
{this function checks if an infection type entered by the user is valid}

var	lca			: integer;
	testch			: char;
	
begin

	chktc := true;

	for lca := 1 to length (s1) do begin
		testch := s1[lca];
		if pos (testch, strains) = 0 then begin
			writeln ('ERROR: ', testch, ' is not a valid Wolbachia strain!');
			chktc := false
		end
	end
end;			

	
{============== main ==========================================================================================================} 

begin

	assign (out, 'results.txt'); rewrite (out);

	writeln; writeln; writeln;

	writeln ('TCinfo v2.0 by Wolfgang Arthofer 2010'); writeln;
	writeln ('Reference: Arthofer et al. (2011) Allele Intersection Analysis:');
	writeln ('a novel tool for multi locus sequence assignment in multiply');
	writeln ('infected hosts. PLoS one.'); writeln;
	writeln ('This program will test wheter a given type combiation');
	writeln ('is informative for allele intersection analysis in');
	writeln ('a multiple Wolbachia infection.'); writeln;
	writeln ('Screen output will be copied to the file results.txt');
	writeln ('which will be overwritten every time you invoke the program.'); writeln;
	writeln ('First, enter a string coding the Wolbachia community in the species.');
	writeln ('Each strain is coded by a single alphanumeric character, no spaces');
	writeln ('inbetween - like 12345 or ABCDE or Aa*1%');
	writeln ('The maximum number of strains is 16. The software is case sensitive.'); writeln;

	writeln (out, 'TCinfo v2.0 by Wolfgang Arthofer 2009'); writeln (out);
	writeln (out, 'Reference: Arthofer et al. (2011) Allele Intersection Analysis:');
	writeln (out, 'a novel tool for multi locus sequence assignment in multiply');
	writeln (out, 'infected hosts. PLoS one.'); writeln (out);

	repeat
		write ('Wolbachia community code: '); readln (strains);
	until chkstrains (strains);

	writeln;
	n_strains := length (strains);


	repeat

		repeat
			write ('How many infection types are in your type combination? '); readln (instr);
			val (instr, n_types, valerr); if valerr <> 0 then n_types := 0
		until n_types <> 0;
		
		writeln;

		for a := 1 to n_types do begin
			repeat
				write ('Enter ', a, '. infection type '); readln (tc[a])
			until chktc (tc[a])
		end;

		writeln; writeln;

		writeln (out, 'Now testing following type combination:');
		for a := 1 to n_types do begin
			write (out, tc[a], '   ')
		end;

		writeln (out);

		info := FALSE;								{Null hypothesis}
		y := TRUE;									{basic setting to start into the first loop}




{Next step: check if each strain is present at least once in any on the ITs; otherwise the TC
can't be informative!}

		c := 0;

		for a := 1 to n_strains do begin					{check each strain}
			ch := copy (strains, a, 1);
			x := FALSE;
			for b := 1 to n_types do begin
				if pos (ch, tc[b]) <> 0 then x := TRUE		{the strain was found in a IT}
			end;
			if x then inc (c)								{count how many strains have been found} 
		end;

		if c = n_strains then begin



{Check if the longest IT is already 1; in this case its informative anyway!}

			b := 0;

			for a := 1 to n_types do begin

				if length (tc[a]) > b then b := length (tc[a]);

			end;

			if b = 1 then info := TRUE
	
			else begin



{Now start to create all pairwise intersects of ITs. If an intersect with cardinality = 1 is found, the element is removed from all
ITs that contain it and output is created. If not, it is tested whether a complement with a cardinality of 1 was created, which is treated like
an intersect with card 1. This loop is repeated until
- the longest TC is only one charcter long -> the TC was informative
- no intersect with cardinality = 1 was found and there are still ITs > 1 -> the TC was not informative}


				x := FALSE;							{x becomes TRUE if longest IT = 1}

				repeat

					a := 1; y:= FALSE;				{y becomes TRUE if intersect or complement with cardinality 1 exits}

					repeat 

						b := a + 1;
						repeat
							ch1 := intersect (tc[a], tc[b]);
							if length (ch1) = 1 then begin		{test for intersects}
								y := TRUE;
								writeln ('Infection types ', tc[a], ' and ', tc[b], ' have the intersect ', ch1);
								writeln ('Resolved strain ', ch1, ' was removed from all infection types.'); writeln;
								writeln (out, 'Infection types ', tc[a], ' and ', tc[b], ' have the intersect ', ch1);
								writeln (out, 'Resolved strain ', ch1, ' was removed from all infection types.'); writeln (out);
								ch := ch1
							end
							
							else begin							{test for complements}
								ch2 := complement (ch1, tc[a]);
								if length (ch2) = 1 then y := true
								else begin
									ch2 := complement (ch1, tc[b]);
									if length (ch2) = 1 then y := true
								end;
														
								if y then begin
									writeln ('Intersecting infection types ', tc[a], ' and ', tc[b], ' gives the complement ', ch2);
									writeln ('Resolved strain ', ch2, ' was removed from all infection types.'); writeln;
									writeln (out, 'Intersecting infection types ', tc[a], ' and ', tc[b], ' gives the complement ', ch2);
									writeln (out, 'Resolved strain ', ch2, ' was removed from all infection types.'); writeln (out);
									ch := ch2
								end
							end;
							
							inc (b);
						until (b > n_types) OR y;
						inc (a)

					until (a > n_types) OR y;

{If an intersect or complement with cardinality = 1 was identified, the element will now be removed from all ITs; at the same it is checked
how long the longest IT is afterwards}


					if y then begin
						b := 0;

						for a := 1 to n_types do begin

							c := pos (ch, tc[a]);
							if c <> 0 then delete (tc[a], c, 1);
							if length (tc[a]) > b then b := length (tc[a]);

						end;

						if b <= 1 then begin
							writeln ('All reduced infection types have now a cardinality of 1.');
							writeln (out, 'All reduced infection types have now a cardinality of 1.');
							x := TRUE;
							info := TRUE
						end
					end

				until x OR (y = FALSE)
 			end
		end;

		if info then begin
			writeln; writeln (out);
			writeln ('This type combination is informative.');
			writeln (out, 'This type combination is informative.');
			writeln; writeln; writeln (out); writeln (out)
		end
		else begin
			writeln; writeln (out);
			writeln ('This type combination is not informative.');
			writeln (out, 'This type combination is not informative.');
			writeln; writeln; writeln (out); writeln (out)
		end;

		write ('Do you want to test another type combination for this community (y/n) ? '); readln (rep);
		writeln;
		
	until (rep = 'n') or (rep = 'no');

	close (out)

end.