Robust pattern matching for functions obeying quadratic constraints

Question

I have a function, br, that takes multiple integer arguments (which for syntactic ease I collect in a list) and is

• Antisymmetric in any two arguments:

  br[l_List] :> Signature[l] br[Sort[l]]
  

• Obeys an algebraic relation:

   %%%%%TYPO br[{i_,j_,m___}]br[{k_,l_,m___}] -
   %%%%%TYPO br[{i_,k_,m___}]br[{j_,l_,m___}] -
   %%%%%TYPO br[{i_,l_,m___}]br[{j_,k_,m___}] :> 0
   br[{i_,j_,m___}]br[{p_,q_,m___}] -
   br[{p_,j_,m___}]br[{i_,q_,m___}] -
   br[{q_,j_,m___}]br[{p_,i_,m___}] :> 0
  

Perhaps abusively, I call this a "quadratic" constraint since each term is two "powers" of br (with different arguments).

Is there a good way to implement this second condition?

A sample expression that should reduce after two iterations of the second rule:

samp = (1/(br[{3, 6, 7}] br[{4, 6, 7}]))*
(
br[{2, 6, 7}] br[{3, 6, 7}] br[{4, 5, 6}] + 
br[{2, 6, 7}] br[{3, 4, 6}] br[{5, 6, 7}] + 
br[{2, 3, 6}] br[{4, 6, 7}] br[{5, 6, 7}]
);

The first condition is straightforward, but I have to by-hand define the second:

cleanBR =
{
br[l_List] :> Signature[l] br[Sort[l]]
,
br[{3, 6, 7}] br[{4, 5, 6}] :> 
br[{3, 6, 4}] br[{7, 5, 6}] + br[{3, 6, 5}] br[{7, 4, 6}]
,
br[{2, 6, 7}] br[{3, 5, 6}] :> 
br[{2, 6, 3}] br[{5, 7, 6}] + br[{2, 6, 5}] br[{7, 3, 6}]
};

Then:

FixedPoint[(# //. cleanBR // Simplify) &, samp]
(* br[{2,5,6}] *)

Is there a clever way to do the br[___]br[___]:>___ that I currently resort to? I'm open minded about this and have aside from pattern matching considered algebraic elimination and some kind of Simplify[samp,extraEquations_List] but nothing is very robust.

Edit

I had a typo in the original "quadratic" constraint. I've corrected it. The constraint is just one among determinants of matrices. If:

• br[l_List] takes Length[l] arguments and
• each integer argument of br is a vector of length Length[l] and
• br:=Det

then the constraint is satisfied. Demonstration for arbitraty l (by way of arbitrary mSeq):

mSeq = Sequence[m1, m2, m3, m4, m5, m6];
test = br[{i, j, mSeq}] br[{p, q, mSeq}] - 
       br[{p, j, mSeq}] br[{i, q, mSeq}] - 
       br[{q, j, mSeq}] br[{p, i, mSeq}];
test = test //. cleanBR;
lettersToVecs = (# -> RandomInteger[{1, 100}, Length[{mSeq}] + 2]) & /@ {i, j, p, q, mSeq};
(test //. lettersToVecs) //. br :> Det
(*0*)

Answer 1

I suppose there is some typo in your question, because in your reduction formula:

br[{i_,j_,m___}]br[{k_,l_,m___}] - br[{i_,k_,m___}]br[{j_,l_,m___}] - br[{i_,l_,m___}]br[{j_,k_,m___}] == 0

if we let l==j, and m be one element, we will have

br[{i_,j_,m_}]br[{k_,j_,m_}] - br[{i_,k_,m_}]br[{j_,j_,m_}] - br[{i_,j_,m_}]br[{j_,k_,m_}] == 0

Due to the antisymmetry of br, the second term is zero, and the third term is the negative number of the first term, then

br[{i_,j_,m_}]br[{k_,j_,m_}] + br[{i_,j_,m_}]br[{k_,j_,m_}] == 0

Obviously this is wrong. So there must be some typo in your original reduction equation.

Answer 2

You could automatically generate all rules replacing single br[{...}] expression with combination of other br[{...}] expressions according to your "quadratic" constraint.

brExpand // ClearAll
brExpand[list_, ijPos_, {k_, l_}] := Module[{i, j, m},
  {i, j} = Extract[list, ijPos];
  m = Sequence @@ Delete[list, ijPos];
  Signature@list Signature@{i, j, m} (br@{i, k, m} br@{j, l, m} + br@{i, l, m} br@{k, j, m}) / br@{k, l, m}
]

Union @@@ GroupBy[Cases[samp, br@l_ :> l, Infinity], Length]
Join @@ KeyValueMap[Tuples@{Subsets[Transpose@{Range@#1}, {2}], Subsets[#2, {2}]} &, %]
$rules = br@x_ /; Intersection[x, #2] === {} :> brExpand[x, #1, #2] & @@@ %

Those rules, together with "anti-symmetric rule", can be used in my replaceSimplify function:

replaceSimplify[samp, Append[$rules, br@l_ :> Signature@l br@Sort@l]]
(* br[{2, 5, 6}] *)

But this is a kind of "brute force" approach, so it'll take a lot of time on larger expressions.