Infix for All (листья)

Infix[] работает только на первом уровне:

Infix[(c a^b)^d]
(*
-> (a^b c) ~Power~ d
*)

Как я хочу (не спрашивайте почему), чтобы полное выражение переключилось на нотацию infix, я попробовал что-то вроде:

SetAttributes[toInfx, HoldAll];
toInfx[expr_] := Module[{prfx, infx},
  prfx = Level[expr, {0, Infinity}];
  infx = Infix /@ prfx /. {Infix[a_Symbol] -> a, Infix[a_?NumericQ] -> a};
  Fold[ReplaceAll[#1, #2] &, expr, [email protected][Rule[prfx, infx]]]
  ]
k = toInfx[(c a^b)^d]
(*
-> (c ~Times~ (a ~Power~ b)) ~Power~ d
*)

Но это имеет две очевидные проблемы, потому что

(c a^b)^d == a~Power~b~Times~c~Power~d
Так что я получаю не эффективное использование инфикса.
Он не является надежным и не подходит для простых выражений, таких как k = toInfx[a/b + ArcTan[a/b]]

Есть ли простой способ получить Infix[] работу для All (leaves)?

Ответ 1

Вот один из способов:

ClearAll[toInfixAlt];
SetAttributes[toInfixAlt, HoldAll];
toInfixAlt[expr_] :=
 [email protected][Infix, HoldForm[expr]] //. 
   Infix[a : _?(Function[s, AtomQ[[email protected]], HoldAll]) | _[_]| _[]] :> a

Я использовал HoldForm, так как вы можете захотеть, чтобы код оставался неоцененным. Вот пример:

In[781]:= toInfixAlt[(c a^b)^d/(1/2)]
Out[781]= ((c ~Times~ (a ~Power~ b)) ~Power~ d) ~Times~ (1/((1/2)))

ИЗМЕНИТЬ

In[792]:= toInfixAlt[a/b+ArcTan[a/b]]
Out[792]= (a ~Times~ (b ~Power~ (-1))) ~Plus~ ArcTan[a ~Times~ (b ~Power~ (-1))]

Конец EDIT

Что касается лишних круглых скобок, их сложнее удалить, поскольку они часто необходимы из-за приоритета различных операторов, но должны быть возможны.

ИЗМЕНИТЬ 2

Чтобы позаботиться о приоритете, вот попытка:

ClearAll[toInfixAlt];
SetAttributes[toInfixAlt, HoldAll];
toInfixAlt[expr_] := 
  [email protected][Infix, HoldForm[expr]] //. 
     Infix[a : _?(Function[s, AtomQ[[email protected]],HoldAll]) | _[_] | _[]] :> a //. 
     {
        Infix[f_[a__, Infix[r : (h_[___])],b___]] /; 
            Precedence[Unevaluated[f]] <= Precedence[Unevaluated[h]] :> Infix[f[a, r, b]],
        Infix[b___,f_[Infix[r : (h_[___])], a__]] /; 
            Precedence[Unevaluated[f]] <= Precedence[Unevaluated[h]] :> Infix[f[b, r, a]]
     };

Теперь я получаю:

In[963]:= toInfixAlt[a/b+ArcTan[a/b]]
Out[963]= (a b ~Power~ (-1)) ~Plus~ ArcTan[a ~Times~ (1/b)]

Ответ 2

Здесь мой подход, очень похожий на Леонида:

(* In[118]:= *) foo[a:_[_,__]]:=Infix[a]
                foo[a_]:=a

(* In[120]:= *) MapAll[foo,(c a^b)^d]

(* Out[120]= *) (c ~Times~ (a ~Power~ b)) ~Power~ d

(* In[121]:= *) MapAll[foo,a/b+ArcTan[a/b]]

(* Out[121]= *) ArcTan[a ~Times~ (b ~Power~ (-1))] ~Plus~ (a ~Times~ (b ~Power~ (-1)))

Ответ 3

Я не знаю, почему я помогаю тебе высмеивать меня, но...

(c a^b)^d //. h_[a_, b_] :> ix[a, h, b] /. ix :> (Infix[{##}, "~"] &)