1

I am trying to solve:

DSolve[{Cn'[t] == CP[t]*kr - P*Cn[t]*kf, 
        CP'[t] == Cn[t]*P*kf + 2*CPP[t]*kr - P*CP[t]*kf - CP[t]*kr, 
        CPP'[t] == CP[t]*P*kf + 3*CPPP[t]*kr - P*CPP[t]*kf - 2*CPP[t]*kr, 
        CPPP'[t] == CPP[t]*P*kf + 4*CPPPP[t]*kr - P*CPPP[t]*kf - 3*CPPP[t]*kr, 
        CPPPP'[t] == CPPP[t]*P*kf - 4*CPPPP[t]*kr, CP[0] == 0, CPP[0] == 0, 
        CPPP[0] == 0, CPPPP[0] == Chp, Cn[0] == Chn}, 
      {Cn[t], CP[t], CPP[t], CPPP[t], CPPPP[t]}, t]

Mathematica 9 did not give a result overnight and ate up all the memory (~6g). However it can solve

DSolve[{Cn'[t] == CP[t]*kr - P*Cn[t]*kf, 
        CP'[t] == Cn[t]*P*kf + CPP[t]*kr - P*CP[t]*kf - CP[t]*kr, 
        CPP'[t] == CP[t]*P*kf + CPPP[t]*kr - P*CPP[t]*kf - CPP[t]*kr, 
        CPPP'[t] == CPP[t]*P*kf + CPPPP[t]*kr - P*CPPP[t]*kf - CPPP[t]*kr, 
        CPPPP'[t] == CPPP[t]*P*kf - CPPPP[t]*kr, CP[0] == 0, CPP[0] == 0, 
        CPPP[0] == 0, CPPPP[0] == chp, Cn[0] == chn},
      {Cn[t], CP[t], CPP[t], CPPP[t], CPPPP[t]}, t]

in hours. I am not very familiar with Mathematica. I wonder if there is a way to solve this system (the former one).

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
Weiwei
  • 11
  • 1
  • Do you need a closed form solution or a numerical one would do the trick ? – Sektor Sep 06 '13 at 22:38
  • Can you specify what kr,kf and P are? If those are constants, i.e. independent of t, the system should be easily solvable in a matter of seconds, because it would be linear. – Wizard Sep 07 '13 at 00:10
  • Thanks a lot for the reply! Yes kr, kf and P are constants with respect to t. I added SetAttributes[{kr, kf, P, chn, chp}, Constant] before the DSolve expression. It has been working for several hours now and still no result yet. It is best if I can have an explicit solution to this. If not, is there a way to do numerical fittings with my experimental data to derive kr, kf and P (parameters). – Weiwei Sep 07 '13 at 04:55
  • @Weiwei Something like: How to fit...? – Kuba Sep 07 '13 at 07:59

1 Answers1

1

You can use a property of your system of equations :

eqs = Simplify[{Cn'[t] == CP[t]*kr - P*Cn[t]*kf, 
                CP'[t] == Cn[t]*P*kf + 2*CPP[t]*kr - P*CP[t]*kf - CP[t]*kr, 
                CPP'[t] == CP[t]*P*kf + 3*CPPP[t]*kr - P*CPP[t]*kf - 2*CPP[t]*kr, 
                CPPP'[t] == CPP[t]*P*kf + 4*CPPPP[t]*kr - P*CPPP[t]*kf - 3*CPPP[t]*kr, 
                CPPPP'[t] == CPPP[t]*P*kf - 4*CPPPP[t]*kr}];

If you sum all the right-hand sides then you get :

FullSimplify[
 (CP[t]*kr - P*Cn[t]*kf) + 
 (Cn[t]*P*kf + 2*CPP[t]*kr - P*CP[t]*kf - CP[t]*kr) + 
 (CP[t]*P*kf + 3*CPPP[t]*kr - P*CPP[t]*kf - 2*CPP[t]*kr) + 
 (CPP[t]*P*kf + 4*CPPPP[t]*kr - P*CPPP[t]*kf - 3*CPPP[t]*kr) + 
 (CPPP[t]*P*kf - 4*CPPPP[t]*kr)]
 (* 0 *)

This means that the sum of all your functions Cn[t] + CP[t] + CPP[t] + CPPP[t] + CPPPP[t] is a constant, which equals (for instance) the value at t=0. We can use this information to get rid of Cn[t] :

subs = {Cn[t] -> (Chn + Chp) - (CP[t] + CPP[t] + CPPP[t] + CPPPP[t]), 
        Cn'[t] -> D[(Chn + Chp) - (CP[t] + CPP[t] + CPPP[t] + CPPPP[t]), t]};

eqs2 = FullSimplify[eqs[[2 ;;]] /. subs];

sol = DSolve[Join[eqs2, {CP[0] == 0, CPP[0] == 0, CPPP[0] == 0, CPPPP[0] == Chp}], 
             {CP[t], CPP[t], CPPP[t], CPPPP[t]}, t];

This runs quickly, however the result has a lot of RootSum objects.

Checks :

(* CP[0] *)
FullSimplify[sol[[1, 1, 2]] /. t -> 0]
(* 0 *)

(* CPPPP[0] *)
FullSimplify[sol[[1, 4, 2]] /. t -> 0]
(* Chp *)

(* Cn[0] *)
FullSimplify[(Chn + Chp) - Total[sol[[1, All, 2]] /. t -> 0]]
(* Chn *)
b.gates.you.know.what
  • 20,103
  • 2
  • 43
  • 84