Instantly share code, notes, and snippets.

Embed
What would you like to do?
Mathematica code to compute the nth derivative of x^x (using specific rewrite rules)
pown[_,0]:=1
pown[a_,1]:=a
pown[a_,n_]:=With[{b=pown[a,Floor[n/2]]},b b If[Mod[n,2]==0,1,a]]
add[m_Integer,n_Integer]:=m+n
add[0,f_]:=f
add[f_,0]:=f
add[f_,n_Integer]:=add[n,f]
add[f_,add[n_Integer,g_]]:=add[n,add[f,g]]
add[add[f_,g_],h_]:=add[f,add[g,h]]
mul[m_Integer,n_Integer]:=m n
mul[0,f_]:=0
mul[f_,0]:=0
mul[1,f_]:=f
mul[f_,1]:=f
mul[f_,n_Integer]:=mul[n,f]
mul[f_,mul[n_Integer,g_]]:=mul[n,mul[f,g]]
mul[mul[f_,g_],h_]:=mul[f,mul[g,h]]
pow[m_Integer,n_Integer]:=pown[m,n]
pow[f_,0]:=1
pow[f_,1]:=f
pow[0,f_]:=0
ln[1]:=0
d[x_,f_Symbol]:=If[x==f,1,0]
d[x_,_Integer]:=0
d[x_,add[f_,g_]]:=add[d[x,f],d[x,g]]
d[x_,mul[f_,g_]]:=add[mul[f, d[x, g]],mul[g,d[x,f]]]
d[x_,pow[f_,g_]]:=mul[pow[f, g], add[mul[mul[g, d[x, f]], pow[f, -1]], mul[ln[f], d[x, g]]]]
d[x_,ln[f_]]:=mul[d[x,f], pow[f,-1]]
count[_Integer]:=1
count[_Symbol]:=1
count[add[f_,g_]]:=count[f]+count[g]
count[mul[f_,g_]]:=count[f]+count[g]
count[pow[f_,g_]]:=count[f]+count[g]
count[ln[f_]]:=count[f]
mem0=MemoryInUse[]
dx[f_]:=Block[{df=d[x,f]},Print[MemoryInUse[]-mem0];df]
Nest[dx,pow[x,x],9]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment