Looping through the internal form of a symbolic expression?

Question

Could someone provide code for looping through the internal form for a symbolic expression?

Specifically I am looking to write my own code for simplifying expressions (such as removing a common factor from a vector or matrix) by parsing the internal form of the expression. I am not satisfied with the results that PolynomialGCD gives.

Answer 1

Something like this might be fun for looking at the FullForm structure:

ff = FullForm[x/Sqrt[5] + y^2 + 1/z] (* example from MMA help *)

(* Plus[1,Times[Power[5,Rational[-1,2]],x],Power[y,2]] *)

t[f_, tree_] := Module[{},
  If[Length[f] == 0, Return[tree],
   Table[(f[[0]] // FullForm) ->
     If[Length[f[[n]]] == 0, f[[n]] // FullForm, t[f[[n]], tree]],
    {n, 1, Length[f]}]]]

t[ff[[1]], {}]

(* {Plus->1,Plus->{Times->{Power->5,Power->Rational[-1,2]},Times->x},Plus->{Power->y,Power->2}} *)

```

Answer 2

Here is what I came up with to remove a common factor from a vector/list/matrix. It works better than PolynomialGCD.

First I give an example of usage.

f = {((1 + g)*r^(-1 + g))/E^(r*\[Kappa]), 
   0, (I*r^(-2 + g)*z*\[Alpha])/
    E^(r*\[Kappa]), (I*r^(-2 + g)*(x + I*y)*\[Alpha])/E^(r*\[Kappa])};
Print["ORIGINAL f = ", f // MatrixForm];
With[{cf = PolynomialGCD @@ f}, 
  Print["SIMPLIFIED WITH PolynomialGCD: ", cf, " ", 
   f/cf // MatrixForm]];
PrintRCF["SIMPLIFIED WITH BESPOKE CODE BELOW = ", 
  RemoveCommonFactor[f], ""];

HERE IS THE OUTPUT

Here is the code

RemoveCommonFactor[myexpr_] :=
  Module [{leafcount, atoms, factor, newExpr, Nfactors, depth},
   factor = 1;
   Nfactors = 0;
   newExpr = Simplify[myexpr];
   depth = Depth[newExpr];
   leafcount = LeafCount[newExpr];
   atoms = Union[Flatten[Level[newExpr, 3]]];
   Do[
    Module[ {atom, temp, lc},
     atom = atoms[[i]];
     If[! (atom === 0), (
       temp = Simplify[newExpr/atom];
       lc = LeafCount[temp] +  LeafCount[atom] ;
       If[lc < LeafCount[newExpr] + 1, (
         factor = factor * atom;
         Nfactors = Nfactors + 1;
         newExpr = temp;
         ),
        null
        ];
       )
      ];
     ],
    {i, 1, Length[atoms]}
    ];
   {Nfactors, factor, newExpr}
   ];


PrintRCF[headstr_, rcf_, footstr_] :=
  Module[{Nfactors, myfactor, expr},
   Nfactors = rcf[[1]];
   myfactor = rcf[[2]];
   expr = rcf[[3]];
   If[Nfactors > 0,
    (
     Print[headstr, myfactor, " ", expr // MatrixForm, footstr]
     ),
    (
     Print[headstr, expr // MatrixForm, footstr];
     )
    ];
   Return[null];
   ];