Mathematica：提取一个情节的坐标，我不知道它的方程

Question

在Mathematica中绘制2D绘图，如果您继续单击图形，则会显示该图形的一系列坐标。我想提取所有这些点的x和y坐标，而不使用“获取坐标”工具（它一次只提取一个坐标，这既不准确又费力）。一个额外的约束是图的方程是未知的（我发现了一个由Wolfram Alpha生成的图，我的方程是未知的。如果我可以简单地提取坐标，我可以通过这些共同拟合样条。纵坐标，从而得到图的方程式。有什么想法吗？

干杯！

Answer 1

这就是在Mathematica 9中可以做到的。

首先获得图表。

chart = WolframAlpha["density vs altitude of heterosphere",
  {{"EntrainedDensityPlot:AtmosphericLayers", 1}, "Content"}]

提取数据部分。 x轴根据刻度规格进行缩放。

data = chart[[1, 1, 1, 1, 1, 1, 3, 2, 1]];
ListLinePlot[data, PlotRange -> All]

这是tick规范的内容： -

ticksposition = Position[chart, Ticks];
ticks = Last@chart[[Sequence @@ Most[First@ticksposition]]];
Take[First@ticks, 5][[All, 1]]

  

{ - 25.328436022934504，-18.420680743952367，-11.512925464970229`，   -4.605170185988091,2.302585092994046}

以上数字与以下刻度标签有关： -

{10^-11, 10^-8, 10^-5, 0.01, 10};

行数据如下所示。可以根据刻度重新调整x值。

data

  

{{7.56584506772668，-5}，{7.522454313212941，-4.5}，{7.4785653196771396，-4}，{7.4342573821331355，-3.5}，{7.38950218524746，-3。}，{7.344266755495627，-2.5}，{ 7.2985804103507865，-2}，{7.25233739856673，-1.5}，{7.205635176410364，-1}，{7.158436173289435，-0.5}，{7.110696122978827,0。}，{7.062448668658617,0.5}，{7.0136456542395695,1。}，{ 6.964230125910116,1.5}，{6.91433359434226,2。}，{6.863751143484082,2.5}，{6.812620083867098,3。}，{6.760878083121377,3.5}，{6.708511342992233,4。}，{6.655491829094075,4.5}，{6.601814187258075,5} {6.547459502017843,5.5}，{6.4924064877997925,6。}，{6.436647039879506,6.5}，{6.380156434630315,7。}，{6.32290629486736,7.5}，{6.264901893476659,8。}，{6.206091938653852,8.5}，{6.1464577290734805,9 }，{6.086001700931971,9.5}，{6.0246816979681785,10。}，{5.962473333757384,10.5}，{5.899349258200177,11。}，{5.821358081393286,11.5}，{5.7428108616236795,12。}，{5.664279054878501,12.5}，{5.585749407744609 ，13}，{5.507199708509977,13.5}，{5.42873140526997,14。}，{5.350245459408396,14.5}，{5.2717680313145,15。}，{5.114815113 005919,16。}，{4.957937505095806,17。}，{4.801148069229532,18。}，{4.6443908991413725,19。}，{4.487624622133048,20。}，{4.326976291408619,21。}，{4.16682025054415,22。}，{4.007442270191581 ，23}，{3.848827581930999,24。}，{3.6909772521960824,25。}，{3.533890923387621,26。}，{3.3775192543075785,27。}，{3.221911213411722,28。}，{3.0670291554360247,29。}，{2.9128939952449864， 30。}，{2.7595034826911258,31。}，{2.606755482950629,32。}，{2.4486747988659405,33。}，{2.2912612192626023,34。}，{2.1357509841344284,35。}，{1.9820905307957144,36。}，{1.680194560884901,38 }，{1.3852187828929574,40}，{1.096877451374393,42}，{0.8148779691310925,44}，{0.5389464994826453,46}，{0.27512860638016096,48}，{0.02654455522211221,50}，{ - 。。。。。。0.21614311166946532,52 }，{ - 。0.44783517527478434,54}，{ - 。0.6842865521277486,56}，{ - 。0.9256594818782552,58}，{ - 。1.1722157727127442,60}，{ - 。1.8127175638195325,65}，{ - 。2.490977037365282,70} ，{ - 。3.220852777752422,75}，{ - 3.992257398138752,80。}，{ - 4.801233732898559,85。}，{ - 4.884341907755072,85.5}，{ - 4.967863202252387,86。}，{ - 5.67928500305 58135,90}，{ - 。6.576295584184468,95}，{ - 。7.486859743501422,100}，{ - 。9.239975177105872,110}，{ - 。10.71451777375279,120}，{ - 。11.71724726204385,130}，{ - 12.472384692245763， 140}，{ - 。13.085067592660632,150}，{ - 。13.606060333782066,160}，{ - 。14.062050687084879,170}，{ - 。14.470591537717763,180}，{ - 。14.842453559942024,190}，{ - 15.185537946620293,200。 }，{ - 。15.50507451487766,210}，{ - 。15.805477093216508,220}，{ - 。16.359148622816097,240}，{ - 。16.864221756309153,260}，{ - 。17.331782147471895,280}，{ - 。17.7704410644037,300} {-18.1863994482277,320。}，{ - 。18.582846794542757,340}，{ - 。18.964546221796557,360}，{ - 。19.333726745661632,380}，{ - 。19.69257556476376,400}，{ - 。20.554367300484596,450}，{ - 21.37431184148772,500}，{ - 。22.157071180737354,550}，{ - 。22.89745771517206,600}，{ - 。23.585866797897218,650}，{ - 。24.206758461335397,700}，{ - 。24.74733834618318,750}，{ - 25.200922702635545， 800}，{ - 。25.573825183196032,850}，{ - 。25.880257267404012,900}，{ - 。26.137443089588984,950}，{ - 。26.360979711632908,1000}}

Answer 2

从here回收答案，此函数会在变量pts中存储鼠标点击次数。您需要在Show函数中组合曲线，并进行适当缩放。在这里，我只是放入一个正弦图。

它使用动态模块，因此当您保存，关闭并重新打开笔记本时，这些点仍然存在。

CreateDistribution[] := 
 DynamicModule[{savepts = {{-1, -1}}}, 
  Dynamic[EventHandler[
    Show[Plot[Sin[x], {x, 0, 7}], 
     ListPlot[pts, AxesOrigin -> {0, 0}, 
      PlotRange -> {{0, 7}, {0, 5}}]], 
    "MouseDown" :> (savepts = 
       pts = DeleteCases[
         Append[pts, MousePosition["Graphics"]], {-1, -1}])], 
   Initialization :> (pts = savepts)]]

CreateDistribution[]

pts

  

{{0.371185,0.357737}，{0.859027,0.7779375}，{1.55898，     1.01471}，{2.36498,0.661709}，{2.95887，     0.161626}，{3.55277，-0.358067}，{4.10424，-0.799316}，{4.91024，-0.985622}，{5.6314，-0.573789}，{6.20409，-0.142345}，{6.71314，     0.367543}}