$Version

starttime = AbsoluteTime[]

<< HighEnergyPhysics`FeynCalc`

$FeynCalcVersion

tr = TR[Calc[#]] &;

{ScalarProduct[p, p] = mw^2, ScalarProduct[q, q] = 0, 
        ScalarProduct[l, l] =  (x + y)^2  mw^2, 
        ScalarProduct[l3, l3] =  x^2  mw^2, 
        ScalarProduct[l4, l4] =  x^2  mw^2, 
        ScalarProduct[p, l] =  (x + y)  mw^2, 
        ScalarProduct[p, l3] =  x  mw^2, 
        ScalarProduct[p, l4] =  x  mw^2, ScalarProduct[l, q] = 0, 
        ScalarProduct[l3, q] = 0, ScalarProduct[l4, q] = 0, 
        ScalarProduct[p, q] = 0, 
        Pair[Momentum[q, ___], LorentzIndex[μ, ___]] = 0, 
        Pair[Momentum[p, d___], LorentzIndex[α, ___]] =   Pair[
            Momentum[q, d], LorentzIndex[α, d]], 
        Pair[Momentum[p, d___], 
            LorentzIndex[β, ___]] = -Pair[Momentum[q, d], 
              LorentzIndex[β, d]],  
        Pair[Momentum[l, d___], 
            LorentzIndex[α, ___]] =   2  y  Pair[Momentum[q, d], 
              LorentzIndex[α, d]], 
        Pair[Momentum[l, d___], 
            LorentzIndex[β, ___]] = -2  x  Pair[Momentum[q, d], 
              LorentzIndex[β, d]],  
        Pair[Momentum[l, d___], 
            LorentzIndex[μ, ___]] = (x + y)  Pair[Momentum[p, d], 
              LorentzIndex[μ, d]],  
        Pair[Momentum[l3, d___], LorentzIndex[α, ___]] = 
          2  x Pair[Momentum[q, d], LorentzIndex[α, d]], 
        Pair[Momentum[l3, d___], LorentzIndex[β, ___]] = 0,  
        Pair[Momentum[l3, d___], LorentzIndex[μ, ___]] = 
          x  Pair[Momentum[p, d], LorentzIndex[μ, d]], 
        Pair[Momentum[l4, d___], LorentzIndex[α, ___]] = 0, 
        Pair[Momentum[l4, d___], LorentzIndex[β, ___]] = -2 
            x Pair[Momentum[q, d], LorentzIndex[β, d]],  
        Pair[Momentum[l4, d___], LorentzIndex[μ, ___]] = 
          x Pair[Momentum[p, d], LorentzIndex[μ, d]]};

PL = (1 - GAD[5])/2;

PR = (1 + GAD[5])/2;

s[a_, b_] := 
      I/2 (GAD[a] . GAD[b] - GAD[b] . GAD[a])

Γa[c_, 
        d_]:=FullSimplify[
        Calc[GAD[α] . (AL PL  + AR  PR )  +  
            (1/Λ) ( -( 
                        CL PL  + CR  PR) (FVD[c, α] + 
                        FVD[d, α])  - 
                  4 I (DL PL  +  DR  PR) .  
                      Contract[
                        s[α, ρ]  (FVD[p, ρ] -  
                              FVD[q, ρ])] )]]

Γαμ = 
        FullSimplify[
          Calc[ (1/Λ) (   ( ( Qb CL  + BL ) 
                          PL  + ( Qb CR  + BR ) 
                          PR ) MTD[α, μ] + 
                  4 I (DL PL  +  DR  PR) .  
                      s[α, μ] )]];

\(\(\(
\)\(\(Γb[e_, f_] := 
      FullSimplify[
        Calc[GAD[β] . \((\(AL\^*\)\ PL\  + \(AR\^*\)\ \ PR\ )\)\  + \ 
            1\/Λ\ \((\ \(-\((\ \(CL\^*\)\ PR\  + \(CR\^*\)\ PL)\)\)\ \((FVD[e, β] + FVD[f, β])\)\  + 
                  4\ I\ \((\(DL\^*\)\ \ PR\  + \ \(DR\^*\)\ PL)\) . \ 
                      Contract[
                        s[β, λ]\ \ \((FVD[p, λ] + \ 
                              FVD[q, λ])\)]\ )\)]]\)\(
\)\(
\)
    \)\)\)

\(\(\(
\)\(\(Γβμ = 
        FullSimplify[
          Calc[\ 1\/Λ\ \((\ \ \ \((\ \((\ 
                            Qb\ \ \(CL\^*\)\  + \ \(BL\^*\)\ )\) 
                          PR\  + \((\ Qb\ \ \(CR\^*\)\  + \(BR\^*\)\ )\) 
                          PL\ )\)\ MTD[β, μ] - 
                  4\ I\ \((\(DL\^*\)\ PR\  + \ \(DR\^*\)\ \ PL)\) . \ 
                      s[\ β, μ]\ )\)]];\)\(
\)
    \)\)\)

Γαβ = 
        Calc[ (2/Λ) (   (Co  +  
                    I C5  GAD[5]) .  
                s[ α, β] )] ;

Γtμ =  
        DiracReduce[
          Qt  GAD[μ]  -  
            (4/Λ) (I abo  - ab5) Contract[
                s[μ, λ]  FVD[
                    q, λ]]] ;

Γbμ = 
        Qb GAD[μ] ;

Options@Isolate

$NonComm

tmp1 = 
      Isolate[FCI[Γαμ . (GSD[k] - 
                x (GSD[p] + GSD[q]) + mb) . Γb[
              k, -l3] . (GSD[k] + (1 - x) (GSD[p] + GSD[q]) + 
                mt)], $NonComm, IsolateNames -> Z]

Options@DiracSimplify

?DotExpand

Options@Collect2

AbsoluteTiming[tmp2 = 
          Collect2[DiracTrick[DotExpand[tmp1]] // FRH, $NonComm, 
            IsolateNames -> Z, 
            Factoring -> Expand];]
tmp2 // Length

AbsoluteTiming[t2 = 
          Collect2[Tr[tmp2] // FRH, LorentzIndex, IsolateNames -> R, 
            Factoring -> Factor2];]

t2

?? R

ntr = 
        Collect2[
            Tr[Collect2[
                  DiracTrick[
                      DotExpand[
                        Isolate[FCI[#], $NonComm, IsolateNames -> Z]]] // 
                    FRH, $NonComm, IsolateNames -> Z, 
                  Factoring -> Expand]] // FRH, LorentzIndex, 
            IsolateNames -> R, 
            Factoring -> Factor2] &;

AbsoluteTiming[
      t3 = ntr[Γαμ . (GSD[k] - 
                x (GSD[p] + GSD[q]) + mb) . Γb[
              k, -l3] . (GSD[k] + (1 - x) (GSD[p] + GSD[q]) + 
                mt)]]

AbsoluteTiming[
      t4 = ntr[Γa[
              k, -l4] . (GSD[k] - x (GSD[p] - GSD[q]) + 
                mb) . Γβμ . (GSD[
                  k] + (1 - x) (GSD[p] - GSD[q]) + 
                mt)]]

AbsoluteTiming[
      t5 = ntr[Γtμ . (GSD[k] - x GSD[q] + 
                mt) . Γαβ . (GSD[
                  k] + (2  - x) GSD[q] + mt)]]

Round[AbsoluteTime[] - starttime] segundos