2
$\begingroup$

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*)
$\endgroup$
2
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Thanks for pointing this out; I've updated accordingly. This includes an explanation and verification of the relation this time. $\endgroup$ – jjstankowicz Jan 24 '18 at 15:06
0
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.