Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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$.

share|improve this question
5  
It would be very useful to have your u[x,t]. –  b.gatessucks Nov 15 '13 at 13:06
    
Done. But what difference does it make? –  hrothgarrrr Nov 15 '13 at 13:49
4  
Try answering any new question without that information and maybe you'll see. –  b.gatessucks Nov 15 '13 at 14:07

2 Answers 2

up vote 9 down vote accepted

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. :)

share|improve this answer
    
And it's even better than NMaximize[{t, sol[x, t] == 1, -58 <= x <= 50, 50 <= t <= 58}, {x, t}]. –  b.gatessucks Nov 15 '13 at 14:23
    
@b.gatessucks Why do you think so? –  belisarius Nov 15 '13 at 14:31
    
@belisarius Kuba gets 56.0635, I get 56.0632. –  b.gatessucks Nov 15 '13 at 14:33
    
@b.gatessucks I get 56.0635 using NMaximize, MMa 9.0 –  belisarius Nov 15 '13 at 14:36

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

share|improve this answer
    
Nice paralypsis there. –  Yves Klett Nov 15 '13 at 15:09
    
@YvesKlett I was waiting for someone to notice it :) –  belisarius Nov 15 '13 at 15:22
1  
I shall call you Cicero henceforth :D –  Yves Klett Nov 15 '13 at 15:28

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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