MODULE HIDDEN;

% Author: James H. Davenport.

% Redistribution and use in source and binary forms, with or without
% modification, are permitted provided that the following conditions are met:
%
%    * Redistributions of source code must retain the relevant copyright
%      notice, this list of conditions and the following disclaimer.
%    * Redistributions in binary form must reproduce the above copyright
%      notice, this list of conditions and the following disclaimer in the
%      documentation and/or other materials provided with the distribution.
%
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
% CONTRIBUTORS
% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
% POSSIBILITY OF SUCH DAMAGE.
%


FLUID '(!*trint
        !*TRJHD
        CANCELLATIONLIST
        EQUALITYSTACK
        HIDE
        INDEXLIST
        INDEXMAP
        INEQUALITYSTACK
        LASTREDUCTION
        NINDEX
        POPSTACK
        RHS
        ULIST);

EXPORTS HIDDENTERMGENERATORS;
IMPORTS INTERR,NEXTPRIME,MKSP,ADDF,GETV,!*MULTF,PRINTSF,GCDF,QUOTF,NEGF;
IMPORTS MAKEPRIM,PRIN2,MKVECT,COPYVEC,PRINTDF;


%PACKAGE FOR DEALING WITH LINEAR SUBSPACES DEFINED;
% BY BOTH EQUALITIES AND INEQUALITIES;


% MAJOR DATASTRUCTURE - ;
% AN EQUATION IS STORED IN A VECTOR OF LENGTH (LENGTH INDEXLIST);
% ELEMENTS 2::N ARE THE COEFFS OF THE VARIOUS INDEX QUANTITIES;
% ELEMENT 1 IS CONSTANT PART;
% ELEMENT 0 IS NUMBER DEFINING A PIVOT IN THE ROW;
%;
% ALL VECTOR ELEMENTS ARE STANDARD FORMS;

SYMBOLIC PROCEDURE NEWSPACE;
 BEGIN SCALAR W;
    INDEXMAP:=NIL;
    NINDEX:=1;
    W:=INDEXLIST;
    WHILE W DO <<
        NINDEX:=NINDEX+1;
        INDEXMAP:=(CAR W . NINDEX) . INDEXMAP;
        W:=CDR W >>;
    POPSTACK:=EQUALITYSTACK:=INEQUALITYSTACK:=NIL;
    IF !*TRINT THEN PRINTC "NEW SPACE SET UP"
 END;

SYMBOLIC PROCEDURE CURRENTSPACE;
%PICKS UP THE CURRENT SET OF LINEAR CONSTRAINTS SO THEY CAN BE STORED;
    (EQUALITYSTACK . INEQUALITYSTACK) . POPSTACK;

% RESTORES A SPACE SAVED BY 'CURRENTSPACE';
SYMBOLIC PROCEDURE SETLINSPACE A;
 << POPSTACK:=CDR A;
    A:=CAR A;
    EQUALITYSTACK:=CAR A;
    INEQUALITYSTACK:=CDR A;
    NIL >>;


SYMBOLIC PROCEDURE NEWEQUATION(EQQN,NOTFLAG);
% DECLARE THE EQUATION;
%    EQQN=0;
% (OR IF NOTFLAG IS SET)    EQQN NE 0;
% TO HOLD IN ADDITION TO ALL PREVIOUSLY DECLARED RELATIONSHIPS;
% RETURN 'INCONSISTENT IF THIS IS NOT POSSIBLE;
 BEGIN SCALAR NEWROW,NEWPIVOT,Q1,R;
    IF !*TRINT THEN <<
       PRIN2 "NEW ";
       IF NOTFLAG THEN PRIN2 "IN";
       PRINTC "EQUALITY";
       PRINTSF EQQN >>;
    IF INEQUALITYSTACK='INCONSISTENT THEN INTERR "DOUBLE INCONSISTENCY";
    POPSTACK:=(EQUALITYSTACK . INEQUALITYSTACK) . POPSTACK;
    NEWROW:=MKVECT NINDEX; % SPACE FOR NEW ROW IN EQQNSTACK;
