How can we obtain the imaginary part of a too complicated expression with Mathematica?

Question

I would like to obtain the imaginary part of a long expression. All the parameters in the expression are real. Moreover, X and Y are positive. I have used ComplexExpand and tried to simplify the expression by the the assumption that X and Y are real parameters. In fact, I have used

Simplify[ComplexExpand[Im[expression]], X > 0 && Y > 0]

I could not achieve the correct answer. Could you please guide me to obtain the correct answer?

The same problem exist when I want to obtain the real part of the expression. Can anybody help me what the problem is?

expression=
-((2. Sqrt[
     X] (999.117 Sqrt[Y] - 4. W^2 Sqrt[Y]  + 
       515.558 W^2 X Sqrt[Y] +  
       515.558 W^2 X^2 Sqrt[Y] + 
       4. W^2 X^3 Sqrt[Y] + 2006.23 Y^(3/2) - 8. W^2 Y^(3/2) - 
       1998.23 X Y^(3/2) + 1023.12 W^2 X Y^(3/2) - 2. W^4 X Y^(3/2) - 
       8. X^2 Y^(3/2) - 8. W^2 X^2 Y^(3/2) + 2. W^4 X^2 Y^(3/2) + 
       1015.12 Y^(5/2) - 4. W^2 Y^(5/2) - 8. X Y^(5/2) + 
       12. W^2 X Y^(5/2) + 
       8. Y^(7/2) + (0. + 23500.4 I) Sqrt[
        Y] ω + (0. + 12004. I) W^2 Sqrt[
        Y] ω - (0. + 46996.9 I) X Sqrt[
        Y] ω + (0. + 1.48767*10^6 I) W^2 X Sqrt[
        Y] ω + (0. + 23492.4 I) X^2 Sqrt[
        Y] ω + (0. + 11500.4 I) W^2 X^2 Sqrt[
        Y] ω + (0. + 4. I) X^3 Sqrt[
        Y] ω + (0. + 46992.9 I) Y^(
        3/2) ω + (0. + 24008. I) W^2 Y^(
        3/2) ω - (0. + 46976.9 I) X Y^(
        3/2) ω + (0. + 503.558 I) W^2 X Y^(
        3/2) ω + (0. + 6002. I) W^4 X Y^(
        3/2) ω - (0. + 16. I) X^2 Y^(
        3/2) ω + (0. + 2.22045*10^-16 I) W^2 X^2 Y^(
        3/2) ω + (0. + 23484.4 I) Y^(
        5/2) ω + (0. + 12004. I) W^2 Y^(
        5/2) ω + (0. + 20. I) X Y^(
        5/2) ω - (0. + 8. I) Y^(7/2) ω + 
       8.99206*10^9 Sqrt[Y] ω^2 - 
       3.5988*10^7 W^2 Sqrt[Y] ω^2 + 
       7.79692*10^7 X Sqrt[Y] ω^2 + 
       3.293*10^7 W^2 X Sqrt[Y] ω^2 + 
      35992. W^2 Y^(3/2) ω^2 - 1986.23 X Y^(3/2) ω^2 - 
       47992. W^2 X Y^(3/2) ω^2 + 
       6000. W^4 X Y^(3/2) ω^2 - 6. X^2 Y^(3/2) ω^2 - 
       4. W^2 X^2 Y^(3/2) ω^2 - 10485.3 Y^(5/2) ω^2 +  
      (0. + 41873.1 I) X^2 Sqrt[
        Y] ω^3 + (0. + 3001. I) W^2 X^2 Sqrt[
        Y] ω^3 + (0. + 1. I) X^3 Sqrt[
        Y] ω^3 - (0. + 1.4243*10^8 I) Y^(
        3/2) ω^3 - (0. + 3.5988*10^7 I) W^2 Y^(
        3/2) ω^3 - (0. + 107488. I) X Y^(
        3/2) ω^3 - (0. + 12004. I) W^2 X Y^(
        3/2) ω^3 - (0. + 6. I) X^2 Y^(
        3/2) ω^3 + (0. + 59484.4 I) Y^(
        5/2) ω^3 + (0. + 12004. I) W^2 Y^(
        5/2) ω^3 + (0. + 12. I) X Y^(
        5/2) ω^3 - (0. + 8. I) Y^(7/2) ω^3 + 
       1.23736*10^11 Sqrt[Y] ω^4 + 
       1.07955*10^11 W^2 Sqrt[Y] ω^4 + 
       1.6649*10^8 X Sqrt[Y] ω^4 + 
       1.17366*10^8 W^2 X Sqrt[Y] ω^4 + 
       15124.9 X^2 Sqrt[Y] ω^4 + 
       9000. W^2 X^2 Sqrt[Y] ω^4 + 
       4.9529*10^7 Y^(3/2) ω^4 - 
       3.5964*10^7 W^2 Y^(3/2) ω^4 - 
       24499.6 X Y^(3/2) ω^4 - 
       24000. W^2 X Y^(3/2) ω^4 - 11500.4 Y^(5/2) ω^4 + 
       12000. W^2 Y^(5/2) ω^4 + (0. + 3.7238*10^11 I) Sqrt[
        Y] ω^5 + (0. + 1.35045*10^11 I) W^2 Sqrt[
        Y] ω^5 + (0. + 1.52245*10^8 I) X Sqrt[
        Y] ω^5 + (0. + 1.8006*10^7 I) W^2 X Sqrt[
        Y] ω^5 + (0. + 9000. I) X^2 Sqrt[
        Y] ω^5 - (0. + 1.96477*10^8 I) Y^(
        3/2) ω^5 - (0. + 3.6012*10^7 I) W^2 Y^(
        3/2) ω^5 - (0. + 36000. I) X Y^(
        3/2) ω^5 + (0. + 36000. I) Y^(5/2) ω^5 + 
       1.42868*10^11 Sqrt[Y] ω^6 + 
       1.34991*10^11 W^2 Sqrt[Y] ω^6 + 
       3.67493*10^7 X Sqrt[Y] ω^6 + 
       2.7*10^7 W^2 X Sqrt[Y] ω^6 - 
       1.94987*10^7 Y^(3/2) ω^6 - 
       3.6*10^7 W^2 Y^(3/2) ω^6 + (0. + 1.87876*10^11 I) Sqrt[
        Y] ω^7 + (0. + 2.7009*10^10 I) W^2 Sqrt[
        Y] ω^7 + (0. + 2.7*10^7 I) X Sqrt[
        Y] ω^7 - (0. + 5.4*10^7 I) Y^(3/2) ω^7 + 
       2.8124*10^10 Sqrt[Y] ω^8 + 
       2.7*10^10 W^2 Sqrt[Y] ω^8 + (0. + 2.7*10^10 I) Sqrt[
        Y] ω^9 + 
       W^2 X Sqrt[
        Y] (503.558 + 
          Y^2 (4. - (0. + 4. I) ω) - (0. + 
             1.51118*10^6 I) ω - 
          1.51055*10^6 ω^2 - (0. + 377795. I) ω^3 - 
          377669. ω^4 + 
          X (-503.558 + Y (-4. + (0. + 2. I) ω) - 
             125.89 ω^2) + 
          Y (507.558 - (0. + 12257.8 I) ω - 
             17750.2 ω^2 + (0. + 6000. I) ω^3 + 
             W^2 (2.22045*10^-16 - (0. + 9.09495*10^-13 I) ω - 
                9.09495*10^-13 ω^2))) Cos[2 θ] + 
       6.39488*10^-14 W^3 X^(3/2)
         Y Cos[3 θ] + (0. + 4.54747*10^-13 I) W^3 X^(3/2)
         Y ω Cos[3 θ] - 
       4.54747*10^-13 W^3 Sqrt[X]
         Y^2 ω^2 Cos[
         3 θ] - (0. + 1.86265*10^-9 I) W^3 Sqrt[X]
         Y ω^3 Cos[3 θ] - 
       5.55112*10^-17 W^4 X Y^(3/2)
         Cos[4 θ] - (0. + 2.27374*10^-13 I) W^4 X Y^(
        3/2) ω Cos[4 θ] + 
       2.27374*10^-13 W^4 X Y^(
        3/2) ω^2 Cos[4 θ] - (0. + 712.139 I) W Sqrt[X]
         Sin[θ] + (0. + 1424.28 I) W X^(3/2)
         Sin[θ] - (0. + 712.139 I) W X^(5/2)
         Sin[θ] - (0. + 1429.94 I) W Sqrt[X]
         Y Sin[θ] + (0. + 1435.59 I) W X^(3/2)
         Y Sin[θ] - (0. + 356.07 I) W^3 X^(3/2)
         Y Sin[θ] - (0. + 5.65685 I) W X^(5/2)
         Y Sin[θ] + (0. + 1.77636*10^-15 I) W^3 X^(5/2)
         Y Sin[θ] - (0. + 723.453 I) W Sqrt[X]
         Y^2 Sin[θ] + (0. + 11.3137 I) W X^(3/2)
         Y^2 Sin[θ] - (0. + 2.82843 I) W^3 X^(3/2)
         Y^2 Sin[θ] - (0. + 5.65685 I) W Sqrt[X]
         Y^3 Sin[θ] + 
       356.07 W Sqrt[X] ω Sin[θ] - 
       712.139 W X^(3/2) ω Sin[θ] + 
       356.07 W X^(5/2) ω Sin[θ] - 
       4.2403*10^6 W Sqrt[X] Y ω Sin[θ] + 
       16979. W^3 Sqrt[X] Y ω Sin[θ] - 
       33963.8 W X^(3/2) Y ω Sin[θ] - 
       16803.8 W^3 X^(3/2) Y ω Sin[θ] + 
       5.65685 W X^(5/2) Y ω Sin[θ] + 
       2.82843 W^3 X^(5/2) Y ω Sin[θ] - 
       35015. W Sqrt[X] Y^2 ω Sin[θ] + 
       5.65685 W^3 Sqrt[X] Y^2 ω Sin[θ] - 
       5.65685 W X^(3/2) Y^2 ω Sin[θ] - 
       5.65685 W^3 X^(3/2) Y^2 ω Sin[θ] - 
       11.3137 W Sqrt[X]
         Y^3 ω Sin[θ] - (0. + 6.40925*10^9 I) W Sqrt[
        X] ω^2 Sin[θ] - (0. + 4.27248*10^6 I) W X^(
        3/2) ω^2 Sin[θ] - (0. + 178.035 I) W X^(
        5/2) ω^2 Sin[θ] - (0. + 1.4853*10^8 I) W Sqrt[X]
         Y ω^2 Sin[θ] - (0. + 5.09541*10^7 I) W^3 Sqrt[
        X] Y ω^2 Sin[θ] - (0. + 33587.9 I) W X^(3/2)
         Y ω^2 Sin[θ] + (0. + 8488.11 I) W^3 X^(3/2)
         Y ω^2 Sin[θ] + (0. + 1.41421 I) W X^(5/2)
         Y ω^2 Sin[θ] + (0. + 16970.6 I) W Sqrt[X]
         Y^2 ω^2 Sin[θ] - (0. + 16976.2 I) W^3 Sqrt[X]
         Y^2 ω^2 Sin[θ] - (0. + 5.65685 I) W X^(3/2)
         Y^2 ω^2 Sin[θ] + (0. + 5.65685 I) W Sqrt[X]
         Y^3 ω^2 Sin[θ] + 
       3.20463*10^9 W Sqrt[X] ω^3 Sin[θ] + 
       2.13624*10^6 W X^(3/2) ω^3 Sin[θ] + 
       89.0174 W X^(5/2) ω^3 Sin[θ] - 
       5.20057*10^7 W Sqrt[X] Y ω^3 Sin[θ] - 
       5.09456*10^7 W^3 Sqrt[X] Y ω^3 Sin[θ] + 
       25453. W X^(3/2) Y ω^3 Sin[θ] + 
       16970.6 W^3 X^(3/2) Y ω^3 Sin[θ] - 
       350.413 W Sqrt[X] Y^2 ω^3 Sin[θ] - 
       16970.6 W^3 Sqrt[X]
         Y^2 ω^3 Sin[θ] - (0. + 8.01157*10^9 I) W Sqrt[
        X] ω^4 Sin[θ] - (0. + 1.06821*10^6 I) W X^(
        3/2) ω^4 Sin[θ] - (0. + 6.25884*10^7 I) W Sqrt[
        X] Y ω^4 Sin[θ] + (0. + 
          2.54643*10^7 I) W^3 Sqrt[X]
         Y ω^4 Sin[θ] + (0. + 8485.28 I) W X^(3/2)
         Y ω^4 Sin[θ] - (0. + 16970.6 I) W Sqrt[X]
         Y^2 ω^4 Sin[θ] + 
       4.00578*10^9 W Sqrt[X] ω^5 Sin[θ] + 
       534104. W X^(3/2) ω^5 Sin[θ] + 
       2.54474*10^7 W Sqrt[X] Y ω^5 Sin[θ] + 
       2.54558*10^7 W^3 Sqrt[X]
         Y ω^5 Sin[θ] - (0. + 1.60231*10^9 I) W Sqrt[
        X] ω^6 Sin[θ] + (0. + 1.27279*10^7 I) W Sqrt[X]
         Y ω^6 Sin[θ] + 
       8.01157*10^8 W Sqrt[X] ω^7 Sin[θ] + 
       W Sqrt[X]
         Cos[θ] (-712.139 - 2842.9 Y + 5.65685 W^2 Y - 
          2147.73 Y^2 + 5.65685 W^2 Y^2 - 
          16.9706 Y^3 - (0. + 356.07 I) ω - (0. + 
             33946.8 I) Y ω - (0. + 
             16976.2 I) W^2 Y ω - (0. + 
             33579.4 I) Y^2 ω - (0. + 
             16976.2 I) W^2 Y^2 ω + (0. + 
             11.3137 I) Y^3 ω - 6.40925*10^9 ω^2 - 
          4.24353*10^7 Y ω^2 - 42429.2 W^2 Y ω^2 + 
          49487.4 Y^2 ω^2 - 16970.6 W^2 Y^2 ω^2 - 
          5.65685 Y^3 ω^2 - (0. + 
             3.20463*10^9 I) ω^3 + (0. + 
             1.50623*10^8 I) Y ω^3 + (0. + 
             7.64015*10^7 I) W^2 Y ω^3 - (0. + 
             68244. I) Y^2 ω^3 - 8.01157*10^9 ω^4 + 
          1.80523*10^7 Y ω^4 + 7.6376*10^7 W^2 Y ω^4 + 
          16970.6 Y^2 ω^4 - (0. + 
             4.00578*10^9 I) ω^5 + (0. + 
             7.74442*10^7 I) Y ω^5 - (0. + 
             3.72529*10^-9 I) W^2 Y ω^5 - 
          1.60231*10^9 ω^6 - 
          1.27279*10^7 Y ω^6 - (0. + 
             8.01157*10^8 I) ω^7 + 
          X^2 (-712.139 - (0. + 356.07 I) ω - 
             178.035 ω^2 - (0. + 89.0174 I) ω^3 + 
             Y (5.65685 + 
                W^2 (5.65685 - (0. + 
                    8.88178*10^-16 I) ω) + (0. + 
                   5.65685 I) ω - 1.41421 ω^2)) + 
          X (1424.28 + (0. + 712.139 I) ω - 
             4.27248*10^6 ω^2 - (0. + 
                2.13624*10^6 I) ω^3 - 
             1.06821*10^6 ω^4 - (0. + 534104. I) ω^5 + 
             Y^2 (11.3137 + 
                W^2 (-8.48528 + (0. + 
                    1.77636*10^-15 I) ω) - (0. + 
                   16.9706 I) ω + 5.65685 ω^2) + 
             Y (2837.24 + (0. + 33941.1 I) ω + 
                35368.2 ω^2 + (0. + 42785.3 I) ω^3 - 
                8485.28 ω^4 + 
                W^2 (-367.383 + (0. + 16798.2 I) ω + 
                   42429.2 ω^2))) + 
          W Sqrt[X] Sqrt[
           Y] ((0. + 1007.12 I) + 
             3.02236*10^6 ω - (0. + 
                3.0211*10^6 I) ω^2 + 
             755589. ω^3 - (0. + 755338. I) ω^4 + 
             Y^2 ((0. + 8. I) + 8. ω) + 
             X ((0. - 1007.12 I) + 
                Y ((0. - 8. I) - 4. ω) - (0. + 
                   251.779 I) ω^2) + 
             Y ((0. + 1015.12 I) + 
                24515.6 ω - (0. + 35500.4 I) ω^2 - 
                12000. ω^3 + 
                W^2 ((0. + 3.34953*10^-16 I) + 
                   6.85984*10^-13 ω - (0. + 
                    6.85984*10^-13 I) ω^2))) Sin[θ]) + \
(0. + 2.22045*10^-16 I) W^3 Sqrt[X]
         Y Sin[3 θ] + (0. + 6.39488*10^-14 I) W^3 X^(3/2)
         Y Sin[3 θ] + (0. + 2.22045*10^-16 I) W^3 Sqrt[X]
         Y^2 Sin[3 θ] + 
       1.36424*10^-12 W^3 X^(3/2)
         Y ω Sin[
         3 θ] - (0. + 4.54747*10^-13 I) W^3 Sqrt[X]
         Y^2 ω^2 Sin[3 θ] + 
       1.86265*10^-9 W^3 Sqrt[X]
         Y ω^3 Sin[
         3 θ] - (0. + 8.37383*10^-17 I) W^4 X Y^(3/2)
         Sin[4 θ] + 
       1.71496*10^-13 W^4 X Y^(
        3/2) ω Sin[
         4 θ] + (0. + 1.71496*10^-13 I) W^4 X Y^(
        3/2) ω^2 Sin[4 θ]))/((-4. + 8. X - 4. X^2 - 
       8. Y + 8. X Y - 2. W^2 X Y - 
       4. Y^2 - (0. + 24012. I) ω + (0. + 
          24016. I) X ω - (0. + 4. I) X^2 ω - (0. + 
          24020. I) Y ω + (0. + 12. I) X Y ω - (0. + 
          8. I) Y^2 ω + 3.6072*10^7 ω^2 - 
       48010. X ω^2 + 1. X^2 ω^2 + 
       60016. Y ω^2 - 4. X Y ω^2 + 
       4. Y^2 ω^2 + (0. + 1.08078*10^8 I) ω^3 - (0. + 
          30002. I) X ω^3 + (0. + 48004. I) Y ω^3 - 
       1.17036*10^8 ω^4 + 6000. X ω^4 - 
       12000. Y ω^4 - (0. + 5.4006*10^7 I) ω^5 + 
       9.*10^6 ω^6 + 
       W Sqrt[X] Sqrt[
        Y] (5.65685 + 5.65685 Y + 
          X (-5.65685 - (0. + 2.82843 I) ω) + (0. + 
             16979. I) ω + (0. + 5.65685 I) Y ω - 
          25458.7 ω^2 - (0. + 
             8485.28 I) ω^3) Cos[θ] - 
       3.63798*10^-12 W Sqrt[X] Sqrt[
        Y] ω Sin[θ]) (-4. + 8. X - 4. X^2 - 8. Y + 
       8. X Y - 2. W^2 X Y - 
       4. Y^2 + (0. + 24012. I) ω - (0. + 
          24016. I) X ω + (0. + 4. I) X^2 ω + (0. + 
          24020. I) Y ω - (0. + 12. I) X Y ω + (0. + 
          8. I) Y^2 ω + 3.6072*10^7 ω^2 - 
       48010. X ω^2 + 1. X^2 ω^2 + 
       60016. Y ω^2 - 4. X Y ω^2 + 
       4. Y^2 ω^2 - (0. + 1.08078*10^8 I) ω^3 + (0. + 
          30002. I) X ω^3 - (0. + 48004. I) Y ω^3 - 
       1.17036*10^8 ω^4 + 6000. X ω^4 - 
       12000. Y ω^4 + (0. + 5.4006*10^7 I) ω^5 + 
       9.*10^6 ω^6 + 
       W Sqrt[X] Sqrt[
        Y] (5.65685 + 5.65685 Y + 
          X (-5.65685 + (0. + 2.82843 I) ω) - (0. + 
             16979. I) ω - (0. + 5.65685 I) Y ω - 
          25458.7 ω^2 + (0. + 
             8485.28 I) ω^3) Cos[θ] + 
       3.63798*10^-12 W Sqrt[X] Sqrt[Y] ω Sin[θ])))

