1
$\begingroup$

I have an expression:

expr = Transpose[x]+Transpose[f[x]]+Transpose[x+f[x]]

I want to differentiate this expression and desired result looks like this:

D[expr, x]
res = Transpose[1] + Transpose[f'[x]] + Transpose[1 + f'[x]]

But I get the following:

enter image description here

Task: How to replace all patterns D[Transpose[___],___] with patterns Transpose[D[___,___]]

I used a set of rules, but I want to test alternatives:

Unprotect[D, Transpose, Dot];
(*Derivative rules*)
D[Transpose[A_], X_] := D[A, X]\[Transpose]
D[A_.B_, X_] := D[A, X].B + A.D[B, X]
(*Dot rules*)
Dot[_, 0] := 0
Dot[0, _] := 0
Protect[D, Transpose, Dot];
$\endgroup$

2 Answers 2

1
$\begingroup$

Try this:

expr[x_] := Transpose[x] + Transpose[f[x]] + Transpose[x + f[x]];

MapAt[D[#, x] &, expr[x], {All, 1}]

(*  Transpose[1] + Transpose[Derivative[1][f][x]] + 
 Transpose[1 + Derivative[1][f][x]]   *)

Have fun!

$\endgroup$
4
  • $\begingroup$ Your code is good, but it stops working for the expression: expr[x_] := Transpose[x].Transpose[x] + Transpose[f[x]] + Transpose[x + f[x]]; I'm trying to come up with something more universal based on this, but I'm not succeeding yet. $\endgroup$
    – ayr
    Commented Nov 2, 2022 at 12:05
  • $\begingroup$ mathematica.stackexchange.com/questions/275514/… I invite you to take part $\endgroup$
    – ayr
    Commented Nov 2, 2022 at 16:20
  • 1
    $\begingroup$ But, of course, it stops. It is not a universal approach. It depends on the structure of your expression. If the expression changes, one needs to change the tree coordinates in the code. Have a look at MapAt. $\endgroup$ Commented Nov 2, 2022 at 17:46
  • $\begingroup$ Thank you very much for your reply! I'll examine the MapAt function more carefully. $\endgroup$
    – ayr
    Commented Nov 3, 2022 at 4:15
1
$\begingroup$

We can play with Level as follows:

dtnDerivative[expr_, Pattern[var, Blank[Symbol]]] := ReplaceAll[
        Thread[
            Rule[
                DeleteDuplicates[
                    Flatten[
                            Map[
                                Function[
                                    If[
                                        Or[Equal[Depth[#], 2], Equal[Depth[#], 3]],
                                        Level[#, {2}],
                                        Level[#, {-2}]
                                    ]
                                ],
                                Level[expr, {1}]
                            ]
                        ]
                ],
                D[
                    DeleteDuplicates[
                            Flatten[
                                Map[
                                    Function[
                                        If[
                                                Or[Equal[Depth @ #, 2], Equal[Depth @ #, 3]],
                                                Level[#, {2}],
                                                Level[#, {-2}]
                                            ]
                                    ],
                                    Level[expr, {1}]
                                ]
                            ]
                        ],
                    var
                ]
            ]
        ]
    ][expr];

Test with your first expression:

dtnDerivative[expr[x], x]
(*Transpose[1] + Transpose[Derivative[1][f][x]] + Transpose[1 + Derivative[1][f][x]]*)

Test with your second expression:

dtnDerivative[expr2[x], x]
(*Transpose[1] . Transpose[1] + Transpose[Derivative[1][f][x]] + Transpose[1 + Derivative[1][f][x]]*)

This function is useful for the two structures you exposed.

$\endgroup$
1
  • $\begingroup$ Thank you for your reply and for developing the feature and calling my name! :) Perhaps someday in Mathematica there will be a full-fledged command, which will be called: _D_ifferentiation of _T_ransposed _N_otes. Now to the serious. I understand that the task is actually much more difficult and each case needs to be considered separately. There is no universal code (without modifying MMA commands by removing protection, adjusting and installing protection) yet. I haven't made any progress yet either. $\endgroup$
    – ayr
    Commented Nov 3, 2022 at 4:43

Not the answer you're looking for? Browse other questions tagged or ask your own question.