I need to create a function with two arguments f(s, l):
s is a list of three integer like:
s={1,-3,+5}
and l is a list of lists of naturals of same length:
l={{2,4,7,9,11,13,14},{8,11,15,19,21,23,24},{9,10,12,19,22,23,26},{12,14,17,19,24,28,30}}
s is transformed into the pure function #1-#3+#5& and the operation to do is:
#1-#3+#5&@@@l
l[[;;, Abs @ s]] . Sign @ s
{6, 14, 19, 19}
For fun:
☺ = #2[[;;, √(# #)]] . (√# √(1/#)) &;
☺[s,l]
{6, 14, 19, 19}
Remove@f
f[s_,l_]:= Evaluate@Total[Sign[s] Slot/@Abs@s]& @@@l
Evaluate[Total[Sign[s] Slot /@ Abs@s]] & @@@ l to obtain the same result as #1-#3+#5&@@@l.
$\endgroup$
Commented
Apr 2, 2023 at 18:13
Evaluate[Sign[s].Slot /@ Abs@s] & @@@ l
$\endgroup$
Commented
Apr 2, 2023 at 18:28
Another way using SparseArray and linear algebra.
s = {1, -3, +5};
l = {{2, 4, 7, 9, 11, 13, 14}, {8, 11, 15, 19, 21, 23, 24}, {9, 10, 12, 19, 22, 23, 26}, {12, 14, 17, 19, 24, 28, 30}};
f[s_, l_] := [email protected][Abs@s -> Sign@s // Thread, Dimensions[l][[2]]]
Normal@f[s, l]
{6, 14, 19, 19}
A slightly different approach (without using Apply)
f[s_List, l_List]:=Total[Sign[s] #[[Abs[s]]]&/@l,{2}]
f[s,l]
(* {6, 14, 19, 19} *)
Modify s and let Dot do the computation.
s2 = Normal@SparseArray[Thread[Abs@s -> Sign@s], Length@First@l];
l.s2 // RepeatedTiming
(* {4.7051429748535154` *^-7, {6,14,19,19}}*)
#1 - #3 + #5 & @@@ l // RepeatedTiming
(* {1.889423370361328` *^-6, {6,14,19,19}}*)
l[[;; , Abs@s]] . Sign@s // RepeatedTiming
(* {2.0671768188476562` *^-6, {6,14,19,19}}*)
It's slightly faster than the other answers. Aesthetically, I like the simple dot product.
lMax = RandomInteger[{1, Times @@ #}, #] &@{31, 37};
sMax = RandomChoice[{-1, 0, 0, 0, 1}, Length@First@lMax];
lMax.sMax // RepeatedTiming
(* {7.610435485839844` *^-7 , {-3202,-4288,-2123,-6777,-4301,-1779,-1781,-\
2826,-2023,-1972,-2624,-5320,-2773,-3360,-3533,-2929,-3197,-700,-2891,\
-5077,-3149,-2768,-2477,-508,-2841,-4150,-3876,-4284,-3164,-2091,-\
2712}}*)
ss = Flatten[Position[sMax,1|-1]*Sign@Cases[sMax,1|-1]];
lMax[[;; , Abs@ss]] . Sign@ss // RepeatedTiming
(* {1.4854793548583985` *^-6 , {-3202,-4288,-2123,-6777,-4301,-1779,-1781,\
-2826,-2023,-1972,-2624,-5320,-2773,-3360,-3533,-2929,-3197,-700,-\
2891,-5077,-3149,-2768,-2477,-508,-2841,-4150,-3876,-4284,-3164,-2091,\
-2712}}*)
edit:
I forgot that RandomInteger and RandomChoice return a packed array (Developer`PackedArrayQ), which speeds up the computation. Here are the times if it's not packed (name is Min rather than Max if it's not packed):
lMax.sMin -> 1.01245*10^-6
lMin.sMax -> 3.54877*10^-6
lMin.sMin -> 0.0000138674
lMax[[;;,Abs@ss]].Sign@ss -> 1.48547 *^-6
list = {
{2, 4, 7, 9, 11, 13, 14},
{8, 11, 15, 19, 21, 23, 24},
{9, 10, 12, 19, 22, 23, 26},
{12, 14, 17, 19, 24, 28, 30}};
s = {1, -3, 5};
Function @ Evaluate[Map[Slot, Abs[s]].Sign[s]] @@@ list
{6, 14, 19, 19}