%   FOR I:=0:NINDEX DO PUTV(NEWROW,I,NIL); %SET TO ZERO;
    EXPANDINTO(NEWROW,EQQN,1);
    MAKEPRIM(NEWROW,NINDEX); % REMOVE ANY COMMON FACTORS;
    MAPC(REVERSE EQUALITYSTACK,FUNCTION LAMBDA J;
      ELIMINATEWITH(NEWROW,J));
    NEWPIVOT:=0;
    FOR I:=2:NINDEX DO
      IF GETV(NEWROW,I) NEQ NIL THEN NEWPIVOT:=I;
    IF NEWPIVOT=0 THEN
       IF (GETV(NEWROW,1)=NIL)=NOTFLAG THEN GO TO CONTRADICT
         ELSE RETURN 'REDUNDANT;
    PUTV(NEWROW,0,NEWPIVOT);
    IF NOTFLAG THEN <<
      INEQUALITYSTACK:=NEWROW . INEQUALITYSTACK;
      IF !*TRINT THEN PRINTC "NEW INEQUALITY ADDED";
      RETURN 'CONSISTENT! INEQUALITY >>;
    EQUALITYSTACK:=NEWROW . EQUALITYSTACK;
    Q1:=INEQUALITYSTACK;
    INEQUALITYSTACK:=NIL;
WIND:
    IF Q1=NIL THEN RETURN 'CONSISTENT! EQUALITY;
    R:=COPYVEC(CAR Q1,NINDEX);
    Q1:=CDR Q1;
    ELIMINATEWITH(R,NEWROW);
    NEWPIVOT:=0;
    FOR I:=2:NINDEX DO
      IF GETV(R,I) NEQ NIL THEN NEWPIVOT:=I;
    IF NEWPIVOT NEQ 0 THEN GO TO OK;
    IF GETV(R,1)=NIL THEN GO TO CONTRADICT;
    GO TO WIND;
CONTRADICT:
    EQUALITYSTACK:=INEQUALITYSTACK:='INCONSISTENT;
    RETURN 'INCONSISTENT;
OK: PUTV(R,0,NIL);
    MAKEPRIM(R,NINDEX);
    INEQUALITYSTACK:=R . INEQUALITYSTACK;
    GO TO WIND
 END;

SYMBOLIC PROCEDURE EXPANDINTO(ROW,VAL,ABOVE);
    IF DOMAINP VAL THEN PUTV(ROW,1,ADDF(GETV(ROW,1),!*MULTF(VAL,ABOVE)))
    ELSE BEGIN SCALAR X;
      X:=ATSOC(MVAR VAL,INDEXMAP); % PROCESS LEADING TERM FIRST;
      IF X THEN << X:=CDR X;
        IF NOT (TDEG LT VAL = 1) THEN
          INTERR "NOT LINEAR IN EXPANDINTO";
        PUTV(ROW,X,ADDF(GETV(ROW,X),!*MULTF(LC VAL,ABOVE))) >>
    ELSE EXPANDINTO(ROW,LC VAL,!*MULTF(ABOVE,((LPOW VAL) .* 1) .+ NIL));
    RETURN EXPANDINTO(ROW,RED VAL,ABOVE)
 END;

SYMBOLIC PROCEDURE ELIMINATEWITH(NEWROW,OLDROW);
   BEGIN SCALAR PIVOTX,P,Q;
    PIVOTX:=GETV(OLDROW,0);
    P:=GETV(NEWROW,PIVOTX);
    IF P=NIL THEN RETURN NIL; %NOTHING NEEDS DOING;
    Q:=GETV(OLDROW,PIVOTX);
    BEGIN SCALAR GG;
      GG:=GCDF(P,Q);
      P:=QUOTF(P,GG);
      Q:=NEGF QUOTF(Q,GG) END;
    FOR I:=1:NINDEX DO
      PUTV(NEWROW,I,ADDF(!*MULTF(GETV(NEWROW,I),Q),
                         !*MULTF(GETV(OLDROW,I),P)));
    PIVOTX:=GETV(NEWROW,0);
    PUTV(NEWROW,0,NIL);
    MAKEPRIM(NEWROW,NINDEX);
    PUTV(NEWROW,0,PIVOTX);
    RETURN NIL
   END;

