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]
Related
I want to fit this data to a trig function, as it is periodic.
So far, this cubic model is my most accurate result.
Data = {{0, 4.042704626}, {1, 2.078666417}, {2, 1.174751826}, {3,
0.3352687769}, {4, 0.2094025098}, {5, 0.0614347256}, {6,
0.06293313355}, {7, 0.1011425361}, {8, 0.2648436037}, {9,
0.385090841}, {10, 0.9986888931}, {11, 1.678591497}, {12,
2.508709496}, {13, 2.891178123}, {14, 3.06799026}, {15,
4.494100019}, {16, 6.881438472}, {17, 8.603483798}, {18,
9.519011051}, {19, 10.42667166}, {20, 11.2448024}, {21,
11.1889867}, {22, 10.53343323}, {23, 7.246675407}};
model = a*x^3 + b*x^2 + c*x + d;
fit = NonlinearModelFit[Data, model, {a, b, c, d}, x]
Show[ListPlot[Data, PlotStyle -> Red], Plot[fit[x], {x, 0, 23}]]
A quintic model would be better.
model = a*x^5 + b*x^4 + c*x^3 + d*x^2 + e*x + f;
fit = NonlinearModelFit[Data, model, {a, b, c, d, e, f}, x]
Show[ListPlot[Data, PlotStyle -> Red], Plot[fit[x], {x, 0, 23}]]
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}}
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}}
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}}
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}].