I am trying to create my own Plus and Times functions, which are identical to the built in ones with the exception that they are only Listable for numerical arguments, or for List arguments (which in my context will always be numerical lists).
My attempt so far is this:
ClearAll[CircleTimes, CirclePlus]
Attributes[CirclePlus] = Attributes[CircleTimes] =
Complement[Attributes[Plus], {Listable, Protected}];
CircleTimes[a_, b_, c___] := CircleTimes[a*b, c]
/;numericOrList[a] && numericOrList[b];
CirclePlus[a_, b_, c___] := CirclePlus[a+b, c]
/;numericOrList[a] && numericOrList[b];
CirclePlus[CircleTimes[a_, x1_], CircleTimes[a_, x2_]] := CircleTimes[a, x1 + x2]
/; numericOrList[x1] && numericOrList[x2];
numericOrList[a_] := NumericQ[a] || Head[a] === List;
This is only a partial solution though, because these do not yet have the property CirclePlus[a]=a. This leads to for example:
expr = Sin[z] f[z] + z^3 f[z] + 3 (z^2 + 1);
rule = {Plus->CirclePlus,Times->CircleTimes};
expr/.rule/.{f_[z]:>f[z],z->{1.,2.,3.}}
which outputs
3 (c*) CirclePlus[{2., 5., 10.}] (c+) f[z] (c*) {1.84147, 8.9093, 27.1411}
(I wrote (c*) and (c+) for CircleTimes and CirclePlus here, which have their own symbol in Mathematica)
So we get 3 (c*) CirclePlus[{2., 5., 10.}] where we want to get just {6.,15.,30.}.
I would think that I just need to add to the definition:
CircleTimes[a_] := a
CirclePlus[a_] := a
But this causes an infinite recursion that I don't understand and don't know how to fix.
How can I include this?
The point of these functions is to evaluate all the numerical parts in an expression, keeping the symbolic parts as is (i.e. not turning a*{1.,2.,3.} into {1. a, 2. a, 3. a}, because a might be a vector).
Apart from this issue this was the most elegant way I found of doing that.