Artifact 0614f5cd659951460ecc1b8cf869a0aa3bf385325a4bf4ce769403871881d5e0:
- Executable file
r37/packages/scope/codopt.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 70049) [annotate] [blame] [check-ins using] [more...]
- Executable file
r38/packages/scope/codopt.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 70049) [annotate] [blame] [check-ins using]
module codopt; % Generalization of Breuer's Growth Factor Algorithm. % ------------------------------------------------------------------- ; % Copyright : J.A. van Hulzen, Twente University, Dept. of Computer ; % Science, P.O.Box 217, 7500 AE Enschede, the Netherlands.; % Authors : J.A. van Hulzen, B.J.A. Hulshof, W.N. Borst. ; % ------------------------------------------------------------------- ; symbolic$ %-------------------------------------------------------------------- ; % The module CODOPT contains: ; % ; % THE GENERALIZED VERSION OF BREUER'S GROWTH FACTOR ALGORITHM ; % ; % A description can be found in : ; % M.A. Breuer : "Generation of Optimal Code for Expressions via ; % Factorization", Comm.ACM 12, 333-340 (1969). ; % J.A. van Hulzen : "Breuer's Grow Factor Algorithm in Computer ; % Algebra",Proceedings SYMSAC '81 (P.S. Wang, ed.), 100-104, New ; % York: ACM(1981). ; % J.A. van Hulzen : "Code Optimization of Multivariate Polynomial ; % Schemes : A Pragmatic Approach", Proceedings EUROCAL '83 (J.A. ; % van Hulzen, ed.),Springer LNCS-series nr 162, 286-300 (1983). ; % ------------------------------------------------------------------- ; % ; % ------ DATA STRUCTURES AND WEIGHTS ------ ; % Via FFVAR!! and in combination with SSETVARS(also the CODMAT module); % a set of input-expressions is decomposed and stored in the "matrix" ; % CODMAT. ; % The Breuer-like searches, for finding common subexpressions (cse's ; % for short), concentrate on Zstrt's, defining the primitive parts ; % (pp's for short) of input-expressions. These pp's are either linear ; % expressions (Opval='PLUS) or monomials (Opval='TIMES). The pp's be- ; % long to larger expressions if CHROW is not NIL at the same level or ; % if the FarVar-field of the row contains a rowindex (of a father ex- ; % pression). ; % The Zstrt is a list of pairs Z.Such a Z consists of a (column)index,; % denoted by XIND(Z) or YIND(Z) and an integer value IVAL(Z), being ; % the exponent (or coefficient) of the variable corresponding with the; % column-index, occurring in this pair. In a similar way columns are ; % used to define the occurrences of variables in the description of ; % the input-expressions( see the CODMAT module). ; % Each row or column has a weight WGHT=((AWght.MWght).HWght), where ; % HWght=AWght + 3*MWght. The A(dditive)W(ei)ght is the length of the ; % Zstrt. The M(ultiplicative)W(ei)ght is its number of (|IVAL|>1)-ele-; % ments. The factor 3 reflects the assumption that multiplication is 3; % times as expensive as addition. The HWghts play an essential role in; % the heuristics (on which the Breuer searches are based) and are com-; % puted and stored via application of the procedure INITWGHT (see the ; % CODMAT module). ; % NOTE : It is of course possible to make the factor 3 a parameter. ; % This requires some resettings in the weight-routines (see the module; % CODMAT). ; % HWghts can be associated with both rows and columns. ; % This allows to produce weightfactors (see the references), to be ; % associated with rows (or columns) to refine heuristic decisions, if ; % required. The weightfactor of a row(column) is the sum of the HWghts; % of those columns(rows) which share a non-zero entry with it.Although; % the use of weightfactors might improve decision making, its over- ; % head in computational cost can be considerable, certainly when the ; % CODMAT-matrix is large. The visual intuitive selection-mechanisms ; % for cse-building (extend a set of column-indices against the price ; % of reducing the number of parents (rows)) can be impractical, becau-; % se - certainly initially - the number of variables is a fraction of ; % the number of rows, corresponding with (sub)pp's. ; % So we drop the weightfactors and we select rows instead of columns. ; % To speed up the row-selection all rows with an equal HWght are col- ; % lected in a double linked list, using the HiR-fields. These sets are; % accessible via the elements of the CODHISTO-vector (details are gi- ; % ven in the CODMAT module, procedure INSHISTO). We recall only that ; % CODHISTO(i) = k means that HWght(k) = i and that HiR(k) allows to ; % access the FILO-list of rows j with HWght(j) = i. ; % NOTE : These FILO-lists, a kind of buckets, can contain both PLUS- ; % and TIMES-rows if both are SETFREE (see the COSYMP module and again ; % INSHISTO). The operator-type is irrelevant during the Breuer-search.; % In fact, it is only explicitly required in the procedure ADDCSE. ; % ; % ------ THE SEARCHES : THE ESSENTIALS ------ ; % Initially the cse's are either linear expressions or monomials. To ; % discover them the integer-matrices (CODMAT-parts with PLUS and TIMES; % Opval-fields,respectively), are heuristically searched for submatri-; % ces of rank 1 of maximal size. The size is determined, using a ; % profit-criterium. A basic scan is used, which can be qualified as ; % "test whether the determinant of a (2,2)-matrix of non-zero entries ; % is zero". Its use is based on information about the row-weights, ; % which allow to locate completely dense submatrices. The row-weight ; % is a reflection of the arithmetic complexity of the pp,corresponding; % with the row. Since we want to reduce the arithmetic complecity AC =; % (n+,n*) of the set of input-expressions, a cse-selection ought to ; % contribute to a reduction of the number of additions (n+) and/or the; % number of multiplications (n*). This is only possible if the cse oc-; % curs at least twice and if the additive weight AWght is at least 2. ; % The profit-criterium WSI is based on this assumption. Its actual va-; % lue is (|Psi|-1) * (|Jsi|-1). Here Psi is the set of Parent- row in-; % dices and Jsi is the set of indices of columns, which are associated; % with variables occurring in the cse under construction. ; % Once a cse is found its description is removed from the rows,defined; % by Psi, and from the columns, with indices in Jsi. The cse itself is; % added to CODMAT as a new row. It has a system-selected name (given ; % in the FarVar-field and produced with FNEWSYM (see CODCTL module)), ; % which is also used as recognizer of the new column added to CODMAT, ; % to define the occurrences of the new cse (via the Psi-set). In addi-; % tion the HWghts of the Psi rows, used in the previous resettings are; % recomputed and reinserted via CODHISTO and the cse-row is entered in; % CODHISTO, to allow it to play its own role in the optimization. We ; % also insert the new cse in the output hierarchy via the ORDR-field ; % of the Psi-parents, associated with the cse. We finally remark that ; % it also might be possible that the cse is identical to one or more ; % of its parent-pp's. In this case it might be necessary to migrate ; % information from the PLUS(TIMES)-matrix to the TIMES(PLUS)-matrix. ; % Further details are given in the source, contained in this module. ; % ; % Essentially all searches are done in Zstrt's. A Zstrt is a list of ; % pairs (index . value). The ordering in the Zstrt is based on the ; % indices. A column-Zstrt contains (positive) row-indices, given in ; % descending order. A row-Zstrt contains (negative) column-indices, ; % given in ascending order. The indices define relative positions. In ; % all operations on CODMAT information-pieces (except for MKZEL-calls); % these relative positions, produced via Rowmax and Rowmin value chan-; % ges, are needed for information retrieval and information storage. ; % These relative CODMAT-positions are used during the searches, i.e. ; % the sets (lists) Psi and Jsi are built with them.During the searches; % ordering is only relevant if the procedure PnthXZZ is used. The ap- ; % plication PnthXZZ(A,B) delivers the Zstrt B, but after removal of ; % the elements preceding the Z-element with the A-index. This Z-elem. ; % can thus be obtained as CAR(PnthXZZ(A,B)). Since the searches are ; % based on row-selection followed by Jsi-resettings, only ordering in ; % Jsi is relevant. When a cse is found, Psi is ordered, before making ; % and adding to CODMAT the corresponding Zstrt. ; % ; % ------ DOMAIN CONSIDERATIONS ------ ; % As stipulated above operator considerations are hardly relevant du- ; % ring cse-searches. Identical tests can be applied for cse's occur- ; % ring in linear expressions as well as in monomials, albeit that via ; % the Expand- and ShrinkProd mechanism additional searches are perfor-; % med for monomial-cse's, simply because the mathematical context is ; % somewhat richer. When allowing various coefficient domains, a dis- ; % tinction between coefficient- and exponent searches is needed : ; % Assuming MkZel, SetIVal and IVal become generic functions, the fol- ; % lowing changes in CODOPT are required : ; % - ExtBrsea - A double CODHISTO-mechanism ( to allow to analyse PLUS ; % and TIMES rows separately) is required and doubles in ; % fact initialization, as well as appl. of ExtBrsea1. ; % - TestPr - The zero-minor test has to be made generic. ; % - RZstrtCse- The GC-computations uses ABS-value computations, which ; % ought to be generic, as well as the gcd comp.'s with ; % - Gcd2 - This routine must be generic. ; % - CZstrtCse- The ZZcse-construction requires multiplication factor ; % computations, i.e. divisions of domain-elements, which ; % ought to be generic. ; % ------------------------------------------------------------------- ; % ------------------------------------------------------------------- ; % The global identifiers needed in this module are : ; % ------------------------------------------------------------------- ; global '(psi jsi npsi njsi wsi rcoccup roccup1 roccup2 newjsi newnjsi codhisto headhisto rowmin rowmax )$ % ------------------------------------------------------------------- ; % Description of the global variables used in this module (see also ; % the CODMAT module): ; % ------------------------------------------------------------------- ; % Roccup1 : Indices of rows, which become (temporarily) irrelevant ; % during a cse search (see procedure FindOptRow). ; % Roccup2 : Indices of rows, which were (temporarily) selected as ; % candidate-parent row (see procedure FindOptRow). ; % RCoccup : Indices of rows and columns, either used for building ; % the cse or leading to a failure, i.e. to Wsi=0. ; % Psi : Indices of the parents of the cse. ; % NPsi : Number of elments in Psi. ; % Jsi : A list of column indices representing the current cse. ; % NJsi : Number of elements in Jsi. ; % NewJsi : Contains the new Jsi if a certain rowindex is added to ; % Psi (see FINDOPTROW). ; % NewNJsi : Number of elements in NewJsi. ; % Wsi : Profitfunction = (|Psi|-1)*(|Jsi|-1). See proc. TestRed.; % CodHisto : Vector representing the Histogram. ; % Headhisto : CodHisto(i) = 0 if i > Headhisto, i.e. the list of rows ; % with HWght = HeadHisto is accessible via CodHisto(Head- ; % Histo). ; %-------------------------------------------------------------------- ; rcoccup:=roccup1:=roccup2:=nil; symbolic procedure extbrsea; % ------------------------------------------------------------------- ; % The main procedure governing the Breuer-searches. Both,monomials and; % linear expressions, can be found as cse. ; % ------------------------------------------------------------------- ; begin scalar further; % ---------------------------------------------------------------- ; % We start excluding those rows and columns, which are irrelevant ; % for our searches : Either the FarVar-field = -1 (This setting is ; % performed by application of the procedure ClearRow, defined in ; % the module CODMAT, and expresses that a row or column is not in ; % use anymore) or = -2 (Columns reservedto store temporarily mono- ; % mial information created in ExpandProd and removed in ShrinkProd); % ---------------------------------------------------------------- ; for x:=rowmin:rowmax do if farvar(x)=-1 or farvar(x)=-2 then setoccup(x) else setfree(x); % ---------------------------------------------------------------- ; % After initialization the searches are performed. ; % ---------------------------------------------------------------- ; initbrsea(); extbrsea1(); % ---------------------------------------------------------------- ; % The remaining monomials can further be analysed for cse-occurren-; % ces when they are temporarily expanded, using a specific addition; % chain mechanism (see procedure EXPANDPROD). ; % ---------------------------------------------------------------- ; repeat <<expandprod(); for x:=rowmin:rowmax do if not(farvar(x)=-1) and opval(x) eq 'times then setfree(x) else setoccup(x); initbrsea(); extbrsea1(); % ------------------------------------------------------------- ; % Once the continued searches, based on expanded monomial infor-; % mation, are completed, the original monomial-variable informa-; % tion structure is restored by shrinking the sets of columns, ; % associated with the various monomial-variables, together into ; % the originally used columns (details are given in the procedu-; % re SHRINKPROD). ; % ------------------------------------------------------------- ; further:=shrinkprod(); >> until not(further); % ---------------------------------------------------------------- ; % Once the Breuer-searches are completed control is passed over to ; % IMPROVELAYOUT, before TCHScheme and finally CODFAC are used. ; % TCHScheme allows information migration and CODFAC application of ; % the distributive law. Application of IMPROVELAYOUT might lead to ; % the conclusion that the Expand-Shrink activities resulted in re- ; % dundant cse-names, such as a double name for x^2 or the like. ; % Details are given in OPTIMIZELOOP (see the module CODCTL). ; % ---------------------------------------------------------------- ; end; symbolic procedure initbrsea; % ------------------------------------------------------------------- ; % The CODMAT-submatrices are prepared for the Breuer-searches. ; % The weights are set, the vector CODHISTO gets its initial values ; % and redundant information is temporarily removed. It is of course ; % needed again for output and eventually during later stages of the ; % optimization process, due to information migration. Information is ; % redundant when a row or column, i.e a Zstrt, only contains one Z- ; % element. This demands for a recursive search through CODMAT, since ; % a redundant row can lead to a redundant column if the element they ; % share ought to be disregarded. ; % ------------------------------------------------------------------- ; begin scalar hlen; hlen:=histolen; for x:=rowmin:rowmax do if free(x) then initwght(x); % ----------------------------------------------------------------- ; % Only the weights for relevant rows and columns are computed. Once ; % the weights are known, the redundancy can be removed using : ; % ----------------------------------------------------------------- ; redcodmat(); % ----------------------------------------------------------------- ; % If the vector CODHISTO is already known, it might have been crea- ; % ted during a previous use of the Optimizer. In this case its en- ; % tries are set to NIL. Otherwise it is created, before the HWght- ; % information is stored in the HiR-fields and in CODHISTO. ; % ----------------------------------------------------------------- ; if codhisto then for x:=0:histolen do sethisto(x,nil) else codhisto:=mkvect(hlen); headhisto:=0; for x:=0:rowmax do inshisto(x); end; symbolic procedure redcodmat; % ------------------------------------------------------------------- ; % Recursive removal of redundant information using the procedure ; % TestRed. ; % ------------------------------------------------------------------- ; for x:=rowmin:rowmax do testred(x); symbolic procedure testred(x); % ------------------------------------------------------------------- ; % If the row or column X is still relevant but has an additive weight ; % of 1 or 0 its information is irrelevant for the searches. ; % Remark : It is possible to consider the LOWER BOUND of 2 as a PARA- ; % METER. If we are only interested in cse's of a LENGTH of AT LEAST M ; % we have to replace the 2 by M and to MAKE this M GLOBAL. It demands ; % a revision of the procedure DOWNWGHT1 and similar routines, given in; % the CODMAT module, and a modification of the profit criterium WSI ; % (see the procedure EXTBRSEA1). ; % So when a row is redundant we declare it to be occupied and reduce ; % the weights of the column its shares its element with, before we ; % test if this column is now redundant as well. The role of rows and ; % columns are thus interchangeable. ; % ------------------------------------------------------------------- ; if free(x) and awght(x)<2 then <<setoccup(x); foreach z in zstrt(x) do <<downwght1(yind z,ival z); testred(yind z)>> >>; symbolic procedure extbrsea1; % ------------------------------------------------------------------- ; % This procedure defines the kernel of the generalized Breuer-search. ; % It is based on the basic scan for zero-determinants. An explanation ; % is given, using a (6,4)-matrix B of integers, which can also be ; % found in Van Hulzen '83, p.295 : ; % ; % column -4 -3 -2 -1 ; % ; % row 6 | 0 0 1 1 | AWght = 2 MWght = 0 HWght = 2 CodHisto( 2) = 6 ; % 5 | 0 1 2 2 | 3 2 9 ( 9) 5 ; % 4 | 0 2 2 3 | 3 3 12 (12) 4 ; % 3 | 2 3 4 5 | 4 4 16 (16) 3 ; % 2 | 4 6 0 0 | 2 2 8 ( 8) 2 ; % 1 | 1 6 8 10 | 4 3 13 (13) 1 ; % ; % AWght = 3 5 5 5 ; % ; % Hence Zstrt(-4) = ((3.2) (2.4) (1.1)) ; % and Zstrt( 6) = ((-2.1)(-1.1)). ; % ------------------------------------------------------------------- ; begin scalar hr,hc,x; while hr:=findhr() do % ----------------------------------------------------------------- ; % ExtBrsea1 consists of a WHILE-loop,which is executed as long as ; % a first parent-row can be found using CODHISTO, via FindHR. So ; % initially Psi = (HR). ; % ----------------------------------------------------------------- ; if hc:=findhc(hr) % ---------------------------------------------------------------- ; % As long as a row HC can be found, which can be used in combinati-; % on with HR, the cse-search continues. Since redundancy is removed; % the AWght of HC is at least 2. Via FINDHC the column with maximal; % AWght, which shares a non-zero element with Row(HR) is selected. ; % ---------------------------------------------------------------- ; then <<wsi:=0; while not null(x:=findoptrow(hr,hc,(wsi/npsi)+1)) do brupdate(x); % ------------------------------------------------------------ ; % The Breuer-search continues as long as profit is gained. The ; % minimal rowlength for continuation is Floor(Wsi/NPsi) + 2. ; % The number of rows is iteratively extended : ; % NPs(i+1) = NPs(i) + 1 or NPsi = NPs(i+1) - 1. ; % Since Ws(i+1) > Ws(i) or NPsi * (NJs(i+1) - 1) > Ws(i), the ; % number of columns, which are required for a further cse-exten; % sion is at least NJs(i+1),i.e. is larger than Floor(Wsi/NPsi); % + 1. ; % ------------------------------------------------------------ ; foreach x in roccup1 do setfree(x); % ------------------------------------------------------------ ; % Not usable during construction of the present cse. Given free; % again for a next attempt, with of course another HR. ; % ------------------------------------------------------------ ; foreach x in roccup2 do setfree(x); % ------------------------------------------------------------ ; % Used for cse-construction, but now possibly reusable. ; % ------------------------------------------------------------ ; roccup1:=roccup2:=nil; if wsi>0 then <<foreach x in rcoccup do setfree(x); rcoccup:=nil; % -------------------------------------------------------- ; % Rows and Columns used for building the cse can eventually; % be usable again. Hence also given free again. ; % Finally all necessary resettings in CODMAT and CODHISTO ; % are performed with AddCse, before the search for further ; % cse's is continued. ; % -------------------------------------------------------- ; addcse()>> else if npsi=1 then << % ---------------------------------------------------- ; % If Wsi = 0 and NPsi = 1 the (HR,HC)-selection was un-; % lucky.No cse is found, i.e. HC has to be disregarded.; % ---------------------------------------------------- ; setoccup(hc); rcoccup:=hc.rcoccup >> >> else << % ---------------------------------------------------------- ; % No columns available for cse-construction using the row HR.; % Hence HR is an unlucky choise. The elements of RCoccup are ; % freed to be reused. HR is disregarded via RowDel(HR), with ; % as a consequence a possible, intermediate introduction of ; % redundancy, which can be removed by applying TestredZZ. ; % ---------------------------------------------------------- ; foreach x in rcoccup do setfree(x); rcoccup:=nil; rowdel(hr); testredzz(hr) >> end; symbolic procedure findhr; % ------------------------------------------------------------------- ; % CODHISTO is subjected to a top-down search to find the non-zero en- ; % try with maximal index, i.e. to find the index of the most interes- ; % ting row. This is row 3 in the example in the comment in ExtBrsea1. ; % This value is returned. In addition Psi, NPsi and RCoccur are initia; % lized (Psi = (3), NPsi = 1 and RCoccur = (3),for example). Finally ; % row X (= 3), selected as most attractive row, is removed from the ; % candidate rows, by assigning NIL to the FREE-field. ; % Note that X = Nil is possible, implying that the search, defined in ; % ExtBrsea1,is finished during this stage of the optimization process.; % ------------------------------------------------------------------- ; begin scalar x; while headhisto>0 and null(x:=histo headhisto) do headhisto:=headhisto-1; if x then <<psi:=list x; npsi:=1; setoccup(x); rcoccup:=x.rcoccup>>; return x end; symbolic procedure findhc(hr); % ------------------------------------------------------------------- ; % HR is the index of a row, for instance selected with FindHR. ; % The Zstrt of HR is used to select the column, which can best be used; % in combination with the row HR to start constructing a cse, i.e. the; % "leftmost" column with locally maximal AWght. When looking at the ; % example in ExtBrsea1 this will be column -3. ; % In addition Jsi and NJsi are initialized. Only the columns, which ; % are FREE are used( Jsi = (-1 -2 -3 -4), NJsi = 4).The return value ; % is Y = -3. ; % NOTE :ExtBrsea1 is applied as long as it is possible.This might lead; % to the need of disregarding columns during some stage in the itera- ; % tive process. Therefore the test FREE(Y1:=Yind Z) is required. ; % ------------------------------------------------------------------- ; begin scalar y,y1,aw,awmax; awmax:=njsi:=0; jsi:=nil; foreach z in zstrt(hr) do if free(y1:=yind z) then <<jsi:=y1.jsi; njsi:=njsi+1; if (aw:=awght y1)>awmax then <<awmax:=aw; y:=y1>> >>; jsi:=reverse(jsi); return y end; symbolic procedure findoptrow(hr,hc,lmax); % ------------------------------------------------------------------- ; % The row-index HR and the column-index HC are used to find a Row(X),; % applying the test defined in the procedure TestPr, such that Row(HR); % and Row(X) have a cse of at least a length Lmax + 1. ; % If HR =3 and HC = -3 FindOptRow will produce X = 1. ; % In TestPr a zero-minor-test is performed, always using B(HR,HC), and; % here for shortness called Bil. Bil is used in all the TestPr-tests. ; % These tests are done for all rows, which share a non-zero element ; % with the column HC, and which are not yet disregarded for further ; % searches.The new version of Jsi is assigned to the local variable S,; % i.e. the return-value of TestPr. If S is a list of one element, HC, ; % its Cdr is Nil, i.e Row(X1) does not contribute to a possible cse, ; % contained in a pp, defined by Row(HR). Then X1 is added to the list ; % Roccup1. If the profit is satisfactory, i.e. if the list S is longer; % than Lmax a new set of column-indices, called NewJsi, is created and; % the index X1 is also renamed and returned. Hence when no X1 is found; % X is not initialized, implying that Nil is returned. ; % Regardless of X1's role, it is added to the list Roccup2 if S con- ; % tains at least 2 elements. Before returning to the calling procedure; % ExtBrsea1, the FREE-field of Row(X1) is set to Nil, implying that it; % is disregarded until further notice. ; % TestPr produces S = (-1 -2 -3). ; % ------------------------------------------------------------------- ; begin scalar l,s,x,x1,bil; bil:=ival(car pnthxzz(hc,zstrt hr)); foreach z in zstrt(hc) do if free(x1:=xind z) then <<if null(cdr(s:=testpr(x1,hr,ival z,bil))) then roccup1:=x1.roccup1 else <<if (l:=length s)>lmax then <<newnjsi:=lmax:=l; x:=x1; newjsi:=s >>; roccup2:=x1.roccup2 >>; setoccup(x1) >>; return x end; symbolic procedure testpr(x,hr,bkl,bil); % ------------------------------------------------------------------- ; % TestPr is a procedure to perform zero-minor tests. ; % X and HR are row-indices. Bkl = B(X,HC) and Bil = B(HR,HC). ; % The test is : Is Bil*Bkj - Bij*Bkl = 0? ; % Assumptions : Bkj = B(X,j) and Bij = B(HR,j), where j is running ; % through Jsi, the set of indices of columns, which share a non-zero ; % element with Row(HR).HC is an element of Jsi. ; % The new JSI-set is returned. It contains at least HC. ; % ------------------------------------------------------------------- ; begin scalar zz,zzhr,x1,y,p,ljsi,cljsi; ljsi:=jsi; zz:=zstrt(x); zzhr:=zstrt(hr); while ljsi and zz do if (cljsi:=car ljsi)=(x1:=xind car zz) then << % -------------------------------------------------------------- ; % The list LJsi is initially equal to the already existing Jsi,a ; % list consisting of column-indices. The lists ZZ and ZZHR are, ; % initially the Zstrt's of Row(X) and Row(HR), respectively. The ; % Zstrt's consist of pairs (column-index . coefficient/exponent).; % The WHILE-loop is performed as long as the lists LJsi and ZZ ; % are not yet empty. The test defining alternative actions is ba-; % sed on a comparison of the car-elements of the remaining parts ; % of these lists, which are given in ascending index-order. ; % -------------------------------------------------------------- ; zzhr:=pnthxzz(cljsi,zzhr); % -------------------------------------------------------------- ; % The Zstrt ZZHR is also in ascending order. If the Car of LJsi, ; % CLJsi, is equal to X1, the column-index of the Car of Zstrt(X),; % the elements of Zstrt(HR), preceding the element, containing ; % CLJSI as column-index,are removed from ZZHR. ; % This can imply that ZZHR =(),i.e. that Car(ZZHR) = Nil and that; % IVal(Car(ZZHR)) = 0. ; % -------------------------------------------------------------- ; if zeropp(dm!-difference(dm!-times(ival(car zz),bil), dm!-times(ival(car zzhr),bkl))) then p:=cljsi.p; comment if zeropp(dm!-difference(dm!-quotient(bil,bkl), dm!-quotient(ival(car zzhr),ival(car zz)))) then p:=cljsi.p; % -------------------------------------------------------------- ; % CLJsi can be added to the new Jsi-list, which is under construc; % tion, using P, if the test succeeds.Here Ival(Car ZZ) = Bkj and; % IVal(Car ZZHR) = Bij. ; % -------------------------------------------------------------- ; ljsi:=cdr(ljsi); zz:=cdr(zz) >> else if cljsi>x1 % --------------------------------------------------------------- ; % The lists are in ascending order. Hence if the Car's do not ; % match one of the two has to be skipped. ; % --------------------------------------------------------------- ; then zz:=cdr(zz) else ljsi:=cdr(ljsi); return p end; symbolic procedure brupdate(x); % ------------------------------------------------------------------- ; % Assume Row(X) was found with procedure FindOptRow. It is the most ; % recently found cse-parent. Therefore the administration needs some ; % updating : The set Psi of parents must be extended with X, the set ; % Jsi of column-indices ought to be replaced by NewJsi and (de)activa-; % tion of relevant rows(columns) ought to take place. ; % ------------------------------------------------------------------- ; <<psi:=x.psi; npsi:=npsi+1; jsi:=reverse(newjsi); njsi:=newnjsi; wsi:=(njsi-1)*(npsi-1); % ----------------------------------------------------------------- ; % Roccup2 is the set of indices of rows, which can possibly contri- ; % bute to a cse. During the previous FindOptRow-step Row(X) received; % apparently a higher priority. Row(X) is not longer a candidate pa-; % rent for the cse, presently being built. ; % ----------------------------------------------------------------- ; foreach x in roccup2 do setfree(x); roccup2:=nil; setoccup(x); rcoccup:=x.rcoccup >>; symbolic procedure addcse; % ------------------------------------------------------------------- ; % The cse defined by the index-sets Psi and Jsi is added to CODMAT. ; % So its occurrences in the rows,which have an index in Psi, are remo-; % ved, the description of the cse is added as a new row to CODMAT and ; % the system-selected cse-name is used to head a new column,defining ; % occurrences in the parent-rows. In combination with these measures ; % some weights have to be reset and thus also some information in ; % CODHISTO. The cse-ordering has - finally - to be taken care of via ; % the procedure SETPREV (see the CODMAT module for comment). ; % ------------------------------------------------------------------- ; begin scalar zz,zzr,zzc,lzzr,lzzc,opv,var,gc,flt,min; zzr:=lzzr:=rzstrtcse() ; lzzc:=czstrtcse(ival car zzr); gc:=dm!-abs(ival car lzzc); min:=gc; flt:=floatprop(gc); foreach zz in lzzc do % We have to test all the zz elements << % because one could be a float flt:=flt or floatprop(ival zz); min:=dm!-min(min,dm!-abs(ival zz)); if not(flt) then gc:=gcd2(gc,abs(ival zz)) >>; if flt then gc:=min; % When a float was encountered we take the % smallest IVal, otherwise the gcd. if not(!:onep gc) then % Correct when flt. << zz:=nil; % When not(flt) gc<1 is not possible foreach z in zzr do zz:=mkzel(xind z,dm!-times(ival(z),gc)).zz; zzr:=lzzr:=reverse zz; zz:=nil; foreach z in lzzc do zz:=mkzel(xind z,dm!-quotient(ival(z),gc)).zz; lzzc:=reverse zz >>; zz:=nil; % ----------------------------------------------------------------- ; % ZZr and LZZr are assigned a row-Zstrt, in ascending order, defi- ; % ning the cse, which must be added to CODMAT, in row Rowmax. ; % LZZc is the column-Zstrt of the cse in ascending, thus "wrong" or-; % der. But LZZc is reversed, when updating the parent-rows in the ; % Psi-loop. Similarly LZZr is used in the Jsi-loop for updating co- ; % lumns. ; % ----------------------------------------------------------------- ; var:=fnewsym(); rowmax:=rowmax+1; setrow(rowmax,opv:=opval car jsi,var,list nil,zzr); % ----------------------------------------------------------------- ; % List Nil, parameter 4, defines the empty list of children and ex- ; % presses that also the EXPCOF-field of row(Rowmax) remains unused. ; % ----------------------------------------------------------------- ; rowmin:=rowmin-1; setrow(rowmin,opv,var,nil,nil); % ----------------------------------------------------------------- ; % The column(Rowmin) is reserved for the cse-description reverse( ; % LZZc). Only the name Var is stored in the FarVar-field, like the ; % operator-value in the OPVAL-field. ; % ----------------------------------------------------------------- ; if opv eq 'plus then put(var,'varlst!+,rowmin) else put(var,'varlst!*,rowmin); put(var,'rowindex,rowmax); % ----------------------------------------------------------------- ; % The new cse-name is stored either in the list of add.variables or ; % in the list of multiplicative variables. Its row-index is stored ; % to allow retrieval of relevant information later on. ; % ----------------------------------------------------------------- ; foreach x in psi do <<zz:=remzzzz(zzr,zstrt x); zzc:=car(lzzc).zzc; setzstrt(x,mkzel(rowmin,val car lzzc).zz); delhisto(x); initwght(x); inshisto(x); setprev(x,rowmax); lzzc:=cdr(lzzc) % --------------------------------------------------------------- ; % The cse Zstrt-description is removed from all the parent-Zstrt's; % before the thus shortened Zstrt's are extended with the required; % information about occurence and multiplicity of the new cse,re- ; % presented by column(Rowmin). Since column-indices are negative ; % and row-Zstrt's are in ascending order a dotted pair constructi-; % on the SetZstrt-application is used. The Psi-loop allows to step; % wise reverse the column-Zstrt LZZc to produce the required form ; % ZZc, a Zstrt in descending order. ; % Once a row is modified it is removed from the CODHISTO-hierarchy; % and its HWght is recomputed before it is reinserted via CODHISTO; % Finally the ORDR-fields in the parents are reset, by adding the; % location of the new cse to the already stored information about ; % the output ordering.(see for SetPrev the module CODMAT). ; % --------------------------------------------------------------- ; >>; foreach y in jsi do <<setzstrt(y,mkzel(rowmax,val car lzzr).remzzzz(zzc,zstrt y)); lzzr:=cdr lzzr; initwght(y)>>; setzstrt(rowmin,zzc); % ----------------------------------------------------------------- ; % The column-Zstrt ZZc is removed from all the Jsi columns it is oc-; % curring in and ZZc itself is stored in column(Rowmin), already re-; % served for this purpose. All relevant column-HWghts are recomputed; % like done for row(Rowmax) : ; % ----------------------------------------------------------------- ; initwght(rowmax); inshisto(rowmax); initwght(rowmin); % ----------------------------------------------------------------- ; % Finally we test the modified columns and rows for redundancy. ; % ----------------------------------------------------------------- ; foreach x in jsi do testredh(x); foreach x in psi do testredh(x) end; symbolic procedure rzstrtcse; % ------------------------------------------------------------------- ; % The Zstrt defining the cse,associated with Psi and Jsi, is made. ; % Psi is a list of row-indices, defining the parents. ; % Jsi is a list of column -indices, defining the variables, occurring ; % in the cse. ; % Jsi is in ascending order. Psi is - in fact - not ordered. ; % This is due to the construction process. ; % The cse-Zstrt is made out of the Zstrt of Row(Car Psi). The IVal's ; % in this Zstrt (coefficients or exponents) can be either integers or ; % floats. When all of these IVals are integer (e.g. when dealing with ; % exponents) the parents contain an integer-multiple (or integral ; % power) of the cse. In this case, when constructing the cse-Zstrt ; % such that the IVal's are relative prime all further required ; % resettings lead to integer IVal's in CODMAT. ; % When one of the IVal's is a float, the smalest one is divided out. ; % Generally, this leads to float IVal's in CODMAT. ; % ------------------------------------------------------------------- ; begin scalar ljsi,zz,zzcse,gc,flt,min; zz:=pnthxzz(car jsi,zstrt car psi); zzcse:=list(car zz); gc:=dm!-abs(ival(car zz)); min:=gc; flt:=floatprop(gc); % ----------------------------------------------------------------- ; % All initializations for the WHILE-loop are made : ; % ZZ is that part of the Zstrt(Car Psi) that starts with the element; % containing the leftmost element of Jsi in its index-field. ; % So its first element is also the first element of the cse-Zstrt. ; % The IVal-value of this head-element is assumed to contain the gcd ; % of all the IVal's of the cse. During the WHILE-loop other elements; % of Jsi,collected in LJsi are consumed,thus producing the cse-Zstrt; % ----------------------------------------------------------------- ; foreach ljsi in cdr(jsi) do <<zz:=pnthxzz(ljsi,zz); flt:=flt or floatprop(ival car zz); min:=dm!-min(min,dm!-abs(ival car zz)); if not(flt) then gc:=gcd2(gc,abs(ival car zz)); zzcse:=car(zz).zzcse >>; if flt then gc:=min; % When a float has been encountered, the ; return % minimum of the ival's is divided out ; if !:onep(gc) or expshrtest() then reverse(zzcse) % -------------------------------------------------------------- ; % If GC = 1 the IVal's are relative prime or/so there is no need ; % to divide out an IVal. The ZZcse ought to be ; % reversed, because the cons-construction reverses the original ; % information. ; % The alternative expresses that the GC(d) of the exponents, de- ; % fining a monomial-cse, obtained after temporarily expanding the; % TIMES-columns, has not to be divided out, since it is in con- ; % flict with the information storage and retrieval of the tempo- ; % rarily used TIMES-columns, as realized by using the NPCD- and ; % PCDvar indicators in ExpandProd and ShrinkProd. ; % -------------------------------------------------------------- ; else <<zz:=nil; foreach z in zzcse do zz:=mkzel(xind z,dm!-quotient(ival(z),gc)).zz; % ---------------------------------------------------------- ; % Due to the cons-construction, reversion is now superfluous.; % The GC is divided out to get relative prime IVal's. ; % ---------------------------------------------------------- ; zz >> end; symbolic procedure gcd2(a1,a2); % ------------------------------------------------------------------- ; % The Gcd of A1 and A2 is computed. The value returned is positive, if; % A1 and A2 are positive. ; % ------------------------------------------------------------------- ; begin scalar a3; a3:=remainder(a1,a2); return if a3=0 then a2 else gcd2(a2,a3) end; symbolic procedure expshrtest; % ------------------------------------------------------------------- ; % ExpShrTest returns T is Jsi contains atleast one index of a column, ; % which is temporarily used to store (part of) the expanded represen- ; % tation of a column, defining a TIMES-variable. Such a column has a ; % -2 Farvar-value. Details : Expandprod and ShrinkProd. ; % ------------------------------------------------------------------- ; begin scalar ljsi,further; if not (opval(car jsi) eq 'plus) then << ljsi:=jsi; while (ljsi and not further) do << further:=(farvar(car ljsi)=-2); ljsi:=cdr ljsi>> >>; return(further) end; symbolic procedure czstrtcse(iv); % ------------------------------------------------------------------- ; % The row-Zstrt of the actual cse is made by applying RZstrtCse. The ; % parameter IV is the IVal of the head-element of this Zstrt. It will ; % be used to compute the multiplicity of the cse in the different pa- ; % rents. These multiplicities are stored as IVal's in the column-Zstrt; % associated with the new life of the cse as new variable. ; % ------------------------------------------------------------------- ; begin scalar lpsi,zz,zzcse; zz:=zstrt(car jsi); lpsi:=ordn(psi); % Standard Reduce function ; psi:=nil; % ----------------------------------------------------------------- ; % The set LPsi defines Psi in descending order, i.e. the ordering ; % needed for the construction of the column-Zstrt. ZZ is the Zstrt ; % of the column,which contains the parameter IV as one of its IVal's; % ZZ is used to produce the Psi elements, which form the cse-Zstrt, ; % called ZZcse.ZZ is in descending order. During the WHILE-loop exe-; % cution Psi is reconstructed in ascending order. ; % ----------------------------------------------------------------- ; while lpsi do <<zz:=pnthxzz(car lpsi,zz); zzcse:=mkzel(car lpsi,dm!-quotient(ival(car zz),iv)).zzcse; psi:=car(lpsi).psi; lpsi:=cdr(lpsi) % -------------------------------------------------------------- ; % ZZ is used to built ZZcse. Using Car(LPsi) the non-relevant e- ; % lements of ZZ are removed, allowing to access the next column- ; % element, which can be used to produce the cse-column. The mul- ; % tiplicity has to be stored as IVal of the actual Z-element, and; % is found by dividing the IVal of the present Car of ZZ by IV. ; % The IVal's of the row-Zstrt of the cse are relative prime, im- ; % plying that the IVal's of the relevant elements of ZZ are all ; % integral multiples of IV. ; % ZZcse is made in ascending order. ; % -------------------------------------------------------------- ; >>; return zzcse end; symbolic procedure testredzz(x); % ------------------------------------------------------------------- ; % TestredZZ is mutually recursive with TestredH and use in combination; % with this routine to remove redundancy from CODMAT. Always of course; % on a temporary basis. ; % ------------------------------------------------------------------- ; foreach z in zstrt(x) do testredh(yind z); symbolic procedure testredh(x); % ------------------------------------------------------------------- ; % Row (column) X is disregarded during further searches and its infor-; % mation is deleted from CODHISTO, if the length of Zstrt(X) is redu- ; % ced to 1. This redundancy test has to be done recursively. ; % ------------------------------------------------------------------- ; if free(x) and awght(x)<2 then <<rowdel(x); testredzz(x)>>; symbolic procedure expandprod; % ------------------------------------------------------------------- ; % Only linear-expression like monomial cse's are found when applying ; % ExtBrsea1. The zero-minor condition is too strong. Monomial cse be- ; % haviour is additive. Therefore addition chain mechanisms are employ-; % ed to extend the relevant TIMES-columns in a number of temporarily ; % used columns, of which all the non-zero elements have the same expo-; % nent value. Then ExtBrsea1 can be applied again, after relevant re- ; % settings in CODHISTO. Procedure Shrinkprod is applied to undo this ; % expansion after the additional searches. ; % Expandprod's functioning is illustrated by an example : ; % Assume : Y = -15, Var (= FarVar Y) = X and ; % Zstrt(Y) = ((6.1)(5.5)(4.5)(3.3)(2.5)(1.2)). ; % Zstrt(Y) is transformed into a matrix, using algorithm 2.1, given in; % van Hulzen '83, page 296-297. The overall functioning can be vizua- ; % lized in the following way : ; % ; % Before Expandprod Application After ; % ; % column|-15| column|-15 -23 -24 -40 | ; % +---+ +----------------+ ; % row 1 | 2 | row 1 | 1 1 | ; % 2 | 5 | 2 | 1 1 1 2 | ; % 3 | 3 | 3 | 1 1 1 | ; % 4 | 5 | 4 | 1 1 1 2 | ; % 5 | 5 | 5 | 1 1 1 2 | ; % 6 | 1 | 6 | 1 | ; % ----- ------------------ ; % ; % ------------------------------------------------------------------- ; begin scalar var,pcvary,pcdvar,zzr,ivalz,n,m,npcdvar,npcdv,col!*, relcols; for y:=rowmin:(-1) do if opval(y) eq 'times and not numberp(farvar y) and testrel(y) then relcols:=y . relcols; foreach y in relcols do << var := farvar y; % -------------------------------------------------------------- ; % TIMES-columns are only elaborated, when their Farvar-field is ; % not a number, i.e. is the name of a variable or a cse, and if ; % their Zstrt consists of at least 2 elements, which are not all ; % equal 1. ; % The Zstrt of such a column contains IVal's being powers of Var,; % the name associated with the column. ; % -------------------------------------------------------------- ; pcvary:=pcdvar:=zzr:=nil; foreach zel in zstrt(y) do if not((ivalz:=ival zel)=1) then <<setival(zel,1); % --------------------------------------------------------- ; % Zstrt(Y) is modified. All exponents are reduced to 1, i.e.; % Zstrt(Y) := ((6.1)(5.1)(4.1)(3.1)(2.1)(1.1)). ; % The remaining exponent parts are saved in PCvarY, using ; % InsPCvv, as pairs of the form ((exponent-1).(list of indi-; % ces of associated rows). So ; % PCvarY := ((1.(1))(2.(3))(4.(2 4 5))). ; % --------------------------------------------------------- ; pcvary:=inspcvv(xind zel,ivalz-1,pcvary) >>; pcdvar:=inspcvv(y,1,pcdvar); % -------------------------------------------------------------- ; % PCDvar is a list of pairs consisting of an exponent EXPO and a ; % list of indices of columns, which were (temporarily) used to ; % store occurrences of Var^EXPO. Initially holds : ; % PCDvar := ((1.(-15))). ; % -------------------------------------------------------------- ; n:=0; npcdv:=npcdvar:=get(var,'npcdvar); % -------------------------------------------------------------- ; % NPCDvar is a list of column-indices, which were used during a ; % previous ExpandProd activity, to store temporarily the additio-; % nal columns, to be produced with PCvarY. NPCDvar was stored on ; % the property-list of Var, during a previous application of ; % Expandprod, and using the actual value of NPCDv. Assume now, ; % for the example, that NPCDvar = (-23 -24). ; % NPCDv is initially the previous version of NPCDvar, but eventu-; % ally extended, during an ExpandProd-application. This new value; % is stored on the property-list of Var before leaving ExpandProd; % Hence the columns, associated with NPCDvar are reused when ever; % necessary. Their Farvar-fields will always contain the value -2; % to avoid a wrong use. ; % -------------------------------------------------------------- ; foreach pc in pcvary do % -------------------------------------------------------------- ; % Each item of the PCvarY list is now used to make a new column, ; % starting with the smallest exponent value. ; % -------------------------------------------------------------- ; <<if npcdvar then <<col!*:=car(npcdvar); npcdvar:=cdr(npcdvar); % ------------------------------------------------------- ; % The first 2 columns, which are selected are -23 and -24.; % ------------------------------------------------------- ; >> else <<col!*:=rowmin:=rowmin-1; npcdv:=col!*.npcdv; % ------------------------------------------------------- ; % All additional columns, which are needed are newly gene-; % rated. Assume their indices to be -40, -41, ... ; % ------------------------------------------------------- ; >>; %------------------------------------------------------------ ; % Hence, whenever necessary a new column-index is made and ad-; % ded to the set (list) NPCDv. ; % ----------------------------------------------------------- ; zzr:=mkzel(col!*,car(pc)-n).zzr; % ----------------------------------------------------------- ; % ZZr is a Zstrt, used to produce relevant additional row in- ; % formation, needed on a temporary basis, when expanding mono-; % mial row descriptions. ZZr is growing during the execution ; % of the current ForEach-loop in the following way : ; % ZZr := ((-23 . 1)), ; % ZZr := ((-24 . 1) (-23 . 1)), ; % ZZr := ((-40 . 2) (-24 . 1) (-23 . 1)). ; % ----------------------------------------------------------- ; setrow(col!*,'times,-2,nil,nil); % ----------------------------------------------------------- ; % FarVar := -2 setting of column COL!*. ; % ----------------------------------------------------------- ; foreach x in cdr(pc) do % ---------------------------------------------------------- ; % PC is a pair (reduced exponent . list of indices of rows,of; % which the Zstrt ought to be temporarily modified). ; % ---------------------------------------------------------- ; foreach z in zzr do <<setzstrt(x,inszzzr(z,zstrt x)); % ------------------------------------------------------- ; % Every element of ZZr is inserted in Zstrt(X), where X is; % running through the row-index list, defined by PC. ; % ------------------------------------------------------- ; setzstrt(yind z,inszzz(mkzel(x,val z),zstrt yind z)) % ------------------------------------------------------- ; % The Zstrts of the corresponding col.s are also modified.; % ------------------------------------------------------- ; >>; % ----------------------------------------------------------- ; % This double FOREACH-loop is executed inside the PC-FOREACH- ; % loop. For the example holds : ; % PC=(1.(1)) & ZZr=((-23 . 1)) gives insertion of (-23 . 1) in; % Zstrt(row(1)) and of (1 . 1) in Zstrt(col(-23)). ; % PC=(2.(3)) & ZZr=((-24 .1 )(-23 . 1)) gives insertion of ; % (-24 . 1) and (-23 . 1) in Zstrt(row(3)) and of (3 . 1) in ; % Zstrt(col(-23)) and Zstrt(col(-24)). ; % Finally PC=(4.(2 4 5)) & ZZr=((-40 . 2)(-24 . 1)(-23 . 1)) ; % gives insertion of (-40 . 2),(-24 . 1) and (-23 . 1) in ; % in Zstrt(row(2)), Zstrt(row(4)) and Zstrt(row(5)),of (2 . 2); % (4 . 2) and (5 . 2) in Zstrt(col(-40)), and of (2 . 1),(4 . ; % 1) and (5 . 1), finally, in both Zstrt(col(-23)) and Zstrt( ; % col(-24)). ; % See also the matrix shown above. ; % ----------------------------------------------------------- ; pcdvar:=inspcvv(col!*,car(pc)-n,pcdvar); % ----------------------------------------------------------- ; % The PCDvar-list is also iteratively built up. This list is ; % needed in Shrinkprod. Its final form for the example is : ; % ((1.(-15 -23 -24)) (2.(-40))) ; % ----------------------------------------------------------- ; n:=car(pc); % ----------------------------------------------------------- ; % N is used to compute the reduced exponents iteratively. ; % ----------------------------------------------------------- ; >>; put(var,'pcdvar,pcdvar); put(var,'npcdvar,npcdv); >> end; symbolic procedure testrel colindex; % ------------------------------------------------------------------- ; % TestRel(evance) is used to determine if the TIMES-column with index ; % Y possesses a Zstrt n which at least 2 elements obey the condition ; % that their IVal-value is at least 2. This test is either performed ; % in EXPANDPROD or in SHRINKPROD. In the latter case the test is need-; % ed to be able to decide if a next application of EXPANDPROD is re- ; % quired. If so this is indicated by setting the flag EXPSHR. Hence ; % its existence is tested in the former case. When the flag proves to ; % have been set it is removed to allow a possible next test. If it was; % not yet set the TIMES-column with the index Y has not been used be- ; % fore in an application of EXPANDPROD. ; % ------------------------------------------------------------------- ; begin scalar btst,mn,rcol,relcols,relrow,onerows,orows; if(btst:=flagp(list(farvar(colindex)),'expshr)) then remflag(list(farvar(colindex)),'expshr) else << mn:=0; foreach z in zstrt(colindex) do if ival(z)>1 then << mn:=mn+1; if mn=1 then relrow:=xind z >> else onerows:=xind(z).onerows; if not (btst:=(mn>1)) and mn=1 and onerows and length(zstrt(relrow))>1 then << mn:=0; foreach z in zstrt(relrow) do if (yind(z) neq colindex) then << mn:=mn+1; relcols:=yind(z).relcols >>; if mn>0 then while relcols and not(btst) do << rcol:=car relcols; relcols:=cdr relcols; orows:=onerows; while orows and not(btst) do << btst:=pnthxzz(car orows,zstrt rcol); orows:=cdr orows >> >> >> >>; return(btst) end; symbolic procedure inspcvv(x,iv,s); % ------------------------------------------------------------------- ; % S is a list of pairs, given in ascending Car-ordering. The Cars are ; % integers IV and the Cdrs are lists of objects X. Application of ; % InsPCvv leads to inclusion of the object X in the list associated ; % with IV. This Integer Value might be an exponent and the objects can; % be row-indices, for instance. ; % ------------------------------------------------------------------- ; if null(s) then list(iv.list(x)) else if dm!-eq(iv,caar(s)) then (iv.(x.cdar(s))).cdr(s) else if dm!-lt(iv,caar(s)) then (iv.list(x)).s else car(s).inspcvv(x,iv,cdr s); symbolic procedure shrinkprod; % ------------------------------------------------------------------- ; % After expansion of certain Times-columns additional Breuer-searches ; % are performed. Shrinkprod is used to restore the remaining informa- ; % tion in the standard form. So the distributed exponent portions are ; % added together and stored in the original column. For the example, ; % introduced in Expandprod all remaining information is to be collect-; % ed in column -15. ; % Assume the Breuer-searches to have produced the following result : ; % ; % column|-15 -23 -24 -40|-60 -61 -62| Row(7) and column(-60) ; % +---------------+-----------+ define cse X5=X^2*X3. ; % row 1 | | 1 | ; % 2 | | 1 | Row(8) and column(-61) ; % 3 | | 1 | define cse X3=X*X2. ; % 4 | | 1 | ; % 5 | | 1 | Row(9) and column(-62) ; % 6 | 1 | | define cse X2=X*X. ; % +---------------+-----------+ ; % 7 | 2 | 1 | The columns -15,-23 and -24 ; % 8 | 1 | 1 | define X-occurrences and ; % 9 | 1 1 | | the column -40 defines an ; % ----------------------------- X^2-occurrence. ; % ; % ShrinkProd is used to recombine the information of column -15 and ; % those given in the PCDvar-list. The result is : ; % ; % column|-15 -23 -24 -40|-60 -61 -62| ; % +---------------+-----------+ ; % row 1 | | 1 | The columns -23, -24 and -40 ; % 2 | | 1 | remain unused until the next ; % 3 | | 1 | application of ExpandProd. ; % 4 | | 1 | The indices remain stored in ; % 5 | | 1 | the list NPCDvar (see the ; % 6 | 1 | | procedure ExpandProd). ; % +---------------+-----------+ X^2 can again be found as a ; % 7 | 2 | 1 | cse (see column -15). Hence ; % 8 | 1 | 1 | ImproveLayout(see the module ; % 9 | 2 | | CODAD1) is needed. ; % ----------------------------- ; % ; % ------------------------------------------------------------------- ; begin scalar var,pcdvar,zz,zstreet,el,exp,collst,indx,further; for y:=rowmin:(-1) do if not numberp(var:=farvar y) and (pcdvar:=get(var,'pcdvar)) and opval(y) eq 'times then << % -------------------------------------------------------------- ; % Only Times-columns are elaborated, which are associated with ; % those Var's of which the PCDvar-indicator has a nonNil value. ; % The Opval test is needed because Var's are in general associa- ; % ted with both PLUS and TIMES-columns. ; % For the example holds : Var = X and PCDvar = ((1.(-15 -23 -24) ; % (2.(-40))). ; % -------------------------------------------------------------- ; zstreet:=zstrt(y); % -------------------------------------------------------------- ; % Initially holds : Zstrt(Y) = Zstreet = ((9.1)(6.1)). ; % Application of ShrinkProd leads to : Zstreet = ((9.2)(8.1)(7.2); % (6.1)). This also affects the Zstrt's of the rows 7,8 and 9 and; % of the columns -23,-24 and -40. ; % -------------------------------------------------------------- ; foreach pcd in pcdvar do <<% ----------------------------------------------------------- ; % Pcd gets 2 different values for the example : ; % (1.(-15=Y -23 -24)) and (2.(-40)). ; % ----------------------------------------------------------- ; exp:=car(pcd); collst:=delete(y,cdr pcd); % ----------------------------------------------------------- ; % The original Var!* column is left out during the now follow-; % ing reconstruction process, because it is Zstreet = Zstrt(Y); % which is restored. ; % ----------------------------------------------------------- ; foreach col in collst do % ----------------------------------------------------------- ; % These Col's are all FarVar = -2 columns. ; % ----------------------------------------------------------- ; <<foreach z in zstrt(col) do <<% ----------------------------------------------------- ; % These Z's are pairs (row-index . exponent-value). ; % ----------------------------------------------------- ; indx:=xind(z); if el:=assoc(indx,zstreet) then setival(el,ival(el)+exp) % ----------------------------------------------- ; % If the row-index Indx is already used in the des; % cription of Zstreet (i.e. in the column -15 of ; % the example) only the value in the exponent- ; % field of the Z-element has to be reset. This is ; % done with SetIval, implying that through a ; % Replaca command Zstreet is also modified! ; % ----------------------------------------------- ; else <<% ------------------------------------------------- ; % If the row-index Indx is not yet used in the des- ; % cription of Zstreet a new element has to be added ; % to both Zstreet and the Zstrt of the row Indx. ; % ------------------------------------------------- ; zstreet:=inszzz(el:=mkzel(indx,exp),zstreet); setzstrt(indx,inszzzr(mkzel(y,val el),zstrt indx)) >>; setzstrt(indx,delyzz(col,zstrt indx)) % ----------------------------------------------------- ; % Now the element Z is removed from the Zstrt of row ; % Indx. The complete column Col is emptied and can thus ; % freely be reused during a next application of Expandp.; % To avoid any confusion ClearRow is used, implying that; % the FarVar-field of the column Col gets the value -1. ; % ----------------------------------------------------- ; >>; clearrow(col) >> >>; setzstrt(y,zstreet); remprop(var,'pcdvar); % ------------------------------------------------------------- ; % The final Zstreet-value is stored in column Y ( in the example; % column -15) and the PCDvar information is removed from the ; % property list of Var. ; % ------------------------------------------------------------- ; if testrel(y) then <<further:=t;flag(list(var),'expshr)>> % ------------------------------------------------------------- ; % After regrouping TIMES-column information it is tested if a ; % next application of EXPANDPROD is needed. If so T is returned.; % This value is used in EXTBRSEA to decide if the EXPAND-SHRINK ; % repeat-loop has to be continued or not. ; % ------------------------------------------------------------- ; >>; return(further) end; endmodule; end;