Writing a variable-labelling function that will subscript a specific variable in a derivative or other function?

Question

I have made a function which takes any expression and should replace it with one whose variables are identical, but replaced by those with a chosen subscript (inside the "{}" part goes a set of variables which I don't want to be labelled).

At[expr_, i_] := 
  Module[{varsD},
    varsD = Variables[expr],{}];
    ReplaceAll[expr, # -> Subscript[#, i] & /@ varsD] ]

However, what I am noticing is that, when I take functions (such as sines or derivatives etc), that the whole function is subscripted rather than just the variable.

I want them both to be $\sin(\theta _l)$ and $\dfrac{\partial F_l}{\partial y}$. I need some way of ensuring that this only happens to the function at the highest depth, but I am not sure how to do this.

EDIT: An answer to this has been provided, but what I would also like to do is the following:

• If the expression contains an unknown function (e.g. $F(x,y)$) then the function $F$ should receive the labelling as opposed to $x$ and $y$).
• Specify a set of variables or functions which should remain untouched by the labelling procedure (for example $H(z)$) - I had a previous solution which did this (which was omitted from the script I provided in this post, for simplicity).

Could somebody point me in the right direction?

Answer 1

I can't see any way to do it without telling the function the name of the variable that is to given the subscript. If you are willing to accept that as an additional requirement, it can be done like this:

at[expr_, i_, var_Symbol] :=
  Module[{m, idxs},
    m = expr;
    idxs = Position[m, var];
    Do[Part[m, Sequence @@ j] = Subscript[Part[m, Sequence @@ j], i], {j, idxs}];
    m]

Tests

at[D[f[x, y], x] D[f[x, y], y] + 2 D[f[x, y], x, y], 1, f]// TraditionalForm

at[Cos[θ] + I Sin[θ], 1, θ] // TraditionalForm