The same problem exists when I try to obtain the real part of the expression. Can anybody help me to find the correct answer?

Answer 1

It's not very hard to write your own Re and Im(which perform better in this case, since there exist only very simple functions):

(*
re[expression_, realVariableList_, positiveVariableList_, 
    realVariableFunctionList_]

and 

im[expression_, realVariableList_, positiveVariableList_, 
    realVariableFunctionList_]
*)
(* rules of atomic objects *)
re[num_?NumericQ, ___] := Re[num];
im[num_?NumericQ, ___] := Im[num];
re[expr:Re[___], ___] := expr;
im[expr:Im[___], ___] := expr;
re[expr:Im[___], ___] := 0;
im[expr:Re[___], ___] := 0;
re[sym_Symbol, reals_, ___] := If[MemberQ[reals, 
    sym], sym, Re[sym]];
im[sym_Symbol, reals_, ___] := If[MemberQ[reals, 
    sym], 0, Im[sym]];
(* rules of real variable functions *)
re[f_[a_], reals_, poss_, rrfuncs_] := If[MemberQ[rrfuncs, f] && TrueQ[re[a, 
    reals, poss, rrfuncs] == a], f[a], Re[f[a]]];
im[f_[a_], reals_, poss_, rrfuncs_] := If[MemberQ[rrfuncs, f] && TrueQ[re[a,  
    reals, poss, rrfuncs] == a], 0, Im[f[a]]];
