cmplutil2.dtx

% 
% \iffalse (driver)
%<*driver>
\documentclass{tclldoc}

\usepackage{amsmath,amssymb,amsfonts,amsthm}

% \newtheorem{lemma}{Lemma}[section]
% \theoremstyle{definition}
% \newtheorem{definition}[lemma]{Definition}
% \newtheorem{example}[lemma]{Example}
% \theoremstyle{remark}
% \newtheorem*{remark}{Remark}
% \newtheorem*{algsketch}{Algorithm sketch}

\PageIndex
\CodelineNumbered
\setcounter{IndexColumns}{2}

\newenvironment{ttdescription}{%
  \description
  \def\makelabel##1{\hspace\labelsep\normalfont\ttfamily ##1}%
}{\enddescription}

\makeatletter
\NewDescribeCommand{\describecolumn}{%
   \XD@grab@sarg{/}\XD@grab@sarg{*}\XD@grab@sarg{+}%
   \XD@grab@harmless@oarg\XD@grab@harmless{}%
}{5}{%
   \ifx #2\BooleanFalse
      \GenericDescribePrint{%
         \MacroFont #5 \normalfont(column)%
      }%
   \fi
   \begingroup
      \def\meta##1{(##1)}%
      \unrestored@protected@xdef\@gtempa{#5}%
   \endgroup
   \IndexEntry{%
      \LevelSorted{\@gtempa}{\texttt{#5} column}%
      \ifx \NoValue#4\@empty \else
         \LevelSorted{#4}{\texttt{#4} table}%
      \fi
   }{\ifx #1\BooleanTrue usage\else main\fi}{\thepage}%
   \ifx \NoValue#4\@empty \else
      \IndexEntry{%
         \LevelSorted{#4}{\texttt{#4} (table)}%
         \LevelSorted{\@gtempa}{\texttt{#5} column}%
      }{\ifx #1\BooleanTrue usage\else main\fi}{\thepage}%
   \fi
   \ifx #3\BooleanTrue
      \texttt{#5}%
      \expandafter\@gobble % Eats \ignorespaces
   \fi
}
\makeatother

\makeatletter
\DeclareRobustCommand\SMC{%
  \ifx\@currsize\normalsize\small\else
   \ifx\@currsize\small\footnotesize\else
    \ifx\@currsize\footnotesize\scriptsize\else
     \ifx\@currsize\large\normalsize\else
      \ifx\@currsize\Large\large\else
       \ifx\@currsize\LARGE\Large\else
        \ifx\@currsize\scriptsize\tiny\else
         \ifx\@currsize\tiny\tiny\else
          \ifx\@currsize\huge\LARGE\else
           \ifx\@currsize\Huge\huge\else
            \small\SMC@unknown@warning
 \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
}
\newcommand{\SMC@unknown@warning}{\TBWarning{\string\SMC: unrecognised
    text font size command -- using \string\small}}
\makeatother

\newcommand{\PROP}{{\SMC PROP}}
\newcommand{\PROPs}{{\SMC PROP}s}
\newcommand{\PRO}{{\SMC PRO}}
\newcommand{\ISBN}{{\SMC ISBN}}
\newcommand{\ISBNX}{{\SMC X}}
\providecommand*{\Dash}{%
   \hspace*{0.166667em}\textemdash\hspace{0.166667em}%
}
\providecommand*{\Ldash}{%
   \hspace{0.166667em}\textemdash\hspace*{0.166667em}%
}
\providecommand*{\dash}{\textendash\hspace{0pt}}

\newcommand{\package}[1]{\textsf{#1}}

\newcommand{\Tcl}{\Tcllogo}
\newcommand*{\DefOrd}[2][]{\textbf{#2}}
\newcommand*{\emDefOrd}[2][]{\emph{#2}}

\newcommand{\mc}{\mathcal}
\newcommand{\N}{\mathbb{N}}
\newcommand{\Zp}{\mathbb{Z}_{>0}}
\newcommand{\Fpil}{\longrightarrow}
\newcommand{\cross}[2]{{}^{#1}\mathsf{X}^{#2}}
\newcommand{\same}[1]{\mathsf{I}^{#1}}

\begin{document}
\DocInput{cmplutil2.dtx}
\PrintIndex
\end{document}
%</driver>
% \fi
% 
% \title{Another \PROP py completion utility}
% \author{Lars Hellstr\"om}
% \date{2009-03-17--}
% \maketitle
% 
% \begin{abstract}
%   This is a full-featured utility for completing a set of 
%   \PROP py identities. The main innovation compared to its 
%   predecessor is that the rules and ambiguities are kept in 
%   an external database rather than RAM, but it also adds support 
%   for non-monomial identities and improved handling of undirectable 
%   equalities.
% \end{abstract}
% 
% \tableofcontents
% 
% 
% \subsection*{Docstrip modules}
% 
% There is no main delimiter around the code in this file, but 
% several modules that choose code variants.
% 
% 
% \subsubsection*{Algorithm variants}
% 
% The primary point of variance is the 
% \describestring*+[proc]{pick_next_ambiguity} procedure, which is 
% called to start processing of the next ambiguity. Not surprisingly 
% the variability here includes that of selection strategy, but there 
% is also a more fundamental variance that concerns when (and if) 
% certain things are done, that may be described as \emph{styles} of the 
% algorithm.
% 
% The basic style is to employ a straightforward implementation 
% of Buchberger's algorithm, storing the full queue of ``critical pairs'' 
% as rows with state |A| in the \describestring*+[table]{am6iguities} 
% table, and weeding it by use of the ``second criterion'' whenever a 
% new rule is discovered.
% 
% The basic style also has a cautious mode of operations, which 
% is activated by setting the \describestring+[var.]{am6iguity_top} 
% variable to something else than its default |infinity| value. In 
% this mode, only ambiguities at or below this top value are allowed 
% into the |am6iguities| table; larger ambiguities are instead kept 
% in the more compact |pa1rs| table until a raise in |am6iguity_top| 
% allows them back into the |am6iguities| table.
% 
% A problem with the basic style is that a lot of time is spent 
% weeding the table of ambiguities\Dash this leads to congestion in 
% the transfer of data from database to memory. The \Module{lazy} style 
% is instead that Buchberger's second criterion is applied as the 
% first step when an ambiguity has been picked for resolution.
% 
% The \Module{lazier} style attacks a different problem common to the 
% basic and lazy styles, namely that overlaps were sought as soon as 
% a pair of rules could be formed; since the number of pairs is 
% quadratic in the number of rules, this meant much more time was 
% spent forming overlaps than was spent using or discovering rules, 
% which is problematic when the aim is to discover new identities. 
% The \Module{lazier} style is instead to merely estimate how an 
% ambiguity between two rules would rank, and delay actually 
% computing it until it reaches ambiguities of that rank.
% 
% In practice this means that both the |am6iguities| and |pa1rs| tables 
% are treated as queues, and each |pick_next_ambiguity| call picks an 
% item from the queue whose head has lowest rank. If a pair is picked 
% then any ambiguities formed from it go into the ambiguity table 
% (where they will abide their time if the rank turned out to be 
% higher than expected), whereas if an ambiguity is picked then it 
% will be resolved.
% 
% The \Module{BB2} module guards (in the case of \Module{lazier}) 
% the code for the `second criterion' prereduction step. It was made 
% optional since it turned out to almost never apply in that setting.
% 
% There are several modules which attempt to control the order in 
% which ambiguities are processed; not specifying any of them means 
% they are processed in an arbitrary order. The best supported module 
% is \Module{vsquare}, since no code variant employing a |pa1rs| 
% table has been tested with anything else. The full list are:
% \begin{itemize}
%   \item 
%     \Module{classic}\Dash order primarily by |m1nus|, secondarily 
%     by |p1us|. This was (pretty much) the mode of operation in 
%     \textsf{cmplutil1}.
%   \item
%     \Module{oldnew}\Dash order by the sum of |m1nus| and |p1us|.
%   \item
%     \Module{pcols}\Dash order by the sum of all profile columns 
%     (requires \Module{aprofile}); this is the same as the number of 
%     inner vertices and edges in the ambiguity site.
%   \item
%     \Module{vcols}\Dash order by the sum of all profile columns for 
%     vertices (requires \Module{aprofile}); this is the same as the 
%     number of inner vertices in the ambiguity site.
%   \item
%     \Module{vsum}\Dash order by the sum, over all terms in the 
%     first step of the |re5olution|, of the orders of the networks. 
%     The idea is that the terms of the resolution are more like the 
%     terms of the rule that it might give rise to than the ambiguity 
%     site is, so this should help ``small'' rules be discovered more 
%     quickly.
%   \item
%     \Module{vsquare}\Dash order by the sum, over all terms in the 
%     first step of the |re5olution|, of the \emph{squares} of the 
%     orders of the networks. The idea is that this provides a better 
%     balance between the order of the largest term and orders of 
%     other terms than does a straightforward sum of the orders.
% \end{itemize}
% ToDo: Implement ordering by some norm (e.g.~the Frobenius norm) of 
% the matrix representation of the first biaffine \PROP\ element used 
% to compare networks; this is probably the closest one can get to 
% the standard strategy.
% 
% The \Module{axiomsfirst} module modifies the initial processing (in 
% some problem initialisations) to process all entered congruences 
% before looking at pairs. Whether takes effect also depends on 
% having modules \Module{lazier} and \Module{vsquare}.
% 
% 
% \subsubsection*{Data structure variants}
% 
% The \Module{zlib} module causes some data to be compressed before 
% it is stored in the database; it is independent of other variants.
% 
% The \Module{aprofile} module adds profile columns and an index of 
% those to the \describestring*+[table]{am6iguities} table.
% 
% The \Module{pairmap} module adds the |pa1rsMap| table and causes 
% ``large'' pairs (i.e., those that wouldn't be processed for quite 
% some time) to go into this more compact table, rather than the 
% basic |pa1rs| table.
% 
% \begin{variable}{code_variants}
%   The |code_variants| variable is a list of those \textsf{docstrip} 
%   options which affect how (and what) data are stored in the database 
%   and which are true for this instance of the utility.
%   \begin{tcl}
set code_variants {}
%<zlib>lappend code_variants zlib
%<aprofile>lappend code_variants aprofile
%<pairmap>lappend code_variants pairmap
%   \end{tcl}
%   This list can be compared against the cached value stored in a 
%   database to determine if opening the database would be reliable.
% \end{variable}
% 
% 
% \subsubsection*{Problem initialisation modules}
% 
% The \Module{Frobenius} module contains all code initialising the 
% utility with (one axiom system of) a Frobenius algebra. The 
% submodule \Module{coproduct} guards a congruence defining the 
% coproduct.
% 
% The \Module{Hopf} module contains all code initialising the utility 
% with the axioms of a Hopf algebra or variation thereof. It has 
% several submodules:
% \begin{itemize}
%   \item
%     The \Module{twist} module modifies the definitions to be for 
%     ``Hopf algebra with abstract twist'', i.e., the distributive 
%     law employs an abstract twist vertex rather than an explicit 
%     permutation. In particular this extends the partial order 
%     with $4$ extra blocks. \Module{untwist} is a submodule of 
%     \Module{twist} that adds an extra vertex whose only given 
%     property is that it is the inverse of the twist vertex.
%   \item
%     The \Module{cocomplex} module adds two constant vertices |Re| 
%     and |Im|, and axioms for their interaction with |Delta| and 
%     |epsilon| that give them the behaviour of the real-part and 
%     imaginary-part maps in the coalgebra dual to the complex 
%     numbers as a real algebra.
%   \item
%     The \Module{testequalities} module adds some congruences that 
%     can be derived anyway, but only after several hundred steps. 
%     As the name hints, they were intended for testing the handling 
%     of equalities, but subsequent refinements of the ordering have 
%     actually made them orientable.
%   \item
%     The \Module{moretwist} module adds axioms about the |twist|. 
%     It is hoped that these will actually turn out to be implied by 
%     the basic set of axioms, but if that is true then the proof 
%     would have to be rather large.
%   \item
%     The \Module{division} module adds a |div| vertex, drops 
%     all axioms about |m| and |S| vertices, and adds instead some 
%     axioms about |div| which are derived from a formalisation of 
%     group that takes division as the primitive operation. The idea 
%     of this was mainly to see how difficult it is to derive the 
%     ordinary group axioms from the ones for division, but since the 
%     division axioms are not linear (and less linear than the 
%     ordinary group axioms), it follows of course that one needs to 
%     make use of the coproduct and counit to duplicate or destroy 
%     input values as necessary, and then the best one could hope for 
%     would be a Hopf algebra.
% \end{itemize}
% The module \Module{hopfbase} only contains the vertex definitions 
% and ordering, but no congruences. It is meant as a starting point 
% for experimentation.
% 
% The \Module{HomAss} module initialising the utility with the axioms 
% of a hom-associative algebra or variation thereof. The 
% \Module{aishom} submodule adds the congruence stating that the 
% unary operation is a homomorphism of the algebra.
% 
% The \Module{WeakAss} module initialising the utility with a ``weak 
% associative'' axiom.
% 
% Common to the \Module{HomAss} and \Module{WeakAss} modules is a 
% (fairly large) block of code which, in coarity~$1$ settings only, 
% can produce estimates of the growth of the operad by computing a 
% finite tree automaton for the language of irreducible networks.
% 
% The \Module{Transposition} module sets up an axiom system for a 
% vertex to be an abstract transposition: it is its own inverse and 
% satisfies the Yang--Baxter equation. The main challenge here is to 
% come up with an ordering that actually manages to orient some 
% derived equalities.
% 
% 
% \subsubsection*{Other}
% 
% The \Module{stats} module contains code that makes the main loop 
% keep track of which procedures it calls: how many times and the 
% accumulated runtime (in microseconds).
% 
% The \Module{Tk} module contains code that gives the utility a GUI. 
% \textbf{Note} that many example modules contain a call to 
% |tk_getSaveFile|, which means they too have a Tk dependency.
% 
% The \Module{testserver} module contains code that starts a HTTP 
% miniserver at port 9090. When that server is asked to GET a path 
% that begins with what looks like a rule number, then it delivers an 
% XHTML+SVG rendering of that rule (with proof).
% 
% The \Module{trans} module bracket some code that makes each 
% creation of a new rule a separate transaction. The primary reason 
% for this was to speed up the database access (collect many small 
% transactions in one big), but the transaction overhead seems to 
% have been rather small.
% 
% The \Module{splitnewrule} module splits the basic |new_ru1e| 
% procedure in smaller pieces, to improve GUI responsiveness.
% 
% 
% 
% \section{Data structures}
% 
% The main data structures are the list of rules and the list of 
% ambiguities. Both of these are for size reasons kept in a database 
% (accessed through the TDBC interface), as experience has shown 
% that they have a tendency to grow beyond what is practical for 
% \Tcl\ to keep in memory. It turns out that also certain search 
% operations benefit from this arrangement, as the database machinery 
% can perform a rather effective initial thinning of possibilities to 
% consider, if provided with the necessary information.
% A potential problem with putting things in a database is however 
% the use of SQL, as implementations of this language are rather 
% varied; in particular any English word \emph{might} turn out to 
% have been seized for syntactic purposes, and thus not work as the 
% name of a column. Therefore the names which really \emph{are} English 
% words have been obfuscated through the substitution of digits for 
% one or several letters, as one sometimes sees in Leet orthography.
% 
% Accordingly, the table of rules is named
% \describestring+[table]{ru1es} and the table of ambiguities is 
% named \describestring+[table]{am6iguities}. 
% Both rules and ambiguities are assigned a number when created, so 
% there is in both a \describecolumn*[ru1es]{num6er}
% \describecolumn+[am6iguities]{num6er} column that 
% can be designated as the \texttt{PRIMARYKEY} for rows in the 
% table.
% 
% \begin{arrayvar}{DB_column}
%   The |DB_column| array is indexed by the name of a table and keeps 
%   tracks of the columns in this table. Each element is a list with 
%   the structure
%   \begin{displaysyntax}
%     \begin{regblock}[\regstar] \word{name} \word{type} 
%     \end{regblock}
%   \end{displaysyntax}
%   where the \word{name} is the column name and \word{type} is its 
%   SQL type.
%   \begin{tcl}
lappend DB_column(ru1es)       num6er {INTEGER PRIMARY KEY AUTOINCREMENT}
lappend DB_column(am6iguities) num6er {INTEGER PRIMARY KEY AUTOINCREMENT}
%   \end{tcl}
%   One could probably do without the |AUTOINCREMENT| here, as rows 
%   are never removed from these tables, but I don't think it hurts 
%   either.
%   
%   Note: A mechanism for adjusting column types to the underlying 
%   database would be good. The |column_defs| proc has the beginnings 
%   of such a mechanism.
% \end{arrayvar}
% 
% \describecolumn[ru1es]{lhs}
% \describecolumn[am6iguities]{si7e}
% \describecolumn[ru1es]{feed6acks}
% \describecolumn*[am6iguities]{feed6acks}
% Conceptually however, the identifying feature of a rule or ambiguity 
% is a network with feedback. Since all networks involved in a rule 
% or ambiguity has the same set of feedbacks, this information is put 
% in the separate column |feed6acks|. The network itself is the left 
% hand side in the case of a rule, and the site of the ambiguity in 
% the other case, so these columns are named |lhs| and |si7e|.
% \begin{tcl}
lappend DB_column(ru1es)  lhs {NOT NULL}  feed6acks {NOT NULL} \
  rhs {NOT NULL}
lappend DB_column(am6iguities)  si7e {NOT NULL}  feed6acks {NOT NULL}
% \end{tcl}
% 
% \describecolumn[ru1es]{rhs}
% The other part of a rule is the right hand side, which is a linear 
% combination of networks. Hence it is a list\slash dictionary
% \begin{displaysyntax}
%   \begin{regblock}[\regstar] \word{network} \word{coefficient} 
%   \end{regblock}
% \end{displaysyntax}
% where the \word{network}s should be on canonical form and the 
% \word{coefficient}s belong to whatever ring of scalars one operates 
% over.
% 
% Another important column in |ru1es| is the 
% \describecolumn+[ru1es]{st4te} column, which expresses the state of 
% said row. (|am6iguities| has a similar |st4te| column, documented 
% separately.) This is basically a column where the values are 
% individual characters, interpreted as follows:
% \begin{ttdescription}
%   \item[R]
%     An ordinary active rule. Only rows in this state are used in 
%     reduction.
%   \item[r]
%     An ordinary inactive rule. Rules get demoted from |R| to |r| 
%     when a new rule is discovered which act on the same networks as 
%     this one does.
%   \item[E]
%     An active equality pseudo-rule. These are created when an 
%     equality without unique leading term are discovered, and 
%     participate in ambiguity creation but are not used for 
%     reduction (since that would generate cycles). The rewrite 
%     system cannot be complete as long as there exists this kind of 
%     entries.
%   \item[e]
%     An inactive equality pseduo-rule (does not form ambiguities, 
%     and is tolerated in a complete rewrite system).
% \end{ttdescription}
% It may also be of interest to introduce a class |I| of rules where 
% the leading coefficient is not invertible, but that can be a later 
% development. 
% \begin{tcl}
lappend DB_column(ru1es) st4te {CHAR NOT NULL} pr00f INTEGER
% \end{tcl}
% The \describecolumn+[ru1es]{pr00f} column in the |ru1es| table 
% contains the number of the ambiguity from which the rule or 
% equality was derived, or null if it was given as an axiom.
% 
% The \describecolumn+[ru1es]{wh3n1} column is the timestamp 
% (|clock seconds| value) for when the rule or equality was created 
% and \describecolumn+[ru1es]{wh3n2} is (if non-null) the timestamp 
% for when it was retired.
% \begin{tcl}
lappend DB_column(ru1es) wh3n1 INTEGER wh3n2 INTEGER
% \end{tcl}
% An SQL date value might have been more appropriate, but I find 
% this sufficient. Some drivers might however require the column to 
% be a bigint.
% 
% 
% 
% \subsection{The legend}
% 
% Besides the two main tables, there is a table 
% \describestring+[table]{le9end} which basically is a dictionary of 
% auxiliary information providing context to the |ru1es| and 
% |am6iguities|. This table only has two columns: 
% \describecolumn+[le9end]{k3y} and \describecolumn+[le9end]{va1ue}, 
% both of which are arbitrary strings. The |k3y| must be unique 
% within the table.
% \begin{tcl}
lappend DB_column(le9end) k3y {UNIQUE} va1ue {}
% \end{tcl}
% 
% The \describestring+[legend key]{code_variants} entry in the legend 
% stores the value of the |code_variants| variable for the version of 
% the utility that created the database. If the two are different 
% then there may be problems with trying to opening.
% 
% The \describestring+[legend key]{signature} entry in the legend is 
% the signature of the free \PROP\ in which the calculations are 
% carried out, in the form of a dictionary mapping each annotation 
% $x$ to the pair `$\alpha(x) \ \omega(x)$' of arity and coarity. In 
% other words, it has the structure of the \word{type-dict} argument 
% of the |network::pure::construct| procedure. \textbf{The order of 
% the keys in this dictionary is significant} since the interpretation 
% of the profile columns depend on it. \textbf{The existence of this 
% entry in a database} signals that the signature may no longer the 
% modified; there may be data stored elsewhere that would be 
% extremely difficult to adjust according to changes in the signature.
% 
% The \describestring+[legend key]{coeff_setup} entry is a script 
% that sets up anything needed for the |coeff_cmd| (requires 
% packages, creates aliases, etc.).
% The \describestring+[legend key]{coeff_cmd} entry in the legend is 
% the command prefix of the ring of coefficients. 
% \begin{quote}
%   \textbf{Discussion.} \itshape
%   It might be better to store a make-command for the coefficient 
%   ring prefix than to store the actual prefix, on the grounds that 
%   this is more likely to survive updates in the package. On the 
%   other hand, neither approach would survive an update in the 
%   package that changes the data representation, so persistence here 
%   is an interesting problem on the level of principles.
% \end{quote}
% 
% Other \texttt{le9end} entries are described where the corresponding 
% runtime variables are introduced.
% 
% 
% \subsection{Network profiles}
% 
% When reducing a network, the most time-consuming task is that of 
% finding a rule whose |lhs| occurs in it or deciding that no such 
% rule exists, since |network::wfb::instances| is rather complicated. 
% Profiles provide a shortcut, by counting the number of occurencies 
% of certain features within a network, and thus a way of eliminating 
% rules from the search before even looking at the |lhs|, since there 
% can be no instances of $H$ in $G$ if there are more occurencies of 
% some feature in $H$ than there is in $G$.
% 
% The features being counted are simply the vertices (separate count 
% for each annotation) and the edges, where the endpoints are used to 
% refine the count, paying attention to both vertex annotation and 
% the index of the edge. For a signature $(\Omega,\alpha,\omega)$ 
% there are thus $\sum_{x \in \Omega} \omega(x)$ different things that 
% can be at the tail end of an edge, and 
% $\sum_{x \in \Omega} \alpha(x)$ different things that can be at the 
% head end of it, so the number of different edge features is the 
% product of these. There is no point in counting boundary edges 
% since their numbers are already determined by the counts of 
% internal edges and vertices; also these counts are more troublesome 
% to compare, as a boundary edge in $H$ can be internal in $G$. 
% Counting edges this way is only slightly weaker than counting 
% connected $2$-vertex subsemigraphs; it does not notice when such a 
% subsemigraph is more than simply connected, but that will on the 
% other hand probably be very rare and would not warrant the 
% increased complexity.
% 
% \begin{proc}{network_profile}
%   This procedure computes the profile (a dictionary mapping column 
%   names to counts). The call syntax is
%   \begin{displaysyntax}
%     |network_profile| \word{signature} \word{network}\regopt
%   \end{displaysyntax}
%   When called without a \word{network} argument, the command 
%   returns an ``all zeroes'' profile (technically it computes the 
%   profile of the empty network) that can be used for example to get 
%   the list of profile columns for this \word{signature}.
%   
%   The column names are of the form 
%   \describecolumn*[am6iguities]{v\meta{num}}
%   \describecolumn+[ru1es]{v\meta{num}} for vertex counts and 
%   \describecolumn*[am6iguities]{e\meta{num}}
%   \describecolumn+[ru1es]{e\meta{num}} for edge counts. The names 
%   can be opaque because they are not meant to be interpreted; only 
%   this procedure converts data from the network realm to the 
%   profile realm, so it only needs to do so consistently.
%   
%   The implementation relies heavily on |incr|'s new auto-initialise 
%   behaviour. The |VC| array is for vertex counts and is indexed by 
%   vertex annotations. The |EC| array is for edge counts and is 
%   indexed by lists on the form
%   \begin{displaysyntax}
%     \word{head-annotation} \word{head-index} \word{tail-annotation} 
%     \word{tail-index}
%   \end{displaysyntax}
%   \begin{tcl}
proc network_profile {signature {NW {{{"" {} {}} {"" {} {}}} {}}}} {
   foreach v [lindex $NW 0] {incr VC([lindex $v 0])}
   foreach e [lindex $NW 1] {
      lset e 0 [lindex $NW 0 [lindex $e 0] 0]
      lset e 2 [lindex $NW 0 [lindex $e 2] 0]
      incr EC($e)
   }
   set inL {}
   set outL {}
   set res {}
   set n 0
   foreach {x p} $signature {
      lappend res v$n [incr VC($x) 0]
      for {set i 0} {$i < [lindex $p 0]} {incr i} {
         lappend inL [list $x $i]
      }
      for {set i 0} {$i < [lindex $p 1]} {incr i} {
         lappend outL [list $x $i]
      }
      incr n
   }
   set n 0
   foreach o $outL {
      foreach i $inL {
         lappend res e$n [incr EC([concat $o $i]) 0]
         incr n
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \subsection{Ambiguities}
% 
% Most of the information in an ambiguity row is in the 
% \describecolumn+[am6iguities]{re5olution} column, which holds the 
% list of steps that were taken while trying to resolve the 
% ambiguity. Each of these steps is a linear combination of networks, 
% and therefore a dictionary mapping monomials to coefficients. The 
% first step for an ambiguity $(t_1,\mu,t_2)$ is always the 
% difference $t_1(\mu) \mathcar"2200 t_2(\mu)$ (the ``S-polynomial'').
% Since each network typically appears in more than one step of the 
% |re5olution|, the \emph{monomials} there are not the networks 
% themselves, but indices into a list of networks that have occurred 
% during the resolution of this ambiguity. That list of networks kept 
% in the \describecolumn+[am6iguities]{m0n0mials} column.
% \begin{tcl}
lappend DB_column(am6iguities) re5olution {NOT NULL}
%<-zlib>lappend DB_column(am6iguities) m0n0mials {NOT NULL}
%<+zlib>lappend DB_column(am6iguities) deflated_m0n0mials BLOB
% \end{tcl}
% Experience has shown that the size of a |m0n0mials| list for a 
% resolve ambiguity is typically on the order of a few kilobytes, and 
% account for a substatial percentage of the overall database size, 
% so it makes sense to compress them. In the \Module{zlib} setting, 
% there is not a |m0n0mials| column, but instead a
% \describecolumn+[am6iguities]{deflated_m0n0mials} column, whose 
% contents are the result of doing
% \begin{displaysyntax}
%   zlib deflate [encoding convertto utf-8 \word{m0n0mials}] 9
% \end{displaysyntax}
% where the |encoding convertto| of course doesn't change anything 
% for ASCII data but provides correctness also for non-ASCII data.
% 
% Besides the individual steps in the resolution, it is also 
% interesting to keep track of which rules were applied, to which
% monomial they were applied, and exactly where in these they were 
% applied. The \describecolumn+[am6iguities]{wh1ch} column is a list of 
% rule |num6er|s such that the $i$th rule listed here was used to 
% transform the $i$th step into the $(i +\nobreak 1)$th step. The 
% \describecolumn+[am6iguities]{wh3re} column is a list of pairs
% \begin{displaysyntax}
%   \word{monomial} \word{region}
% \end{displaysyntax}
% that specify to which monomial the corresponding rule from |wh1ch| 
% was applied, and what region in it was replaced when doing so. The 
% reason the rule numbers are kept in a separate column is that this 
% makes it feasible to e.g.~search for resolutions that employed a 
% particular rule.
% \begin{tcl}
lappend DB_column(am6iguities) wh1ch {} wh3re {}
% \end{tcl}
% 
% It should be observed that |wh1ch| and |wh3re| do not provide 
% information about how the first resolution step $t_1(\mu)-t_2(\mu)$ 
% is formed. The rules that take part in this are kept in the 
% \describecolumn+[am6iguities]{p1us} and 
% \describecolumn+[am6iguities]{m1nus} columns, where |p1us| is used 
% in $t_1$ and |m1nus| is used in $t_2$. The corresponding regions 
% of the |si7e| are kept in the 
% \describecolumn+[am6iguities]{p1us2eg} and 
% \describecolumn+[am6iguities]{m1nus2eg} columns.
% \begin{tcl}
lappend DB_column(am6iguities)\
  p1us {INTEGER}  m1nus {INTEGER} \
  p1us2eg {NOT NULL}  m1nus2eg {NOT NULL}
% \end{tcl}
% It should be observed that \emph{the \texttt{p1us} and \texttt{m1nus} 
% columns may be null}, for an ambiguity that is used to feed an 
% unspecified congruence into the completion procedure. In such 
% ambiguities, the \describecolumn[am6iguities]{si7e} network is 
% arbitrary (usually the first element of |m0n0mials|) and the 
% profile columns are bogus (usually set to all zeroes). Furthermore 
% the |p1us2eg| and |m1nus2eg| columns contain text descriptions of 
% the identity being encoded. The format is unspecified, but the 
% |p1us2eg| column can contain a longer description and |m1nus2eg| 
% column a shorter description.
% 
% Then there is the \describecolumn+[am6iguities]{st4te} column, 
% which expresses the status of an ambiguity.
% \begin{ttdescription}
%   \item[A]
%     An active ambiguity, i.e., one that still requires resolution.
%   \item[0]
%     An ambiguity that has been resolved to $0$. For ambiguities in 
%     this state, the final element in the |re5olution| is empty 
%     (representing $0$).
%   \item[r]
%     An ambiguity that was made resolvable by the creation of a new 
%     rule; exactly which rule that was can be determined by 
%     looking at the |pr00f| column in the |ru1es| table.
%   \item[e]
%     An ambiguity that could not be resolved, and instead lead to 
%     the creation of two or more equalities. Exactly which 
%     equalities can be determined by looking at the |pr00f| column 
%     in the |ru1es| table.
%   \item[d]
%     An ambiguity that could not be resolved, and would have lead to 
%     the creation of two or more equalities, where it not that these 
%     (or some simpler form of them) are already known. The 
%     \describecolumn/+[am6iguities]{wh1ch} list has one element, 
%     namely the |num6er| of the equality that implied the final step 
%     in the |re5olution|.
%   \item[S]
%     A suspended ambiguity, i.e., one that still requires resolution 
%     but is expected to resolve when an additional rule has been 
%     added. Information about where that rule might come from is not 
%     kept in the database.
%   \item[2]
%     The ambiguity has not been explicitly resolved, but it has been 
%     discarded as useless by ``Buchberger's second criterion''. The 
%     \describecolumn/+[am6iguities]{wh1ch} list has one element, 
%     namely the |num6er| of the rule or equality that has an 
%     instance in the site of the ambiguity.
% \end{ttdescription}
% \begin{tcl}
lappend DB_column(am6iguities) st4te {CHAR NOT NULL}
% \end{tcl}
% It would not be possible to use the |st4te| column to distinguish 
% ambiguities used to feed congruences into the system, as these 
% ambiguities get resolved just like ordinary ones and thus change 
% state.
% 
% As for rules, the \describecolumn+[am6iguities]{wh3n1} column is 
% the timestamp for when the ambiguity was created and 
% \describecolumn+[am6iguities]{wh3n2} is (if non-null) the timestamp 
% for when the ambiguity was retired.
% \begin{tcl}
lappend DB_column(am6iguities) wh3n1 INTEGER wh3n2 INTEGER
% \end{tcl}
% 
% The \describecolumn+[am6iguities]{vRe5Sum} column contains the 
% total number of (internal) vertices in all terms of the first step 
% of the |re5olution|. This number is one candidate to order by when 
% selecting the next ambiguity to process. The 
% \describecolumn+[am6iguities]{v2Re5Sum} column similarly contains 
% the sum over all terms of the squares of the numbers of internal 
% vertices.
% \begin{tcl}
lappend DB_column(am6iguities) vRe5Sum INTEGER v2Re5Sum INTEGER
% \end{tcl}
% 
% 
% \subsection{Pairs}
% 
% Experience with the first example problem (Hopf with twist) has shown 
% that the database is around $1.5\,\mathrm{GB}$ when the |am6iguities| 
% table reaches half a million rows. Most of these ambiguities are 
% expected to be irrelevant\Ldash generated from a rule or equality 
% that is subsequently dropped, and too large to figure in the proofs 
% of anything interesting\Dash so it would be interesting to 
% establish a less spacious storage for ambiguities far from those 
% that are currently being chosen for resolution.
% 
% The natural format for this would be as a table of critical pairs 
% that have not yet contributed to the |am6iguities| table. This 
% table is called \describestring+[table]{pa1rs}, and its two main 
% columns are \describecolumn+[pa1rs]{p1us} and 
% \describecolumn+[pa1rs]{m1nus} with the same interpretations as in 
% |am6iguities|.
% \begin{tcl}
lappend DB_column(pa1rs)  p1us {INTEGER}  m1nus {INTEGER} \
  pick8y {NUMERIC}
% \end{tcl}
% There is also a column \describecolumn+[pa1rs]{pick8y} which holds 
% whatever rank is used when picking ambiguities.
% 
% \medskip
% 
% More experience still has shown that even if the space requirements 
% are kept in moderation when using pairs, it still takes an awful 
% lot of time to enumerate all the overlaps, especially since most 
% of the imformation is simply going to be thrown away. It would be 
% better to delay this step until some ambiguity is actually going to 
% be used; on one hand this means remembering also pairs for which 
% there is no overlap, but on the other hand it means not keeping 
% multiples (one pair for each ambiguity) of pairs, and on the whole 
% it all seems to even out. The problem is then how to compute a 
% reasonable |pick8y| value for a pair.
% 
% At least in the \Module{vsquare} case that the |pick8y| value is 
% the sum over all terms of the squares of the orders of the 
% networks, this is actually easy enough to be done in SQL. The basic 
% idea is that when annexing to network $G$ of order $g$ a list 
% $H_1,\dotsc,H_n$ of networks of orders $h_1,\dotsc,h_n$, the 
% order-square sum of the result list is
% \begin{equation*}
%   \sum_{i=1}^n (g + h_i)^2 = 
%   g^2 + 2g\sum_{i=1}^n h_i + \sum_{i=1}^n h_i^2
%   \text{;}
% \end{equation*}
% hence in order to have the left hand side readily available for 
% every value of $g$, it is sufficient to precompute and store the 
% two sums in the right hand side.
% 
% A trickier issue is that of determining the appropriate value of 
% $g$, since this is going to be the number of vertices (in the |lhs| 
% of the other rule of the pair) that don't overlap. An accurate 
% value is not feasible, but it should be sufficient to merely give 
% a good guess, and as that can be taken the average number of in 
% all overlaps with rule computed so far! Hence a prototypical 
% command for adding to the |pa1rs| table all pairs that can be 
% formed from a (new) rule would be:
%\begin{verbatim}
%  INSERT INTO pa1rs (p1us,m1nus,pick8y)
%  SELECT num6er, :newnum, 
%    annex1*annex1 + 2*annex1*vSum + v2Sum +
%    annex2*annex2 + 2*annex2*:vSum + :v2Sum
%  FROM ( SELECT num6er, vSum, v2Sum,
%    :lhsOrder - overl4p AS annex1,
%    lhsOrder - overl4p AS annex2
%  FROM ( SELECT num6er, vSum, v2Sum, 
%    v0+v1+v2+v3+v4+v5 AS lhsOrder,
%    coalesce( overl4pSum / overl4pTimes, 1 ) AS overl4p
%  FROM ru1es WHERE st4te IN ('R','E') ))
%\end{verbatim}
%
% This requires some four new columns in the |ru1es| table, but no 
% more than that. The \describecolumn+[ru1es]{vSum} and 
% \describecolumn+[ru1es]{v2Sum} are thus the sum of the orders and 
% sum of the squares of the orders respectively, of the networks in 
% the |rhs| of the rule. The \describecolumn+[ru1es]{overl4pTimes} are 
% the number of ambiguities constructed for a rule, and 
% \describecolumn+[ru1es]{overl4pSum} is the sum of the orders of all 
% overlap regions in these ambiguities.
% \begin{tcl}
%<*lazier>
lappend DB_column(ru1es)  vSum REAL  v2Sum REAL \
  overl4pSum {REAL DEFAULT 0}  overl4pTimes {INTEGER DEFAULT 0}
%</lazier>
% \end{tcl}
% The main reason to make |overl4pSum| a real is that I didn't at the 
% time find any other way to avoid integer division above (the proper 
% SQL construct is |CAST (overl4pSum AS REAL)|). The real 
% declarations could just as well have been integers.
% 
% The problem with this set-up is however that a sparse encoding 
% (|pa1rs| as a set of pairs of integers) is used for what is really 
% a very dense set. When |ru1es| approaches $8000$ elements, |pa1rs| 
% is beyond $30$ million elements, and easily using up some gigabyte 
% of disk area. A more compact representation is called for, but here 
% the problem arises of how much can be accomplished on the SQL side. 
% It seems a composite value can reasonably well be taken apart (by 
% indexing a string) but not so easily put together again, so 
% assistance from \Tcl\ is necessary. The problem on the \Tcl\ side 
% would be with retrieving the overlap statistics from the database, 
% but this is a minor chunk of data and could therefore be fetched 
% even when just adding pairs for a new rule. Hence the best solution 
% seems to be to actually perform the above calculations on the \Tcl\ 
% side.
% 
% The dense representation of is therefore kept in a table 
% \describestring+[table]{pa1rMap} with two columns 
% \describecolumn+[pa1rMap]{m1nus} and 
% \describecolumn+[pa1rMap]{plu5es}. The first column contains 
% integers referencing the |num6er| in |ru1es|, while the second 
% column contains BLOBs whose binary patterns encode which |p1us| 
% values would form a pair with the |m1nus|. Each bit corresponds to 
% one pair, where $1$ means ``pair is in |pa1rMap|'' and $0$ means it 
% isn't (it might be in |pa1rs|, or it might have been processed 
% already). The BLOB is to be |binary scan|ned and |format|ted as 
% |B*|, where the first digit corresponds to |ru1e| $1$.
% \begin{tcl}
%<*lazier>
lappend DB_column(pa1rMap)  m1nus {INTEGER PRIMARY KEY}  plu5es BLOB
%</lazier>
% \end{tcl}
% 
% 
% 
% \subsection{Initialising the database}
% 
% 
% \begin{proc}{prepare_statements}
%   This procedure creates TDBC statement objects for database 
%   transactions that are carried out frequently, and stores them 
%   into the |DBCMD| array. The call syntax is
%   \begin{displaysyntax}
%     |prepare_statements| \word{db}
%   \end{displaysyntax}
%   and there is no particular return value.
%   
%   The first order of business is to retrieve the |signature|, since 
%   that is needed to construct proper statements involving profiles.
%   \begin{tcl}
proc prepare_statements {db} {
   variable DBCMD
   set signature [dict get [lindex [
      $db allrows {SELECT va1ue FROM le9end WHERE k3y='signature'}
   ] 0] va1ue]
   set pcols [dict keys [network_profile $signature]]
%   \end{tcl}
%   
%   \begin{arrayentry}{DBCMD}{Divisors}
%     The |Divisors| statement finds proper active rules whose |lhs| 
%     might have an instance in a network with the provided profile.
%     \begin{tcl}
   set L [list {(st4te = 'R')}]
   foreach col $pcols {lappend L "($col <= :$col)"}
   set DBCMD(Divisors) [$db prepare "
      SELECT num6er,lhs,rhs,feed6acks 
      FROM ru1es WHERE ( [join $L " AND "] )
   "]
%     \end{tcl}
%     This is used when reducing expressions, to find rules that 
%     might act nontrivially.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{EDivisors}
%     The |EDivisors| statement finds equalities whose |lhs| might 
%     have an instance in a network with the provided profile.
%     \begin{tcl}
   set L [list {(st4te = 'E' OR st4te = 'e')}]
   foreach col $pcols {lappend L "($col <= :$col)"}
   set DBCMD(EDivisors) [$db prepare "
      SELECT num6er,lhs,rhs,feed6acks 
      FROM ru1es WHERE ( [join $L " AND "] )
   "]
%     \end{tcl}
%     This is used when checking whether the end result of resolving 
%     an ambiguity is just a duplicate of some known equality. It is 
%     necessary to try also the inactive equalities, because 
%     equalities can deactivate each other.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{RDividedBy}
%     The |RDividedBy| statement finds active rules or equalities 
%     whose |lhs| might contain an instance of a network with the 
%     provided profile.
%     \begin{tcl}
   set L [list {(st4te = 'R' OR st4te = 'E')}]
   foreach col $pcols {lappend L "($col >= :$col)"}
   set DBCMD(RDividedBy) [$db prepare "
      SELECT num6er,st4te,lhs,rhs,feed6acks 
%<lazier>        , vSum, v2Sum
      FROM ru1es WHERE ( [join $L " AND "] )
   "]
%     \end{tcl}
%     This is used to find rules that should be dropped when a new 
%     rule has been added. It is also used to discover the |num6er| 
%     assigned to a newly created rule.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{RDividedBy2}
%     The |RDividedBy| statement finds active rules or equalities 
%     whose |lhs| might contain an instance of a network with the 
%     provided profile and whose |num6er|s are greater than one that 
%     is specified.
%     \begin{tcl}
   set L [list {(st4te = 'R' OR st4te = 'E')}]
   lappend L {(num6er > :num6er)}
   foreach col $pcols {lappend L "($col >= :$col)"}
   set DBCMD(RDividedBy2) [$db prepare "
      SELECT num6er,st4te,lhs,rhs,feed6acks 
      FROM ru1es WHERE ( [join $L " AND "] )
   "]
%     \end{tcl}
%     This is used to find rules that might imply an ambiguity with 
%     the given profile can be discarded by ``Buchberger's second 
%     criterion''.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{ADividedBy}
%     The |ADividedBy| statement finds the |num6er|s of active or 
%     suspended ambiguities whose |si7e| might contain an instance 
%     of a network with the provided profile.
%     \begin{tcl}
%<*aprofile>
   set L [list {(st4te = 'A' OR st4te = 'S')} {(p1us NOTNULL)}]
   foreach col $pcols {lappend L "($col >= :$col)"}
   set DBCMD(ADividedBy) [$db prepare "
      SELECT num6er FROM am6iguities WHERE ( [join $L " AND "] )
   "]
%</aprofile>
%     \end{tcl}
%     This is used to find ambiguities that can be discarded by 
%     ``Buchberger's second criterion'', hence the restriction that 
%     |p1us| must be non-null.
%     
%     This statement used to return full rows of the |am6iguities| 
%     table, but this turned out to be infeasible when the table grew 
%     to about $70000$ rows, as that often made the selection as a 
%     whole too large to fit comfortably in RAM (although the exact 
%     figure is of course machine-dependent). Using the TDBC 
%     resultset interface did \emph{not} get around that, as the 
%     underlying \textsf{tclsqlite} API did not provide such an 
%     abstraction. (The SQLite C-level API sort-of provides this, but 
%     possibly with the restriction that only one resultset per 
%     statement is allowed.)
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{GetAmbiguity}
%      Instead each ambiguity is going to be fetched by |num6er|, when 
%      it is needed. The |GetAmbiguity| statement takes the |num6er| 
%      as only parameter and returns the non-profile columns of the 
%      row.
%      \begin{tcl}
   variable DB_column
   set DBCMD(GetAmbiguity) [$db prepare "
      SELECT [join [dict keys $DB_column(am6iguities)] ", "]
      FROM am6iguities WHERE ( num6er = :num6er )
   "]
%      \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{ActiveRu1e}
%     The |ActiveRu1e| statement finds the \emph{numbers} of all 
%     active rules or equalities. It has no parameters.
%     \begin{tcl}
   set DBCMD(ActiveRu1e) [$db prepare {
      SELECT num6er FROM ru1es WHERE ( st4te='R' OR st4te='E' )
   }]
%     \end{tcl}
%     This is used to gather a list of rules against which one must 
%     try to form new overlap ambiguities.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{GetRu1e}
%     The |GetRu1e| statement takes the |num6er| of a rule or 
%     equality as parameter and returns all non-profile 
%     columns.
%     \begin{tcl}
   set DBCMD(GetRu1e) [$db prepare "
      SELECT [join [dict keys $DB_column(ru1es)] ", "]
      FROM ru1es WHERE ( num6er = :num6er )
   "]
%     \end{tcl}
%     This is a basic ``get rule $i$'' operation. It is for example 
%     used on the numbers obtained using the |ActiveRu1e| statement.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{NewRu1e}
%     The |NewRu1e| statement creates a new rule or equality. 
%     The parameters are |lhs|, |rhs|, |feed6acks|, |st4te|, |pr00f|, 
%     |wh3n1|, |vSum|, |v2Sum|, and the profile components.
%     \begin{tcl}
   set L $pcols
   lappend L lhs rhs feed6acks st4te pr00f wh3n1
%<lazier>   lappend L vSum v2Sum
   set DBCMD(NewRu1e) [$db prepare "
      INSERT INTO ru1es ( [join $L ", "] )
      VALUES ( :[join $L ", :"] )
   "]

%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{SetRu1eState}
%     The |SetRu1eState| statement updates the state of a rule 
%     identified by |num6er|. Parameters are |st4te| (the new state), 
%     |wh3n2| (timestamp when doing this), and |num6er|.
%     \begin{tcl}
   set DBCMD(SetRu1eState) [$db prepare {
      UPDATE ru1es SET st4te = :st4te, wh3n2 = :wh3n2 
      WHERE num6er = :num6er
   }]
%     \end{tcl}
%     This is typically used to deactivate a rule or equality.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{NewAmbiguity}
%     The |NewAmbiguity| statement creates a new ambiguity. The 
%     parameters are all the columns except |num6er|.
%     \begin{tcl}
   set L [dict keys [dict remove $DB_column(am6iguities) num6er]]
%<aprofile>   lappend L {*}$pcols
   set DBCMD(NewAmbiguity) [$db prepare "
      INSERT INTO am6iguities ( [join $L ", "] )
      VALUES ( :[join $L ", :"] )
   "]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{LastInsertNumber}
%     The |LastInsertNumber| statement returns the rowid of the 
%     most recently inserted row in any table. If called immediately 
%     after a |NewAmbiguity|, that should be the |num6er| of said 
%     ambiguity.
%     \begin{tcl}
   set DBCMD(LastInsertNumber)\
     [$db prepare "SELECT last_insert_rowid();"]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{AdvanceAmbiguity}
%     The |AdvanceAmbiguity| statement updates the columns of an 
%     ambiguity that may change due to reductions of it, i.e., 
%     |m0n0mials| or |deflated_m0n0mials|, |re5olution|, |st4te|, 
%     |wh1ch|, |wh3re|, and |wh3n2|. The parameters are |num6er| 
%     (which identifies the ambiguity to update) and the six new 
%     values.
%     \begin{tcl}
   set DBCMD(AdvanceAmbiguity) [$db prepare {
      UPDATE am6iguities SET 
%<-zlib>        m0n0mials = :m0n0mials, 
%<+zlib>        deflated_m0n0mials = :deflated_m0n0mials, 
        re5olution = :re5olution, wh1ch = :wh1ch, wh3re = :wh3re, 
        st4te = :st4te, wh3n2 = :wh3n2
      WHERE num6er = :num6er
   }]
%     \end{tcl}
%     It is possible to advance an ambiguity after each reduction 
%     step, but one typically leaves it as it is until an end is 
%     reached.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{ChooseAmbiguity}
%     The |ChooseAmbiguity| statement selects one active ambiguity, 
%     returning all non-profile columns. There are no parameters. 
%     The criterion used to choose an ambiguity is that the sum of 
%     its vertex profile columns should be minimal; this is a sort 
%     of ``least critical pair first'' strategy.
%     \begin{tcl}
   set DBCMD(ChooseAmbiguity) [$db prepare "
      SELECT [join [dict keys $DB_column(am6iguities)] ", "]
      FROM am6iguities WHERE st4te = 'A'
%<classic>      ORDER BY m1nus,p1us ASC
%<oldnew>      ORDER BY m1nus+p1us ASC
%<pcols>      ORDER BY [join $pcols +] ASC
%<vcols>      ORDER BY [join [lsearch -all -inline $pcols v*] +] ASC
%<vsum>      ORDER BY vRe5Sum ASC
%<vsquare>      ORDER BY v2Re5Sum ASC
      LIMIT 1
   "]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{AddPair}
%     The |AddPair| statement adds a row to the |pa1rs| table. Its 
%     parameters are the column values.
%     \begin{tcl}
   set DBCMD(AddPair) [$db prepare "
      INSERT INTO pa1rs ( [join [dict keys $DB_column(pa1rs)] ", "] )
      VALUES ( :[join [dict keys $DB_column(pa1rs)] ", :"] )
   "]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{LeastPair}
%     The |LeastPair| statement selects a pair with minimal |pick8y|. 
%     There are no parameters.
%     \begin{tcl}
   set DBCMD(LeastPair) [$db prepare {
      SELECT * FROM pa1rs ORDER BY pick8y ASC LIMIT 1
   }]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{PairsUpto}
%     The |PairsUpto| statement selects the |p1us| and |m1nus| values 
%     of all |pa1rs| rows whose |pick8y| value is less than or equal 
%     to the parameter with this name. It also reports (as |c0unt|) 
%     the number of times each combination occurs, which incidentally 
%     means each combination is only reported once.
%     \begin{tcl}
   set DBCMD(PairsUpto) [$db prepare {
      SELECT p1us, m1nus, count(*) AS c0unt FROM pa1rs 
      WHERE pick8y <= :pick8y GROUP BY p1us,m1nus
   }]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{DropPair}
%     The |DropPair| statement deletes the |pa1rs| row(s) made from 
%     the specified |p1us| and |m1nus|.
%     \begin{tcl}
   set DBCMD(DropPair) [$db prepare {
      DELETE FROM pa1rs WHERE p1us = :p1us AND m1nus = :m1nus
   }]
%     \end{tcl}
%     This is usually applied to a pair that has been picked, after 
%     its overlaps have been generated.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{DropPairsOf}
%     The |DropPairsOf| statement deletes all |pa1rs| rows where the 
%     specified |num6er| parameter matches |p1us| or |m1nus|.
%     \begin{tcl}
   set DBCMD(DropPairsOf) [$db prepare {
      DELETE FROM pa1rs WHERE p1us = :num6er OR m1nus = :num6er
   }]
%     \end{tcl}
%     This is used when a rule or equality is deactivated.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{DropPairsBelow}
%     The |DropPairsBelow| statement deletes all |pa1rs| rows whose 
%     |pick8y| value is less than or equal to the parameter with this 
%     name.
%     \begin{tcl}
   set DBCMD(DropPairsBelow) [$db prepare {
      DELETE FROM pa1rs WHERE pick8y <= :pick8y
   }]
%     \end{tcl}
%     This is used in the \Module{lazy} setting, when a batch of 
%     pairs have been converted to ambiguities.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{EstimatePairs}
%     The |EstimatePairs| statement creates all pairs with an active 
%     rule or equality as |p1us| and a given rule or equality as 
%     |m1nus|, assigning each an estimated |pick8y|. The parameters are 
%     |num6er| (the |m1nus|), |vSum| (order sum of |m1nus|'s |rhs|), 
%     |v2Sum| (ditto order squared sum) and |lhsOrder| (order of 
%     |m1nus|'s |lhs|).
%     \begin{tcl}
%<*lazier>
   set DBCMD(EstimatePairs) [$db prepare "
      INSERT INTO pa1rs (p1us,m1nus,pick8y)
      SELECT num6er, :num6er, 
        annex1*annex1 + 2*annex1*vSum + v2Sum +
        annex2*annex2 + 2*annex2*:vSum + :v2Sum
      FROM ( SELECT num6er, vSum, v2Sum,
        :lhsOrder - overl4p AS annex1,
        lhsOrder - overl4p AS annex2
      FROM ( SELECT num6er, vSum, v2Sum, 
        [join [lsearch -all -inline $pcols v*] +] AS lhsOrder,
        coalesce( overl4pSum / overl4pTimes, 1 ) AS overl4p
      FROM ru1es WHERE st4te IN ('R','E') ))
   "]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{GetOverl4ps}
%     The |GetOverl4ps| statement retrieves the |num6er|, |st4te|, 
%     |overl4pSum|, |overl4pTimes|, |vSum|, |v2Sum| columns of all 
%     |ru1es|, and additionally the number of inner vertices as 
%     |lhsOrder|. There are no parameters, but the result is ordered 
%     by |num6er|.
%     \begin{tcl}
   set DBCMD(GetOverl4ps) [$db prepare "
      SELECT num6er,st4te,overl4pSum,overl4pTimes,vSum,v2Sum,
        [join [lsearch -all -inline $pcols v*] +] AS lhsOrder
      FROM ru1es ORDER BY num6er
   "]
%     \end{tcl}
%     This is used when estimating pairs in \Tcl.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{GetSomeOverl4ps}
%     The |GetSomeOverl4ps| statement is like |GetOverl4ps|, but 
%     retrieves only a range of rows. There are two parameters: the 
%     result set size limit |limit|, and the ditto offset |ofs|.
%     \begin{tcl}
   set DBCMD(GetSomeOverl4ps) [$db prepare "
      SELECT num6er,st4te,overl4pSum,overl4pTimes,vSum,v2Sum,
        [join [lsearch -all -inline $pcols v*] +] AS lhsOrder
      FROM ru1es ORDER BY num6er LIMIT :limit OFFSET :ofs
   "]
%</lazier>
%     \end{tcl}
%     This is used when estimating pairs in \Tcl.
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{ListPairmaps}
%     The |ListPairmaps| statement retrieves the |m1nus| entries of 
%     all rows in the |pa1rMap| table. There are no parameters.
%     \begin{tcl}
%<*pairmap>
   set DBCMD(ListPairmaps) [$db prepare {
      SELECT m1nus FROM pa1rMap
   }]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{GetPairmap}
%     The |GetPairmap| statement retrieves the |plu5es| entry from a 
%     row in the |pa1rMap| table. The only parameter is the |m1nus| 
%     value.
%     \begin{tcl}
   set DBCMD(GetPairmap) [$db prepare {
      SELECT plu5es FROM pa1rMap WHERE m1nus=:m1nus
   }]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{SetPairmap}
%     Conversely, the |SetPairmap| statement sets the |plu5es| entry 
%     from a row in the |pa1rMap| table. The semantics are the same 
%     as for the |set| command, i.e., a new entry is created if it 
%     didn't exist already and the existing entry is updated 
%     otherwise. The parameters are |m1nus| and |plu5es|.
%     \begin{tcl}
   set DBCMD(SetPairmap) [$db prepare {
      INSERT OR REPLACE INTO pa1rMap (m1nus,plu5es) 
      VALUES (:m1nus,:plu5es)
   }]
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{UnsetPairmap}
%     The |UnsetPairmap| statement deletes a row in the |pa1rMap| 
%     table. The only parameter is the |m1nus| value.
%     \begin{tcl}
   set DBCMD(UnsetPairmap) [$db prepare {
      DELETE FROM pa1rMap WHERE m1nus=:m1nus
   }]
%</pairmap>
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{UpdateOverl4p}
%     The |UpdateOverl4p| statement updates the |overl4pSum| and 
%     |overl4pTimes| columns for a rule. The parameters are |num6er|, 
%     |sum| and |times|.
%     \begin{tcl}
%<*lazier>
   set DBCMD(UpdateOverl4p) [$db prepare {
      UPDATE ru1es SET 
        overl4pSum = overl4pSum + :sum,
        overl4pTimes = overl4pTimes + :times
      WHERE num6er = :num6er
   }]
%</lazier>
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{signature}
%     Although not strictly logical, it is convenient to store the 
%     signature in the |DBCMD| array as well, since many statements 
%     require that one computes a profile. To distinguish it from the 
%     prepared statements, it is all lower case.
%     \begin{tcl}
   set DBCMD(signature) $signature
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{arrayentry}{DBCMD}{database}
%     The object command for the database as a whole is also stored 
%     in the |DBCMD| array; this is convenient for a more intelligent 
%     transaction handling.
%     \begin{tcl}
   set DBCMD(database) $db
%     \end{tcl}
%   \end{arrayentry}
%   
%   \begin{tcl}
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{column_defs}
%   The |column_defs| procedure takes lists with the structure
%   \begin{displaysyntax}
%     \begin{regblock}[\regstar] \word{name} \word{type} 
%     \end{regblock}
%   \end{displaysyntax}
%   as arguments and returns a single list of SQL column definitions 
%   for columns with these names and these types. It mostly just 
%   combines the \word{name} with its \word{type} in a single 
%   argument, but it can also perform substitutions of the 
%   \word{type} or leave it out altogether. The command call syntax 
%   is
%   \begin{displaysyntax}
%     |column_defs| \word{list}\regstar
%   \end{displaysyntax}
%   The result of specifying several arguments is the same as the 
%   result of specifying just their |concat|enation; this is a 
%   conveniency feature.
%   
%   At the moment, the \word{type}s |CHAR| and empty string are left 
%   out altogether, whereas the \word{type} |0| is replced by 
%   |INTEGER|. The latter is a hack to allow mixing the result of 
%   |network_profile| with entries in |DB_column|.
%   \begin{tcl}
proc column_defs {args} {
   set res {}
   foreach list $args {
      foreach {name type} $list {
         switch -- $type {
            CHAR -
            "" {lappend res $name}
            0 {lappend res "$name INTEGER"}
            "CHAR NOT NULL" {lappend res "$name NOT NULL"}
            default {lappend res "$name $type"}
         }
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{init_database}
%   This procedure takes a TDBC connection object and \PROP\ 
%   signature as arguments. It creates in that database the tables 
%   |ru1es|, |am6iguities|, and |le9end| with the appropriate columns 
%   for this signature. The call syntax is
%   \begin{displaysyntax}
%     |init_database| \word{db} \word{signature}
%   \end{displaysyntax}
%   and there is no particular return value.
%   
%   The first step is to create the |le9end| table and record the 
%   \word{signature} in it.
%   \begin{tcl}
proc init_database {db signature} {
   variable DB_column
   set SQL {CREATE TABLE le9end }
   append SQL ( [join [column_defs $DB_column(le9end)] ", "] )
   $db allrows $SQL
   $db allrows {
      INSERT INTO le9end (k3y, va1ue) VALUES ( :k3y , :va1ue )
   } [dict create k3y signature va1ue $signature]
%   \end{tcl}
%   The second step is to create the |ru1es| and |am6iguities| 
%   tables.
%   \begin{tcl}
   set nullprofile [network_profile $signature]
   $db allrows "
      CREATE TABLE ru1es ( [join [
         column_defs $DB_column(ru1es) $nullprofile
      ] ", "] )
   "
   $db allrows "
      CREATE TABLE am6iguities ( [join [
%<aprofile>         column_defs $DB_column(am6iguities) $nullprofile
%<!aprofile>         column_defs $DB_column(am6iguities)
      ] ", "] )
   "
%   \end{tcl}
%   The third step is to create indices for the |ru1es| table: one 
%   on the profile and |st4te| columns called 
%   \describestring+[index table]{ru1esProfile} and one on the 
%   |wh3n1| and |wh3n2| columns called 
%   \describestring+[index table]{ru1esTimes}.
%   \begin{tcl}
   set L [dict keys $nullprofile]
   lappend L st4te
   set SQL "( [join $L ", "] )"
   $db allrows "CREATE INDEX ru1esProfile ON ru1es $SQL"
   $db allrows "CREATE INDEX ru1esTimes ON ru1es (wh3n1,wh3n2)"
%   \end{tcl}
%   The fourth step is to similarly create indices for the 
%   |am6iguities| table. The most important is 
%   \describestring+[index table]{am6iguitiesProfile} on the profile 
%   and |st4te| columns (which in this case also includes the |p1us| 
%   column, since the |ADividedBy| statement (below) has a condition 
%   on that as well). The 
%   \describestring+[index table]{am6iguitiesTimes} profile is 
%   another clear parallel, whereas the 
%   \describestring+[index table]{am6vRe5Sum} would be used by some 
%   variants of the |ChooseAmbiguity| statement (others use the 
%   |am6iguitiesProfile|).
%   \begin{tcl}
   lappend L p1us
%<*aprofile>
   $db allrows "
      CREATE INDEX am6iguitiesProfile ON am6iguities 
      ( [join $L ", "] )
   "
%</aprofile>
   $db allrows {
      CREATE INDEX am6iguitiesTimes ON am6iguities (st4te,wh3n1,wh3n2)
   }
   $db allrows {
      CREATE INDEX am6vRe5Sum ON am6iguities (st4te,v2Re5Sum,vRe5Sum)
   }
%   \end{tcl}
%   The fifth step is to create the |pa1rs| table. It has an index on 
%   the |pick8y| column and an index on the $($|p1us|$,{}$|m1nus|$)$ 
%   pairs of columns. The first index is needed to get reasonable 
%   performance for |LeastPair|, the other index is needed to get 
%   reasonable performance for |DropPair|.
%   \begin{tcl}
   $db allrows "
      CREATE TABLE pa1rs 
      ( [join [column_defs $DB_column(pa1rs)] ", "] )
   "
   $db allrows {
      CREATE INDEX pa1rsPick8y ON pa1rs (pick8y)
   }
   $db allrows {
      CREATE INDEX pa1rsP1usM1nus ON pa1rs (m1nus,p1us)
   }
%   \end{tcl}
%   The sixth step is to create the |pa1rMap| table. It has no 
%   indices, but the |m1nus| column is the primary key
%   \begin{tcl}
%<*pairmap>
   $db allrows "
      CREATE TABLE pa1rMap 
      ( [join [column_defs $DB_column(pa1rMap)] ", "] )
   "
%</pairmap>
}
%   \end{tcl}
% \end{proc}
% 
% 
% I have no idea what that 3.16.0 version is supposed to be (it came 
% with the OS), but it's broken, so forget about it.
% \begin{tcl}
%<*sqlite3.16.0fix>
{*}[package unknown] sqlite3
apply {{} {
   set D [dict create]
   foreach ver [package versions sqlite3] {
      dict set D $ver [package ifneeded sqlite3 $ver]
   }
   package forget sqlite3
   dict unset D 3.16.0
   dict for {ver script} $D {package ifneeded sqlite3 $ver $script}
}}
%</sqlite3.16.0fix>
% \end{tcl}
% It turns out it wasn't just one version that's broken, but probably 
% rather the way that the \texttt{.dylib} links against \Tcllogo; if 
% memory serves there were some changes between 8.5 and 8.6. 
% Unfortunately Apple seems to keep updating the sqlite but not how 
% they interface with the \Tcllogo\ runtime! A more flexible fix 
% should be to forget any \texttt{sqlite3} version that comes from 
% the \texttt{/System/Library} hierarchy.
% \begin{tcl}
%<*AppleSqliteFix>
{*}[package unknown] sqlite3
apply {{} {
   set D [dict create]
   foreach ver [package versions sqlite3] {
      dict set D $ver [package ifneeded sqlite3 $ver]
   }
   package forget sqlite3
   dict for {ver script} $D {
      if {[string match */System/Library/* $script]} then {
         puts "Forgetting sqlite3 $ver, that would: $script"
      } else {
         package ifneeded sqlite3 $ver $script
      }
   }
}}
%</AppleSqliteFix>
% \end{tcl}
% 
% \begin{proc}{sqlite3_init}
%   This procedure creates and opens an SQLite database, setting up 
%   the |DBCMD| array in the process. The call syntax is
%   \begin{displaysyntax}
%     |sqlite3_init| \word{filename} \word{signature}
%   \end{displaysyntax}
%   and the return value is the database connection object.
%   \begin{tcl}
proc sqlite3_init {fname signature} {
   package require tdbc::sqlite3
   set db [tdbc::sqlite3::connection create thedatabase $fname]
   if {![llength [$db tables ru1es]]} then {
      init_database $db $signature
   }
   prepare_statements $db
   return $db
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \section{The completion main loop}
% 
% The main loop in the completion is an iterate that gets called by 
% the \Tcl\ event loop. This permits intervention from the user, as 
% well as live displays of the current activity.
% 
% \begin{proc}{push_main_task}
% \begin{variable}{main_loop_stack}
%   Each iteration of the main loop performs a specific \emph{task}, 
%   which is concretely just a script to evaluate. The tasks waiting 
%   to be done are kept in the |main_loop_stack| variable, which is 
%   a stack-as-list with the top element last. New tasks are pushed 
%   onto the stack with the command
%   \begin{displaysyntax}
%     |push_main_task| \word{word}\regplus
%   \end{displaysyntax}
%   where each \word{word} is a word of one task, which will be a 
%   single command.
%   \begin{tcl}
variable main_loop_stack {}
proc push_main_task {args} {
   variable main_loop_stack
   lappend main_loop_stack $args
}
%   \end{tcl}
% \end{variable}\end{proc}
% 
% \begin{proc}{completion_main_loop}
%   The main loop iterate command is |completion_main_loop|, which 
%   neither takes any arguments nor returns anything particular. It 
%   ends with a standard |after 0 after idle| to rescedule itself, 
%   but its main task is to pop one task of the |main_loop_stack| and 
%   perform it. If there is no task on the stack, then it calls 
%   |pick_next_ambiguity| to start resolving something. The stack 
%   usually gets empty between two ambiguities.
%   
%   \begin{tcl}
variable main_loop_stack {}
variable next_task_type {}
proc completion_main_loop {} {
   variable main_loop_stack
   if {[llength $main_loop_stack]} then {
      set cmd [lindex $main_loop_stack end]
      set main_loop_stack [lreplace $main_loop_stack end end]
   } else {
      set cmd pick_next_ambiguity
   }
%<stats>   set before [clock microseconds]
   {*}$cmd
%<*stats>
   set diff [expr {[clock microseconds]-$before}]
   variable Stats
   incr Stats(n,[lindex $cmd 0])
   incr Stats(t,[lindex $cmd 0]) $diff
%</stats>
   if {[catch {lindex $main_loop_stack end 0} cmd]} then {set cmd ""}
   variable next_task_type $cmd
%<!eventbug>   after 0 [list after idle completion_main_loop]
%<eventbug>   after 1 [list after idle completion_main_loop]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{pause_main_loop}
%   This procedure pauses the main loop, leaving it to be resumed 
%   later by a call to |completion_main_loop|. It works by pushing a 
%   |return| script on the |main_loop_stack|, as that causes 
%   |completion_main_loop| to return without resceduling itself.
%   \begin{tcl}
interp alias {} pause_main_loop {} push_main_task return
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{halt_main_loop}
%   This procedure is functionally similar to |pause_main_loop|, but 
%   it inserts the |return| at the bottom of the stack rather than at 
%   the top. This has the effect of delaying the stop until the main 
%   loop stack is empty, which in particular means that the entire 
%   state of the completion is recorded in the database. Halting is 
%   thus the safe thing to do when you want to quit the completion 
%   utility, saving all data until later.
%   \begin{tcl}
proc halt_main_loop {} {
   variable main_loop_stack
   set main_loop_stack [linsert $main_loop_stack 0 return]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{exit_main_loop}
%   This procedure is similar to |halt_main_loop| in that it causes 
%   something to happen when the stack would otherwise be empty, but 
%   instead of |return|ing from |completion_main_loop|, it |exit|s 
%   the entire process.
%   \begin{tcl}
proc exit_main_loop {} {
   variable main_loop_stack
   set main_loop_stack [linsert $main_loop_stack 0 {uplevel #0 {
      $DBCMD(database) close
      exit
   }}]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{arrayvar}{Stats}[n,\meta{command}]
% \begin{arrayvar}{Stats}[t,\meta{command}]
%   The |Stats| array is used to gather statistics on what is done in 
%   the main loop. The |n,|\meta{command} entries count how many 
%   times the \word{command} (just the command name) has been called, 
%   whereas the |t,|\meta{command} entries count the number of 
%   microseconds that have been spent doing so.
% \end{arrayvar}\end{arrayvar}
% 
% \begin{proc}{record_stats}
%   The |record_stats| procedure periodically records the contents of 
%   the |Stats| array in the |le9end| table. 
%   \begin{tcl}
proc record_stats {} {
   variable DBCMD
   $DBCMD(database) allrows {
      INSERT INTO le9end(k3y,va1ue) VALUES (:k3y,:va1ue)
   } [dict create k3y Stats@[clock seconds] va1ue [array get ::Stats]]
   after 3600000 record_stats
}
%   \end{tcl}
% \end{proc}
% 
% \begin{arrayvar}{Count}
%   The |Count| array keeps counts of how many things of various 
%   states are (or at least should be) in the database: rules, 
%   equalities, and ambiguities\Dash both in total and that have been 
%   deactivated. These are incremented by procedures that modify the 
%   database in these respects. The array entries in question are
%   \begin{center}
%     \begin{tabular}{r c c}
%     & \textbf{Total}& \textbf{Deactivated}\\
%     \textbf{Rules}& |Rr|& |r|\\
%     \textbf{Equalities}& |Ee|& |e|\\
%     \textbf{Ambiguities}& |Aa|& |a|
%     \end{tabular}
%   \end{center}
%   The reason for keeping track of these things is that these are 
%   the ones that increase with time; a counter for active things 
%   would sometimes increase and sometimes decrease.
% \begin{proc}{clear_counts}
%   The |clear_counts| procedure zeroes the |Count| array. It takes 
%   no arguments.
%   \begin{tcl}
proc clear_counts {} {
   variable Count
   foreach x {Rr r Ee e Aa a P p} {set Count($x) 0}
}
clear_counts
%   \end{tcl}
% \end{proc}\end{arrayvar}
% 
% \begin{proc}{database_counts}
%   Alternatively, one may initialise the |Count| array from the 
%   database. This is most interesting when reopening an existing 
%   database.
%   \begin{tcl}
proc database_counts {} {
   variable Count
   variable DBCMD
   foreach field {Rr r Ee e} {
      set SQL {SELECT count(num6er) FROM ru1es WHERE }
      append SQL {(st4te='} [join [split $field ""] {') OR (st4te='}] {')}
      set Count($field) [lindex [
         $DBCMD(database) allrows -as lists $SQL
      ] 0 0]
   }
   set Count(Aa) [lindex [$DBCMD(database) allrows -as lists {
      SELECT count(*) FROM am6iguities
   }] 0 0]
   set Count(a) [lindex [$DBCMD(database) allrows -as lists {
      SELECT count(*) FROM am6iguities 
      WHERE NOT (st4te IN ('A','S'))
   }] 0 0]
   set Count(P) [lindex [$DBCMD(database) allrows -as lists {
      SELECT count(*) FROM pa1rs
   }] 0 0]
   set Count(p) 0
%<*lazy>
   if {$Count(P)} then {
      variable am6iguity_top [lindex [
         $DBCMD(database) allrows -as lists {
            SELECT min(pick8y) FROM pa1rs
         }
      ] 0 0]
   }
%</lazy>
%<*pairmap>
   if {$Count(P)} then {
      variable pairs_top [tcl::mathfunc::round [lindex [
         $DBCMD(database) allrows -as lists {
            SELECT max(pick8y) FROM pa1rs
         }
      ] 0 0]]
   }
%</pairmap>
}
%   \end{tcl}
% \end{proc}
% 
% \begin{arrayentry}{Count}{R}
% \begin{arrayentry}{Count}{E}
% \begin{arrayentry}{Count}{A}
%   The |R|, |E|, and |A| entries in the |Count| array are maintained 
%   through traces.
%   \begin{tcl}
apply {args {
   variable Count
   foreach V $args {
      set v [string tolower $V]
      set cmd [list ::apply [
         list {x y z args} {
            variable Count
            set Count($x) [expr {$Count($y)-$Count($z)}]
         } [namespace current]
      ] $V $V$v $v]
      foreach name [list $V$v $v] {
         trace add variable Count($name) write $cmd
      }
   }
}} R E A
%   \end{tcl}
% \end{arrayentry}\end{arrayentry}\end{arrayentry}
% 
% 
% Under Tk, it is useful to provide a minimal control panel.
% \begin{tcl}
%<*Tk>
eval {
   toplevel .control
   grid x [label .control.rule -text "Rules"]\
     [label .control.equality -text "Equalities"]\
     [label .control.pair -text "Pairs"]\
     [label .control.ambiguity -text "Ambiguities"]
   grid [label .control.active -text "Active:"]\
     [label .control.lR -textvariable Count(R)]\
     [label .control.lE -textvariable Count(E)]\
     [label .control.lP -textvariable Count(P)]\
     [label .control.lA -textvariable Count(A)]
   grid [label .control.inactive -text "Inactive:"]\
     [label .control.lr -textvariable Count(r)]\
     [label .control.le -textvariable Count(e)]\
     [label .control.lp -textvariable Count(p)]\
     [label .control.la -textvariable Count(a)]
   grid [
      label .control.lnext -textvariable next_task_type
   ] - - - -
   grid x x x [
      label .control.llpair -textvariable pair_level
   ] [
      label .control.llamb -textvariable ambiguity_level
   ]
   grid [
      button .control.halt -text "Halt" -command halt_main_loop
   ] x x [
      button .control.pause -text "Pause" -command pause_main_loop
   ] [
      button .control.run -text "Run" -command completion_main_loop
   ]
   wm title .control "Control panel"
   lower .
}
%</Tk>
% \end{tcl}
% 
% \begin{variable}{pair_level}
% \begin{variable}{ambiguity_level}
%   These variables are used for displaying data in the control 
%   panel, namely the current picking levels for pairs and 
%   ambiguities, respectively.
%   \begin{tcl}
variable pair_level "" ambiguity_level ""
%   \end{tcl}
% \end{variable}\end{variable}
% 
% The following is a minimal alternative control mechanism: Create a 
% child that sits waiting forever, which when killed will initiate a 
% controlled shutdown of the present process.
% \begin{tcl}
%<*noTk>
set kill_to_exit_child [open "|[info nameofexecutable]" r+]
fconfigure $kill_to_exit_child -buffering none -blocking no
puts $kill_to_exit_child "vwait forever\n"
fileevent $kill_to_exit_child readable "
   catch {[list ::close $kill_to_exit_child]}
   exit_main_loop
"
%</noTk>
% \end{tcl}
% 
% 
% \subsection{Reducing ambiguities}
% 
% The roadmap for explicitly resolving an ambiguity is to find a 
% sequence of reduction steps for the |re5olution| that ends in an 
% irreducible element, and then update the database accordingly for 
% the irreducible element that was discovered. This subsection deals 
% with the reduction part of that road.
% 
% \begin{arrayvar}{RS}
%   The |RS| (resolution state) array is where the elements of the 
%   ambiguity row get dumped. It also contains several entries 
%   which are related to the ambiguity, but are not exactly columns 
%   in the table.
% \end{arrayvar}
% 
% \begin{arrayentry}{RS}{NWID}
%   The |m0n0mials| entry in the resultion state is a list mapping 
%   monomial numbers to concrete networks, as is needed to decode the 
%   |re5olution|. The |NWID| entry is a dictionary that goes the 
%   other way, mapping (canonical) networks to indices into the 
%   |m0n0mials| list.
% \end{arrayentry}
% 
% \begin{arrayentry}{RS}{irr}
% \begin{arrayentry}{RS}{rest}
%   The expression being reduced is kept in two parts: |irr| contains 
%   all terms that have turned out to be irreducible, and |rest| 
%   keeps track of the rest. |irr| is a straightforward formal linear 
%   combination\Ldash a dictionary mapping monomial numbers to 
%   coefficients\Dash but |rest| is (the pointer to) a skiplist 
%   mapping (extended) comparison keys to coefficients. This 
%   arrangement has the advantage of making the leading term readily 
%   available.
% \end{arrayentry}\end{arrayentry}
% 
% 
% \begin{variable}{restheap}
% \begin{proc}{restheap}
%   The |restheap| variable is where the |rest| skiplist lives. The 
%   |restheap| command provides the operations in this heap.
%   \begin{tcl}
package require heap 1.0
heap::makecmd restheap -command restheap
package require heap::skiplist 1.0
%   \end{tcl}
% \end{proc}\end{variable}
% 
% The comparison keys employed are optimised for the case of an order 
% that is a lexicographic composition of cartesian product orders, 
% but also for use with skiplists. Concretely, the comparison key is 
% a list of components, where each component corresponds to a factor 
% in some cartesian product. Extended comparison keys contain the 
% monomial number as an extra element at the end, to make sure they 
% uniquely identify a network. When used in a skiplist, comparison 
% keys are compared in a purely lexicographic manner (thus totally 
% ordering them), but when deciding whether to make a rule or some 
% equalities the actual partial order is needed. Since the skiplist 
% total order is an extension of the proper partial order with which 
% rules must be compatible, one can never generate a term already in 
% |irr| by reducing a term still in |rest|.
% 
% \begin{arrayentry}{RS}{cmpkeycmd}
%   Comparison keys are computed by calling a command prefix which is 
%   kept in the |cmpkeycmd| entry of the |RS| array. The call syntax 
%   for this is the basic
%   \begin{displaysyntax}
%     \meta{cmpkeycmd} \word{network}
%   \end{displaysyntax}
%   The reason this is kept in the |RS| array is that the details of 
%   the comparison key \emph{may} depend on the type of the 
%   \word{network}; there is formally a separate order for each 
%   element of $\mathbb{B}^{\bullet\times\bullet}$.
% \end{arrayentry}
% 
% \begin{arrayentry}{RS}{cmpcmds}
% \begin{arrayentry}{RS}{cmpblocks}
%   The |cmpcmds| entry is a list of command prefixes, with one for 
%   each element of an extended comparison key. The call syntax for 
%   these command prefixes is
%   \begin{displaysyntax}
%     \meta{cmp-cmd} \word{left} \word{right}
%   \end{displaysyntax}
%   and the result must be $<0$ when \(\mathit{left} < 
%   \mathit{right}\), $>0$ when \(\mathit{left} > 
%   \mathit{right}\), and $=0$ otherwise. This means |string compare| 
%   and |::tcl::mathop::-| are both valid \word{cmp-cmd}s.
%   
%   The |cmpblocks| entry is another list of the same length and with 
%   corresponding elements, but its elements are booleans. An element 
%   is true if it corresponds to the final component of a block in 
%   the key, i.e., if it is the final factor in a cartesian product. 
%   These are used when determining what the partial order thinks 
%   about two keys.
% \end{arrayentry}\end{arrayentry}
% 
% \begin{proc}{compare_keys}
%   This procedure takes two (extended) comparison keys as arguments, 
%   and compares them using the current |RS(cmpcmds)| and 
%   |RS(cmpblocks)|. The call syntax is
%   \begin{displaysyntax}
%     |compare_keys| \word{left} \word{right}
%   \end{displaysyntax}
%   and the return value is one of `|<|', `|=|', `|>|', and `|!=|' 
%   depending on whether the \word{left} is less than, equal to, 
%   greater than, or incomparable to the \word{right}. The comparison 
%   performed is thus that for the \emph{partial order} relation 
%   (which in general can be a quasiorder on the monomials, since 
%   key elements after the final block are effectively ignored).
%   
%   \begin{tcl}
proc compare_keys {left right} {
   variable RS
   set less 0
   set greater 0
   foreach l $left r $right cmd $RS(cmpcmds) f $RS(cmpblocks) {
      set d [{*}$cmd $l $r]
      if {$d<0} then {
         set less 1
      } elseif {$d>0} then {
         set greater 1
      }
      if {$f} then {
         if {$less} then {
            if {$greater} then {return !=} else {return <}
         } elseif {$greater} then {return >}
      }
   }
   return =
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{set_cmpcmds}
%   The |cmpkeycmd|, |cmpcmds|, and |cmpblocks| entries in the |RS| 
%   arrays need to be initialised anew for every ambiguity processed, 
%   and that is the responsibility of the |set_cmpcmds| command. It 
%   takes no arguments (the |si7e| and |feed6acks| entries in the 
%   |RS| arrray have already been set) and returns nothing 
%   particular, but must initialise the three entries listed. In the 
%   case of |cmpcmds| and |cmpblocks|, it \emph{must not} include the 
%   extension element for monomial numbers, as that is handled by 
%   |prepare_ambiguity|.
%   
%   The default implementation is for the equality relation;
%   definitions of specific problems are expected to override it.
%   \begin{tcl}
proc set_cmpcmds {} {
   variable RS
   set RS(cmpkeycmd) [list ::apply {NW {}}]
   set RS(cmpcmds) {}
   set RS(cmpblocks) {}
}
%   \end{tcl}
% \end{proc}
% 
% \begin{arrayentry}{RS}{cmpkeys}
%   In parallel to the |m0n0mials| list, the |cmpkeys| entry is a list 
%   of the extended comparison keys of the networks.
% \end{arrayentry}
% 
% 
% \begin{proc}{prepare_ambiguity}
%   This procedure is responsible for initialising all variables 
%   involved in reduction for a particular ambiguity. The call syntax 
%   is
%   \begin{displaysyntax}
%     |prepare_ambiguity| \word{ambiguity}
%   \end{displaysyntax}
%   where the \word{ambiguity} is the dictionary form of the database 
%   row for the ambiguity. There is no particular return value, but 
%   the |RS| array gets filled in.
%   
%   \begin{tcl}
proc prepare_ambiguity {amb} {
   variable RS
   array unset RS
   array set RS $amb
%   \end{tcl}
%   The first step is to initialise the system for computing 
%   comparison keys.
%   \begin{tcl}
   set_cmpcmds
   lappend RS(cmpcmds) ::tcl::mathop::-
   lappend RS(cmpblocks) 0
%   \end{tcl}
%   The second step is to initialise the |NWID| dictionary and 
%   |cmpkey| list for |m0n0mials| already known.
%   \begin{tcl}
%<*zlib>
   set RS(m0n0mials) [encoding convertfrom utf-8 [zlib inflate\
     $RS(deflated_m0n0mials)]]
%</zlib>
   set RS(cmpkeys) {}
   foreach NW $RS(m0n0mials) {
      dict set RS(NWID) $NW [llength $RS(cmpkeys)]
      set key [{*}$RS(cmpkeycmd) $NW]
      lappend key [llength $RS(cmpkeys)]
      lappend RS(cmpkeys) $key
   }
%   \end{tcl}
%   The final step is to create and fill in the |rest| skiplist.
%   \begin{tcl}
   set RS(rest) [heap::skiplist::create restheap {*}$RS(cmpcmds)]
   foreach {mu r} [lindex $RS(re5olution) end] {
      heap::skiplist::Set restheap $RS(rest)\
        [lindex $RS(cmpkeys) $mu] $r
   }
   set RS(irr) [dict create]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{variable}{coefficient}
%   The |coefficient| variable holds the \meta{ring} command prefix 
%   for coefficients of networks. Definitions are expected to override 
%   this default definition of $\mathbb{Z}_{32003}$.
%   \begin{tcl}
variable coefficient [mtmtcl::rings::integers::make_modulo 32003]
%   \end{tcl}
% \end{variable}
% 
% \begin{arrayentry}{RS}{candobj}
%   The |candobj| entry in the |RS| array is the name of the current 
%   TDBC resultset object being iterated over; it returns rows from 
%   the |ru1es| table.
% \end{arrayentry}
% 
% \begin{proc}{reduce_step}
%   This procedure does the reducing part of ambiguity resolution. It 
%   is meant to be run as a task in the main loop, so it doesn't 
%   return anything particular.
%   What it concretely does when called is that it pops the leading 
%   term off the |rest| skiplist and tries to act upon it using one 
%   of the rules. If there is a rule which will do this, then the 
%   result is added back into the rest of |rest|, and otherwise the 
%   term is appended to |irr| since it has been found irreducible. In 
%   the special case that the skiplist is empty, reduction is 
%   complete and the resolution process proceeds to the task of 
%   ruling the ambiguity.
%   
%   The call syntax is
%   \begin{displaysyntax}
%     |reduce_step| \word{term}\regopt
%   \end{displaysyntax}
%   where the \word{term} argument defaults to an empty list. If 
%   it is nonempty then it is a leading term popped off the |rest| 
%   skiplist, and |RS(candobj)| is an existing object with 
%   rules that should be tried for reducing the \word{term}. 
%   Otherwise the leading term is popped off |rest|, and 
%   |RS(candobj)| is initialised to the rules that might help with 
%   this.
%   
%   \begin{tcl}
proc reduce_step {{leading ""}} {
   variable RS
   if {![llength $leading]} then {
      set leading [heap::skiplist::pop restheap $RS(rest)]
      if {![llength $leading]} then {
         judge_ambiguity
         return
      }
%   \end{tcl}
%   Now for the task of finding appropriate rules.
%   \begin{tcl}
      set NWFB [list [lindex $RS(m0n0mials) [lindex $leading 0 end]]\
        $RS(feed6acks)]
      variable DBCMD
      set profile [network_profile $DBCMD(signature) [lindex $NWFB 0]]
      set RS(candobj) [$DBCMD(Divisors) execute $profile]
   } else {
      set NWFB [list [lindex $RS(m0n0mials) [lindex $leading 0 end]]\
        $RS(feed6acks)]
   }
%   \end{tcl}
%   The loop over appropriate rules can be ended in three ways: 
%   |limit| goes to $0$ (meaning it's time to return to the main 
%   loop), the |nextdict| method returns $0$ (meaning there are no 
%   more rules to try), or |sites| becomes nonempty (in which case a 
%   rule that applies has been found).
%   \begin{tcl}
   set limit 20
   set sites {}
   while {![llength $sites]} {
      if {![incr limit -1]} then {
         push_main_task reduce_step $leading
         return
      }
      if {![$RS(candobj) nextdict row]} then {
         $RS(candobj) close
         dict set RS(irr) [lindex $leading 0 end] [lindex $leading 1]
         push_main_task reduce_step
         return
      }
      set sites [network::wfb::instances $NWFB\
        [list [dict get $row lhs] [dict get $row feed6acks]] 1]
   }
   $RS(candobj) close
%   \end{tcl}
%   If we get this far, a rule that applies has been found, so it is 
%   applied, meaning concretely that the appropriate multiple of its 
%   |rhs| is added to the skiplist.
%   \begin{tcl}
   variable coefficient
   set G [network::pure::detach [lindex $NWFB 0]\
     [lindex $sites 0]]
   foreach {H r} [dict get $row rhs] {
%   \end{tcl}
%   For each term of the |rhs|, one must first construct the 
%   underlying monomial, and add it to the |m0n0mials| list if it 
%   hasn't been seen before in this resolution.
%   \begin{tcl}
      set NW [network::pure::canonise\
        [network::pure::annex $G $H]]
      if {![dict exists $RS(NWID) $NW]} then {
         dict set RS(NWID) $NW [llength $RS(m0n0mials)]
         set key [{*}$RS(cmpkeycmd) $NW]
         lappend key [llength $RS(m0n0mials)]
         lappend RS(cmpkeys) $key
         lappend RS(m0n0mials) $NW
      } else {
         set key [lindex $RS(cmpkeys) [dict get $RS(NWID) $NW]]
      }
%   \end{tcl}
%   Then the appropriate entry in the |rest| is to be updated. It is 
%   quite possible that this updates the same entry several times, 
%   since |annex|ing is not injective.
%   \begin{tcl}
      heap::skiplist::update restheap $RS(rest) $key s {
         if {![info exists s]} then {set s [{*}$coefficient 0]}
         set s [{*}$coefficient + $s\
           [{*}$coefficient * [lindex $leading 1] $r]]
         if {[{*}$coefficient iszero $s]} then {unset s}
      }
   }
%   \end{tcl}
%   Finally, the |re5olution| must be updated, since the combination 
%   of |irr| and |rest| changed.
%   \begin{tcl}
   set D $RS(irr)
   foreach {key val} [heap::skiplist::contents restheap $RS(rest)] {
      dict set D [lindex $key end] $val
   }
   lappend RS(re5olution) $D
   lappend RS(wh1ch) [dict get $row num6er]
   lappend RS(wh3re)\
     [list [lindex $leading 0 end] [lindex $sites 0]]
   push_main_task reduce_step
}
%   \end{tcl}
% \end{proc}
% 
% \begin{arrayentry}{RS}{leading}
%   The |leading| entry in the |RS| array holds a list of the 
%   (numbers of) maximal terms in the |irr| entry. It gets 
%   initialised by the |judge_ambiguity| procedure.
% \end{arrayentry}
% 
% \begin{proc}{judge_ambiguity}
%   The |judge_ambiguity| procedure is called when the |rest| part of 
%   the current ambiguity becomes empty. Its task is to determine 
%   whether the ambiguity resolved to $0$, prompts the creation of a 
%   new rule, or the creation of two or more equalities.
%   
%   First the (now empty) |rest| skiplist is destroyed, since it 
%   isn't needed anymore.
%   \begin{tcl}
proc judge_ambiguity {} {
   variable RS
   heap::skiplist::destroy restheap $RS(rest)
%   \end{tcl}
%   Second, it is determined which monomials are maximal in the given 
%   partial order.
%   \begin{tcl}
   set RS(leading) {}
   dict for {mu r} $RS(irr) {
      set maximal 1
      foreach nu $RS(leading) {
         if {">" eq [
            compare_keys [lindex $RS(cmpkeys) $nu]\
              [lindex $RS(cmpkeys) $mu] 
         ]} then {
            set maximal 0; break
         }
      }
      if {$maximal} then {lappend RS(leading) $mu}
   }
%   \end{tcl}
%   Third, the ambiguity is updated and new rules or equalities are 
%   created as necessary (or rather, tasks to create them are pushed 
%   into the main loop).
%   \begin{tcl}
   variable coefficient
   if {0 == [llength $RS(leading)]} then {
      set RS(st4te) 0
   } elseif {1 == [llength $RS(leading)]} then {
      set RS(st4te) r
      set lhs [lindex $RS(m0n0mials) [lindex $RS(leading) 0]]
      set s [{*}$coefficient neg [dict get $RS(irr) [lindex $RS(leading) 0]]]
      set rhs {}
      dict for {nu r} [dict remove $RS(irr) [lindex $RS(leading) 0]] {
         lappend rhs [lindex $RS(m0n0mials) $nu] [{*}$coefficient / $r $s]
      }
      push_main_task new_ru1e R $lhs $rhs $RS(feed6acks) $RS(num6er)
   } else {
      reduce_equality
      return
   }
   variable DBCMD
   set RS(wh3n2) [clock seconds]
%<*zlib>
   set RS(deflated_m0n0mials)\
     [zlib deflate [encoding convertfrom utf-8 $RS(m0n0mials)] 9]
%</zlib>
   $DBCMD(AdvanceAmbiguity) allrows [array get RS]
   variable Count
   incr Count(a)
   array unset RS
}
%   \end{tcl}
%   That |new_ru1e| commands are placed on the |main_loop_stack| like 
%   this means the completion is not entirely durable; a deletion of 
%   the |main_loop_stack| (e.g.~due to a power outage) could cause 
%   some rules or equalities to be lost, even though the ambiguity 
%   that gave rise to them is no longer active. Such lost |ru1es| 
%   entries may however be recovered by checking that every ambiguity 
%   in state |r| or |e| really is the |pr00f| of something, and 
%   reactivating the ambiguity if that is not the case.
% \end{proc}
% 
% \begin{proc}{reduce_equality}
%   This procedure is called when reduction by rules of what is in 
%   |RS| has reached a terminal element, and that has more than one 
%   leading term. What one may then do is attempt further reductions 
%   using equalities, and in particular try to discover when the 
%   element is just a duplicate of a known equality. There are no 
%   arguments, since all information is in the |RS| array, nor any 
%   particular return value.
%   
%   This procedure used to be |equality_duplicate?| and part of 
%   |judge_ambiguity|, but it turned out to be a rather 
%   time-consuming operation, and was therefore split off so that 
%   it could yield to the event loop.
%   \begin{tcl}
proc reduce_equality {} {
   variable RS
   variable DBCMD
   set RS(candobj) [$DBCMD(EDivisors) execute [network_profile\
     $DBCMD(signature) [lindex $RS(m0n0mials) [lindex $RS(leading) 0]]]]
   reduce_equality_A 19
}
%   \end{tcl}
%   
%   \begin{proc}{reduce_equality_B}
%     This procedure is called by |reduce_equality_A| when it has 
%     determined whether the equality was a duplicate. Its main tasks 
%     are to |close| the resultset object, update the database 
%     regarding this ambiguity, and push |new_ru1e| tasks when the 
%     equality was not a duplicate.
%     
%     Whether the equality turned out to be a duplicate or not can be 
%     seen from the |st4te| in the |RS| array.
%     \begin{tcl}
proc reduce_equality_B {} {
   variable RS
   $RS(candobj) close
   if {$RS(st4te) eq "e"} then {
      variable coefficient
      foreach mu $RS(leading) {
         set lhs [lindex $RS(m0n0mials) $mu]
         set s [{*}$coefficient neg [dict get $RS(irr) $mu]]
         set rhs {}
         dict for {nu r} [dict remove $RS(irr) $mu] {
            lappend rhs [lindex $RS(m0n0mials) $nu] [{*}$coefficient / $r $s]
         }
         push_main_task new_ru1e E $lhs $rhs $RS(feed6acks) $RS(num6er)
      }
   }
   variable DBCMD
   set RS(wh3n2) [clock seconds]
%<*zlib>
   set RS(deflated_m0n0mials)\
     [zlib deflate [encoding convertfrom utf-8 $RS(m0n0mials)] 9]
%</zlib>
   $DBCMD(AdvanceAmbiguity) allrows [array get RS]
   variable Count
   incr Count(a)
   array unset RS
}
%     \end{tcl}
%     A possible improvement (for improved recoverability) might be 
%     to put the ambiguity in a |P| (for pending) state here, that 
%     will be changed to |e| (or whatever) after the new rules have 
%     been created.
%   \end{proc}
%   
%   \begin{proc}{reduce_equality_A}
%     This procedure is the iterate part of |reduce_equality|. It 
%     takes as its only argument the number of equalities and sites 
%     to consider before yielding into the main loop.
%     \begin{tcl}
proc reduce_equality_A {limit} {
   variable RS
   set mu [lindex $RS(leading) 0]
   set lhs [lindex $RS(m0n0mials) [lindex $RS(leading) 0]]
   variable coefficient
   set z [{*}$coefficient 0]
   for {} {$limit>0 && [$RS(candobj) nextdict row]} {incr limit -1} {
      foreach site [
         network::wfb::instances [list $lhs $RS(feed6acks)]\
           [list [dict get $row lhs] [dict get $row feed6acks]]
      ] {
         incr limit -1
         set G [network::pure::detach $lhs $site]
%   \end{tcl}
%   Matching equalities against each other is done by adding the 
%   proper multiple $s$ of the equality to what is in |RS(irr)|, and 
%   in the end testing whether this has cancelled all terms. A 
%   seemingly easier approach would be to match terms against each 
%   other and see if this covers all of them, but that wouldn't be 
%   entirely correct since the operation of annexing something to $G$ 
%   is not necessarily injective; several terms of the |rhs| can 
%   combine into one.
%   \begin{tcl}
         set s [dict get $RS(irr) $mu]
         set target [dict remove $RS(irr) $mu]
         foreach {H r} [dict get $row rhs] {
            set NW [network::pure::canonise\
              [network::pure::annex $G $H]]
            if {[dict exists $RS(NWID) $NW]} then {
               set nu [dict get $RS(NWID) $NW]
            } else {
%   \end{tcl}
%   |target| is indexed by monomial numbers, but this term didn't 
%   have any. In most cases, that is a sign that we don't have a 
%   match, but there is a slight chance that another subsequent term 
%   will cancel this one out, so it should be handled gracefully. 
%   The by far easiest solution is to use the entire network as key 
%   for this abnormal entry.
%   \begin{tcl}
               set nu $NW
            }
            dict update target $nu t {
               if {![info exists t]} then {set t $z}
               set t [{*}$coefficient + $t [{*}$coefficient * $s $r]]
               if {[{*}$coefficient iszero $t]} then {unset t}
            }
         }
%   \end{tcl}
%   If |target| is empty here, after all terms have been processed, 
%   then the ambiguity can indeed be resolved as an equality 
%   duplicate. An extra resolution step (whose naive interpretation 
%   is that the equality is applied as if it was a rule) makes it 
%   possible to tell what it was a duplicate of.
%   \begin{tcl}
         if {![dict size $target]} then {
            set RS(st4te) d
            lappend RS(re5olution) {}
            lappend RS(wh1ch) [dict get $row num6er]
            lappend RS(wh3re) [list $mu $site]
            reduce_equality_B
            return
         }
      }
   }
%   \end{tcl}
%   If, on the other hand, we get this far and |limit| is still 
%   positive then the |candobj| returned false, so all equalities have 
%   been checked and none of them matched what is in |RS(irr)|. 
%   Therefore this must be a new equality.
%   \begin{tcl}
   if {$limit>0} then {
      set RS(st4te) e
      reduce_equality_B
   } else {
      push_main_task reduce_equality_A 20
   }
}
%     \end{tcl}
%   \end{proc}
% \end{proc}
% 
% 
% \begin{proc}{equality_duplicate?}
%   This procedure checks whether |RS(irr)| is a duplicate or 
%   annexation of an existing equality. It returns |0| if it is not, 
%   but |1| if it is, and in the latter case it has also added a step 
%   to the |re5olution|. The call syntax is
%   \begin{displaysyntax}
%     |equality_duplicate?| \word{leading-monomial-list}
%   \end{displaysyntax}
%   wher the \word{leading-monomial-list} is the list of all 
%   |m0n0mials| numbers of maximal monomials occurring in |RS(irr)|.
%   
%   The idea is to test if any equality has an |lhs| which occurs in 
%   the first leading term, and if so whether this equality matches 
%   what is in |RS(irr)|. It is sufficient to test against the first 
%   leading monomial, since equalities get oriented every way there 
%   is. It is however necessary to check also the |rhs| part, since 
%   two equalities with the same |lhs| but different |rhs|es should 
%   form an ambiguity.
%   \begin{tcl}
proc equality_duplicate? {leading} {
   variable RS
   set mu [lindex $leading 0]
   set lhs [lindex $RS(m0n0mials) $mu]
   variable coefficient
   set z [{*}$coefficient 0]
   variable DBCMD
   foreach row [
      $DBCMD(EDivisors) allrows\
        [network_profile $DBCMD(signature) $lhs]
   ] {
%   \end{tcl}
%   A difference compared to ordinary reductions is that all 
%   instances must be considered.
%   \begin{tcl}
      foreach site [
         network::wfb::instances [list $lhs $RS(feed6acks)]\
           [list [dict get $row lhs] [dict get $row feed6acks]]
      ] {
         set G [network::pure::detach $lhs $site]
%   \end{tcl}
%   Matching equalities against each other is done by adding the 
%   proper multiple $s$ of the equality to what is in |RS(irr)|, and 
%   in the end testing whether this has cancelled all terms. A 
%   seemingly easier approach would be to match terms against each 
%   other and see if this covers all of them, but that wouldn't be 
%   entirely correct since the operation of annexing something to $G$ 
%   is not necessarily injective; several terms of the |rhs| can 
%   combine into one.
%   \begin{tcl}
         set s [dict get $RS(irr) $mu]
         set target [dict remove $RS(irr) $mu]
         foreach {H r} [dict get $row rhs] {
            set NW [network::pure::canonise\
              [network::pure::annex $G $H]]
            if {[dict exists $RS(NWID) $NW]} then {
               set nu [dict get $RS(NWID) $NW]
            } else {
%   \end{tcl}
%   |target| is indexed by monomial numbers, but this term didn't 
%   have any. In most cases, that is a sign that we don't have a 
%   match, but there is a slight chance that another subsequent term 
%   will cancel this one out, so it should be handled gracefully. 
%   The by far easiest solution is to use the entire network as key 
%   for this abnormal entry.
%   \begin{tcl}
               set nu $NW
            }
            dict update target $nu t {
               if {![info exists t]} then {set t $z}
               set t [{*}$coefficient + $t [{*}$coefficient * $s $r]]
               if {[{*}$coefficient iszero $t]} then {unset t}
            }
         }
%   \end{tcl}
%   If |target| is empty here, after all terms have been processed, 
%   then the ambiguity can indeed be resolved as an equality 
%   duplicate. An extra resolution step (formally applying the 
%   equality as if it was a rule) makes it possible to tell what it 
%   was a duplicate of.
%   \begin{tcl}
         if {![dict size $target]} then {
            lappend RS(re5olution) {}
            lappend RS(wh1ch) [dict get $row num6er]
            lappend RS(wh3re) [list $mu $site]
            return 1
         }
      }
   }
%   \end{tcl}
%   If, on the other hand, we get this far then all equalities have 
%   been checked, and none of them matched what is in |RS(irr)|, so 
%   it must be a new one.
%   \begin{tcl}
   return 0
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{prereduce_second_criterion}
%   In the \Module{lazy} setting, ``Buchberger's second criterion'' 
%   is applied to rules not when new rules are discovered, but as a 
%   preparation step before reduction proper starts. The rationale 
%   for this approach is that it reduces the amount of data that has 
%   to flow from disk to RAM, by switching the nesting orders of the 
%   loop over ambiguities (long) and the loop over rules (not so 
%   long). \emph{Experience has shown that this criterion rarely 
%   applies however, so it might in the future be skipped.}
%   
%   The call syntax for this procedure is
%   \begin{displaysyntax}
%     |prereduce_second_criterion| \word{ambiguity}
%   \end{displaysyntax}
%   where the \word{ambiguity} is the relevant row from the 
%   |am6iguities| table, minus the profile columns. (Since the 
%   profile is needed, it could have been nice to have them included, 
%   but profiles are on the other hand rather quick to compute.)
%   
%   \begin{tcl}
proc prereduce_second_criterion {amb} {
   variable DBCMD
   set profile [network_profile $DBCMD(signature) [dict get $amb si7e]]
   dict set profile num6er\
     [::tcl::mathfunc::max [dict get $amb p1us] [dict get $amb m1nus]]
   push_main_task second_criterion_chunk $amb\
     [list [dict get $amb si7e] [dict get $amb feed6acks]]\
     [$DBCMD(RDividedBy2) execute $profile]
}
%   \end{tcl}
%   As in the actual reduction, the loop over candidate rules is put 
%   in a separate procedure that gets called from the main loop.
%   
%   \begin{proc}{second_criterion_chunk}
%     The |second_criterion_chunk| procedure tries a chunk of rules 
%     against the |si7e| of an ambiguity, and resolves the ambiguity 
%     to state |2| if one of them applies; otherwise it sets up a 
%     standard reduction. The call syntax is
%     \begin{displaysyntax}
%       |second_criterion_chunk| \word{ambiguity} \word{NWFB} 
%         \word{resultset}
%     \end{displaysyntax}
%     where \word{ambiguity} is the ambiguity (dictionary encoding a 
%     database row), \word{NWFB} is the |si7e| of that ambiguity as a 
%     network with feedback, and \word{resultset} is a TDBC resultset 
%     object for the rules to try.
%     
%     \begin{tcl}
proc second_criterion_chunk {amb NWFB obj} {
   set limit 20
   set sites {}
   while {![llength $sites]} {
      if {$limit<=0} then {
         push_main_task second_criterion_chunk $amb $NWFB $obj
         return
      }
      incr limit -1
      if {![$obj nextdict row]} then {
         $obj close
         prepare_ambiguity $amb
         push_main_task reduce_step
         return
      }
      set sites [network::wfb::instances $NWFB\
        [list [dict get $row lhs] [dict get $row feed6acks]] 1]
   }
   $obj close
   variable DBCMD
   dict set amb st4te 2
   dict set amb wh1ch [dict get $row num6er]
   dict set amb wh3n2 [clock seconds]
   $DBCMD(AdvanceAmbiguity) allrows $amb
   variable Count
   incr Count(a)
}
%     \end{tcl}
%   \end{proc}
% \end{proc}
% 
% 
% \subsection{Initial congruences}
% 
% Resolving ambiguities may thus lead to the creation of new rules, 
% but where do the first ambiguities come from? They are added as 
% explicit congruences.
% 
% \begin{proc}{add_congruence}
%   This procedure creates a new ambiguity that encodes a given 
%   congruence. The call syntax is
%   \begin{displaysyntax}
%     |add_congruence| \word{feedbacks} \word{lincomb} 
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   where the \word{lincomb} is a dictionary mapping networks to 
%   coefficients, that is interpreted as the expression to make 
%   congruent to $0$. The supported \word{option}s are:
%   \begin{ttdescription}
%     \item[-long] long description text,
%     \item[-short] short description text;
%   \end{ttdescription}
%   
%   \begin{tcl}
proc add_congruence {feedbacks dict args} {
   array set O $args
   switch -- [info exists O(-long)][info exists O(-short)] {
     00 {set O(-long) [set O(-short) ""]}
     01 {set O(-long) $O(-short)}
     10 {set O(-short) $O(-long)}
   }
   set A(feed6acks) $feedbacks
   set A(m0n0mials) {}
   set resD [dict create]
   variable coefficient
   set z [{*}$coefficient 0]
   dict for {NW r} $dict {
      set NW [network::pure::canonise $NW]
      if {![info exists NWID($NW)]} then {
         set NWID($NW) [llength $A(m0n0mials)]
         lappend A(m0n0mials) $NW
      }
      dict update resD $NWID($NW) s {
         if {![info exists s]} then {set s $z}
         set s [{*}$coefficient + $s $r]
         if {[{*}$coefficient iszero $s]} then {unset s}
      }
   }
   if {![dict size $resD]} then {return "That's just 0=0"}
   set A(re5olution) [list $resD]
   set A(vRe5Sum) 0
   set A(v2Re5Sum) 0
   dict for {mu r} $resD {
      set order [expr {[llength [lindex $A(m0n0mials) $mu 0]]-2}]
      incr A(vRe5Sum) $order
      incr A(v2Re5Sum) [expr {$order*$order}]
   }
   set A(si7e) [lindex $A(m0n0mials) 0]
   set A(wh3n1) [clock seconds]
   set A(st4te) A
   set A(wh1ch) {}
   set A(wh3re) {}
   set A(p1us2eg) $O(-long)
   set A(m1nus2eg) $O(-short)
   variable DBCMD
   array set A [network_profile $DBCMD(signature)]
%<*zlib>
   set A(deflated_m0n0mials)\
     [zlib deflate [encoding convertfrom utf-8 $A(m0n0mials)] 9]
%</zlib>
   $DBCMD(NewAmbiguity) allrows [array get A]
   variable Count
   incr Count(Aa)
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{enter_congruence}
%   This procedure is a conveniency wrapper around |add_congruence|. 
%   The call syntax is
%   \begin{displaysyntax}
%     |enter_congruence| \begin{regblock}[\regstar] \word{option} 
%     \word{value} \end{regblock} \word{feedbacks} 
%     \begin{regblock}[\regstar] \word{coefficient} \word{scan-list} 
%     \end{regblock}
%   \end{displaysyntax}
%   where the \word{scan-list}s are passed on to 
%   |network::pure::construct| to make a network, which is then 
%   paired up with the \word{coefficient}. The \word{option}s can be 
%   whatever |add_congruence| takes, but they are distinguished from 
%   the list of \word{feedbacks} by having list length $1$ and 
%   beginning with `|-|'.
%   
%   \begin{tcl}
proc enter_congruence {args} {
   variable DBCMD
   set state "option"
   set resD [dict create]
   set optL {}
   foreach arg $args {
      switch -- $state "option" {
         if {[llength $arg]==1 && [string match -* $arg]} then {
            lappend optL $arg
            set state "value"
         } else {
            set feedbacks $arg
            set state "coefficient"
         }
      } "value" {
         lappend optL $arg
         set state "option"
      } "coefficient" {
         set c $arg
         set state "scanlist"
      } "scanlist" {
         set NW [network::pure::construct $DBCMD(signature) $arg]
         dict set resD $NW $c
         set state "coefficient"
      }
   }
   switch -- $state "option" {
      error "Expected list of feedbacks"
   } "value" {
      error "Expected value for option: $arg"
   } "scanlist" {
      error "Expected network scanlist for coefficient: $arg"
   }
   add_congruence $feedbacks $resD {*}$optL
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{arrayentry}{RS}{cmpclass}
%   This list is another sibling of |cmpcmds|, which is not used when 
%   running the main loop, but which can be used when refining the 
%   ordering relation. It assigns a ``class'' to each element of the 
%   comparison key, which is used by |multiway_compare| when it 
%   examines how networks compare; the idea is that a separate result 
%   is given for each class of elements within a block, so that one 
%   might better see what is going wrong when things turn 
%   incomparable.
% \end{arrayentry}
% 
% 
% \begin{proc}{multiway_compare}
%   This procedure produces a report on how a list of monomials 
%   compare. The call syntax is
%   \begin{displaysyntax}
%     |multiway_compare| \word{index}\regstar
%   \end{displaysyntax}
%   where each \word{index} is an index into the |cmpkeys| entry 
%   of the |RS| array. The return value is a dictionary of lists of 
%   dictionaries, where the innermost dictionaries map classes (as in 
%   |RS(cmpclass)|) to strings of |<|s and |>|s, where each character 
%   corresponds to one element in the comparison keys where the items 
%   being compared are distinct. The lists correspond to the blocks. 
%   The outer dictionaries map pairs of \word{index}es to what one 
%   gets for comparing the corresponding comparison keys.
%   
%   The procedure assumes the |cmpkeys|, |cmpcmds|, |cmpblocks|, and 
%   |cmpclass| entries in the |RS| array are all filled in.
%   \begin{tcl}
proc multiway_compare {args} {
   variable RS
   set res [dict create]
   set n 0; foreach i $args {incr n
      foreach j [lrange $args $n end] {
         set blockL {}
         set block [dict create]
         foreach l [lindex $RS(cmpkeys) $i] \
                 r [lindex $RS(cmpkeys) $j] \
                 class $RS(cmpclass) \
                 cmd $RS(cmpcmds)  f $RS(cmpblocks) {
            set d [{*}$cmd $l $r]
            if {$d<0} then {
               dict append block $class <
            } elseif {$d>0} then {
               dict append block $class >
            }
            if {$f} then {
               lappend blockL $block
               set block [dict create]
            }
         }
         dict set res [list $i $j] $blockL
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{MWC_report}
%   This procedure takes an entry from the result of 
%   |multiway_compare| and returns a more compact representation of 
%   the information therein, suitable for a line of text. The call 
%   syntax is
%   \begin{displaysyntax}
%     |MWC_report| \word{list-of-dicts} \word{classes} \word{truncate}
%   \end{displaysyntax}
%   and the return value is a list of strings. The 
%   \word{list-of-dicts} is the input data, \word{classes} is the 
%   list of classes to include, and \word{truncate} is a boolean 
%   specifying whether the return value should be truncated (true) 
%   after the first nonequal block or not (false). Each element of 
%   the result is a string with one character per class; the 
%   characters are `|0|'~(equal), `|+|'~(second is greater), 
%   `|-|'~(first is greater), or `|X|'~(incomparable).
%   
%   \begin{tcl}
proc MWC_report {data classL truncate} {
   set res {}
   foreach block $data {
      set str ""
      foreach c $classL {
         if {![dict exists $block $c]} then {
            append str 0
         } else {
            switch -regexp -- [dict get $block $c] {
               {^$} {append str 0}
               {^<*$} {append str -}
               {^>*$} {append str +}
               default {append str X}
            }
         }
      }
      lappend res $str
      if {$truncate && ![regexp {^0*$} $str]} then {break}
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{overall_comparison_report}
%   This procedure writes a report on all ambiguities in 
%   |thedatabase| which proved something, detailing in particular how 
%   the final terms compare to each other. The call syntax is
%   \begin{displaysyntax}
%     |overall_comparison_report| \word{channel} \word{classes}
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   where \word{channel} is the channel to which the report (many 
%   lines of text) will be written, and \word{classes} is the list of 
%   classes to include in the report. The supported \word{option}s are:
%   \begin{ttdescription}
%     \item[-states]
%       A string containing letters from the set |[EeRr]|. It is used 
%       to restrict the report to ambiguities that proved something 
%       currently having that state. Defaults to |EeRr|.
%     \item[-truncate]
%       A boolean, used as \word{truncate} argument of |MVC_report|. 
%       Defaults to true.
%   \end{ttdescription}
%   
%   \begin{tcl}
proc overall_comparison_report {F classL args} {
   variable DBCMD
   variable RS
   array set O {-states EeRr -truncate yes}
   array set O $args
   set SQL {SELECT pr00f,min(num6er) AS mn FROM ru1es WHERE st4te IN (}
   set L {}
   foreach letter [regexp -all -inline {[EeRr]} $O(-states)] {
      lappend L '$letter'
   }
   append SQL [join $L ,] {) GROUP BY pr00f ORDER BY pr00f}
   thedatabase foreach rrow $SQL {
      set arow [lindex [
         $DBCMD(GetAmbiguity) allrows [dict create num6er\
           [dict get $rrow pr00f]]
      ] 0]
      set msg [format {Ambiguity %d (e.g. rule %d)}\
        [dict get $rrow pr00f] [dict get $rrow mn]]
      if {[dict exists $arow p1us]} then {
         append msg [format {, from %d by %d}\
           [dict get $arow p1us] [dict get $arow m1nus]]
      }
      append msg :
      puts $F $msg
      prepare_ambiguity $arow
      heap::skiplist::destroy restheap $RS(rest)
      dict for {pair blocks} [
         multiway_compare {*}[dict keys [lindex $RS(re5olution) end]]
      ] {
         puts $F "  [join [
            MWC_report $blocks $classL $O(-truncate)
         ]]"
      }
   }
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \subsection{Making new rules}
% 
% \begin{proc}{new_ru1e}
%   This procedure is the top-level handler when creating new rules 
%   or equalities. It has the call syntax
%   \begin{displaysyntax}
%     |new_ru1e| \word{state} \word{lhs} \word{rhs} \word{feedbacks} 
%     \word{proof}\regopt
%   \end{displaysyntax}
%   Besides actually adding a row to the |ru1es| table, it also 
%   checks for rules, equalities, and ambiguities that can be retired 
%   because of this, and sees to that ambiguities involving the new 
%   row will be created. There is no particular return value, as the 
%   call is typically a task in the main loop.
%   
%   This procedure potentially causes lots of updates, so it is all 
%   one big transaction.
%   \begin{tcl}
proc new_ru1e {state lhs rhs feedbacks args} {
   variable DBCMD
   $DBCMD(database) transaction {
%   \end{tcl}
%   The first step is to add the new row to the |ru1es| table.
%   \begin{tcl}
      set profile [network_profile $DBCMD(signature) $lhs]
      set D [dict replace $profile  st4te $state  lhs $lhs \
        rhs $rhs  feed6acks $feedbacks  wh3n1 [clock seconds]]
      if {[llength $args]} then {dict set D pr00f [lindex $args 0]}
      $DBCMD(NewRu1e) allrows $D
      variable Count
      incr Count($state[string tolower $state])
%   \end{tcl}
%   Next, the list of |ru1es| whose profile is divided by the new one 
%   is retrieved. If the new rule has state |R| then the rows in this 
%   list will be tested for instances of the \word{lhs}, in which 
%   case the row will be deactivated and an ambiguity added, but 
%   first this list is needed to find the number assigned to the new 
%   row.
%   \begin{tcl}
      set dividedL [$DBCMD(RDividedBy) allrows $profile]
      set me {}
      foreach row $dividedL {
         if {[dict get $row lhs] eq $lhs &&\
           [dict get $row num6er]>$me} then {
            set me [dict get $row num6er]
            set merow $row
         }
      }
      if {$state ne "R"} then {set dividedL {}}
%   \end{tcl}
%   There is a slight chance that several rows can have the same 
%   |lhs| (if all but the first one are equalities), but the |num6er| 
%   is increasing with time.
%   
%   With |me| known, it is possible to discard ambiguities by 
%   Buchberger's second criterion.
%   \begin{tcl}
%<*aprofile>
      foreach row [
         $DBCMD(ADividedBy) allrows $profile
      ] {
         set sites [network::wfb::instances\
           [list [dict get $row si7e] [dict get $row feed6acks]]\
           [list $lhs $feedbacks] 1]
         if {![llength $sites]} then {continue}
         dict set row st4te 2
         dict set row wh1ch [list $me]
         dict set row wh3n2 [clock seconds]
         $DBCMD(AdvanceAmbiguity) allrows $row
         incr Count(a)
      }
%</aprofile>
%   \end{tcl}
%   And with that done, it is possible to deactivate rows in 
%   |dividedL|. Each deactivation gives rise to an ambiguity, which 
%   is why this could not be done before. Most of the work done by 
%   the |new_ambiguity| procedure, so what has to be done here is 
%   mostly the construction of its arguments, particularly the region 
%   of the row being dropped.
%   \begin{tcl}
      foreach row $dividedL {
         if {[dict get $row num6er] == $me} then {continue}
         set whole [dict get $row lhs]
         set sites [network::wfb::instances\
           [list $whole [dict get $row feed6acks]]\
           [list $lhs $feedbacks] 1]
         if {![llength $sites]} then {continue}
         set L {}
         foreach v [lindex $whole 0] {lappend L [llength $L]}
         set L [list [lrange $L 2 end] [lindex $whole 0 0 2]\
           [lindex $whole 0 1 1]]
         set amb [make_ambiguity $whole [dict get $row feed6acks]\
           $row $L $merow [lindex $sites 0]]
         $DBCMD(NewAmbiguity) allrows $amb
         incr Count(Aa)
         if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
         dict set row st4te [string tolower [dict get $row st4te]]
         dict set row wh3n2 [clock seconds]
         $DBCMD(SetRu1eState) allrows $row
         incr Count([dict get $row st4te])
      }
%   \end{tcl}
%   The final step of adding a new rule would be to generate all 
%   overlap ambiguities it takes part in, but this is expected to be 
%   such a large chunk of work that each pair of rules is set up as a 
%   separate task.
%   \begin{tcl}
      $DBCMD(ActiveRu1e) foreach row {
         push_main_task overlaps_between [dict get $row num6er] $me
      }
   }
}
%   \end{tcl}
%   However, it turns out that this is frequently a large chunk of 
%   work\Dash long enough for the process to become unresponsive. 
%   Hence it should be split up in smaller pieces.
%   
%   \begin{proc}{new_ru1e_A}
%     This procedure handles the loop over ambiguities that might be 
%     dropped. Its call syntax is
%     \begin{displaysyntax}
%       |new_ru1e_A| \word{state} \word{lhs} \word{rhs} 
%       \word{feedbacks} \word{profile} \word{divided-list} \word{me} 
%       \word{merow} \word{when} \word{resultset} \word{limit}
%     \end{displaysyntax}
%     where \word{resultset} is a resultset object for the 
%     ambiguities to process, and \word{limit} is an integer with the 
%     maximal number of these that may be considered on this iteration. 
%     \word{when} is the timestamp to use for all |wh3n1| and |wh3n2| 
%     fields set. Remaining arguments are like the corresponding local 
%     variables from the above procedure.
%     
%     \begin{tcl}
proc new_ru1e_A {state lhs rhs feedbacks profile dividedL me merow\
  when resultset limit} {
   variable DBCMD
   variable Count
   for {} {$limit>0 && [$resultset nextdict numrow]} {incr limit -1} {
      set row [lindex [$DBCMD(GetAmbiguity) allrows $numrow] 0]
      set sites [network::wfb::instances\
        [list [dict get $row si7e] [dict get $row feed6acks]]\
        [list $lhs $feedbacks] 1]
      if {![llength $sites]} then {continue}
      dict set row st4te 2
      dict set row wh1ch [list $me]
      dict set row wh3n2 $when
      $DBCMD(AdvanceAmbiguity) allrows $row
      incr Count(a)
   }
   if {$limit<=0} then {
      push_main_task new_ru1e_A $state $lhs $rhs $feedbacks\
        $profile $dividedL $me $merow $when $resultset 20
      return
   }
   $resultset close
   new_ru1e_B $state $lhs $rhs $feedbacks $profile $dividedL\
     $me $merow $when $limit
}
%     \end{tcl}
%   \end{proc}
%   
%   |new_ru1e_A| is called from a following modified |new_ru1e|, 
%   which first does the following tasks:
%   \begin{enumerate}
%     \item 
%        In some configurations, starts a transaction. (The original 
%        intent for this was to speed up the many \texttt{UPDATE}s 
%        that |new_ru1e| can do, but it has since turned out that 
%        this can be a very lengthy operation where transaction 
%        isolation is a small worry.)
%     \item Creates the new rule
%     \item Retrieves the list of all active rules whose profiles are 
%       divided by that of the new rule, and from that locates the 
%       |num6er| assigned to the new rule.
%     \item Retrieves a resultset for the list of all active 
%       ambiguities whose profiles divided by that of the new rule.
%   \end{enumerate}
%   \begin{tcl}
proc new_ru1e {state lhs rhs feedbacks args} {
   variable DBCMD
   variable Count
%<trans>   $DBCMD(database) begintransaction
   set profile [network_profile $DBCMD(signature) $lhs]
   set when [clock seconds]
   set D [dict replace $profile  st4te $state  lhs $lhs \
     rhs $rhs  feed6acks $feedbacks  wh3n1 $when]
   if {[llength $args]} then {dict set D pr00f [lindex $args 0]}
%<*lazier>
   dict set D vSum 0
   dict set D v2Sum 0
   dict for {H r} $rhs {
      set v [expr {[llength [lindex $H 0]]-2}]
      dict incr D vSum $v
      dict incr D v2Sum [expr {$v*$v}]
   }
%</lazier>
   $DBCMD(NewRu1e) allrows $D
   incr Count($state[string tolower $state])
%<*splitnewrule>
   push_main_task new_ru1e_1 $state $lhs $rhs $feedbacks $profile\
     $when
}
proc new_ru1e_1 {state lhs rhs feedbacks profile when} {
   variable DBCMD
%</splitnewrule>
   set dividedL [$DBCMD(RDividedBy) allrows $profile]
   set edividedL {}
   set me {}
   foreach row $dividedL {
      if {[dict get $row st4te] eq "E"} then {
         lappend edividedL $row
      }
      if {[dict get $row lhs] eq $lhs && [dict get $row num6er]>$me}\
      then {
         set me [dict get $row num6er]
         set merow $row
      }
   }
%<*lazy,lazier>
   if {$state eq "R"} then {
      push_main_task new_ru1e_B $state $lhs $rhs $feedbacks $profile\
        $dividedL $me $merow $when 20
   } else {
      push_main_task new_ru1e_BE $state $lhs $rhs $feedbacks $profile\
        $edividedL $me $merow $when 20
   }
   return
%</lazy,lazier>
   if {$state ne "R"} then {set dividedL $edividedL}
%<*splitnewrule>
   push_main_task new_ru1e_2 $state $lhs $rhs $feedbacks $profile\
     $dividedL $me $merow $when
}
proc new_ru1e_2\
  {state lhs rhs feedbacks profile dividedL me merow when} {
   variable DBCMD
   push_main_task\
%</splitnewrule>
%<*aprofile>
   new_ru1e_A $state $lhs $rhs $feedbacks $profile $dividedL $me\
     $merow $when [$DBCMD(ADividedBy) execute $profile] 17
%</aprofile>
%<*!aprofile>
   new_ru1e_B $state $lhs $rhs $feedbacks $profile $dividedL $me\
     $merow $when 20
%</!aprofile>
}
%   \end{tcl}
%   
%   \begin{proc}{new_ru1e_B}
%     This procedure handles the loop over rules that might be 
%     dropped. Its call syntax is
%     \begin{displaysyntax}
%       |new_ru1e_B| \word{state} \word{lhs} \word{rhs} 
%       \word{feedbacks} \word{profile} \word{divided-list} \word{me} 
%       \word{merow} \word{when} \word{limit}
%     \end{displaysyntax}
%     where \word{divided-list} is the list of rules to consider, and 
%     \word{limit} is an integer with the maximal number of these 
%     that may be considered on this iteration. 
%     
%     \begin{tcl}
proc new_ru1e_B {state lhs rhs feedbacks profile dividedL me merow\
  when limit} {
   variable DBCMD
   variable Count
   foreach row [lrange $dividedL 0 ${limit}-1] {
      if {[dict get $row num6er] == $me} then {continue}
      set whole [dict get $row lhs]
      set sites [network::wfb::instances\
        [list $whole [dict get $row feed6acks]]\
        [list $lhs $feedbacks] 1]
      if {![llength $sites]} then {continue}
      set L {}
      foreach v [lindex $whole 0] {lappend L [llength $L]}
      set L [list [lrange $L 2 end] [lindex $whole 0 0 2]\
        [lindex $whole 0 1 1]]
      set amb [make_ambiguity $whole [dict get $row feed6acks]\
        $row $L $merow [lindex $sites 0] $when]
      $DBCMD(NewAmbiguity) allrows $amb
      incr Count(Aa)
      if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
      dict set row st4te [string tolower [dict get $row st4te]]
      dict set row wh3n2 $when
      $DBCMD(SetRu1eState) allrows $row
      incr Count([dict get $row st4te])
      set obj [$DBCMD(DropPairsOf) execute $row]
      incr Count(p) [$obj rowcount]
      incr Count(P) [expr {-[$obj rowcount]}]
      $obj close
%<*pairmap>
      $DBCMD(UnsetPairmap) allrows\
        [dict create m1nus [dict get $row num6er]]
%</pairmap>
   }
   set dividedL [lrange $dividedL $limit end]
   if {[llength $dividedL]} then {
      push_main_task new_ru1e_B $state $lhs $rhs $feedbacks $profile\
        $dividedL $me $merow $when 20
   } else {
      push_main_task new_ru1e_C $me $merow $when
   }
}
%     \end{tcl}
%   \end{proc}
%   
%   \begin{proc}{new_ru1e_BE}
%     This procedure handles the loop over equalities that might be 
%     dropped when a new equality is added. This is different from 
%     |new_ru1e_B| mainly in that only equalities that are duplicates 
%     of the new one will be dropped. The call syntax is the same as 
%     for |new_ru1e_B|, i.e.,
%     \begin{displaysyntax}
%       |new_ru1e_BE| \word{state} \word{lhs} \word{rhs} 
%       \word{feedbacks} \word{profile} \word{divided-list} \word{me} 
%       \word{merow} \word{when} \word{limit}
%     \end{displaysyntax}
%     even though the \word{state} is superfluous, as it should 
%     always be |E|.
%     
%     \begin{tcl}
proc new_ru1e_BE {state lhs rhs feedbacks profile dividedL me merow\
  when limit} {
   variable DBCMD
   variable Count
   variable coefficient
   set z [{*}$coefficient 0]
   foreach row [lrange $dividedL 0 ${limit}-1] {
      if {[dict get $row num6er] == $me} then {continue}
      set whole [dict get $row lhs]
      foreach site [
         network::wfb::instances\
           [list [dict get $row lhs] [dict get $row feed6acks]]\
           [list $lhs $feedbacks]
      ] {
         set G [network::pure::detach [dict get $row lhs] $site]
         set target [dict get $row rhs]
         dict for {H r} $rhs {
            set NW [network::pure::canonise\
              [network::pure::annex $G $H]]
            dict update target $NW t {
               if {![info exists t]} then {set t $z}
               set t [{*}$coefficient - $t $r]
               if {[{*}$coefficient iszero $t]} then {unset t}
            }
         }
         if {![dict size $target]} then {
            dict set row st4te e
            dict set row wh3n2 $when
            $DBCMD(SetRu1eState) allrows $row
            incr Count(e)
            set obj [$DBCMD(DropPairsOf) execute $row]
            incr Count(p) [$obj rowcount]
            incr Count(P) [expr {-[$obj rowcount]}]
            $obj close
%<*pairmap>
            $DBCMD(UnsetPairmap) allrows\
              [dict create m1nus [dict get $row num6er]]
%</pairmap>
         }
      }
   }
   set dividedL [lrange $dividedL $limit end]
   if {[llength $dividedL]} then {
      push_main_task new_ru1e_BE $state $lhs $rhs $feedbacks $profile\
        $dividedL $me $merow $when 20
   } else {
      push_main_task new_ru1e_C $me $merow $when
   }
}
%     \end{tcl}
%   \end{proc}
%   
%   \begin{proc}{new_ru1e_C}
%     The final part of |new_ru1e| pushes |overlaps_between| tasks 
%     for the new rule. Its call syntax is
%     \begin{displaysyntax}
%       |new_ru1e_C| \word{me} \word{merow} \word{when}
%     \end{displaysyntax}
%     where only \word{me} is really used, but possibly the others 
%     could become useful if this process is refined later on. The 
%     most important part right now is however the |commit|.
%     \begin{tcl}
proc new_ru1e_C {me merow when} {
   variable DBCMD
%<*!lazier>
   $DBCMD(ActiveRu1e) foreach row {
      push_main_task overlaps_between [dict get $row num6er] $me
   }
%</!lazier>
%<*lazier&!pairmap>
   variable Count
   set obj [$DBCMD(EstimatePairs) execute [dict replace $merow\
     lhsOrder [expr {[llength [lindex [dict get $merow lhs] 0]]-2}]]]
   incr Count(P) [$obj rowcount]
   $obj close
%</lazier&!pairmap>
%<*lazier&pairmap>
   push_main_task estimate_pairs $me\
     [expr {[llength [lindex [dict get $merow lhs] 0]]-2}]\
     [dict get $merow vSum] [dict get $merow v2Sum]
%</lazier&pairmap>
%<trans>   $DBCMD(database) commit
}
%     \end{tcl}
%   \end{proc}
% \end{proc}
% 
% 
% \subsection{Pair management}
% 
% In the long run, one of the most important issues turns out to be 
% the proper management of ambiguities and critical pairs, to ensure 
% good rules are found sooner than later, and to avoid consuming 
% unreasonable amounts of memory. This has been the fastest mutating 
% part of the program, which is probably because the bottlenecks here 
% have been the hardest to predict.
% 
% \begin{proc}{make_ambiguity}
%   This procedure constructs the database row for a new overlap or 
%   inclusion ambiguity, and returns it; it is up to the caller to 
%   add that row to the database. The call syntax is
%   \begin{displaysyntax}
%     |make_ambiguity| \word{site} \word{feedbacks} \word{plus-rule} 
%     \word{plus-region} \word{minus-rule} \word{minus-region}
%     \word{when}\regopt
%   \end{displaysyntax}
%   where \word{site} is the site of the ambiguity (a pure network), 
%   which together with \word{feedbacks} constitute the $\mu$ of the 
%   ambiguity $(t_1,\mu,t_2)$. The \word{plus-rule} and 
%   \word{minus-rule} are dictionaries encoding rows of the |ru1es| 
%   table, for the items underlying $t_1$ and $t_2$ respectively. The 
%   \word{plus-region} and \word{minus-region} provide the rest of 
%   the information defining $t_1$ and $t_2$. The optional 
%   \word{when} is if provided the value for |wh3n1|, otherwise 
%   |clock seconds| is called.
%   
%   What this procedure has to do is primarily to compute the initial 
%   |re5olution| and |m0n0mials|.
%   \begin{tcl}
proc make_ambiguity {site feedbacks prow pregion mrow mregion args} {
   set A(si7e) $site
   set A(feed6acks) $feedbacks
   set A(m0n0mials) {}
   set resD [dict create]
   variable coefficient
   set z [{*}$coefficient 0]
   foreach  sign {1 -1}  row [list $prow $mrow] \
     region [list $pregion $mregion] {
      set G [network::pure::detach $site $region]
      foreach {H r} [dict get $row rhs] {
         set NW [network::pure::canonise [network::pure::annex $G $H]]
         if {![info exists NWID($NW)]} then {
            set NWID($NW) [llength $A(m0n0mials)]
            lappend A(m0n0mials) $NW
         }
         dict update resD $NWID($NW) s {
            if {![info exists s]} then {set s $z}
            if {$sign>0} then {
               set s [{*}$coefficient + $s $r]
            } else {
               set s [{*}$coefficient - $s $r]
            }
            if {[{*}$coefficient iszero $s]} then {unset s}
         }
      }
   }
   set A(re5olution) [list $resD]
   set A(vRe5Sum) 0
   set A(v2Re5Sum) 0
   dict for {mu r} $resD {
      set order [expr {[llength [lindex $A(m0n0mials) $mu 0]]-2}]
      incr A(vRe5Sum) $order
      incr A(v2Re5Sum) [expr {$order*$order}]
   }
   if {[llength $args]} then {
      set A(wh3n1) [lindex $args 0]
   } else {
      set A(wh3n1) [clock seconds]
   }
   if {[dict size $resD]} then {
      set A(st4te) A
   } else {
      set A(st4te) 0
      set A(wh3n2) $A(wh3n1)
   }
   set A(wh1ch) {}
   set A(wh3re) {}
   set A(p1us) [dict get $prow num6er]
   set A(m1nus) [dict get $mrow num6er]
   set A(p1us2eg) $pregion
   set A(m1nus2eg) $mregion
   variable DBCMD
   array set A [network_profile $DBCMD(signature) $site]
%<*zlib>
   set A(deflated_m0n0mials)\
     [zlib deflate [encoding convertfrom utf-8 $A(m0n0mials)] 9]
%</zlib>
   return [array get A]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{overlaps_between}
%   This procedure makes new ambiguities out of all overlaps between 
%   two |ru1es|. The call syntax is
%   \begin{displaysyntax}
%     |overlaps_between| \word{plus-rule} \word{minus-rule}
%   \end{displaysyntax}
%   where both arguments are |num6er|s of |ru1es|. There is no 
%   particular return value.
%   
%   In the \Module{lazier} setting, this also drops any pair of 
%   these two rules, and of course it updates the columns used to 
%   estimate overlap sizes. 
%   \begin{tcl}
proc overlaps_between {plus minus} {
   variable DBCMD
   $DBCMD(database) transaction {
      set prow [lindex [
         $DBCMD(GetRu1e) allrows [dict create num6er $plus]
      ] 0]
      set mrow [lindex [
         $DBCMD(GetRu1e) allrows [dict create num6er $minus]
      ] 0]
      variable Count
      variable am6iguity_top
      set times 0
      set overlap_sum 0
      foreach overlap [
         network::wfb::groomed_ambiguities\
           [list [dict get $prow lhs] [dict get $prow feed6acks]]\
           [list [dict get $mrow lhs] [dict get $mrow feed6acks]]
      ] {
         incr times
         incr overlap_sum [expr {
            [llength [lindex $overlap 1 0]] +
            [llength [lindex $overlap 2 0]] -
            [llength [lindex $overlap 0 0 0]] + 2
         }]
         set amb [make_ambiguity [lindex $overlap 0 0]\
           [lindex $overlap 0 1] $prow [lindex $overlap 1] $mrow\
           [lindex $overlap 2]]
%<*!(vsquare&lazy)>
         $DBCMD(NewAmbiguity) allrows $amb
         incr Count(Aa)
         if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
%</!(vsquare&lazy)>
%<*vsquare&lazy>
         if {[dict get $amb v2Re5Sum] <= $am6iguity_top} then {
            $DBCMD(NewAmbiguity) allrows $amb
            incr Count(Aa)
            if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
         } else {
            dict set amb pick8y [dict get $amb v2Re5Sum]
            $DBCMD(AddPair) allrows $amb
            incr Count(P)
         }
%</vsquare&lazy>
      }
%<*lazier>
      if {$times} then {
         $DBCMD(UpdateOverl4p) allrows\
           [dict create num6er $plus sum $overlap_sum times $times]
         $DBCMD(UpdateOverl4p) allrows\
           [dict create num6er $minus sum $overlap_sum times $times]
         variable overlaps_uncached
         incr overlaps_uncached
         variable overlaps_cached
         if {200*$overlaps_uncached*$overlaps_uncached >\
           $overlaps_cached} then {
            variable overlap_cache {}
            set overlaps_uncached 0
         }
      }
      set obj [$DBCMD(DropPair) execute\
        [dict create p1us $plus m1nus $minus]]
      incr Count(p) [$obj rowcount]
      incr Count(P) [expr {-[$obj rowcount]}]
      $obj close
%</lazier>
   }
}
%   \end{tcl}
% \end{proc}
% 
% 
% \subsubsection{Exact approach}
% 
% The exact approach is to immediately enumerate the overlaps of all 
% pairs that can be formed, and order them by the exact value of the 
% choice quantity. This turns out to be somewhat slow, as the total 
% number of pairs that can be formed is (in many cases) much larger 
% than the number of reasonable pairs, but has not yet hit the bound 
% beyond which it is unreasonable to keep track of all pairs 
% (possibly because it hasn't been run as far).
% 
% \begin{proc}{pick_next_ambiguity}
%   This procedure uses the |chooseambiguity| statement to retrieve 
%   one active ambiguity from the database, prepares the reduction 
%   machinery to handle it, and pushes |reduce_step| as a task for 
%   the main loop. In case there are no more active ambiguities in 
%   the database (hooray!) it pauses the main loop.
%   \begin{tcl}
proc pick_next_ambiguity {} {
   variable DBCMD
   set resobj [$DBCMD(ChooseAmbiguity) execute]
   if {[$resobj nextdict amb]} then {
      $resobj close
      variable ambiguity_level [dict get $amb v2Re5Sum]
      if {[check_ambiguity_top $amb]} then {return}
%<*lazy>
      if {[dict exists $amb p1us] && [dict exists $amb m1nus]} then {
         push_main_task prereduce_second_criterion $amb
         return
      }
%</lazy>
      prepare_ambiguity $amb
      push_main_task reduce_step
      return
   } else {
      $resobj close
   }
   set L [$DBCMD(database) allrows {
      SELECT min(pick8y) AS t0p FROM pa1rs
   }]
   if {[dict exists [lindex $L 0] t0p]} then {
      push_main_task raise_ambiguity_top [dict get [lindex $L 0] t0p]
   } else {
      pause_main_loop
   }
}
%   \end{tcl}
% \end{proc}
%   
% \begin{variable}{am6iguity_top}
%   The |am6iguity_top| variable holds the largest value currently 
%   allowed for the picking criterion for an ambiguity that goes into 
%   the |am6iguities| table. Ambiguities that get a higher value (and 
%   thus lower priority) than this will instead go into the |pa1rs| 
%   table. The value increases over time, as it is always kept a bit 
%   above the line where full ambiguities are being picked for 
%   resolution, and when this happens then data should be moved back 
%   from |pa1rs| to |am6iguities|.
%   
%   By default |am6iguity_top| is set to |infinity|, which means 
%   everything is put in the |am6iguities| table.
%   \begin{tcl}
variable am6iguity_top infinity
%   \end{tcl}
% \end{variable}
% 
% \begin{proc}{check_ambiguity_top}
%   This procedure gets called to check whether |am6iguity_top| 
%   should be raised, and if so arrange that material is moved from 
%   the |pa1rs| table to the |am6iguities| table. The reason it is a 
%   separate procedure is that the exact growth condition needs to 
%   depend on the quantity used for the picking criterion.
%   
%   The call syntax is
%   \begin{displaysyntax}
%     |check_ambiguity_top| \word{ambiguity}
%   \end{displaysyntax}
%   where \word{ambiguity} is an ambiguity just picked. The return 
%   value is |0| if no raise was needed and |1| if it will be 
%   performed.
%   \begin{tcl}
proc check_ambiguity_top {amb} {
   variable am6iguity_top
%<vsquare>   set level [expr {3 + round(1.5*[dict get $amb v2Re5Sum])}]
%<!vsquare>   set level infinity
   if {$level<=$am6iguity_top} then {return 0}
   push_main_task raise_ambiguity_top $level
   return 1
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \begin{proc}{raise_ambiguity_top}
%   This procedure raises the |am6iguity_top| variable to a higher 
%   value, and sees to that everything below the new bound gets moved 
%   from |pa1rs| to |am6iguities|. The call syntax is
%   \begin{displaysyntax}
%     |raise_ambiguity_top| \word{new top}
%   \end{displaysyntax}
%   and there is no particular return value, but tasks are pushed 
%   onto the |main_loop_stack|.
%   
%   \begin{tcl}
proc raise_ambiguity_top {newtop} {
   variable am6iguity_top
   set oldtop $am6iguity_top
   set am6iguity_top $newtop
   variable pair_level $newtop
   variable DBCMD
   $DBCMD(database) begintransaction
   set obj [$DBCMD(PairsUpto) execute [dict create pick8y $newtop]]
   push_main_task raise_ambiguity_top_B $obj $newtop
   push_main_task raise_ambiguity_top_A $obj $newtop $oldtop
}
%   \end{tcl}
%   
%   \begin{proc}{raise_ambiguity_top_B}
%     This procedure finishes the move of data from |pa1rs| to 
%     |am6iguities| by closing the result object, deleting the pairs, 
%     and committing the changes.
%     \begin{tcl}
proc raise_ambiguity_top_B {obj newtop} {
   $obj close
   variable DBCMD
   set obj [$DBCMD(DropPairsBelow) execute [dict create pick8y $newtop]]
   variable Count
   incr Count(P) [expr {- [$obj rowcount]}]
   $obj close
   $DBCMD(database) commit
}
%     \end{tcl}
%   \end{proc}
%   
%   \begin{proc}{raise_ambiguity_top_A}
%     This procedure is mostly a variant of |overlaps_between| that 
%     gets its pairs from the |pa1rs| table, and therefore doesn't 
%     insert anything there. The call syntax is
%     \begin{displaysyntax}
%       |raise_ambiguity_top_A| \word{result-object} 
%       \word{new top} \word{old top}
%     \end{displaysyntax}
%     where the \word{new top} and \word{old top} is the new and old 
%     respectively values of |am6iguity_top|; an ambiguity not 
%     between these values should be ignored, as it will still have an 
%     row in the |pa1rs| table or is already in the |am6iguities| table.
%     
%     Another difference to |overlaps_between| is that this procedure 
%     only does something if the plus and minus rules are still 
%     active; such a check in |overlaps_between| would however be 
%     pointless, as it is only called for pairs where both parties 
%     are known to exist.
%     \begin{tcl}
proc raise_ambiguity_top_A {obj newtop oldtop} {
   if {![$obj nextdict pair]} then {return}
   push_main_task raise_ambiguity_top_A $obj $newtop $oldtop
   variable DBCMD
   variable Count
   set prow [lindex [
      $DBCMD(GetRu1e) allrows\
        [dict create num6er [dict get $pair p1us]]
   ] 0]
   if {[dict get $prow st4te] in {r e}} then {
      incr Count(p) [dict get $pair c0unt]
      return
   }
   set mrow [lindex [
      $DBCMD(GetRu1e) allrows\
        [dict create num6er [dict get $pair m1nus]]
   ] 0]
   if {[dict get $mrow st4te] in {r e}} then {
      incr Count(p) [dict get $pair c0unt]
      return
   }
   foreach overlap [
      network::wfb::groomed_ambiguities\
        [list [dict get $prow lhs] [dict get $prow feed6acks]]\
        [list [dict get $mrow lhs] [dict get $mrow feed6acks]]
   ] {
      set amb [make_ambiguity [lindex $overlap 0 0]\
        [lindex $overlap 0 1] $prow [lindex $overlap 1] $mrow\
        [lindex $overlap 2]]
%<*vsquare>
      if {[dict get $amb v2Re5Sum]>$oldtop &&\
        [dict get $amb v2Re5Sum]<=$newtop} then {
         $DBCMD(NewAmbiguity) allrows $amb
         incr Count(Aa)
         if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
      }
%</vsquare>
%<*!vsquare>
      $DBCMD(NewAmbiguity) allrows $amb
      incr Count(Aa)
      if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
%</!vsquare>
   }
}
%     \end{tcl}
%   \end{proc}
% \end{proc}
% 
% 
% \subsubsection{Estimating approach}
% 
% The estimating approach is instead to only estimate (from 
% statistics of previous overlaps) how large an overlap for a pair 
% would be. Pairs are turned into ambiguities when the processing of 
% ambiguities reach the level at which the pair is estimated to be. 
% 
% \begin{variable}{pairs_top}
%   The |pairs_top| variable keep track of the current boundary 
%   between sparse pairs and dense pairs. Pairs above this boundary 
%   are placed in the |pa1rsMap| table, other pairs in the |pa1rs| 
%   table. The value (arbitrarily) starts at $50$ and is raised in 
%   steps of $50$.
%   \begin{tcl}
%<+pairmap>variable pairs_top 50
%<-pairmap>variable pairs_top infinity
%   \end{tcl}
%   ToDo: It would be nice if the scheme for raising |pairs_top| 
%   could be so that there was a constant bound for the number of 
%   times a pair might be put in |pa1rsMap|. Find a scheme which 
%   delivers this.
% \end{variable}
% 
% \begin{variable}{overlap_cache}
%   It turns out that merely performing a |GetOverl4ps| can be a 
%   bottleneck when the |ru1es| table grows large enough. 
%   Furthermore it turns out that when one needs this data, it 
%   tends not to change very often, whereas in periods where it 
%   changes frequently it tends not to be used. Hence it makes 
%   sense to cache the list, and clear this cache when a certain 
%   number of new overlaps have been successfully computated. The 
%   cache is empty when it is an empty list. When the cache is 
%   nonempty, it should hold the result one would get from 
%   |$DBCMD(GetOverl4ps) allrows|.
%   \begin{tcl}
variable overlap_cache {}
%   \end{tcl}
% \end{variable}
% 
% \begin{variable}{overlaps_cached}
% \begin{variable}{overlaps_uncached}
%   In practice, many new rules give rise to a few pairs with 
%   estimated size less than the current ambiguity level---maybe only 
%   by a fraction, but still less---and in that case the cache is of 
%   limited utility. A more pragmatic approach is to allow some 
%   fraction of uncached overlaps before invalidating the cache. The 
%   |overlaps_cached| variable is updated when |overlap_cache| is 
%   filled in, and at the same time |overlaps_uncached| is zeroed. 
%   When $100$ times the number of uncached overlaps exceed the 
%   number of cached overlaps, then the cache is cleared.
%   \begin{tcl}
variable overlaps_cached 0
variable overlaps_uncached 0
%   \end{tcl}
%   Technically, the |overlaps_cached| value is rather twice the number 
%   of overlaps, since it is the sum of all |overl4pTimes| value, and 
%   each computed overlap is contributed twice (once for each rule 
%   involved). Therefore the factor $100$ rather appears as $200$ in 
%   the code.
% \end{variable}\end{variable}
% 
% 
% \begin{proc}{estimate_pairs}
%   This procedure creates the pairs that can be formed from a new 
%   rule, estimating their |pick8y| value and placing them into the 
%   |pa1rs| or |pa1rMap| table accordingly. The call syntax is
%   \begin{displaysyntax}
%     |estimate_pairs| \word{minus-number} 
%     \word{lhs-order} \word{v-sum} \word{$v^2$-sum}
%   \end{displaysyntax}
%   where \word{minus-number} is the |num6er| of the rule that should 
%   be |m1nus| in the new pairs, and the other arguments are the data 
%   for this rule that are used when estimating the |v2Re5Sum| of the 
%   corresponding ambiguity.
%   There is no particular return value, and the procedure pushes tasks 
%   on the main loop stack.
%   
%   In fact, almost the only thing this procedure does is to start a 
%   transaction; all the pair generation is handled by the iterate 
%   procedure |estimate_pairs_A|. There is however one thing that 
%   needs to be done: a new row for the present rule must be added to 
%   the |overlap_cache|. All the necessary data except the |st4te| is 
%   immediately available, so the latter is faked as `|ER|', which 
%   |estimate_pairs_A| understands.
%   \begin{tcl}
proc estimate_pairs {minus lhs_order vsum v2sum} {
   variable DBCMD
   $DBCMD(database) begintransaction
   variable overlap_cache
   if {[llength $overlap_cache]} then {
      lappend overlap_cache [dict create  num6er $minus  st4te ER \
        overl4pSum 0.0  overl4pTimes 0  vSum $vsum  v2Sum $v2sum \
        lhsOrder $lhs_order]
      push_main_task estimate_pairs_A 1 0 "" $minus $lhs_order\
        $vsum $v2sum
   } else {
      push_main_task estimate_pairs_A 0 0 "" $minus $lhs_order\
        $vsum $v2sum
      variable overlaps_cached 0
      variable overlaps_uncached 0
   }
}
%   \end{tcl}
%   
%   \begin{proc}{estimate_pairs_A}
%     The call syntax of |estimate_pairs_A| is
%     \begin{displaysyntax}
%       |estimate_pairs_A| \word{use cache} \word{overlap-offset} 
%       \word{pair-map} \word{minus-number} \word{lhs-order} 
%       \word{v-sum} \word{$v^2$-sum}
%     \end{displaysyntax}
%     where \word{use cache} is |1| if overlap data are to be taken 
%     from |overlap_cache| and |0| if it is to be fetched from the 
%     database. \word{overlap-offset} is the offset (starting at $0$) 
%     to the chunk of overlap data to process on this round.
%     \word{pair-map} is the part of the 
%     |plu5es| that has been computed so far, and remaining arguments 
%     are as for |estimate_pairs|. This procedure either processes the 
%     \word{overlap-data} to end, sets the row in |pa1rMap|, and 
%     commits the transaction, or reschedules itself with the remaining 
%     \word{overlap-data}; the number of |ru1es| considered in a chunk 
%     is at most $512$. Either way, it also inserts rows into the 
%     |pa1rs| table.
%     
%     \begin{tcl}
proc estimate_pairs_A {use_cache offset plu5es minus lhs_order vsum v2sum} {
   variable DBCMD
   variable pairs_top
   variable Count
   variable overlap_cache
   variable overlaps_cached
   
   set bits ""
   if {$use_cache} then {
      set overlapL [lrange $overlap_cache $offset $offset+511]
   } else {
      set overlapL [$DBCMD(GetSomeOverl4ps) allrows [
         dict create ofs $offset limit 512
      ]]
      lappend overlap_cache {*}$overlapL
      foreach row $overlapL {
         incr overlaps_cached [dict get $row overl4pTimes]
      }
   }
   foreach row $overlapL {
      if {[dict get $row st4te] in {R E ER}} then {
         set overlap [expr {[dict get $row overl4pTimes]>0 ? 
            double([dict get $row overl4pSum]) / 
              [dict get $row overl4pTimes] 
            : 1.0
         }]
         set annex1 [expr {$lhs_order - $overlap}]
         set annex2 [expr {[dict get $row lhsOrder] - $overlap}]
         set pick8y [expr {
            $annex1*($annex1 + 2*[dict get $row vSum]) +
            [dict get $row v2Sum] + $annex2*($annex2 + 2*$vsum) +
            $v2sum
         }]
         if {$pick8y > $pairs_top} then {
            append bits 1
            incr Count(PP)
         } else {
            append bits 0
            $DBCMD(AddPair) allrows [dict create \
              p1us [dict get $row num6er] m1nus $minus pick8y $pick8y]
            incr Count(P)
         }
      } else {
         append bits 0
      }
   }
   append plu5es [binary format B* $bits]
   if {[llength $overlapL] < 512} then {
      if {![regexp -- {^\0*$} $plu5es]} then {
         $DBCMD(SetPairmap) allrows\
           [dict create  m1nus $minus  plu5es $plu5es]
      }
      $DBCMD(database) commit
   } else {
      incr offset [llength $overlapL]
      push_main_task estimate_pairs_A $use_cache $offset $plu5es $minus\
        $lhs_order $vsum $v2sum
   }
}
%     \end{tcl}
%   \end{proc}
% \end{proc}
% 
% 
% \begin{proc}{resieve_pairs}
%   The |resieve_pairs| procedure goes through the |pairMap| table, 
%   making |pa1rs| out of bits which do not exceed the current 
%   |pairs_top|, and clearing bits belonging to inactive |ru1es|. 
%   There are no arguments, nor any particular return value.
%   
%   What this procedure primarily does is that it fetches the lists 
%   of |overl4p| data and (|m1nus| values of) rows in the |pa1rMap| 
%   table. These are then frozen, and helper tasks are used to 
%   process them.
%   \begin{tcl}
proc resieve_pairs {} {
   variable Count
   set Count(PP) 0
   variable DBCMD
   set overlapL [$DBCMD(GetOverl4ps) allrows]
   variable overlap_cache $overlapL
   variable overlaps_cached 0
   foreach row $overlapL {
      incr overlaps_cached [dict get $row overl4pTimes]
   }
   variable overlaps_uncached 0
   set minusL [concat {*}[$DBCMD(ListPairmaps) allrows -as lists]]
   if {[llength $minusL]} then {
      push_main_task resieve_pairs_A $overlapL $minusL
   }
}
%   \end{tcl}
%   
%   \begin{proc}{resieve_pairs_A}
%     The |resieve_pairs_A| procedure is the |resieve_pairs| iterate 
%     at the |pairMap| row level. Its call syntax is
%     \begin{displaysyntax}
%       |resieve_pairs_A| \word{overlap-data} \word{minus-list}
%     \end{displaysyntax}
%     where \word{overlap-data} is the result of the |GetOverl4ps| 
%     statement (as dicts) and \word{minus-list} is the list of 
%     |m1nus| values that still need to be processed.
%     
%     The procedure works by popping off the first element of the 
%     \word{minus-list} and processing this in a manner similar to 
%     that of the |estimate_pairs| procedure, which includes pushing 
%     a |resieve_pairs_B| task onto the main loop stack. But first 
%     this procedure has pushed the task of applying itself to the 
%     rest of the \word{minus-list}, so that all of that gets 
%     processed.
%     \begin{tcl}
proc resieve_pairs_A {overlapL minusL} {
   if {[llength $minusL]>1} then {
      push_main_task resieve_pairs_A $overlapL [lrange $minusL 1 end]
   }
   set minus [lindex $minusL 0]
   set row [lindex $overlapL $minus-1]
   if {[dict get $row num6er] != $minus} then {
      error "Assertion failed"
   }
   variable DBCMD
   $DBCMD(database) begintransaction
   set L [$DBCMD(GetPairmap) allrows -as lists [dict create m1nus $minus]]
   if {![llength $L]} then {return}
   push_main_task resieve_pairs_B $overlapL [lindex $L 0 0] "" $row
}
%     \end{tcl}
%   \end{proc}
%   
%   \begin{proc}{resieve_pairs_B}
%     The call syntax of |resieve_pairs_B| is
%     \begin{displaysyntax}
%       |resieve_pairs_B| \word{overlap-data} \word{pair-map old} 
%       \word{pair-map new} \word{minus-row}
%     \end{displaysyntax}
%     where \word{overlap-data} and \word{pair-map new} are like the 
%     \word{overlap-data} and \word{pair-map} arguments of 
%     |estimate_pairs_A|. \word{pair-map old} is the part of the 
%     old |plu5es| value that hasn't been processed yet, and each bit 
%     of it corresponds to an element of \word{overlap-data}. The 
%     \word{minus-row} is the element of the \word{overlap-data} that 
%     corresponds to the |m1nus| part of the pair.
%     
%     The \word{overlap-data} are considered in chunks of $512$ 
%     elements.
%     
%     \begin{tcl}
proc resieve_pairs_B {overlapL plu5es_old plu5es_new mrow} {
   variable DBCMD
   variable pairs_top
   variable Count
   if {![binary scan $plu5es_old B512a* bits_old tail_old]} then {
      binary scan $plu5es_old B* bits_old
      set bits_old [string trimright $bits_old 0]
      set tail_old ""
   }
   set bits_new ""
   foreach bit [split $bits_old ""] prow $overlapL {
      if {$bit eq ""} then {break}
      if {$bit && [dict get $prow st4te] in {R E}} then {
         set overlapTimes [expr {[dict get $prow overl4pTimes] +\
           [dict get $mrow overl4pTimes]}]
         if {$overlapTimes>0} then {
            set overlap [expr {
               double( 
                  [dict get $prow overl4pSum] + 
                  [dict get $mrow overl4pSum]
               ) / $overlapTimes
            }]
         } else {
            set overlap 1.0
         }
         set annex1 [expr {[dict get $mrow lhsOrder] - $overlap}]
         set annex2 [expr {[dict get $prow lhsOrder] - $overlap}]
         set pick8y [expr {
            $annex1*($annex1 + 2*[dict get $prow vSum]) +
            [dict get $prow v2Sum] + [dict get $mrow v2Sum] +
            $annex2*($annex2 + 2*[dict get $mrow vSum])
         }]
         if {$pick8y > $pairs_top} then {
            append bits_new 1
            incr Count(PP)
         } else {
            append bits_new 0
            $DBCMD(AddPair) allrows [dict create  pick8y $pick8y \
              p1us [dict get $prow num6er] \
              m1nus [dict get $mrow num6er]]
            incr Count(P)
         }
      } else {
         append bits_new 0
      }
   }
   append plu5es_new [binary format B* $bits_new]
   if {[string length $tail_old]} then {
      push_main_task resieve_pairs_B\
        [lrange $overlapL 512 end] $tail_old $plu5es_new $mrow
   } else {
      if {[regexp -- {^\0*$} $plu5es_new]} then {
         $DBCMD(UnsetPairmap) allrows\
           [dict create  m1nus [dict get $mrow num6er]]
      } else {
         $DBCMD(SetPairmap) allrows [dict create \
           m1nus [dict get $mrow num6er]  plu5es $plu5es_new]
      }
      $DBCMD(database) commit
   }
}
%     \end{tcl}
%   \end{proc}
% \end{proc}
% 
% 
% 
% \begin{proc}{pick_next_ambiguity}
%   The estimating approach form of |pick_next_ambiguity| is quite 
%   different from its exact form, since this picks both a pair and 
%   an ambiguity, and processes only the smaller of the two. Pairs in 
%   the |pa1rMap| table are only considered if the |pa1rs| table is 
%   empty, since the best computed estimate for any of them must be 
%   larger than the |pairs_top|.
%   \begin{tcl}
%<*lazier&vsquare>
proc pick_next_ambiguity {} {
   variable DBCMD
   variable pairs_top
   set aobj [$DBCMD(ChooseAmbiguity) execute]
   set pobj [$DBCMD(LeastPair) execute]
   if {[$pobj nextdict pair]} then {
      if {![$aobj nextdict amb]} then {
         push_main_task overlaps_between [dict get $pair p1us]\
           [dict get $pair m1nus]
      } elseif {[dict get $pair pick8y] <= [dict get $amb v2Re5Sum]} then {
%   \end{tcl}
%   The point of processing pairs at a level before ambiguities is to 
%   gather more data for estimating overlap sizes.
%   \begin{tcl}
         push_main_task overlaps_between [dict get $pair p1us]\
           [dict get $pair m1nus]
%<*BB2>
      } elseif {[dict exists $amb p1us] && [dict exists $amb m1nus]} then {
         push_main_task prereduce_second_criterion $amb
%</BB2>
      } else {
         prepare_ambiguity $amb
         push_main_task reduce_step
      }
   } elseif {[$aobj nextdict amb]} then {
      if {[dict get $amb v2Re5Sum] >= $pairs_top} then {
         set pairs_top [expr {$pairs_top + 50}]
         push_main_task resieve_pairs
%<*BB2>
      } elseif {[dict exists $amb p1us] && [dict exists $amb m1nus]} then {
         push_main_task prereduce_second_criterion $amb
%</BB2>
      } else {
         prepare_ambiguity $amb
         push_main_task reduce_step
      }
%<*pairmap>
   } elseif {[llength [$DBCMD(ListPairmaps) allrows]]} then {
      set pairs_top [expr {$pairs_top + 50}]
      push_main_task resieve_pairs
%</pairmap>
   } else {
      pause_main_loop
   }
   $aobj close
   $pobj close
   variable ambiguity_level\
     [if {[info exists amb]} then {dict get $amb v2Re5Sum}]
   variable pair_level\
     [if {[info exists pair]} then {format %.1f [dict get $pair pick8y]}]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{force_next_ambiguity}
%   This is a variant of |pick_next_ambiguity| which always picks an 
%   ambiguity regardless of whether there are pairs to process. It 
%   can be used to force conversion of initial congruences to rules, 
%   for viewing.
%   \begin{tcl}
proc force_next_ambiguity {} {
   variable DBCMD
   variable pairs_top
   set aobj [$DBCMD(ChooseAmbiguity) execute]
   if {[$aobj nextdict amb]} then {
      prepare_ambiguity $amb
      push_main_task reduce_step
   }
   $aobj close
   variable ambiguity_level\
     [if {[info exists amb]} then {dict get $amb v2Re5Sum}]
}
%</lazier&vsquare>
%   \end{tcl}
% \end{proc}
% 
% 
% \subsection{Constructing confluence proofs}
% 
% Once a complete set of rules has been discovered, one might want to 
% produce a standalone proof of this fact, that is not tainted by 
% whatever twists and turns the original completion calculations 
% took. The easiest way to do this is to construct a fresh set of 
% all ambiguities and then demonstrate that they all resolve to~$0$. 
% This exercises the above completion machinery (or at least parts of 
% it) in slightly unconventional ways, but it is possible to maintain 
% control of the process provided the |main_loop_stack| is not 
% allowed to become empty. (Therefore this process is not expected to 
% be power failure resistant.)
% 
% \begin{proc}{verify_confluence}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |verify_confluence| \word{new rules} \word{old rules}\regopt
%   \end{displaysyntax}
%   where \word{new rules} and \word{old rules} both are lists of 
%   rule \texttt{num6er}s; the latter defaults to being empty. It 
%   will (over some iterations of the main loop) construct 
%   \texttt{am6iguities} for all pairs of rules where one is among 
%   the \word{new rules} and the other is in \word{new rules} or 
%   \word{old rules}, and have those resolved. By checking afterwards 
%   that nothing was added to the |ru1es| table, one can be sure that 
%   the ambiguities all resolved to $0$.
%   
%   The implementation makes use of the idea to reshedule itself with 
%   a helper.
%   \begin{tcl}
proc verify_confluence {newL {oldL {}}} {
   if {![llength $newL]} then {return}
   set rule [lindex $newL 0]
   lappend oldL $rule
   if {[llength $newL] > 1} then {
      push_main_task verify_confluence [lreplace $newL 0 0] $oldL
   }
   push_main_task verify_confluence_A $rule $oldL
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{verify_confluence_A}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |verify_confluence_A| \word{rule} \word{rule-list}
%   \end{displaysyntax}
%   It It will (over some iterations of the main loop) construct 
%   \texttt{am6iguities} for all pairs of rules where one is the 
%   \word{rule} and the other is in the \word{rule-list}, and have 
%   those resolved.
%   
%   Like |verify_conflunce|, this procedure reschedules itself with 
%   a \word{rule-list} one element shorter, until that list becomes 
%   empty.
%   \begin{tcl}
proc verify_confluence_A {plus minusL} {
   set restL [lassign $minusL minus]
   if {[llength $restL]} then {
      push_main_task verify_confluence_A $plus $restL
   }
%   \end{tcl}
%   The rest of the procedure, which needs to process one pair of 
%   rules, is mostly a duplication of |overlaps_between|. The main 
%   novelty here is that whereas |overlaps_between| could rely upon 
%   the main loop calling |pick_next_ambiguity| to start processing 
%   of ambiguities, this procedure must instead push an explicit 
%   command to that end upon the stack.
%   \begin{tcl}
   variable DBCMD
   set prow [lindex [
      $DBCMD(GetRu1e) allrows [dict create num6er $plus]
   ] 0]
   set mrow [lindex [
      $DBCMD(GetRu1e) allrows [dict create num6er $minus]
   ] 0]
   variable Count
   foreach overlap [
      network::wfb::groomed_ambiguities\
        [list [dict get $prow lhs] [dict get $prow feed6acks]]\
        [list [dict get $mrow lhs] [dict get $mrow feed6acks]]
   ] {
      set amb [make_ambiguity [lindex $overlap 0 0]\
        [lindex $overlap 0 1] $prow [lindex $overlap 1] $mrow\
        [lindex $overlap 2]]
      $DBCMD(NewAmbiguity) allrows $amb
      if {[dict get $amb st4te] eq "A"} then {
         push_main_task verify_confluence_B\
           [lindex [$DBCMD(LastInsertNumber) allrows -as lists] 0 0]
      }
      incr Count(Aa)
      if {[dict get $amb st4te] ne "A"} then {incr Count(a)}
   }
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{verify_confluence_B}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |verify_confluence_B| \word{ambiguity number}
%   \end{displaysyntax}
%   It fetches the so numbered ambiguity from the database, prepares 
%   it for reduction, and calls |reduce_step|. The main reason this is 
%   even a separate procedure is to make it easy to call from 
%   \begin{tcl}
proc verify_confluence_B {num} {
   variable DBCMD
   prepare_ambiguity [lindex [
      $DBCMD(GetAmbiguity) allrows -as dicts [dict create num6er $num]
   ] 0]
   tailcall reduce_step
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{begin_verify_confluence}
%   This procedure has the same call syntax as |verify_confluence|, 
%   but it also does some extra initialisation to better keep track 
%   of the result, and it starts the main event loop to make sure 
%   that things actually happen.
%   
%   Concretely, it has a partner command |end_verify_confluence| that 
%   it pushes first onto the stack, that will afterwards pause the 
%   main loop and check that everything worked as expected (no new 
%   rules discovered). The call syntax of that is
%   \begin{displaysyntax}
%     |end_verify_confluence| \word{last-rule} \word{last-ambiguity}
%   \end{displaysyntax}
%   where \word{last-rule} and \word{last-ambiguity} are the 
%   \texttt{num6ber}s of the last ambiguities that existed before any 
%   new confluences were verified.
%   \begin{tcl}
proc begin_verify_confluence {newL {oldL {}}} {
   variable DBCMD
   set lastrule [lindex [
      $DBCMD(database) allrows -as lists {
         SELECT max(num6er) FROM ru1es
      }
   ] 0 0]
   set lastamb [lindex [
      $DBCMD(database) allrows -as lists {
         SELECT max(num6er) FROM am6iguities
      }
   ] 0 0]
   if {![string is integer -strict $lastamb]} then {
      set lastamb -1
   }
   push_main_task end_verify_confluence $lastrule $lastamb
%   \end{tcl}
%   \emph{Then} this procedure pushes the corresponding 
%   |verify_confluence| task and starts the main loop.
%   \begin{tcl}
   push_main_task verify_confluence $newL $oldL
   tailcall completion_main_loop
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{end_verify_confluence}
%   \begin{tcl}
proc end_verify_confluence {begin_last_rule begin_last_amb} {
   variable DBCMD
   set end_last_rule [lindex [
      $DBCMD(database) allrows -as lists {
         SELECT max(num6er) FROM ru1es
      }
   ] 0 0]
%   \end{tcl}
%   It should hold that |begin_last_rule| and |end_last_rule| are 
%   equal, but we'll hold off checking that for a moment.
%   
%   \begin{variable}{confluence_check_ambiguitiesL}
%     It is useful to have a list of all ambiguities created as part 
%     of this confluence check, so the procedure stores that away in 
%     the |confluence_check_ambiguitiesL| variable. (The SELECT 
%     statement technically returns a list of single-element lists, 
%     so the |concat| is there to flatten them.)
%     \begin{tcl}
   variable confluence_check_ambiguitiesL [concat {*}[
      $DBCMD(database) allrows -as lists {
         SELECT num6er FROM am6iguities WHERE num6er > :last
      } [dict create last $begin_last_amb]
   ]]
%     \end{tcl}
%   \end{variable}
%   
%   The final reporting is done using a modal dialog in the 
%   \Module{Tk} case, and using an |error| in the non-\Module{Tk} 
%   case.
%   \begin{tcl}
%<*!Tk>
   if {$begin_last_rule != $end_last_rule} then {
      return -code error "Last rule before was number\ 
        $begin_last_rule, but now it's $end_last_rule; the confluence\
        check FAILED"
   }
%</!Tk>
%<*Tk>
   if {$begin_last_rule == $end_last_rule} then {
      tk_messageBox -type ok -message "All ambiguities resolved."\
        -detail "[llength $confluence_check_ambiguitiesL] resolutions\
          have been generated."
   } else {
      tk_messageBox -type ok -icon warning\
        -message "Some ambiguities did not resolve!"\
        -detail "[expr {$end_last_rule-$begin_last_rule}] rules have\
          been added."
   }
%</Tk>
   return -code return
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% 
% 
% \section{Viewing results}
% 
% Having computed something is all well and good, but it doesn't 
% amount to much if you cannot also get these results out of the 
% database and into a human-comprehensible format. In the long run, 
% the way to go is to follow the |mtmtcl| route and export data as 
% (near-)OpenMath, which in particular means networks are going 
% to be encoded as some kind of abstract index expression. This does 
% not mean the graphical presentation of networks will be lost, but 
% it means it will have to be generated by the renderer of the 
% OpenMath data rather than the completion utility. This should not 
% be a problem, as the automatically generated layout is now 
% perfectly adequate in the cases considered.
% 
% Still, there is a place for interactive viewing of what the utility 
% is up to, so it makes sense to adapt some parts of the previous 
% utility to view rules in a database.
% 
% \begin{variable}{vertex_appearances}
% \begin{variable}{vertex_sizes}
%   The |vertex_appearances| variable holds the dictionary of 
%   appearances for the vertex types currently occuring in the rule 
%   networks. It is used by those procedures that draw or 
%   redraw networks. The |vertex_sizes| variable is a list patterns 
%   and vertex sizes for use with |make_level-layout-Tk|.
%   \begin{tcl}
set vertex_sizes {* {20 20}}
%   \end{tcl}
% \end{variable}\end{variable}
% 
% 
% 
% \subsection{A rule browser}
% 
% The rule browser requires Tk.
% \begin{tcl}
%<*Tk>
package require Tk
% \end{tcl}
% As before, it is essentially a window that allows one to browse the 
% list of rules. It is geared towards binomial identities, but should 
% provide a fallback mode for viewing rules with more than one term 
% on the right hand side.
% 
% \changes{2}{2007/03/17}{Redesigning rule browser layout. (LH)}
% 
% \begin{proc}{rule_browser_layout}
%   This procedure creates a window for the rule browser and sets up 
%   the widgets that should reside in it. At the top there is bar of 
%   controls, below that is a pair of canvases displaying the left 
%   and right hand sides of the rule, and below that is a canvas 
%   displaying the rule derivation.
%   All canvases have vertical and horizontal scroll bars. 
%   
%   The control bar has fixed height, but the heights of the other 
%   parts is under the control of a |panedwindow| widget. Each of the 
%   three parts of the window are found inside frames called 
%   |.rulebrowser.fbar|, |.rulebrowser.frule|, and 
%   |.rulebrowser.fproof| respectively.
%   \begin{tcl}
proc rule_browser_layout {} {
   set t [toplevel .rulebrowser]
   wm title $t "Rule browser"
   pack [
      frame $t.fbar -background grey90
   ] -expand true -fill x -side top
   pack [
      label $t.infoline
   ] -expand true -fill x -side top
   pack [
      panedwindow $t.panes -orient vertical -borderwidth 0
   ] -expand true -fill both
   frame $t.frule
   frame $t.fproof
%   \end{tcl}
%   The two frames will eventually be made panes of the 
%   |panedwindow|, but delaying adding them until the grids inside 
%   them are complete makes it less likely to run into Tk 
%   bug~\#1714535. 
%   The order of widget creations here is important, as the frames 
%   need to be above the panedwindow in the stacking order.
%   
%   Creating the network canvases and their associated scrollbars 
%   is a highly uniform task, so all three of them are handled by the 
%   same loop. The widget names all have the form 
%   \meta{toplevel}|.|\meta{midpart}\meta{suffix} where \meta{suffix} 
%   is |c|, |h|, or |v| depending on whether this is a 
%   \texttt{c}anvas, \texttt{h}orizontal scrollbar, or 
%   \texttt{v}ertical scrollbar, but the \meta{midpart} is 
%   syntactically different in the rule and derivation parts: in the 
%   former case it is |frule.left_| or |frule.right_|, but in the 
%   latter it is |fproof.|.
%   \begin{tcl}
   foreach c_ [list $t.frule.left_ $t.frule.right_ $t.fproof.] {
      scrollbar ${c_}h -orient horiz -command [list ${c_}c xview]
      scrollbar ${c_}v -command [list ${c_}c yview]
      canvas ${c_}c -width 200 -height 300 -relief solid -borderwidth 1\
        -xscrollcommand [list ${c_}h set]\
        -yscrollcommand [list ${c_}v set]
      bindtags ${c_}c [linsert [bindtags ${c_}c] 1 Network]
   }
%   \end{tcl}
%   
%   Geometry inside the the |frule| and |fproof| frames is |grid|ded, 
%   since this automatically leaves a square of the right size in the 
%   corner. The |fproof| arrangement is slightly simpler, but the 
%   |frule| is mostly just a repetition.
%   \begin{tcl}
   grid $t.fproof.c -row 0 -column 0 -sticky nsew
   grid $t.fproof.v -row 0 -column 1 -sticky ns
   grid $t.fproof.h -row 1 -column 0 -sticky ew
   grid rowconfigure $t.fproof 0 -weight 1
   grid columnconfigure $t.fproof 0 -weight 1
%
   grid $t.frule.left_c  -row 0 -column 0 -sticky nsew
   grid $t.frule.left_v  -row 0 -column 1 -sticky ns
   grid $t.frule.left_h  -row 1 -column 0 -sticky ew
   grid $t.frule.right_c -row 0 -column 3 -sticky nsew
   grid $t.frule.right_v -row 0 -column 4 -sticky ns
   grid $t.frule.right_h -row 1 -column 3 -sticky ew
   grid rowconfigure $t.frule 0 -weight 1
   grid columnconfigure $t.frule 0 -weight 1
   grid columnconfigure $t.frule 3 -weight 1
%   \end{tcl}
%   Column 2 is reserved for a canvas with an arrow pointing right.
%   \begin{tcl}
   canvas $t.frule.arrow_c -width 20 -height 20
   $t.frule.arrow_c create line {0 10 20 10} -arrow last -width 2
   grid $t.frule.arrow_c -row 0 -column 2
%   \end{tcl}
%   Now the frame contents are complete, so they are added as panes.
%   \begin{tcl}
   $t.panes add $t.frule -sticky nsew -minsize 50
   $t.panes add $t.fproof -sticky nsew -minsize 50
%   \end{tcl}
%   The control bar |fbar| is filled in by a separate procedure, 
%   since the details of these controls are closely associated with 
%   the actions that they will perform. Similarly with the bindings 
%   for hyperlinks.
%   \begin{tcl}
   rule_browser_fbar $t
   hyper_references $t.fproof.c
   return $t
}
%   \end{tcl}
% \end{proc}
% 
% The \describestring[bindtag]{Network}|Network| bindtag is used for 
% all canvases displaying networks. It offers bindings for grabbing the 
% network with the mouse and moving it around. The |-cursor| 
% man\oe uvres are meant to isolate this use of the mouse from that 
% of clicking hyperlinks.
% \begin{tcl}
bind Network <ButtonPress-1> {
   if {[%W cget -cursor] eq ""} then {
      %W configure -cursor fleur
      %W scan mark %x %y
   }
}
bind Network <B1-Motion> {
   if {[%W cget -cursor] eq "fleur"} then {%W scan dragto %x %y 1}
}
bind Network <ButtonRelease-1> {
   if {[%W cget -cursor] eq "fleur"} then {
      %W configure -cursor ""
   }
}
bind Network <B1-Leave> {%W configure -cursor ""}
% \end{tcl}
% 
% \begin{proc}{center_network}
%   This procedure scrolls a canvas so that the contents appear in 
%   the center of the visible region. The call syntax is
%   \begin{quote}
%     |center_network| \word{canvas} \word{itemOrId}\regopt
%   \end{quote}
%   where \word{itemOrId} selects the items to center. If not 
%   specified, then this defaults to |all|.
%   \begin{tcl}
proc center_network {c {id all}} {
   foreach {left top right bottom} {0 0 0 0} break
   foreach {left top right bottom} [$c bbox $id] break
   $c scan mark [expr {($right+$left)/2}] [expr {($bottom+$top)/2}]
   set w [winfo width $c]
   if {$w < 10} then {set w [winfo reqwidth $c]}
   set h [winfo height $c]
   if {$h < 10} then {set h [winfo reqheight $c]}
   $c scan dragto [
      expr {round([$c canvasx [expr {$w/2}]])}
   ] [
      expr {round([$c canvasy [expr {$h/2}]])}
   ] 1
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \begin{proc}{display_rule}
%   The |display_rule| procedure updates the rule browser window to 
%   show the specified rule or equality. The syntax is
%   \begin{quote}
%     |display_rule| \word{toplevel} \word{ruleno}
%   \end{quote}
%   where \word{toplevel} is the name of the browser window and 
%   \word{ruleno} is the number of the rule to display. It returns 
%   |1| if there was such a rule and |0| otherwise.
%   
%   \begin{tcl}
proc display_rule {t ruleno} {
   variable DBCMD
   set L [$DBCMD(GetRu1e) allrows [dict create num6er $ruleno]]
   if {![llength $L]} then {return 0}
   set rule [lindex $L 0]
   $t.infoline configure -text [
      switch -- [dict get $rule st4te] "R" {
         format "Active rule"
      } "r" {
         clock format [dict get $rule wh3n2] -format "Rule dropped %+"
      } "E" {
         format "Active equality"
      } "e" {
         clock format [dict get $rule wh3n2] -format "Equality dropped %+"
      }
   ]
%
   set tr $t.frule
   $tr.left_c delete all
   $tr.right_c delete all
   $t.fproof.c delete all
%   \end{tcl}
%   Drawing the |lhs| network is mostly about calling the proper 
%   helper procedures, in the proper order.
%   \begin{tcl}
   variable vertex_sizes
   set NW(pure) [dict get $rule lhs]
   network::rich::make_level-layout-Tk $vertex_sizes -var NW
   network::rich::vpos-Tk_by_level -var NW
   variable vertex_appearances
   network::rich::ecurve-Tk-tt_by_level $vertex_appearances -var NW
   network::rich::drawit $tr.left_c $vertex_appearances {} -var NW
   draw_network_feedbacks $tr.left_c [dict get $rule feed6acks]\
     [array get NW] 1
   $tr.left_c configure -scrollregion [$tr.left_c bbox all]
%   \end{tcl}
%   The |rhs| is trickier, since there are two styles for it. When 
%   there is only a single term with coefficient $1$, then the 
%   classical style of just the network can be used, but all other 
%   cases should be with brackets around the networks and explicit 
%   coefficients. For the moment though, that is let unimplemented.
%   \begin{tcl}
   variable coefficient
   set rhs [dict get $rule rhs]
   if {[llength $rhs] == 2 &&\
     [{*}$coefficient = [lindex $rhs 1] [{*}$coefficient 1]]} then {
      set NW(pure) [lindex $rhs 0]
      network::rich::make_level-layout-Tk $vertex_sizes -var NW
      network::rich::vpos-Tk_by_level -var NW
      network::rich::ecurve-Tk-tt_by_level $vertex_appearances -var NW
      network::rich::drawit $tr.right_c $vertex_appearances {} -var NW
   } else {
      $tr.right_c create text 0 0 -anchor nw\
        -text {Not implemented yet (fixme)!}
   }
   $tr.right_c configure -scrollregion [$tr.right_c bbox all]
%   \end{tcl}
%   Displaying the proof is such a big task that it is handled by a 
%   separate procedure.
%   \begin{tcl}
   if {[dict exists $rule pr00f]} then {
      display_rule_proof $t.fproof.c [dict get $rule pr00f]\
        -lhs [dict get $rule lhs]
   } else {
      $t.fproof.c create text 0 0 -anchor n -text "Axiom"
   }
   $t.fproof.c configure -scrollregion [$t.fproof.c bbox all]
   center_network $tr.left_c
   center_network $tr.right_c
   return 1
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{draw_network_feedbacks}
%   This procedure draws the feedbacks for a network and optionally 
%   recenters it in its canvas. The call syntax is
%   \begin{quote}
%     |draw_network_feedbacks| \word{canvas} \word{feedback-list} 
%     \word{rich network} \word{center?} 
%     \begin{regblock}[\regstar]\word{option} 
%     \word{value}\end{regblock}
%   \end{quote}
%   where \word{center?} is a boolean for whether to center while the 
%   options and values are passed on to 
%   |network::rich::draw_feedbacks|. As a special case, the |-tags| 
%   option is interpreted here (as it is a separate argument to the 
%   underlying procedure).
%   
%   \begin{tcl}
proc draw_network_feedbacks {c fbL NWval center args} {
   array set NW $NWval
   set inL {}
   foreach item [lindex $NW(level-layout-Tk) 0 end-2] {
      if {[lindex $item 0] eq "edge"} then {
         lappend inL [lindex $item 2]
      }
   }
   set outL {}
   foreach item [lindex $NW(level-layout-Tk) 0 0] {
      if {[lindex $item 0] eq "edge"} then {
         lappend outL [lindex $item 2]
      }
   }
   set Opt(-tags) ""
   array set Opt $args
   eval [list network::rich::draw_feedbacks $c $Opt(-tags) $fbL\
     -inx $inL -outx $outL -bbox [lindex $NW(level-layout-Tk) 1]]\
     $args
   if {$center} then {center_network $c}
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{draw_network_lincomb}
%   This procedure draws a linear combination of networks and returns 
%   the bounding box of the material drawn. The call syntax is
%   \begin{displaysyntax}
%     |draw_network_lincomb| \word{canvas} \word{lincomb} \word{$x$} 
%     \word{$y$} \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   where \word{canvas} is the thing to draw on, \word{lincomb} is 
%   the linear combination of networks to draw, and $(x,y)$ is the 
%   reference point of the material drawn. The options are numerous
% \end{proc}
% 
% 
% \begin{proc}{display_rule_proof}
%   This procedure displays the proof of a rule (technically the 
%   resolution of an ambiguity) in a |canvas| (or approximation 
%   thereof; only the |create| subcommand is needed). 
%   The call syntax is
%   \begin{displaysyntax}
%     |display_rule_proof| \word{canvas-cmd} \word{ambiguity} 
%     \begin{regblock}[\regstar] \word{option} \word{value}
%     \end{regblock}
%   \end{displaysyntax}
%   where \word{ambiguity} is the number of the ambiguity to draw. 
%   The return value is the bounding box of all the things drawn, or 
%   an empty list if there wasn't a \word{derivation} (in which case 
%   nothing is drawn).
%   
%   The \word{option}s are:
%   \begin{ttdescription}
%     \item[-lhs]
%       The left hand side network. This is needed in the monomial 
%       style, to determine which thing goes to the left and which 
%       thing goes to the right.
%     \item[-tags] ?
%     \item[-eqtext] ?
%     \item[-eqfont] ?
%     \item[-eqwidth] ?
%     \item[-eqhalfheight] ?
%     \item[-reffont] ?
%     \item[-refcolour] ?
%   \end{ttdescription}
%   
%   The first step is to retrieve the ambiguity.
%   \begin{tcl}
proc display_rule_proof {prefix number args} {
   variable DBCMD
   set L [$DBCMD(GetAmbiguity) allrows [dict create num6er $number]]
   if {![llength $L]} then {return}
   set arow [lindex $L 0]
%<*zlib>
   dict set arow m0n0mials [encoding convertfrom utf-8\
     [zlib inflate [dict get $arow deflated_m0n0mials]]]
%</zlib>
   array set Opt {
      -tags "" 
      -eqtext "="
      -eqfont {Times 24}
      -eqwidth 36
      -eqhalfheight 12
      -reffont {Courier 10 underline}
      -refcolour blue
   }
   array set Opt $args
%   \end{tcl}
%   The second step is to see if its resolution can be stated in 
%   monomial form. If not, the presentation is going to be rather 
%   different.
%   \begin{tcl}
   set bbox [display_monomial_proof $prefix $arow [array get Opt]]
   if {[llength $bbox]} then {return $bbox}
   
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{display_monomial_proof}
%   This procedure checks whether an ambiguity resolution can be 
%   phrased as a monomial proof. If that is possible then this proof 
%   is also displayed and a bounding box is returned, otherwise an 
%   empty list is returned. The call syntax is
%   \begin{displaysyntax}
%     |display_rule_proof| \word{canvas-cmd} \word{ambiguity} 
%     \word{options-dict}
%   \end{displaysyntax}
%   where the \word{ambiguity} is the database row dictionary for the 
%   ambiguity.
%   
%   The first part checks if the resolution has the wanted form. The 
%   idea is to\Ldash for each step\Dash look at the monomials which 
%   are acted upon and determine whether they belong to the plus or 
%   minus branch of the proof. The |plusL| and |minusL| lists have 
%   the form
%   \begin{displaysyntax}
%     \begin{regblock}[\regstar] \word{monomial number} \{ \word{rule 
%     number} \word{region} \} \end{regblock} \word{monomial number}
%   \end{displaysyntax}
%   It is also necessary to verify that there are two terms in each 
%   step, and that the term with the monomial not acted upon stays 
%   fixed; otherwise some very incorrect proof displays may follow.
%   \begin{tcl}
proc display_monomial_proof {prefix arow optD} {
   variable coefficient
   set one [{*}$coefficient 1]
   set mone [{*}$coefficient neg $one]
   set plusL {}
   set minusL {}
   foreach  step [lrange [dict get $arow re5olution] 0 end-1] \
     nextstep [lrange [dict get $arow re5olution] 1 end] \
     which [dict get $arow wh1ch]  where [dict get $arow wh3re]  {
      if {[dict size $step] != 2} then {return {}}
      set mu [lindex $where 0]
      if {[{*}$coefficient = $one [dict get $step $mu]]} then {
         lappend plusL $mu [list $which [lindex $where 1]]
      } elseif {[{*}$coefficient = $mone [dict get $step $mu]]} then {
         lappend minusL $mu [list $which [lindex $where 1]]
      } else {
         return {}
      }
      set notmu [lindex [dict keys [dict remove $step $mu]] 0]
      if {![dict exists $nextstep $notmu] ||\
        ![{*}$coefficient = [dict get $step $notmu]\
          [dict get $nextstep $notmu]]} then {return {}}
   }
   dict for {mu r} [lindex [dict get $arow re5olution] end] {
      if {[{*}$coefficient = $one $r]} then {
         lappend plusL $mu
      } elseif {[{*}$coefficient = $mone $r]} then {
         lappend minusL $mu
      } else {
         return {}
      }
   }
   if {[llength $plusL]%2!=1 || [llength $minusL]%2!=1}\
   then {return {}}
%   \end{tcl}
%   Have passed those tests, it is now established that a monomial 
%   proof is possible, so it now only remains to draw it. There are 
%   however two things still not determined: whether the middle part 
%   is the site of the ambiguity or a congruence name, and whether 
%   the left branch (leading up to the |-lhs|) is the plus or the 
%   minus branch.
%   
%   The next step is to lay out the center of the proof.
%   \begin{tcl}
   variable vertex_appearances
   variable vertex_sizes
   if {[dict exists $arow p1us]} then {
      set plusL [linsert $plusL 0 [
         list [dict get $arow p1us] [dict get $arow p1us2eg]
      ]]
      set minusL [linsert $minusL 0 [
         list [dict get $arow m1nus] [dict get $arow m1nus2eg]
      ]]
      set midbox [
         network::rich::drawit_bracketed $prefix $vertex_appearances\
           0 0 -anchor center -val [
            network::rich::Tk_from_pure [dict get $arow si7e]\
              $vertex_sizes $vertex_appearances
         ]
      ]
   } elseif {[llength $plusL]==1 && [llength $minusL]==1} then {
%   \end{tcl}
%   If the proof is only a given congruence, then just give the 
%   |-long| name of that.
%   \begin{tcl}
      return [{*}$prefix bbox [
         {*}$prefix create text  0 0 \
           -text "[dict get $arow p1us2eg]" \
           -font [dict get $optD -eqfont] \
           -tags [dict get $optD -tags]
      ]]
   } else {
      set item [{*}$prefix create text  0 0 \
        -text "\{[dict get $arow m1nus2eg]\}" \
        -font [dict get $optD -eqfont] \
        -tags [dict get $optD -tags]]
      set midbox [{*}$prefix bbox $item]
      set plusL [linsert $plusL 0 {}]
      set minusL [linsert $minusL 0 {}]
   }
%   \end{tcl}
%   |midbox| is now the bounding box of the middle part.
%   \begin{tcl}
   foreach {left top right bottom} $midbox break
   set monomials [dict get $arow m0n0mials]
   set plusleft [expr {![dict exists $optD -lhs] ||\
     [dict get $optD -lhs] eq [lindex $monomials [lindex $plusL end]]}]
%   \end{tcl}
%   
%   \begin{tcl}
   set tags [dict get $optD -tags]
   set eqopts [list -text [dict get $optD -eqtext] \
     -font [dict get $optD -eqfont] -tags $tags]
   set refopts [list -font [dict get $optD -reffont] \
     -fill [dict get $optD -refcolour]]
   set eqwidth [dict get $optD -eqwidth]
   set yref [expr {-[dict get $optD -eqhalfheight]}]
   set stepno -1
   foreach {spec mu} [lindex [list $minusL $plusL] $plusleft] {
      set stepTagsL [linsert $tags end step${stepno}]
      incr stepno -1
      set xeq [expr {$left - 0.5*$eqwidth}]
      {*}$prefix create text $xeq 0 -anchor center {*}$eqopts
      if {[llength $spec]} then {
         {*}$prefix create text $xeq $yref -anchor s\
           {*}$refopts -tags [linsert $stepTagsL end reference]\
           -text [format "<(%d)" [lindex $spec 0]]
      }
      set left [expr {$left - $eqwidth}]
      set bbox [
         network::rich::drawit_bracketed $prefix $vertex_appearances\
           $left 0 -anchor e -val [
            network::rich::Tk_from_pure [lindex $monomials $mu]\
              $vertex_sizes $vertex_appearances
         ]
      ]
      set left [lindex $bbox 0]
      if {$top > [lindex $bbox 1]} then {set top [lindex $bbox 1]}
      if {$bottom > [lindex $bbox 3]}\
        then {set bottom [lindex $bbox 3]}
   }
   set stepno 1
   foreach {spec mu} [lindex [list $plusL $minusL] $plusleft] {
      set stepTagsL [linsert $tags end step${stepno}]
      incr stepno 
      set xeq [expr {$right + 0.5*$eqwidth}]
      {*}$prefix create text $xeq 0 -anchor center {*}$eqopts
      if {[llength $spec]} then {
         {*}$prefix create text $xeq $yref -anchor s\
           {*}$refopts -tags [linsert $stepTagsL end reference]\
           -text [format "(%d)>" [lindex $spec 0]]
      }
      set right [expr {$right + $eqwidth}]
      set bbox [
         network::rich::drawit_bracketed $prefix $vertex_appearances\
           $right 0 -anchor w -val [
            network::rich::Tk_from_pure [lindex $monomials $mu]\
              $vertex_sizes $vertex_appearances
         ]
      ]
      set right [lindex $bbox 2]
      if {$top > [lindex $bbox 1]} then {set top [lindex $bbox 1]}
      if {$bottom > [lindex $bbox 3]}\
        then {set bottom [lindex $bbox 3]}
   }
   return [list $left $top $right $bottom]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{variable}{browser_bwL}
% \begin{variable}{browser_fwL}
%   The browser backward and forward lists are lists of rule numbers, 
%   serving as backward and forward stacks. Moving backward means the 
%   top (last) element is popped off |browser_bwL| and pushed onto 
%   |browser_fwL|, and vice versa. The top (last) element of 
%   |browser_fwL| is the current rule.
%   \begin{tcl}
set browser_bwL {}
set browser_fwL {1}
%   \end{tcl}
% \end{variable}\end{variable}
% 
% 
% \begin{proc}{go_to_rule}
%   The |go_to_rule| procedure is the high level handler of going 
%   from one rule to another. It changes what is displayed in the 
%   browser window canvases, the rule number displayed in the control 
%   bar, and updates the backwards\slash forwards lists accordingly. 
%   The call syntaxes are
%   \begin{displaysyntax}
%     |go_to_rule| absolute \word{rule number}\par
%     |go_to_rule| relative \word{offset}\par
%     |go_to_rule| backward\par
%     |go_to_rule| forward
%   \end{displaysyntax}
%   where \word{rule number} is the number of the item in |rulesL| to 
%   display, and \word{style} is the style of movement this is. 
%   |forward| or |backward| as \word{style} means this is navigation 
%   using the forward and backward buttons, whereas |normal| means 
%   this is a normal move.
%   
%   \begin{tcl}
proc go_to_rule {style {data ""}} {
   global browser_fwL browser_bwL rule_number_var
   switch -- $style "absolute" {
      if {![scan $data %d num]} then {bell; return}
   } "relative" {
      set num [lindex $browser_fwL end]
      incr num $data
   } "backward" {
      if {![llength $browser_bwL]} then {bell; return}
      set num [lindex $browser_bwL end]
   } "forward" {
      if {[llength $browser_fwL]<2} then {bell; return}
      set num [lindex $browser_fwL end-1]
   }
   if {![
      display_rule .rulebrowser $num
   ]} then {bell; return}
   set rule_number_var $num
   switch -- $style "backward" {
      lappend browser_fwL $num
      set browser_bwL [lreplace $browser_bwL\
        [set browser_bwL end] end]
   } "forward" {
      lappend browser_bwL [lindex $browser_fwL end]
      set browser_fwL [lreplace $browser_fwL\
        [set browser_fwL end] end]
   } default {
      if {[llength $browser_fwL]} then {
         lappend browser_bwL [lindex $browser_fwL end]
      }
      set browser_fwL [list $num]
   }
   .rulebrowser.fbar.back configure -state [lindex {disabled normal}\
     [expr {[llength $browser_bwL]>0}]]
   .rulebrowser.fbar.forward configure -state [lindex {disabled normal}\
     [expr {[llength $browser_fwL]>1}]]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{hyper_references}
%   This procedure makes bindings in a canvas so that all items 
%   tagged |reference| become hyperlinks. The call syntax is
%   \begin{quote}
%     |hyper_references| \word{canvas}
%   \end{quote}
%   \begin{tcl}
proc hyper_references {c} {
   $c bind reference <Enter> [list $c configure -cursor hand2]
   $c bind reference <Leave> [list $c configure -cursor {}]
   $c bind reference <ButtonPress-1> [list\
     $c itemconfigure current -fill red]
   $c bind reference <B1-Leave> "
      [list $c configure -cursor {}]
      [list $c itemconfigure current -fill blue]
   "
   $c bind reference <ButtonRelease-1> [list hyper_jump $c red]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{hyper_jump}
%   This procedure does the jumping associated with clicking on a 
%   hyperlink. The call syntax is
%   \begin{quote}
%     |hyper_jump| \word{canvas} \word{hot fill}
%   \end{quote}
%   It only does anything if the |-fill| of the item is equal to 
%   \word{hot fill}, since a different value of |-fill| would indicate 
%   that the mouse was moved in over the hyperlink while being pressed, 
%   which should not count as clicking the hyperlink.
%   \begin{tcl}
proc hyper_jump {c hot} {
   if {[$c itemcget current -fill] ne $hot} then {return}
%   \end{tcl}
%   The number of the rule to jump to is parsed from the text of the 
%   link.
%   \begin{tcl}
   regsub -all -- {[<>()]} [$c itemcget current -text] {} ruleno
   go_to_rule absolute $ruleno
}
%   \end{tcl}
% \end{proc}
%
% 
% \begin{proc}{rule_browser_fbar}
%   This procedure fills in the |fbar| child of a specified toplevel 
%   with the controls for a rule browser window. The call syntax is
%   \begin{quote}
%     |rule_browser_fbar| \word{toplevel}
%   \end{quote}
%   There is no particular return value.
%   
%   ---
%   
%   The control bar is a frame, into which the individual controls are 
%   packed. Its background has a colour.
%   \begin{tcl}
proc rule_browser_fbar {t} {
   set tf $t.fbar
   set bg [$tf cget -background]
   pack [
      button $tf.back -text "Back" -highlightbackground $bg\
        -command {go_to_rule backward}
   ] -side left
   pack [
      button $tf.forward -text "Forward" -highlightbackground $bg\
        -command {go_to_rule forward}
   ] -side left
   
   pack [
      button $tf.go -text "Go" -highlightbackground $bg -command {
         go_to_rule absolute $rule_number_var
      }
   ] -side right
   pack [
      entry $tf.go_e -width 4 -textvariable rule_number_var
   ] -side right
   bind $tf.go_e <Return> [list $tf.go invoke]
   pack [label $tf.go_l -text "Rule" -background $bg] -side right
   pack [
      button $tf.next -text "+1" -highlightbackground $bg\
        -command {go_to_rule relative 1}
   ] -side right
   pack [
      button $tf.prev -text "-1" -highlightbackground $bg\
        -command {go_to_rule relative -1}
   ] -side right
}
%   \end{tcl}
% \end{proc}
% 
% Now that this code is completed, it is fitting to also create the 
% corresponding window.
% \begin{tcl}
rule_browser_layout
lower .rulebrowser .control
%</Tk>
% \end{tcl}
% 
% 
% \subsection{Rules as SVG}
% 
% An alternative means of presentation is to generate an XHTML page 
% with the rules as SVG (and in the future: coefficients in MathML). 
% This is slighly experimental, though.
% 
% \begin{proc}{rule_as_XHTML}
%   This procedure basically takes a rule (in the form of a database 
%   row dictionary) as argument and returns a data-tree representing 
%   an XHTML paragraph presenting that rule. The call syntax is
%   \begin{displaysyntax}
%     |rule_as_XHTML| \word{rule}
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   The supported \word{option}s are:
%   \begin{ttdescription}
%     \item[-vertexobjs]
%       The value is the dictionary of data-trees to use for the 
%       vertices. If this option is not given, then the 
%       |SVG_appearances| procedure is called to compute these.
%     \item[-feedbacks]
%       The value is a boolean and defaults to true. If true, the 
%       reurn value includes a note with the transferrence matrix 
%       the rule was derived under.
%   \end{ttdescription}
%   
%   \begin{tcl}
proc rule_as_XHTML {row args} {
   variable vertex_appearances
   if {[dict exists $args -vertexobjs]} then {
      set vobjD [dict get $args -vertexobjs]
   } else {
      set vobjD [network::rich::SVG_appearances $vertex_appearances]
   }
   variable vertex_sizes
   set children {}
   lappend children [
      network::rich::as_SVG $vobjD -val [
         network::rich::Tk_from_pure [dict get $row lhs]\
           $vertex_sizes $vertex_appearances
      ] -setstroke 0
   ]
   variable coefficient
   dict for {mu r} [dict get $row rhs] {
      set s [{*}$coefficient neg $r]
      if {[string length $s] < [string length $r]} then {
         lappend children {#text " \u2212 "}
      } else {
         lappend children {#text { + }}
         set s $r
      }
      if {$s ne "1"} then {lappend children [list #text $s]}
      lappend children [
         network::rich::as_SVG $vobjD -val [
            network::rich::Tk_from_pure $mu\
              $vertex_sizes $vertex_appearances
         ]
      ]
   }
   if {[dict get $row st4te] in {R r}} then {
      set to \u2192
   } else {
      set to \u2261
   }
   if {[llength $children] == 1} then {
      lappend children [list #text " $to 0"]
   } elseif {[lindex $children 1] eq {#text { + }}} then {
      lset children 1 [list #text " $to "]
   } else {
      lset children 1 1 " $to[lindex $children 1 1]"
   }
% \smallskip
   if {![dict exists $args -feedbacks] || [dict get $args -feedbacks]}\
   then {
      lappend children [list #text " derived under transferrence "]
      set L {}
      foreach e [lindex [dict get $row lhs] 0 1 1] {lappend L 1}
      set M {}
      foreach e [lindex [dict get $row lhs] 0 0 2] {lappend M $L}
      if {![llength $M] || ![llength $L]} then {
         lappend children [list #text "None."]
      } elseif {![llength [dict get $row feed6acks]]} then {
         lappend children [list #text "All."]
      } else {
         foreach fb [dict get $row feed6acks] {
            lset M {*}$fb 0
         }
         set L {}
         foreach matrow $M {
            set M {}
            foreach cell $matrow {
               lappend M [list td {} [list [list \#text $cell]]]
            }
            lappend L [list tr {} $M]
         }
         lappend children [list table {class transferrence} $L]\
           [list #text "."]
      }
   }
   return [list p {} $children]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{resolution_as_XHTML}
%   This procedure takes an ambiguity (in the form of a database row 
%   dictionary) as argument and returns a data-tree representing an 
%   XHTML paragraph presenting the resolution of that ambiguity. It 
%   is assumed that the ambiguity has |p1us| and |m1nus| elements. 
%   The call syntax is
%   \begin{displaysyntax}
%      |resolution_as_XHTML| \word{row} \begin{regblock}[\regstar]
%      \word{option} \word{value} \end{regblock}
%   \end{displaysyntax}
%   and the supported options are:
%   \begin{ttdescription}
%     \item[-vertexobjs]
%       The value is the dictionary of data-trees to use for the 
%       vertices. If this option is not given, then the 
%       |SVG_appearances| procedure is called to compute these.
%     \item[-rulelink]
%       If provided, this option signals that rule annotations should 
%       be links to these rules. The value is a command prefix with 
%       call syntax
%       \begin{displaysyntax}
%         \meta{value} \word{number}
%       \end{displaysyntax}
%       that returns the URI for rule \word{number}. The |format| 
%       command is often useful for this.
%   \end{ttdescription}
%   
%   First generate rich forms of the monomials involved. The site is 
%   put last.
%   \begin{tcl}
proc resolution_as_XHTML {row args} {
%<*zlib>
   dict set row m0n0mials [encoding convertfrom utf-8\
      [zlib inflate [dict get $row deflated_m0n0mials]]]
%</zlib>
   variable vertex_appearances
   variable vertex_sizes
   set richL {}
   dict lappend row m0n0mials [dict get $row si7e]
   foreach NW [dict get $row m0n0mials] {
      lappend richL [network::rich::Tk_from_pure $NW\
        $vertex_sizes $vertex_appearances]
   }
%   \end{tcl}
%   The $i$th element of |whichObjL| is the XHTML object for the 
%   annotation of the relation leading to the $i$th element of the 
%   |re5olution|. Depending on the presence of a |-rulelink| option, 
%   these may contain links to the rules or just their numbers.
%   \begin{tcl}
   if {[dict exists $args -rulelink]} then {
      set cmd [dict get $args -rulelink]
      set L {}
      foreach step [list [dict get $row p1us] [dict get $row m1nus]] {
         lappend L [list a [
            dict create href [{*}$cmd $step]
         ] [list [list #text $step]]]
      }
      set whichObjL [list [
         list span {class relsince} [linsert $L 1 {#text ", "}]
      ]]
      foreach step [dict get $row wh1ch] {
         lappend whichObjL [
            list span {class relsince} [list [
               list a [dict create href [{*}$cmd $step]] [list [
                  list #text $step
               ]]
            ]]
         ]
      }
   } else {
      set whichObjL [list [
         list span {class relsince} [list [
            list #text "[dict get $row p1us], [dict get $row m1nus]"
         ]]
      ]]
      foreach step [dict get $row wh1ch] {
         lappend whichObjL [
            list span {class relsince} [list [
               list #text $step
            ]]
         ]
      }
   }
%   \end{tcl}
%   Now it's time to start generating SVG code.
%   \begin{tcl}
   if {[dict exists $args -vertexobjs]} then {
      set vobjD [dict get $args -vertexobjs]
   } else {
      set vobjD [network::rich::SVG_appearances $vertex_appearances]
   }
   set children {}
   lappend children [
      network::rich::as_SVG $vobjD -val [lindex $richL end] -setstroke 0
   ] [list #text " \u2212 "]
   lappend children [lindex $children 0]
   variable coefficient
   foreach which $whichObjL sum [dict get $row re5olution] {
      lappend children [list span {class stackrel} [
         list $which [list span {class stackedrel} {{#text \u2261}}]
      ]]
      set first 1
      dict for {mu r} $sum {
         set s [{*}$coefficient neg $r]
         if {[string length $s] < [string length $r]} then {
            lappend children {#text " \u2212 "}
         } elseif {!$first} then {
            lappend children {#text { + }}
            set s $r
         } else {
            set s $r
         }
         if {$s ne "1"} then {lappend children [list #text $s]}
         lappend children\
            [network::rich::as_SVG $vobjD -val [lindex $richL $mu]\
              -setstroke 0]
         set first 0
      }
      if {$first} then {lappend children {#text 0}}
   }
   return [list p {} $children]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{raw_XHTML_coefficient}
%   This procedure performs a trivial conversion of coefficients (as 
%   understood by the |$coefficient| ring) to XHTML. The call syntax 
%   is
%   \begin{displaysyntax}
%     |raw_XHTML_coefficient| \word{coefficient}
%   \end{displaysyntax}
%   and the return value is a pair
%   \begin{displaysyntax}
%     \word{sign} \word{data-tree-list}
%   \end{displaysyntax}
%   where \word{sign} is a character (plus or minus: |+| or U+2212) 
%   and \word{data-tree-list} is a list of data-trees that together 
%   express the ``unsigned'' part of the coefficient. The 
%   \word{data-tree-list} is empty when the \word{coefficient} is 
%   just $\pm 1$.
%   
%   That the conversion is raw means the result actually uses the 
%   same representation for coefficients as the input, albeight 
%   wrapped up in a |#text| node. It does however check whether 
%   changing the sign would result in a shorter representation, and 
%   if so considers the original coefficient to have been 
%   ``negative''; this works very well for coefficients that are 
%   integers modulo some constant, and is probably no worse than 
%   doing nothing for everything else.
%   \begin{tcl}
proc raw_XHTML_coefficient {r} {
   variable coefficient
   set u [{*}$coefficient neg $r]
   if {[string length $u] < [string length $r]} then {
      set res [list \u2212]
   } else {
      set res [list +]
      set u $r
   }
   lappend res [
      if {$u ne "1"} then {list [list #text $u]}
   ]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{SAR_as_XHTML}
%   This procedure takes a ``standalone resolution'' (see description 
%   of |standalone_resolution|) as argument and returns a data-tree 
%   representing an XHTML paragraph presenting that multirelation. 
%   The call syntax is
%   \begin{displaysyntax}
%      |SAR_as_XHTML| \word{start} \word{SAR} 
%      \begin{regblock}[\regstar]\word{option} \word{value} 
%      \end{regblock}
%   \end{displaysyntax}
%   where \word{start} is the missing $-1$th step of \word{SAR}---the 
%   left hand side to which all the \word{SAR} steps are right hand 
%   sides. The supported options are:
%   \begin{ttdescription}
%     \item[-vertexobjs]
%       The value is the dictionary of data-trees to use for the 
%       vertices. If this option is not given, then the 
%       |SVG_appearances| procedure is called to compute these.
%     \item[-rulelink]
%       If provided, this option signals that rule annotations should 
%       be links to these rules. The value is a command prefix with 
%       call syntax
%       \begin{displaysyntax}
%         \meta{value} \word{number}
%       \end{displaysyntax}
%       that returns the URI for rule \word{number}. The |format| 
%       command is often useful for this.
%     \item[-coeffconv]
%       This option specifies the command prefix to use for 
%       converting coefficients. It defaults to 
%       |raw_XHTML_coefficient|.
%   \end{ttdescription}
%   
%   First generate rich forms of the monomials involved. The site is 
%   put last.
%   \begin{tcl}
proc SAR_as_XHTML {start SAR args} {
   variable vertex_appearances
   variable vertex_sizes
   foreach {res whichL whatL whereL coeffL monomials} $SAR break
   set richL {}
   foreach NW $monomials {
      lappend richL [network::rich::Tk_from_pure $NW\
        $vertex_sizes $vertex_appearances]
   }
%   \end{tcl}
%   The $i$th element of |whichObjL| is the XHTML object for the 
%   annotation of the relation leading to the $i$th element of the 
%   |re5olution|. Depending on the presence of a |-rulelink| option, 
%   these may contain links to the rules or just their numbers.
%   \begin{tcl}
   set whichObjL {}
   if {[dict exists $args -rulelink]} then {
      set cmd [dict get $args -rulelink]
      foreach step $whichL c $coeffL {
         lappend whichObjL [
            list span {class relsince} [list [
               list a [dict create href [{*}$cmd $step]] [list [
                  list #text \[$step\]
               ]]
            ]]
         ]
      }
   } else {
      foreach step $whichL c $coeffL {
         lappend whichObjL [
            list span {class relsince} [list [
               list #text \[$step\]
            ]]
         ]
      }
   }
%   \end{tcl}
%   Now it's time to start generating SVG code.
%   \begin{tcl}
   if {[dict exists $args -vertexobjs]} then {
      set vobjD [dict get $args -vertexobjs]
   } else {
      set vobjD [network::rich::SVG_appearances $vertex_appearances]
   }
   if {[dict exists $args -coeffconv]} then {
      set cccmd [dict get $args -coeffconv]
   } else {
      set cccmd [list raw_XHTML_coefficient]
   }
   set children {}
   foreach which [linsert $whichObjL 0 ""] sum [linsert $res 0 $start] {
      if {[llength $which]} then {
         lappend children [list span {class stackrel} [
            list $which [list span {class stackedrel} {{#text \u2261}}]
         ]]
      }
      set first 1
      dict for {mu r} $sum {
         lassign [{*}$cccmd $r] sign objL
         if {$sign ne "+" || !$first} then {
            lappend children [list #text " $sign "]
         }
         lappend children {*}$objL
         lappend children\
            [network::rich::as_SVG $vobjD -val [lindex $richL $mu]\
              -setstroke 0]
         set first 0
      }
      if {$first} then {lappend children {#text 0}}
   }
   return [list p {} $children]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{XHTML_prologue}
%   This procedure writes a suitable XHTML prologue (up to and 
%   including the opening |body| tag) to a channel. The call syntax is
%   \begin{displaysyntax}
%     |XHTML_prologue| \word{channel} \word{title}
%   \end{displaysyntax}
%   where \word{title} is XML code that will be put in the |head|, 
%   and should include a |title| element.
%   \begin{tcl}
proc XHTML_prologue {F title} {
   puts $F {<?xml version="1.0"?>}
   puts $F {<!DOCTYPE html PUBLIC\
    "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN"\
    "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">}
   puts $F {<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en"}
   puts $F {      xmlns:xlink="http://www.w3.org/1999/xlink">}
   puts $F {<head>}
   puts $F $title
   puts $F {
    <style type="text/css">
%   \end{tcl}
%   The following is the general style for networks.
%   \begin{tcl}
       svg.network {
         border-style: dotted;
         border-width: thin;
         vertical-align: middle;
         margin-top: 1pt;
         margin-bottom: 1pt;
         fill: none;
         stroke: currentColor;
       }
%   \end{tcl}
%   The following is for encoding feedbacks (a boolean matrix).
%   \begin{tcl}
       table.transferrence {
         display: inline-table;
         border-collapse: collapse;
         vertical-align: middle;
       }
       table.transferrence td {
         border-style: dotted;
         border-width: thin;
       }
%   \end{tcl}
%   The following are used to make an XHTML equivalent of |\stackrel|.
%   \begin{tcl}
       span.stackrel {
         display: inline-block;
         vertical-align: baseline;
       }
       span.relsince {
         display: block;
         font-size: x-small;
         text-align: center;
       }
       span.stackedrel {
         display: block;
         text-align: center;
       }
%   \end{tcl}
%   The following is for the status page.
%   \begin{tcl}
       table.siffertabell td {
         text-align: ".";
       }
    </style>
  }
  puts $F {</head><body>}
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{XHTML_rule_file}
%   This procedure creates a new file, and writes a full XHTML page 
%   with one or several rules to it. The call syntax is
%   \begin{displaysyntax}
%     |XHTML_rule_file| \word{filename} \word{ruleno}\regstar
%   \end{displaysyntax}
%   \begin{tcl}
proc XHTML_rule_file {fname args} {
   set F [open $fname w]
   fconfigure $F -encoding utf-8
   XHTML_prologue $F [mtmtcl::support::xml_from_tree [
      list title {} [list [list #text "Rules [join $args {, }]"]]
   ] -nodesep ""]
%   \end{tcl}
%   Since vertices are reused over and over again, the following 
%   establishes objects that can be referenced.
%   \begin{tcl}
   set defL {}
   set refD [dict create]
   variable vertex_appearances
   dict for {name obj} [
      network::rich::SVG_appearances $vertex_appearances
   ] {
      if {[regexp {^[A-Za-z0-9_.-]*$} $name]} then {
         set id "v-$name"
      } else {
         set id "tcl_[info cmdcount]"
      }
      lappend defL [lreplace $obj 1 1 [
         dict replace [lindex $obj 1] id $id
      ]]
      dict set refD $name [list use [
         dict create  xlink:href "#$id"
      ] {}]
   }
   puts $F [mtmtcl::support::xml_from_tree [
      list svg {xmlns http://www.w3.org/2000/svg display none} $defL
   ]]
%   \end{tcl}
%   At first it seemed that it would be natural to wrap up the 
%   referenced objects in a |symbol| element, but that turned out to 
%   require setting up a |viewBox| for each and every one of them, 
%   whereas referencing the objects themselves Just Works.
%   
%   Now generate the rules.
%   \begin{tcl}
   if {![llength $args]} then {
      set args [concat {*}[thedatabase allrows -as lists\
        {SELECT num6er FROM ru1es}]]
   }
   variable DBCMD
   foreach ruleno $args {
      puts $F [mtmtcl::support::xml_from_tree [
         list h1 [dict create id "rule-$ruleno"]\
           [list [list #text "Rule $ruleno"]]
      ] -nodesep ""]
      set rrow [lindex\
        [$DBCMD(GetRu1e) allrows [dict create num6er $ruleno]] 0]
      set msg [clock format [dict get $rrow wh3n1]\
        -format "Derived %H:%M:%S %Z, %a %b %d %Y."]
      if {[dict exists $rrow wh3n2]} then {
         append msg [clock format [dict get $rrow wh3n2]\
        -format " Retired %H:%M:%S %Z, %a %b %d %Y."]
      }
      puts $F [mtmtcl::support::xml_from_tree [
         list p {} [list [list #text $msg]]
      ]]
      puts $F [mtmtcl::support::xml_from_tree [
         rule_as_XHTML $rrow -vertexobjs $refD
      ]]
      set arow [lindex [$DBCMD(GetAmbiguity) allrows\
        [dict create num6er [dict get $rrow pr00f]]] 0]
%   \end{tcl}
%   \begin{tcl}
      if {[dict exists $arow p1us]} then {
         puts $F {<h5 style="display: run-in">Proof.</h5>}
         puts $F [mtmtcl::support::xml_from_tree [
            resolution_as_XHTML $arow -vertexobjs $refD\
              -rulelink {::format {#rule-%d}}
         ]]
      } else {
         puts $F [mtmtcl::support::xml_from_tree [
            list p {} [list [
               list #text [dict get $arow p1us2eg]
            ]]
         ]]
      }
   }
   puts $F {</body></html>}
   close $F
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{XHTML_rule_document}
%   This procedure writes a full XHTML page with one rule to an open 
%   channel. The call syntax is
%   \begin{displaysyntax}
%     |XHTML_rule_document| \word{channel} \word{ruleno}
%     \begin{regblock}[\regstar] \word{option} \word{value}
%     \end{regblock}
%   \end{displaysyntax}
%   The supported options are:
%   \begin{ttdescription}
%     \item[-head]
%       This option is used to supply a page head, which will be the 
%       first thing after the |<body>| tag. Its value is a string 
%       (XHTML code).
%     \item[-foot]
%       This option is used to supply a page footer, which will be 
%       the last thing before the |</body>| tag. Its value is a string 
%       (XHTML code).
%     \item[-rulelink]
%       This option is passed on to |SAR_as_XHTML|. 
%       If provided, it option signals that rule annotations should 
%       be links to these rules. The value is a command prefix with 
%       call syntax
%       \begin{displaysyntax}
%         \meta{value} \word{number}
%       \end{displaysyntax}
%       that returns the URI for rule \word{number}. The |format| 
%       command is often useful for this.
%     \item[-coeffconv]
%       This option is passed on to |SAR_as_XHTML|. It specifies the 
%       command prefix to use for converting coefficients, and 
%       effectively defaults to |raw_XHTML_coefficient|.
%   \end{ttdescription}
%   \begin{tcl}
proc XHTML_rule_document {F ruleno args} {
   XHTML_prologue $F [mtmtcl::support::xml_from_tree [
      list title {} [list [list #text "Rule $ruleno"]]
   ] -nodesep ""]
   if {[dict exists $args -head]} then {
      puts $F [dict get $args -head]
   }
%   \end{tcl}
%   Since vertices are reused over and over again, the following 
%   establishes objects that can be referenced.
%   \begin{tcl}
   set defL {}
   set refD [dict create]
   variable vertex_appearances
   dict for {name obj} [
      network::rich::SVG_appearances $vertex_appearances
   ] {
      if {[regexp {^[A-Za-z0-9_.-]*$} $name]} then {
         set id "v-$name"
      } else {
         set id "tcl_[info cmdcount]"
      }
      lappend defL [lreplace $obj 1 1 [
         dict replace [lindex $obj 1] id $id
      ]]
      dict set refD $name [list use [
         dict create  xlink:href "#$id"
      ] {}]
   }
   puts $F [mtmtcl::support::xml_from_tree [
      list svg {xmlns http://www.w3.org/2000/svg display none} $defL
   ]]
%   \end{tcl}
%   At first it seemed that it would be natural to wrap up the 
%   referenced objects in a |symbol| element, but that turned out to 
%   require setting up a |viewBox| for each and every one of them, 
%   whereas referencing the objects themselves Just Works.
%   
%   Now generate the rule.
%   \begin{tcl}
   variable DBCMD
   puts $F [mtmtcl::support::xml_from_tree [
      list h1 [dict create id "rule-$ruleno"]\
        [list [list #text "Rule $ruleno"]]
   ] -nodesep ""]
   set rows [$DBCMD(GetRu1e) allrows [dict create num6er $ruleno]]
   if {![llength $rows]} then {
      puts $F "<p>Not found in database!</p>"
      if {[dict exists $args -foot]} then {
         puts $F [dict get $args -foot]
      }
      puts $F {</body></html>}
   }
   set rrow [lindex $rows 0]
   set msg [clock format [dict get $rrow wh3n1]\
     -format "Derived %H:%M:%S %Z, %a %b %d %Y."]
   if {[dict exists $rrow wh3n2]} then {
      append msg [clock format [dict get $rrow wh3n2]\
     -format " Retired %H:%M:%S %Z, %a %b %d %Y."]
   }
   puts $F [mtmtcl::support::xml_from_tree [
      list p {} [list [list #text $msg]]
   ]]
   variable coefficient
   puts $F [mtmtcl::support::xml_from_tree [
      rule_as_XHTML $rrow -vertexobjs $refD
   ]]
   set arow [lindex [$DBCMD(GetAmbiguity) allrows\
     [dict create num6er [dict get $rrow pr00f]]] 0]
   if {[dict exists $arow p1us]} then {
      puts $F {<h5 style="display: run-in">Proof.</h5>}
%<*zlib>
      dict set arow m0n0mials [encoding convertfrom utf-8\
        [zlib inflate [dict get $arow deflated_m0n0mials]]]
%</zlib>
      set SAR0 [standalone_resolution $arow]
      set mu0 [lsearch -exact [lindex $SAR0 5]\
        [dict get $rrow lhs]]
      if {$mu0<0} then {error "Couldn't find lhs in m0n0mials."}
      set SAR [solve_SAR_for $SAR0 $mu0]
      puts $F [mtmtcl::support::xml_from_tree [
         SAR_as_XHTML [list $mu0 [{*}$coefficient 1]] $SAR\
           {*}$args -vertexobjs $refD
      ]]
   } else {
%   \end{tcl}
%   The following is actually too simple; it doesn't account for the 
%   case that an axiom undergoes reduction before it is turned into a 
%   rule, so those reductions are not shown. [FixMe]
%   \begin{tcl}
      puts $F [mtmtcl::support::xml_from_tree [
         list p {} [list [
            list #text [dict get $arow p1us2eg]
         ]]
      ]]
   }
   if {[dict exists $args -foot]} then {
      puts $F [dict get $args -foot]
   }
   puts $F {</body></html>}
}
%   \end{tcl}
% \end{proc}
% 
% 
% \subsubsection{Embedded server}
% 
% \begin{proc}{Log}
%   This is a small helper called by event-loop code to record errors 
%   and such.
%   \begin{tcl}
proc Log {msg} {puts stdout $msg}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{HTTP_accept}
%   This is a |server -socket| and |fileevent readable| callback that 
%   responds with the rule whose number is the beginning of the last 
%   path component of the URL. The \word{incoming} argument is used 
%   for material that has already been |read| but didn't constitute a 
%   full line; it should be an empty string in the |socket -server| 
%   callback prefix.
%   \begin{tcl}
proc HTTP_accept {incoming sock ip port} {
   if {[catch {
      if {$incoming eq ""} then {
         fconfigure $sock -blocking 0 -translation binary
      } else {
         fileevent $sock readable {}
      }
      append incoming [read $sock]
      if {[
         regexp -- {^([A-Za-z]+) ([^\r\n]+) ([^\r\n ]+)\r\n} $incoming\
           "" method url version
      ]} then {
         fconfigure $sock -translation crlf
         puts $sock "HTTP/1.0 200 OK"
         puts $sock "Content-Type: application/xhtml+xml; charset=UTF-8"
         puts $sock "Connection: close\n"
         fconfigure $sock -encoding utf-8
         if {[
            scan [lindex [split $url /] end] %d ruleno
         ]>0} then {
            XHTML_rule_document $sock $ruleno -head [
               format {<p><a href="%d.xhtml">Prev</a>\
                 <a href="%d.xhtml">Next</a></p>}\
                 [expr {$ruleno-1}] [expr {$ruleno+1}]
            ] -rulelink {::format %d.xhtml}
         } else {
            XHTML_status_document $sock
         }
         close $sock
      } elseif {[string length $incoming]<5000} {
         fileevent $sock readable [list\
           [namespace which HTTP_accept] $incoming $sock $ip $port]
      } else {
         Log "$ip has written [string length $incoming] bytes,\
           but still no CRLF; I give up."
         close $sock
      }
   } msg]} {
      Log "Error: $msg"
      catch {close $sock}
   }
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{XHTML_status_document}
%   This procedure produces an XHTML rendering of the data (but not 
%   the controls) of the control window. Its call syntax is
%   \begin{displaysyntax}
%     |XHTML_status_document| \word{socket}
%   \end{displaysyntax}
%   where \word{socket} is the channel to which the document should 
%   be written.
%   
%   \begin{tcl}
proc XHTML_status_document {F} {
   variable Count
   variable pair_level
   variable ambiguity_level
   variable main_loop_stack
   variable DBCMD
   XHTML_prologue $F "<title>Completion utility status</title>"
   set rows {}
   set cells {}
   lappend cells {td {} {}}
   lappend cells [list th {scope col} [list [list #text Rules]]]
   lappend cells [list th {scope col} [list [list #text Equalities]]]
   lappend cells [list th {scope col} [list [list #text Pairs]]]
   lappend cells [list th {scope col} [list [list #text Ambiguities]]]
   lappend rows [list tr {} $cells]
   set cells {} 
   lappend cells [list th {scope row} [list [list #text Active]]]
   lappend cells [list td {} [list [list #text $Count(R)]]]
   lappend cells [list td {} [list [list #text $Count(E)]]]
   lappend cells [list td {} [list [list #text $Count(P)]]]
   lappend cells [list td {} [list [list #text $Count(A)]]]
   lappend rows [list tr {} $cells]
   set cells {} 
   lappend cells [list th {scope row} [list [list #text Inactive]]]
   lappend cells [list td {} [list [list #text $Count(r)]]]
   lappend cells [list td {} [list [list #text $Count(e)]]]
   lappend cells [list td {} [list [list #text $Count(p)]]]
   lappend cells [list td {} [list [list #text $Count(a)]]]
   lappend rows [list tr {} $cells]
   set cells {} 
   lappend cells [list td {} {}]
   lappend cells [list td {} {}]
   lappend cells [list th {scope row} [list [list #text Level]]]
   lappend cells [list td {} [list [list #text $pair_level]]]
   lappend cells [list td {} [list [list #text $ambiguity_level]]]
   lappend rows [list tr {} $cells]
   puts $F [mtmtcl::support::xml_from_tree [
      list table {class siffertabell} $rows
   ] -nodesep ""]
   if {$Count(R)>0} then {
      set L [$DBCMD(database) allrows -as lists {
         SELECT min(num6er),max(num6er) FROM ru1es WHERE st4te='R'
      }]
      puts $F [mtmtcl::support::xml_from_tree [
         list p {} [list [
            list a [dict create href [lindex $L 0 0].xhtml] [list [
               list #text "First rule"
            ]]
         ] {#text " / "} [
            list a [dict create href [lindex $L 0 1].xhtml] [list [
               list #text "Last rule"
            ]]
         ]]
      ]]
   }
   if {$Count(E)>0} then {
      set L [$DBCMD(database) allrows -as lists {
         SELECT min(num6er),max(num6er) FROM ru1es WHERE st4te='E'
      }]
      puts $F [mtmtcl::support::xml_from_tree [
         list p {} [list [
            list a [dict create href [lindex $L 0 0].xhtml] [list [
               list #text "First equality"
            ]]
         ] {#text " / "} [
            list a [dict create href [lindex $L 0 1].xhtml] [list [
               list #text "Last equality"
            ]]
         ]]
      ]]
   }
   puts $F {<h3>Main loop stack</h3>}
   foreach cmd [lreverse $main_loop_stack] {
      puts $F [mtmtcl::support::xml_from_tree [
         list p {} [list [
            list kbd {} [list [
               list #text $cmd
            ]]
         ]]
      ] -nodesep "" -charmap {\0 &#x2400; \33 &#x241B; \17 &#x241F;}]
   }
   puts $F "</body></html>"
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{navigation_head}
%   This procedure returns XHTML code (raw string) for a ``navigation 
%   page head'' relative to a particular rule.
%   
%   ---
% \end{proc}
% 
% \begin{tcl}
%<*testserver>
set servsock [socket -server [namespace code {HTTP_accept ""}] 9090]
%</testserver>
% \end{tcl}
% 
% \subsection{Resolutions as proofs}
% 
% Resolutions are the back bones of proofs for rules, but they are 
% not always optimal as presentations of proofs; even though the rule 
% is obvious from the last step, each individual step is often a mix 
% of two separate reduction paths, and it would be clearer (sometimes 
% also shorter) if these could be separated. The following aims to 
% transform a resolution to a multistep equation where the left hand 
% side is the rule left hand side, the right hand side is the rule 
% right hand side, and each step consists of adding some 
% $rv(a -\nobreak \mu)$ to the whole thing.
% 
% \begin{proc}{standalone_resolution}
%   This procedure generates a standalone form of a resolution, to be 
%   used in further processing. The call syntax is
%   \begin{displaysyntax}
%     |standalone_resolution| \word{ambiguity}
%   \end{displaysyntax}
%   where the \word{ambiguity} is the dictionary for a row in the 
%   |am6iguity| table (with noncompressed |m0n0mials| entry). The 
%   return value is a list
%   \begin{displaysyntax}
%     \word{resolution} \word{which-list} \word{what-list} 
%     \word{where-list} \word{coeff-list} \word{monomials}
%   \end{displaysyntax}
%   which is similar to an ambiguity, but with some subtle 
%   differences. The primary differences are that the |p1us| and 
%   |m1nus| entries have been incorporated into the 
%   \word{which-list}, and the |wh3re| entry has been split on the 
%   \word{what-list} and the \word{where-list}, but there are also 
%   some minor modifications: the |si7e| is in \word{monomials}, it is 
%   mentioned twice in \word{what-list}, and of course the |p1us2eg| 
%   and |m1nus2eg| have been inserted into the \word{where-list}. All 
%   of this aims to make the resolution more self-contained.
%   
%   Formally,
%   \begin{equation} \label{Eq:StandaloneResolution}
%     \texttt{[lindex~\word{resolution}~$n$]} =
%     \sum_{k=0}^n r_k \bigl( t_k(\mu_k) - \mu_k \bigr)
%   \end{equation}
%   where \(r_k ={}\)\texttt{[lindex \word{coeff-list} $k$]}, 
%   \(\mu_k={}\)\texttt{[lindex \word{what-list} $k$]}, and $t_k$ is 
%   the simple reduction which applies \texttt{[lindex 
%   \word{which-list} $k$]} at \texttt{[lindex \word{where-list} $k$]} 
%   in $\mu_k$. It is always the case that \(\mu_0=\mu_1={}\)|si7e|, 
%   \(r_0=-1\), and \(r_1=1\).
%   
%   The first complication for this is that the |si7e| is not 
%   guaranteed to be canonical; it has to be canonised and the two 
%   regions modified accordingly.
%   \begin{tcl}
proc standalone_resolution {amb} {
   set monomials [dict get $amb m0n0mials]
   set mu0 [llength $monomials]
   lappend monomials\
     [network::pure::canonise [dict get $amb si7e] relabel]
   set whatL [set whichL [set whereL [set coeffL {}]]]
   lappend whatL $mu0 $mu0
   lappend whichL [dict get $amb m1nus] [dict get $amb p1us]
   lappend whereL\
     [network::pure::forward_region $relabel [dict get $amb m1nus2eg]]\
     [network::pure::forward_region $relabel [dict get $amb p1us2eg]]
   variable coefficient
   set one [{*}$coefficient 1]
   set mone [{*}$coefficient neg $one]
   lappend coeffL $mone $one
%   \end{tcl}
%   The second complication is that the argument does not contain 
%   sufficient information for reconstructing the first step of the 
%   \word{resolution} (although it is usually possible to make a good 
%   guess), since terms from the respective |rhs|'s of the |p1us| and 
%   |m1nus| rules could have cancelled. Therefore the |m1nus| rule 
%   underlying $t_0$ is fetched from the database, and the
%   $-\bigl( t_0(\mu_0) -\nobreak \mu_0 \bigr)$ term is recomputed.
%   \begin{tcl}
   set D [dict create $mu0 $one]
   variable DBCMD
   set rule [lindex [
      $DBCMD(GetRu1e) allrows [dict create num6er [lindex $whichL 0]]
   ] 0]
   set NWG [network::pure::detach [lindex $monomials end]\
     [lindex $whereL 0]]
   dict for {NWH r} [dict get $rule rhs] {
      set NW [network::pure::canonise\
        [network::pure::annex $NWG $NWH]]
      set nu [lsearch -exact $monomials $NW]
      if {$nu<0} then {
         set nu [llength $monomials]
         lappend monomials $NW
      }
      dict update D $nu s {
         if {[info exists s]} then {
            set s [{*}$coefficient - $s $r]
         } else {
            set s [{*}$coefficient neg $r]
         }
         if {[{*}$coefficient iszero $s]} then {unset s}
      }
   }
%   \end{tcl}
%   Finally the rest of the various lists are built up; this does not 
%   require any calculations.
%   \begin{tcl}
   set resL [list $D {*}[dict get $amb re5olution]]
   lappend whichL {*}[dict get $amb wh1ch]
   foreach pair [dict get $amb wh3re] step [dict get $amb re5olution] {
      if {![llength $pair]} then {break}
      lappend whatL [lindex $pair 0]
      lappend whereL [lindex $pair 1]
      lappend coeffL [dict get $step [lindex $pair 0]]
   }
   return [list $resL $whichL $whatL $whereL $coeffL $monomials]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{solve_SAR_for}
%   This procedure takes a standalone resolution (as returned by 
%   |standalone_resolution|) and a monomial in the final step as 
%   argument. It returns a list on the same general form as a 
%   standalone resolution, and in particular applying the same rules 
%   as in the input resolution, but with the difference that all the 
%   steps are congruent to the given monomial; each step is thus a 
%   ``right hand side'' to this ``left hand side''. This is used to 
%   turn a resolution into a more narrative proof of a rule, by 
%   treating it as a multistep equation that is solved for the given 
%   monomial.
%   
%   The call syntax is
%   \begin{displaysyntax}
%     |solve_SAR_for| \word{standalone res.} \word{lhs} 
%     \word{factor}\regopt\ \word{start}\regopt
%   \end{displaysyntax}
%   where the \word{lhs} is an index into the \word{monomials} 
%   element of the \word{standalone res.}. It is presumed that an 
%   \word{lhs} term appears in the final step of the resolution. It 
%   is also required that each \word{what} (except the zeroeth) has 
%   a nonzero term in the previous step of the resolution; this 
%   condition will typically not be fulfilled by the result.
%   
%   The optional \word{factor} argument is the coefficient for 
%   \word{lhs} in the implicit left hand side; it defaults to $1$. 
%   The optional \word{start} argument is what to use as starting 
%   point for the resolution. It defaults to \word{factor} times 
%   \word{lhs}, which generally corresponds to solving for this. If 
%   that was only a term in a larger sum, it may instead be 
%   appropriate to use the full sum as \word{start}.
%   
%   There are three loops in the procedure. The first of these 
%   decomposes the \word{resolution}~\eqref{Eq:StandaloneResolution} 
%   into individual terms, as a preparation for rearranging them. 
%   Arithmetic with linear combinations of monomials is provided by 
%   the |mtmtcl::rings::semigroup_algebra| ensemble, a prefix for 
%   which is kept in the |M| variable. The first loop also computes 
%   a table (in the |S| array) of in which steps in the input 
%   resolution each particular monomial appears.
%   \begin{tcl}
proc solve_SAR_for {SAR lhs args} {
   variable coefficient
   set M [list ::mtmtcl::rings::semigroup_algebra $coefficient\
     ::mtmtcl::rings::integers::all]
   set termL {}
   set sum [{*}$M 0]
   foreach partial [lindex $SAR 0] {
      dict for {mu r} $partial {lappend S($mu) [llength $termL]}
      lappend termL [{*}$M - $partial $sum]
      set sum $partial
   }
%   \end{tcl}
%   The second loop constructs the first half of the output 
%   resolution, which goes from \word{lhs} to $\mu_0$ through a 
%   series of monomials such that the previous one is introduced by a 
%   reduction acting on the next.
%   \begin{tcl}
   if {[llength $args]>0} then {
      set factor [lindex $args 0]
   } else {
      set factor [{*}$coefficient 1]
   }
   set scale [{*}$coefficient neg\
     [{*}$coefficient / $factor [dict get $sum $lhs]]]
   if {[llength $args]>1} then {
      set sum [lindex $args 1]
   } else {
      set sum [dict create $lhs $factor]
   }
   set sumL {}; set coeffL {}
   set whatL {}; set whichL {}; set whereL {}
   while {[set n [lindex $S($lhs) 0]]} {
      lappend whichL [lindex $SAR 1 $n]
      lappend whatL  [lindex $SAR 2 $n]
      lappend whereL [lindex $SAR 3 $n]
      lappend coeffL [{*}$coefficient * $scale [lindex $SAR 4 $n]]
      set sum [{*}$M + $sum [{*}$M . $scale [lindex $termL $n]]]
      lappend sumL $sum
      lset termL $n {}
      set lhs [lindex $whatL end]
   }
%   \end{tcl}
%   The second loop clears the |termL| entries for the steps it has 
%   processed. The third loop processes remaining terms.
%   \begin{tcl}
   foreach term $termL  which [lindex $SAR 1]  what [lindex $SAR 2] \
     where [lindex $SAR 3]  r [lindex $SAR 4] {
      if {![dict size $term]} then {continue}
      set sum [{*}$M + $sum [{*}$M . $scale $term]]
      lappend sumL $sum
      lappend whichL $which
      lappend whatL  $what
      lappend whereL $where
      lappend coeffL [{*}$coefficient * $scale $r]
   }
   return [list $sumL $whichL $whatL $whereL $coeffL [lindex $SAR 5]]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \subsection{Export to \LaTeX}
% 
% \begin{proc}{rule_as_LaTeX}
%   This procedure formats a rule (with proof, if any) as \LaTeX\ 
%   code, using the \texttt{sdpgf} environment for the networks. The 
%   call syntax is
%   \begin{displaysyntax}
%     |rule_as_LaTeX| \word{ruleno} \begin{regblock}[\regstar] 
%     \word{option} \word{value} \end{regblock}
%   \end{displaysyntax}
%   where the directly supported options are
%   \begin{ttdescription}
%     \item[-style]
%       The basic kind of \LaTeX\ code unit generated for each rule; 
%       supported values are |equation| (default) and |theorem|. In 
%       the |equation| style, the material generated for a rule is 
%       its derivation formula. In the |theorem| style, the material 
%       generated is a pair of theorem-like environment stating the 
%       rule as such, and a |proof| environment giving the derivation.
%     \item[-labelprefix]
%       A string which is used as prefix for |\label|s of rules. If 
%       this is not specified, then no referencing is made.
%     \item[-refwrap]
%       A list of one or two |format| strings, which should each 
%       contain one |%s| specifier. These are used to produce the 
%       \LaTeX\ code for rule references in proofs, and will be used 
%       as the argument of a |\stackrel|. The first is used for rules 
%       with proofs (lemmas), the last for rules without proofs 
%       (axioms). The default is |{\eqref{%s}}| (list of one element, 
%       thus used for both). An appropriate value in the |theorem| 
%       style could rather be
%       \begin{displaysyntax}
%         |{\text{L\ref{%s}}} {\text{A\ref{%s}}}|
%       \end{displaysyntax}
%       \changes{2.1}{2021/11/15}{Added \texttt{-refwrap}, 
%         \texttt{-pretheorem}, and \texttt{-posttheorem} options. (LH)}
%     \item[-groom]
%       Boolean, defaults to true, if which case the inputs and 
%       outputs of rules are permutated to groom the left hand side 
%       of the rule. If false, they are instead presented as they 
%       appear in the the database, which rather means the site of 
%       the ambiguity is groomed.
%     \item[-environment]
%       The name of the main \LaTeX\ environment for the rule. 
%       Defaults to |equation| in |equation| style, but to |lemma| in 
%       |theorem| style.
%     \item[-axiomenvironment]
%       The name an alternative \LaTeX\ environment for rules that 
%       have no proof (concretely: the corresponding 
%       \texttt{am6iguities} row has a null |p1us| column). 
%       Defaults to |equation| in |equation| style, but to |axiom| in 
%       |theorem| style.
%       \changes{2.1}{2019/10/13}{Refined the axiom\slash lemma 
%         distinction. (LH)}
%     \item[-pretheorem]
%       In |theorem| style, a script evaluated (directly in the 
%       context of |rule_as_LaTeX|) after the |\begin| 
%       (and associated material) of the main environment, but before 
%       the diagram formula is appended to the result. Defaults to 
%       appending a |\begin{displaymath}| line to the result variable 
%       |res|. Could be used to employ a different environment, or 
%       even insert more text.
%     \item[-posttheorem]
%       Analogous, but this script is evaluated after the diagram 
%       formula and before the |\end| for the main environment. 
%       Defaults to appending a |\end{displaymath}| line to the 
%       result variable |res|.
%   \end{ttdescription}
%   Other options are passed on to lower level commands, particularly 
%   |network::rich::as_PGF|.
%   
%   \begin{tcl}
proc rule_as_LaTeX {ruleno args} {
   array set O {
      -style equation
      -refwrap {{\eqref{%s}}}
      -pretheorem {
         append res "\n  \\begin{displaymath}"
         append nl "  "
      }
      -posttheorem {
         append res "\n  \\end{displaymath}"
      }
      -groom 1
   }
   array set O $args
   if {$O(-style) eq "theorem"} then {
      if {![info exists O(-environment)]} then {
         set O(-environment) lemma
      }
      if {![info exists O(-axiomenvironment)]} then {
         set O(-axiomenvironment) axiom
      }
   } else {
      if {![info exists O(-environment)]} then {
         set O(-environment) equation
      }
      if {![info exists O(-axiomenvironment)]} then {
         set O(-axiomenvironment) equation
      }
   }
%   \end{tcl}
%   \begin{tcl}
   variable DBCMD
   set rows [$DBCMD(GetRu1e) allrows [dict create num6er $ruleno]]
   if {![llength $rows]} then {
      error "No rule $ruleno found in database"
   }
   set rrow [lindex $rows 0]
   set arow [lindex [$DBCMD(GetAmbiguity) allrows\
     [dict create num6er [dict get $rrow pr00f]]] 0]
   if {$O(-groom)} then {
%   \end{tcl}
%   Grooming the rule is done by modifying the |rrow|. Its proof (the 
%   ambiguity) is however more complicated due to assumptions about 
%   networks being canonical, so in that case the permutations are 
%   applied to the |standalone_resolution|.
%   \begin{tcl}
      lassign [network::pure::grooming_permutations\
        [dict get $rrow lhs]] sigma tau
      dict set rrow lhs [network::pure::left_action $sigma\
        [network::pure::right_action [dict get $rrow lhs] $tau]]
      dict set rrow rhs [dict map {mu r} [dict get $rrow rhs] {
         set mu [network::pure::left_action $sigma\
           [network::pure::right_action $mu $tau]]
         set r
      }]
      set tauinv $tau
      for {set k 0} {$k < [llength $tau]} {incr k} {
         lset tauinv [lindex $tau $k] $k
      }
      dict set rrow feed6acks [lmap pair [dict get $rrow feed6acks] {
         list [lindex $sigma [lindex $pair 0]]\
           [lindex $tauinv [lindex $pair 1]]
      }]
   }
   set hasproof [dict exists $arow p1us]
   if {$hasproof} then {
      if {[info exists O(-environment)]} then {
         set env $O(-environment)
      } elseif {$O(-style) eq "theorem"} then {
         set env lemma
      } else {
         set env equation
      }
   } else {
      if {[info exists O(-axiomenvironment)]} then {
         set env $O(-axiomenvironment)
      } elseif {$O(-style) eq "theorem"} then {
         set env axiom
      } else {
         set env equation
      }
   }
   set res "\\begin{$env}"
   if {$O(-style) eq "theorem" && !$hasproof &&\
     [dict exists $arow m1nus2eg]} then {
%   \end{tcl}
%   A lot of axioms have short descrptions, so add those as notes in 
%   the axiom heading. This is somewhat hacky, but should suffice for 
%   the moment.
%   \begin{tcl}
      append res \[ [
        mtmtcl::latex::make::tool::str2licr [dict get $arow m1nus2eg]
      ] \]
   }
   if {[info exists O(-labelprefix)]} then {
      append res " \\label{$O(-labelprefix)$ruleno}"
   }
   set nl "\n  "
   if {$O(-style) eq "theorem"} then $O(-pretheorem)
   append res $nl [string map [list \n $nl] [
     network_as_LaTeX [dict get $rrow lhs] {*}$args
   ]]
   if {$O(-style) eq "theorem" || !$hasproof} then {
      if {[dict get $rrow st4te] in {R r}} then {
         append res $nl {\rightarrow}
      } else {
         append res $nl {\equiv}
      }
      append res $nl [
        lincomb_as_LaTeX [dict get $rrow rhs] {*}$args
      ]
   }
   if {$O(-style) eq "theorem"} then $O(-posttheorem)
   if {$O(-style) eq "theorem"} then {append res \n "\\end{$env}"}
   if {$hasproof} then {
      if {$O(-style) eq "theorem"} then {
         append res \n {\begin{proof}} \n {  \begin{math}}
         append res $nl [string map [list \n $nl] [
           network_as_LaTeX [dict get $rrow lhs] {*}$args
         ]]
      }
%<*zlib>
      dict set arow m0n0mials [encoding convertfrom utf-8\
        [zlib inflate [dict get $arow deflated_m0n0mials]]]
%</zlib>
%   \end{tcl}
%   Acting with permutations on |arow| is quite complicated, because 
%   monomials are stored in several places, and there are 
%   presumptions about some of them being canonical (which permuting 
%   the legs in general violates). Acting with permutations on a 
%   standalone resolution is much easier, since there all monomials 
%   are in a single list. Not canonising after acting means the 
%   regions are still valid.
%   \begin{tcl}
      set SAR0 [standalone_resolution $arow]
      if {$O(-groom)} then {
         lset SAR0 5 [lmap mu [lindex $SAR0 5] {
            network::pure::left_action $sigma\
              [network::pure::right_action $mu $tau]
         }]
      }
      set mu0 [lsearch -exact [lindex $SAR0 5] [dict get $rrow lhs]]
      if {$mu0<0} then {error "Couldn't find lhs in m0n0mials."}
      set SAR [solve_SAR_for $SAR0 $mu0]
      foreach lincomb [lindex $SAR 0] rule [lindex $SAR 1] {
         if {[info exists O(-labelprefix)]} then {
            set rrow2 [lindex [
               $DBCMD(GetRu1e) allrows [dict create num6er $rule]
            ] 0]
            set arow2 [lindex [$DBCMD(GetAmbiguity) allrows\
              [dict create num6er [dict get $rrow2 pr00f]]] 0]
            append res $nl "\\stackrel{[
               format [
                  lindex $O(-refwrap)\
                    [lindex {end 0} [dict exists $arow2 p1us]]
               ] $O(-labelprefix)$rule
            ]}{\\equiv}"
         } else {
            append res $nl {\equiv}
         }
         append res $nl [
           lincomb_as_LaTeX $lincomb -networks [lindex $SAR 5]\
             {*}$args
         ]
      }
      if {$O(-style) eq "theorem"} then {
         append res \n {  \end{math}} \n {\end{proof}}
      }
   }
   if {$O(-style) ne "theorem"} then {append res \n "\\end{$env}"}
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{network_as_LaTeX}
%   This procedure takes a pure network as argument and returns 
%   \LaTeX\ code for drawing that network (in a math mode context). 
%   The call syntax is
%   \begin{displaysyntax}
%     |network_as_LaTeX| \word{network} \begin{regblock}[\regstar] 
%     \word{option} \word{value} \end{regblock}
%   \end{displaysyntax}
%   Notable options are:
%   \begin{ttdescription}
%     \item[-unit]
%       Passed on to |network::rich::as_PGF|.
%     \item[-division]
%       Passed on to |network::rich::as_PGF|.
%   \end{ttdescription}
%   
%   \begin{tcl}
proc network_as_LaTeX {NW args} {
   set A(pure) $NW
   variable vertex_appearances
   variable vertex_sizes
   network::rich::make_level-layout-Tk $vertex_sizes {*}$args -var A
   network::rich::vpos-Tk_by_level -var A
   network::rich::ecurve-Tk-raw_by_level $vertex_appearances {*}$args -var A
   return "\\left\[ [
     network::rich::as_PGF $vertex_appearances {*}$args -var A
   ] \\right\]"
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{network_as_OMLaTeX}
%   This procedure takes a pure network as argument and returns a 
%   near-OpenMath object for that network, that is suitable for 
%   conversion to \LaTeX\ code. The call syntax is
%   \begin{displaysyntax}
%     |network_as_OMLaTeX| \word{network} \begin{regblock}[\regstar] 
%     \word{option} \word{value} \end{regblock}
%   \end{displaysyntax}
%   Notable options are:
%   \begin{ttdescription}
%     \item[-unit]
%       Passed on to |network::rich::as_PGF|.
%     \item[-division]
%       Passed on to |network::rich::as_PGF|.
%   \end{ttdescription}
%   
%   Currently, the OM object returned is just an |OMFOREIGN| 
%   (containing the \word{network} verbatim, without even specifying 
%   an |encoding|) equipped with an |altenc/LaTeX_encoding| 
%   attribution. 
%   
%   \begin{tcl}
proc network_as_OMLaTeX {NW args} {
   set A(pure) $NW
   variable vertex_appearances
   variable vertex_sizes
   network::rich::make_level-layout-Tk $vertex_sizes {*}$args -var A
   network::rich::vpos-Tk_by_level -var A
   network::rich::ecurve-Tk-raw_by_level $vertex_appearances {*}$args -var A
   set lineL [split [
     network::rich::as_PGF $vertex_appearances {*}$args -var A
   ] \n]
   set L [list {usepackage {name sdpgf} {}}]
   lappend L [list unindent {linebreak 1} [list {#text \\left\[}\
     [list \#text [lindex $lineL 0]] ] ]
   foreach line [lrange $lineL 1 end-1] {
      foreach word [split [string trim $line]] {
         lappend L [list \#text $word]
      }
   }
   lappend L [list unindent {} [list\
     [list \#text [lindex $lineL end]] {#text \\right\]} ] ]
   list OMATTR {} [list [
      list OMATP {} [list\
        {OMS {cd altenc name LaTeX_encoding} {}}\
        [list OMFOREIGN {encoding mtmtcl-LaTeX} $L]]
   ] [
      list OMFOREIGN {} [list [list #text $NW]]
   ]]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{lincomb_as_LaTeX}
%   This procedure takes a linear combination of pure networks as 
%   argument and returns \LaTeX\ code for drawing that linear 
%   combination (in a math mode context). 
%   The call syntax is
%   \begin{displaysyntax}
%     |lincomb_as_LaTeX| \word{linear combination} 
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   Notable options are:
%   \begin{ttdescription}
%     \item[-networks]
%       If this option is provided, then the keys in the \word{linear 
%       combination} are not actual networks, but indices into a list 
%       of networks. That list is the value of this option.
%     \item[-unit]
%       Passed on to |network::rich::as_PGF|.
%     \item[-division]
%       Passed on to |network::rich::as_PGF|.
%   \end{ttdescription}
%   \begin{tcl}
proc lincomb_as_LaTeX {lincomb args} {
   variable coefficient
   set termL {{OMS {cd arith1 name plus} {}}}
   dict for {mu r} $lincomb {
      set L {}
      lappend L {OMS {cd arith1 name times mtmtcl:path .} {}}
      lappend L [{*}$coefficient export $r {mtmtcl:path scalar}]
      if {[dict exists $args -networks]} then {
         set mu [lindex [dict get $args -networks] $mu]
      }
      set L2 {}
      foreach line [split [
         network_as_LaTeX $mu {*}$args
      ] \n] {lappend L2 [list #text [string trim $line]]}
      lappend L [list OMATTR {} [list [
         list OMATP {} [list\
           {OMS {cd altenc name LaTeX_encoding} {}}\
           [list OMFOREIGN {encoding mtmtcl-LaTeX} $L2]]
      ] [
         list OMFOREIGN {} [list [list #text $mu]]
      ]]]
      lappend termL [list OMA {} $L]
   }
   mtmtcl::latex::convertto [list OMA {} $termL]
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \begin{proc}{database_as_LaTeX}
%   This procedure dumps the entire database as a \LaTeX\ document. 
%   The call syntax is
%   \begin{displaysyntax}
%     |database_as_LaTeX| \word{filename} \begin{regblock}[\regstar] 
%     \word{option} \word{value} \end{regblock}
%   \end{displaysyntax}
%   where \word{filename} is the name of the \LaTeX\ file to create. 
%   Options and values are passed on to |rule_as_LaTeX|, but if 
%   |-preamble| is provided then the value of this option is inserted 
%   into the preamble of the created \LaTeX\ file; this is useful for 
%   defining \texttt{lemma} and \texttt{axiom} environments for the 
%   \texttt{theorem} style of a database dump.
%   
%   \begin{tcl}
proc database_as_LaTeX {fname args} {
   array set O $args
   set F [open $fname w]
   puts $F {\documentclass{article}}
   puts $F {\usepackage{amsmath,sdpgf}}
   if {[info exists O(-preamble)]} then {puts $F $O(-preamble)}
   puts $F {\begin{document}}
   variable DBCMD
   foreach rule [lsort -integer [
      concat {*}[thedatabase allrows -as lists {SELECT num6er FROM ru1es}]
   ]] {
      puts $F "[rule_as_LaTeX $rule {*}$args]\n"
   }
   puts $F {\end{document}}
   close $F
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{resolution_as_LaTeX}
%   This procedure encodes a resolution as \LaTeX; the resolution 
%   need not have given rise to a new rule. The call syntax is
%   \begin{displaysyntax}
%     |resolution_as_LaTeX| \word{resolution} \word{rule-names}
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   and this returns math-mode \LaTeX\ code. The \word{resolution} is a 
%   dictionary with the same structure as a row in the |am6iguities| 
%   table; entries of note are:
%   \begin{ttdescription}
%     \item[m0n0mials]
%       The list of networks (monomials) that may appear in the 
%       resolution.
%     \item[re5olution]
%       The list of steps in the resolution. Each item is  a linear 
%       combination of monomials, encoded as a dictionary\slash 
%       key--value list mapping monomial index to coefficient value.
%     \item[wh1ch]
%       A list of rule \texttt{num6ers}. Element $i$ of this list 
%       is applied to convert element $i$ of the \texttt{re5olution} 
%       into element $i+1$.
%     \item[si7e]
%       The actual network of the ambiguity being resolved.
%     \item[p1us\textnormal{, }m1nus]
%       The \texttt{num6ers} of the two rules applied to the 
%       \texttt{si7e} to generate the first step of the 
%       \texttt{re5olution}.
%   \end{ttdescription}
%   The \word{rule-names} is a dictionary, where the keys are rule 
%   \texttt{num6ers} and a value is math-mode \LaTeX\ code for a
%   symbolic name for that rule. Rules with no entry in the 
%   \word{rule-names} are left anonymous in the result.
%   
%   \begin{tcl}
proc resolution_as_LaTeX {rD rulesD args} {
   set res ""
%   \end{tcl}
%   If there is a \texttt{si7e}, then that network is shown first, 
%   followed by a colon. This is passed through |lincomb_as_LaTeX| to 
%   reduce the number of lines over which the network is spread out.
%   \begin{tcl}
   if {[dict exists $rD si7e]} then {
      append res [lincomb_as_LaTeX [
         dict create [dict get $rD si7e] [{*}$::coefficient 1]
      ] {*}$args] \n
      if {[dict exists $rD p1us]} then {
         set no [dict get $rD p1us]
         if {[dict exists $rulesD $no]} then {
            set pluscode [dict get $rulesD $no]
         }
      }
      if {[dict exists $rD m1nus]} then {
         set no [dict get $rD m1nus]
         if {[dict exists $rulesD $no]} then {
            set minuscode [dict get $rulesD $no]
         }
      }
      if {[info exists pluscode] && [info exists minuscode]} then {
         append res "\\quad\\text{acted upon by rules \$$pluscode\$\
           and \$$minuscode\$ yields:}\\quad" \n
      } else {
         append res : \n
      }
   }
%   \end{tcl}
%   Strictly speaking, that should also record the transferrence of 
%   the ambiguity. FIXME, perhaps?
%   
%   Then comes the main loop over the steps of the 
%   \texttt{re5olution} and \texttt{wh1ch}. The latter list has one 
%   element less, so the end can be recognised by that element 
%   picking up an empty string.
%   \begin{tcl}
   if {![dict exists $rD wh1ch]} then {dict set rD wh1ch {}}
   foreach step [dict get $rD re5olution] rule [dict get $rD wh1ch] {
      append res [
        lincomb_as_LaTeX $step -networks [dict get $rD m0n0mials]\
          {*}$args
      ]
      if {$rule ne ""} then {
         if {[dict exists $rulesD $rule]} then {
            append res \n "\\stackrel{[dict get $rulesD $rule]}\\to" \n
         } else {
            append res \n {\to} \n
         }
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{ambiguities_as_LaTeX}
%   This is a small wrapper around |resolution_as_LaTeX| which takes 
%   a list of ambiguity numbers rather than their corresponding 
%   database rows. The call syntax is
%   \begin{displaysyntax}
%     |ambiguities_as_LaTeX| \word{number-list} \word{rule-names}
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   The return value is a sequence of paragraphs (so text-mode 
%   \LaTeX\ code), one for each resolution.
%   
%   \begin{tcl}
proc ambiguities_as_LaTeX {numberL rulesD args} {
   variable DBCMD
   set res ""
   foreach num $numberL {
      set amb [lindex [
         $DBCMD(GetAmbiguity) allrows -as dicts\
           [dict create num6er $num]
      ] 0]
%<*zlib>
      dict set amb m0n0mials [
         encoding convertfrom utf-8 [zlib inflate\
           [dict get $amb deflated_m0n0mials]]
      ]
%</zlib>
      catch {
         append res "% $num: [dict get $amb p1us], [dict get $amb m1nus]" \n
      }
      append res {\begin{math}} \n {  }
      append res [string map {\n "\n  "} [
         resolution_as_LaTeX $amb $rulesD {*}$args
      ]] \n {\end{math}} \n\n
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \section{Examples}
% 
% These examples call |tk_getSaveFile| to get the name of the 
% database file to operate on. This is impractical in the 
% \Module{noTk} setting, where a suitable substitute instead is to 
% use the last command-line argument.
% \begin{tcl}
%<noTk>proc tk_getSaveFile {args} {lindex $::argv end}
% \end{tcl}
% 
% 
% \subsection{Frobenius algebra}
% 
% Given the axiom system that we have an algebra with a 
% non-degenerate form~\cite[p.~10]{Lauda}, what will be derived?
% 
% \begin{tcl}
%<*Frobenius>
set vertex_appearances {
   m {
      {oval {square 8} {}} 
      {{0 8}}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
   unit {
      {oval {square 8} {}} 
      {{0 8}}
      {}
   }
   Delta {
      {oval {square 8} {}} 
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {{0 -8}}
   }
   epsilon {
      {oval {square 8} {}}
      {}
      {{0 -8}}
   }
   cap {
      {oval {square 8} {}}
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {}
   }
}
sqlite3_init [tk_getSaveFile -initialdir ~/tmp -initialfile Frobenius] {
  Delta {1 2}  epsilon {1 0}  cap {0 2}  m {2 1}  unit {0 1}
}
% \end{tcl}
% 
% 
% \subsubsection{Ordering}
% 
% \begin{proc}{Frobenius_cmpkey}
%   This procedure computes comparison keys that should be suitable 
%   for a Frobenious algebra, so it has the syntax
%   \begin{displaysyntax}
%     |Frobenius_cmpkey| \word{network}
%   \end{displaysyntax}
%   and returns the comparison key.
%   \begin{tcl}
proc Frobenius_cmpkey {NW} {
%   \end{tcl}
%   The first blocks is a basic count of vertices.
%   \begin{tcl}
   set res [list [llength [lindex $NW 0]]]
%   \end{tcl}
%   The next block consists of path counts, so essentially it is what 
%   one gets from evaluating the network in the biaffine \PROP. A 
%   slight twist is however that the signs are reversed, to make the 
%   symmetric term (with every input connected to every output) in the 
%   Frobenius identities the smallest of the three.
%   \begin{tcl}
   set pathMat [network::pure::list_paths_turning $NW]
   foreach row $pathMat {
      foreach cell $row {
         lappend res [expr {-[llength $cell]}]
      }
   }
%   \end{tcl}
%   The final block consists of weighted path counts, and could 
%   similarly be obtained by evaluating the network in the biaffine 
%   \PROP\ (with a slightly different assignment of values to 
%   vertices). Here, the weight of a path is doubled every time it 
%   goes through the right branch of a product, coproduct, or cap. 
%   This has the effect of orienting the associativity and 
%   coassociativity identities.
%   \begin{tcl}
   foreach row $pathMat {
      foreach cell $row {
         set sum 0
         foreach path $cell {
            set w 1
            foreach {tail annot head} $path {
               if {$head > 0} then {set w [expr {2*$w}]}
               if {$tail > 0} then {set w [expr {2*$w}]}
            }
            set sum [expr {$sum + $w}]
         }
         lappend res $sum
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{set_cmpcmds}
%   The comparison key command is |Frobenius_cmpkey| straight off.
%   \begin{tcl}
proc set_cmpcmds {} {
   variable RS
   set RS(cmpkeycmd) [list [namespace which Frobenius_cmpkey]]
%   \end{tcl}
%   The blocks list begins with two single-element blocks, but the 
%   lengths of the two final blocks depend on the network arity and 
%   coarity. An auxiliary lists of zeroes is constructed to simplify 
%   this.
%   \begin{tcl}
   set L {}
   foreach e [lindex $RS(si7e) 0 1 1] {lappend L 0}
   set RS(cmpblocks) {1}
   foreach e [lindex $RS(si7e) 0 0 2] {
      lappend RS(cmpblocks) {*}$L 0
   }
   lappend RS(cmpblocks) {*}$L 1
   lappend RS(cmpblocks) {*}[lrange $RS(cmpblocks) 1 end]
%   \end{tcl}
%   Finally, the comparison command is always |::tcl::mathop::-|, so 
%   |cmpcmds| is a list where all elements are this command.
%   \begin{tcl}
   set RS(cmpcmds) [lrepeat [llength $RS(cmpblocks)]\
     [list ::tcl::mathop::-]]
}
%   \end{tcl}
% \end{proc}
% 
% \subsubsection{Congruences}
% 
% No need to add the basic congruencies again if we're restarting a 
% completion.
% \begin{tcl}
database_counts
if {$Count(Aa)>0} then {return}
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% \begin{tcl}
enter_congruence -short "Left unit" {} 1 {unit . \n m} -1 {.}
enter_congruence -short "Right unit" {} 1 {. unit \n m} -1 {.}
enter_congruence -short "Associative" {} 1 {m . \n m} -1 {. m \n m}
enter_congruence -short "Left bend" {} 1 {. cap \n m . \n epsilon .} -1 {.}
enter_congruence -short "Right bend" {} 1 {cap . \n . m \n . epsilon} -1 {.}
%<*coproduct>
enter_congruence -short "Coproduct" {} 1 {Delta} -1 {cap . \n . m}
%</coproduct>
%</Frobenius>
% \end{tcl}
% 
% 
% 
% 
% 
% \subsection{Hopf algebra}
% 
% As ever, the motivating example.
% 
% \begin{tcl}
%<*Hopf,hopfbase>
set vertex_appearances {
   m {
      {oval {square 8} {}} 
      {{0 8}}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
   unit {
      {oval {square 8} {}} 
      {{0 8}}
      {}
   }
   Delta {
      {oval {square 8} {}} 
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {{0 -8}}
   }
   epsilon {
      {oval {square 8} {}}
      {}
      {{0 -8}}
   }
   S {
      {rectangle {square 8} {}} 
      {{0 8}}
      {{0 -8}}
   }
   twist {
      {oval {square 8} {}  line {square 5.657} {} \
        line {offsets {5.657 -5.657} {-5.657 5.657}} {}} 
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
   untwist {
      {oval {square 8} {}  line {offsets {0 -8} {0 8}} {} \
        line {offsets {-8 0} {8 0}} {}} 
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
   Re {
      {rectangle {square 8} {}
       text {offsets {0 0}} {-font {-size -10} -text R}} 
      {{0 8}}
      {}
   }
   Im {
      {rectangle {square 8} {}
       text {offsets {0 0}} {-font {-size -10} -text I}} 
      {{0 8}}
      {}
   }
%<*odd>
   odd {
      {polygon {offsets {0 8} {-9.238 -8} {9.238 -8}} {}} 
      {{0 8}}
      {{0 -8}}
   }
%</odd>
%<*division>
   div {
      {polygon {offsets {0 8} {8 -8} {0 -8} {-8 8}} \
        {-fill "" -outline black}}
      {{-4 8}}
      {{-3 -2 -2 -1} {5 -2 2 -1}}
   }
%</division>
   cup {
      {oval {square 8} {}}
      {}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
   cap {
      {oval {square 8} {}}
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {}
   }
   int {
      {rectangle {square 8} {}} 
      {}
      {{0 -8}}
   }
}
if {[llength $argv]==1} then {
   set fname [lindex $argv 0]
} else {
   set fname [tk_getSaveFile -initialdir ~/tmp -initialfile Hopfrules]
}
sqlite3_init $fname {
  Delta {1 2}  epsilon {1 0}  S {1 1}  m {2 1}  unit {0 1}
%<twist>  twist {2 2}
%<twist&untwist>  untwist {2 2}
%<cocomplex>  Re {0 1}  Im {0 1}
%<division>  div {2 1}
%<integral>  int {1 0}
}
% \end{tcl}
% 
% 
% \subsubsection{Ordering}
% 
% The ordering of choice is by evaluating the network in several 
% biaffine \PROPs, and taking the flat list of all the components of 
% these as the comparison key. This amounts to using a pullback to 
% the free \PROP\ of the order on the biaffine \PROP\ which it 
% inherits from the corresponding matrix \PROP, namely the cartesian 
% element-wise comparison. Several such orders are then 
% lexicographically composed.
% 
% \begin{proc}{flatten_biaffine}
%   This procedure returns a flat list of components from a biaffine 
%   \PROP\ element. The call syntax is
%   \begin{displaysyntax}
%     |flatten_biaffine| \word{PROP} \word{element}
%   \end{displaysyntax}
%   where the \word{PROP} is a command prefix supporting the |part| 
%   method of a |biaffine| \PROP, and \word{element} is an element of 
%   that \PROP. The return value is the flat list of components in 
%   that element.
%   \begin{tcl}
%</Hopf,hopfbase>
%<*Hopf,hopfbase,Transposition>
proc flatten_biaffine {prefix element} {
   set res [list [{*}$prefix part closed $element]]
   lappend res {*}[{*}$prefix part end $element]
   lappend res {*}[{*}$prefix part begin $element]
   foreach row [{*}$prefix part open $element] {lappend res {*}$row}
   return [lreverse $res]
}
%   \end{tcl}
%   The |lreverse| is to allow considering different parts 
%   separately, rather than all together.
% \end{proc}
% 
% \begin{proc}{semiflatten_biaffine}
%   This procedure returns a dictionary whose entries are flat lists 
%   of components from a biaffine \PROP\ element. The call syntax is
%   \begin{displaysyntax}
%     |semiflatten_biaffine| \word{PROP} \word{element}
%   \end{displaysyntax}
%   where the \word{PROP} is a command prefix supporting the |part| 
%   method of a |biaffine| \PROP, and \word{element} is an element of 
%   that \PROP. The return value has entries |A|, |b|, |c|, and |d|, 
%   each containing a flat list of the components from their respective 
%   part of the \word{element}.
%   \begin{tcl}
proc semiflatten_biaffine {prefix element} {
   set res [dict create]
   dict set res d [list [{*}$prefix part closed $element]]
   dict set res c [{*}$prefix part end $element]
   dict set res b [{*}$prefix part begin $element]
   foreach row [{*}$prefix part open $element] {
      dict lappend res A {*}$row
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{biaffine_PROP_key}
%   This procedure constructs a comparison key for networks that 
%   consists of all the components of one or several |biaffine| 
%   \PROP\ elements that arise by evaluating the network in some 
%   specified \PROP. The call syntax is
%   \begin{displaysyntax}
%     |biaffine_PROP_key| \word{maps} \word{network}
%   \end{displaysyntax}
%   where \word{network} is the network to compute a key for and 
%   \word{maps} is a list with the structure
%   \begin{displaysyntax}
%     \begin{regblock}[\regstar] \word{target \PROP} 
%     \word{seed dictionary} \word{flatten-cmd} \end{regblock}
%   \end{displaysyntax}
%   where \word{target \PROP} is a (v\,2.0) \PROP\ command prefix and 
%   \word{seed dictionary} maps vertex annotations to elements of 
%   this \PROP. This seed dictionary is extended to arbitrary 
%   networks by the universal property. The \word{flatten-cmd} is a 
%   command prefix which takes an element of the \word{target \PROP} 
%   as argument and returns a list of components to compare.
%   
%   \begin{tcl}
proc biaffine_PROP_key {maps NW} {
   set res {}
   foreach {PROP seed flatten} $maps {
      set call $PROP
      lappend call fuse [lindex $NW 0 0 2]
      foreach v [lrange [lindex $NW 0] 2 end] {
         lappend call [lindex $v 1]\
           [dict get $seed [lindex $v 0]] [lindex $v 2]
      }
      lappend call [lindex $NW 0 1 1]
      lappend res {*}[{*}$flatten [eval $call]]
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{tclcommand}{alias}{integer_biaffine_PROP}
%   The primary ordered \PROP\ used is the biaffine \PROP\ over the 
%   integers (primarily the natural numbers, to ensure DCC).
%   \begin{tcl}
interp alias {} integer_biaffine_PROP {}\
  mtmtcl::matprop::biaffine ::mtmtcl::rings::integers::all
%   \end{tcl}
% \end{tclcommand}
% 
% \begin{tclcommand}{alias}{realmatrix_biaffine_PROP}
%   The secondary ordered \PROP\ used is the biaffine \PROP\ over 
%   $\mathrm{M}_2(\mathbb{R})$, i.e., over real $2 \times 2$ 
%   matrices. Rational numbers (or even dyadic numbers) would work 
%   too, but I currently don't have an implementation of these.
%   \begin{tcl}
interp alias {} realmatrix_biaffine_PROP {}\
  mtmtcl::matprop::biaffine {
     ::mtmtcl::matprop::ring 2 ::mtmtcl::rings::float
  }
%   \end{tcl}
% \end{tclcommand}
% 
% \begin{proc}{list_select_flatten}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |list_select_flatten| \word{index-list} \word{prefix} 
%     \word{argument}
%   \end{displaysyntax}
%   It starts out making the call
%   \begin{displaysyntax}
%     \meta{prefix} \word{argument}
%   \end{displaysyntax}
%   which is expected to return a list $L$, whose elements are 
%   typically themselves lists to some nesting depth. The 
%   \word{index-list} is a list of indices into elements of $L$, and 
%   the overall return value is a flattened list of the results one 
%   gets when each element of the \word{index-list} has been applied 
%   to each element of $L$.
%   
%   The operation is a kind of unshuffling, since the outer loop is 
%   over the \word{index-list} and the inner loop is over $L$; the 
%   result has first all selections of one kind from $L$, then all 
%   selections of the second kind, then all selections of the third 
%   kind, etc.
%   \begin{tcl}
proc list_select_flatten {indexL prefix arg} {
   set L [{*}$prefix $arg]
   set res {}
   foreach index $indexL {
      foreach l $L {
         lappend res [lindex $l $index]
      }
   }
   return $res
}
%</Hopf,hopfbase,Transposition>
%<*Hopf,hopfbase>
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{set_cmpcmds}
%   The comparison keys command set up by this procedure consists of 
%   |biaffine_PROP_key| with a hardwired \word{maps} argument. By far 
%   the largest part of the following is spent constructing this 
%   \word{maps} argument (but it could in principle be cached since 
%   that does not depend on the arity or coarity of the network).
%   
%   \begin{tcl}
proc set_cmpcmds {} {
   variable RS
%   \end{tcl}
%   The first comparison level ignores |twist|s (treating them as 
%   permutations), but takes care of directing most rules in ordinary 
%   Hopf algebra as one would expect (save only those of 
%   associativity and coassociativity, since making a left--right 
%   distinction would mess things up for the rules stating that the 
%   antipode is an antihomomorphism).
%   \begin{tcl}
   set iPROPprefix [list integer_biaffine_PROP]
   dict set seed1 m\
     [integer_biaffine_PROP fromparts 0 1 {0 0} {{1 1}}]
   dict set seed1 unit\
     [integer_biaffine_PROP fromparts 0 1 {} {}]
   dict set seed1 Delta\
     [integer_biaffine_PROP fromparts 0 {0 0} 1 {{1} {1}}]
   dict set seed1 epsilon\
     [integer_biaffine_PROP fromparts 0 {} 1 {}]
   dict set seed1 S\
     [integer_biaffine_PROP fromparts 0 0 0 2]
   dict set seed1 twist\
     [integer_biaffine_PROP fromparts 0 {0 0} {0 0} {{0 1} {1 0}}]
   dict set seed1 untwist\
     [integer_biaffine_PROP fromparts 0 {0 0} {0 0} {{0 1} {1 0}}]
   dict set seed1 Re [dict get $seed1 unit]
   dict set seed1 Im [dict get $seed1 unit]
%<*division>
%   \end{tcl}
%   As a first stab at values for the |div| vertex, make it like the 
%   |m| vertex but triple every component. This is to make it 
%   strictly larger than a combination of |m| and |S|.
%   \begin{tcl}
   dict set seed1 div\
     [integer_biaffine_PROP fromparts 0 3 {0 0} {{3 3}}]
%</division>
%<*integral>
%   \end{tcl}
%   As a first stab at values for the |int| vertex, make it like the 
%   |epsilon| vertex but with a nonzero scalar part.
%   \changes{2.2}{2023/05/25}{Adding rules for an integral\slash 
%     measure operation. (LH)}
%   \begin{tcl}
   dict set seed1 int\
     [integer_biaffine_PROP fromparts 1 {} 1 {}]
%</integral>
   set map {}
   lappend map $iPROPprefix $seed1 [list flatten_biaffine $iPROPprefix]
%   \end{tcl}
%   The second comparison level is almost like the first, but 
%   puts an extra endpoint (beginpoint) in the right branch of |m| 
%   (|Delta|) to make the right-branching side of the 
%   (co)associativity axiom larger than the left-branching.
%   \begin{tcl}
   lappend map $iPROPprefix [
      dict replace $seed1 \
        m [integer_biaffine_PROP fromparts 0 1 {0 1} {{1 1}}] \
%<*division>
        div [integer_biaffine_PROP fromparts 0 3 {0 3} {{3 3}}] \
%</division>
        Delta [integer_biaffine_PROP fromparts 0 {0 1} 1 {{1} {1}}]
   ] [list flatten_biaffine $iPROPprefix]
   set blocks 2
%<*twist>
%   \end{tcl}
%   The third comparison level is about making the |twist| behave 
%   like a crossing in that it can be moved across a product or 
%   coproduct, from |m . \n twist| to |. twist \n twist . \n . m| 
%   (and similarly for all its mirror forms). This comparison is 
%   even trickier than that for the product--coproduct rule, and 
%   employs as esoteric an object as 
%   $\mathrm{Baff}(\mathbb{R}^{2 \times 2})$.
%   
%   The main problem encountered for this comparison is that a strand 
%   which used to pass through one |twist| now passes through two, so 
%   the coefficient for such a passage can be no greater than $1$. On 
%   the other hand, any coefficient less than $1$ seriously threatens 
%   to create an infinite descending chain, so we appear to be stuck 
%   at $1$ as far as the crossing directions are concerned. The 
%   presence of a |twist| is instead made noticable by putting an $E$ 
%   such that \(E^2=0\) as coefficient for the same-side branches of 
%   the |twist|; this has the effect of making the $E$ part of the 
%   coefficient of a path count how many crossings there were of this 
%   path. It is however necessary to let surrounding |m| and |Delta| 
%   bias this count, as we still want two crossings on the input side 
%   of |m| or output side of |Delta| respectively count as no more 
%   than one crossing on the other side of it.
%   
%   ---
%   
%   |untwist|s are treated just like |twist|s.
%   \begin{tcl}
   set rPROPprefix [list realmatrix_biaffine_PROP]
   lappend map $rPROPprefix
   set one  {{1.0  0.0} {0.0 1.0}}
   set zero {{0.0  0.0} {0.0 0.0}}
   set up   {{0.5  0.0} {0.0 1.0}}
   set twoup {{2.0  0.0} {0.0 1.0}}
   set down {{1.0  0.0} {0.0 0.5}}
   set E    {{0.0  1.0} {0.0 0.0}}
   dict set seed3 m [realmatrix_biaffine_PROP fromparts\
     $zero [list $one] [list $zero $zero] [list [list $up $up]]]
   dict set seed3 unit [realmatrix_biaffine_PROP fromparts\
     $zero [list $one] {} {}]
   dict set seed3 Delta [realmatrix_biaffine_PROP fromparts\
     $zero [list $zero $zero] [list $one]\
     [list [list $down] [list $down]]]
   dict set seed3 epsilon [realmatrix_biaffine_PROP fromparts\
     $zero {} [list $one] {}]
   dict set seed3 S [realmatrix_biaffine_PROP fromparts\
     $zero [list $zero] [list $zero] [list [list $twoup]]]
   dict set seed3 twist [realmatrix_biaffine_PROP fromparts\
     $zero [list $zero $zero] [list $zero $zero]\
     [list [list $E $one] [list $one $zero]]]
   dict set seed3 untwist [dict get $seed3 twist]
   lappend map $seed3 [list list_select_flatten {{0 0} {1 1} {0 1}}\
     [list flatten_biaffine $rPROPprefix]]
   incr blocks 3
   lappend map $rPROPprefix
   dict set seed3 twist [realmatrix_biaffine_PROP fromparts\
     $zero [list $zero $zero] [list $zero $zero]\
     [list [list $zero $one] [list $one $E]]]
   dict set seed3 untwist [dict get $seed3 twist]
   lappend map $seed3 [list list_select_flatten {{0 1}}\
     [list flatten_biaffine $rPROPprefix]]
   incr blocks
%   \end{tcl}
%   The fourth comparison level is about ordering the sides of the 
%   braiding equation\slash``Yang--Baxter equation'':
%   |. twist \n twist . \n . twist| is less than 
%   |twist . \n . twist \n twist .|. The difference comes out for the 
%   middle strand in this braid, as it goes first right and then left 
%   in the former case, but first left and then right in the latter.
%   \begin{tcl}
   dict set seed4 m\
     [integer_biaffine_PROP fromparts 0 0 {0 0} {{1 1}}]
   dict set seed4 unit\
     [integer_biaffine_PROP fromparts 0 1 {} {}]
   dict set seed4 Delta\
     [integer_biaffine_PROP fromparts 0 {0 0} 0 {{1} {1}}]
   dict set seed4 epsilon\
     [integer_biaffine_PROP fromparts 0 {} 1 {}]
   dict set seed4 S\
     [integer_biaffine_PROP fromparts 0 0 0 1]
   dict set seed4 twist\
     [integer_biaffine_PROP fromparts 0 {0 0} {1 0} {{0 2} {1 0}}]
   dict set seed4 untwist [dict get $seed4 twist]
   lappend map $iPROPprefix $seed4 [list flatten_biaffine $iPROPprefix]
   incr blocks
%</twist>
%   \end{tcl}
%   
%   Subsequent blocks in the \Module{cocomplex} setting needs to 
%   address differences between ordinary associative products. 
%   The first block has already imposed a degree order weighted by 
%   the antipode power (each antipode applied to a |Re| or |Im| 
%   doubles the degree). The third block achieves lexicographic 
%   ordering of products by making each |m| double what comes into 
%   it, and assigning higher weight to |Im| than to |Re|. A factor as 
%   high as $5$ is given to the antipode to penalise it (but this 
%   handling is not as clean as I'd like; maybe a proper 
%   lexicographic order requires a different underlying ring).
%   \begin{tcl}
%<*cocomplex>
   dict set seed3 m\
     [integer_biaffine_PROP fromparts 0 0 {0 0} {{2 2}}]
   dict set seed3 unit\
     [integer_biaffine_PROP fromparts 0 1 {} {}]
   dict set seed3 Delta\
     [integer_biaffine_PROP fromparts 0 {0 0} 0 {{1} {1}}]
   dict set seed3 epsilon\
     [integer_biaffine_PROP fromparts 0 {} 1 {}]
   dict set seed3 S\
     [integer_biaffine_PROP fromparts 0 0 0 5]
   dict set seed3 Re\
     [integer_biaffine_PROP fromparts 0 1 {} {}]
   dict set seed3 Im\
     [integer_biaffine_PROP fromparts 0 2 {} {}]
   lappend map $iPROPprefix $seed3 [list flatten_biaffine $iPROPprefix]
   incr blocks
%</cocomplex>
   set RS(cmpkeycmd) [list [namespace which biaffine_PROP_key] $map]
   set inputs [llength [lindex $RS(si7e) 0 1 1]]
   set outputs [llength [lindex $RS(si7e) 0 0 2]]
   set size [expr { (1+$outputs) * (1+$inputs) }]
   set L [list d]
   lappend L {*}[lrepeat $inputs c] {*}[lrepeat $outputs b]
   lappend L {*}[lrepeat [expr {$inputs*$outputs}] A]
   set RS(cmpclass) [lrepeat $blocks {*}$L]
   set RS(cmpcmds)\
     [lrepeat [expr {$blocks*$size}] [list ::tcl::mathop::-]]
   set RS(cmpblocks) [lrepeat $blocks {*}[
      if {$outputs && $inputs} then {
         list {*}[lrepeat [expr {$inputs*$outputs-1}] 0] 1
      }
   ] {*}[
      if {$outputs} then {
         list {*}[lrepeat [expr {$outputs-1}] 0] 1
      }
   ] {*}[
      if {$inputs} then {
         list {*}[lrepeat [expr {$inputs-1}] 0] 1
      }
   ] 1]
}
%</Hopf,hopfbase>
%   \end{tcl}
% \end{proc}
% 
% 
% \subsubsection{Congruences}
% 
% No need to add the basic congruencies again if we're restarting a 
% completion.
% \begin{tcl}
%<*Hopf>
database_counts
if {$Count(Aa)<=0} then {
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% \begin{tcl}
enter_congruence -short "Unit&counit" {} 1 {unit \n epsilon} -1 {}
%<*!division>
enter_congruence -short "Left unit" {} 1 {unit . \n m} -1 {.}
enter_congruence -short "Right unit" {} 1 {. unit \n m} -1 {.}
enter_congruence -short "Associative" {} 1 {m . \n m} -1 {. m \n m}
%</!division>
enter_congruence -short "Left counit" {} 1 {Delta \n epsilon .} -1 {.}
enter_congruence -short "Right counit" {} 1 {Delta \n . epsilon} -1 {.}
enter_congruence -short "Coassociative" {}\
  1 {Delta \n . Delta} -1 {Delta \n Delta .}
enter_congruence -short "Unit&coproduct" {}\
  1 {unit \n Delta} -1 {unit unit}
%<*!division>
enter_congruence -short "Product&counit" {}\
  1 {m \n epsilon} -1 {epsilon epsilon}
%<*!twist>
enter_congruence -short "Product&coproduct" {}\
  1 {m \n Delta} -1 {Delta Delta \n . X . \n m m}
%</!twist>
%<*twist>
enter_congruence -short "Product&coproduct with twist" {}\
  1 {m \n Delta} -1 {Delta Delta \n . twist . \n m m}
%</twist>
enter_congruence -short "Left formal inverse" {}\
  1 {Delta \n S . \n m} -1 {epsilon \n unit}
enter_congruence -short "Right formal inverse" {}\
  1 {Delta \n . S \n m} -1 {epsilon \n unit}
%</!division>
% \end{tcl}
% 
% The reference division-group axioms are (writing $e$ for the group 
% unit) that for all $x$, $y$, and $z$:
% \begin{align*}
%   x/x ={}& e \text{,}\\
%   x/e ={}& x \text{,}\\
%   (z/x) \big/ (y/x) ={}& z/y \text{.}
% \end{align*}
% Encoding those amounts to, in turn:
% \begin{tcl}
%<*division>
enter_congruence -short "Division by same" {}\
  1 {Delta \n div} -1 {epsilon \n unit}
enter_congruence -short "Division by unit" {}\
  1 {. unit \n div} -1 {.}
enter_congruence -short "Division of fractions" {}\
  1 {. . Delta \n . X . \n div div \n div} -1 {div epsilon}
% \end{tcl}
% In addition, it needs to be specified that |Delta| and |epsilon| 
% behaves like duplication and disposal with respect to |div| (just 
% as it normally would with respect to |m|). If anything goes really 
% wrong, it will probably be with respect to the latter of these two.
% \begin{tcl}
enter_congruence -short "Division&counit" {}\
  1 {div \n epsilon} -1 {epsilon epsilon}
%<*nonstandardcoproduct>
enter_congruence -short "Division&coproduct" {}\
  1 {div \n Delta} -1 {Delta Delta \n . X . \n div div}
%</nonstandardcoproduct>
%<*!nonstandardcoproduct>
enter_congruence -short "Division&coproduct" {}\
  1 {div \n Delta} -1 {Delta Delta \n . 2X1 \n div div}
%</!nonstandardcoproduct>
% \end{tcl}
% Finally, make |S| and |m| aliases for expressions that can be 
% written using |div| alone.
% \begin{tcl}
enter_congruence -short "Antipode from division" {}\
  1 {S} -1 {unit . \n div}
enter_congruence -short "Product from division" {}\
  1 {m} -1 {. S \n div}
%</division>
% \end{tcl}
%\begin{verbatim}
% enter_congruence -short "Division,antipode&product" {}\
%   1 {div} -1 {. S \n m}
%\end{verbatim}
% 
% The only identity given for the |untwist| is that it undoes 
% whatever |twist| does, on both sides.
% \begin{tcl}
%<*twist&untwist>
enter_congruence -short "Untwist below" {}\
  1 {twist \n untwist} -1 {. .}
enter_congruence -short "Untwist above" {}\
  1 {untwist \n twist} -1 {. .}
%</twist&untwist>
% \end{tcl}
% 
% The following are consequences of the above axioms, but adding them 
% can be useful for testing the program.
% \begin{tcl}
%<*twist>
%<*testequalities>
enter_congruence -short "Test equality" {}\
   1 {Delta . \n . twist \n . Delta . \n twist . . \n . m .}\
  -1 {. Delta \n twist . \n . Delta . \n . . twist \n . m .}
enter_congruence -short "Test equality" {}\
   1 {. Delta . \n twist . . \n . m . \n . twist \n m .}\
  -1 {. Delta . \n . . twist \n . m . \n twist . \n . m}
%</testequalities>
%</twist>
% \end{tcl}
% 
% The following is probably an axiom for a bialgebra with twist, but 
% I hope it is actually a nontrivial consequence of the other axioms 
% when there is an antipode.
% \begin{tcl}
%<*twist>
%<*moretwist>
enter_congruence -short "Product and twist" {}\
   1 {m . \n twist} -1 {. twist \n twist . \n . m}
%</moretwist>
%</twist>
% \end{tcl}
% 
% These are the properties of |Re| and |Im| in the trigonometric 
% coalgebra.
% \begin{tcl}
%<*cocomplex>
enter_congruence -short "Coproduct(Re)" {}\
   -1 {Re \n Delta} 1 {Re Re} -1 {Im Im}
enter_congruence -short "Counit(Re)" {}\
   -1 {Re \n epsilon} 1 {}
enter_congruence -short "Coproduct(Im)" {}\
   -1 {Im \n Delta} 1 {Im Re} 1 {Re Im}
enter_congruence -short "Counit(Im)" {}\
   -1 {Im \n epsilon}
%</cocomplex>
% \end{tcl}
% 
% These are the properties of an integral (left and right invariant 
% measure).
% \begin{tcl}
%<*integral>
enter_congruence -short "Left invariant" {}\
  1 {Delta \n . int} -1 {int \n unit}
enter_congruence -short "Right invariant" {}\
  1 {Delta \n int .} -1 {int \n unit}
%</integral>
% \end{tcl}
% 
% 
% It is for presentation purposes frequently convenient to first 
% convert the congruences to rules, before working generally.
% \begin{tcl}
%<*axiomsfirst&lazier&vsquare>
for {set n 0} {$n < $Count(Aa)} {incr n} {
   push_main_task force_next_ambiguity
}
%</axiomsfirst&lazier&vsquare>
% \end{tcl}
% 
% 
% This is the end of the |if| preventing reading the initial 
% congruences.
% \begin{tcl}
}
%</Hopf>
% \end{tcl}
% 
% 
% 
% \subsection{Hom-associative algebra}
% 
% An active research problem.
% 
% \begin{tcl}
%<*HomAss,WeakAss,HomLeib>
set vertex_appearances {
   m {
      {oval {square 8} {}} 
      {{0 8}}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
   a {
      {rectangle {square 8} {}} 
      {{0 8}}
      {{0 -8}}
   }
   b {
      {polygon {offsets {0 11} {11 0} {0 -11} {-11 0}} {}} 
      {{0 11}}
      {{0 -11}}
   }
   e1 {
      {rectangle {square 8} {}
       text {offsets {0 0}} {-font {-size -10} -text e1}} 
      {{0 8}}
      {}
   }
   e2 {
      {rectangle {square 8} {}
       text {offsets {0 0}} {-font {-size -10} -text e2}} 
      {{0 8}}
      {}
   }
   e3 {
      {rectangle {square 8} {}
       text {offsets {0 0}} {-font {-size -10} -text e3}} 
      {{0 8}}
      {}
   }
}
%</HomAss,WeakAss,HomLeib>
%<*WeakAss>
sqlite3_init [
   tk_getSaveFile -initialdir ~/tmp -initialfile WeakAss.db
] {
  m {2 1}  
}
%</WeakAss>
%<*HomAss,HomLeib>
sqlite3_init [
   tk_getSaveFile -initialdir ~/Documents/Artiklar/DL-git/Lund-2009\
     -initialfile HomAss.db
] {
  a {1 1}  m {2 1}  
%<constants>  e1 {0 1}  e2 {0 1}  e3 {0 1}
%<bihomass>  b {1 1}
}
% \end{tcl}
%
% 
% \begin{proc}{tree_NW_to_traditional_LaTeX}
%   This procedure converts a tree-like pure network to \LaTeX\ for a 
%   traditional formula with variables and functions. The call syntax 
%   is
%   \begin{displaysyntax}
%     |tree_NW_to_traditional_LaTeX| \word{network} \word{edge}
%   \end{displaysyntax}
%   where \word{edge} is the label of the root edge of the formula to 
%   return. The \word{edge} argument is because this procedure 
%   recursively calls itself, to produce operand subtrees.
%   
%   \begin{tcl}
proc tree_NW_to_traditional_LaTeX {G e} {
   if {[lindex $G 1 $e 2] == 1} then {
      return [lindex {
         x y z w v u t s r q p n m l k j i h g f d c b a
      } [lindex $G 1 $e 3]]
   }
   set res [dict get {
      m  {\mu}
      a  {\alpha}
      b  {\beta}
      e1 {e_1}
      e2 {e_2}
      e3 {e_3}
      S  {\alpha}
   } [lindex $G 0 [lindex $G 1 $e 2] 0]]
   set L {}
   foreach e1 [lindex $G 0 [lindex $G 1 $e 2] 2] {
      lappend L [tree_NW_to_traditional_LaTeX $G $e1]
   }
   if {[llength $L]} then {
      append res ( [join $L ", "] )
   }
   return $res
}
%   \end{tcl}
%   This implementation is rather quick-and-dirty, directly producing 
%   \LaTeX\ code. A more robust implementation (also capable of 
%   handling multiple terms and coefficients) would be to first 
%   generate OpenMath and then a presentation of that, but then we'd 
%   have more overhead with arranging the presentation.
% \end{proc}
% 
% 
% \subsubsection{Ordering}
% 
% For a change, let's try a (height-)lexicographic order.
% 
% \begin{proc}{NW_to_Polish}
%   This procedure takes a pure network, which is expected to be a 
%   tree, as argument and returns a pair
%   \begin{displaysyntax}
%     \word{input heights} \word{Polish list}
%   \end{displaysyntax}
%   of lists. The \word{input heights} list is indexed by input index 
%   and contains the heights of the individual inputs, i.e., the 
%   number of vertices between the output (root) and this input. The 
%   \word{Polish list} is the network in Polish notation; each element 
%   is either a vertex annotation or a natural number (denoting that 
%   input).
%   
%   This procedure tries to do something sensible also for networks 
%   that are not trees, but the validity of the results is of course 
%   uncertain in that case. For a forrest, the \word{Polish list} is 
%   the concatenation of the Polish lists one would get for each 
%   individual output. If there are cycles, then the network is 
%   treated as a DAG, and the height reported for an input is the 
%   height for the rightmost path to that input. Inputs for which no 
%   oriented path reaches an output will be missing from the 
%   \word{Polish list} and their entries in the \word{input heights} 
%   will be arbiitrary (edge labels, thus integers).
%   \begin{tcl}
proc NW_to_Polish {NW} {
   set htL [lindex $NW 0 1 1]
   set PL {}
   set stack {}
   foreach e [lreverse [lindex $NW 0 0 2]] {
      lappend stack [list $e 0]
   }
   while {[llength $stack]} {
      lassign [lindex $stack end] e h
      set stack [lreplace $stack [set stack end] end]
      set v [lindex $NW 1 $e 2]
      if {$v > 1} then {
         lappend PL [lindex $NW 0 $v 0]
         incr h
         foreach e [lreverse [lindex $NW 0 $v 2]] {
            lappend stack [list $e $h]
         }
      } else {
         lappend PL [lindex $NW 1 $e 3]
         lset htL [lindex $PL end] $h
      }
   }
   return [list $htL $PL]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{heightlex_cmpkey}
%   This procedure computes a height-lexicographic comparison key. 
%   The call syntax is
%   \begin{displaysyntax}
%     |heightlex_cmpkey| \word{map} \word{input} \word{network}
%   \end{displaysyntax}
%   where the \word{map} maps vertex annotations to individual 
%   characters, for comparison using |string compare|, and 
%   \word{input} is the character used for inputs.
%   
%   The key computed has the structure
%   \begin{quote}
%     \meta{heights} \meta{inputs} \word{Polish}
%   \end{quote}
%   where the \meta{heights} is one element for each input and gives 
%   the height of that input, \word{Polish} is the left-Polish 
%   encoding as directed by the \word{map} and \word{input} of the 
%   \word{network}, and the \meta{inputs} the actual input numbers, 
%   in the order that they ``should'' appear in the \word{Polish}.
%   each input 
%   \begin{tcl}
proc heightlex_cmpkey {map input NW} {
   lassign [NW_to_Polish $NW] res PL
   set str ""
   foreach item $PL {
      if {[dict exists $map $item]} then {
         append str [dict get $map $item]
      } else {
         append str $input
         lappend res $item
      }
   }
   lappend res $str
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{set_cmpcmds}
%   This procedure sets everything up for a height-lexicographic 
%   comparison, where input\({}< \mathsf{m} < \mathsf{a}\). The first 
%   two blocks are needed to make the comparison compatible with 
%   composition, but neither should ever see any difference for 
%   congruences derivable from the hom-associativity axiom. The 
%   second block effectively compares two permutations for equality; 
%   it can never arrive at |<| or |>|.
%   \begin{tcl}
proc set_cmpcmds {} {
   variable RS
   set RS(cmpkeycmd) [list [namespace which heightlex_cmpkey] {
      m M  a a
%<bihomass>      b b
   } .]
   set inputs [llength [lindex $RS(si7e) 0 1 1]]
   set RS(cmpcmds) [lrepeat $inputs [list ::tcl::mathop::-]]
   set RS(cmpblocks) [lrepeat $inputs 0]
   if {$inputs} then {lset RS(cmpblocks) end 1}
   lappend RS(cmpcmds) {*}$RS(cmpcmds) [list ::string compare]
   lappend RS(cmpblocks) {*}$RS(cmpblocks) 1
   set RS(cmpclass) [lrepeat [llength $RS(cmpblocks)] _]
}
%   \end{tcl}
% \end{proc}
% 
% 
% Since a major limitation of the above is that there can be 
% absolutely no permutation of inputs, an alternative approach that 
% at least sometimes allows permutations would be useful. The idea 
% for the following is to do a breadth first scan of the network, 
% starting from the output side (i.e.~root, in the case of a tree), 
% and comparing the resulting sequences of annotations 
% lexicographically. Inputs also appear as items in these sequences, 
% but an input must be considered as uncomparable to everything but 
% itself, since anything can be substituted for an input; this is 
% sufficient for making the order a \PROP\ partial order.
% 
% The tricky things for these orders is how one implements the 
% comparison. Since the number of items in the sequences is 
% \emph{not} known from the network arity (and coarity), one cannot 
% make each item a separate element of the comparison key\Dash 
% instead one must have key items which are lists compared 
% lexicographically.
% 
% \begin{proc}{lexcompare_lists}
%   The |lexcompare_lists| procedure takes two lists (which may be of 
%   unequal length) and compares them lexicographically, returning 
%   one of |-1|, |0|, and |1|. The call syntax is
%   \begin{displaysyntax}
%     |lexcompare_lists| \word{left} \word{right}
%   \end{displaysyntax}
%   List items are compared using |expr|'s |!=| and |<|.
%   \begin{tcl}
proc lexcompare_lists {left right} {
   foreach l $left r $right {
      if {$l != $r} then {
         return [expr {$l < $r ? -1 : 1}]
      }
   }
   return 0
}
%   \end{tcl}
% \end{proc}
% 
% Doing the comparison that way introduces another complication, 
% however: an elementary comparison must be total, whereas the target 
% \PROP\ order must be partial! The way out of this is to make a 
% comparison group of two key items, and make sure that incomparable 
% sequence items have opposite key orders.
% 
% \begin{proc}{BFS_scan_keypair}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |BFS_scan_keypair| \word{mapdict} \word{network}
%   \end{displaysyntax}
%   and returns a pair that is meant to be contributed to a 
%   comparison key (as two key items). The elements of this pair are 
%   lists themselves, which are constructed by scanning the 
%   \word{network} in breadth first order. Inputs of the network are 
%   represented by their index in the first pair element and by the 
%   negative of their index in the second pair element. What a vertex 
%   is represented by is determined by the \word{mapdict}, which maps 
%   vertex annotations to pairs where the first element is used in 
%   the left result component and the second element is used in the 
%   right result element; normally, the first should be a negative 
%   number and the second a positive number.
%   
%   \begin{tcl}
proc BFS_scan_keypair {mapD NW} {
   set scan0 {}
   set scan1 {}
   set queue [lindex $NW 0 0 2]
   for {set qp 0} {$qp < [llength $queue]} {incr qp} {
      set edge [lindex $NW 1 [lindex $queue $qp]]
      set v [lindex $edge 2]
      if {$v < 2} then {
         lappend scan0 [lindex $edge 3]
         lappend scan1 [expr {-[lindex $edge 3]}]
      } else {
         foreach var {scan0 scan1} \
                 val [dict get $mapD [lindex $NW 0 $v 0]] {
            lappend $var $val
         }
         lappend queue {*}[lindex $NW 0 $v 2]
      }
   }
   return [list $scan0 $scan1]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{set_cmpcmds}
%   This procedure sets everything up for a BFS-lexicographic 
%   comparison, where \(\mathsf{m} < \mathsf{a}\). Note that it is 
%   fixed.
%   \begin{tcl}
%<*HomLeib>
proc set_cmpcmds {} {
   variable RS
   set RS(cmpkeycmd) [list [namespace which BFS_scan_keypair] {
      m {-2 1}  a {-1 2}
   }]
   set RS(cmpcmds) [lrepeat 2 [namespace which lexcompare_lists]]
   set RS(cmpblocks) {0 1}
   set RS(cmpclass) {+ -}
}
%</HomLeib>
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \subsubsection{Congruences}
% 
% No need to add the basic congruencies again if we're restarting a 
% completion.
% \begin{tcl}
database_counts
if {$Count(Aa)>0} then {return}
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% \begin{tcl}
%<*HomAss&!bihomass>
enter_congruence -short "Hom-associative" {} 1 {m a \n m} -1 {a m \n m}
%</HomAss&!bihomass>
%<*HomAss&bihomass>
enter_congruence -short "Bi-Hom-associative" {} 1 {m b \n m} -1 {a m \n m}
%</HomAss&bihomass>
%<*HomLeib>
enter_congruence -short "Hom-Leibniz" {}\
  1 {a m \n m} -1 {m a \n m} 1 {. X \n m a \n m}
%</HomLeib>
%<*aishom>
enter_congruence -short "Hom-associative" {} 1 {m \n a} -1 {a a \n m}
%<*bihomass>
enter_congruence -short "BiHom-associative" {} 1 {m \n b} -1 {b b \n m}
enter_congruence -short "Homs commute" {} 1 {a \n b} -1 {b \n a}
%</bihomass>
%</aishom>
%</HomAss,HomLeib>
% \end{tcl}
% 
% \subsubsection{Tricks with trees}
% 
% For sets of tree-like networks, it may be useful to have 
% descriptions as tree languages of the reducible and irreducible 
% networks respectively. The following routines make it easy to 
% compute that.
% 
% \begin{proc}{top_down_contains}
%   This procedure computes a grammar for the language of trees which 
%   contain at least one subtree occurring in the given list of trees.
%   
%   The resulting grammar is a list indexed by state number 
%   (nonterminal number), whose elements are themselves the possible 
%   \emph{productions} for this state. A production is a list
%   \begin{displaysyntax}
%     \word{annotation} \word{state}\regstar
%   \end{displaysyntax}
%   where the \word{annotation} is the annotation from the 
%   corresponding network vertex, and there are as many \word{state}s 
%   as that vertex has inputs. The initial state for this language is 
%   |0|, and the final state is |1|. \textbf{Note} that the language 
%   of all trees cannot be expressed on that form, so an error is 
%   thrown if an order $0$ network is given as input. All other tree 
%   languages are handled correctly.
%   
%   The call syntax is
%   \begin{displaysyntax}
%     |top_down_contains| \word{signature} \word{network}\regstar
%   \end{displaysyntax}
%   where the \word{signature} is needed to initialise the 
%   productions for states |0| and |1|. It is often possible to infer 
%   it from the \word{network}s, but it is cleaner to supply it 
%   explicitly. 
%   
%   Most states only have one production (this is not a minimal 
%   automaton), but |1| has a separate production for every 
%   annotation (regardless of annotation, every input gets state |1| 
%   too), and |0| gains a new production for every \word{network}. 
%   Therefore the productions for state |0| are collected in the list 
%   |P0|, and only at the end inserted into the main result.
%   \begin{tcl}
%<*HomAss,WeakAss>
proc top_down_contains {signature args} {
   set P0 {}
   set P1 {}
   dict for {symbol type} $signature {
      set oneprod [linsert [lrepeat [lindex $type 0] 1] 0 $symbol]
      lappend P1 $oneprod
      for {set n 1} {$n <= [lindex $type 0]} {incr n} {
         lappend P0 [lreplace $oneprod $n $n 0]
      }
   }
   set res [list {} $P1]
   foreach NW $args {
     if {[llength [lindex $NW 0]] <= 2} then {
        error "Answer is language of all trees; cannot express that\
          though"
     }
%   \end{tcl}
%   The idea for converting a network is to first assign a state 
%   number \texttt{S($e$)} to each edge, and then loop over all edges 
%   again to construct the productions.
%   \begin{tcl}
      array unset S
      set next [llength $res]
      set n -1; foreach e [lindex $NW 1] {incr n
         if {[lindex $e 2] == 1} then {
            set S($n) 1
         } elseif {[lindex $e 0] == 0} then {
            set S($n) 0
         } else {
            set S($n) $next
            incr next
         }
      }
      set n -1; foreach e [lindex $NW 1] {incr n
         if {$S($n) == 1} then {continue}
         set v [lindex $NW 0 [lindex $e 2]]
         set prod [lrange $v 0 0]
         foreach i [lindex $v 2] {lappend prod $S($i)}
         if {$S($n) == 0} then {
            lappend P0 $prod
         } else {
            lappend res [list $prod]
         }
      }
   }
   lset res 0 $P0
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% 
% 
% \begin{proc}{bottom_up_DFA}
%   This procedure applies the subset construction (for tree finite 
%   automata) to convert a top-down nondeterministic automaton to a 
%   bottom-up deterministic automaton. The call syntax is
%   \begin{displaysyntax}
%     |bottom_up_DFA| \word{signature} \word{grammar} 
%     \word{bottom-list}
%   \end{displaysyntax}
%   where the \word{bottom-list} should usually be just |1|; it is 
%   the list of states allowed at inputs of the corresponding trees. 
%   
%   The return value is a pair
%   \begin{displaysyntax}
%     \word{states} \word{operations}
%   \end{displaysyntax}
%   which together define the automaton (as a 
%   \word{signature}-algebra): \word{states} is the list of states 
%   (carrier set of the algebra) and \word{operations} are the tables 
%   of the operations. The states are going to be ordered (|lsort\
%   -integer|) lists of states in the input NFA \word{grammar}. The 
%   \word{operations} is a nested dictionary, where the primary key 
%   is a symbol name (annotation) and subsequent keys are states; an 
%   $n$-ary symbol is followed by $n$ levels of state keys! The final 
%   entries in the \word{operations} nested dictionary are the states 
%   which this operation assumes for the given arguments.
%   
%   \begin{tcl}
proc bottom_up_DFA {signature grammar bottom} {
   set bottom [lsort -integer -unique $bottom]
   set states [list $bottom]
   set stateTab($bottom) $bottom
   set operations [dict create]
   for {set nextstate 0} {$nextstate < [llength $states]}\
     {incr nextstate} {
      dict for {symbol type} $signature {
         Cartesian_foreach_delta stateL\
           [lreplace $states $nextstate end] [lindex $states $nextstate]\
           [lindex $type 0] {
            set L {}
            set i -1; foreach prodL $grammar {incr i
               foreach prod $prodL {
                  if {$symbol eq [lindex $prod 0]} then {
                     set ok 1
                     foreach arg [lrange $prod 1 end] state $stateL {
                        if {$arg ni $state} then {
                           set ok 0
                           break
                        }
                     }
                     if {$ok} then {
                        lappend L $i
                        break
                     }
                  }
               }
            }
%   \end{tcl}
%   The primary purpose of the following is to take note of new 
%   states that are created, so that they can be added to the 
%   |states| list. A secondary purpose is to make sure the same 
%   Tcl\_Obj is used for all |operations| entries with a particular 
%   state; this should help to conserve at least some memory 
%   (although the dictionary keys will use up more memory than the 
%   keys in this case).
%   \begin{tcl}
            if {![info exists stateTab($L)]} then {
               lappend states $L
               set stateTab($L) $L
            }
            dict set operations $symbol {*}$stateL $stateTab($L)
         }
      }
   }
   return [list $states $operations]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{Cartesian_foreach_delta}
%   This is a helper loop command for |bottom_up_DFA|. The idea is 
%   that the call
%   \begin{displaysyntax}
%     |Cartesian_foreach_delta| \word{variable} $X$ $y$ $n$ \word{body}
%   \end{displaysyntax}
%   is a loop where the \word{variable} ranges over the set
%   \[
%     \bigl( X \cup \{y\} \bigr)^n \setminus X^n \text{.}
%   \]
%   In the case that \(n=0\), the above is considered to be empty 
%   unless \(X = \varnothing\).
%   
%   Practically this is done by first constructing that set, and then 
%   |uplevel|ling a |foreach| over it.
%   \begin{tcl}
proc Cartesian_foreach_delta {var X y n body} {
   if {$n<1} then {
      if {![llength $X]} then {
         uplevel 1 [list ::foreach $var [list {}] $body]
      }
      return
   }
%   \end{tcl}
%   The main recursion used is\footnote{
%     If $\times$ is interpreted as doing \texttt{linsert} rather than 
%     \texttt{concat}.
%   }
%   \begin{align*}
%     X_0 ={}& \bigl\{ () \bigr\} \text{,}&
%     D_0 ={}& \varnothing\text{,}\\
%     X_{k+1} ={}& X_k \times X \text{,}&
%     D_{k+1} ={}& D_k \times \bigl( X \cup \{y\} \bigr) \cup
%       X_k \times \{y\} \text{.}
%   \end{align*}
%   The wanted result is $D_n$, but one should avoid computing $X_n$. 
%   Therefore the loop is slightly unrolled.
%   \begin{tcl}
   set Xk [list {}]
   set Dk [list]
   for {set k 1} {$k<$n} {incr k} {
      set Dk1 {}
      foreach L $Dk {
         foreach x $X {
            lappend Dk1 [linsert $L end $x]
         }
         lappend Dk1 [linsert $L end $y]
      }
      set Xk1 {}
      foreach L $Xk {
         foreach x $X {
            lappend Xk1 [linsert $L end $x]
         }
         lappend Dk1 [linsert $L end $y]
      }
      set Dk $Dk1
      set Xk $Xk1
   }
   set Dk1 {}
   foreach L $Dk {
      foreach x $X {
         lappend Dk1 [linsert $L end $x]
      }
      lappend Dk1 [linsert $L end $y]
   }
   foreach L $Xk {lappend Dk1 [linsert $L end $y]}
   uplevel 1 [list ::foreach $var $Dk1 $body]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{irreducible_eqsys}
%   This procedure converts a bottom-up DFA to a list of equations 
%   defining the OGF of the corresponding irreducible language. The 
%   call syntax is
%   \begin{displaysyntax}
%     |irreducible_eqsys| \word{signature} \word{states} 
%     \word{operations} \word{initials}\regopt
%   \end{displaysyntax}
%   where the last two arguments are as for |bottom_up_DFA|. The 
%   return value is a list of polynomials in Mathematica-notation, 
%   where there is one variable for each operation in the 
%   \word{signature}, one variable named |wanted|, and a bunch of 
%   variables names |s|\meta{n} for some integer $n$ (which is also 
%   the corresponding index into the \word{states} list).
%   
%   The equations are built up in the |Eq| array, which is indexed by 
%   left hand side name and whose entries are the lists of terms on 
%   the right hand side. The terms are in Mathematica format.
%   \begin{tcl}
proc irreducible_eqsys {signature states operations {initial 1}\
  {clean 1}} {
   set Eq(wanted) -wanted
   set n -1; foreach state $states {incr n
      set StateToVar($state) s$n
      if {0 ni $state} then {lappend Eq(wanted) s$n}
      lappend Eq(s$n) -s$n
   }
   lappend Eq($StateToVar($initial)) 1
   dict for {op table} $operations {
      set factors [list $op $table]
      for {set k 1} {$k<=[lindex [dict get $signature $op] 0]}\
        {incr k} {
         set factors2 {}
         foreach {factor subtable} $factors {
            dict for {state slice} $subtable {
               lappend factors2 $factor*$StateToVar($state) $slice
            }
         }
         set factors $factors2
      }
      foreach {factor state} $factors {
         lappend Eq($StateToVar($state)) $factor
      }
   }
   if {$clean} {
      foreach state $states {
         if {0 in $state} then {unset Eq($StateToVar($state))}
      }
   }
   set res {}
   foreach var [lsort -dictionary [array names Eq]] {
      lappend res [join $Eq($var) " + "]
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{irreducible_iterate}
%   This procedure converts a bottom-up DFA to a \Tcl\ script that 
%   can be used to compute truncations of the OGF of the corresponding 
%   irreducible language. The call syntax is
%   \begin{displaysyntax}
%     |irreducible_iterate| \word{signature} \word{states} 
%     \word{operations} \word{poly-ring} \word{prev}
%     \word{initial}\regopt\ \word{clean?}\regopt
%   \end{displaysyntax}
%   where the \word{states} and \word{operations} arguments are as 
%   returned by |bottom_up_DFA|. The \word{poly-ring} and \word{prev} 
%   arguments are fragments of \Tcl\ code (that may well employ 
%   e.g.~variable substitution or expansion) that will be used as 
%   follows:
%   \begin{itemize}
%     \item 
%       \meta{poly-ring} is a command prefix supporting the 
%       |ring|~(1.0), |monoid|~(1.0), |additive_group|~(1.1), and 
%       |named|~(1.0) interfaces; each operation in the 
%       \word{signature} must also be the name of a ring element.
%     \item
%       \meta{prev} is (evaluates to, under substitution) a list of 
%       elements in the \word{poly-ring}.
%   \end{itemize}
%   The result of evaluating the generated script will be a list that 
%   can be used as a new value of the \meta{prev}. More precisely, 
%   the return value will be a list
%   \begin{displaysyntax}
%     \word{next-script} \word{wanted-script}
%   \end{displaysyntax}
%   where the \word{next-script} evaluates to a new 
%   \word{prev}-vector, and the \word{wanted-script} evaluates to the 
%   sum of those \word{prev}-elements that do not correspond to 
%   states containing |0|.
%   
%   The \word{initial} is the initial state vector; it defaults to 
%   |1|. The \word{clean?} is a flag for whether elements 
%   corresponding to states containing |0| should be left out.
%   
%   The |Next| array is used for constructing scripts that compute 
%   the next value for a state; it is indexed by state name, and the 
%   script is obtained by |join|ing its elements. The |Get| array is 
%   also indexed by state and contains code that retrieves the 
%   \word{prev} value for that state---usually something like 
%   |[lindex |\meta{prev}| |$n$|]| for some integer $n$.
%   \begin{tcl}
proc irreducible_iterate {signature states operations ring prev\
  {initial 1} {clean 1}} {
   set wanted [list $ring +]
   set n 0
   foreach state $states {
      set Get($state) "\[lindex $prev $n\]"
      if {$clean && 0 in $state} then {continue}
      lappend wanted $Get($state)
      set Next($state) [list $ring +]
      incr n
   }
   lappend Next($initial) "\[$ring 1\]"
   dict for {op table} $operations {
      set factors [list "\[$ring named [list $op]\]" $table]
      for {set k 1} {$k<=[lindex [dict get $signature $op] 0]}\
        {incr k} {
         set factors2 {}
         foreach {factor subtable} $factors {
            dict for {state slice} $subtable {
               lappend factors2 "\[$ring * $factor $Get($state)\]" $slice
            }
         }
         set factors $factors2
      }
      foreach {factor state} $factors {
         lappend Next($state) $factor
      }
   }
   set L {}
   foreach state $states {
      if {$clean && 0 in $state} then {continue}
      lappend L [join $Next($state)]
   }
   set next "list \[\n   [join $L "\n\] \[\n  "]\n\]"
   return [list $next [join $wanted]]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{tcl}
interp alias {} Poly_ring {} ::mtmtcl::rings::semigroup_algebra {
   ::mtmtcl::rings::integers::all
} [list ::mtmtcl::groups::power_product_monoid_1.3 [
   list ::mtmtcl::sets::variable_set {a m} {}
]]
proc cull_vector {vector maxdeg} {
   set res {}
   foreach sum $vector {
      set new {}
      dict for {exps coeff} $sum {
         set degsum [tcl::mathop::+ {*}$exps]
         if {$degsum <= $maxdeg} then {
            lappend new [list $degsum $exps $coeff]
         }
      }
      set D [dict create]
      foreach term [
         lsort -index 0 -integer [lsort -index {1 0} -integer $new]
      ] {dict set D [lindex $term 1] [lindex $term 2]}
      lappend res $D
   }
   return $res
}
% \end{tcl}
% 
% Alternative approach, which uses a ``partial semigroup'' instead of 
% the full semigroup of power products. Products not in the partial 
% semigroup are signalled by a |continue| return, which has the 
% correct effect on the algebra |*| method.
% \begin{tcl}
proc truncated_power_products {varlist maxdeg method args} {
   switch -- $method * {
      set res [::mtmtcl::groups::power_product_monoid_1.3\
        [list ::mtmtcl::sets::variable_set $varlist {}] * {*}$args]
      if {[::tcl::mathop::+ {*}$res] <= $maxdeg} then {
         return $res
      } else {
         return -code continue
      }
   } default {
      tailcall ::mtmtcl::groups::power_product_monoid_1.3\
        [list ::mtmtcl::sets::variable_set $varlist {}]\
        $method {*}$args
   }
}
interp alias {} Poly_ring {} ::mtmtcl::rings::semigroup_algebra {
   ::mtmtcl::rings::integers::all
} [list ::truncated_power_products {a b m} 8]
%</HomAss,WeakAss>
% \end{tcl}
% 
% 
% \subsubsection{Characterising rules}
% 
% My distinct impression is that all the rules derived from the 
% hom-associative axiom have the form of a strongly hom-associative 
% axiom plus some extra padding, but is that empirically true? What 
% strong hom-associative axioms arise this way? (Hypothesis: all that 
% are on normal form.) And what does the padding look like?
% 
% \begin{proc}{classify_homass_rule}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |classify_homass_rule| \word{rule-dict}
%   \end{displaysyntax}
%   where the \word{rule-dict} \textsc{must} include the |lhs| and 
%   |rhs| entires. It returns a list classifying the rule, one of
%   \begin{displaysyntax}
%     strong-root-padded \word{strong core} \word{root padding}\par
%     strong-padded \word{strong core} \word{full lhs}\par
%     other
%   \end{displaysyntax}
%   where the \word{strong core} is the left hand side of the strong 
%   core of the rule, in Polish notation with |1| for any input. The 
%   \word{full lhs} is likewise in Polish notation. The 
%   \word{root padding} is in Polish notation, with |!| for the input 
%   where the \word{strong core} would be spliced in.
%   
%   First check that the right hand side has exactly one term.
%   \begin{tcl}
%<*HomAss>
proc classify_homass_rule {D} {
   if {[dict size [dict get $D rhs]] != 1} then {
      return other
   }
%   \end{tcl}
%   Next convert the networks to Polish notation, and locate the point 
%   where the two strings are different.
%   \begin{tcl}
   set NW2 [lindex [dict keys [dict get $D rhs]] 0]
   set equal 1
   set prefix ""
   set left ""
   set right ""
   foreach item1 [lindex [NW_to_Polish [dict get $D lhs]] 1] \
           item2 [lindex [NW_to_Polish $NW2] 1] {
      if {$item1 ne $item2} then {set equal 0}
      if {[regexp {^[0-9]+$} $item1]} then {set item1 1}
      if {[regexp {^[0-9]+$} $item2]} then {set item2 1}
      if {$equal} then {
         append prefix $item1
      } else {
         append left $item1
         append right $item2
      }
   }
%   \end{tcl}
%   We expect the |left| to begin with the |a| on the left side of a 
%   canyon, followed by the right side of the canyon and the matching 
%   |m| on the right side. Swapping those two operations should 
%   recreate the |right|, otherwise we are in an |other| case.
%   \begin{tcl}
   if {!([
      regexp {^a1([am]*)m11(.*)$} $left "" middle suffix
   ] && $right eq "m11${middle}a1${suffix}")} then {
      return other
   }
%   \end{tcl}
%   The next problem is to locate the |m| at the bottom of the 
%   canyon, which is part of the |prefix|. In the 
%   |strong-root-padded| case, that |m| is the last that is not 
%   followed by a |1|. Otherwise one can make it be such an |m| by 
%   removing any |m11| or |a1| from the string.
%   \begin{tcl}
   set snipped 0
   set p $prefix
   while {![regexp {m(m1|a)*$} $p l]} {
      set p [string map {m11 1 a1 1} $p]
      incr snipped
      if {$snipped > [string length $prefix]} then {
         error "This shouldn't happen!"
      }
   }
   set r [string map {a "" m 1} $middle]
   if {![string match "$r*" $suffix]} then {incr snipped}
   set core "${l}a1${middle}m11${r}"
   if {$snipped} then {
      return [list strong-padded $core ${prefix}${left}]
   } else {
      return [list strong-root-padded $core [
         string range $prefix 0 end-[string length $l]
      ]![
         string range $suffix [string length $r] end
      ]]
   }
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{homass_core_distribution}
%   This procedure returns a nested dictionary that groups rules 
%   according to their strong core. The primary key in that 
%   dictionary is the \word{strong core}, as returned by 
%   |classify_homass_rule|. The secondary key is the |num6er| of a 
%   rule with such a core. The value is one of
%   \begin{description}
%     \item[just]
%       if the strong rule is true in weakly hom-associative algebras,
%     \item[padded]
%       if the strong core needs to be padded to yield an identity of 
%       weakly hom-associative algebras,
%     \item[other]
%       if this rule does not fit the pattern for a strongly 
%       hom-associative axiom (this probably won't happen).
%   \end{description}
%   There are no arguments. This procedure reads the database 
%   directly, using commands in the |DBCMD| array.
%   
%   \begin{tcl}
proc homass_core_distribution {} {
   variable DBCMD
   set ruleL [$DBCMD(ActiveRu1e) allrows -as lists]
   set res {}
   foreach num $ruleL {
      set D [lindex [
         $DBCMD(GetRu1e) allrows [dict create num6er $num]
      ] 0]
      set type [classify_homass_rule $D]
      switch -- [lindex $type 0] strong-padded {
         dict set res [lindex $type 1] $num padded
      } strong-root-padded {
         if {[lindex $type 2] eq "!"} then {
            dict set res [lindex $type 1] $num just
         } else {
            dict set res [lindex $type 1] $num padded
         }
      } default {
         dict set res "" $num other
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{Polish_to_scan}
%   This procedure takes a Polish notation string for a plane tree 
%   (any digit is valid and just marks an input) and generates a 
%   corresponding list of scan-lines, almost as expected by 
%   |network::pure::construct| except that lines are separate list 
%   elements rather than ranges separated by newline elements.
%   
%   The scanlines are built in the array |L|, which is indexed by 
%   numeric level ($0$ being the bottom level). |prefixL| is what a 
%   new level should implicitly start out as, if it turns out to be 
%   needed; is consists of zero or more |.| elements, for inputs that 
%   have already been reached. The |stack| is the stack of levels.
%   \begin{tcl}
proc Polish_to_scan {str} {
   set L(0) {}
   set stack [list 0]
   set prefixL {}
   foreach ch [split $str ""] {
      switch -- $ch "a" - "b" - "m" {
         if {[lindex $stack end] >= [array size L]} then {
            set L([array size L]) $prefixL
         }
         set lvl [lindex $stack end]
         lappend L($lvl) $ch
         incr lvl
         set stack [lreplace $stack end end $lvl {*}[
            if {$ch eq "m"} then {list $lvl}
         ]]
      } default {
         lappend prefixL .
         for {set lvl [lindex $stack end]} {$lvl < [array size L]}\
           {incr lvl} {lappend L($lvl) .}
         set stack [lreplace $stack end end]
      }
   }
   return [lmap lvl [
      lsort -integer -decreasing [array names L]
   ] {set L($lvl)}]
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{coregroup_to_LaTeX}
%   This procedure has the call syntax
%   \begin{displaysyntax}
%     |coregroup_to_LaTeX| \word{channel} \word{core} 
%     \word{instance-dict} \begin{regblock}[\regstar] \word{option} 
%     \word{value} \end{regblock}
%   \end{displaysyntax}
%   It writes to the \word{channel} \LaTeX-code presenting a group of 
%   rules with common core \word{core} (list of scanlines). The numbers 
%   of the rules in that group are the keys in the 
%   \word{instance-dict}, and the values are as set by 
%   |homass_core_distribution|.
%   
%   The \LaTeX-code generated has the structure:
%   \begin{quote}
%     |\subsection{Signature |\dots|}|\\
%     |\[|\\
%     \meta{core rule lhs} |\to| \meta{core rule rhs}\\
%     |\]|\\
%     For each instance: the rule number, and the lhs with the core 
%     highlighted.
%   \end{quote}
%   
%   Data is taken from the database, and relies upon the |DBCMD| 
%   array being initialised.
%   
%   \begin{tcl}
proc coregroup_to_LaTeX {F core instancesD args} {
   array set O {-ruleslimit 100}
   array set O $args
   variable DBCMD
   set signature [string map {. "" { } "" ! " "} [
      join [lrange $core 1 end-1] !
   ]]
   if {$signature ne ""} then {
      puts $F "\\subsection{Signature \\texttt{$signature}}"
   }
   puts $F {\[}
   set NWL [network::pure::construct $DBCMD(signature)\
     [join $core { \n }]]
   puts $F [network_as_LaTeX $NWL {*}$args]
   puts $F {\to}
   set rcore $core
   lset rcore 0 [string map {"a m" "m a"} [lindex $rcore 0]]
   set NWR [network::pure::construct $DBCMD(signature)\
     [join $rcore { \n }]]
   puts $F [network_as_LaTeX $NWR {*}$args]
   puts $F {\]}
   if {[dict size $instancesD] == 0} then {
      puts $F {There are no rules with this core signature.}
      puts $F \n
      return
   } elseif {[dict size $instancesD] == 1 &&\
     [dict values $instancesD] eq "just"} then {
      puts $F "This is just rule [dict keys $instancesD],\
        valid in any hom-associative algebra."
      puts $F \n
      return
   }
   puts $F "This core has (so far) been found in\
     [dict size $instancesD] distinct rules.\n"
   set count 0
   foreach num [lsort -integer [dict keys $instancesD]] {
      puts $F "Rule $num:"
      set D [lindex [
         $DBCMD(GetRu1e) allrows [dict create num6er $num]
      ] 0]
      set NW [dict get $D lhs]
%   \end{tcl}
%   The following tweaks the presentation by putting each vertex on 
%   its lowest possible level (instead of that level wich would make 
%   the total length of all edges as short as possible, which is the 
%   default), since the level is an invariant in hom-associative 
%   algebras (without assuming the |a| operation is a homomorphism).
%   \begin{tcl}
      set minlevelL [lrepeat [llength [lindex $NW 0]] ""]
      set lvl 0
      foreach L [network::pure::minimal_grading $NW] {
         foreach item $L {
            if {[lindex $item 0] eq "vertex"} then {
               lset minlevelL [lindex $item 1] $lvl
            }
         }
         incr lvl
      }
      set whereL [network::wfb::instances [list $NW {}] [list $NWL {}]]
      if {![llength $whereL]} then {
         puts $F {\textbf{Confusion: Core not a subnetwork here!}}
      } else {
         puts $F {\begin{math}}
         puts $F [join [
            lmap region $whereL {
               network_as_LaTeX $NW {*}$args -region $region\
                 -levellist $minlevelL
            }
         ] {, }]
         puts $F {\end{math}.}
      }
      incr count
      if {$count >= $O(-ruleslimit)} then {
         puts $F "\nThat makes $count rules, which seems plenty."
         puts $F {Adjust the \texttt{-ruleslimit} if you want to see\
           more of them.}
         break
      }
      if {$count % 10 == 0} then {
         puts $F ""
      }
   }
   puts $F \n
}
%   \end{tcl}
% \end{proc}
% 
% 
% \begin{proc}{dump_coregroups_as_LaTeX}
%   This is a top-level command, which generates a full document 
%   presenting the rules in the database from a 
%   strong-coregroup-centric perspective. The call syntax is
%   \begin{displaysyntax}
%     |dump_coregroups_as_LaTeX| \word{target file name} 
%     \begin{regblock}[\regstar] \word{option} \word{value} 
%     \end{regblock}
%   \end{displaysyntax}
%   \begin{tcl}
proc dump_coregroups_as_LaTeX {filename args} {
   set coregroups [homass_core_distribution]
   set sortgroupL [lmap core [dict keys $coregroups] {
      if {$core eq ""} then {continue}
      set scan [Polish_to_scan $core]
      list [llength $scan] [string map {. "" { } ""} [join $scan ""]]\
        $scan $core
   }]
   set sortgroupL [lsort -index 0 -integer [lsort -index 1 $sortgroupL]]
   set F [open $filename w]
   puts $F {\documentclass{article}}
   puts $F {\usepackage{sdpgf}}
   puts $F {\begin{document}}
   puts $F {\tableofcontents}
   puts $F {\sloppy}
   set last 0
   foreach key $sortgroupL {
      if {[lindex $key 0] > $last} then {
         set last [lindex $key 0]
         puts $F "\\section{Height $last cores}"
      }
      coregroup_to_LaTeX $F [lindex $key 2]\
        [dict get $coregroups [lindex $key 3]] {*}$args
   }
   puts $F {\end{document}}
   close $F
}
%</HomAss>
%   \end{tcl}
% \end{proc}
% 
% 
% \subsubsection{Weak associative algebras}
% 
% On 2011-04-12, Pallo Jean asked a question on the rewriting mailing 
% list about the weak associative law. This is quite similar to the 
% above, so one might go ahead in the same way.
% 
% \begin{proc}{Leftass_cmpkey}
%   This procedure is a cut-down |Frobenius_cmpkey|, with only the 
%   final block left. It has the syntax
%   \begin{displaysyntax}
%     |Leftass_cmpkey| \word{network}
%   \end{displaysyntax}
%   and returns the comparison key.
%   \begin{tcl}
%<*WeakAss>
proc Leftass_cmpkey {NW} {
   set res {}
   set pathMat [network::pure::list_paths_turning $NW]
   foreach row $pathMat {
      foreach cell $row {
         set sum 0
         foreach path $cell {
            set w 1
            foreach {tail annot head} $path {
               if {$head > 0} then {set w [expr {2*$w}]}
               if {$tail > 0} then {set w [expr {2*$w}]}
            }
            set sum [expr {$sum + $w}]
         }
         lappend res $sum
      }
   }
   return $res
}
%   \end{tcl}
% \end{proc}
% 
% \begin{proc}{set_cmpcmds}
%   The comparison key command is |Leftass_cmpkey| straight off.
%   \begin{tcl}
proc set_cmpcmds {} {
   variable RS
   set RS(cmpkeycmd) [list [namespace which Leftass_cmpkey]]
   set L {}
   foreach e [lindex $RS(si7e) 0 1 1] {lappend L 0}
   set RS(cmpblocks) {}
   foreach e [lindex $RS(si7e) 0 0 2] {
      lappend RS(cmpblocks) {*}$L 0
   }
   lappend RS(cmpblocks) {*}$L 1
   set RS(cmpcmds) [lrepeat [llength $RS(cmpblocks)]\
     [list ::tcl::mathop::-]]
}
%   \end{tcl}
% \end{proc}
% 
% 
% No need to add the basic congruencies again if we're restarting a 
% completion.
% \begin{tcl}
database_counts
if {$Count(Aa)>0} then {return}
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% \begin{tcl}
enter_congruence -short "Weak associative" {}\
  1 {. m . \n . m \n m} -1 {m . . \n m . \n m}
%</WeakAss>
% \end{tcl}
% 
% 
% \subsubsection{Hom-associativity type II}
% 
% The following are meant to be used with \Module{hopfbase} for 
% ordering (rather than \Module{HomAss}), since the congruences added 
% are not height-homogeneous.
% 
% \begin{proc}{set_cmpcmds}
%   However, we still need to override |set_cmpcmds| itself, since 
%   the |biaffine_PROP_key| \word{maps} argument must be changed.
%   
%   \begin{tcl}
%<*HomAssTypeII>
proc set_cmpcmds {} {
   variable RS
%   \end{tcl}
%   Contrary to the main Hopf case, the first level ignores |S| but 
%   cares about left and right for multiplication.
%   \begin{tcl}
   set iPROPprefix [list integer_biaffine_PROP]
   dict set seed1 m\
     [integer_biaffine_PROP fromparts 0 1 {0 0} {{1 1}}]
   dict set seed1 unit\
     [integer_biaffine_PROP fromparts 0 1 {} {}]
   dict set seed1 Delta\
     [integer_biaffine_PROP fromparts 0 {0 1} 1 {{1} {1}}]
   dict set seed1 epsilon\
     [integer_biaffine_PROP fromparts 0 {} 1 {}]
   dict set seed1 S\
     [integer_biaffine_PROP fromparts 1 0 0 1]
   dict set seed1 twist\
     [integer_biaffine_PROP fromparts 0 {0 0} {0 0} {{0 1} {1 0}}]
   dict set seed1 untwist\
     [integer_biaffine_PROP fromparts 0 {0 0} {0 0} {{0 1} {1 0}}]
   dict set seed1 Re [dict get $seed1 unit]
   dict set seed1 Im [dict get $seed1 unit]
   set map {}
   lappend map $iPROPprefix $seed1 [list flatten_biaffine $iPROPprefix]
%   \end{tcl}
%   The second comparison level is almost like the first, but 
%   puts an extra endpoint (beginpoint) in the right branch of |m| 
%   (|Delta|) to make the right-branching side of the 
%   (co)associativity axiom larger than the left-branching.
%   \begin{tcl}
   lappend map $iPROPprefix [
      dict replace $seed1\
        S [integer_biaffine_PROP fromparts 0 0 0 1]\
        m [integer_biaffine_PROP fromparts 0 0 {0 1} {{1 1}}]
   ] [list flatten_biaffine $iPROPprefix]
   set blocks 2
   set RS(cmpkeycmd) [list [namespace which biaffine_PROP_key] $map]
   set inputs [llength [lindex $RS(si7e) 0 1 1]]
   set outputs [llength [lindex $RS(si7e) 0 0 2]]
   set size [expr { (1+$outputs) * (1+$inputs) }]
   set L [list d]
   lappend L {*}[lrepeat $inputs c] {*}[lrepeat $outputs b]
   lappend L {*}[lrepeat [expr {$inputs*$outputs}] A]
   set RS(cmpclass) [lrepeat $blocks {*}$L]
   set RS(cmpcmds)\
     [lrepeat [expr {$blocks*$size}] [list ::tcl::mathop::-]]
   set RS(cmpblocks)\
     [lrepeat $blocks {*}[lrepeat [expr {$size-1}] 0] 1]
}
%   \end{tcl}
% \end{proc}
% 
% No need to add the basic congruencies again if we're restarting a 
% completion.
% \begin{tcl}
database_counts
if {$Count(Aa)>0} then {return}
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% \begin{tcl}
enter_congruence -short "Type II hom-associative" {}\
  1 {. m \n . S \n m} -1 {m . \n S . \n m}
enter_congruence -short "Anti-homomorphism" {}\
  1 {S S \n m} -1 {1X1 \n m \n S}
enter_congruence -short "Involutive" {}\
  1 {S \n S} -1 {.}
%</HomAssTypeII>
% \end{tcl}
% 
% 
% 
% 
% 
% \subsection{Transposition}
% 
% An example considered by Samuel Mimram, Yves Lafont, and others.
% 
% \begin{tcl}
%<*Transposition>
set vertex_appearances {
   twist {
      {oval {square 8} {}  line {square 5.657} {} \
        line {offsets {5.657 -5.657} {-5.657 5.657}} {}} 
      {{-5.657 5.657 -1 1} {5.657 5.657 1 1}}
      {{-5.657 -5.657 -1 -1} {5.657 -5.657 1 -1}}
   }
}
sqlite3_init [
   tk_getSaveFile -initialdir ~/tmp\
     -initialfile transposition.db
] {twist {2 2}}
% \end{tcl}
% 
% \subsubsection{Ordering}
% 
% The ordering is basically the same as developed for Hopf algebra 
% with twist, but with the unnecessary parts removed.
% 
% \begin{proc}{set_cmpcmds}
%   The comparison keys command set up by this procedure consists of 
%   |biaffine_PROP_key| with a hardwired \word{maps} argument. By far 
%   the largest part of the following is spent constructing this 
%   \word{maps} argument (but it could in principle be cached since 
%   that does not depend on the arity or coarity of the network).
%   
%   \begin{tcl}
proc set_cmpcmds {} {
   variable RS
   set map {}
%   \end{tcl}
%   The first comparison level simply counts the total number of 
%   |twist|s, otherwise treating them as a permutation.
%   \begin{tcl}
   set iPROPprefix [list integer_biaffine_PROP]
   dict set seed1 twist\
     [integer_biaffine_PROP fromparts 1 {0 0} {0 0} {{0 1} {1 0}}]
   lappend map $iPROPprefix $seed1 [list flatten_biaffine $iPROPprefix]
   set blocks 1
%   \end{tcl}
%   The second comparison level was the fourth comparison level is 
%   about ordering the sides of the braiding equation\slash``Yang--Baxter 
%   equation'': |. twist \n twist . \n . twist| is less than 
%   |twist . \n . twist \n twist .|. The difference comes out for the 
%   middle strand in this braid, as it goes first right and then left 
%   in the former case, but first left and then right in the latter.
%   \begin{tcl}
   dict set seed4 twist\
     [integer_biaffine_PROP fromparts 0 {0 0} {1 0} {{0 2} {1 0}}]
   lappend map $iPROPprefix $seed4 [list flatten_biaffine $iPROPprefix]
   incr blocks
   set RS(cmpkeycmd) [list [namespace which biaffine_PROP_key] $map]
   set inputs [llength [lindex $RS(si7e) 0 1 1]]
   set outputs [llength [lindex $RS(si7e) 0 0 2]]
   set size [expr { (1+$outputs) * (1+$inputs) }]
   set L [list d]
   lappend L {*}[lrepeat $inputs c] {*}[lrepeat $outputs b]
   lappend L {*}[lrepeat [expr {$inputs*$outputs}] A]
   set RS(cmpclass) [lrepeat $blocks {*}$L]
   set RS(cmpcmds)\
     [lrepeat [expr {$blocks*$size}] [list ::tcl::mathop::-]]
   set RS(cmpblocks)\
     [lrepeat $blocks {*}[lrepeat [expr {$size-1}] 0] 1]
}
%   \end{tcl}
% \end{proc}
% 
% 
% \subsubsection{Congruences}
% 
% No need to add the basic congruencies again if we're restarting a 
% completion.
% \begin{tcl}
database_counts
if {$Count(Aa)>0} then {return}
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% \begin{tcl}
enter_congruence -short "Own inverse" {} 1 {twist \n twist} -1 {. .}
enter_congruence -short "Yang--Baxter" {}\
  1 {. twist \n twist . \n . twist} -1 {twist . \n . twist \n twist .}
% \end{tcl}
% 
% 
% 
% \begin{tcl}
%</Transposition>
% \end{tcl}
% 
% 
% \subsection{A braid representation}
% 
% The following (ab)uses the network completion machinery to make a 
% mere associative word completion. However, the problem originated 
% with one of ordering the above \Module{Transposition} relations, as 
% explained in more detail below.
% 
% 
% \subsubsection{Generators and order}
% 
% There are four generators $A$, $B$, $C$, and $D$, which correspond 
% to the four quadrants of the block matrix $\left[ 
% \begin{smallmatrix} A&B \\ C&D \end{smallmatrix} \right]$.
% 
% \begin{tcl}
%<*BraidMatrix>
set vertex_appearances {}
set signature {}
foreach x {A B C D} {
   dict set vertex_appearances $x [list [
      list rectangle {square 8} {} \
        text {offsets {0 0}} [dict create -font {-size -10} -text $x]
   ] {{0 8}} {{0 -8}}]
   dict set signature $x {1 1}
}
sqlite3_init [
   tk_getSaveFile -initialdir ~/tmp -initialfile braidmatrix.db
] $signature
% \end{tcl}
% 
% 
% \begin{proc}{set_cmpcmds}
%   The order will be a basic length-lexicographic order. 
%   \begin{tcl}
proc cmpkeycmd {NW} {
   lrange [
      network::pure::compkey_paths-wdeg-lex deglex {A A B B C C D D}\
        $NW
   ] 1 end
}
proc set_cmpcmds {} {
   variable RS
   if {[llength [lindex $RS(si7e) 0 1 1]] != 1 ||
       [llength [lindex $RS(si7e) 0 0 2]] != 1} then {
      error "Networks must (and should) be of type (1,1) in this setup"
   }
   set RS(cmpkeycmd) [namespace which cmpkeycmd]
   set RS(cmpblocks) {1 1}
   set RS(cmpcmds) [list ::tcl::mathop::- {string compare}] 
}
%   \end{tcl}
% \end{proc}
% 
% \begin{tcl}
database_counts
if {$Count(Aa)>0} then {return}
%<lazy>set am6iguity_top 30
% \end{tcl}
% 
% 
% \subsubsection{Congruences}
% 
% The congruences can be entered as a set of explicit equations, but 
% it is nicer to actually compute those equations from the components 
% of the Yang--Baxter equation when substituting the above block 
% matrix for the crossing. This requires constructing a free 
% associative algebra to use for the elements of such matrices.
% 
% \begin{tcl}
interp alias {} Z<A,B,C,D> {} \
  ::mtmtcl::rings::semigroup_algebra ::mtmtcl::rings::integers::all\
    ::mtmtcl::groups::string_free_monoid
interp alias {} matrix_PROP {} \
  ::mtmtcl::matprop::trivial dummy ::Z<A,B,C,D>
% \end{tcl}
% 
% Then |twist| will be the \PROP\ element $\left[ 
% \begin{smallmatrix} A&B \\ C&D \end{smallmatrix} \right]$. 
% |matrix_PROP| documents its value format rather than providing 
% generic value constructors. Similarly the |string_free_monoid| has 
% a documented value format.
% \begin{tcl}
set twist [list [
  list [Z<A,B,C,D> basiselement A] [Z<A,B,C,D> basiselement B]
] [
  list [Z<A,B,C,D> basiselement C] [Z<A,B,C,D> basiselement D]
]]
% \end{tcl}
% 
% The |lhs| and |rhs| are the two sides of the Yang--Baxter equation.
% \begin{tcl}
set nwse [matrix_PROP * [
   matrix_PROP tensor $twist [matrix_PROP permutation 0]
] [
   matrix_PROP tensor [matrix_PROP permutation 0] $twist
]]
set lhs [matrix_PROP * $nwse [
   matrix_PROP tensor $twist [matrix_PROP permutation 0]
]]
set rhs [matrix_PROP * [
   matrix_PROP tensor [matrix_PROP permutation 0] $twist
] $nwse]
set diff [matrix_PROP - $lhs $rhs]
% \end{tcl}
% 
% Now each element of the matrix |diff| gives rise to a congruence.
% \begin{tcl}
set i 0; foreach row $diff {incr i
   set j 0; foreach cell $row {incr j
      set call [list enter_congruence -short "Yang--Baxter ($i,$j)" {}]
      foreach mu [Z<A,B,C,D> support $cell] {
         lappend call [{*}$coefficient 1 [Z<A,B,C,D> coeff $mu $cell]]\
           [join [lreverse [split $mu ""]] { \n }]
      }
      eval $call
   }
}
% \end{tcl}
% And that's it!
% 
% \begin{tcl}
%</BraidMatrix>
% \end{tcl}
% 
% 
% \section{A GUI for generating problems}
% 
% Writing code for individual example problems is fine when 
% developing the utility, but it really doesn't scale well to usage 
% focused on examining a particular mathematical problem, not even 
% when the user is also the original program developer (because the 
% two modes of thinking are a bit too different)! Hence it makes 
% sense to offer a more convenient (even graphical) interface for 
% setting up problems.
% 
% 
% \subsection{The signature}
% 
% 
% 
% \subsection{Monomial ordering}
% 
% 
% 
% 
% \section*{Closing}
% 
% Wish starts an event loop and waits for the user to run the 
% completion main loop, but this is not an option in the 
% \Module{noTk} setting.
% \begin{tcl}
%<*noTk>
after 0 completion_main_loop
vwait forever
%</noTk>
% \end{tcl}
% 
% \begin{thebibliography}{9}
% 
% \bibitem{Lauda}
%   Aaron D. Lauda:
%   \textit{Frobenius algebras and planar open string topological 
%   field theories}, 2005.
%   arXiv:\texttt{math.QA/0508349v1}
% 
% \end{thebibliography}
% 
% 
\endinput