(***********************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which typically
will have the same name as this file except ending in ".nb" instead of
".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent to
using the Evaluate Initialization Cells menu command in the front end.

DO NOT EDIT THIS FILE.  This entire file is regenerated automatically 
each time the parent Notebook file is saved in the Mathematica front end.
Any changes you make to this file will be overwritten.
***********************************************************************)





(* ICTCM12 - Burlingame, CA, 1999 *)
(* file HillData.m:  creates key mats & plain/cipher text *)
(* Copyright \[Copyright] 1999 by Murray Eisenberg *)

Begin["special`temp`"]	(* encapsulate whole file *)

(* Check for needed globals *)

(* checking myID and myName *)

HillData`check`checking::noID = "\nYou forgot to define myID!";
HillData`check`checking::badID = 
  "\nmyID must be a string, enclosed in quotes, consisting "<>
		"of the digits of your student ID number.";
HillData`check`checking::noName = "\nYou forgot to define "<>
	"myName!";
HillData`check`checking::badName = 
  "\nmyName must be a string, enclosed in quotes, consisting "<>
		"of at least three letters of your (first) name.";

HillData`check`checkingNoID = 
	If[Names["myID"] === {}, True, False];

HillData`check`checkingNoName = 
	If[Names["myName"] === {}, True, False];