(* rules of plus and times *)
re[a_ b_, conds___] := re[a, conds]re[b, conds] - im[a, conds]im[b, conds];
re[a_ + b_, conds___] := re[a, conds]+re[b, conds];
im[a_ b_, conds___] := re[a, conds]im[b, conds] + im[a, conds]re[b, conds];
im[a_ + b_, conds___] := im[a, conds]+im[b, conds];
(* rules of power *)
re[expr:Power[a_, b_], conds___] := Switch[
    b,
    _?Internal`NonNegativeIntegerQ, 
    Which[
        re[a, conds] =!= 0 && im[a, conds] =!= 0,
            Sum[
                re[a, conds]^(b-2i) im[a, conds]^(2i) (-1)^i Binomial[b, 2i],
                    {i, 0, Ceiling[b/2]}],
        im[a, conds] == 0 && re[a, conds] =!= 0,
            re[a, conds]^b,
        re[a, conds] == 0 && im[a, conds] =!= 0 && EvenQ@b,
            im[a, conds]^b (-1)^(b/2),
        True,
            0
        ],
    _?Internal`NegativeIntegerQ, With[
        {rep = re[a^-b, conds], imp = im[a^-b, conds]},
        rep/(rep^2+imp^2)
    ],
    _Rational, First@reimrational[a, Numerator@b, Denominator@b, conds],
    _, Re[expr]
];
im[expr:Power[a_, b_], conds___] := Switch[
    b,
    _?Internal`NonNegativeIntegerQ, Which[
        re[a, conds] =!= 0 && im[a, conds] =!= 0,
        Sum[
            re[a, conds]^(b-2i-1)im[a,conds]^(2i+1) (-1)^i Binomial[b, 2i+1], 
            {i, 0, Ceiling[b/2]}
        ],
        re[a, conds] == 0 && im[a, conds] =!= 0 && OddQ@b,
            im[a, conds]^b (-1)^((b-1)/2),
        True,
            0
        ],
    _?Internal`NegativeIntegerQ, With[
        {rep = re[a^-b, conds], imp = im[a^-b, conds]},
        -(imp/(rep^2+imp^2))
    ],
    _Rational, Last@reimrational[a, Numerator@b, Denominator@b, conds],
    _, Im[expr]
];
reimrational[a_, num_, den_, reals_, poss_, rrfuncs_] := 
    reimrational[a, num, den, reals, poss, rrfuncs] = If[
    num < 0, Block[
        {rep, imp},
        {rep, imp} = reimrational[a, -num, den, reals, poss, rrfuncs];
        Return[{rep/(rep^2+imp^2), -imp/(rep^2+imp^2)}]
    ],
    If[
        EvenQ[den] && re[a, reals, poss, rrfuncs] == a && FullSimplify[
            a >= 0, Assumptions->{Thread[poss>0]}
        ], Return[{a^(num/den), 0}]
    ];
    If[
        OddQ[den] && re[a, reals, poss, rrfuncs] == a, 
        Return[{a^(num/den), 0}]
    ];
    Return[{Re[a^(num/den)], Im[a^(num/den)]}];
]

Then:

re[expression, 
    Union@Cases[expression, _Symbol, Infinity],
    {X, Y},
    {Sin, Cos}
]

Notice in reimrational I use inline cache to accelerate evaluation. Actually we can do this for some definitions of im and re as well, by using GeneralUtilities`Memoized:

Memoized[im[args___] := (*defs*), (* memozied methods *)]

Numerical check:

rep = re[expression, 
    Union@Cases[expression, _Symbol, Infinity],
    {X, Y},
    {Sin, Cos}
];
imp = im[expression, 
    Union@Cases[expression, _Symbol, Infinity],
    {X, Y},
    {Sin, Cos}
];
Block[{
    X=RandomReal[{0, 3}], 
    Y=RandomReal[{0, 3}], 
    Z=RandomReal[{-3, 3}],
    W=RandomReal[{-3, 3}],
    \[Omega]=RandomReal[{-3, 3}],
    \[Theta]=RandomReal[{-\[Pi], \[Pi]}]
}, {rep+I imp, expression, rep+I imp - expression}]
(*{-0.00001028148857 + 0.00001737001526 I, -0.00001028148857 + 
  0.00001737001526 I, -6.776263578*10^-21 + 6.776263578*10^-21 I}*)