What I'm trying to achieve in Mathematica is the creation of a binary operator whose operands are both pure functions over the natural numbers. The result of the operator should be another pure function over the natural numbers.
To demonstrate concretely what I want, suppose I have the following functions defined:
f[n_Natural]:=2*n;
g[n_Natural]:=n-1;
(There is no Head called "Natural" so the above pattern matching won't work. But I want f and g to accept only natural numbers. This is problem No. 1 [SOLVED])
I then want a binary operator defined like so:
Needs["Notation`"];
CombinedFunction[f_NaturalFunction,g_NaturalFunction]:={#}/.{{x_Natural}:>f[#]+g[#]}}&;
InfixNotation[ParsedBoxWrapper["\[CirclePlus]"], CombinedFunction];
Operating $f$ $\oplus$ $g$ yields a pure function $h$ that only takes a natural number as an argument. I have found a way of enforcing the domain of $h$ thanks to this thread, but I want to extend this to ensure that $\oplus$ itself is only defined for unary functions over the natural numbers. Seeing as there's no Head like 'NaturalFunction', I don't know how to do this. This is problem No. 2.
As an additional issue, the operator (which currently yields a function defined over the integers) currently gives an unsimplified output:
Needs["Notation`"];
CombinedFunction[f_, g_] := {#} /. {{x_Integer} :> f[x] + g[x]} &;
AddInputAlias["4" -> ParsedBoxWrapper["\[CirclePlus]"]];
InfixNotation[ParsedBoxWrapper["\[CirclePlus]"], CombinedFunction];
f=1&;
g=#&;
h=f\[CirclePlus]g
{#1} /. {{x$_Integer} :> (1 &)[x$] \[LeftRightArrow] (#1 &)[x$]} &
I would have expected the output to be:
(1+#)&
I'm unsure of the inner workings of what I've written so I don't know how to obtain a simplified result. I can now apply $h$ to an integer and it operates as expected. However:
h[3.5]
{3.5}
I want instead Mathematica to behave as if the function was simply undefined for anything but an integer, just as it would do if I defined $h$ like so:
Clear[h]; h[x_Integer]:=x+1;
h[3.5]
h[3.5]
Answer
Without giving this much thought you might proceed as follows:
naturalQ = IntegerQ[#] && Positive[#] &;
You can then define:
fn[n_?naturalQ] := 2*n;
fn /@ {-1, 0, 1}
{fn[-1], fn[0], 2}
For the second problem you might make use of SubValues syntax:
SetAttributes[nFun, HoldAll]
nFun[p_, body_][arg_?naturalQ] := With[{p = arg}, body]
Now:
nFun[x, x^2][8]
nFun[x, 2 x][8]
nFun[x, x+5][8]
64
16
13
You can define CirclePlus
directly since it is an operator. You don't need the Notation package. (You can enter the \[CirclePlus]
character with Escc+
Esc.) Again using SubValues syntax:
CirclePlus[f_nFun, g_nFun][arg_?naturalQ] := f[arg] + g[arg]
Now:
f = nFun[x, x];
g = nFun[x, 1];
h = f \[CirclePlus] g
h[7]
8
This doesn't produce a Function
object but perhaps it is sufficient. If it is not acceptable please explain how and why and I shall try again.
Anticipating a possible request, and also offering a variant, here is a method that makes use of Slot
notation and yields partial evaluation:
ClearAll[nFun, CirclePlus]
SetAttributes[nFun, HoldFirst]
nFun[body_][arg__?naturalQ] := body &[arg]
CirclePlus[nFun[b1_], nFun[b2_]] := nFun[b1 + b2]
Now:
f = nFun[#];
g = nFun[1];
h = f\[CirclePlus]g
h[7]
nFun[#1 + 1]
8
For complete evaluation of the body you can use nFun @@ {b1 + b2}
for the RHS of the second definition.
Comments
Post a Comment