mathematica 是否能够做一些平面几何绘图 [英] is mathematica able to do some planar geometry plotting

问题描述

我正在尝试使用计算机来显示一些平面几何图形.我不知道什么软件可以做到这一点，或者 mathematica 是否可以轻松生成这样的图.

I am trying to use computer to show some planar geometry plots. I donot know what software can do this, or whether mathematica can produce such plots easily.

例如，我要显示以下图.给定任何三角形 ABC，令 AD 为平分角 BAC 并与 BC 在 D 处相交的线.令 M 为 AD 的中点.令直径为AB的圆与CM相交于F.

For example, I have the following plot to show. Given any triangle ABC, let AD be the line bisecting angle BAC and intersecting BC at D. Let M be the midpoint of AD. Let the circle whose diameter is AB intersects CM at F.

如何生成这些图并在 mma 中显示点的相关标记?容易做到吗?有人可以举个例子，或者就什么软件最适合这个目的提出一些建议吗?

How to produce these plots and show the relevant labeling of the points in mma? Is it easy to do? Could someone please give an example, or give some recommendation as to what software is best suited for this purposes?

非常感谢.

推荐答案

我想我会展示如何在 Mathematica 中解决这个问题.虽然编码不是最简单的事情，但它确实具有灵活性.另请记住，作者在图形方面相当无能，因此可能有更简单和/或更好的方法来处理它.

I thought I'd show how one might approach this in Mathematica. While not the simplest thing to code, it does have flexibility. Also bear in mind that the author is fairly inept when it comes to graphics, so there might be easier and/or better ways to go about it.

offset[pt_, center_, eps_] := center + (1 + eps)*(pt - center);

pointfunc[{pt_List, center_List, ptname_String}, siz_, 
   eps_] := {PointSize[siz], Point[pt], 
   Inset[ptname, offset[pt, center, eps]]};

Manipulate[Module[
  {plot1, plot2, plot3, siz = .02, ab = bb - aa, bc = cc - bb, 
   ac = cc - aa, cen = (aa + bb)/2., x, y, soln, dd, mm, ff, lens, 
   pts, eps = .15},
  plot1 = ListLinePlot[{aa, bb, cc, aa}];
  plot2 = Graphics[Circle[cen, Norm[ab]/2.]];
  soln = NSolve[{Norm[ac]*({x, y} - aa).ab - 
       Norm[ab]*({x, y} - aa).ac == 
      0, ({x, y} - cc).({-1, 1}*Reverse[bc]) == 0}, {x, y}];
  dd = {x, y} /. soln[[1]];
  mm = (dd + aa)/2;
  soln = NSolve[{({x, y} - cen).({x, y} - cen) - ab.ab/4 == 
      0, ({x, y} - cc).({-1, 1}*Reverse[mm - cc]) == 0}, {x, y}];
  ff = {x, y} /. soln;
  lens = Map[Norm[# - cc] &, ff];
  ff = If[OrderedQ[lens], ff[[1]], ff[[2]]];
  pts = {{aa, cen, "A"}, {bb, cen, "B"}, {cc, cen, "C"}, {dd, cen, 
     "D"}, {ff, cen, "F"}, {mm, cen, "M"}, {cen, ff, "O"}};
  pts = Map[pointfunc[#, siz, eps] &, pts];
  plot3 = Graphics[Join[pts, {Line[{aa, dd}], Line[{cc, mm}]}]];
  Show[plot1, plot2, plot3, PlotRange -> {{-.2, 1.1}, {-.2, 1.2}}, 
   AspectRatio -> Full, Axes -> False]],
 {{aa, {0, 0}}, {0, 0}, {1, 1}, Locator},
 {{bb, {.8, .7}}, {0, 0}, {1, 1}, Locator},
 {{cc, {.1, 1}}, {0, 0}, {1, 1}, Locator}, 
 TrackedSymbols :> None]

这是一个屏幕截图.

丹尼尔·利希布劳Wolfram 研究

Daniel Lichtblau Wolfram Research

这篇关于mathematica 是否能够做一些平面几何绘图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！