0
$\begingroup$

I am using this code

A := Cos[3 y] + (7 Sin[3 y])/( 2 y) + (-Cos[x] + Cos[2 y]) Csc[2 y] Sin[3 y];
B := (Cos[2 y] - Cos[x]) Csc[2 y] +  Sqrt[-1 + (Cos[3 y] + (2 - y Cos[x] Csc[2 y]) )^2];
F := (Cos[2 y] - Cos[x]) Csc[2 y] - Sqrt[-1 + (Cos[3 y] + (2 - y Cos[x] Csc[2 y]) )^2];

Manipulate[
 Module[{colorsDot = {Black, Green, White}, colorsLine = {   Orange  , Black,  Green}, pairs = Subsets[{" A ", " B ", " F "}, {2}], plt, pts}, 
  Show[Show[ plt = Plot[Evaluate[ToExpression[#[[1]]] /. x -> xv], {y, 0, 3}, PlotRange -> {0, 1.5}, PlotStyle -> #[[2]], PlotPoints -> 1000],  Graphics[{PointSize[Large], #[[3]], 
        pts = Point@Graphics`Mesh`FindIntersections[plt],  pts /. {y_, x_?NumericQ} :> {y, 1.6}}], 
      PlotRangeClipping -> False,  ImagePadding -> {{Automatic, 10}, {Automatic, 20}}] & /@ 
    Transpose[{pairs, Subsets[colorsLine, {2}],  colorsDot}]]], {{xv, -5, x}, -5, -3, 0.01, 
  Appearance -> "Open"}, TrackedSymbols :> True]

and I get this plot

enter image description here

Question:

How can I change those points (on the top) to a special character, say "*", or anything else? I do not want to change the intersection points markers of the curves, only the ones on the top; something like this picture

enter image description here

I appreciate any comments.

$\endgroup$

1 Answer 1

1
$\begingroup$
Clear["Global`*"]

A := Cos[3 y] + (7 Sin[3 y])/(2 y) +
   (-Cos[x] + Cos[2 y]) Csc[2 y] Sin[3 y];
B := (Cos[2 y] - Cos[x]) Csc[2 y] +
   Sqrt[-1 + (Cos[3 y] + (2 - y Cos[x] Csc[2 y]))^2];
F := (Cos[2 y] - Cos[x]) Csc[2 y] -
   Sqrt[-1 + (Cos[3 y] + (2 - y Cos[x] Csc[2 y]))^2];

Manipulate[
 Module[{
   colorsDot = {Black, Green, White},
   colorsLine = {Orange, Black, Green},
   pairs = Subsets[{" A ", " B ", " F "}, {2}],
   plt, pts},
  Show[
   Show[
      plt = Plot[Evaluate[ToExpression[#[[1]]] /. x -> xv],
        {y, 0, 3},
        PlotRange -> {0, 1.5},
        PlotStyle -> #[[2]],
        PlotPoints -> 1000],
      Graphics[{PointSize[Large], #[[3]], Point@
         (pts = Graphics`Mesh`FindIntersections[plt]),
        Text[Style["\[Star]", 20], {#[[1]], 1.6}] & /@ pts}],
      PlotRangeClipping -> False,
      ImagePadding ->
       {{Automatic, 10}, {Automatic, 20}}] & /@

        Transpose[{pairs, Subsets[colorsLine, {2}],
      colorsDot}]]],
 {{xv, -5, x}, -5, -3, 0.01, Appearance -> "Open"},
 TrackedSymbols :> True]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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