Related
Is there function in Wolfram Mathematica for removing element from original list?
For example
a={1,2,3};
DeleteFrom[a,1];
a
a={2,3}
If it is absent can anyone give example of efficient variant of such function?
(I know that there is function Delete() but it will create new list. This is not good if list is big)
If you want to drop the first element from a list a the statement
Drop[a,1]
returns a list the same as a without its first element. Note that this does not update a. To do that you could assign the result to a, eg
a = Drop[a,1]
Note that this is probably exactly what Delete is doing behind the scenes; first making a copy of a without its first element, then assigning the name a to that new list, then freeing the memory used by the old list.
Comparing destructive updates and non-destructive updates in Mathematica is quite complicated and can take one deep into the system's internals. You'll find a lot about the subject on the Stack Exchange Mathematica site.
Every time you change the length of a list in Mathematica you cause a reallocation of the list, which takes O(n) rather than O(1) time. Though no "DeleteFrom" function exists, if it did it would be no faster than a = Delete[a, x].
If you can create in advance a list of all the elements you wish to delete and delete them all at once you will get much better performance. If you cannot you will have to find another way to formulate your problem. I suggest you join us on the proper Stack Exchange site if you have additional questions:
Assign the element to an empty sequence and it will removed from the list. This works for any element.
In[1] := a = {1,2,3}
Out[1]= {1,2,3}
In[2] := a[[1]] = Sequence[]
Out[2] = Sequence[]
In[3] := a
Out[3] = {2,3}
Yes Mathematica tends towards non-destructive programming, but the programmers at Wolfram are pretty clever folks and the code seems to run pretty fast. It hard to believe they would always copy a whole list to change one element, i.e. not make any optimizations.
Improving the user3446498's answer, you can do the following:
In[1] := a = {1,2,3};
In[2] := a[[1]] = Nothing;
In[3] := a
Out[3] = {2,3}
In[4] := a == {2,3}
Out[4] = True
this Nothing symbol was introduced in in the 10th version (2015), see here.
Both solutions from #user3446498 and #pmsoltani won't actually delete the element. Test:
a = {1, 2, 3};
a[[2]] = Sequence[]; (* or Nothing *)
--a[[1]];
++a[[2]];
a
They both output {0, 4, 3}, while {0, 4} is expected.
Replacing 2nd line with a = Delete[a, 2]; would work.
Please consider:
Clear[x]
expr = Sum[x^i, {i, 15}]^30;
CoefficientList[expr, x]; // Timing
Coefficient[Expand#expr, x, 234]; // Timing
Coefficient[expr, x, 234]; // Timing
{0.047, Null}
{0.047, Null}
{4.93, Null}
Help states:
Coefficient works whether or not expr is explicitly given in expanded form.
Is there a reason why Coefficient needs to be so slow in the last case?
Here is a hack which may enable your code to be fast, but I don't guarantee it to always work correctly:
ClearAll[withFastCoefficient];
SetAttributes[withFastCoefficient, HoldFirst];
withFastCoefficient[code_] :=
Block[{Binomial},
Binomial[x_, y_] := 10 /; ! FreeQ[Stack[_][[-6]], Coefficient];
code]
Using it, we get:
In[58]:= withFastCoefficient[Coefficient[expr,x,234]]//Timing
Out[58]= {0.172,3116518719381876183528738595379210}
The idea is that, Coefficient is using Binomial internally to estimate the number of terms, and then expands (calls Expand) if the number of terms is less than 1000, which you can check by using Trace[..., TraceInternal->True]. And when it does not expand, it computes lots of sums of large coefficient lists dominated by zeros, and this is apparently slower than expanding, for a range of expressions. What I do is to fool Binomial into returning a small number (10), but I also tried to make it such that it will only affect the Binomial called internally by Coefficient:
In[67]:= withFastCoefficient[f[Binomial[7,4]]Coefficient[expr,x,234]]
Out[67]= 3116518719381876183528738595379210 f[35]
I can not however guarantee that there are no examples where Binomial somewhere else in the code will be computed incorrectly.
EDIT
Of course, a safer alternative that always exists is to redefine Coefficient using the Villegas - Gayley trick, expanding an expression inside it and calling it again:
Unprotect[Coefficient];
Module[{inCoefficient},
Coefficient[expr_, args__] :=
Block[{inCoefficient = True},
Coefficient[Expand[expr], args]] /; ! TrueQ[inCoefficient]
];
Protect[Coefficient];
EDIT 2
My first suggestion had an advantage that we defined a macro which modified the properties of functions locally, but disadvantage that it was unsafe. My second suggestion is safer but modifies Coefficient globally, so it will always expand until we remove that definition. We can have the best of both worlds with the help of Internal`InheritedBlock, which creates a local copy of a given function. Here is the code:
ClearAll[withExpandingCoefficient];
SetAttributes[withExpandingCoefficient, HoldFirst];
withExpandingCoefficient[code_] :=
Module[{inCoefficient},
Internal`InheritedBlock[{Coefficient},
Unprotect[Coefficient];
Coefficient[expr_, args__] :=
Block[{inCoefficient = True},
Coefficient[Expand[expr], args]] /; ! TrueQ[inCoefficient];
Protect[Coefficient];
code
]
];
The usage is similar to the first case:
In[92]:= withExpandingCoefficient[Coefficient[expr,x,234]]//Timing
Out[92]= {0.156,3116518719381876183528738595379210}
The main Coefficient function remains unaffected however:
In[93]:= DownValues[Coefficient]
Out[93]= {}
Coefficient will not expand unless it deems it absolutely necessary to do so. This does indeed avoid memory explosions. I believe it has been this way since version 3 (I think I was working on it around 1995 or so).
It can also be faster to avoid expansion. Here is a simple example.
In[28]:= expr = Sum[x^i + y^j + z^k, {i, 15}, {j, 10}, {k, 20}]^20;
In[29]:= Coefficient[expr, x, 234]; // Timing
Out[29]= {0.81, Null}
But this next appears to hang in version 8, and takes at least a half minute in the development Mathematica (where Expand was changed).
Coefficient[Expand[expr], x, 234]; // Timing
Possibly some heuristics should be added to look for univariates that will not explode. Does not seem like a high priority item though.
Daniel Lichtblau
expr = Sum[x^i, {i, 15}]^30;
scoeff[ex_, var_, n_] /; PolynomialQ[ex, var] :=
ex + O[var]^(n + 1) /.
Verbatim[SeriesData][_, 0, c_List, nmin_, nmax_, 1] :>
If[nmax - nmin != Length[c], 0, c[[-1]]];
Timing[scoeff[expr, x, 234]]
seems quite fast, too.
After some experimentation following Rolf Mertig's answer, this appears to be the fastest method on the type of expression such as Sum[x^i, {i, 15}]^30:
SeriesCoefficient[expr, {x, 0, 234}]
I have the following problem.
I am developing a stochastic simulator which samples configurations of the system at random and stores the statistics of how many times each configuration has been visited at certain time instances. Roughly the code works like this
f[_Integer][{_Integer..}] :=0
...
someplace later in the code, e.g.,
index = get index;
c = get random configuration (i.e. a tuple of integers, say a pair {n1, n2});
f[index][c] = f[index][c] + 1;
which tags that configuration c has occurred once more in the simulation at time instance index.
Once the code has finished there is a list of definitions for f that looks something like this (I typed it by hand just to emphasize the most important parts)
?f
f[1][{1, 2}] = 112
f[1][{3, 4}] = 114
f[2][{1, 6}] = 216
f[2][{2, 7}] = 227
...
f[index][someconfiguration] = some value
...
f[_Integer][{_Integer..}] :=0
Please note that pattern free definitions that come first can be rather sparse. Also one cannot know which values and configurations will be picked.
The problem is to efficiently extract down values for a desired index, for example issue something like
result = ExtractConfigurationsAndOccurences[f, 2]
which should give a list with the structure
result = {list1, list2}
where
list1 = {{1, 6}, {2, 7}} (* the list of configurations that occurred during the simulation*)
list2 = {216, 227} (* how many times each of them occurred *)
The problem is that ExtractConfigurationsAndOccurences should be very fast. The only solution I could come up with was to use SubValues[f] (which gives the full list) and filter it with Cases statement. I realize that this procedure should be avoided at any cost since there will be exponentially many configurations (definitions) to test, which slows down the code considerably.
Is there a natural way in Mathematica to do this in a fast way?
I was hoping that Mathematica would see f[2] as a single head with many down values but using DownValues[f[2]] gives nothing. Also using SubValues[f[2]] results in an error.
This is a complete rewrite of my previous answer. It turns out that in my previous attempts, I overlooked a much simpler method based on a combination of packed arrays and sparse arrays, that is much faster and more memory - efficient than all previous methods (at least in the range of sample sizes where I tested it), while only minimally changing the original SubValues - based approach. Since the question was asked about the most efficient method, I will remove the other ones from the answer (given that they are quite a bit more complex and take a lot of space. Those who would like to see them can inspect past revisions of this answer).
The original SubValues - based approach
We start by introducing a function to generate the test samples of configurations for us. Here it is:
Clear[generateConfigurations];
generateConfigurations[maxIndex_Integer, maxConfX_Integer, maxConfY_Integer,
nconfs_Integer] :=
Transpose[{
RandomInteger[{1, maxIndex}, nconfs],
Transpose[{
RandomInteger[{1, maxConfX}, nconfs],
RandomInteger[{1, maxConfY}, nconfs]
}]}];
We can generate a small sample to illustrate:
In[3]:= sample = generateConfigurations[2,2,2,10]
Out[3]= {{2,{2,1}},{2,{1,1}},{1,{2,1}},{1,{1,2}},{1,{1,2}},
{1,{2,1}},{2,{1,2}},{2,{2,2}},{1,{2,2}},{1,{2,1}}}
We have here only 2 indices, and configurations where both "x" and "y" numbers vary from 1 to 2 only - 10 such configurations.
The following function will help us imitate the accumulation of frequencies for configurations, as we increment SubValues-based counters for repeatedly occurring ones:
Clear[testAccumulate];
testAccumulate[ff_Symbol, data_] :=
Module[{},
ClearAll[ff];
ff[_][_] = 0;
Do[
doSomeStuff;
ff[#1][#2]++ & ## elem;
doSomeMoreStaff;
, {elem, data}]];
The doSomeStuff and doSomeMoreStaff symbols are here to represent some code that might preclude or follow the counting code. The data parameter is supposed to be a list of the form produced by generateConfigurations. For example:
In[6]:=
testAccumulate[ff,sample];
SubValues[ff]
Out[7]= {HoldPattern[ff[1][{1,2}]]:>2,HoldPattern[ff[1][{2,1}]]:>3,
HoldPattern[ff[1][{2,2}]]:>1,HoldPattern[ff[2][{1,1}]]:>1,
HoldPattern[ff[2][{1,2}]]:>1,HoldPattern[ff[2][{2,1}]]:>1,
HoldPattern[ff[2][{2,2}]]:>1,HoldPattern[ff[_][_]]:>0}
The following function will extract the resulting data (indices, configurations and their frequencies) from the list of SubValues:
Clear[getResultingData];
getResultingData[f_Symbol] :=
Transpose[{#[[All, 1, 1, 0, 1]], #[[All, 1, 1, 1]], #[[All, 2]]}] &#
Most#SubValues[f, Sort -> False];
For example:
In[10]:= result = getResultingData[ff]
Out[10]= {{2,{2,1},1},{2,{1,1},1},{1,{2,1},3},{1,{1,2},2},{2,{1,2},1},
{2,{2,2},1},{1,{2,2},1}}
To finish with the data-processing cycle, here is a straightforward function to extract data for a fixed index, based on Select:
Clear[getResultsForFixedIndex];
getResultsForFixedIndex[data_, index_] :=
If[# === {}, {}, Transpose[#]] &[
Select[data, First## == index &][[All, {2, 3}]]];
For our test example,
In[13]:= getResultsForFixedIndex[result,1]
Out[13]= {{{2,1},{1,2},{2,2}},{3,2,1}}
This is presumably close to what #zorank tried, in code.
A faster solution based on packed arrays and sparse arrays
As #zorank noted, this becomes slow for larger sample with more indices and configurations. We will now generate a large sample to illustrate that (note! This requires about 4-5 Gb of RAM, so you may want to reduce the number of configurations if this exceeds the available RAM):
In[14]:=
largeSample = generateConfigurations[20,500,500,5000000];
testAccumulate[ff,largeSample];//Timing
Out[15]= {31.89,Null}
We will now extract the full data from the SubValues of ff:
In[16]:= (largeres = getResultingData[ff]); // Timing
Out[16]= {10.844, Null}
This takes some time, but one has to do this only once. But when we start extracting data for a fixed index, we see that it is quite slow:
In[24]:= getResultsForFixedIndex[largeres,10]//Short//Timing
Out[24]= {2.687,{{{196,26},{53,36},{360,43},{104,144},<<157674>>,{31,305},{240,291},
{256,38},{352,469}},{<<1>>}}}
The main idea we will use here to speed it up is to pack individual lists inside the largeres, those for indices, combinations and frequencies. While the full list can not be packed, those parts individually can:
In[18]:= Timing[
subIndicesPacked = Developer`ToPackedArray[largeres[[All,1]]];
subCombsPacked = Developer`ToPackedArray[largeres[[All,2]]];
subFreqsPacked = Developer`ToPackedArray[largeres[[All,3]]];
]
Out[18]= {1.672,Null}
This also takes some time, but it is a one-time operation again.
The following functions will then be used to extract the results for a fixed index much more efficiently:
Clear[extractPositionFromSparseArray];
extractPositionFromSparseArray[HoldPattern[SparseArray[u___]]] := {u}[[4, 2, 2]]
Clear[getCombinationsAndFrequenciesForIndex];
getCombinationsAndFrequenciesForIndex[packedIndices_, packedCombs_,
packedFreqs_, index_Integer] :=
With[{positions =
extractPositionFromSparseArray[
SparseArray[1 - Unitize[packedIndices - index]]]},
{Extract[packedCombs, positions],Extract[packedFreqs, positions]}];
Now, we have:
In[25]:=
getCombinationsAndFrequenciesForIndex[subIndicesPacked,subCombsPacked,subFreqsPacked,10]
//Short//Timing
Out[25]= {0.094,{{{196,26},{53,36},{360,43},{104,144},<<157674>>,{31,305},{240,291},
{256,38},{352,469}},{<<1>>}}}
We get a 30 times speed-up w.r.t. the naive Select approach.
Some notes on complexity
Note that the second solution is faster because it uses optimized data structures, but its complexity is the same as that of Select- based one, which is, linear in the length of total list of unique combinations for all indices. Therefore, in theory, the previously - discussed solutions based on nested hash-table etc may be asymptotically better. The problem is, that in practice we will probably hit the memory limitations long before that. For the 10 million configurations sample, the above code was still 2-3 times faster than the fastest solution I posted before.
EDIT
The following modification:
Clear[getCombinationsAndFrequenciesForIndex];
getCombinationsAndFrequenciesForIndex[packedIndices_, packedCombs_,
packedFreqs_, index_Integer] :=
With[{positions =
extractPositionFromSparseArray[
SparseArray[Unitize[packedIndices - index], Automatic, 1]]},
{Extract[packedCombs, positions], Extract[packedFreqs, positions]}];
makes the code twice faster still. Moreover, for more sparse indices (say, calling the sample-generation function with parameters like generateConfigurations[2000, 500, 500, 5000000] ), the speed-up with respect to the Select- based function is about 100 times.
I'd probably use SparseArrays here (see update below), but if you insist on using functions and *Values to store and retrieve values an approach would be to have the first part (f[2] etc.) replaced by a symbol you create on the fly like:
Table[Symbol["f" <> IntegerString[i, 10, 3]], {i, 11}]
(* ==> {f001, f002, f003, f004, f005, f006, f007, f008, f009, f010, f011} *)
Symbol["f" <> IntegerString[56, 10, 3]]
(* ==> f056 *)
Symbol["f" <> IntegerString[56, 10, 3]][{3, 4}] = 12;
Symbol["f" <> IntegerString[56, 10, 3]][{23, 18}] = 12;
Symbol["f" <> IntegerString[56, 10, 3]] // Evaluate // DownValues
(* ==> {HoldPattern[f056[{3, 4}]] :> 12, HoldPattern[f056[{23, 18}]] :> 12} *)
f056 // DownValues
(* ==> {HoldPattern[f056[{3, 4}]] :> 12, HoldPattern[f056[{23, 18}]] :> 12} *)
Personally I prefer Leonid's solution, as it's much more elegant but YMMV.
Update
On OP's request, about using SparseArrays:
Large SparseArrays take up a fraction of the size of standard nested lists. We can make f to be a large (100,000 entires) sparse array of sparse arrays:
f = SparseArray[{_} -> 0, 100000];
f // ByteCount
(* ==> 672 *)
(* initialize f with sparse arrays, takes a few seconds with f this large *)
Do[ f[[i]] = SparseArray[{_} -> 0, {100, 110}], {i,100000}] // Timing//First
(* ==> 18.923 *)
(* this takes about 2.5% of the memory that a normal array would take: *)
f // ByteCount
(* ==> 108000040 *)
ConstantArray[0, {100000, 100, 100}] // ByteCount
(* ==> 4000000176 *)
(* counting phase *)
f[[1]][[1, 2]]++;
f[[1]][[1, 2]]++;
f[[1]][[42, 64]]++;
f[[2]][[100, 11]]++;
(* reporting phase *)
f[[1]] // ArrayRules
f[[2]] // ArrayRules
f // ArrayRules
(*
==>{{1, 2} -> 2, {42, 64} -> 1, {_, _} -> 0}
==>{{100, 11} -> 1, {_, _} -> 0}
==>{{1, 1, 2} -> 2, {1, 42, 64} -> 1, {2, 100, 11} -> 1, {_, _, _} -> 0}
*)
As you can see, ArrayRules makes a nice list with contributions and counts. This can be done for each f[i] separately or the whole bunch together (last line).
In some scenarios (depending upon the performance needed to generate the values), the following easy solution using an auxiliary list (f[i,0]) may be useful:
f[_Integer][{_Integer ..}] := 0;
f[_Integer, 0] := Sequence ## {};
Table[
r = RandomInteger[1000, 2];
f[h = RandomInteger[100000]][r] = RandomInteger[10];
f[h, 0] = Union[f[h, 0], {r}];
, {i, 10^6}];
ExtractConfigurationsAndOccurences[f_, i_] := {f[i, 0], f[i][#] & /# f[i, 0]};
Timing#ExtractConfigurationsAndOccurences[f, 10]
Out[252]= {4.05231*10^-15, {{{172, 244}, {206, 115}, {277, 861}, {299,
862}, {316, 194}, {361, 164}, {362, 830}, {451, 306}, {614,
769}, {882, 159}}, {5, 2, 1, 5, 4, 10, 4, 4, 1, 8}}}
Many thanks for everyone on the help provided. I've been thinking a lot about everybody's input and I believe that in the simulation setup the following is the optimal solution:
SetAttributes[linkedList, HoldAllComplete];
temporarySymbols = linkedList[];
SetAttributes[bookmarkSymbol, Listable];
bookmarkSymbol[symbol_]:=
With[{old = temporarySymbols}, temporarySymbols= linkedList[old,symbol]];
registerConfiguration[index_]:=registerConfiguration[index]=
Module[
{
cs = linkedList[],
bookmarkConfiguration,
accumulator
},
(* remember the symbols we generate so we can remove them later *)
bookmarkSymbol[{cs,bookmarkConfiguration,accumulator}];
getCs[index] := List ## Flatten[cs, Infinity, linkedList];
getCsAndFreqs[index] := {getCs[index],accumulator /# getCs[index]};
accumulator[_]=0;
bookmarkConfiguration[c_]:=bookmarkConfiguration[c]=
With[{oldCs=cs}, cs = linkedList[oldCs, c]];
Function[c,
bookmarkConfiguration[c];
accumulator[c]++;
]
]
pattern = Verbatim[RuleDelayed][Verbatim[HoldPattern][HoldPattern[registerConfiguration [_Integer]]],_];
clearSimulationData :=
Block[{symbols},
DownValues[registerConfiguration]=DeleteCases[DownValues[registerConfiguration],pattern];
symbols = List ## Flatten[temporarySymbols, Infinity, linkedList];
(*Print["symbols to purge: ", symbols];*)
ClearAll /# symbols;
temporarySymbols = linkedList[];
]
It is based on Leonid's solution from one of previous posts, appended with belsairus' suggestion to include extra indexing for configurations that have been processed. Previous approaches are adapted so that configurations can be naturally registered and extracted using the same code more or less. This is hitting two flies at once since bookkeeping and retrieval and strongly interrelated.
This approach will work better in the situation when one wants to add simulation data incrementally (all curves are normally noisy so one has to add runs incrementally to obtain good plots). The sparse array approach will work better when data are generated in one go and then analyzed, but I do not remember being personally in such a situation where I had to do that.
Also, I was rather naive thinking that the data extraction and generation could be treated separately. In this particular case it seems one should have both perspectives in mind. I profoundly apologise for bluntly dismissing any previous suggestions in this direction (there were few implicit ones).
There are some open/minor problems that I do not know how to handle, e.g. when clearing the symbols I cannot clear headers like accumulator$164, I can only clean subvalues associated with it. Have not clue why. Also, if With[{oldCs=cs}, cs = linkedList[oldCs, c]]; is changed into something like cs = linkedList[cs, c]]; configurations are not stored. Have no clue either why the second option does not work. But these minor problems are well defined satellite issues that one can address in the future. By and large the problem seems solved by the generous help from all involved.
Many thanks again for all the help.
Regards
Zoran
p.s. There are some timings, but to understand what is going on I will append the code that is used for benchmarking. In brief, idea is to generate lists of configurations and just Map through them by invoking registerConfiguration. This essentially simulates data generation process. Here is the code used for testing:
fillSimulationData[sampleArg_] :=MapIndexed[registerConfiguration[#2[[1]]][#1]&, sampleArg,{2}];
sampleForIndex[index_]:=
Block[{nsamples,min,max},
min = Max[1,Floor[(9/10)maxSamplesPerIndex]];
max = maxSamplesPerIndex;
nsamples = RandomInteger[{min, max}];
RandomInteger[{1,10},{nsamples,ntypes}]
];
generateSample :=
Table[sampleForIndex[index],{index, 1, nindexes}];
measureGetCsTime :=((First # Timing[getCs[#]])& /# Range[1, nindexes]) // Max
measureGetCsAndFreqsTime:=((First # Timing[getCsAndFreqs[#]])& /# Range[1, nindexes]) // Max
reportSampleLength[sampleArg_] := StringForm["Total number of confs = ``, smallest accumulator length ``, largest accumulator length = ``", Sequence## {Total[#],Min[#],Max[#]}& [Length /# sampleArg]]
The first example is relatively modest:
clearSimulationData;
nindexes=100;maxSamplesPerIndex = 1000; ntypes = 2;
largeSample1 = generateSample;
reportSampleLength[largeSample1];
Total number of confs = 94891, smallest accumulator length 900, largest accumulator length = 1000;
First # Timing # fillSimulationData[largeSample1]
gives 1.375 secs which is fast I think.
With[{times = Table[measureGetCsTime, {50}]},
ListPlot[times, Joined -> True, PlotRange -> {0, Max[times]}]]
gives times around 0.016 secs, and
With[{times = Table[measureGetCsAndFreqsTime, {50}]},
ListPlot[times, Joined -> True, PlotRange -> {0, Max[times]}]]
gives same times. Now the real killer
nindexes = 10; maxSamplesPerIndex = 100000; ntypes = 10;
largeSample3 = generateSample;
largeSample3 // Short
{{{2,2,1,5,1,3,7,9,8,2},92061,{3,8,6,4,9,9,7,8,7,2}},8,{{4,10,1,5,9,8,8,10,8,6},95498,{3,8,8}}}
reported as
Total number of confs = 933590, smallest accumulator length 90760, largest accumulator length = 96876
gives generation times of ca 1.969 - 2.016 secs which is unbeliavably fast. I mean this is like going through the gigantic list of ca one million elements and applying a function to each element.
The extraction times for configs and {configs, freqs} are roughly 0.015 and 0.03 secs respectivelly.
To me this is a mind blowing speed I would never expect from Mathematica!
I have a question regarding Mathematica's global optimization capability. I came across this text related to the NAG toolbox (kind of white paper).
Now I tried to solve the test case from the paper. As expected Mathematica was pretty fast in solving it.
n=2;
fun[x_,y_]:=10 n+(x-2)^2-10Cos[2 Pi(x-2)]+(y-2)^2-10 Cos[2 Pi(y-2)];
NMinimize[{fun[x,y],-5<= x<= 5&&-5<= y<= 5},{x,y},Method->{"RandomSearch","SearchPoints"->13}]//AbsoluteTiming
Output was
{0.0470026,{0.,{x->2.,y->2.}}}
One can see the points visited by the optimization routine.
{sol, pts}=Reap[NMinimize[{fun[x,y],-5<= x<= 5&&-5<= y<= 5},{x,y},Method->`{"RandomSearch","SearchPoints"->13},EvaluationMonitor:>Sow[{x,y}]]];Show[ContourPlot[fun[x,y],{x,-5.5,5.5},{y,-5.5,5.5},ColorFunction->"TemperatureMap",Contours->Function[{min,max},Range[min,max,5]],ContourLines->True,PlotRange-> All],ListPlot[pts,Frame-> True,Axes-> False,PlotRange-> All,PlotStyle-> Directive[Red,Opacity[.5],PointSize[Large]]],Graphics[Map[{Black,Opacity[.7],Arrowheads[.026],Arrow[#]}&,Partition[pts//First,2,1]],PlotRange-> {{-5.5,5.5},{-5.5,5.5}}]]`
Now I thought of solving the same problem on higher dimension. For problems of five variables mathematica started to fall in the traps of local minimum even when large number of search points are allowed.
n=5;funList[x_?ListQ]:=Block[{i,symval,rule},
i=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];symval=10 n+Sum[(i[[k]]-2)^2-10Cos[2Pi(i[[k]]-2)],{k,1,n}];rule=MapThread[(#1-> #2)&,{i,x}];symval/.rule]val=Table[RandomReal[{-5,5}],{i,1,n}];vars=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];cons=Table[-5<=ToExpression["x$"<>ToString[j]]<= 5,{j,1,n}]/.List-> And;NMinimize[{funList[vars],cons},vars,Method->{"RandomSearch","SearchPoints"->4013}]//AbsoluteTiming
Output was not what we wold have liked to see. Took 49 sec in my core2duo machine and still it is a local minimum.
{48.5157750,{1.98992,{x$1->2.,x$2->2.,x$3->2.,x$4->2.99496,x$5->1.00504}}}
Then tried SimulatedAnealing with 100000 iterations.
NMinimize[{funList[vars],cons},vars,Method->"SimulatedAnnealing",MaxIterations->100000]//AbsoluteTiming
Output was still not agreeable.
{111.0733530,{0.994959,{x$1->2.,x$2->2.99496,x$3->2.,x$4->2.,x$5->2.}}}
Now Mathematica has an exact optimization algorithm called Minimize. Which as expected must fail on practicality but it fails very fast as the problem size increases.
n=3;funList[x_?ListQ]:=Block[{i,symval,rule},i=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];symval=10 n+Sum[(i[[k]]-2)^2-10Cos[2 Pi(i[[k]]-2)],{k,1,n}];rule=MapThread[(#1-> #2)&,{i,x}];symval/.rule]val=Table[RandomReal[{-5,5}],{i,1,n}];vars=Table[ToExpression["x$"<>ToString[j]],{j,1,n}];cons=Table[-5<=ToExpression["x$"<>ToString[j]]<= 5,{j,1,n}]/.List-> And;Minimize[{funList[vars],cons},vars]//AbsoluteTiming
output is perfectly all right.
{5.3593065,{0,{x$1->2,x$2->2,x$3->2}}}
But if one changes the problem size one step further with n=4 you see the result. Solution does not appear for long time in my notebook.
Now the question simple does anybody here think there is a way to numerically solve this problem efficiently in Mathematica for higher dimensional cases? Lets share our ideas and experience. However one should remember that it is a benchmark nonlinear global optimization problem. Most numerical root-finding/minimization algorithms usually searches the local minimum.
BR
P
Increasing initial points allows me to get to the global minimum:
n = 5;
funList[x_?ListQ] := Total[10 + (x - 2)^2 - 10 Cos[2 Pi (x - 2)]]
val = Table[RandomReal[{-5, 5}], {i, 1, n}];
vars = Array[Symbol["x$" <> ToString[#]] &, n];
cons = Apply[And, Thread[-5 <= vars <= 5]];
These are the calls. The timing may not be too efficient though, but with randomized algorithms, one has to have enough initial samples, or a good feel for the function.
In[27]:= NMinimize[{funList[vars], cons}, vars,
Method -> {"DifferentialEvolution",
"SearchPoints" -> 5^5}] // AbsoluteTiming
Out[27]= {177.7857768, {0., {x$1 -> 2., x$2 -> 2., x$3 -> 2.,
x$4 -> 2., x$5 -> 2.}}}
In[29]:= NMinimize[{funList[vars], cons}, vars,
Method -> {"RandomSearch", "SearchPoints" -> 7^5}] // AbsoluteTiming
Out[29]= {609.3419281, {0., {x$1 -> 2., x$2 -> 2., x$3 -> 2.,
x$4 -> 2., x$5 -> 2.}}}
Have you seen this page of the documentation? It goes over the methods supported by NMinimize, with examples for each. One of the SimulatedAnnealing examples is Rastgrin's function (or one very similar), and the docs suggest that you need to increase the perturbation size to get good results.
I have used mathematica mostly as a mathematics workbench and for writing relatively small ad-hoc programs. I am however designing a system which I intend to program in Mathematica. I need to store data in a tree, and search and traverse the tree. Although I know how to implement a tree, I prefer standard, tested code. I looked at what sort of packages there are for basic datastructures at the Mathematica users wiki. I have found none, although there is a small example in the Mathematica documentation.
Now to my question(s):
Is there an ( open source ) package for data structures available somewhere?
What approach have you used with regard to data structures? Gradually developing your own util package?
( Not a question, just a remark. Maybe... the lack of ( lots of available ) open source packages is the reason why Mathematica doesn't have the momentum it deserves. A chicken / egg issue, I am afraid. )
In Mathematica, most of what you do is based on expressions. Expressions naturally have the tree structure. For depth-first traversals (which are probably most common), you can then use functions like Scan,Map, Cases etc. The difference w.r.t the more traditional languages is that there is no simple way to preserve the identity of individual node in an expression tree, since there are no pointers in Mathematica. Also, many operations on expressions that are idiomatic in Mathematica would copy the entire expression when you only need to modify it in a few places, because expressions are immutable.
Using immutable Mathematica expressions as trees still has several advantages. One is that, because they are immutable, it is easy to understand what they store by just looking at them (state and behavior are not mixed). Another is that there are efficient and generic functions such as Map, MapIndexed or Scan, that traverse them. For example, the visitor design pattern is invisible - it is just Map[f,tree,Infinity], built into the langauge. Also, there are built-in functions such as Cases, Replace, ReplaceAll, etc, which allow one to write very concise and declarative code to destructure trees, find pieces of trees with certain syntax or satisfying some condition, etc. Since trees are not restricted to only be built from lists and be built from different heads, one can effectively use this to write very concise tree-processing code. Finally, a freedom to very easily build any tree structure you want makes it much easier to perform experiments and prototype things, in the spirit of exploratory and bottom-up programming, which shortens the development cycle and ultimately leads to better designs.
That said, you can certainly implement "stateful" (mutable) tree data structure. The real reason it has not been done yet generally is, I suspect, the performance hit associated with building, modifying and traversing such a tree, since it will undergo a full symbolic evaluation process at every step (see this post for more details on that). For 2 examples of how, for example, a binary search tree can be used in Mathematica context for pretty efficient code, see my posts here (generic symbolic setting) and here (in the context of Compiled code). For general ways to construct data structures idiomatically in Mathematica, I recommend books of Roman Maeder: "Programming in Mathematica", "Mathematica programmer I&II", and especially "Computer Science in Mathematica". In the latter he has a detailed discussion of how to implement binary search tree in Mathematica. EDIT As #Simon mentioned, the talk of #Daniel Lichtblau is also a great resource, which shows how to build data structures and make them efficient.
Regarding general ways to implement data structures in Mathematica which would incorporate some state, here is a simple example extracted from my post in this Mathgroup thread - it implements a "pair" data structure.
Unprotect[pair, setFirst, getFirst, setSecond, getSecond, new, delete];
ClearAll[pair, setFirst, getFirst, setSecond, getSecond, new, delete];
Module[{first, second},
first[_] := {};
second[_] := {};
pair /: new[pair[]] := pair[Unique[]];
pair /: pair[tag_].delete[] := (first[tag] =.; second[tag] =.);
pair /: pair[tag_].setFirst[value_] := first[tag] = value;
pair /: pair[tag_].getFirst[] := first[tag];
pair /: pair[tag_].setSecond[value_] := second[tag] = value;
pair /: pair[tag_].getSecond[] := second[tag];
Format[pair[x_Symbol]] := "pair[" <> ToString[Hash[x]] <> "]";
];
Protect[pair, setFirst, getFirst, setSecond, getSecond, new, delete];
Here is how you could use it:
pr = new[pair[]];
pr.setFirst[10];
pr.setSecond[20];
{pr.getFirst[], pr.getSecond[]}
{10, 20}
Creating a list of new pair objects :
pairs = Table[new[pair[]], {10}]
{"pair[430427975]", "pair[430428059]", "pair[430428060]", "pair[430428057]",
"pair[430428058]", "pair[430428063]", "pair[430428064]", "pair[430428061]",
"pair[430428062]", "pair[430428051]"}
Setting the fields :
Module[{i},
For[i = 1, i <= 10, i++,
pairs[[i]].setFirst[10*i];
pairs[[i]].setSecond[20*i];]]
Checking the fields :
#.getFirst[] & /# pairs
{10, 20, 30, 40, 50, 60, 70, 80, 90, 100}
#.getSecond[] & /# pairs
{20, 40, 60, 80, 100, 120, 140, 160, 180, 200}
In the post I mentioned there is a more detailed discussion. One big problem for "objects" created in this way is that there is no automatic garbage collection for them, which may be one of the major reasons why OOP extensions implemented in top-level Mathematica itself did not really take off.
There are several OOP extensions for Mathematica, such as the classes.m package by Roman Maeder (the source is in his "Mathematica Programmer" book), the Objectica commercial package, and several others. But until Mathematica itself would provide efficient mechanisms (perhaps based on some kind of pointer or reference mechanism) for building mutable data structures (if this ever happens), there will probably be a large performance hit associated with top-level implementations of such data structures in mma. Also, since mma is based on immutability as one of the core ideas, it is not very easy to make mutable data structures fit well with other idioms of Mathematica programming.
EDIT
Here is a bare-bones stateful tree implementation along the lines of the example above:
Module[{parent, children, value},
children[_] := {};
value[_] := Null;
node /: new[node[]] := node[Unique[]];
node /: node[tag_].getChildren[] := children[tag];
node /: node[tag_].addChild[child_node, index_] :=
children[tag] = Insert[children[tag], child, index];
node /: node[tag_].removeChild[index_] :=
children[tag] = Delete[children[tag], index];
node /: node[tag_].getChild[index_] := children[tag][[index]];
node /: node[tag_].getValue[] := value[tag];
node /: node[tag_].setValue[val_] := value[tag] = val;
];
Some examples of use:
In[68]:= root = new[node[]]
Out[68]= node[$7]
In[69]:= root.addChild[new[node[]], 1]
Out[69]= {node[$8]}
In[70]:= root.addChild[new[node[]], 2]
Out[70]= {node[$8], node[$9]}
In[71]:= root.getChild[1].addChild[new[node[]], 1]
Out[71]= {node[$10]}
In[72]:= root.getChild[1].getChild[1].setValue[10]
Out[72]= 10
In[73]:= root.getChild[1].getChild[1].getValue[]
Out[73]= 10
For one non-trivial example of use of this mutable tree data structure, see this post of mine. It also confronts this method with the one more heavily reusing Mathematica native data structures and functions, and illustrates well the points discussed at the beginning of this post.
I have used mathematica mostly as a mathematics workbench and for writing relatively small ad-hoc programs.
Mathematica really excels at this.
What approach have you used with regard to data structures? Gradually developing your own util package?
I avoid creating my own data structures in Mathematica because it cannot handle them efficiently. Specifically, general data structures tend to be 10-1,000× slower in Mathematica than elsewhere which greatly limits their practical usefulness. For example, Mathematica is 100× slower than F# at computing the range of depths in a red-black tree.
Logic programming with lists is one example where Mathematica is typically orders of magnitude slower than other compiled languages. The following Mathematica program uses linked lists to solve the n-queens problem:
safe[{x0_, y0_}][{x1_, y1_}] :=
x0 != x1 && y0 != y1 && x0 - y0 != x1 - y1 && x0 + y0 != x1 + y1
filter[_, {}] := {}
filter[p_, {h_, t_}] := If[p[h], {h, filter[p, t]}, filter[p, t]]
search[n_, nqs_, qs_, {}, a_] := If[nqs == n, a + 1, a]
search[n_, nqs_, qs_, {q_, ps_}, a_] :=
search[n, nqs, qs, ps,
search[n, nqs + 1, {q, qs}, filter[safe[q], ps], a]]
ps[n_] :=
Fold[{#2, #1} &, {}, Flatten[Table[{i, j}, {i, n}, {j, n}], 1]]
solve[n_] := search[n, 0, {}, ps[n], 0]
Here is the equivalent F#:
let safe (x0, y0) (x1, y1) =
x0<>x1 && y0<>y1 && x0-y0<>x1-y1 && x0+y0<>x1+y1
let rec filter f = function
| [] -> []
| x::xs -> if f x then x::filter f xs else filter f xs
let rec search n nqs qs ps a =
match ps with
| [] -> if nqs=n then a+1 else a
| q::ps ->
search n (nqs+1) (q::qs) (filter (safe q) ps) a
|> search n nqs qs ps
let ps n =
[ for i in 1..n do
for j in 1..n do
yield i, j ]
let solve n = search n 0 [] (ps n) 0
solve 8
Solving the 8-queens problem takes 10.5s with Mathematica and 0.07s with F#. So F# is 150× faster than Mathematica in this case.
The Stack Overflow question Mathematica "linked lists" and performance gives a more extreme example. Naive translation of that Mathematica code into F# gives an equivalent program that runs between 4,000 and 200,000× faster than the Mathematica:
let rand = System.Random()
let xs = List.init 10000 (fun _ -> rand.Next 100)
Array.init 100 (fun _ ->
let t = System.Diagnostics.Stopwatch.StartNew()
ignore(List.length xs)
t.Elapsed.TotalSeconds)
Specifically, Mathematica takes 0.156s to 16s to perform a single iteration whereas the F# takes 42µs to 86µs.
If I really want to stay in Mathematica then I shoehorn everything I'm doing into Mathematica's handful of built-in data structures, e.g. Dispatch.