Problem with Piecewise function

Question

I have a Piecewise function that must be non-negative. I want to replace negative part of this function with zero. my function has two summit and two valley. I want to remove this valley because in my piecewise function negative value is not reasonable. I tried for define a new piecewise -F[t]- for replace this valley with zero!!! but my piecwise cant Diagnosis the positiveness of my first summit. what's my mistake? please help me for find my mistake.I used Heaviside and piecewise but they didn't work for my FN[t]!!! I can use Piecewise, Piecewise and heaviside together but any of them dont work for my FN[t] and all of them remove my first positive summit. you can see picture of my resultant Positive function or copy past my code in your mathematica and see the result.

ClearAll[sol, m, e, K, F, FN, d, yGroundContact, yBodyContact,
Ballradius, Cmax, yCM, eq1, InitialConditions, A]
m = 32.6767;
g=9.81;
(*Contact Parameters*)
K = 100000000;
e = 1.5;
Cmax = 10000;  
d = 0.000001;

Ballradius = 0.1;


yGroundContact[t_] := 0;
yBodyContact[t_] := yCM[t] - Ballradius;
STEP[t_] := 
  Piecewise[{{1, 
     yBodyContact[t] < (yGroundContact[t] - d)}, {1/
       2*(1 - Sin[Pi/d*(yBodyContact[t] - yGroundContact[t]) + Pi/2]),
      yGroundContact[t] >= 
      yBodyContact[t] > (yGroundContact[t] - d)}, {0, 
     yBodyContact[t] > (yGroundContact[t])}}];
FN[t_] := 
  Piecewise[{{0, 
     yBodyContact[t] > 
      yGroundContact[t]}, {K*
       Abs[(yGroundContact[t] - yBodyContact[t])]^e - 
      Cmax*(yBodyContact'[t] - yGroundContact'[t])*STEP[t], 
     yBodyContact[t] <= yGroundContact[t]}}];
F[t_] := Piecewise[{{FN[t], FN[t] >= 0}, {0, FN[t] < 0}}];
A[t_] := Piecewise[{{10000, FN[t] >= 0}, {0, FN[t] < 0}}];

eq1 = m*yCM''[t] + m*g == +FN[t];

InitialConditions = {yCM[0] == 0.4, yCM'[0] == 0};
sol = NDSolve[{eq1, InitialConditions}, yCM, {t, 0, 10}, 
   MaxStepSize -> 0.0001];

Plot[{FN[t] /. sol, A[t] /. sol}, {t, 0, 0.5}, PlotRange -> Full, 
 AspectRatio -> 1/4, ImageSize -> 1400, 
 PlotStyle -> {{Red, Thickness[0.002]}, {Blue, Thickness[0.002], 
    Dashed}, {Orange, Thick, Dotted}}]
Plot[{F[t] /. sol, A[t] /. sol}, {t, 0, 0.5}, PlotRange -> Full, 
 AspectRatio -> 1/4, ImageSize -> 1400, 
 PlotStyle -> {{Red, Thickness[0.002]}, {Blue, Thickness[0.002], 
    Dashed}, {Orange, Thick, Dotted}}]

Answer 1

It's not surprising that Plot misses the first peak in the second case. Quoted from Details and Options section of document of Plot:

Plot initially evaluates $f$ at a number of equally spaced sample points specified by PlotPoints. Then it uses an adaptive algorithm to choose additional sample points, subdividing a given interval at most MaxRecursion times.

Since only a finite number of sample points are used, it is possible for Plot to miss features of $f$. Increasing the settings for PlotPoints and MaxRecursion will often catch such features.

Notice the following inference can be made based on these paragraphs: Recursive sampling probably won't happen in a region where no feature is catched.

Let's check how Plot places initial points for your function:

refF = Plot[F[t] /. sol // Evaluate, {t, 0, 0.5}, PlotPoints -> 51, PlotRange -> All, 
   PlotStyle -> Blue];

refFN = Plot[FN[t] /. sol // Evaluate, {t, 0, 0.5}, PlotRange -> All, 
   PlotStyle -> {Red, Dashed, Thick}];

test = Plot[Evaluate[F[t] /. sol], {t, 0, 0.5}, PlotRange -> All, MaxRecursion -> 0, 
   Mesh -> All, MeshStyle -> PointSize@Large];

Show[test, refF, refFN, PlotRange -> {{0.2, 0.3}, All}]

As we can see, the first peak of F happens to insert the space between initial plot points, so the recursive sampling simply doesn't happen near the first peak, because Plot thinks it's constant there. The peak is catched in refFN, because one initial plot point luckily catches the negative peak near the first peak so the first peak is then catched by recursive sampling. This is no more than an accident when the number of inital points isn't enough.

Answer 2

I understand that my problem was with my Plot. Function for remove non-positive piece of FN work correctly but i couldn't see the result in my plot. I used from PlotPoints -> 100000 in my code and now i can see the resultant function of remove negative parts. All of my below function works correctly and problem was with my plot after remove negative regions!!!

F1[t_] := Max[FN[t], 0];
F2[t_] := FN[t] - Min[FN[t], 0];
F3[t_] := Piecewise[{{FN[t], FN[t] >= 0}, {0, FN[t] < 0}}];
Plot[F1[t] /. sol, {t, 0, 0.5}, PlotRange -> Full, PlotPoints -> 100000]
Plot[F2[t] /. sol, {t, 0, 0.5}, PlotRange -> Full, PlotPoints -> 100000]
Plot[F3[t] /. sol, {t, 0, 0.5}, PlotRange -> Full, PlotPoints -> 100000]

I cant explain that event. I think the plot needs more point for show my new function but i cant find any logic and reason for this!!! why after remove negative region my plot needs more point for depict new function? Why mathematica couldn't detect this problem and use more point for draw changed information? why with remove negative parts i need more point for depict my values? If anyone can explain that why this problem occur after make a change in function, please illuminates my mind.

Answer 3

You may use HeavisideTheta.

For some Piecewise function

f[x_] := Piecewise[{{Sin[x], x <= 0}, {Cos[x], x > 0}}]

Plot[f[x], {x, -4, 4}]

Then the negatives can be shaved off by using HeavisideTheta in a new function.

positiveF[x_] := With[{v = f[x]}, HeavisideTheta[v] v]

Plot[positiveF[x], {x, -4, 4}, PlotRange -> {-1, 1}, PlotRangeClipping -> False]

Above With is used to calculate f[x] only once per call in case it is expensive to calculate.

Hope his helps.