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.

How can I add an arrow at a certain point of a curve with the direction of the arrow tangential to that point? (Line are not straight in a log-plot.)

LogPlot[(1 - τ)^(-0.5),
 {τ, 0, 1}, PlotRange -> {{0, 1}, {0.66, 20}},
 Frame -> {{True, True}, {True, False}},
 ImageSize -> 600,
 PlotStyle -> {Directive[Black, Thick]},
 BaseStyle -> {FontSize -> 30},
 RotateLabel -> False,
 AspectRatio -> 1
 ]

enter image description here

share|improve this question
    
Relevant example code: (56543), (22200). –  Pickett Aug 15 at 14:09
1  
I think the fact that this Q concerns a LogPlot instead of Plot/ParametricPlot makes it sufficiently distinct from the related questions or proposed duplicate. Certainly, the code in those questions does not work as is (without adjusting for the difference in the coordinate system). –  Michael E2 Aug 15 at 14:48
    
@user19178 I added what I thought might the issue. If I'm wrong, you might consider expanding your question and clarifying what issue(s) you face. –  Michael E2 Aug 15 at 15:01
    
@MichaelE2 Reopened on request. –  Mr.Wizard Aug 16 at 3:38

4 Answers 4

up vote 5 down vote accepted

The question was reopened after I went to bed, so it seems like I left the party early. :)

In any case, LogPlot[f, <>] of course is the plot of Log[f] with the tick labels and positions adjusted to correspond. So the slope of the tangent is given by the derivative of Log[f]. Using the variable x for my own convenience, the tangent arrow (of length 0.5) at x = x0 is given by

f = (1 - x)^(-0.5);
f0 = Log[f] /. x -> x0;
df0 = D[Log[f], x] /. x -> x0;
Arrow[{{x0, f0}, {x0, f0} + 0.5 Normalize[{1, df0}]}]

The Arrow can be added to a plot with Epilog, Prolog, or using Show and Graphics.

If you wish to display several arrows of the same geometric length in a plot, they will not appear to have the same length unless AspectRatio is set to Automatic (or the slopes of the arrows accidentally have the same magnitude). If you can wait an extra tenth of a second or so, you can fix it so that the arrows will have lengths that will appear the same in the output. If we let ar be the ratio of the aspect ratio of the PlotRange to the value of AspectRatio (see further down for code), then the length of the tangent should be given by the following to have any arrow appear to have the same length:

Arrow[{{x0, f0}, {x0, f0} + 0.5 {1, df0} / Norm[{1, df0*ar}]}]

Again, the 0.5 can be adjusted to suit a particular application.

The code for calculating ar is based on Alexey Popkov's completePlotRange for computing the actual PlotRange of a plot.

