Related
I have several 100x15 matrices; one of them is a distance. When elements of that matrix exceed a bound, I want to reset those elements to zero and also reset the corresponding elements of three other matrices to zero. Here's my silly way (but it works):
Do[ If[ xnow[[i, j]] > L, xnow[[i, j]] = 0.;
cellactvA[[i, j ]] = 0.;
cellactvB[[i, j ]] = 0.;
cellactvC[[i, j ]] = 0.; ], (* endIF *)
{ i, 1, nstrips}, {j, 1, ncells} ]; (* endDO *)
I tried ReplacePart:
xnow = ReplacePart[ xnow, Position[ xnow, x_?(# > L &) ] ]
(something like this, I don't have it handy; it was done correctly enough to execute), but it was as slow as the loop and did not produce the correct replacement structure in matrix xnow. Please advise on how to do this in a way that is reasonably quick, as this calc is inside another loop (over time) that executes many many times. The overall calculation is of course, now, very slow. Thanks in advance.
Here is how I did this in R; very simple and quick:
# -- find indices of cells outside window
indxoutRW <- which( xnow > L, arr.ind=T )
# -- reset cells outside window
cellrateA[indxoutRW] <- 0
cellrateB[indxoutRW] <- 0
cellrateC[indxoutRW] <- 0
# -- move reset cells back to left side
xnow[indxoutRW] <- xnow[indxoutRW] - L
How about this:
Timing[
matrixMask2 = UnitStep[limit - $xnow];
xnow = $xnow*matrixMask2;
cellactvA2 = $a*matrixMask2;
cellactvB2 = $b*matrixMask2;
cellactvC2 = $c*matrixMask2;
]
If you want to write fast code one thing to make sure is to check that On["Packing"] does not gives messages; or at least that you understand them and know that they are not an issue.
Edit for OP comment:
mask = UnitStep[limit - xnow];
{xnow*mask, cellactvA2*mask, cellactvB2*mask, cellactvC2*mask}
Hope this helps, you still need to set limit.
The following will be based on SparseArrays, avoid extraneous stuff and very fast:
extractPositionFromSparseArray[
HoldPattern[SparseArray[u___]]] := {u}[[4, 2, 2]];
positionExtr[x_List, n_] :=
extractPositionFromSparseArray[
SparseArray[Unitize[x - n], Automatic, 1]]
replaceWithZero[mat_, flatZeroPositions_List, type : (Integer | Real) : Real] :=
Module[{copy = Flatten#mat},
copy[[flatZeroPositions]] = If[type === Integer, 0, 0.];
Partition[copy, Last[Dimensions[mat]]]];
getFlatZeroDistancePositions[distanceMat_, lim_] :=
With[{flat = Flatten[distanceMat]},
With[{originalZPos = Flatten# positionExtr[flat , 0]},
If[originalZPos === {}, #, Complement[#, originalZPos ]] &#
Flatten#positionExtr[Clip[flat , {0, lim}, {0, 0}], 0]]];
Now, we generate our matrices, making sure that they are packed:
{xnow, cellactvA, cellactvB, cellactvC} =
Developer`ToPackedArray /# RandomReal[10, {4, 100, 15}];
Here is the benchmark for doing this 1000 times:
In[78]:=
Do[
With[{L = 5},
With[{flatzpos = getFlatZeroDistancePositions[xnow,L]},
Map[replaceWithZero[#,flatzpos ]&,{xnow,cellactvA,cellactvB,cellactvC}]]
],
{1000}]//Timing
Out[78]= {0.203,Null}
Note that there was no unpacking in the process, but you have to ensure that you have your matrices packed from the start, and that you pick the correct type (Integer or Real) for the replaceWithZero function.
Yet another method which seems to be fast
xnow = $xnow; a = $a; b = $b; c = $c;
umask = Unitize#Map[If[# > limit, 0, #] &, xnow, {2}];
xnow = xnow*umask; a = a*umask; b = b*umask; c = c*umask;
Based on limited testing in Nasser's setup it seems it is as fast as the SparseArray-based mask.
Edit: Can combine with SparseArray to get a slight speed-up
umask2=SparseArray[Unitize#Map[If[# > limit, 0, #] &, xnow, {2}]];
xnow = xnow*umask2; a = a*umask2; b = b*umask2; c = c*umask2;
Edit 2: Inspired by ruebenko's solution, another built-in function (not nearly as fast as UnitStep but much faster than others):
umask3 = Clip[xnow, {limit, limit}, {1, 0}];
xnow = xnow*umask3; a = a*umask3; b = b*umask3; c = c*umask3;
Does this approach work for you?
matrixMask =
SparseArray[Thread[Position[xnow, _?(# > 0.75 &)] -> 0.],
Dimensions[xnow], 1.];
xnow = xnow * matrixMask;
cellactvA = cellactvA * matrixMask;
cellactvB = cellactvB * matrixMask;
cellactvC = cellactvC * matrixMask;
The basic idea is to create a matrix that is zero where your threshold is crossed, and one everywhere else. Then we use element-wise multiplication to zero out the appropriate elements in the various matrices.
ReplacePart is notoriously slow.
MapThread should do what you want - note the third argument.
{xnow, cellactvA, cellactvB, cellactvC} =
RandomReal[{0, 1}, {4, 10, 5}]
L = 0.6;
MapThread[If[#1 > L, 0, #2] &, {xnow, xnow}, 2]
And for all four matrices
{xnow, cellactvA, cellactvB, cellactvC} =
MapThread[Function[{x, y}, If[x > L, 0, y]], {xnow, #},
2] & /# {xnow, cellactvA, cellactvB, cellactvC}
may be
(*data*)
nRow = 5; nCol = 5;
With[{$nRow = nRow, $nCol = nCol},
xnow = Table[RandomReal[{1, 3}], {$nRow}, {$nCol}];
cellactvA = cellactvB = cellactvC = Table[Random[], {$nRow}, {$nCol}]
];
limit = 2.0;
now do the replacement
pos = Position[xnow, x_ /; x > limit];
{cellactvA, cellactvB, cellactvC} =
Map[ReplacePart[#, pos -> 0.] &, {cellactvA, cellactvB, cellactvC}];
edit(1)
Here is a quick speed comparing the 4 methods above, the LOOP, and then Brett, me, and Verbeia. May be someone can double check them. I used the same data for all. created random data once, then used it for each test. Same limit (called L) I used matrix size of 2,000 by 2,000.
So speed Timing numbers below does not include data allocation.
I run the tests once.
This is what I see:
For 2,000 by 2,000 matrices:
Bill (loop): 16 seconds
me (ReplacPart): 21 seconds
Brett (SparseArray): 7.27 seconds
Verbeia (MapThread): 32 seconds
For 3,000 by 3,000 matrices:
Bill (loop): 37 seconds
me (ReplacPart): 48 seconds
Brett (SparseArray): 16 seconds
Verbeia (MapThread): 79 seconds
So, it seems to be that SparseArray is the fastest. (but please check to make sure I did not break something)
code below:
data generation
(*data*)
nRow = 2000;
nCol = 2000;
With[{$nRow = nRow, $nCol = nCol},
$xnow = Table[RandomReal[{1, 3}], {$nRow}, {$nCol}];
$a = $b = $c = Table[Random[], {$nRow}, {$nCol}]
];
limit = 2.0;
ReplacePart test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
pos = Position[xnow, x_ /; x > limit];
{xnow, a, b, c} = Map[ReplacePart[#, pos -> 0.] &, {xnow, a, b, c}]][[1]]
SparseArray test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
matrixMask =
SparseArray[Thread[Position[xnow, _?(# > limit &)] -> 0.],
Dimensions[xnow], 1.]; xnow = xnow*matrixMask;
a = a*matrixMask;
b = b*matrixMask;
c = c*matrixMask
][[1]]
MapThread test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
{xnow, a, b, c} =
MapThread[Function[{x, y}, If[x > limit, 0, y]], {xnow, #},
2] & /# {xnow, a, b, c}
][[1]]
loop test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
Do[If[xnow[[i, j]] > limit,
xnow[[i, j]] = 0.;
a[[i, j]] = 0.;
b[[i, j]] = 0.;
c[[i, j]] = 0.
],
{i, 1, nRow}, {j, 1, nCol}
]
][[1]]
edit(2)
There is something really bothering me with all of this. I do not understand how a loop can be faster that the specialized commands for this purpose?
I wrote a simple loop test in Matlab, like Bill had using R, and I getting much lower timings there also. I hope an expert can come up with a much faster method, because now I am not too happy with this.
For 3,000 by 3,000 matrix, I am getting
Elapsed time is 0.607026 seconds.
This is more than 20 times faster than the SparseArray method, and it is just a loop!
%test, on same machine, 4GB ram, timing uses cpu timing using tic/toc
%allocate data
nRow = 3000;
nCol = 3000;
%generate a random matrix of real values
%between 1 and 3
xnow = 1 + (3-1).*rand(nRow,nRow);
%allocate the other 3 matrices
a=zeros(nRow,nCol);
b=a;
c=b;
%set limit
limit=2;
%engine
tstart=tic;
for i=1:nRow
for j=1:nCol
if xnow(i,j) > limit
xnow(i,j) = 0;
a(i,j) = 0;
b(i,j) = 0;
c(i,j) = 0;
end
end
end
toc(tstart)
fyi: using cputime() gives similar values.as tic/toc.
I have defined three variables a,b,c before a while loop, then compute a new var d.
I want to get rid of the biggest value in the three vars a,b,c and then replace it with d value; So I can keep the smallest values in the thre original vars.
a = 1;
b = 2;
c = 10;
While[ condition,
compute d using values of a b and c
d = 4;
a = 1;
b = 2;
c = 4; (*c = d *)
]
to do so I was think to get the max of the three vars and then update it depeneding wich has greatest value..
a = 1;
b = 2;
c = 10;
d = 4;
temp = Max[a, b];
maxim = Max[c, temp];
a = a; (*did not change*)
b = b; (*did not change*)
c = d = 4 (*changed!!*)
So after that a new iteraion will occur and update the three vars...
Another option is as follows:
Clear#updateList
SetAttributes[updateList, HoldFirst]
updateList[list_, value_] :=
Module[{listMax = Max#list},
list = (list /. listMax -> value);]
Now if I define variables as in your case and use the function:
a = 1; b = 10; c = 0;
updateList[{a,b,c},5];
{a,b,c}
Out[1]= {1, 5, 0}
You can see that the variable b, which was the largest has been replaced with the new value.
If you can accept the values in a list (array) rather than individual named Symbols, and if you really mean "most near" rather than greatest, then you may do something like this:
vars = {1, 10, 0};
vars = ReplacePart[vars, Position[vars, Nearest[vars, 5][[1]]] -> 5];
vars
(* Out= {5, 10, 0} *)
This also assumes that values are unique, or that you want to replace all values that match (such as if there is more than one 1 in the list in this example).
If you always what to replace the greatest value, then you could Max[vars] rather than Nearest.
In light of the updated problem description, I propose:
vars = {1, 10, 0};
d = 5;
vars = With[{m = Max[vars]}, If[d < m, vars /. m -> d, vars]]
If you wish to automate this, you may use:
SetAttributes[repmax, HoldFirst]
repmax[s_Symbol, n_?NumericQ] := If[n < #, s = s /. # -> n]& # Max#s
Now:
vals = {1, 10, 0};
repmax[vals, 5];
vals
{1, 5, 0}
vals = {1, 10, 0};
repmax[vals, 12];
vals
{1, 10, 0}
This is probably not the best way to go about this problem,
a = 1; b = 10; c = 0;
Position[#, Max##] &#{a, b, c}
{a, b, c} = ReplacePart[{a, b, c}, % -> 5]
You'd be better off defining your original values in as a list abc = {1, 10, 0} and then replacing the max element of the list. As I noticed Mr Wizard has just done in his answer.
You can also do something like
SetAttributes[ReplaceMax, HoldFirst]
ReplaceMax[list : {__Symbol}, val_] := Module[{pos},
pos = Flatten#Position[#, Max#Select[#, N[#] \[Element] Reals &]]&#list;
Do[Evaluate[(HoldPattern /# Unevaluated#list)[[p]]] = val,
{p, pos}]]
Then
In[15]:= {a, b, c, d, e} = {1, 15, 6, 17 + I, x};
In[16]:= ReplaceMax[{a, b, c, d, e}, 5]
{a, b, c, d, e}
Out[17]= {1, 5, 6, 17 + I, x}
I have Mathematica 7.01 and Mathematica 5.2 installed on the same machine. I wish to be able to evaluate code in the v.5.2 kernel from within Mathematica 7.01 session. I mean that running Mathematica 7.0.1 standard session I wish to have a command like kernel5Evaluate to evaluate some code in the 5.2 kernel and return the result into the 7.01 kernel and linked 7.01 FrontEnd notebook in such a way as this code would be executed in the 7.01 kernel.
For example (in the standard Mathematica v.7.01 session):
In[1]:= solutionFrom5 = kernel5Evaluate[NDSolve[{(y^\[Prime])[x]==y[x],y[1]==2},y,{x,0,3}]]
Out[1]= {{y -> InterpolatingFunction[{{0., 3.}}, <>]}}
In[2]:= kernel5Evaluate[Plot3D[Sin[x y],{x,-Pi,Pi},{y,-Pi,Pi}]]
During evaluation of In[2]:= GraphicsData["PostScript", "\<\............
Out[2]= -SurfaceGraphics-
In the both cases the result should be as if the v.5.2 kernel is set to be "Notebook's Kernel" in the v.7.01 FrontEnd. And of course solutionFrom5 variable should be set to the real solution returned by v.5.2 kernel.
Here is an implementation based on Simon's code. It still requires improvement. The one unclear thing to me is how to handle Messages generated in the slave (v.5.2) kernel.
Here is my code:
Clear[linkEvaluate]
SetAttributes[linkEvaluate, HoldRest]
linkEvaluate[link_LinkObject, expr_] := Catch[
Module[{out = {}, postScript = {}, packet, outputs = {}},
While[LinkReadyQ[link],
Print["From the buffer:\t", LinkRead[link]]];
LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
While[Not#MatchQ[packet = LinkRead[link], InputNamePacket[_]],
Switch[packet,
DisplayPacket[_], AppendTo[postScript, First#packet],
DisplayEndPacket[_], AppendTo[postScript, First#packet];
CellPrint#
Cell[GraphicsData["PostScript", #], "Output",
CellLabel -> "Kernel 5.2 PostScript ="] &#
StringJoin[postScript]; postScript = {},
TextPacket[_],
If[StringMatchQ[First#packet,
WordCharacter .. ~~ "::" ~~ WordCharacter .. ~~ ": " ~~ __],
CellPrint#
Cell[BoxData#
RowBox[{StyleBox["Kernel 5.2 Message = ",
FontColor -> Blue], First#packet}], "Message"],
CellPrint#
Cell[First#packet, "Output", CellLabel -> "Kernel 5.2 Print"]],
OutputNamePacket[_], AppendTo[outputs, First#packet];,
ReturnExpressionPacket[_], AppendTo[outputs, First#packet];,
_, AppendTo[out, packet]
]
];
If[Length[out] > 0, Print[out]];
Which[
(l = Length[outputs]) == 0, Null,
l == 2, Last#outputs,
True, multipleOutput[outputs]
]
]];
Clear[kernel5Evaluate]
SetAttributes[kernel5Evaluate, HoldAll]
kernel5Evaluate[expr_] :=
If[TrueQ[MemberQ[Links[], $kern5]], linkEvaluate[$kern5, expr],
Clear[$kern5]; $kern5 = LinkLaunch[
"C:\\Program Files\\Wolfram Research\\Mathematica\\5.2\\MathKernel.exe -mathlink"];
LinkRead[$kern5];
LinkWrite[$kern5,
Unevaluated[EnterExpressionPacket[$MessagePrePrint = InputForm;]]];
LinkRead[$kern5]; kernel5Evaluate[expr]]
Here are test expressions:
plot = kernel5Evaluate[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}]]
plot = kernel5Evaluate[Plot[Sin[x], {x, 0, Pi}]; Plot[Sin[x], {x, -Pi, Pi}]] //
DeleteCases[#, HoldPattern[DefaultFont :> $DefaultFont], Infinity] &
s = kernel5Evaluate[
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]]
s // InputForm // Short
kernel5Evaluate[1/0; Print["s"];]
It seems to work as expected. However it could be better...
Here is working implementation of what I wanted. I have added checking for a dead MathLink connection as suggested by Todd Gayley here. Now kernel5Evaluate works reliable even if the slave kernel was terminated in unusual way. I also have much improved parsing of Messages and added some diagnostic messages for kernel5Evaluate. Here is the code:
$kern5Path = "C:\\Program Files\\Wolfram Research\\Mathematica\\5.2\\MathKernel.exe";
Clear[printMessage, printPrint, printPostScript]
printMessage[str_String] :=
CellPrint#
Cell[BoxData[
RowBox[StringSplit[str,
x : ("MyDelimeterStart" | "MyDelimeterEnd") :> x] //. {x___,
"MyDelimeterStart", y_, "MyDelimeterEnd", z___} :> {x,
ToExpression[y], z}]], "Message",
CellLabel -> "(Kernel 5.2)", ShowCellLabel -> True];
printPostScript =
CellPrint#
Cell[GraphicsData["PostScript", #], "Graphics",
CellLabel -> "(Kernel 5.2 PostScript)", ShowCellLabel -> True] &;
printPrint[str_String] :=
CellPrint#
Cell[If[StringTake[str, -1] === "\n", StringDrop[str, -1], str],
"Print", CellLabel -> "(Kernel 5.2 print, text mode)",
ShowCellLabel -> True];
Clear[linkEvaluate]
SetAttributes[linkEvaluate, HoldAllComplete]
linkEvaluate[link_LinkObject, expr_] := Catch[
Module[{out = {}, postScript = {}, packet, result = Null},
If[LinkReadyQ[link],
While[LinkReadyQ[link],
Print["Rest of the buffer:\t",
packet = LinkRead[link, Hold]]];
If[Not#MatchQ[packet, Hold[InputNamePacket[_]]],
Message[kernel5Evaluate::linkIsBusy]; Throw[$Failed]]];
LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
While[
Check[Not#
MatchQ[packet = LinkRead[link, Hold],
Hold[InputNamePacket[_]]],
Message[kernel5Evaluate::linkIsClosed]; Throw[$Failed]],
Switch[packet,
Hold#DisplayPacket[_String],
AppendTo[postScript, First#First#packet],
Hold#DisplayEndPacket[_String],
AppendTo[postScript, First#First#packet];
printPostScript#StringJoin[postScript]; postScript = {},
Hold#MessagePacket[__], ,
Hold#TextPacket[_String],
If[StringMatchQ[First#First#packet,
WordCharacter .. ~~ "::" ~~ WordCharacter .. ~~ ": " ~~ __],
printMessage[First#First#packet],
printPrint[First#First#packet]],
Hold#OutputNamePacket[_], ,
Hold#ReturnExpressionPacket[_], result = First[First[packet]],
_, AppendTo[out, packet]
]
];
If[Length[out] > 0, Print["Unparsed packets: ", out]];
result
]];
Clear[kernel5Evaluate]
SetAttributes[kernel5Evaluate, HoldAllComplete]
kernel5Evaluate::usage = "kernel5Evaluate[\!\(\*
StyleBox[\"expr\",\nFontFamily->\"Times New Roman\",\n\
FontSlant->\"Italic\"]\)] writes \!\(\*
StyleBox[\"expr\",\nFontFamily->\"Times New Roman\",\n\
FontSlant->\"Italic\"]\) to MathKernel 5.2, returns output and prints \
messages generated during computation.";
kernel5Evaluate::linkIsBusy =
"Kernel 5.2 is still running previous calculation.";
kernel5Evaluate::linkIsClosed = "Connection to Kernel 5.2 is lost.";
kernel5Evaluate::kernel5NotFound =
"Path `1` not found. Please set variable $kern5Path to correct path \
to MathKernel 5.2.";
kernel5Evaluate[expr_] :=
If[TrueQ[MemberQ[Links[], $kern5]],
If[LinkReadyQ[$kern5]; First[LinkError[$kern5]] == 0,
With[{$kern5 = $kern5}, linkEvaluate[$kern5, expr]],
LinkClose[$kern5]; kernel5Evaluate[expr]],
Clear[$kern5];
If[FileExistsQ[$kern5Path],
$kern5 = LinkLaunch[$kern5Path <> " -mathlink -noinit"];
LinkRead[$kern5]; LinkWrite[$kern5,
Unevaluated[
EnterExpressionPacket[$MessagePrePrint = ("MyDelimeterStart" <>
ToString[ToBoxes[#]] <> "MyDelimeterEnd") &;
SetOptions[$Output, {PageWidth -> Infinity}];]]];
LinkRead[$kern5]; kernel5Evaluate[expr],
Message[kernel5Evaluate::kernel5NotFound, $kern5Path]; $Failed]
]
And here are some test expressions:
kernel5Evaluate[Unevaluated[2 + 2]]
kernel5Evaluate[$Version]
kernel5Evaluate[Quit[]]
kernel5Evaluate[Print["some string"];]
kernel5Evaluate[Sin[1,]]
kernel5Evaluate[1/0]
kernel5Evaluate[{Plot[Sin[x], {x, 0, Pi}],
Plot[Sin[x], {x, -Pi, Pi}]}] //
DeleteCases[#, HoldPattern[DefaultFont :> $DefaultFont], Infinity] &
kernel5Evaluate[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}]];
ListPlot3D[First#%, Mesh -> Full, DataRange -> MeshRange /. Last[%]]
s = kernel5Evaluate[
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]]
% // InputForm // Short
kernel5Evaluate[ContourPlot[Sin[x y], {x, -5, 5}, {y, -5, 5}]];
ListContourPlot[First#%, DataRange -> MeshRange /. Last[%],
Contours -> 10,
Method -> {"Refinement" -> {"CellDecomposition" -> "Quad"}}]
Here's my attempt at what you want,
First I define linkEvaluate that takes an active Link and passes it an expression.
If there's things for LinkRead still to read, then it reads them until there are no more.
Then it writes the expression and waits for the results to come back.
Then it reads the output until there's nothing left to read.
Normally, it then returns the first ReturnExpressionPacket unless you have set the final, optional argument, all, to True - in which case it returns everything it read.
Clear[linkEvaluate]
SetAttributes[linkEvaluate, HoldRest]
linkEvaluate[link_LinkObject, expr_, all : (True | False) : False] :=
Catch[Module[{out = {}},
While[LinkReadyQ[link], PrintTemporary[LinkRead[link]]];
If[LinkReadyQ[link], Throw["huh"]];
LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
While[! LinkReadyQ[link], Pause[.1]];
While[LinkReadyQ[link], AppendTo[out, LinkRead[link]]];
If[all, out, Cases[out, _ReturnExpressionPacket][[1, 1]]]
]];
Then kernel5Evaluate first checks if the global $kern5 is defined as a LinkObject, if not then it defines it. It then simply passes the work over to linkEvaluate.
You will have to replace "math5" with the filename and path of your Mma 5.2 kernel.
Clear[kernel5Evaluate]
SetAttributes[kernel5Evaluate, HoldAll]
kernel5Evaluate[expr_, all:(True|False):False] := If[TrueQ[MemberQ[Links[], $kern5]],
linkEvaluate[$kern5, expr, all],
Clear[$kern5]; $kern5 = LinkLaunch["math5 -mathlink"]; kernel5Evaluate[expr,all]
]
I want to use a Structure like HashTable. Is there similar structure in Wolfram Mathematica?
Update: Mathematica version 10 introduced the Association data structure (tutorial).
There are a number of possibilities. The easiest possibility, which works well if you don't need to add or delete keys from your table, or change their associated values, is to construct a list of rules with the key on the left-hand side and the value on the right-hand side, and use Dispatch on it.
If you do need to change the entries in your table, you can use the DownValues of a symbol as a hash table. This will support all the operations one commonly uses with hash tables. Here's the most straightforward way of doing that:
(* Set some values in your table.*)
In[1]:= table[a] = foo; table[b] = bar; table[c] = baz;
(* Test whether some keys are present. *)
In[2]:= {ValueQ[table[a]], ValueQ[table[d]]}
Out[2]:= {True, False}
(* Get a list of all keys and values, as delayed rules. *)
In[3]:= DownValues[table]
Out[3]:= {HoldPattern[table[a]] :> foo, HoldPattern[table[b]] :> bar,
HoldPattern[table[c]] :> baz}
(* Remove a key from your table. *)
In[4]:= Unset[table[b]]; ValueQ[table[b]]
Out[4]:= False
I'd say the most similar structure you can get out of the box are sparse arrays.
I agree with Pillsy, but see also this answer:
Mathematica Downvalue Lhs
It includes a handy function for getting the keys of a hash table.
I've made Dictionary.m module, which contained:
DictHasKey = Function[
{
dict,
key
},
ValueQ[dict[key]]
]
DictAddKey = Function[
{
dict,
key,
value
},
If[
DictHasKey[dict,key],
Print["Warning, Dictionary already has key " <> ToString[key]]
];
dict[key] = value;
]
DictKeys = Function[
{
dict
},
res = {};
ForEach[DownValues[dict], Function[{dictKeyDescr},
res = Append[res, ((dictKeyDescr[[1]]) /. dict -> neverUsedSymbolWhatever)[[1, 1]]];
]];
res
]
DictValues = Function[
{
dict
},
res = {};
ForEach[DownValues[dict], Function[{dictKeyDescr},
res = Append[res, dictKeyDescr[[2]]];
]];
res
]
DictKeyValuePairs = Function[
{
dict
},
res = {};
ForEach[DownValues[dict], Function[{dictKeyDescr},
res = Append[res, {((dictKeyDescr[[1]]) /. dict -> neverUsedSymbolWhatever)[[1, 1]], dictKeyDescr[[2]]}];
]];
res
]
ForEach = Function[
{
list,
func
},
len = Length[list];
For[i = 1, i <= len, i++,
func[
list[[i]]
];
];
]
Mathematica 10 introduces Association, <| k -> v |>,
<|a -> x, b -> y, c -> z|>
%[b]
y
Which is basically a wrapper for a list of rules:
Convert a list of rules to an association:
Association[{a -> x, b -> y, c -> z}]
<|a -> x, b -> y, c -> z|>
Convert an association to a list of rules:
Normal[<|a -> x, b -> y, c -> z|>]
{a -> x, b -> y, c -> z}
Can you do something like Python's yield statement in Mathematica, in order to create generators? See e.g. here for the concept.
Update
Here's an example of what I mean, to iterate over all permutations, using only O(n) space: (algorithm as in Sedgewick's Algorithms book):
gen[f_, n_] := Module[{id = -1, val = Table[Null, {n}], visit},
visit[k_] := Module[{t},
id++; If[k != 0, val[[k]] = id];
If[id == n, f[val]];
Do[If[val[[t]] == Null, visit[t]], {t, 1, n}];
id--; val[[k]] = Null;];
visit[0];
]
Then call it it like:
gen[Print,3], printing all 6 permutations of length 3.
As I have previously stated, using Compile will given faster code. Using an algorithm from fxtbook, the following code generates a next partition in lexicographic ordering:
PermutationIterator[f_, n_Integer?Positive, nextFunc_] :=
Module[{this = Range[n]},
While[this =!= {-1}, f[this]; this = nextFunc[n, this]];]
The following code assumes we run version 8:
ClearAll[cfNextPartition];
cfNextPartition[target : "MVM" | "C"] :=
cfNextPartition[target] =
Compile[{{n, _Integer}, {this, _Integer, 1}},
Module[{i = n, j = n, ni, next = this, r, s},
While[Part[next, --i] > Part[next, i + 1],
If[i == 1, i = 0; Break[]]];
If[i == 0, {-1}, ni = Part[next, i];
While[ni > Part[next, j], --j];
next[[i]] = Part[next, j]; next[[j]] = ni;
r = n; s = i + 1;
While[r > s, ni = Part[next, r]; next[[r]] = Part[next, s];
next[[s]] = ni; --r; ++s];
next
]], RuntimeOptions -> "Speed", CompilationTarget -> target
];
Then
In[75]:= Reap[PermutationIterator[Sow, 4, cfNextPartition["C"]]][[2,
1]] === Permutations[Range[4]]
Out[75]= True
This is clearly better in performance than the original gen function.
In[83]:= gen[dummy, 9] // Timing
Out[83]= {26.067, Null}
In[84]:= PermutationIterator[dummy, 9, cfNextPartition["C"]] // Timing
Out[84]= {1.03, Null}
Using Mathematica's virtual machine is not much slower:
In[85]:= PermutationIterator[dummy, 9,
cfNextPartition["MVM"]] // Timing
Out[85]= {1.154, Null}
Of course this is nowhere near C code implementation, yet provides a substantial speed-up over pure top-level code.
You probably mean the question to be more general but the example of iterating over permutations as given on the page you link to happens to be built in to Mathematica:
Scan[Print, Permutations[{1, 2, 3}]]
The Print there can be replaced with any function.