Skip to main content
Responded to comment
Source Link
Michael E2
  • 244.7k
  • 18
  • 350
  • 774

Update notice: @lotus2019 pointed out that it was not working for them. The issue, as much as one can be sure of issues when fiddling with internals, is that the time constraint needs to be short enough. Tested on V14.0 and V14.1. I checked DSolve[ode, y[x], x] in V14.1, and it still results in an implicit equation with an unsolved integral.

Workaround:

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{Solve},
   (* ref: https://mathematica.stackexchange.com/a/63676 *)
   Unprotect[Solve];
   s_Solve /; ! TrueQ[$in] := Block[{$in = True},
     TimeConstrained[s, 1, $$in] := Block[{$in = True},
     TimeConstrained[s, 0.1, $Failed] (* might need to adjust 0.1 *)
     ];
   Protect[Solve];
   DSolve[ode, y[x], x]
   ] //(* difficult simplification *)
  Collect[#, Sqrt[-x + C[1]], 
    ReplaceAll[c_ (x - C[1]) -> -c (-x + C[1])]@*Factor] & //
 AbsoluteTiming
(*
{84.2428 (* first time; 2.4242 sec. on subsequent runs *), 
{{y[x] -> C[1] - 2/3 (-x + C[1])^(3/2)},
 {y[x] -> C[1] + 2/3 (-x + C[1])^(3/2)}}}
*)
ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{DSolve`DSolveSingularSolutions, 
   TimeConstrained, Limit, Solve},
  DSolve`DSolveSingularSolutions;
  Unprotect[DSolve`DSolveSingularSolutions];
  DownValues@DSolve`DSolveSingularSolutions = 
   DownValues@DSolve`DSolveSingularSolutions /.
    HoldPattern[ (* BUG FIX *)
      If[! FreeQ[test_, False], s_ = {}]] :> (s = Pick[s, test]);
  Protect[DSolve`DSolveSingularSolutions];
  Unprotect[TimeConstrained];
  TimeConstrained[code_, tc_, fail___] /; ! TrueQ[$inTC] :=
   Block[{$inTC = True},
    If[FreeQ[Hold[code], DSolve`DSolveSingularSolutions],
     TimeConstrained[code, 0.1, fail], (* might need to adjust 0.1 *)
     (* Don't over-constrain DSolveSingularSolutions: *)
     TimeConstrained[code, tc, fail]
     ]
    ];
  Protect[TimeConstrained];
  Unprotect[Limit];
  lim_Limit /; ! TrueQ[$inLimit] := 
   Block[{$inLimit = True, $res1, $res2},
    TimeConstrained[lim, 1, Infinity]
    ];
  Protect[Limit];
  Unprotect[Solve];
  s_Solve /; ! TrueQ[$inSolve] := 
   Block[{$inSolve = True, $res1, $res2},
    TimeConstrained[s, 1, $Failed]
    ];
  Protect[Limit];
  
  DSolve[ode, y[x], x, IncludeSingularSolutions -> True]
  ] // AbsoluteTiming
(* unsimplified
{69.4 (* first time; 5.1 sec. on subsequent runs *), 
 {{y[x] -> 1/3 (3 C[1] + 2 x Sqrt[-x + C[1]] - 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (3 C[1] - 2 x Sqrt[-x + C[1]] + 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (1 + 3 x)}}}
*)

Workaround:

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{Solve},
   (* ref: https://mathematica.stackexchange.com/a/63676 *)
   Unprotect[Solve];
   s_Solve /; ! TrueQ[$in] := Block[{$in = True},
     TimeConstrained[s, 1, $Failed]
     ];
   Protect[Solve];
   DSolve[ode, y[x], x]
   ] //(* difficult simplification *)
  Collect[#, Sqrt[-x + C[1]], 
    ReplaceAll[c_ (x - C[1]) -> -c (-x + C[1])]@*Factor] & //
 AbsoluteTiming
(*
{84.2428 (* first time; 2.4242 sec. on subsequent runs *), 
{{y[x] -> C[1] - 2/3 (-x + C[1])^(3/2)},
 {y[x] -> C[1] + 2/3 (-x + C[1])^(3/2)}}}
*)
ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{DSolve`DSolveSingularSolutions, 
   TimeConstrained, Limit, Solve},
  DSolve`DSolveSingularSolutions;
  Unprotect[DSolve`DSolveSingularSolutions];
  DownValues@DSolve`DSolveSingularSolutions = 
   DownValues@DSolve`DSolveSingularSolutions /.
    HoldPattern[ (* BUG FIX *)
      If[! FreeQ[test_, False], s_ = {}]] :> (s = Pick[s, test]);
  Protect[DSolve`DSolveSingularSolutions];
  Unprotect[TimeConstrained];
  TimeConstrained[code_, tc_, fail___] /; ! TrueQ[$inTC] :=
   Block[{$inTC = True},
    If[FreeQ[Hold[code], DSolve`DSolveSingularSolutions],
     TimeConstrained[code, 1, fail],
     (* Don't over-constrain DSolveSingularSolutions: *)
     TimeConstrained[code, tc, fail]
     ]
    ];
  Protect[TimeConstrained];
  Unprotect[Limit];
  lim_Limit /; ! TrueQ[$inLimit] := 
   Block[{$inLimit = True, $res1, $res2},
    TimeConstrained[lim, 1, Infinity]
    ];
  Protect[Limit];
  Unprotect[Solve];
  s_Solve /; ! TrueQ[$inSolve] := 
   Block[{$inSolve = True, $res1, $res2},
    TimeConstrained[s, 1, $Failed]
    ];
  Protect[Limit];
  
  DSolve[ode, y[x], x, IncludeSingularSolutions -> True]
  ] // AbsoluteTiming
(* unsimplified
{69.4 (* first time; 5.1 sec. on subsequent runs *), 
 {{y[x] -> 1/3 (3 C[1] + 2 x Sqrt[-x + C[1]] - 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (3 C[1] - 2 x Sqrt[-x + C[1]] + 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (1 + 3 x)}}}
*)

Update notice: @lotus2019 pointed out that it was not working for them. The issue, as much as one can be sure of issues when fiddling with internals, is that the time constraint needs to be short enough. Tested on V14.0 and V14.1. I checked DSolve[ode, y[x], x] in V14.1, and it still results in an implicit equation with an unsolved integral.

Workaround:

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{Solve},
   (* ref: https://mathematica.stackexchange.com/a/63676 *)
   Unprotect[Solve];
   s_Solve /; ! TrueQ[$in] := Block[{$in = True},
     TimeConstrained[s, 0.1, $Failed] (* might need to adjust 0.1 *)
     ];
   Protect[Solve];
   DSolve[ode, y[x], x]
   ] //(* difficult simplification *)
  Collect[#, Sqrt[-x + C[1]], 
    ReplaceAll[c_ (x - C[1]) -> -c (-x + C[1])]@*Factor] & //
 AbsoluteTiming
(*
{84.2428 (* first time; 2.4242 sec. on subsequent runs *), 
{{y[x] -> C[1] - 2/3 (-x + C[1])^(3/2)},
 {y[x] -> C[1] + 2/3 (-x + C[1])^(3/2)}}}
*)
ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{DSolve`DSolveSingularSolutions, 
   TimeConstrained, Limit, Solve},
  DSolve`DSolveSingularSolutions;
  Unprotect[DSolve`DSolveSingularSolutions];
  DownValues@DSolve`DSolveSingularSolutions = 
   DownValues@DSolve`DSolveSingularSolutions /.
    HoldPattern[ (* BUG FIX *)
      If[! FreeQ[test_, False], s_ = {}]] :> (s = Pick[s, test]);
  Protect[DSolve`DSolveSingularSolutions];
  Unprotect[TimeConstrained];
  TimeConstrained[code_, tc_, fail___] /; ! TrueQ[$inTC] :=
   Block[{$inTC = True},
    If[FreeQ[Hold[code], DSolve`DSolveSingularSolutions],
     TimeConstrained[code, 0.1, fail], (* might need to adjust 0.1 *)
     (* Don't over-constrain DSolveSingularSolutions: *)
     TimeConstrained[code, tc, fail]
     ]
    ];
  Protect[TimeConstrained];
  Unprotect[Limit];
  lim_Limit /; ! TrueQ[$inLimit] := 
   Block[{$inLimit = True, $res1, $res2},
    TimeConstrained[lim, 1, Infinity]
    ];
  Protect[Limit];
  Unprotect[Solve];
  s_Solve /; ! TrueQ[$inSolve] := 
   Block[{$inSolve = True, $res1, $res2},
    TimeConstrained[s, 1, $Failed]
    ];
  Protect[Limit];
  
  DSolve[ode, y[x], x, IncludeSingularSolutions -> True]
  ] // AbsoluteTiming
(* unsimplified
{69.4 (* first time; 5.1 sec. on subsequent runs *), 
 {{y[x] -> 1/3 (3 C[1] + 2 x Sqrt[-x + C[1]] - 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (3 C[1] - 2 x Sqrt[-x + C[1]] + 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (1 + 3 x)}}}
*)
Added addendum
Source Link
Michael E2
  • 244.7k
  • 18
  • 350
  • 774

Addendum

Hackier but complete workaround as a proof of concept (V14.0.0 and the version might be more important here since we edit out the bug in the code):

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{DSolve`DSolveSingularSolutions, 
   TimeConstrained, Limit, Solve},
  DSolve`DSolveSingularSolutions;
  Unprotect[DSolve`DSolveSingularSolutions];
  DownValues@DSolve`DSolveSingularSolutions = 
   DownValues@DSolve`DSolveSingularSolutions /.
    HoldPattern[ (* BUG FIX *)
      If[! FreeQ[test_, False], s_ = {}]] :> (s = Pick[s, test]);
  Protect[DSolve`DSolveSingularSolutions];
  Unprotect[TimeConstrained];
  TimeConstrained[code_, tc_, fail___] /; ! TrueQ[$inTC] :=
   Block[{$inTC = True},
    If[FreeQ[Hold[code], DSolve`DSolveSingularSolutions],
     TimeConstrained[code, 1, fail],
     (* Don't over-constrain DSolveSingularSolutions: *)
     TimeConstrained[code, tc, fail]
     ]
    ];
  Protect[TimeConstrained];
  Unprotect[Limit];
  lim_Limit /; ! TrueQ[$inLimit] := 
   Block[{$inLimit = True, $res1, $res2},
    TimeConstrained[lim, 1, Infinity]
    ];
  Protect[Limit];
  Unprotect[Solve];
  s_Solve /; ! TrueQ[$inSolve] := 
   Block[{$inSolve = True, $res1, $res2},
    TimeConstrained[s, 1, $Failed]
    ];
  Protect[Limit];
  
  DSolve[ode, y[x], x, IncludeSingularSolutions -> True]
  ] // AbsoluteTiming
(* unsimplified
{69.4 (* first time; 5.1 sec. on subsequent runs *), 
 {{y[x] -> 1/3 (3 C[1] + 2 x Sqrt[-x + C[1]] - 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (3 C[1] - 2 x Sqrt[-x + C[1]] + 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (1 + 3 x)}}}
*)

The time limits work here because everything important is easy, except the total time for DSolve`DSolveSingularSolutions. The small time limits seem to keep DSolve from going down several rabbit trails for too long. Beware, the time limits might cause DSolve to miss the solution on a different problem. Clearly the improved time on the second and subsequent runs means some work from the first run is re-used. One hopes that the short time limits did not cause failures to be cached. This partly what I mean by warning that this a proof of concept. This is not a general approach to be emulated by the casual user nor certainly by application developers.

The concept proved is that DSolve[] can solve the ODE. However, design choices make finding the general solution very slow, and an apparent bug means the singular solution is discarded.


Addendum

Hackier but complete workaround as a proof of concept (V14.0.0 and the version might be more important here since we edit out the bug in the code):

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{DSolve`DSolveSingularSolutions, 
   TimeConstrained, Limit, Solve},
  DSolve`DSolveSingularSolutions;
  Unprotect[DSolve`DSolveSingularSolutions];
  DownValues@DSolve`DSolveSingularSolutions = 
   DownValues@DSolve`DSolveSingularSolutions /.
    HoldPattern[ (* BUG FIX *)
      If[! FreeQ[test_, False], s_ = {}]] :> (s = Pick[s, test]);
  Protect[DSolve`DSolveSingularSolutions];
  Unprotect[TimeConstrained];
  TimeConstrained[code_, tc_, fail___] /; ! TrueQ[$inTC] :=
   Block[{$inTC = True},
    If[FreeQ[Hold[code], DSolve`DSolveSingularSolutions],
     TimeConstrained[code, 1, fail],
     (* Don't over-constrain DSolveSingularSolutions: *)
     TimeConstrained[code, tc, fail]
     ]
    ];
  Protect[TimeConstrained];
  Unprotect[Limit];
  lim_Limit /; ! TrueQ[$inLimit] := 
   Block[{$inLimit = True, $res1, $res2},
    TimeConstrained[lim, 1, Infinity]
    ];
  Protect[Limit];
  Unprotect[Solve];
  s_Solve /; ! TrueQ[$inSolve] := 
   Block[{$inSolve = True, $res1, $res2},
    TimeConstrained[s, 1, $Failed]
    ];
  Protect[Limit];
  
  DSolve[ode, y[x], x, IncludeSingularSolutions -> True]
  ] // AbsoluteTiming
(* unsimplified
{69.4 (* first time; 5.1 sec. on subsequent runs *), 
 {{y[x] -> 1/3 (3 C[1] + 2 x Sqrt[-x + C[1]] - 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (3 C[1] - 2 x Sqrt[-x + C[1]] + 2 C[1] Sqrt[-x + C[1]])},
  {y[x] -> 1/3 (1 + 3 x)}}}
*)

The time limits work here because everything important is easy, except the total time for DSolve`DSolveSingularSolutions. The small time limits seem to keep DSolve from going down several rabbit trails for too long. Beware, the time limits might cause DSolve to miss the solution on a different problem. Clearly the improved time on the second and subsequent runs means some work from the first run is re-used. One hopes that the short time limits did not cause failures to be cached. This partly what I mean by warning that this a proof of concept. This is not a general approach to be emulated by the casual user nor certainly by application developers.

The concept proved is that DSolve[] can solve the ODE. However, design choices make finding the general solution very slow, and an apparent bug means the singular solution is discarded.

Responded to comment
Source Link
Michael E2
  • 244.7k
  • 18
  • 350
  • 774

Workaround:

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{Solve},
   (* ref: https://mathematica.stackexchange.com/a/63676 *)
   Unprotect[Solve];
   s_Solve /; ! TrueQ[$in] := Block[{$in = True},
     TimeConstrained[s, 1, $Failed]
     ];
   Protect[Solve];
   DSolve[ode, y[x], x]
   ] //(* difficult simplification *)
  Collect[#, Sqrt[-x + C[1]], 
    ReplaceAll[c_ (x - C[1]) -> -c (-x + C[1])]@*Factor] & //
 AbsoluteTiming
(*
{84.2428 (* first time; 2.4242 sec. on subsequent runs *), 
{{y[x] -> C[1] - 2/3 (-x + C[1])^(3/2)},
 {y[x] -> C[1] + 2/3 (-x + C[1])^(3/2)}}}
*)

IncludeSingularSolutions -> True returns the same, after 50(!) additional seconds. So that seems a place for improvement.

Possibly the first strategies the parser tries waste a long time before returning unsolved. That would explain why a short time constraint speeds things up instead of causing a quick failure.

Workaround:

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{Solve},
   (* ref: https://mathematica.stackexchange.com/a/63676 *)
   Unprotect[Solve];
   s_Solve /; ! TrueQ[$in] := Block[{$in = True},
     TimeConstrained[s, 1, $Failed]
     ];
   Protect[Solve];
   DSolve[ode, y[x], x]
   ] //(* difficult simplification *)
  Collect[#, Sqrt[-x + C[1]], 
    ReplaceAll[c_ (x - C[1]) -> -c (-x + C[1])]@*Factor] & //
 AbsoluteTiming
(*
{2.4242, 
{{y[x] -> C[1] - 2/3 (-x + C[1])^(3/2)},
 {y[x] -> C[1] + 2/3 (-x + C[1])^(3/2)}}}
*)

IncludeSingularSolutions -> True returns the same, after 50(!) additional seconds. So that seems a place for improvement.

Possibly the first strategies the parser tries waste a long time before returning unsolved. That would explain why a short time constraint speeds things up instead of causing a quick failure.

Workaround:

ClearAll[y, x]
ode = y[x] == x + y'[x]^2*(1 - 2/3*y'[x]);
Internal`InheritedBlock[{Solve},
   (* ref: https://mathematica.stackexchange.com/a/63676 *)
   Unprotect[Solve];
   s_Solve /; ! TrueQ[$in] := Block[{$in = True},
     TimeConstrained[s, 1, $Failed]
     ];
   Protect[Solve];
   DSolve[ode, y[x], x]
   ] //(* difficult simplification *)
  Collect[#, Sqrt[-x + C[1]], 
    ReplaceAll[c_ (x - C[1]) -> -c (-x + C[1])]@*Factor] & //
 AbsoluteTiming
(*
{84.2428 (* first time; 2.4242 sec. on subsequent runs *), 
{{y[x] -> C[1] - 2/3 (-x + C[1])^(3/2)},
 {y[x] -> C[1] + 2/3 (-x + C[1])^(3/2)}}}
*)

IncludeSingularSolutions -> True returns the same, after 50(!) additional seconds. So that seems a place for improvement.

Possibly the first strategies the parser tries waste a long time before returning unsolved. That would explain why a short time constraint speeds things up instead of causing a quick failure.

Source Link
Michael E2
  • 244.7k
  • 18
  • 350
  • 774
Loading