1
$\begingroup$

I have two vectors p={p1,p2,...,pK} and q={q1,q2,...,qK} of size K. I would like to create a function which is dynamic in the sense that its definition depends on K because it uses all cross-terms (keeping one term constant) which can possibly be created with these two vectors.

As an example, for K=2 and keeping the term p1 constant, and assuming some other function g is already apropriately defined, I wish to create the following function fp1:

fp1:=p2*q1*q2*g[p2,q1,q2]
    +(1-p2)*q1*q2*g[1-p2,q1,q2]
    +p2*(1-q1)*q2*g[p2,1-q1,q2]
    +(1-p2)*(1-q1)*q2*g[1-p2,1-q1,q2]
    +p2*q1*(1-q2)*g[p2,q1,1-q2]
    +(1-p2)*q1*(1-q2)*g[1-p2,q1,1-q2]
    +p2*(1-q1)*(1-q2)*g[p2,1-q1,1-q2]
    +(1-p2)*(1-q1)*(1-q2)*g[1-p2,1-q1,1-q2]

Edit thanks to the comment by @march: I forgot to mention that each variable can have two values 0 and 1. In this example, since p1 is the "reference" (or "constant"), we get the 8 following cross products for the two values of p2, q1 and q2: {p2,1-p2}X{q1,1-q1}X{q2,1-q2}. For K=3, I would thus expect there to be the sum of 2^5 terms for the 5 variables {p2,p3,q1,q2,q3}.

How can I achieve these combinations for any K? How about if I want to create equivalent combinations but using three vectors p, q and r instead of the two above p and q?

I have not been able to get very far, but the following code defines my vectors in preparation of the cross products:

K=2;
pk=Table[p[k], {k, 2, K}];
qk=Table[q[k], {k, K}];

It also seems to me that Tuples might help, but I have not figured out how...

I am a Mathematica novice so do please do not hesitate to provide other approaches if mine seems incorrect or poor practice.

$\endgroup$
6
  • $\begingroup$ It's not clear to me what the general structure of the expression is supposed to be. One example is good, but maybe a second example or a more complete description of what you're looking for is necessary to understand what you're trying to do. For instance, it's not clear what "p1 is a constant" really means. Please edit your post to include this extra information. $\endgroup$
    – march
    Commented Jun 29, 2023 at 21:53
  • $\begingroup$ That said, does this work? Clear[p, q]; n = 2; ps = Array[p, n - 1, 2]; qs = Array[q, n]; elems = Subsets[Join[ps, qs, 1 - qs, 1 - ps], {2 n - 1}]; Times @@ # g @@ # & /@ elems // Total $\endgroup$
    – march
    Commented Jun 29, 2023 at 21:58
  • $\begingroup$ @march Thanks, I have edited the post to attempt to be more specific. I will try your suggestion as soon as I get back to my computer. $\endgroup$
    – tyogi
    Commented Jun 29, 2023 at 22:24
  • $\begingroup$ @march your suggested code does not work for my purposes: right off the bat, it seems to create more combinations, 20 in all, instead of the expected 8. Two problems I notice: 1. among those combinations are mixes of p2 and (1-p2), whereas it should be one or the other, and 2. the placement of arguments in g should be for (p2,q1,q2) in that order, whereas the order seems to have permutations as well. $\endgroup$
    – tyogi
    Commented Jun 30, 2023 at 0:46
  • 1
    $\begingroup$ What if you replaced the Subsets line with Tuples@Transpose[{Join[qs, ps], 1 - Join[qs, ps]}]? $\endgroup$
    – march
    Commented Jun 30, 2023 at 3:36

2 Answers 2

1
$\begingroup$

Try this:

fp1[p_, q_] := Module[{el = Join[p, q], t},
  t = Function[x, el /. Thread[x -> 1 - x]] /@ Subsets[el];
  (Times @@ # g @@ #) & /@ t
  ]

E.g. with K=2:

K = 2;
pk = Table[p[k], {k, 2, K}];
qk = Table[q[k], {k, K}];
fp1[pk, qk] // TableForm

enter image description here

Or a bit more complicated with K=3:

enter image description here

$\endgroup$
2
  • $\begingroup$ This works as specified (provided we use Total at the end), thanks! The line Function[x, el /. Thread[x -> 1 - x]] /@ Subsets[el] was a bit tough for me to understand but I think I got it :) $\endgroup$
    – tyogi
    Commented Jun 30, 2023 at 17:18
  • $\begingroup$ Thread[x -> 1 - x] creates a replacement rule that replaces all elements x in the subset by x and 1-x. This rule is then applied to el. $\endgroup$ Commented Jun 30, 2023 at 17:26
1
$\begingroup$

Here's my version from the comments, wrapped up in a function.

Clear[p, q, g]
fp1[n_] := Module[{ps = Array[p, n - 1, 2], qs = Array[q, n]},
             Times @@ # g @@ # & /@ Tuples@Transpose[{Join[qs, ps], 1 - Join[qs, ps]}] // Total
            ]
$\endgroup$

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.