SYMBOLIC PROCEDURE DROPEQUATION;
   BEGIN
    IF ATOM POPSTACK THEN INTERR "POPSTACK UNDERFLOW";
    EQUALITYSTACK:=CAAR POPSTACK;
    INEQUALITYSTACK:=CDAR POPSTACK;
    POPSTACK:=CDR POPSTACK
   END;


SYMBOLIC PROCEDURE PRINTLINSPACE();
 BEGIN IF EQUALITYSTACK='INCONSISTENT THEN <<
      PRINTC "NEVER HAPPENS";
      RETURN NIL >>;
    IF EQUALITYSTACK=NIL THEN
      PRINTC "NO EQUALITYIES ACTIVE"
    ELSE << PRINTC "SUBJECT TO"; PRINTEQNS EQUALITYSTACK >>;
    IF ATOM INEQUALITYSTACK THEN RETURN NIL;
    PRINTC "EXCEPT WHEN";
    PRINTEQNS INEQUALITYSTACK;
    RETURN NIL END;

SYMBOLIC PROCEDURE PRINTEQNS L;
 BEGIN WHILE L DO <<
      PRINTSF VEC2SF(CAR L,INDEXMAP);
      TERPRI();
      L:=CDR L >>;
    TERPRI();
    RETURN NIL END;

SYMBOLIC PROCEDURE VEC2SF(X,INDEXMAP);
 BEGIN SCALAR R;
    R:=GETV(X,1); % CONSTANT PART;
    FOR I:=2:NINDEX DO BEGIN
        SCALAR V;
        V:=INDEXMAP;
        WHILE NOT (I=CDAR V) DO V:=CDR V;
        V:=CAAR V;
        V:=(MKSP(V,1) .* 1) .+ NIL;
        R:=ADDF(R,!*MULTF(V,GETV(X,I))) END;
    RETURN R END;





SYMBOLIC PROCEDURE HIDDENTERMGENERATORS(RHS);
 BEGIN SCALAR P,Q,REDUCTIONS;
    CANCELLATIONLIST:=NIL;
    HIDE:=NIL;
    NEWSPACE(); %INIT LINEAR SUBSPACE PACKAGE;
    ELIMINATECONSTOFINT();
    REDUCTIONS:=CONSTRAINEDREDUCTIONS RHS;
    IF !*TRINT THEN MAPC(REDUCTIONS,FUNCTION PRINTREDUCTION);
    LASTREDUCTION:=LVLAST REDUCTIONS;
    P:=CDR REDUCTIONS;
    WHILE P DO <<
        Q:=REDUCTIONS;
        WHILE NOT (P EQ Q) DO <<
            INTERFERE(CAR P,CAR Q); %MAY EXTEND REDUCTIONS LIST;
            Q:=CDR Q >>;
        P:=CDR P >>;
    RETURN NIL
   END;




SYMBOLIC PROCEDURE LVLAST L;
    IF NULL L THEN INTERR "L=NIL IN LVLAST"
    ELSE IF NULL CDR L THEN L
    ELSE LVLAST CDR L;

%SYMBOLIC PROCEDURE NEWREDUCTION A;
%% RECORD A NEW REDUCTION FORMULA;
%  BEGIN
%    A:=LIST A;
%    RPLACD(LASTREDUCTION,A);
%    LASTREDUCTION:=A
%   END;

SYMBOLIC PROCEDURE ELIMINATECONSTOFINT();
% SET UP AN INEQUALITY THAT GETS RID OF THE CONSTANT OF
% INTEGRATION BUT NO OTHER POSITIVE TERMS. MAYBE THIS IS
% DONE BY A FUDGE..... ;
 BEGIN SCALAR P,R,M,V,X;
    X:=INDEXLIST;
    P:=LPOW ULIST;
