Interleave 2 single dim lists into a list of lists - wolfram-mathematica

I have 2 lists, {1,2,3,4,5} and {a,b,c,d,e}. I want to end up with {{1,a},{2,b},{3,c},{4,d},{5,e}}.

How about this:
l1 = {1, 2, 3, 4, 5};
l2 = {a, b, c, d, e};
Partition[Riffle[l1, l2], 2]
{{1, a}, {2, b}, {3, c}, {4, d}, {5, e}}
Alternatively, you could try
l1 = {1, 2, 3, 4, 5};
l2 = {a, b, c, d, e};
Transpose[{l1, l2}]
{{1, a}, {2, b}, {3, c}, {4, d}, {5, e}}

Related

Combine two lists and one array to create a 3D data list

Suppose I have the following three lists:
x = {i, j};
y = {a, b, c};
z = {{1, 2, 3}, {4, 5, 6}};
Where z is the data corresponding to the x and y coordinates, z(x_i,y_j) = z_ij. I need to create an array of the following form:
zz = {{i, a, 1}, {i, b, 2}, {i, c, 3}, {j, a, 4}, {j, b, 5}, {j, c, 6}}
How can I do it efficiently in Mathematica 10.0?
This was my attempt so far:
zz = Table[{x[[ii]], y[[jj]], z[[ii, jj]]}, {ii, 1, Length[x]}, {jj, 1, Length[y]}]~Flatten~1
My ultimate goal is to plot (ListPlot3D[zz]) or interpolate this data (Interpolation[zz]), and x and y may be non-uniformly sampled.
Simplifying Bill's answer
x = {i, j};
y = {a, b, c};
z = {{1, 2, 3}, {4, 5, 6}};
MapThread[Append, {Flatten[Outer[List, x, y], 1], Flatten#z}]
{{i, a, 1}, {i, b, 2}, {i, c, 3}, {j, a, 4}, {j, b, 5}, {j, c, 6}}
Also
Transpose#Append[Transpose#Tuples#{x, y}, Flatten#z]
{{i, a, 1}, {i, b, 2}, {i, c, 3}, {j, a, 4}, {j, b, 5}, {j, c, 6}}
Perhaps
x = {i, j}; y = {a, b, c}; z = {{1, 2, 3}, {4, 5, 6}};
zz=MapThread[Flatten[List[#1,#2]] &, {Flatten[Outer[List,x,y],1], Flatten[z]}]
which returns
{{i, a, 1}, {i, b, 2}, {i, c, 3}, {j, a, 4}, {j, b, 5}, {j, c, 6}}
It seems like there should be a simpler way of doing this.
Join ## (Thread[{x[[#]], y, z[[#]]}, List] & /# {1, 2})
{{i, a, 1}, {i, b, 2}, {i, c, 3}, {j, a, 4}, {j, b, 5}, {j, c, 6}}

Variant on Cutting Stock in Mathematica

So I'm pretty new to Mathematica, and am trying to learn to solve problems in a functional way. The problem I was solving was to list the ways in which I could sum elements from a list (with repetitions), so the sum is leq to some value. The code below solves this just fine.
i = {7.25, 7.75, 15, 19, 22};
m = 22;
getSum[l_List, n_List] := Total[Thread[{l, n}] /. {x_, y_} -> x y];
t = Prepend[Map[Range[0, Floor[m/#]] &, i], List];
Outer ## %;
Flatten[%, ArrayDepth[%] - 2];
Map[{#, getSum[i, #]} &, %];
DeleteCases[%, {_, x_} /; x > m || x == 0];
TableForm[Flatten /# SortBy[%, Last], 0,
TableHeadings -> {None, Append[i, "Total"]}]
However, the code check a lot of unneccesary cases, which could be a problem if m is higher of the list is longer. My question is simply what would be the most Mathematica-esque way of solving this problem, concerning both efficiency and code elegancy.
One simple though not optimal way is :
sol = Reduce[Dot[i, {a, b, c, d, e}] <= m, {a, b, c, d, e}, Integers];
at first try with a smaller i, say i = {7.25, 7.75} to get a feeling about whether you can use this.
You can improve speed by providing upper limits for the coefficients, like in
sol = Reduce[And ## {Dot[i, {a, b, c, d, e}] <= m,
Sequence ## Thread[{a, b, c, d, e} <= Quotient[m, i]]},
{a, b, c, d, e}, Integers]
How about
recurr[numbers_, boundary_] :=
Reap[memoryRecurr[0, {}, numbers, boundary]][[2, 1]];
memoryRecurr[_, _, {}, _] := Null;
memoryRecurr[sum_, numbers_, restNumbers_, diff_] :=
(
Block[
{presentNumber = First[restNumbers], restRest = Rest[restNumbers]}
,
If[
presentNumber <= diff
,
Block[{
newNumbers = Append[numbers, presentNumber],
newSum = sum + presentNumber
},
Sow[{newNumbers, newSum}];
memoryRecurr[
newSum,
newNumbers,
restRest,
diff - presentNumber
];
]
];
memoryRecurr[sum, numbers, restRest, diff]
];
);
So that
recurr[{1, 2, 3, 4, 5}, 7]
->
{{{1}, 1}, {{1, 2}, 3}, {{1, 2, 3}, 6}, {{1, 2, 4}, 7}, {{1, 3},
4}, {{1, 4}, 5}, {{1, 5}, 6}, {{2}, 2}, {{2, 3}, 5}, {{2, 4},
6}, {{2, 5}, 7}, {{3}, 3}, {{3, 4}, 7}, {{4}, 4}, {{5}, 5}}

Mathematica, alphabet generation

If I have an alphabet, lets say sigma = {1,2,3,4,a,b,c,d,e,f,g} and want to generate all words of length n, is there a way to do that?
I can do Flatten[Outer[Function[{x, y}, {x, y}], sigma, sigma], 1] to do it for wordlength=2 but it doesnt geenralize to more letters.
And permutations doesnt work since it doesnt include doubles.
Permutations[sigma, {2}]
doesnt give {a,a} for example.
Is there an easy way to do this or I have to write a function for it?
This is correct for n=2 (but I want for arbitrary n):
{{1, 1}, {1, 2}, {1, 3}, {1, 4}, {1, a}, {1, b}, {1, c}, {1, d}, {1,
e}, {1, f}, {1, g}, {2, 1}, {2, 2}, {2, 3}, {2, 4}, {2, a}, {2,
b}, {2, c}, {2, d}, {2, e}, {2, f}, {2, g}, {3, 1}, {3, 2}, {3,
3}, {3, 4}, {3, a}, {3, b}, {3, c}, {3, d}, {3, e}, {3, f}, {3,
g}, {4, 1}, {4, 2}, {4, 3}, {4, 4}, {4, a}, {4, b}, {4, c}, {4,
d}, {4, e}, {4, f}, {4, g}, {a, 1}, {a, 2}, {a, 3}, {a, 4}, {a,
a}, {a, b}, {a, c}, {a, d}, {a, e}, {a, f}, {a, g}, {b, 1}, {b,
2}, {b, 3}, {b, 4}, {b, a}, {b, b}, {b, c}, {b, d}, {b, e}, {b,
f}, {b, g}, {c, 1}, {c, 2}, {c, 3}, {c, 4}, {c, a}, {c, b}, {c,
c}, {c, d}, {c, e}, {c, f}, {c, g}, {d, 1}, {d, 2}, {d, 3}, {d,
4}, {d, a}, {d, b}, {d, c}, {d, d}, {d, e}, {d, f}, {d, g}, {e,
1}, {e, 2}, {e, 3}, {e, 4}, {e, a}, {e, b}, {e, c}, {e, d}, {e,
e}, {e, f}, {e, g}, {f, 1}, {f, 2}, {f, 3}, {f, 4}, {f, a}, {f,
b}, {f, c}, {f, d}, {f, e}, {f, f}, {f, g}, {g, 1}, {g, 2}, {g,
3}, {g, 4}, {g, a}, {g, b}, {g, c}, {g, d}, {g, e}, {g, f}, {g, g}}
Tuples[sigma, n]
While Tuples is surely the better way to go, I think it is valuable to show you a way to make your existing method work for arbitrary n values.
Flatten[Outer[List, ##], n - 1] & ## ConstantArray[sigma, n]
This works by creating n instances of sigma and sequencing (##) them into Outer. Flatten is used to remove all but that last level of brackets.
Observe that your Function[{x, y}, {x, y}] can be replaced with simply List.
You could also use the Distribute function for this, assuming that your alphabet does not itself contain lists.
Distribute[ConstantArray[sigma, n], List]

How do I create a list of atom pairs from two lists in prolog?

I am new to prolog.
Let me show you what I want below as comment..
% ?-pair([1,2],[a,b],Result).
% Result= [{1,a},{1,b},{2,a},{2,b}].
and what I did is..
pair([],Q,[]).
pair(P,[],[]).
pair([A|P],[B|Q],[{A,B}|R]) :- pair([A|P],Q,R).
pair([A|P],[B|Q],[{A,B}|R]) :- pair(P,[B|Q],R).
with this code I reach such a result like this:
?- pair([1,2],[a,b],R).
R = [{1, a}, {1, b}] ;
R = [{1, a}, {1, b}, {2, b}] ;
R = [{1, a}, {1, b}, {2, b}] ;
R = [{1, a}, {2, a}, {2, b}] ;
R = [{1, a}, {2, a}, {2, b}] ;
R = [{1, a}, {2, a}] ;
false.
I want all in one line without repetitions..
You should explain to Prolog what you want (what is a pair, how to build it), then ask Prolog to find all the pairs.
You can do it by listing all the pairs A in L1 and B in L2 an collecting all pairs {A,B} in an other list:
pair(L1, L2, Pairs):-
findall({A,B}, (member(A, L1), member(B, L2)), Pairs).
?-pair([1,2],[a,b],Result).
Result = [{1, a}, {1, b}, {2, a}, {2, b}].

MapThread for any combination of variables

I have a set of regular (mod 5) matrices N2 and I would like to get the group generated by these matrices in Mathematica:
My approach was to use a function f doing the matrix multiplication and g for mod 5 and then I wanted to use MapThread
M= Function[{x,y},x.y];
g = Function[z, Mod[z, 5]]
g /# MapThread[M, {N2,N2}]
The problem is that MapThread is inserting only pairs of elements that are at the same position in the lists. I would like to insert any pair of elements in N. To get the group generated by the matrices in N I would just repeat this and update N2 every time.
E.g. let N2 ={A,B}
g /# MapThread[M, {N2,N2}]
would return {B^2,A^2}, while I want it to return any product of matrices in N2, i.e. {A^2,AB,BA,B^2}.
I'm not sure whether I understand your question, but if your intention is to get all combinations of the two matrices A,B you could use Tuples combined with Apply (which you may use in its functional form with square brackets or as many here do in initially cryptic prefix operator form ### = Apply at level 1):
In[24]:= Dot ### Tuples[{A, B}, 2]
Out[24]= {A.A, A.B, B.A, B.B}
In this case you need Outer:
In[27]:= n = RandomInteger[{1, 5}, {3, 2, 2}];
In[28]:= Outer[mFunc, n, n, 1]
Out[28]= {{mFunc[{{3, 5}, {2, 4}}, {{3, 5}, {2, 4}}],
mFunc[{{3, 5}, {2, 4}}, {{3, 4}, {4, 3}}],
mFunc[{{3, 5}, {2, 4}}, {{4, 4}, {5, 1}}]}, {mFunc[{{3, 4}, {4,
3}}, {{3, 5}, {2, 4}}],
mFunc[{{3, 4}, {4, 3}}, {{3, 4}, {4, 3}}],
mFunc[{{3, 4}, {4, 3}}, {{4, 4}, {5, 1}}]}, {mFunc[{{4, 4}, {5,
1}}, {{3, 5}, {2, 4}}],
mFunc[{{4, 4}, {5, 1}}, {{3, 4}, {4, 3}}],
mFunc[{{4, 4}, {5, 1}}, {{4, 4}, {5, 1}}]}}
In[29]:= n
Out[29]= {{{3, 5}, {2, 4}}, {{3, 4}, {4, 3}}, {{4, 4}, {5, 1}}}

Resources