6
$\begingroup$

The following is a condensed version of a lengthy expression. My objective is to eliminate nonlinear terms from an expression.

The vector containing the variables is:

veclst = {Subscript[A, 11], Subscript[A, 13], Subscript[A, 15]};

The reduced form of the expression is:

expr = a Subscript[A, 11] Subscript[A, 13] + b Subscript[A, 15] + 
c Subscript[A, 15] Subscript[A, 13] + d Subscript[A, 13]^2

My objective is to eliminate nonlinear terms in the expression (expression) in terms of the variables specified in veclst.

I appreciate your assistance in advance.

$\endgroup$

3 Answers 3

6
$\begingroup$

Try This:

Total[Map[If[Total[Exponent[#, veclst]] > 1, Nothing, #] &, MonomialList[expr]]]

(*b Subscript[A, 15]*)
$\endgroup$
6
$\begingroup$

Another way:

CoefficientArrays[expr, veclst][[2]] . veclst

The polynomial does not need to be multiplied out:

SeedRandom[0];
var = {x, y, z};
poly = (1 + var . RandomInteger[2, 3])^2 *
    (1 - var . RandomInteger[2, 3])^3;
CoefficientArrays[poly, var][[2]] . var

(*  4 x + 4 y - 4 z  *)

Yet another way:

SeriesCoefficient[poly /. Thread[var -> t*var], {t, 0, 1}]

(*  4 (x + y - z)  *)

To get the degree-1 terms and lower:

Either of these (the first is how the docs show to do it for higher degree, but deg ≤ 1 can be done with Apply):

Fold[#1 + #2 . veclst &, CoefficientArrays[expr, veclst][[;; 2]]]
(* OR *)
#1 + #2 . veclst & @@ CoefficientArrays[poly, veclst][[;; 2]]

And

SeedRandom[0];
var = {x, y, z};
poly = (1 + var . RandomInteger[2, 3])^2*(1 - 
      var . RandomInteger[2, 3])^3;
Fold[#1 + #2 . var &, CoefficientArrays[poly, var][[;; 2]]]
(* OR *)
#1 + #2 . var & @@ CoefficientArrays[poly, var][[;; 2]]

(*  1 + 4 x + 4 y - 4 z  *)

Yet another way:

Normal@Series[poly /. Thread[var -> t*var], {t, 0, 1}] /. t -> 1

(*  1 + 4 (x + y - z)  *)
$\endgroup$
4
  • $\begingroup$ Thanks @Michael for your solution. Your code exculdes constant terms that don't have any variable. $\endgroup$
    – qahtah
    Commented Apr 12, 2022 at 22:05
  • $\begingroup$ @qahtah Constant terms are not linear, at least in some contexts, and there are none in your example (or the other answers). If you want them, they can be included very easily: add CoefficientArrays[poly, var][[1]] to the rest. Let me know if you want it, and I'll add it to the code. $\endgroup$
    – Michael E2
    Commented Apr 12, 2022 at 22:24
  • $\begingroup$ Thanks @Michael Acutally what i needed was to remove higher order terms and keep lower order ones including the cosntant terms. $\endgroup$
    – qahtah
    Commented Apr 12, 2022 at 22:49
  • $\begingroup$ @qahtah OK, I added the codes for each method. $\endgroup$
    – Michael E2
    Commented Apr 12, 2022 at 22:56
6
$\begingroup$

Since

 Internal`LinearQ[5,x]

Gives false, (is this a bug or by design?) as per comment below, the following version accounts for such cases.

veclst = {Subscript[A, 11], Subscript[A, 13], Subscript[A, 15]};
expr = a Subscript[A, 11] Subscript[A, 13] + b Subscript[A, 15] + 
  c Subscript[A, 15] Subscript[A, 13] + d Subscript[A, 13]^2 + 5 + x;
List @@ expr

Mathematica graphics

And now do (*thanks to hints below for shorter code *)

sel = If[DisjointQ[Variables[#],veclst],True,Internal`LinearQ[#,veclst]] & /@List@@expr

Mathematica graphics

Then

Pick[expr, sel] (*shorter version thanks to Michael E2 *)

Mathematica graphics


Old answer

Another option is to use Internal`LinearQ

You can find the non-linear term using

sel = Internal`LinearQ[#, veclst] & /@ List @@ expr

Mathematica graphics

So only the 3rd term is linear. Now you can do

Total@Pick[List @@ expr, sel]

Mathematica graphics

$\endgroup$
8
  • 2
    $\begingroup$ Pick[expr, sel] is shorter. :) $\endgroup$
    – Michael E2
    Commented Apr 12, 2022 at 14:00
  • $\begingroup$ Thanks @MichaelE2 , yes better. $\endgroup$
    – Nasser
    Commented Apr 12, 2022 at 15:02
  • $\begingroup$ Thanks @Nasser. Your approach will remove constant terms that don't have any variable. $\endgroup$
    – qahtah
    Commented Apr 12, 2022 at 21:57
  • 1
    $\begingroup$ I believe Length[Intersection[Variables[#], veclst]] == 0 could also be shortened to DisjointQ[Variables[#], veclst]. $\endgroup$ Commented Apr 13, 2022 at 0:09
  • 1
    $\begingroup$ @NonDairyNeutrino Yes, thanks for hint. This is better. I'll update my answer with your improvement. I did not look for shorter code at time, just wanted something that worked :) $\endgroup$
    – Nasser
    Commented Apr 13, 2022 at 0:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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