completePlotRange[plot : (_Graphics | _Graphics3D | _Graph)] := 
 Last@Last@
   Reap[Rasterize[
     Show[plot, Axes -> True, Frame -> False, Ticks -> ((Sow[{##}]; Automatic) &), 
      DisplayFunction -> Identity, ImageSize -> 0], 
     ImageResolution -> 1]]

Block[{f, f0, df0, ar, plot},
 f = (1 - x)^(-0.5);
 f0 = Log[f] /. x -> x0;
 df0 = D[Log[f], x] /. x -> x0;

 plot = LogPlot[f, {x, 0, 1}, PlotRange -> {{0, 1.3}, {0.66, 20}}, 
   Frame -> {{True, True}, {True, False}}, ImageSize -> 400, 
   PlotStyle -> {Directive[Black, Thick], Automatic}, 
   BaseStyle -> {FontSize -> 30}, RotateLabel -> False, 
   AspectRatio -> 1
   ];

 ar = If[(AspectRatio /. Options[plot, AspectRatio]) === Automatic,
   1,
   (AspectRatio /. Options[plot, AspectRatio])/
    Ratios[Differences /@ completePlotRange@plot][[1, 1]]
   ];

 Show[
  plot,
  Graphics[{Red, Thick, 
    Table[Arrow[{{x0, f0}, {x0, f0} + 0.5 {1, df0}/Norm[{1, df0*ar}]}], {x0, 0.1, 0.9, 0.2}]}]
  ]
 ]

Mathematica graphics

share|improve this answer
    
+1 for addressing the lengths of the arrows. –  Pickett Aug 16 at 14:57
1  
@MichaelE2 late but very instructive...+1...thanks –  ubpdqn Aug 17 at 0:07

EDIT

Forgot for LogPlot.

Firs of all read about tangent line. Then try to uderstand how work function getTangentVectAtValue

func[t_]:=(1-t)^(-0.5);
getTangentVectAtValue[func_,xValue_,vectLen_]:={{xValue,Log@func[xValue]},{xValue+vectLen,Log[(func[xValue]+(D[func[t],t]/.t->xValue)*(x-xValue))]/.x->(xValue+vectLen)}};

Show[
LogPlot[func[t], {t, 0, 1}, PlotRange -> {{0, 1}, {0.66, 20}}, 
  Frame -> {{True, True}, {True, False}}, ImageSize -> 600, 
  PlotStyle -> {Directive[Black, Thick]}, 
  BaseStyle -> {FontSize -> 30}, RotateLabel -> False, 
  AspectRatio -> 1], 
 Graphics[Arrow[getTangentVectAtValue[func, 0.8, 0.15]]]]

enter image description here

share|improve this answer
    
This does not work on the OP's original plot, which is a LogPlot. –  Michael E2 Aug 15 at 15:03
    
The two most important issues are:1. the slope is tending to infinity near the end where I want to show the arrow; 2. this is a LogPlot. Thank the above answerers!~ –  lxy Aug 16 at 3:45

Here is a method using scaling. The tangent is drawn at x = 0.8.

f[t_] := (1 - t)^(-0.5);
Print@LogPlot[f[t], {t, 0, 1},
   PlotRange -> {{0, 1}, {0.66, 20}},
   Frame -> True, PlotLabel -> "Original plot",
   AspectRatio -> 1];
rescale[i_] := Exp[(i - 1) Log[2.]];
Print[Column[{"Rescaling function: Exp[(i-1) Log[2.]]",
    Row[{"E.g. ", Table[{i, rescale[i]}, {i, 0, 4}]}]}]];
normLog[n_] := 1 + Log[n]/Log[2.];
normf[t_] := normLog[f[t]];
Print@Plot[normf[t], {t, 0, 1},
   PlotRange -> {{0, 1}, normLog /@ {0.66, 20}},
   Frame -> True, PlotLabel -> "Rescaled plot",
   AspectRatio -> 1];
ndf = D[normf[t], t];
x = 0.8;
m = ndf /. t -> x;
y = normf[x];
c = y - m x;
x2 = x - 0.18;
y2 = m x2 + c;
x3 = x + 0.18;
y3 = m x3 + c;
newticks = {#, Round@rescale[#]} & /@ Range[6];
Print@Show[Plot[normf[t], {t, 0, 1},
    PlotRange -> {{0, 1}, normLog /@ {0.66, 20}},
    Frame -> True, PlotLabel -> "Plot with tangent",
    AspectRatio -> 1],
   Graphics[Arrow[{{x2, y2}, {x, y}, {x3, y3}}]],
   FrameTicks -> {Automatic, newticks}];

enter image description here

share|improve this answer

For this specific example but adaptable:

fun[t_] := 
 With[{pt = {t, -0.5 Log[1 - t]}, 
   vec = 0.4 Normalize[{1, 0.5/(1 - t)}]},
  Show[LogPlot[(1 - x)^(-0.5), {x, 0, 1}, PlotRange -> {0.9, 10}, 
    AspectRatio -> Automatic, BaseStyle -> 12, 
    PlotLabel -> (1 - x)^(-0.5)], 
   Graphics[{{Red, PointSize[0.04], Point[pt]}, {Thick, 
      Arrowheads[0.1], Arrow[{pt, pt + vec}]}}]]]
Manipulate[fun[u], {u, 0, 0.95}]

enter image description here

share|improve this answer

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.