% (A) FIND LARGEST VALUE IN THIS THING;
    M:=0;
    WHILE P DO << M:=MAX(M,CAR P); P:=CDR P >>;
    V:=0;
    P:=LPOW ULIST;
% NOW ALLOCATE A PRIME NUMBER > M TO EACH INDEX;
    WHILE P DO <<
        M:=NEXTPRIME M;
        R:=ADDF(R,(MKSP(CAR X,1) .* M) .+ NIL);
        X:=CDR X;
        V:=V-M*CAR P;
        P:=CDR P >>;
    IF NOT(V=0) THEN R:=ADDF(R,V);
    NEWEQUATION(R,T); %ASSERT THE INEQUALITY;
    RETURN NIL
  END;

SYMBOLIC PROCEDURE CONSTRAINEDREDUCTIONS RHS;
 BEGIN SCALAR RELS,FG;
TOP:
    IF RHS=NIL THEN RETURN REVERSEWOC RELS;
    FG:=NEWEQUATION(NUMR LC RHS,T); %NON-ZERO LEADING TERM;
    IF NOT(FG='INCONSISTENT) THEN
        RELS:=(RHS . CURRENTSPACE()) . RELS;
    DROPEQUATION();
    FG:=NEWEQUATION(NUMR LC RHS,NIL); %NOW LT = 0;
    IF FG='INCONSISTENT THEN RETURN REVERSEWOC RELS;
    RHS:=RED RHS;
    GO TO TOP END;

SYMBOLIC PROCEDURE PRINTREDUCTION A;
 BEGIN
    PRINTC "**** REDUCTION FORMULA ****";
    PRINTDF CAR A;
    SETLINSPACE CDR A;
    PRINTLINSPACE()
 END;

SYMBOLIC PROCEDURE INTERFERE(A,B);
 BEGIN
   IF !*TRJHD THEN PRINTC "POTENTIAL CANCELLATION DETECTED"
 END;


%**********************************************************************;
% FROM HERE DOWN I HAVE CODE LEFT OVER FROM THE PREVIOUS VERSION;


%SYMBOLIC PROCEDURE SHIFTMATCH(FORM,P1,P2);
%    SFSUBLIS(FORM,SHIFTASSOC(P1,P2,INDEXLIST));

%SYMBOLIC PROCEDURE SHIFTASSOC(P1,P2,L);
%    IF NULL L THEN NIL
%    ELSE ((CAR L) . (CAAR P1 - CAAR P2)) .
%                         SHIFTASSOC(CDR P1,CDR P2,CDR L);


%SYMBOLIC PROCEDURE SFSUBLIS(FM,L);
%    IF DOMAINP FM THEN FM
%    ELSE BEGIN
%      SCALAR W;
%      W:=ATSOC(MVAR FM,L);
%      IF W NEQ NIL THEN <<
%        W:=CDR W;
%        IF W=0 THEN W:=NIL >>;
%      W:=(MKSP(MVAR FM,1) .* 1) .+ W;
%      W:=!*MULTF(W,SFSUBLIS(LC FM,L));
%      RETURN ADDF(W,SFSUBLIS(RED FM,L)) END;





%SYMBOLIC PROCEDURE CONSTANTOFINTEGRATION();
% BEGIN SCALAR N;
%    IF NOT NULL INEQUALITYSTACK THEN RETURN NIL;
%%TO BE RECOGNIZED, THE TERM HERE MUST BE TOTALLY CONSTRAINED;
%%BY EQUALITIES, AND MUST MATCH THE C OF I ALREADY SET IN ULIST;
%    N:=LENGTH EQUALITYSTACK;
%    IF NOT (N=NINDEX-1) THEN RETURN NIL;
%    RETURN MATCHP(LPOW ULIST,EQUALITYSTACK,INEQUALITYSTACK) END;


%SYMBOLIC PROCEDURE DFSUBLIS(P,L);
%    DFSUBLIS1(P,L,MAPCAR(L,FUNCTION CDR));

%SYMBOLIC PROCEDURE DFSUBLIS1(P,L1,L2);
%    IF NULL P THEN NIL
%    ELSE (LAMBDA COEF,REST;
%      IF NULL COEF THEN REST ELSE
%        (PLUSLISTS(LPOW P,L2) .* (COEF ./ DENR LC P)) .+ REST)
%      (SFSUBLIS(NUMR LC P,L1),DFSUBLIS1(RED P,L1,L2));

%SYMBOLIC PROCEDURE PLUSLISTS(L1,L2);
%    IF NULL L1 THEN NIL
%    ELSE ((CAAR L1 + CAR L2) . NIL) . PLUSLISTS(CDR L1,CDR L2);


%SYMBOLIC PROCEDURE INVERTCLASHES();
% BEGIN
%    CANCELLATIONLIST:=NIL;
%    MAPC(HIDE,FUNCTION CLASH);
%    MAPC(CANCELLATIONLIST,FUNCTION PRINTCANCEL);
% END;

%SYMBOLIC PROCEDURE PRINTCANCEL L;
% BEGIN
%    EQUALITYSTACK:=CAAR L;
%    INEQUALITYSTACK:=CDAR L;
%    PRINTC "A PHANTOM MAY BE NEEDED WHEN THE LEADING TERM SATISFIES";
%    PRINTLINSPACE();
%    PRINTC "OFFSETS =";
%    MAPC(CDR L,FUNCTION PRINTC);
%    TERPRI()
% END;


%SYMBOLIC PROCEDURE CLASH(A);
%% A IS THE STRUCTURE ((A . B) . (EQUAL . INEQUAL))
%% CREATE A CORRESPONDING ENTRY ON CALCELLATIONLIST;
% BEGIN
%    SCALAR RF1,RF2,LINEQ;
%    LINEQ:=CDR A;
%    RF1:=CAAR A;
%    RF2:=CDAR A;
%    A:=PLUSDF(RED RF1,RED RF2);
%% NOW LT A IS MAYBE IMPORTANT TERM LEFT OVER;
%    LINEQ:=SHIFTEQNS(CAR LINEQ,UNLIST LPOW A) .
%             SHIFTEQNS(CDR LINEQ,UNLIST LPOW A);
%    A:=FORMDELTAS(LPOW A,LPOW RF1);
%    CANCELLATIONLIST:=(LINEQ . LIST A) . CANCELLATIONLIST;
%    RETURN NIL
% END;

%SYMBOLIC PROCEDURE UNLIST L;
%    IF NULL L THEN NIL
%    ELSE CAAR L . UNLIST CDR L;


%SYMBOLIC PROCEDURE FORMDELTAS(A,B);
%    IF NULL A THEN NIL
%    ELSE (CAAR A - CAAR B) . FORMDELTAS(CDR A,CDR B);

%SYMBOLIC PROCEDURE SHIFTEQNS(L,DELTA);
%    IF NULL L THEN NIL
%    ELSE SHIFTEQN(CAR L,DELTA) . SHIFTEQNS(CDR L,DELTA);


%SYMBOLIC PROCEDURE SHIFTEQN(V,DELTA);
% BEGIN SCALAR W,I,NEW;
%    NEW:=MKVECT NINDEX;
%    FOR I:=0:NINDEX DO PUTV(NEW,I,GETV(V,I));
%    V:=NEW;
%    I:=2;
%    W:=NIL;
%    WHILE DELTA DO <<
%        W:=ADDF(W,!*MULTF(GETV(V,I),CAR DELTA));
%        DELTA:=CDR DELTA >>;
%    PUTV(V,1,ADDF(GETV(V,1),NEGF W));
%    RETURN V
% END;

ENDMODULE;

END;

