(* relational Databases *)

BeginPackage["CSM`DB`"]

(* data type *)

newRelation::usage = "newRelation[fields, tuples] creates a new relation."
Fields::usage = "Fields[relation] gives the list of fields (attributes)."
Tuples::usage = "Tuples[relation] gives the tuples of a relation."
Type::usage = "Type[attr] gives the type of the attribute. The default
	is String."
Prompt::usage = "Prompt[attr] gives the prompt to use for input. The default
	is 'attr: '."

(* basic operations of relational calculus *)

Projection::usage = "Projection[rel, {fields..}] projects the relation to
	the given fields which must be a subset of its fields."
Join::usage = Join::usage <>
	" Join[rel1, rel2] gives the natural join of the
	relations rel1 and rel2."
Complement::usage = Complement::usage <>
	" Complement[rel1, rel2] gives the difference of the
	relations rel1 and rel2."
Quotient::usage = Quotient::usage <>
	" Quotient[rel1, rel2] gives the quotient of the
	relations rel1 and rel2."
Union::usage = Union::usage <>
	" Union[rel1, rel2] gives the union of the
	relations rel1 and rel2."
Intersection::usage = Intersection::usage <>
	" Intersection[rel1, rel2] gives the intersection of the
	relations rel1 and rel2."
Rename::usage = "Rename[rel, repl] renames fields of the relation rel as
	specified by the replacement rule(s) repl."

(* selection *)

Select::usage = Select::usage <>
	" Select[ rel, cond ] selects all tuples in rel that satisfy cond."
FindOne::usage = "FindOne[rel, cond] returns one tuple in rel that satisfies
	the given condition, or $Failed if none exists."

(* update functions *)

addTupleTo::usage = "addTupleTo[rel, tuple] adds tuple to the relation rel."
addWithKeyTo::usage = "addWithKeyTo[rel, tuple, key] adds the tuple together
	with a unique key to rel. It returns the key generated."
Modify::usage = "Modify[body, rel] loops over the tuples of rel and
	assigns any changed values back to rel."

(* interactive input *)

InputField::usage = "InputField[attr, type, prompt] asks for input.
	The defaults for type and prompt are Type[attr] and Prompt[attr]."
FindOrAdd::usage = "FindOrAdd[rel, attrs, presets, key] is a higher-level
	input function."

(* output *)

Report::usage = "Report[rel, l1, l2, ...] generates a report with li fields
	on one line."

(* misc *)

RelationQ::usage = "RelationQ[rel] gives True, if rel is a relation."
R::usage = "R[fields, Short[tuples]] is the printform for relations."


Begin["`Private`"]

subSetQ[set_List, subset_List] := Complement[subset, set] === {}

newRelation[fields:{___Symbol}, t_List:{}] := relation[ fields, Union[t] ] /;
    t === {} || TensorRank[t] >= 2 && Dimensions[t][[2]] == Length[fields] 

Fields[relation[f_, t_, ___]] := f
Tuples[relation[f_, t_, ___]] := t

SetAttributes[SetTuples, HoldFirst]

SetTuples[rel_Symbol, newtuples_] :=
    (rel = ReplacePart[ rel, newtuples, 2 ]) /; RelationQ[rel]

RelationQ[rel_] := Head[rel] == relation && Length[rel] >= 2


protected = Unprotect[Do, Table, Sum];

relation /: Union[rel1_relation, rel2_relation] :=
		newRelation[ Fields[rel1],
		             Union[Tuples[rel1], Tuples[rel2]] ] /;
		             	Fields[rel1] === Fields[rel2]

relation /: Intersection[rel1_relation, rel2_relation] :=
		newRelation[ Fields[rel1],
		             Intersection[Tuples[rel1], Tuples[rel2]] ] /;
		             	Fields[rel1] === Fields[rel2]

relation /: Complement[rel1_relation, rel2_relation] :=
		newRelation[ Fields[rel1],
		             Complement[Tuples[rel1], Tuples[rel2]] ] /;
		             	Fields[rel1] === Fields[rel2]

SetAttributes[addTupleTo, HoldFirst]

addTupleTo[ rel_Symbol, tuple_List ] :=
    SetTuples[rel, Union[Tuples[rel], {tuple}]] /; RelationQ[rel]

SetAttributes[addWithKeyTo, HoldFirst]

addWithKeyTo[ rel_Symbol, tuple_List, key_Symbol ] :=
	With[ {fields = Fields[rel], keyval = Unique[key]},
	Module[{kpos, nt},
		kpos = Position[ fields, key ][[1,1]];
		nt = Insert[ tuple, keyval, kpos ];
		addTupleTo[ rel, nt ];
		keyval
	]] /; RelationQ[rel] && MemberQ[Fields[rel], key]

