如何在Mathematica中获得Wolfram | Alpha 2D图形的十字线行为?

时间:2011-11-22 06:12:44

标签: wolfram-mathematica wolframalpha

当鼠标光标位于Wolfram | Alpha中的2D绘图上时,会出现一对灰色线条,帮助您读取x轴和y轴之间的坐标. For example,我将鼠标放在以下Airy功能图中的一个转折点上。

Web

以上也可以在Mathematica中使用

获得
WolframAlpha["Plot Ai(x)", {{"Plot", 1}, "Content"}]

Nb

具有显示坐标.

的某种定位器的附加优势

如何在普通的Mathematica图形/情节中模拟这种行为?

4 个答案:

答案 0 :(得分:6)

以下是您在评论中提供的功能:

locatorPlot[func_, r : {var_, __}, other___] :=
 LocatorPane[
   Dynamic[pos, (pos = {#, func /. var -> #}) & @@ # &],
   Column[{Plot[func, r, other], Dynamic@pos}],
   AutoAction -> True,
   Appearance ->
     Graphics[{Gray, Line @ {{{-1, 0}, {1, 0}}, {{0, -1}, {0, 1}}}},
       ImageSize -> Full]
 ]

locatorPlot[AiryAi[z], {z, -11, 5}, ImageSize -> 400]

enter image description here


以下是处理新请求的相当笨重的更新:

locatorPlot[func_List, r : {var_, __}, other___] :=
 DynamicModule[{pos, pos2},
  LocatorPane[
   Dynamic[pos, (pos = #; (pos2 = {#, First@Nearest[func /. var -> #, #2]}) & @@ #) &],
   Plot[func, r, other,
     Epilog ->
      {Text[\[GrayCircle], Dynamic@pos2], Text[Dynamic@pos2, Dynamic@pos2, {-1.2, 0}]}
   ],
   AutoAction -> True,
   Appearance -> 
     Graphics[{Gray, Line@{{{-1, 0}, {1, 0}}, {{0, -1}, {0, 1}}}}, ImageSize -> Full]
   ]
  ]

locatorPlot[{AiryAi[z], Sin[z]}, {z, -11, 5}, ImageSize -> 400]

答案 1 :(得分:6)

这是另一种使用Nearest的方法,与Simon的有点不同:

plot = Plot[{Sin[x], Cos[x]}, {x, -2 Pi, 2 Pi}];
With[{nf = Nearest[Flatten[Cases[Normal[plot], Line[p_, ___] :> p, Infinity], 1]]},
   Show[plot, 
      Epilog -> 
         Dynamic[DynamicModule[{
            pt = First[nf[MousePosition[{"Graphics", Graphics}, {0, 0}]]], 
            scaled = Clip[MousePosition[{"GraphicsScaled", Graphics}, {0, 0}], {0, 1}]
            }, 
           {
            {If[scaled === None, {}, 
               {Lighter@Gray, Line[{
                   {Scaled[{scaled[[1]], 1}], Scaled[{scaled[[1]], 0}]}, 
                   {Scaled[{1, scaled[[2]]}], Scaled[{0, scaled[[2]]}]}
                   }]
               }]}, 
            {AbsolutePointSize[7], Point[pt], White, AbsolutePointSize[5], Point[pt]},
            Text[Style[NumberForm[Row[pt, ", "], {5, 2}], 12, Background -> White], Offset[{7, 0}, pt], {-1, 0}]}
         ]]
    ]
 ]

这是我放置的例子。 (我不喜欢自由浮动的下划线与点跟踪相结合;要么自己感觉很好。)

答案 2 :(得分:5)

这是我的版本,其行为类似于Wolfram | Alpha输出,除了它处理多个图。在W | A图形中,圆圈和文本跳转到最近的曲线,当光标未在图形上方时,圆圈和文本完全消失。 添加缺少的功能并使代码更灵活,这将是一件好事。

WAPlot[fns_, range : {var_Symbol, __}] := 
 DynamicModule[{pos, fn = fns},
  If[Head[fn] === List, fn = First[Flatten[fn]]];
  LocatorPane[Dynamic[pos, (pos = {var, fn} /. var -> #[[1]]) &], 
   Plot[fns, range, Method -> {"GridLinesInFront" -> True},
    GridLines->Dynamic[{{#,Gray}}&/@MousePosition[{"Graphics",Graphics},None]]],
   AutoAction -> True, 
   Appearance -> Dynamic[Graphics[{Circle[pos, Scaled[.01]], 
       Text[Framed[Row[pos, ", "], RoundingRadius -> 5, 
         Background -> White], pos, {-1.3, 0}]}]]]]

然后,例如

WAPlot[{{AiryAi[x], -AiryAi[x]}, AiryBi[x]}, {x, -10, 2}]

enter image description here


以下是使用MousePosition代替LocatorPane的新版本,并窃取W先生的代码,使圆圈移动到最近的曲线。 现在,该行为几乎与WolframAlpha输出相同。

WAPlot[fns_, range : {var_Symbol, __}] := 
 DynamicModule[{fnList = Flatten[{fns}]}, Plot[fnList, range,
   GridLines -> 
    Dynamic[{{#, Gray}} & /@ MousePosition[{"Graphics", Graphics}]],
   Method -> {"GridLinesInFront" -> True},
   Epilog -> Dynamic[With[{mp = MousePosition[{"Graphics", Graphics}, None]},
      If[mp === None, {}, 
       With[{pos = {#1, First@Nearest[fnList /. var -> #1, #2]}& @@ mp},
        {Text[Style["\[EmptyCircle]", Medium, Bold], pos], 
         Text[Style[NumberForm[Row[pos, ", "], 2], Medium], pos, 
          {If[First[MousePosition["GraphicsScaled"]] < .5, -1.3, 1.3], 0}, 
          Background -> White]}]]]]
   ]]

输出看起来与之前版本非常相似,所以我不会发布截图。

答案 3 :(得分:2)

来自Jens-Peer Kuska:

Manipulate[myPosition = p;
 Plot[Sin[x], {x, 0, Pi}, 
  Epilog -> {Point[p], Text[p, p + {0.4, 0}]}], {{p, {0, 0}}, 
  Locator}]

来自Mark McClure:

labeledPointPlot[g_Graphics] := 
  Manipulate[
   Column[{Show[{g, Graphics@Point[pt]}], pt}], {pt, 
    Sequence @@ Transpose[PlotRange /. FullOptions[g]], Locator}];

labeledPointPlot[Plot[x^2, {x, -2, 2}]]

我找到了上面代码的来源,我之前写过:

http://www.mathkb.com/Uwe/Forum.aspx/mathematica/10416/Mathematica-6-Graphics-Options