Problem overloading D[] using UpValues

Question

First I define an entry of UpValues overloading D[] for expressions with head ftest:

ftest /: D[ftest[aaa_, bbb_], r] := ftest[D[aaa, r], D[bbb, r]]

When I try:

D[ftest[r, r^2], r]

the result is as I expect it to be:

ftest[1, 2 r]

However, when I try:

D[(r + ftest[r, r^2]), r]

Mathematica gives not the result I expect:

1 + 2*r*Derivative[0, 1][ftest][r, r^2] + Derivative[1, 0][ftest][r, r^2]

edit The result I expect is:

1 + ftest[1, 2 r]

(this clarification was suggested by Mr.Wizard, thanks!) end edit

How should I understand this?

How can this be fixed?

---

I tried

TreeForm@Unevaluated@Unevaluated@D[(r + ftest[r, r^2]), r]

and understand the result:

I also tried

TreeForm@Unevaluated@Unevaluated@D[(r + ftest[r, r^2]), r]

and I don't understand what does Mathematica do in the meantime to produce this result:

Answer 1

An answer using Mr.Wizard's suggestion

This is an answer to the second question, with assignments to Derivative[__][ftest][__], as suggested by Mr.Wizard in the comments:

ftest2 /: Times[ a_ , ftest2[b_, c_] ] := ftest2[a b, a c];
ftest2 /: Plus[ ftest2[a1_, b1_], ftest2[a2_, b2_] ] := ftest2[a1+a2, b1+b2];
Derivative[1,0][ftest2][_,_] = ftest2[1,0];
Derivative[0,1][ftest2][_,_] = ftest2[0,1];

The result is as I wrote in the original post I wanted it to be:

D[r + ftest2[r, r^2], r]
(* 1 + ftest2[1, 2 r] *)

Note that this does not require any overloading of D[] similar to the instruction from the original post.

---

Why am I still looking for a better answer?

Nevertheless I'd prefer to overload D[], since this would be faster. I'll show it using an example.

First an object with Derivative definitions:

LongTestA /: Plus[ LongTestA[a1_, a2_, a3_, a4_] , 
                   LongTestA[b1_, b2_, b3_, b4_] ] 
             :=   LongTestA[a1 + b1, a2 + b2, a3 + b3, a4 + b4];
LongTestA /: Times[ aaa_ , LongTestA[a1_, a2_, a3_, a4_] ] 
             := LongTestA[aaa a1, aaa a2, aaa a3, aaa a4];
Derivative[1, 0, 0, 0][LongTestA][_, _, _, _] = LongTestA[1, 0, 0, 0];
Derivative[0, 1, 0, 0][LongTestA][_, _, _, _] = LongTestA[0, 1, 0, 0];
Derivative[0, 0, 1, 0][LongTestA][_, _, _, _] = LongTestA[0, 0, 1, 0];
Derivative[0, 0, 0, 1][LongTestA][_, _, _, _] = LongTestA[0, 0, 0, 1];

Next an object with D[] overloading:

LongTestB /: D[ LongTestB[a1_, a2_, a3_, a4_] , r ] 
             := LongTestB[ D[a1, r], D[a2, r], D[a3, r], D[a4, r]];

A function generating some random 'data' (random polynomials of order length):

TestPolynomials[length_] := Block[{pol1, pol2, pol3, pol4},
  {pol1, pol2, pol3, pol4} = RandomInteger[100, length] & /@ Range[4];
  {pol1, pol2, pol3, pol4} = Function[list, Array[Times[r^#, list[[#]]] &, {length}]] 
                              /@ {pol1, pol2, pol3, pol4};
  {pol1, pol2, pol3, pol4} = Plus @@@ {pol1, pol2, pol3, pol4};
  Return[{pol1, pol2, pol3, pol4}];
];

Functions testing the speed of D[ LongTestA[__] ,r ] and D[ LongTestB[__] ,r ]:

TestLength = 10000;
TestA[_] := Block[{tmp},
  {pol1, pol2, pol3, pol4} = TestPolynomials[TestLength];
  tmp = Timing[D[LongTestA[pol1, pol2, pol3, pol4], r];][[1]];
  Return[tmp];
];
TestB[_] := Block[{tmp, pol1, pol2, pol3, pol4},
  {pol1, pol2, pol3, pol4} = TestPolynomials[TestLength];
  tmp = Timing[D[LongTestB[pol1, pol2, pol3, pol4], r];][[1]];
  Return[tmp];
];

And finally the timings...

TestA /@ Range[20]
(* {1.73211, 1.90012, 1.81211, 1.82811, 1.85212, 1.91612, 1.84012, 
    1.84812, 1.83211, 1.85612, 1.50009, 1.5961,  1.70411, 1.75211, 
    1.77611, 1.78811, 1.78811, 1.79611, 1.79611, 1.81211} *)
TestB /@ Range[20]
(* {1.46009, 1.46409, 1.47209, 1.46809, 1.48409, 1.48009, 1.46809, 
    1.48009, 1.47209, 1.47209, 1.6561,  1.36009, 1.40409, 1.43609, 
    1.47209, 1.45209, 1.45609, 1.46409, 1.46009, 1.45609} *)