Related
I just can't understand how this algorithm works. All the explanations I've seen say that if you have a set such as {A, B, C} and you want all the permutations, start with each letter distinctly, then find the permutations of the rest of the letters. So for example {A} + permutationsOf({B,C}).
But all the explanations seem to gloss over how you find the permutations of the rest. An example being this one.
Could someone try to explain this algorithm a little more clearly to me?
To understand recursion you need to understand recursion..
(c) Programmer's wisdom
Your question is about that fact, that "permutations of the rest" is that recursive part. Recursion always consist of two parts: trivial case and recursion case. Trivial case points to a case when there's no continue for recursion and something should be returned.
In your sample, trivial part would be {A} - there's only one permutation of this set - itself. Recursion part will be union of current element and this "rest part" - i.e. if you have more than one element, then your result will be union of permutation between this element and "rest part". In terms of permutation: the rest part is current set without selected element. I.e. for set {A,B,C} on first recursion step that will be {A} and "rest part": {B,C}, then {B} and "rest part": {A,C} - and, finally, {C} with "rest part": {A,B}
So your recursion will last till the moment when "the rest part" will be single element - and then it will end.
That is the whole point of recursive implementation. You define the solution recursively assuming you already have the solution for the simpler problem. With a little tought you will come to the conclusion that you can do the very same consideration for the simpler case making it even more simple. Going on until you reach a case that is simple enough to solve. This simple enough case is known as bottom for the recursion.
Also please note that you have to iterate over all letters not just A being the first element. Thus you get all permutations as:
{{A} + permutationsOf({B,C})} +{{B} + permutationsOf({A,C})} + {{C} + permutationsOf({A,B})}
Take a minute and try to write down all the permutations of a set of four letters say {A, B, C, D}. You will find that the algorithm you use is close to the recursion above.
The answer to your question is in the halting-criterion (in this case !inputString.length).
http://jsfiddle.net/mzPpa/
function permutate(inputString, outputString) {
if (!inputString.length) console.log(outputString);
else for (var i = 0; i < inputString.length; ++i) {
permutate(inputString.substring(0, i) +
inputString.substring(i + 1),
outputString + inputString[i]);
}
}
var inputString = "abcd";
var outputString = "";
permutate(inputString, outputString);
So, let's analyze the example {A, B, C}.
First, you want to take single element out of it, and get the rest. So you would need to write some function that would return a list of pairs:
pairs = [ (A, {B, C})
(B, {A, C})
(C, {A, B}) ]
for each of these pairs, you get a separate list of permutations that can be made out of it, like that:
for pair in pairs do
head <- pair.fst // e.g. for the first pair it will be A
tails <- perms(pair.snd) // e.g. tails will be a list of permutations computed from {B, C}
You need to attach the head to each tail from tails to get a complete permutation. So the complete loop will be:
permutations <- []
for pair in pairs do
head <- pair.fst // e.g. for the first pair it will be A
tails <- perms(pair.snd) // e.g. tails will be a list of permutations computed from {B, C}
for tail in tails do
permutations.add(head :: tail); // here we create a complete permutation
head :: tail means that we attach one element head to the beginning of the list tail.
Well now, how to implement perms function used in the fragment tails <- perm(pair.snd). We just did! That's what recursion is all about. :)
We still need a base case, so:
perms({X}) = [ {X} ] // return a list of one possible permutation
And the function for all other cases looks like that:
perms({X...}) =
permutations <- []
pairs <- createPairs({X...})
for pair in pairs do
head <- pair.fst // e.g. for the first pair it will be A
tails <- perms(pair.snd) // e.g. tails will be a list of permutations computed from {B, C}
for tail in tails do
permutations.add( head :: tail ); // here we create a complete permutation
return permutations
I'm hoping someone might be able to show me a more efficient way of writing my code in mathematica.
I've got a table which has a column of (absolute) times and a second column containing a string associated with that the period of time between the time on the same row and the time on the row below. These times are all regularly spaced. I also have a second list of irregular times and I want to have a list of the strings that would be associated with that time period.
I've done it using this code:
regulartime={{1800,a},{3600,b},{5400,b}}
irregtime={2054,2817,3060,4594, 5123}
flooredtimes=Floor[irregtime,1800]
position=Table[Position[regulartime,flooredtimes[[i]]],{i,Length[flooredtimes]}]
lastlist=Table[regulartime[[position[[i,1,1]],2]],{i,Length[flooredtimes]}]
This outputs a list {a,a,a,b,b} which I can then combine with my list of irregular times. My problem is that I am trying to do it for long (~500 000) lists and it takes a long time, is there a better way to do this?? Thanks in advance for any help!
here are two ideas..
Function[ ireg,
Last#Last#
Select[regulartime, #[[1]] == Floor[ireg, 1800] &]] /# irregtime
(*{a, a, a, b, b}*)
Last#regulartime[[Floor[#, 1800]/1800]] & /# irregtime
(*{a, a, a, b, b}*)
Here is a variation on george's second method:
regulartime[[Quotient[#, 1800], 2]] & /# irregtime
{a, a, a, b, b}
Be aware that you will get an error with values less than 1800; you may want to handle that separately:
time[x_ /; x >= 1800] := regulartime[[Quotient[x, 1800], 2]]
time[else_] := Missing[]
time /# {356, 3060, 4594}
{Missing[], a, b}
What is the simplest way to map an arbitrarily funky nested list expr to a function unflatten so that expr==unflatten##Flatten#expr?
Motivation:
Compile can only handle full arrays (something I just learned -- but not from the error message), so the idea is to use unflatten together with a compiled version of the flattened expression:
fPrivate=Compile[{x,y},Evaluate#Flatten#expr];
f[x_?NumericQ,y_?NumericQ]:=unflatten##fPrivate[x,y]
Example of a solution to a less general problem:
What I actually need to do is to calculate all the derivatives for a given multivariate function up to some order. For this case, I hack my way along like so:
expr=Table[D[x^2 y+y^3,{{x,y},k}],{k,0,2}];
unflatten=Module[{f,x,y,a,b,sslot,tt},
tt=Table[D[f[x,y],{{x,y},k}],{k,0,2}] /.
{Derivative[a_,b_][_][__]-> x[a,b], f[__]-> x[0,0]};
(Evaluate[tt/.MapIndexed[#1->sslot[#2[[1]]]&,
Flatten[tt]]/. sslot-> Slot]&) ]
Out[1]= {x^2 y + y^3, {2 x y, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}}
Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} &
This works, but it is neither elegant nor general.
Edit: Here is the "job security" version of the solution provided by aaz:
makeUnflatten[expr_List]:=Module[{i=1},
Function#Evaluate#ReplaceAll[
If[ListQ[#1],Map[#0,#1],i++]&#expr,
i_Integer-> Slot[i]]]
It works a charm:
In[2]= makeUnflatten[expr]
Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}&
You obviously need to save some information about list structure, because Flatten[{a,{b,c}}]==Flatten[{{a,b},c}].
If ArrayQ[expr], then the list structure is given by Dimensions[expr] and you can reconstruct it with Partition. E.g.
expr = {{a, b, c}, {d, e, f}};
dimensions = Dimensions[expr]
{2,3}
unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten # Flatten[expr]
(The Partition man page actually has a similar example called unflatten.)
If expr is not an array, you can try this:
expr = {a, {b, c}};
indexes = Module[{i=0}, If[ListQ[#1], Map[#0, #1], ++i]& #expr]
{1, {2, 3}}
slots = indexes /. {i_Integer -> Slot[i]}
{#1, {#2, #3}}
unflatten = Function[Release[slots]]
{#1, {#2, #3}} &
expr == unflatten ## Flatten[expr]
I am not sure what you are trying to do with Compile. It is used when you want to evaluate procedural or functional expressions very quickly on numerical values, so I don't think it is going to help here. If repeated calculations of D[f,...] are impeding your performance, you can precompute and store them with something like
Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];
Then just call d[k] to get the kth derivative.
I just wanted to update the excellent solutions by aaz and Janus. It seems that, at least in Mathematica 9.0.1.0 on Mac OSX, the assignment (see aaz's solution)
{i_Integer -> Slot[i]}
fails. If, however, we use
{i_Integer :> Slot[i]}
instead, we succeed. The same holds, of course, for the ReplaceAll call in Janus's "job security" version.
For good measure, I include my own function.
unflatten[ex_List, exOriginal_List] :=
Module[
{indexes, slots, unflat},
indexes =
Module[
{i = 0},
If[ListQ[#1], Map[#0, #1], ++i] &#exOriginal
];
slots = indexes /. {i_Integer :> Slot[i]};
unflat = Function[Release[slots]];
unflat ## ex
];
(* example *)
expr = {a, {b, c}};
expr // Flatten // unflatten[#, expr] &
It might seem a little like a cheat to use the original expression in the function, but as aaz points out, we need some information from the original expression. While you don't need it all, in order to have a single function that can unflatten, all is necessary.
My application is similar to Janus's: I am parallelizing calls to Simplify for a tensor. Using ParallelTable I can significantly improve performance, but I wreck the tensor structure in the process. This gives me a quick way to reconstruct my original tensor, simplified.
Suppose I have a function f that takes a vector v and returns a new vector with the elements transformed in some way.
It does that by calling function g that assumes the vector is sorted.
So I want f to be defined like so:
f[v_] := Module[{s, r},
s = Sort[v]; (* remember the permutation applied in order to sort v *)
r = g[s];
Unsort[r] (* apply the inverse of that permutation *)
]
What's the best way to do the "Unsort"?
Or could we get really fancy and have this somehow work:
answer = Unsort[g[Sort[v]]];
ADDED: Let's make this concrete with a toy example.
Suppose we want a function f that takes a vector and transforms it by adding to each element the next smallest element, if any.
That's easy to write if we assume the vector is sorted, so let's write a helper function g that makes that assumption:
g[v_] := v + Prepend[Most#v, 0]
Now for the function we really want, f, that works whether or not v is sorted:
f[v_] := (* remember the order;
sort it;
call g on it;
put it back in the original order;
return it
*)
One possible method:
mylist = {c, 1, a, b, 2, 4, h, \[Pi]}
g /# (Sort#mylist)[[Ordering#Ordering#mylist]]
gives
{g[c], g1, g[a], g[b], g[2], g[4], g[h], g[[Pi]]}
That is,
(Sort#mylist)[[Ordering#Ordering#mylist]] == mylist
I originally learned of the above from MathGroup, [EDITED] from a post by Andrzej Kozlowski
http://forums.wolfram.com/mathgroup/archive/2007/Jun/msg00920.html
Here's a "sorting wrapper" pattern suggested by Michael Pilat earlier
Clear[g];
g[a_] := If[OrderedQ[a], a^2, Print["Failed"]];
g[{3, 2, 1}]
g[a_] := g[Sort#a][[Ordering#Ordering#a]] /; Not[OrderedQ[a]];
g[{3, 2, 1}]
Thanks to TomD and Yaroslav, here's probably the most concise/elegant way to do it:
f[v_] := g[Sort#v][[Ordering#Ordering#v]]
And thanks to Janus, here's a perhaps more efficient way:
f[v_] := With[{o = Ordering#v}, g[v[[o]]][[Ordering#o]]]
Note that it does 2 sorts instead of 3.
For posterity, here's my original attempt, though I don't think it has anything to recommend it over the above:
f[v_] := With[{o = Ordering[v]}, Sort[Transpose[{o,g[v[[o]]]}]][[All,-1]]]
To address belisarius in the comments, the reason I'm not passing g as a parameter is because I'm thinking of g as a helper function for f.
It's like I have a function f that would be easier to write if I could assume its argument was a sorted vector.
So I write the version that assumes that and then do this wrapper trick.
I have a large set of parameters P which take several distinct sets of values V_i and want to use ActionMenu[] to make assigning P=V_i easy, like so:
ActionMenu["Label", {"name_1" :> (P = V_1;),..}]
Now the problem is that the set of V_i's is large and not static, so instead of coding a long list {"opt_1" :> (P = V_1;),..} over and over by hand, I'd like to generate it.
I am completely stumped at how to do it. The general approach is something like
Thread#RuleDelayed[listOfNames,listOfActions]
where listOfActions should be something like
Thread#Set[repeatedListOfP,listOfV_i]
But this does not work. And since Set[] is a very special function, none of my other usual approaches work (building a Table[], replacing headers, etc). How do you go about constructing a list of Set[] operations?
There may be more to your question that I haven't grokked yet but maybe this will get you on the right track.
This
MapThread[Hold[#1 = #2]&, {{a, b, c}, {1, 2, 3}}]
returns a list of unevaluated "Set"s like so:
{Hold[a = 1], Hold[b = 2], Hold[c = 3]}
If you call ReleaseHold on the above then the assignments will actually happen.
More on Hold and relatives here:
Mathematica: Unevaluated vs Defer vs Hold vs HoldForm vs HoldAllComplete vs etc etc
Here's an alternative solution that I've used when I've wanted to have RuleDelayed applications that have side-effects. You use a different head to substitute in for Set until you have your expression on the right-hand side of a RuleDelayed form (where it'll be held by RuleDelayed's HoldRest attribute) and then subsitute Set back in. When I do this, I like to use Module to create a unique symbol for me. This way you don't have to use Defer, which is an even more unpleasantly slippery construct than Unevaluated.
Here's an example:
Module[{set},
Attributes[set] = Attributes[Set];
With[{rhs = MapThread[set, Unevaluated[{{x, y, z}, {1, 2, 3}}]]},
"name1" :> rhs /. {set -> Set, List -> CompoundExpression}]]
The reason the set symbol is given the same attributes as Set, and the reason the Unevaluated is there, is to make sure this works even if someone has already assigned a value to x, y or z.
Another possibility is to wrap all your Set expressions up as closures and then use Scan to call them when the RuleDelayed is evaluated, like so:
With[{thunks = MapThread[Function[{a, b}, (a = b) &, HoldAll],
Unevaluated[{{x, y, z}, {1, 2, 3}}]]},
"name1" :> Scan[#[] &, thunks]]