Skip to main content

evaluation - Functional-Style Fixed-Length Queue Object?


Following up on question Side-effecting an array in an association? and @Mr.Wizard's answer in there, I'm modernizing and tweaking Daniel Lichtblau's efficient queues and ran into a little roadblock.


First, I came up with the following API, stripped-down for brevity. The queue I want is fixed-length and lossy. Make a new queue with newQ[capacity]. Push values to the back with pushQ[aQueue, aValue]; pop values from the front with popQ[aQueue], just like a queue of humans. If the queue is full, just pop the value at the front, losing it (on purpose)


I want pushQ to return the queue it receives, so that I can fold it and chain it as follows:


Fold[pushQ, newQ[4], Range[10]]

Here's what I came up with, with the functional mojo highlighted:


ClearAll[newQ, emptyQQ, fullQQ, pushQ, popQ, peekQ, bumpQ]; 

newQ[cap_Integer] /; cap > 0 :=
<|"storage" -> ConstantArray[Null, cap],
"len" -> 0, "cap" -> cap,
"iFront" -> 1, "iBack" -> 1|>;
emptyQQ[Q_] := Q[["len"]] === 0;
fullQQ[Q_] := Q[["len"]] === Q[["cap"]];
peekQ[Q_] := Q[["storage", Q[["iFront"]]]];
SetAttributes[bumpQ, HoldFirst];
bumpQ[Q_, index_] := Q[[index]] = Mod[Q[[index]] + 1, Q[["cap"]], 1];
SetAttributes[pushQ, HoldFirst];

pushQ[Q_, item_] :=
(Q[["storage", Q[["iBack"]]]] = item;
bumpQ[Q, "iBack"];
If[fullQQ[Q],
(*then*)bumpQ[Q, "iFront"],
(*else*)Q[["len"]]++];
Q); (* <<<<<<< HERE IS THE FUNCTIONAL MOJO <<<<<<<< *)
SetAttributes[popQ, HoldFirst];
popQ[Q_] /; emptyQQ[Q] := Null;
popQ[Q_] :=

(Q[["len"]]--;
With[ {result = Q[["storage", Q[["iFront"]]]]},
Q[["storage", Q[["iFront"]]]] = Null;
bumpQ[Q, "iFront"];
result ])

This passes a bunch of unit tests:


$q = newQ[4];
pushQ[$q, 1]; $q["storage"]



{1, Null, Null, Null}

pushQ[$q, 2]; $q["storage"]


{1, 2, Null, Null}

pushQ[$q, 3]; $q["storage"]



{1, 2, 3, Null}

popQ[$q]


1

$q["storage"]



{Null, 2, 3, Null}

popQ[$q]; $q["storage"]


{Null, Null, 3, Null}

pushQ[$q, 4]; $q["storage"]



{Null, Null, 3, 4}

pushQ[$q, 5]; $q["storage"]


{5, Null, 3, 4}

popQ[$q]



3

$q["storage"]


{5, Null, Null, 4}

pushQ[$q, 6]; pushQ[$q, 7]; pushQ[$q, 8]; pushQ[$q, 9]; pushQ[$q, 10];
$q["storage"]



{9, 10, 7, 8}

popQ[$q]


7

and so on. Now, when I try the obvious generalization to folding, I'm back where I started with the ... in the part assignment is not a symbol.



Fold[pushQ, newQ[4], Range[1]]


During evaluation of In[49]:= Set::setps: <|storage->{Null,Null,Null,Null},len->0,cap->4,iFront->1,iBack->1|> in the part assignment is not a symbol. >>
During evaluation of In[49]:= Set::setps: <|storage->{Null,Null,Null,Null},len->0,cap->4,iFront->1,iBack->1|> in the part assignment is not a symbol. >>
During evaluation of In[49]:= General::stop: Further output of Set::setps will be suppressed during this calculation. >>
<|"storage" -> {Null, Null, Null, Null}, "len" -> 0, "cap" -> 4, "iFront" -> 1, "iBack" -> 1|>

Ok, I need some kind of symbol for Set to work. A couple more attempts as follows produce the same results, and I did a bunch of tracing and printing, and couldn't see a good way through this:


Module[{$q = newQ[4]}, Fold[pushQ, $q, Range[1]]]



During evaluation of In[48]:= Set::setps: <|storage->{Null,Null,Null,Null},len->0,cap->4,iFront->1,iBack->1|> in the part assignment is not a symbol. >>

Module[{$q = newQ[4]}, Fold[($q = pushQ[#1, #2]) &, $q, Range[1]]]


During evaluation of In[44]:= Set::setps: <|storage->{Null,Null,Null,Null},len->0,cap->4,iFront->1,iBack->1|> in the part assignment is not a symbol. >>

EDIT:



This question is really about elegance because I can get meaningful, useful side effects with Map and Scan, as follows:


Module[{q = newQ[4]}, pushQ[q, #] & /@ Range[10]]


{<|"storage" -> {1, Null, Null, Null}, "len" -> 1, "cap" -> 4, "iFront" -> 1, "iBack" -> 2|>, 
<|"storage" -> {1, 2, Null, Null}, "len" -> 2, "cap" -> 4, "iFront" -> 1, "iBack" -> 3|>,
<|"storage" -> {1, 2, 3, Null}, "len" -> 3, "cap" -> 4, "iFront" -> 1, "iBack" -> 4|>,
<|"storage" -> {1, 2, 3, 4}, "len" -> 4, "cap" -> 4, "iFront" -> 1, "iBack" -> 1|>,
<|"storage" -> {5, 2, 3, 4}, "len" -> 4, "cap" -> 4, "iFront" -> 2, "iBack" -> 2|>,
<|"storage" -> {5, 6, 3, 4}, "len" -> 4, "cap" -> 4, "iFront" -> 3, "iBack" -> 3|>,

<|"storage" -> {5, 6, 7, 4}, "len" -> 4, "cap" -> 4, "iFront" -> 4, "iBack" -> 4|>,
<|"storage" -> {5, 6, 7, 8}, "len" -> 4, "cap" -> 4, "iFront" -> 1, "iBack" -> 1|>,
<|"storage" -> {9, 6, 7, 8}, "len" -> 4, "cap" -> 4, "iFront" -> 2, "iBack" -> 2|>,
<|"storage" -> {9, 10, 7, 8}, "len" -> 4, "cap" -> 4, "iFront" -> 3, "iBack" -> 3|>}



Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...