MMA内置函数重造

最近在看Power Programming with Mathematica: The kernel，因为这本书里面的MMA版本较老，所以现在版本里的很多函数，再那里都还没有，因为后面的练习题有一些是函数重造的练习题。编写了一点，感觉MMA内置函数重造也是一个不错的熟悉、练习MMA编程的过程，尽管有的时候自己编写的函数相比内置函数，运行效率差距不是一点点。函数重造的一个要求就是要能实现内置函数的全部功能，后面抛砖引玉编写了两个：
1. 首先是Extract，Extract有两个功能，
一个就是取出元素Extract[expr,{list1,list2,...}]
另一个是在取出元素之后，在其计算之前加上函数头h,即Extract[expr,list,h]
重造函数及其功能实现如下图：

2，第二个是NumericQ的重造
最简单的办法就是NumberQ[N[expr]]
另外还有一个递归的算法，思想就是数字或者MMA常数比如Pi则是数字量，或者函数头具有NumericFunction属性且其所有参数都是数字或MMA常数，则是数字量。算法如下：
myNumericQ1[x_, appendx___] :=
If[AtomQ[x], True,
MemberQ[Attributes[Evaluate@Head[x]], NumericFunction]] &&
If[AtomQ[x], NumberQ[x] || MemberQ[Attributes[x], Constant],
myNumericQ[Sequence @@ x]] &&
If[{appendx} === {}, True, myNumericQ[Sequence @@ appendx]]
递归算法就是有一个不足，有递归限制，然后运行效率 不是很高
另外一个改进算法，就是提取出表达式的所有函数头以及参数，Union去除重复的，然后分别检测函数头跟参数是否满足上述条件，对于Atom，则单独处理：
myNumericQ[expr_?AtomQ] :=
NumberQ[expr] || MemberQ[Attributes[expr], Constant]
myNumericQ[expr_] :=
With[{all =
Union[Select[Level[expr, Infinity, Heads -> True], AtomQ]],
leaf = Union[Select[Level[expr, Infinity], AtomQ]]},
And @@ Flatten@{(NumberQ[#] || MemberQ[Attributes[#], Constant]) & /@
leaf, MemberQ[Attributes[#], NumericFunction] & /@
Complement[all, leaf]}]
这些就随便玩玩，欢迎交流，有兴趣的朋友也可以贴上自己重构的函数，对于这两个函数，有改进的算法也欢迎交流

运行情况来看，myNumericQ还可以，这么一个复杂的式子也可以检测出来，但是myNumericQ1递归的定义方式就有点问题了，t这么一个复杂的表达式就无法判断了，对于简单的式子还可以，问题出在哪里，有空了再检查检查，而至于NumberQ[N[expr]]的重造方式，只要计算不超过$MaxNumber,都是可行的，这也是NumberQ[N[expr]]的弱点，要判断，必须先计算