Let A
and M
sets of numbers, with Length[A]=15
. I want to do something like
Pick[M, #+A[[1]] <= 1 & /@ M]
but, instead of testing only with $i=1$, testing with all $i\in\{1,...,15\}$. I can use Pick again and again (15 times in total) to achieve the result I want, but this is not a good idea. What can I do?
EDIT1: This is an example. Let $M=\{0,1,2,3,4,5\}$ and $A=\{-1,-2,-3,..., -15\}$. I want to get the subset $M'$ of $M$ formed by the elements $x\in M$ such that $x+y\leq 1$ for all $y\in A$, that is, $$M'= \{0,1,2\}.$$
The code have to work with any condition rather than summation, that is, it has to work with product for real number or the inner product for vectors, and so on. The problem here is that #+A[[i]]
test the condition "$\leq 1$" with only one element of A (the $i$-nth), and I want to test with all of them.
EDIT2: This is my true motivation. Let
M={{0, 0, 0, 1}, {-(1/2), -(1/2), 1/2, 1/2}, {-(1/2), -(1/2), -(1/2), 1/2}, {-(1/2), 1/2, 1/2, 1/2}, {1/2, 1/2, 1/2, 1/2}, {-(1/2), 1/2, -(1/2), 1/2}, {1/2, -(1/2), 1/2, 1/2}, {-1, 0, 0, 0}, {0, 0, 1,0}, {1/2, -(1/2), -(1/2), 1/2}, {1/2, 1/2, -(1/2), 1/2}, {0, -1, 0, 0}, {0, 1, 0, 0}, {0, 0, -1, 0}, {1, 0, 0, 0}, {-(1/2), -(1/2), -(1/2), -(1/2)}, {-(1/2), -(1/2), 1/2, -(1/2)}, {-(1/2), 1/2, 1/2, -(1/2)}, {1/2, 1/2, 1/2, -(1/2)}, {-(1/2), 1/2, -(1/2), -(1/2)}, {1/2, -(1/2), 1/2, -(1/2)}, {1/2, -(1/2), -(1/2), -(1/2)}, {1/2, 1/2, -(1/2), -(1/2)}, {0, 0, 0, -1}}
and
A={{1, 1, 1, 1}, {1, -1, 1, -1}, {-1, 1, -1, 1}, {-1, -1, -1, -1}, {1, 1, -1, -1}, {1, -1, -1, 1}, {-1, 1, 1, -1}, {-1, -1, 1, 1}}.
I aim to obtain as output the subset $$M'=\{v\in M~;~|\langle v,w \rangle|\leq 1, \forall~ w\in A\}.$$
With Pick[M, Abs[#.A[[1]]] <= 1 & /@ M]
I get the set $$M'_0=\{v\in M~;~|\langle v,w_1 \rangle|\leq 1\},$$ where w1=A[[1]]
. I could use Pick again like
Pick[Pick[M, #+A[[1]] <= 1 & /@ M],#+A[[2]] <= 1 & /@Pick[M, #+A[[1]] <= 1 & /@ M]]
and get $$M'_1=M'_0\cap\{v\in M~;~|\langle v,w_2 \rangle|\leq 1\},$$ where w2=A[[2]]
. I am looking for a smarter way to obtain $M'$.
I just realize that using Table[Select[M, # + A[[k]] <= 1 &], {k, Length[A]}]
and then Flatten
and then DeleteDuplicates
is not a solution. As above, we have to make intersections, and this is an union.
Pick[M, #] & /@ Outer[#1 + #2 <= 1 &, M, A]
$\endgroup$Pick[Pick[M, #+A[[1]] <= 1 & /@ M],#+A[[2]] <= 1 & /@Pick[M, #+A[[1]] <= 1 & /@ M]]
. I am new on Mathematica. Could you please elaborate your idea? $\endgroup$Pick[M, Or @@@ Outer[#1 + #2 <= 1 &, M, A]]
returns what you need? $\endgroup$Select[m, AllTrue[# + a, # <= 1 &] &]
$\endgroup$