Accessing sowed data during long computation

Question

This question is very similar to the one posted here: Interrogating a running evaluation but my running computation consists of a backtracking procedure which sows valid solutions. It is hard to tell when the computation will be over so I would like to take a look at the results Sow'ed so far. Is there any way to do this?

Answer 1

AFAIK, there is no way to get what you want with the built-in Reap and Sow.

However, here is a drop-in Reap - Sow replacement based on Internal`Bag structure, which is also the one that the actual Reap and Sow are based on:

SetAttributes[withSideEffect, HoldRest];
withSideEffect[code_, sideEffectCode_] := (sideEffectCode; code);

$storage = <||>

ClearAll[reap]
SetAttributes[reap, HoldFirst]

reap[expr_] := reap[expr, _]
reap[expr_, patt_] := reap[expr, patt, #2&]

(call : reap[expr_, patt_, func_]) /; !TrueQ[$inReap] :=
   Block[{$storage = <||>, $inReap = True},
    call
  ]

reap[expr_, patt:Except[_List], func_:Function[#2]] := 
  MapAt[First, reap[expr, {patt}, func], 2]

reap[expr_, patt_List, func_] :=
  Module[{result = expr, reaped, tag, matchingTags},
    {reaped, matchingTags} =
      Reap[
        Map[
          With[{matchingTagsData = KeySelect[$storage, MatchQ[#]]},
            Sow[Keys @ matchingTagsData, tag];
            Composition[
              KeyValueMap[func],
              Map[Internal`BagPart[#, All]&]
            ] @ matchingTagsData
          ]&
          ,
          patt
        ],
        tag
      ];
      If[matchingTags =!= {},
        KeyDropFrom[$storage, First @ matchingTags];
      ];
      {result, reaped}
  ]

ClearAll[sow, $globalTag]
sow[expr_] := sow[expr, $globalTag]
sow[expr_, _] /; !TrueQ[$inReap] := expr
sow[expr_, tags_List] := First @ Map[sow[expr, #]&, tags]
sow[expr_, tag_] := withSideEffect[expr,
   If[!KeyExistsQ[$storage, tag],
    $storage[tag] = Internal`Bag[{expr}],
    (* else *)
    Internal`StuffBag[$storage[tag], expr]
  ]
]


ClearAll[getCurrentData]
getCurrentData[part: _Integer | {__Integer} | _Span | All : All] := 
  getCurrentData[part, $globalTag]

getCurrentData[part: _Integer | {__Integer} | _Span | All : All, tag_] := 
  Replace[
    Lookup[$storage, tag, {}],
    bag: Except[{}] :> Internal`BagPart[bag, part]
  ]

It can serve as an explanation of how Reap-Sow work, but it can also be used to access the sowed data at any time, something that built-in Reap-Sow can't do:

reap[
  sow[1, {h[1], h[2], g[1]}];
  sow[2, g[2]];
  Print["The current data for tag ", h[1], " is ", getCurrentData[h[1]]];
  sow[3, {h[1], g[2], g[3]}]
  , 
  {_h, _g}
  , f
]

(*

 During evaluation of In[283]:= The current data for tag h[1] is {1}

 {3, {{f[h[1], {1, 3}], f[h[2], {1}]}, {f[g[1], {1}], f[g[2], {2, 3}], f[g[3], {3}]}}}
*)

In terms of performance, these will be slower, but should not be too much slower than the built-ins, since they are based on the same underlying data structure.