This is my first time posting here. I would really appreciate some help with a question from my mathematica study guide. My question is:
Suppose that a drunk randomly steps either forward, backward, left, or right one unit many times. Create a list of coordinates {{x,y}..} representing his path and then display that path as a set of line segments for each step. [Hint: use NestList to create a list of coordinates, Partition to form a list of segments, map Line onto the segment list, and Show[Graphics[list]] to display the path.]
I have managed to successfully create the function:
Clear[x, n]
Randomwalk[n_] :=
NestList[(# + (-1)^Table[Random[Integer, {0, 1}], {2}]) &, Table[0, {2}], n];
Randomwalk[50]
I, however, need help with the second part, where I need to graph it. MY attempt at the second part is as follows:
Show[Graphics[Line[Randomwalk[50]]]]
and although it gives me a graph, it does not seem to be correct. I would really appreciate some help with this.
You could try the following function
RandomWalk[n_]:=Accumulate[{{1,0},{-1,0},{0,1},{0,-1}}[[RandomInteger[{1,4},n]]]]
where n is the number of steps to take. Plotting works as you wrote
Graphics[Line[RandomWalk[200]]]
However, plotting with colour shows how the walk progressed, as in
With[{n=100},
Graphics[MapIndexed[{Hue[#2[[1]]/(n + 10)], Line[#]} &,
Partition[RandomWalk[n], 2, 1]]]]
Instead of using [[RandomInteger[{1,4},n]]] to pick out the directions, you could use RandomChoice which is designed expressly for this type of operation:
RandomWalk[n_] := Accumulate[RandomChoice[{{1, 0}, {-1, 0}, {0, 1}, {0, -1}}, n]]
This gives about the same (maybe slightly faster) speed as the approach using Part and RandomInteger. But if you are working with large walks (n > 10^6, say), then you might want to squeeze some speed out by forcing the list of directions to be a packed array:
NSEWPacked = Developer`ToPackedArray[{{1, 0}, {-1, 0}, {0, 1}, {0, -1}}]
Then use the packed array:
RandomWalkPacked[n_] := Accumulate[RandomChoice[NSEWPacked, n]]
You should see about an order of magnitude speedup with this:
Timing[RandomWalkPacked[10^7];]
For details on packed arrays, see Developer/ref/ToPackedArray or chapter 12 on optimizing Mathematica programs in Programming with Mathematica: An Introduction.
Related
Why doesn't Mathematica automatically use symbolic sums to make computations faster? For instance, the following code takes a very long time to execute.
fr[r_] := PDF[DiscreteUniformDistribution[{1, 10}], r];
Sum[fr[r], {r, 1, 100000000000000000000000000000}]
If I replace the last line with the following, the computation is instantaneous.
ReplaceRepeated[Sum[fr[r], {r, 1, n}], n -> 100000000000000000000000000000]
Is there a way to automatically compute the sum in a symbolic manner?
I have not used PackedArray before, but just started looking at using them from reading some discussion on them here today.
What I have is lots of large size 1D and 2D matrices of all reals, and no symbolic (it is a finite difference PDE solver), and so I thought that I should take advantage of using PackedArray.
I have an initialization function where I allocate all the data/grids needed. So I went and used ToPackedArray on them. It seems a bit faster, but I need to do more performance testing to better compare speed before and after and also compare RAM usage.
But while I was looking at this, I noticed that some operations in M automatically return lists in PackedArray already, and some do not.
For example, this does not return packed array
a = Table[RandomReal[], {5}, {5}];
Developer`PackedArrayQ[a]
But this does
a = RandomReal[1, {5, 5}];
Developer`PackedArrayQ[a]
and this does
a = Table[0, {5}, {5}];
b = ListConvolve[ {{0, 1, 0}, {1, 4, 1}, {0, 1, 1}}, a, 1];
Developer`PackedArrayQ[b]
and also matrix multiplication does return result in packed array
a = Table[0, {5}, {5}];
b = a.a;
Developer`PackedArrayQ[b]
But element wise multiplication does not
b = a*a;
Developer`PackedArrayQ[b]
My question : Is there a list somewhere which documents which M commands return PackedArray vs. not? (assuming data meets the requirements, such as Real, not mixed, no symbolic, etc..)
Also, a minor question, do you think it will be better to check first if a list/matrix created is already packed before calling calling ToPackedArray on it? I would think calling ToPackedArray on list already packed will not cost anything, as the call will return right away.
thanks,
update (1)
Just wanted to mention, that just found that PackedArray symbols not allowed in a demo CDF as I got an error uploading one with one. So, had to remove all my packing code out. Since I mainly write demos, now this topic is just of an academic interest for me. But wanted to thank everyone for time and good answers.
There isn't a comprehensive list. To point out a few things:
Basic operations with packed arrays will tend to remain packed:
In[66]:= a = RandomReal[1, {5, 5}];
In[67]:= Developer`PackedArrayQ /# {a, a.a, a*a}
Out[67]= {True, True, True}
Note above that that my version (8.0.4) doesn't unpack for element-wise multiplication.
Whether a Table will result in a packed array depends on the number of elements:
In[71]:= Developer`PackedArrayQ[Table[RandomReal[], {24}, {10}]]
Out[71]= False
In[72]:= Developer`PackedArrayQ[Table[RandomReal[], {24}, {11}]]
Out[72]= True
In[73]:= Developer`PackedArrayQ[Table[RandomReal[], {25}, {10}]]
Out[73]= True
On["Packing"] will turn on messages to let you know when things unpack:
In[77]:= On["Packing"]
In[78]:= a = RandomReal[1, 10];
In[79]:= Developer`PackedArrayQ[a]
Out[79]= True
In[80]:= a[[1]] = 0 (* force unpacking due to type mismatch *)
Developer`FromPackedArray::punpack1: Unpacking array with dimensions {10}. >>
Out[80]= 0
Operations that do per-element inspection will usually unpack the array,
In[81]:= a = RandomReal[1, 10];
In[82]:= Position[a, Max[a]]
Developer`FromPackedArray::unpack: Unpacking array in call to Position. >>
Out[82]= {{4}}
There penalty for calling ToPackedArray on an already packed list is small enough that I wouldn't worry about it too much:
In[90]:= a = RandomReal[1, 10^7];
In[91]:= Timing[Do[Identity[a], {10^5}];]
Out[91]= {0.028089, Null}
In[92]:= Timing[Do[Developer`ToPackedArray[a], {10^5}];]
Out[92]= {0.043788, Null}
The frontend prefers packed to unpacked arrays, which can show up when dealing with Dynamic and Manipulate:
In[97]:= Developer`PackedArrayQ[{1}]
Out[97]= False
In[98]:= Dynamic[Developer`PackedArrayQ[{1}]]
Out[98]= True
When looking into performance, focus on cases where large lists are getting unpacked, rather than the small ones. Unless the small ones are in big loops.
This is just an addendum to Brett's answer:
SystemOptions["CompileOptions"]
will give you the lengths being used for which a function will return a packed array. So if you did need to pack a small list, as an alternative to using Developer`ToPackedArray you could temporarily set a smaller number for one of the compile options. e.g.
SetSystemOptions["CompileOptions" -> {"TableCompileLength" -> 20}]
Note also some difference between functions which to me at least doesn't seem intuitive so I generally have to test these kind of things whenever I use them rather than instinctively knowing what will work best:
f = # + 1 &;
g[x_] := x + 1;
data = RandomReal[1, 10^6];
On["Packing"]
Timing[Developer`PackedArrayQ[f /# data]]
{0.131565, True}
Timing[Developer`PackedArrayQ[g /# data]]
Developer`FromPackedArray::punpack1: Unpacking array with dimensions {1000000}.
{1.95083, False}
Another addition to Brett's answer: If a list is a packed array then a ToPackedArray is very fast since this checked quite early. Also you might find this valuable:
http://library.wolfram.com/infocenter/Articles/3141/
In general for numerics stuff look for talks from Rob Knapp and/or Mark Sofroniou.
When I develop numerics codes, I write the function and then use On["Packing"] to make sure that everything is packed that needs to be packed.
Concerning Mike's answer, the threshold has been introduced since for small stuff there is overhead. Where the threshold is is hardware dependent. It might be an idea to write a function that sets these threshold based on measurements done on the computer.
Is there a way to make MatrixForm display a row vector horizontally on the line and not vertically as it does for column vectors? As this confuses me sometimes. Do you think it will be hard to write wrapper around matrix form to adjust this behavior?
For example, here is a 2 by 2 matrix. The rows display the same as the columns. Both are shown vertical.
Question: Is it possible to make MatrixForm display row vectors laid out horizontally and not vertically?
Sorry if this was asked before, a quick search shows nothing.
thanks
update (1)
fyi, this is in Matlab, it prints rows horizontally and column vertically automatically, I was hoping for something like this. But I'll use suggestion by Heike below for now as it solves this at the cost of little extra typing.
update (2)
Using Hilderic solution is nice also, I always had hard time printing 3D matrix in a way I can read it. Here it is now using the {} trick
For both arrayname[[All,1]] and arrayname[[1,All]], Part delivers a vector, and MatrixForm has no way of determining which "orientation" it has. Accordingly, it always prints vectors as columns.
About the only thing you can do is provide your own output routine for row vectors, e.g., by wrapping it in an enclosing list, converting it back to a (single-row) matrix:
rowVector[a_List] := MatrixForm[{a}]
columnVector = MatrixForm (*for symmetry*)
It's still up to you to remember whether a vector came from a row or a column, though.
Or you could just cook up your own RowForm function, e.g.:
RowForm[(m_)?VectorQ] := Row[{"(",Row[m," "],
")"}, "\[MediumSpace]"];
Then
RowForm[twoRowsMatrix[[All,1]]]
looks kind of o.k.
Alternatively, if you really just care about displaying vectors, you could do:
twoRowsMatrix = {{a11, a12}, {a21, a22}};
TakeColumn[m_?MatrixQ, i_] := (Print[MatrixForm[#]]; #) &#m[[All, i]];
TakeRow[m_?MatrixQ, i_] := (Print[MatrixForm[{#}]]; #) &#m[[i]];
TakeColumn[twoRowsMatrix, 1]
TakeRow[twoRowsMatrix, 1]
If you don't care about the () part, then you can append with ,{}, wrap in curly brackets, and use TableForm or Grid instead:
vec = {x, y, z};
TableForm[{vec, {}}]
Grid[{vec, {}}]
When I get worried about this, I use {{a,b,c}} to specify a row of a,b,c (they can be any kind of list) and Transpose[{{a,b,c}}] to specify a column of a,b,c.
MatrixForm[a = RandomInteger[{0, 6}, {2, 2}]]
MatrixForm[b = RandomInteger[{0, 6}, {2, 2}]]
MatrixForm[c = RandomInteger[{0, 6}, {2, 2}]]
w = {a, b, c};
MatrixForm[w]
w = {{a, b, c}};
MatrixForm[w]
w = Transpose[{{a, b, c}}];
MatrixForm[w]
Given a set of numbers and a set of binary operations,
what is the fastest way to create random expression trees or exhaustively check every possible combination in Mathematica?
What I am trying to solve is given:
numbers={25,50,75,100,3,6} (* each can ONLY be used ONCE *)
operators={Plus,Subtract,Times,Divide} (* each can be used repeatedly *)
target=99
find expression trees that would evaluate to target.
I have two solutions whose performances I give for the case where expression trees contain exactly 4 of the numbers and 3 operators:
random sample & choice: ~25K trees / second
exhaustive scan: 806400 trees in ~2.15 seconds
(timed on a laptop with: Intel(R) Core(TM)2 Duo CPU T9300 # 2.50GHz, 3GB ram, no parallelization used yet but would be most welcome in answers)
My notebooks are a bit messy at the moment. So I would first love to pose the question and hope for original ideas and answers while I clean up my code for sharing.
Largest possible case is where every expression tree uses up all the (6) numbers and 'Length[numbers]-1' (5) operators.
Performance of methods in the largest case is:
random sample & choice: ~21K trees / second
exhaustive scan: 23224320 trees in ~100 seconds
Also I am using Mathematica 8.0.1 so I am more than all ears if there are any ways to do it in OpenCL or using compiled functions wiht CompilationTarget->"C", etc.
OK, this is not elegant or fast, and it's buggy, but it works (sometimes). It uses a monte carlo method, implementing the metropolis algorithm for a weight function that I (arbitrarily) selected just to see if this would work. This was some time ago for a similar problem; I suppose my mathematica skills have improved as it looks ugly now, but I have no time to fix it at the moment.
Execute this (it looks more reasonable when you paste it into a notebook):
ClearAll[swap];
swap[lst_, {p1_, p2_}] :=
ReplacePart[
lst, {p1 \[Rule] lst\[LeftDoubleBracket]p2\[RightDoubleBracket],
p2 \[Rule] lst\[LeftDoubleBracket]p1\[RightDoubleBracket]}]
ClearAll[evalops];
(*first element of opslst is Identity*)
evalops[opslst_, ord_, nums_] :=
Module[{curval}, curval = First#nums;
Do[curval =
opslst\[LeftDoubleBracket]p\[RightDoubleBracket][curval,
nums\[LeftDoubleBracket]ord\[LeftDoubleBracket]p\
\[RightDoubleBracket]\[RightDoubleBracket]], {p, 2, Length#nums}];
curval]
ClearAll[randomizeOrder];
randomizeOrder[ordlst_] :=
swap[ordlst, RandomInteger[{1, Length#ordlst}, 2]]
ClearAll[randomizeOps];
(*never touch the first element*)
randomizeOps[oplst_, allowedOps_] :=
ReplacePart[
oplst, {RandomInteger[{2, Length#oplst}] \[Rule] RandomChoice[ops]}]
ClearAll[takeMCstep];
takeMCstep[goal_, opslst_, ord_, nums_, allowedops_] :=
Module[{curres, newres, newops, neword, p},
curres = evalops[opslst, ord, nums];
newops = randomizeOps[opslst, allowedops];
neword = randomizeOrder[ord];
newres = evalops[newops, neword, nums];
Switch[Abs[newres - goal],
0, {newops,
neword}, _, (p = Abs[curres - goal]/Abs[newres - goal];
If[RandomReal[] < p, {newops, neword}, {opslst, ord}])]]
then to solve your actual problem, do
ops = {Times, Plus, Subtract, Divide}
nums = {25, 50, 75, 100, 3, 6}
ord = Range[Length#nums]
(*the first element is identity to simplify the logic later*)
oplist = {Identity}~Join~RandomChoice[ops, Length#nums - 1]
out = NestList[
takeMCstep[
99, #\[LeftDoubleBracket]1\[RightDoubleBracket], #\
\[LeftDoubleBracket]2\[RightDoubleBracket], nums, ops] &, {oplist,
ord}, 10000]
and then to see that it worked,
ev = Map[evalops[#\[LeftDoubleBracket]1\[RightDoubleBracket], #\
\[LeftDoubleBracket]2\[RightDoubleBracket], nums] &, out];
ev // Last // N
ev // ListPlot[#, PlotMarkers \[Rule] None] &
giving
thus, it obtained the correct order of operators and numbers after around 2000 tries.
As I said, it's ugly, inefficient, and badly programmed as it was a quick-and-dirty adaptation of a quick-and-dirty hack. If you're interested I can clean up and explain the code.
This was a fun question. Here's my full solution:
ExprEval[nums_, ops_] := Fold[
#2[[1]][#1, #2[[2]]] &,
First#nums,
Transpose[{ops, Rest#nums}]]
SymbolicEval[nums_, ops_] := ExprEval[nums, ToString /# ops]
GetExpression[nums_, ops_, target_] := Select[
Tuples[ops, Length#nums - 1],
(target == ExprEval[nums, #]) &]
Usage example:
nums = {-1, 1, 2, 3};
ops = {Plus, Subtract, Times, Divide};
solutions = GetExpression[nums, ops, 3]
ExprEval[nums, #] & /# solutions
SymbolicEval[nums, #] & /# solutions
Outputs:
{{Plus, Times, Plus}, {Plus, Divide, Plus}, {Subtract, Plus,
Plus}, {Times, Plus, Times}, {Divide, Plus, Times}}
{3, 3, 3, 3, 3}
{"Plus"["Times"["Plus"[-1, 1], 2], 3],
"Plus"["Divide"["Plus"[-1, 1], 2], 3],
"Plus"["Plus"["Subtract"[-1, 1], 2], 3],
"Times"["Plus"["Times"[-1, 1], 2], 3],
"Times"["Plus"["Divide"[-1, 1], 2], 3]}
How it works
The ExprEval function takes in the numbers and operations, and applies them using (I think) RPN:
ExprEval[{1, 2, 3}, {Plus, Times}] == (1 + 2) * 3
It does this by continually folding pairs of numbers using the appropriate operation.
Now that I have a way to evaluate an expression tree, I just needed to generate them. Using Tuples, I'm able to generate all the different operators that I would intersperse between the numbers.
Once you get all possible operations, I used Select to pick out the the ones that evaluate to the target number.
Drawbacks
The solution above is really slow. Generating all the possible tuples is exponential in time. If there are k operations and n numbers, it's on the order of O(k^n).
For n = 10, it took 6 seconds to complete on Win 7 x64, Core i7 860, 12 GB RAM. The timings of the runs match the theoretical time complexity almost exactly:
Red line is the theoretical, blue is experimental. The x-axis is size of the nums input and the y-axis is the time in seconds to enumerate all solutions.
The above solution also solves the problem using a functional programming style. It looks pretty, but the thing also sucks up a butt ton of memory since it's storing the full results at nearly every step.
It doesn't even make use of parallelization, and I'm not entirely certain how you would even parallelize the solution I produced.
Some limitations
Mr. Wizard brought to my attention that this code only solves for only particular set of solutions. Given some input such as {a, b, c, d, e, ... } it only permutes the operators in between the numbers. It doesn't permute the ordering of the numbers. If it were to permute the numbers as well, the time complexity would rise up to O(k^n * n!) where k is the number of operators and n is the length of the input number array.
The following will produce the set of solutions for any permutation of the input numbers and operators:
(* generates a lists of the form
{
{number permutation, {{op order 1}, {op order 2}, ... }
}, ...
}*)
GetAllExpressions[nums_, ops_, target_] :=
ParallelMap[{#, GetExpression[#, ops, target]} &,
Tuples[nums, Length#nums]]
I know that using the Insert menu, you can create a matrix with vertical and horizontal lines, but not a more generic partition, such as dividing a 4x4 matrix into 4 2x2 partitions. Nor, can MatrixForm do any sort of partitioning. So, how would I go about programmatically displaying such a partitioned matrix? I would like to retain the ability of MatrixForm to act only as a wrapper and not affect subsequent evaluations, but it is not strictly necessary. I suspect this would involve using a Grid, but I haven't tried it.
After playing around for far too long trying to make Interpretation drop the displayed form and use the matrix when used in subsequent lines, I gave up and just made a wrapper that acts almost exactly like MatrixForm. This was really quick as it was a simple modification of this question.
Clear[pMatrixForm,pMatrixFormHelper]
pMatrixForm[mat_,col_Integer,row_:{}]:=pMatrixForm[mat,{col},row]
pMatrixForm[mat_,col_,row_Integer]:=pMatrixForm[mat,col,{row}]
pMatrixFormHelper[mat_,col_,row_]:=Interpretation[MatrixForm[
{Grid[mat,Dividers->{Thread[col->True],Thread[row->True]}]}],mat]
pMatrixForm[mat_?MatrixQ,col:{___Integer}:{},row:{___Integer}:{}]:=
(CellPrint[ExpressionCell[pMatrixFormHelper[mat,col,row],
"Output",CellLabel->StringJoin["Out[",ToString[$Line],"]//pMatrixForm="]]];
Unprotect[Out];Out[$Line]=mat;Protect[Out];mat;)
Then the postfix command //pMatrixForm[#, 3, 3]& will give the requested 2x2 partitioning of a 4x4 matrix. It maybe useful to change the defaults of pMatrixForm from no partitions to central partitions. This would not be hard.
So this is what I came up with. For a matrix M:
M = {{a, b, 0, 0}, {c, d, 0, 0}, {0, 0, x, y}, {0, 0, z, w}};
you construct two list of True/False values (with True for places where you want separators) that take two arguments; first the matrix and second a list of positions for separators.
colSep = Fold[ReplacePart[#1, #2 -> True] &,
Table[False, {First#Dimensions##1 + 1}], #2] &;
rowSep = Fold[ReplacePart[#1, #2 -> True] &,
Table[False, {Last#Dimensions##1 + 1}], #2] &;
Now the partitioned view using Grid[] is made with the use of Dividers:
partMatrix = Grid[#1, Dividers -> {colSep[#1, #2], rowSep[#1, #3]}] &;
This takes three arguments; first the matrix, second the list of positions for column dividers, and third the list of values for row dividers.
In order for it to display nicely you just wrap it in brakets and use MatrixForm:
MatrixForm#{partMatrix[M, {3}, {3}]}
Which does the 2by2 partitioning you mentioned.