1
$\begingroup$

I express multilinear functions in the following format. Is there any ready command to convert them to multilinear functions easily?

Input

posTerms = {2, 4, 9, 13, 19};
negTerms = {6, 11, 26};
IntegerString[posTerms, 2]
IntegerString[negTerms, 2]

{"10", "100", "1001", "1101", "10011"}
{"110", "1011", "11010"}

Intended Output

x_2+x_3+x_4*x_1+x_4*x_3*x_1+x_5*x_2*x_1-(x_3*x_2+x_4*x_2*x_1+x_5*x_4*x_2)

Intended Output in Mathematica

Subscript[p, 2]+Subscript[p, 3]+Subscript[p, 4]*Subscript[p, 1]+Subscript[p, 4]*Subscript[p, 3]*Subscript[p, 1]+Subscript[p, 5]*Subscript[p, 2]*Subscript[p, 1]

-Subscript[p, 3]*Subscript[p, 2]-Subscript[p, 4]*Subscript[p, 2]*Subscript[p, 1]-Subscript[p, 5]*Subscript[p, 4]*Subscript[p, 2]
$\endgroup$
3
$\begingroup$

How about

FromCoefficientRules[#, Subscript[x, #] & /@ Reverse@Range@Length@#[[1, 1]]] &@
    Thread[PadLeft@IntegerDigits[posTerms, 2] -> 1] - 
   FromCoefficientRules[#, Subscript[x, #] & /@ Reverse@Range@Length@#[[1, 1]]] &@
 Thread[PadLeft@IntegerDigits[negTerms, 2] -> 1]

enter image description here

As belisarius wrote in comment it can be reduced to

Subtract @@ (FromCoefficientRules[#, Subscript[x, #] & /@ Reverse@Range@Length@#[[1, 1]]] &@
     Thread[PadLeft@IntegerDigits[#, 2] -> 1] & /@ {posTerms, negTerms})

Also there is another short solution

Subtract @@ (Total[Times @@ MapIndexed[Subscript[x, #2[[1]]]^# &, Reverse[#]] & /@ 
   IntegerDigits[#, 2]] & /@ {posTerms, negTerms})

It is shorter than belisarius's solution by 13 characters :)

$\endgroup$
  • 1
    $\begingroup$ @hhh It is because I incorrectly aligned posTerms with negTerms. See my update, does it work now? $\endgroup$ – ybeltukov Nov 6 '13 at 22:56
  • $\begingroup$ I cannot fully understand this: suppose I specify the terms with {1,3,7} to mean p_1p_3p_7 -- is it easier to get the multilinear term from it? So here terms Subscript[x, #] & /@ {1, 3, 7} and now just multiplication. Where is the multiplication? $\endgroup$ – hhh Nov 10 '13 at 19:14
  • $\begingroup$ Moved the new q here. $\endgroup$ – hhh Nov 10 '13 at 19:23
2
$\begingroup$

Also

-Differences[Tr[Times @@@ (Position[Reverse@#, 1] & /@ # /. {n_Integer} -> 
                            Subscript[x, n])] & /@ (IntegerDigits[#, 2] & /@ {posTerms, negTerms})]

Mathematica graphics

Equivalent:

Subtract@@Tr/@ Map[Times @@ (Position[Reverse@#, 1] /. {n_Integer} -> 
                           Subscript[x, n]) &, (IntegerDigits[#, 2] & /@ {posTerms, negTerms}), {2}]
$\endgroup$
  • $\begingroup$ I like shorter +1. $\endgroup$ – hhh Nov 7 '13 at 0:21
  • 1
    $\begingroup$ @hhh So here you have a shorter version of ybeltukov's answer too Subtract @@ (FromCoefficientRules[#, Subscript[x, #] & /@ Reverse@Range@Length@#[[1, 1]]] &@ Thread[PadLeft@IntegerDigits[#, 2] -> 1] & /@ {posTerms, negTerms}) $\endgroup$ – Dr. belisarius Nov 7 '13 at 0:35

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.