Unexpected behavior when directly assigning to DownValues

Question

I'm encountering some unexpected behavior when assigning to DownValues. When I assign two definitions for test[1] as below, Mathematica stores both definitions:

DownValues[test] = {HoldPattern[test[1]] :> 1, HoldPattern[test[1]] :> 2};
DownValues[test]

(*{HoldPattern[test[1]] :> 1, HoldPattern[test[1]] :> 2}*)

After evaluating test[1] I get the expected result 1. However, if the list of rules contains more than 17 elements, Mathematica removes the duplicate definitions and only stores the last one, for example:

DownValues[test] = HoldPattern[test[1]] :> # & /@ Range[18];
DownValues[test]

(*{HoldPattern[test[1]] :> 18}*)

This of course means that when I evaluate test[1] I get 18, and so the behavior of test becomes dependent of the number of definitions I include in my assignment to DownValues[test]:

Table[
 DownValues[test] = HoldPattern[test[1]] :> # & /@ Range[i]; 
 test[1], 
 {i, 25}
]

(*{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 18, 19, 20, 21, 22, 23, 24, 25}*)

This behavior is problematic when I try to copy the down values of multiple symbols to a new symbol, for example:

(a1[#] = #) & /@ Range[5];
(b1[#] = 2 #) & /@ Range[5];

(a2[#] = #) & /@ Range[10];
(b2[#] = 2 #) & /@ Range[10];

DownValues[c1] = Join[DownValues[a1] /. a1 -> c1, DownValues[b1] /. b1 -> c1];
DownValues[c2] = Join[DownValues[a2] /. a2 -> c2, DownValues[b2] /. b2 -> c2];

c1[1]
c2[1]

(*1*)
(*2*)

I would expect here that both c1[1] and c2[1] return 1 -- the downvalue of the first symbol.

Note that the threshold of 17 elements does not seem to depend on the actual number of duplicate definitions, see this example with only one duplicate:

DownValues[test] = Append[
 HoldPattern[test[#]] :> # & /@ Range[25], 
 HoldPattern[test[1]] :> 2
];
test[1]

(*2*)

Can anyone offer an explanation for this behavior? And is there a way to assign a given list of definitions to a symbol such that the expected behavior is obtained? For example, is there a function f such that test[1] returns 1 after evaluating

DownValues[test] = f[Prepend[list, HoldPattern[test[1]] :> 1]]; 

independent of the definitions in list?

Answer 1

Update:

So you mention a specific case where you need this to work, and I think that's doable. So, owing to the fragility of the DownValues under direct assignment I think your best case is a form of DeleteDuplicates that leverages Internal`ComparePatterns.

You need to handle cases with Condition so here's my shot at that:

DownValues[d3] =
 DeleteDuplicates[
  Join[DownValues[a2] /. a2 -> d3, DownValues[b2] /. b2 -> d3, 
   DownValues[a3] /. a3 -> d3],
  Internal`ComparePatterns @@
     Map[
      Replace[
        Verbatim[HoldPattern][Verbatim[Condition][t_, ___]] :> 
         HoldPattern[t]]@*First,
      {##}
      ] === "Identical" &
  ]

And here's a test example, extending on your base case

(a2[#] = #) & /@ Range[10];
(b2[#] = 2 #) & /@ Range[10];
(a3[#] /; $test = #) & /@ Range[10];

DownValues[d3] =
 DeleteDuplicates[
  Join[DownValues[a2] /. a2 -> d3, DownValues[b2] /. b2 -> d3, 
   DownValues[a3] /. a3 -> d3],
  Internal`ComparePatterns @@
     Map[
      Replace[
        Verbatim[HoldPattern][Verbatim[Condition][t_, ___]] :> 
         HoldPattern[t]]@*First,
      {##}
      ] === "Identical" &
  ]

{HoldPattern[d3[1]] :> 1, HoldPattern[d3[2]] :> 2, 
 HoldPattern[d3[3]] :> 3, HoldPattern[d3[4]] :> 4, 
 HoldPattern[d3[5]] :> 5, HoldPattern[d3[6]] :> 6, 
 HoldPattern[d3[7]] :> 7, HoldPattern[d3[8]] :> 8, 
 HoldPattern[d3[9]] :> 9, HoldPattern[d3[10]] :> 10}

Note this is stronger than a DeleteDuplicatesBy[First] and Internal`ComparePatterns is stronger:

Internal`ComparePatterns[a_, b_]

"Identical"

DeleteDuplicates[{a_, b_}]

{a_, b_}

Original:

So clearly there's some DownValues simplification that's happening here.

But to understand the full behavior it helps to understand what exactly is happening with the DownValues. The rough-approximation is that there's a ReplaceRepeated-like mechanism happening in the evaluator that takes the patterns defined in the DownValues of the current expression Head. And so it just matches the first pattern that works.

Now, to your case, the simplification is happening at 18 DownValues. Given the replacement mechanism, it makes sense to drop unnecessary DownValues, why 18 is something I failed to find in the literature. It could be some pattern-complexity estimate or something. I don't know what's going on in the evaluator internals.

On the other hand, the fact that it takes the last value does make some sense. If you think about that assignment in a sequential manner it's entirely reasonable to take the last one.

But note that this simplification doesn't always happen.

DownValues[g] = HoldPattern[g[1]] :> # & /@ Range[-1, -25, -1];
DownValues[g]

{HoldPattern[g[1]] :> -25}

DownValues[f] = HoldPattern[f[a_]] :> # & /@ Range[-1, -25, -1];
DownValues[f]

{HoldPattern[f[a_]] :> -1, HoldPattern[f[a_]] :> -2, 
 HoldPattern[f[a_]] :> -3, HoldPattern[f[a_]] :> -4, 
 HoldPattern[f[a_]] :> -5, HoldPattern[f[a_]] :> -6, 
 HoldPattern[f[a_]] :> -7, HoldPattern[f[a_]] :> -8, 
 HoldPattern[f[a_]] :> -9, HoldPattern[f[a_]] :> -10, 
 HoldPattern[f[a_]] :> -11, HoldPattern[f[a_]] :> -12, 
 HoldPattern[f[a_]] :> -13, HoldPattern[f[a_]] :> -14, 
 HoldPattern[f[a_]] :> -15, HoldPattern[f[a_]] :> -16, 
 HoldPattern[f[a_]] :> -17, HoldPattern[f[a_]] :> -18, 
 HoldPattern[f[a_]] :> -19, HoldPattern[f[a_]] :> -20, 
 HoldPattern[f[a_]] :> -21, HoldPattern[f[a_]] :> -22, 
 HoldPattern[f[a_]] :> -23, HoldPattern[f[a_]] :> -24, 
 HoldPattern[f[a_]] :> -25}

Even more than that, though, we can actually find oddities in the assignment procedure if we construct the appropriate pathological cases by manually manipulating the values.

Consider first the basic, expected behavior:

Clear[f]
f[a___] := 1
DownValues[f]

{HoldPattern[f[a___]] :> 1}

f[a_] := 1
DownValues[f]

{HoldPattern[f[a_]] :> 1, HoldPattern[f[a___]] :> 1}

The more specific pattern gets filtered up, as one would want. But we can change this:

DownValues[f] = RotateRight[DownValues[f], 1];
DownValues[f]

{HoldPattern[f[a___]] :> 1, HoldPattern[f[a_]] :> 1}

And then when we do future assignments no such simplification happens:

f[a___] := 2
DownValues[f]
f[1]

{HoldPattern[f[a___]] :> 2, HoldPattern[f[a_]] :> 1}

2

But now it thinks that final DownValue doesn't exist:

f[a_] := 1
DownValues[f]
f[1]

{HoldPattern[f[a_]] :> 1, HoldPattern[f[a___]] :> 2, 
 HoldPattern[f[a_]] :> 1}

1

But note sometime we still get simplification:

DownValues[f] =
  Join[
   DownValues[f],
   HoldPattern[f[1]] :> # & /@ Range[-1, -25, -1]
   ];
DownValues[f]

{HoldPattern[f[1]] :> -25, HoldPattern[f[a___]] :> 2, 
 HoldPattern[f[a_]] :> 1}

Although the simplification is not wholly what we'd expect.

This all suggests that the top-level DownValues expressions we see are not perfectly correlated to the internally maintained down codes or at the very least there's some opaque simplification mechanism.

One final case where this is crucially important is when using Internal`InheritedBlock on symbols with top-level DownValues. If you use the standard Vilegas-Gayley override, sometimes your override fails.

For example, this fails to print, because there's already a general enough definition:

Internal`InheritedBlock[{
  System`GeoGraphicsDump`iGeoGraphics
  },
 Unprotect[System`GeoGraphicsDump`iGeoGraphics];
 System`GeoGraphicsDump`iGeoGraphics[e___] /; ! TrueQ[$override] :=

  Block[{$override = True},
   Print[Length@{e}];
   System`GeoGraphicsDump`iGeoGraphics[e]
   ];
 System`GeoGraphicsDump`iGeoGraphics[{RandomEntity["Country"][
    "Polygon"]}];
 ]

But using RotateRight on the DownValues works:

Internal`InheritedBlock[{
  System`GeoGraphicsDump`iGeoGraphics
  },
 Unprotect[System`GeoGraphicsDump`iGeoGraphics];
 System`GeoGraphicsDump`iGeoGraphics[e___] /; ! TrueQ[$override] :=

  Block[{$override = True},
   Print[Length@{e}];
   System`GeoGraphicsDump`iGeoGraphics[e]
   ];
 DownValues[System`GeoGraphicsDump`iGeoGraphics] = 
  RotateRight[DownValues@System`GeoGraphicsDump`iGeoGraphics];
 System`GeoGraphicsDump`iGeoGraphics[{RandomEntity["Country"][
    "Polygon"]}];
 ]

1

But beware sometimes this fails. I can't remember what my exact failure conditions have been (something like overriding some part of NotebookOpen or something), but I can remember the RotateRight trick not working.

Long story short, any assignment to any of the *Values is fragile, since simplifications and rearrangements happen opaquely.

Answer 2

Perhaps you could do something like:

DownValues[d1] = DownValues[a1] /. a1 -> d1;
d1[x_] := Replace[a1[x], z_a1 :> b1 @@ z]

DownValues[d2] = DownValues[a2] /. a2 -> d2;
d2[x_] := Replace[a2[x], z_a2 :> b2 @@ z]

Then:

d1 /@ Range[5] === c1 /@ Range[5]

d2 /@ Range[10]
c2 /@ Range[10]

True

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

{2, 4, 6, 8, 10, 12, 14, 16, 18, 20}

Paradoxically, d2 is faster than c2:

data = RandomInteger[{1, 10}, 10^6];
r1 = d2 /@ data; //AbsoluteTiming
r2 = c2 /@ data; //AbsoluteTiming

2 r1 === r2

{0.535748, Null}

{0.63291, Null}

True

Update

Another possibility is to just run the new DownValues again. For example:

DownValues[d2] = DownValues[a2] /. a2 -> d2;
Replace[
    DownValues[b2] /. b2 -> d3,
    _[_[lhs_], rhs_] :> SetDelayed[lhs,rhs],
    {1}
];

d2 /@ Range[10]

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

This way you should never get duplicate downvalues.