5
$\begingroup$

Given the smooth function u[x,t] on a domain, how do I find the maximal t at which u[x,t] == 1 (leaving x unconstrained)?

I can plot the level curve with

ContourPlot[ u[x,t] == 1, {x, -50, -58}, {t, 50, 58} ]

but I'm not sure how to numerically locate the point I want.

Edit: My u is the solution to a PDE:

sol = NDSolve[
      { D[u[x, t], t] == D[u[x, t], x, x] 
          + D[u[x, t], x] - u[x, t]^3
          + 3 u[x, t]^2 -2 u[x, t],
        u[x, 0] == 3 Exp[-x^2 /6],
        u[-100, t] == 0,
        u[30, t] == 0 },
        u, {x, -100, 30}, {t, 0, 100}]

The point of interest lies in the domain $-58<x<-50$ and $50<t<58$.

$\endgroup$
  • 5
    $\begingroup$ It would be very useful to have your u[x,t]. $\endgroup$ – b.gates.you.know.what Nov 15 '13 at 13:06
  • $\begingroup$ Done. But what difference does it make? $\endgroup$ – hrothgarrrr Nov 15 '13 at 13:49
  • 4
    $\begingroup$ Try answering any new question without that information and maybe you'll see. $\endgroup$ – b.gates.you.know.what Nov 15 '13 at 14:07
11
$\begingroup$

Before any real answer appears:

ContourPlot[Evaluate[u[x, t] /. sol] == 1, {x, -50, -58}, {t, 50, 58}
 ] //  Normal // Cases[#, Line[x__] :> x, Infinity][[ 1, ;; , 2]] & // Max
56.0628

...and the real answer:

U = u /. sol[[ 1]]

FindRoot[{U[x, t] == 1, D[U[x, t], x] == 0}, {{x, -56}, {t, 54}}]
{x -> -56.0326, t -> 56.0635}

So graphical method was not so bad. :)

$\endgroup$
  • $\begingroup$ And it's even better than NMaximize[{t, sol[x, t] == 1, -58 <= x <= 50, 50 <= t <= 58}, {x, t}]. $\endgroup$ – b.gates.you.know.what Nov 15 '13 at 14:23
  • $\begingroup$ @b.gatessucks Why do you think so? $\endgroup$ – Dr. belisarius Nov 15 '13 at 14:31
  • $\begingroup$ @belisarius Kuba gets 56.0635, I get 56.0632. $\endgroup$ – b.gates.you.know.what Nov 15 '13 at 14:33
  • $\begingroup$ @b.gatessucks I get 56.0635 using NMaximize, MMa 9.0 $\endgroup$ – Dr. belisarius Nov 15 '13 at 14:36
10
$\begingroup$

Following the trend of posting alternative methods and skipping the obvious
NMaximize[{t, sol[x, t] == 1, -58 <= x <= 50, 50 <= t <= 58}, {x, t}]

max = SortBy[PixelValuePositions[
        i = Binarize@Image[ContourPlot[s[x, t] == 1, {x, -50, -58}, {t, 50, 58}, 
               Frame -> False, PlotRangePadding -> None], ImageSize->2500], Min], -#[[2]] &][[1, 2]]

N@Rescale[max, {1, ImageDimensions[i][[2]]}, {50, 58}]
(*
 56.0632
*)

Some precision is scarified to get errr ... whatever

$\endgroup$
  • $\begingroup$ Nice paralypsis there. $\endgroup$ – Yves Klett Nov 15 '13 at 15:09
  • $\begingroup$ @YvesKlett I was waiting for someone to notice it :) $\endgroup$ – Dr. belisarius Nov 15 '13 at 15:22
  • 1
    $\begingroup$ I shall call you Cicero henceforth :D $\endgroup$ – Yves Klett Nov 15 '13 at 15:28
  • 2
    $\begingroup$ I learnt a new word! en.wiktionary.org/wiki/paraleipsis#English $\endgroup$ – chris May 19 '15 at 8:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.