HillData`check`checkingOK =
	If[HillData`check`checkingNoID, 
		Message[HillData`check`checking::noID]; False,
	If[!StringQ@ToExpression@"myID", 
		Message[HillData`check`checking::badID]; False,
	If[(!Apply[And, 
			Map[MemberQ[Characters@"0123456789", #]&, 
				Characters@ToExpression@"myID"]])
		|| (0 == StringLength@ToExpression@"myID"), 
		Message[HillData`check`checking::badID]; False,
	If[HillData`check`checkingNoName,
		Message[HillData`check`checking::noName]; False,
	If[!StringQ@ToExpression@"myName", 
		Message[HillData`check`checking::badName]; False,
	If[(!Apply[And, 
		Map[MemberQ[Characters@"ABCDEFGHIJKLMNOPQRSTUVWXYZ", #]&,
				Characters@ToUpperCase@ToExpression@"myName"]])
		|| (3 > StringLength@ToExpression@"myName"),
		Message[HillData`check`checking::badName]; False, 
		True
	]]]]]];

If[HillData`check`checkingOK,
	BeginPackage["HillData`"]
]

If[HillData`check`checkingOK,
	Begin["`Private`"]
]

If[HillData`check`checkingOK,
	Print["\nPreparing test data....\n"]
]

(* SETUP AND TEST ... *)

If[HillData`check`checkingOK,


(* PREPARE TEST DATA *)

(* Functions used to generate test data *)

SeedRandom[Floor[0.123456 * 	
	ToExpression@ToExpression@"Global`myID"]];

Options[roll] = {dice \[Rule] 0};
roll[n_Integer?Positive,  opts___?OptionQ] := Module[{k},
	k = dice/.{opts} /. Options[roll];                          
   	If[k == 0, Random[Integer, {1, n}],                    
		Table[Random[Integer, {1, n}], {k}]
	]
];
roll[m_Integer, n_Integer, opts___?OptionQ] := Module[{k},
	k = dice/.{opts} /. Options[roll];                  
    If[k == 0, Random[Integer, {m, n}], 
		Table[Random[Integer, {m, n}],{k}]
	]
];

deal[elts_List, 1] := 
	{elts\[LeftDoubleBracket]roll[Length[elts]]\[RightDoubleBracket]};

deal[elts_List, k_] := Module[{one= deal[elts, 1]},  
	Join[one, deal[Complement[elts, one], k-1]]
] /; k > 1;

makeRandomModMat[n_, m_] := 
	Mod[Partition[roll[0, m - 1, dice \[Rule] n^2], n], m];

hillDefault[3] = Partition[{1,22,8,18,11,5,21,7,15}, 3];
hillDefault[4] = 
	Partition[{15,5,5,18,25,14,8,4,10,5,20,2,1,10,7,8}, 4];
hillDefault[5] = 
	Partition[{16,11,10,25,8,26,9,21,19,23,27,14,23,23,8,
		16,9,2,1,20,5,12,14,9,15}, 5];
hillDefault[6] = 
	Partition[{15,20,12,8,17,23,3,10,18,15,14,7,
		9,7,14,13,26,17,10,26,3,21,7,21,
		3,8,23,15,20,19,9,9,13,12,23,9}, 6];
hillDefault[7] = 
	Partition[{17,18,16,1,7,10,7,6,23,28,7,3,1,18,
		16,19,15,10,26,25,2,4,24,14,27,2,17,3,
		12,3,11,3,19,12,19,7,13,16,22,5,6,4,
		18,17,14,2,0,9,22}, 7];
hillDefault[8] = 
	Partition[{11,1,18,10,10,8,22,26,26,25,20,2,4,24,11,14,
		17,4,5,16,12,28,12,8,3,11,1,21,7,10,9,3,
		8,6,10,23,6,16,12,28,12,5,9,8,14,2,2,0,
		8,19,28,13,17,24,4,3,14,6,17,3,3,26,14,15}, 8];

getHillMat[n_, m_] := Module[{i = 1, a, imax = 20, ready = False},
	While[(i++ <= imax) && (Not@ready),
		a = makeRandomModMat[n, m];
		If[Null =!= invmod[a, m], ready = True]
	];
	If[ready, a,	
		Mod[Transpose[
			Transpose[hillDefault[n]]\[LeftDoubleBracket]deal[Range[n], n]\[RightDoubleBracket]], m]
	]
];

(* Hidden import! *)

Needs["HillDbase0`"];

formPlainText[n_Integer?Positive, dbase_List] :=
	Module[{i = 1, imax = 10, areIndep = False, p},
		While[(i <= imax) && (!areIndep),
			i++; p = dbase\[LeftDoubleBracket]i\[RightDoubleBracket];
			If[checkIndependent[n, p],
				areIndep = True
			]
		];
		If[!areIndep, p = 
			"MARY HAD A LITTLE LAMB ITS FLEECE WAS WHITE "<>
			"AS SNOW AND EVERYWHERE THAT MARY WENT THE "<>
			"LAMB WAS SURE TO GO"
		];
	p
	];

getCPText[mat_?MatrixQ, dbase_List] :=
	Module[{n = Length@mat, r, p, c, t},
		(* drop too-short sentences *)
		t = Select[dbase, n^2 <= StringLength@#&];
		r = Length[t];
		(* shuffle sentences; find one with
		   n independent n-graphs *)
		p = formPlainText[n, t\[LeftDoubleBracket]deal[Range[r], r]\[RightDoubleBracket]];
		{p, encipher[p, mat]}
	];

getEText[mat_?MatrixQ, dbase_List] :=
	encipher[dbase\[LeftDoubleBracket]roll@Length@dbase\[RightDoubleBracket], mat];

(* Functions needed for modular linear algebra *)

GJmod[mat_?MatrixQ, m_Integer?Positive /; PrimeQ[m]] := 
	Module[{a = mat, mrows, n, r, c, p},
		mrows = Length[a]; n = Last@Dimensions@a;
		Do[				 (* for each row... *)
						 (* let c = index of next pivot column *)
			c = firstNonzeroColumn[Drop[a, r - 1]];
			If[ c <= n,	   (* then...get index of pivot's row: *)
				p = r-1+firstNonzeroIndex[Drop[col[a, c], r-1]];
				a = swap[a, r, p];	(* put pivot into position *)
				(* get leading 1: *)				
				a = scale[a, recipmod[a\[LeftDoubleBracket]r, c\[RightDoubleBracket], m], r];
				a = Mod[a, m];
				a = zeroUpDown[a, r, c];(* 0 in rest of column *)
				a = Mod[a, m]
			]				(* end If *)
			, {r, 1, mrows}
		];					(* end Do *)
	a
	];

invmod[mat_?MatrixQ, m_Integer?Positive /; PrimeQ[m]] := 
	Module[{a = mat, n, ident},
		n = Length[a]; ident =IdentityMatrix[n];
		a = GJmod[Apply[Join, Transpose[{a, ident}], {1}], m];
		If[(Take[#, n]& /@ a) === ident,	Take[#, -n]& /@ a]
	];	

recipmod[k_, m_] := PowerMod[k, -1, m];

swap[mat_, i_, k_] := 
	Module[{A = mat}, A[[{i, k}]] = A[[{k, i}]]; A];

scale[mat_, c_, i_] := Module[{A = mat}, A[[i]] = c A[[i]]; A];

(* General-purpose functions for lists *)

nonzeroQ[x_] := N[x] != 0.; SetAttributes[nonzeroQ, Listable];

someNonzeroQ[v_List] := Apply[Or, nonzeroQ[v]];

firstIndex[v_List, b_List /; Not[Apply[Or, b]]] := Length[v] + 1;
firstIndex[v_List, b_List] := First[Flatten[Position[b, True]]];

firstNonzeroIndex[v_List] := firstIndex[v, nonzeroQ[v]];

(* Special-purpose functions for manipulating matrices *)

nonzeroRowsQ[mat_] := Map[someNonzeroQ, mat];
nonzeroColumnsQ[mat_] := nonzeroRowsQ[Transpose[mat]];

firstNonzeroColumn[mat_] := 
	firstIndex[Range[Dimensions[mat]\[LeftDoubleBracket]2\[RightDoubleBracket]], nonzeroColumnsQ[mat]];

col[mat_, j_] := Transpose[mat]\[LeftDoubleBracket]j\[RightDoubleBracket];			(* one column *)
columns[mat_, js_List] := Transpose[Transpose[mat]\[LeftDoubleBracket]js\[RightDoubleBracket]];

zeroUpDown[mat_, i_, j_] := Module[{a = mat, is, cs},
	is = Complement[Range[Length[a]], {i}]; 
 	cs = col[a, j]\[LeftDoubleBracket]is\[RightDoubleBracket]; 
	a\[LeftDoubleBracket]is\[RightDoubleBracket] = a\[LeftDoubleBracket]is\[RightDoubleBracket] - Outer[Times, cs, a\[LeftDoubleBracket]i\[RightDoubleBracket]]; 
	a
]; 

(* Functions for encipherment *)

alf = Characters["ABCDEFGHIJKLMNOPQRSTUVWXYZ.? "];

(* checkIndependent[n, txt] tests string txt for n independent 
	n-graphs *)
checkIndependent[n_Integer?Positive, txt_String] := 
	Module[{b, c, i, j, k, p, foundInd = False},
		p = matFromVect[numsFromChars[txt], n];
		c = Last@Dimensions@p;
		If[n > c, 
			foundInd = False, (* false if more rows than cols *)
			(* else test indep. of each choice of n cols ... *)
			k = Length[j = KSubsets[Range[c], n]];
			foundInd = False; i = 1;
			While[(i <= k) && (!foundInd), i++; 
				If[linIndMod[columns[p, j\[LeftDoubleBracket]i\[RightDoubleBracket]], Length@alf],
						foundInd = True
				]
			]
		];
		foundInd
	];
			
linIndMod[mat_?MatrixQ, m_Integer?Positive /; PrimeQ[m]] :=
	Module[{a = mat, r = Length@mat, c = Last@Dimensions[mat]},
		If[c > r, False,
			If[IdentityMatrix[c] == GJmod[a, m]\[LeftDoubleBracket]Range[c]\[RightDoubleBracket], True,
				False
			]
		]
	];

(* KSubsets from DiscreteMath`Combinatorica` *)
KSubsets[l_List,0] := { {} };
KSubsets[l_List,1] := Partition[l,1];
KSubsets[l_List,k_Integer?Positive] := {l} /; (k == Length[l]);
KSubsets[l_List,k_Integer?Positive] := {}  /; (k > Length[l]);

KSubsets[l_List,k_Integer?Positive] :=
	Join[
		Map[(Prepend[#,First[l]])&, KSubsets[Rest[l],k-1]],
		KSubsets[Rest[l],k]
	];

encipher[txt_String, mat_?MatrixQ] := 
	Module[{m = Length[alf], n = Length[mat], i},
		i = matFromVect[numsFromChars[txt], n];
		i = Mod[mat . i, m];
		charsFromNums@vectFromMat[i]
	];

numsFromChars[txt_String] := 
	Flatten@Map[Position[alf, #] - 1&, Characters@txt];

charsFromNums[ints_List] := StringJoin@alf\[LeftDoubleBracket]ints + 1\[RightDoubleBracket];

vectFromMat[mat_?MatrixQ] := Flatten@Transpose[mat];

matFromVect[vect_List, n_Integer?Positive] := 
	Module[{v = vect, r, q},
		r = Mod[Length@v, n]; (* number of entries left over *)
		v = Join[v, Table[Last[v], {Sign[r]*(n - r)}]]; (* pad *)
		q = Length[v] / n;
		Transpose@Partition[v, n]
	];

(* secure my definitions *)

SetAttributes[{GJmod, invmod, 
	encipher, numsFromChars, charsFromNums, vectFromMat, matFromVect},
	{ReadProtected}]; 

(* CREATE DATA *)

(* Form problem data and instructions *)
stateProblem[name_] := (*Module[{a, ainv, c, n, t, txt},*)
(
	(* Problem 2: given inverse key, decipher given ctext *)
	a = getHillMat[roll[3, 8], 29]; ainv = invmod[a, 29];
	t = "\nFor Problem #2, ";
	t = t<>dataSave[name<>"INV2", "the _inverse_ key", "ainv"];
	t = t<>", and ";
	c = getEText[a, HillDbase0`dbase0];
	t = t<>dataSave[name<>"CTXT2", "the ciphertext", "c"]<>".";
	Print[t];

	(* Problem 3: given key, decipher given ciphertext *)
	Print["\nThis may take a moment or two...."];
	t = "\nFor Problem #3, ";
	a = getHillMat[roll[3, 8], 29];
	t = t<>dataSave[name<>"KEY3", "the key matrix", "a"];
	t = t<>", and ";
	c = getEText[a, HillDbase0`dbase0];
	t = t<>dataSave[name<>"CTXT3", "the ciphertext", "c"]<>".";
	Print[t];

	(* Problem 4: given plain- & cihpertext, find
		independent vectors and inverse key *)
	Print["\nPlese be patient; this may take a bit of time...."];
	n = roll[3, 6];
	t = "\nFor Problem #4, the cipher size";
	t = t<>dataSave[name<>"n", "", "n"]<>".\n";
	txt = getCPText[getHillMat[n, 29], HillDbase0`dbase0];
	t = t<>dataSave[name<>"PTXT4", "The plaintext", "txt\[LeftDoubleBracket]1\[RightDoubleBracket]"];
	t = t<>", and the corresponding ";
	t = t<>dataSave[name<>"CTXT4", "ciphertext", "txt\[LeftDoubleBracket]2\[RightDoubleBracket]"]<>".";
	Print[t]
(*]*);
	Remove[a, ainv, c, n, t, txt];
	Null
);

(* GENERAL PROBLEM-POSING FUNCTIONS *)

dataSave[varname_String, what_String, dataname_String] := 
	(ToExpression[StringJoin[Sequence@@{"Global`"<>varname, "=", dataname}]];
	what<>" is stored in variable "<>varname);

startline[id_String] := 
"\n============ Hill cipher data for ID #"<>id<>
	" ============";

endline[] := 
"\n========= Hill cipher data ready "<>tstamp[Date[]]<>
	" =========\n";

tstamp[when_] := Module[{t, year, month, day, hour, minute}, 
	t = If[Length[when] == 0, Date[], when];
	t\[LeftDoubleBracket]1\[RightDoubleBracket] = Mod[t\[LeftDoubleBracket]1\[RightDoubleBracket], 100];
	{year, day, hour, minute} = Map[ToString, t\[LeftDoubleBracket]{1, 3, 4, 5}\[RightDoubleBracket]];
	minute = StringTake["0"<>minute,-2];
	month = {"Jan","Feb","Mar","Apr","May","Jun",
		"Jul","Aug","Sep","Oct","Nov","Dec"}\[LeftDoubleBracket]t\[LeftDoubleBracket]2\[RightDoubleBracket]\[RightDoubleBracket];
	day<>" "<>month<>" "<>year<>", "<>hour<>":"<>minute];

firstStringPosition[t_String, ch_String] :=
	StringLength[t] + 1 /; 
	StringPosition[t, ch] === {};
firstStringPosition[t_String, ch_String] := 
	First@Flatten@StringPosition[t, ch];

wrapup[name_String] := Module[{i, who = name},
	who = StringTake[who, firstStringPosition[who, " "] - 1];
	i = roll[8];
	"\n"<>Which[i == 1, "That wraps it up, "<>who<>"!",
			i == 2,	"Good luck on your problems, "<>who<>"!",
			i == 3,
				"Well, have fun, "<>who<>"!  I certainly did.",
			i == 4,	"All done, "<>who<>
					".  Now it's your turn to work!",
			i == 5,	"It's in your hands now, "<>who<>".",
			i == 6, "OK, "<>who<>", do a good job!",
			i == 7, 
				"Well, that should keep you busy for a while, "<>
				who<>".",
			i == 8, "Best of luck, "<>who<>"!"
		]
	];
	
setup[id_String, name_String] := 
	Module[{nameStub},
		nameStub = ToUpperCase@
			StringTake[name, 3];
		Print[startline@id];
		stateProblem[nameStub];
		Print[endline[]];
		Print[wrapup[name]]
	];

(* Execute it! *)

setup[ToExpression@"Global`myID", ToExpression@"Global`myName"];

]		(* endIf -- end setup and test *)



If[HillData`check`checkingOK,
	End[]	(* end Private *)
]

If[HillData`check`checkingOK,
	EndPackage[]
]

(* CLEAN UP  *)

(* clean up in case myID or myName was not defined *)
If[HillData`check`checkingNoID, 
	Remove[myID]
];

If[HillData`check`checkingNoName, 
	Remove[myName]
]

(* Don't leave package context in $ContextPath or $Packages! *)

If[HillData`check`checkingOK, 
	$ContextPath= Drop[$ContextPath, 1]
]

Delete[$Packages, Position[$Packages, "HillData`"]]

Remove["HillData`check`*"]	(* clean up `check` objects *)

Off[Remove::rmnsm];
Remove["HillDbase0`*"];
Remove["special`temp`*"];	(* remove all locals in this file *)
On[Remove::rmnsm]

End[];	(* end special`temp` *)

(* end of file *)