relation /: Select[rel_relation, cond_] :=
	With[ {fields = Fields[rel], tuples = Tuples[rel]},
	Module[{pred, selt},
		pred = Function @@ {fields, cond};
		selt = Select[ tuples, Apply[pred, #]& ];
		newRelation[ fields, selt ]
	]]

FindOne[rel_relation, cond_] :=
	With[ {fields = Fields[rel], tuples = Tuples[rel]},
	Module[{pred, selt},
		pred = Function @@ {fields, cond};
		selt = Select[ tuples, Apply[pred, #]&, 1 ];
		If[ Length[selt] == 0, $Failed, selt[[1]] ]
	]]

relation /: Projection[rel_relation, subf_List] :=
	With[ {fields = Fields[rel], tuples = Tuples[rel]},
	Module[{pred, newt},
		pred = Function @@ {fields, subf};
		newt = Apply[pred, tuples, {1}];
		newRelation[ subf, newt ]
	]] /; subSetQ[Fields[rel], subf]

relation /: Join[rel1_relation, rel2_relation] :=
	With[ {f1 = Fields[rel1], f2 = Fields[rel2],
	       t1 = Tuples[rel1], t2 = Tuples[rel2]},
	Module[{res = cons[], val1 = Null, p1, p2, lc, inv,
	        pos1, pos2, ord1, ord2, record, high = 1, take, mult},
	    common = Intersection[f1, f2];
	    lc = Length[common];
	    pos1 = Flatten[ Position[f1, #]& /@ common ];
	    pos2 = Flatten[ Position[f2, #]& /@ common ];
	    rest1 = Complement[ Range[Length[f1]], pos1 ];
	    rest2 = Complement[ Range[Length[f2]], pos2 ];
	    order1 = Join[pos1, rest1];
	    order2 = Join[pos2, rest2];
	    ord1 = Sort[ #[[order1]]& /@ t1 ];
	    ord2 = Sort[ #[[order2]]& /@ t2 ];
	    Do[
	        If[ val1 =!= Take[ ord1[[p1]], lc ],
	        	val1 = Take[ ord1[[p1]], lc ];
	        	(* search occurences in pos2 *)
	        	low = high;
	        	While[ low <= Length[ord2] && 
	        	       Order[val1, Take[ ord2[[low]], lc ]] == -1,
	        	       low++
	        	];
	        	high = low;
	        	While[ high <= Length[ord2] && 
	        	       Order[val1, Take[ ord2[[high]], lc ]] == 0,
	        	       high++
	        	];
	        	(* low ... high-1 have same values *)
	        	If[ high > low,
	        	    take = Take[ ord2, {low, high-1} ];
	        	    take = Drop[Transpose[take], lc]
	        	];
	        ];
	        (* form product *)
	        If[ high > low,
	            mult = Table[#, {high-low}]& /@ ord1[[p1]];
	            record = Transpose[ Join[mult, take] ];
	            res = cons[res, ##]& @@ record
	        ],
	      {p1, 1, Length[t1]}];
	    res = List @@ Flatten[res];
	    If[ Length[res] > 0,
	      inv = Flatten[ Position[order1, #]& /@ Range[Length[f1]] ];
	      inv = Join[ inv, Length[f1] + Range[Length[f2]-lc] ]; 
	      res = Transpose[ Transpose[res][[inv]] ];
	    ];
	    newRelation[ Join[ f1, f2[[rest2]] ], res ]
	]]

relation /: Quotient[rel1_relation, rel2_relation] :=
	With[ {f1 = Fields[rel1], f2 = Fields[rel2]},
	Module[{fields, t, ts, v},
		fields = Complement[f1, f2];
		t =  Projection[rel1, fields];
		ts = Projection[ Join[t, rel2], f1 ];
		v =  Projection[ Complement[ts, rel1],  fields ];
		Complement[t, v]
	]] /; subSetQ[Fields[rel1], Fields[rel2]]

Do[ body_, rel_ ] :=
	With[ {fields = Fields[rel], tuples = Tuples[rel]},
		Module[fields,
		    Do[ fields = tuples[[i]]; body, {i, Length[tuples]} ]
		]
	] /; RelationQ[rel]

Table[ body_, rel_ ] :=
	With[ {fields = Fields[rel], tuples = Tuples[rel]},
		Module[fields,
		    Table[ fields = tuples[[i]]; body, {i, Length[tuples]} ]
		]
	] /; RelationQ[rel]

Sum[ body_, rel_ ] :=
    Plus @@ Table[ body, rel ] /; RelationQ[rel]

SetAttributes[ Modify, HoldAll ]
Modify[ body_, rel_Symbol ] :=
	With[ {fields = Fields[rel]},
	Module[ {tuples = Tuples[rel], i},
		Module[fields,
		    Do[ fields = tuples[[i]];
		        body;
		        tuples[[i]] = fields,
		       {i, Length[tuples]} ]
		];
		rel = newRelation[ fields, tuples ]
	]] /; RelationQ[rel]

(* renaming attributes *)

relation /: Rename[rel_relation, repl___] :=
	newRelation[ Fields[rel] /. Flatten[{repl}], Tuples[rel] ]

(* report generation *)

indent = 4
separ = ", "
Report[rel_relation, levels___] :=
    With[ {fields = Fields[rel], tuples = Tuples[rel]},
    Module[{i, lev = {levels}, next, old, i1},
        If[ Plus @@ lev < Length[fields],
            AppendTo[lev, Length[fields] - Plus @@ lev] ];
        nest = Length[lev];
        old = Table[ Null, {nest+1} ];
        Do[ i1 = 0;
            Do[ 
                range = Range[ i1 + 1, i1 + lev[[i]] ];
                i1 += lev[[i]];
                line = fields[[range]];
                If[ line =!= old[[i]],
                    Print[ Spaces[indent(i-1)], Infix[line, separ] ];
                    old[[i]] = line;
                    old[[i+1]] = Null;
                ];
              , {i, nest}
            ];
          , rel
        ];
        rel
    ]]

Spaces[i_] := Nest[ # <> " "&, "", i ]

(* fix Infix problem for functions with one argument *)

iprot = Unprotect[Infix]
Infix[_[e_], h_:Null] := e
Protect[Evaluate[iprot]]

(* prompted input *)

(* ^D aborts (returns EndOfFile) *)

(* default type is String *)

Type[_] := String

(* default prompt is fieldname *)

Prompt[field_] := ToString[StringForm["`1`: ", field]]

noinput = "end of input"
abort = "."

InputField[field_] := InputField[field, Type[field], Prompt[field]]
InputField[field_, String, prompt_] :=
    Module[{ans},
	ans = InputString[prompt];
	If[ ans === EndOfFile || ans === abort,
	    Print[noinput]; Return[EndOfFile] ];
	ans
    ]

InputField[field_, type_, prompt_] :=
	Module[{str, strstream, res},
	    While[ True,
		str = InputString[prompt];
		If[ str === EndOfFile || str === abort,
		    Print[noinput]; Return[EndOfFile] ]; (* no input *)
		strstream = StringToStream[str];
		res = Read[ strstream, type ];
		Close[strstream];
		If[ res === EndOfFile || res === $Failed, (* error *)
			Print["Reenter Data"],
			Break[]
		]
	    ];
	    res
	]

SetAttributes[FindOrAdd, HoldFirst]
FindOrAdd[rel_Symbol, keys_List, presets_List:{}, key_:None] :=
	Module[{ fields = Fields[rel], n = Length[keys],
	         i, keyvals, keypos = 0, rest, restvals, prefields,
	         prevals, qfields, tuple },
		keyvals = Array[Null, n];
		prefields = #[[1]]& /@ presets;
		prevals   = #[[2]]& /@ presets;
		For[i = 1, i <= n, i++, (* read keys[[i]] *)
		        keyvals[[i]] = InputField[ keys[[i]] ];
		        If[ keyvals[[i]] === EndOfFile, Return[EndOfFile] ];
		];
		query = And @@
		    Thread[ Join[keys, prefields] == Join[keyvals, prevals] ];
		tuple = FindOne[ rel, query ];
		If[ tuple =!= $Failed,
			Print["Found: ", tuple]; Return[tuple] ];
		(* get rest of fields *)
		If[ key =!= None,
		    keypos = Position[fields, key][[1,1]];
		    fields = Drop[ fields, {keypos} ];
		];
		qfields = Complement[ fields, prefields ]; (* query fields *)
		rest = Complement[ qfields, keys ]; n = Length[rest];
		restvals = Array[0, n];
		For[i = 1, i <= n, i++, (* read rest[[i]] *)
		        restvals[[i]] = InputField[rest[[i]]];
		        If[ restvals[[i]] === EndOfFile, Return[EndOfFile] ];
		];
		tuple = fields /. Thread[ keys -> keyvals ] /.
		        Thread[ rest -> restvals ] /.
		        Thread[ prefields -> prevals ];
		If[ key =!= None,
		    i = addWithKeyTo[ rel, tuple, key ];
		    tuple = Insert[ tuple, i, keypos ];
		  , addTupleTo[ rel, tuple ]
		];
		tuple
	]

Format[rel_relation] := R[ Fields[rel], Short[Tuples[rel], 1] ]

Protect[ Evaluate[protected] ]

Protect[ relation ] (* avoid saving Format, etc. *)

End[]

Protect[ Type, Prompt, Fields, Tuples, newRelation ]

EndPackage[]
