Re: Learning Mathematica with neat projects
- To: mathgroup at smc.vnet.net
- Subject: [mg118440] Re: Learning Mathematica with neat projects
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Thu, 28 Apr 2011 06:35:17 -0400 (EDT)
Sol Lederman wrote: > Hello, Everyone. > > I want to thank each of you who has shown me simple and clever ways to use > Mathematica with my dots and lines projects. As a programmer for over 30 > years I'm humbled at how challenging this stuff can be and very grateful to > those of you who have reached out to help me to start getting my bearings. > [...] > I've developed one notebook so far, at > http://playingwithmathematica.com/notebooks/. (For some reason I can't > explain, you can't just click on the "curve stitch" link on the index page > because it just shows the notebook source in the browser. So, you have to > download the notebook and then open it. This first notebook is a good > illustration of how I aim to guide students in math + Mathematica + neat > projects. (I do plan to clean up the layout and style of the notebook and of > the writing a bit before promoting it.) > [...] I'll comment on the math, though this may be above the level of the students you hope to reach. That "stitch curve" is also called an envelope curve as it is simultaneously tangent to a given set of curves (lines, in this case). You can compute an equation describing the curve by observing that points on it are on only one of the lines whereas points beneath are on a pair of lines. How to distinguish these? Start by writing the slope as a function of the y intercept. I'll focus on the curve in the first quadrant. In[1]:= m[b_] := b/(b - 10) Now given arbitrary {x,y} pair, find the b values for possible lines in your family on which {x,y} lies. These will of course be functions of x and y. In[5]:= bvals = b /. Solve[y - (m[b]*x + b) == 0, b] Out[5]= {(1/2)*(10 - x + y - Sqrt[-40*y + (10 - x + y)^2]), (1/2)*(10 - x + y + Sqrt[-40*y + (10 - x + y)^2])} So here is the Big Hint. We'll get a unique solution when the discriminant is zero (discriminants are magic). So we will isolate the discriminant and solve for when it vanishes. In[16]:= discrim = First[Cases[bvals, Sqrt[aa_] -> aa, Infinity, 1]] Out[16]= -40*y + (10 - x + y)^2 In[27]:= funcs = y - (y /. Solve[discrim == 0, y]) Out[27]= {-10 + 2*Sqrt[10]*Sqrt[x] - x + y, -10 - 2*Sqrt[10]*Sqrt[x] - x + y} Lo and behold, we now have a pair of functions describing y in terms of x. We know to take the one that lies below the line x+y=10. One can check that it is the first one. You can turn it into a polynomial as below (there are more "advanced" ways to do this...) In[35]:= imp = Expand[(x + 10 - y)^2] - (2*Sqrt[10]*Sqrt[x])^2 Out[35]= 100 - 20*x + x^2 - 20*y - 2*x*y + y^2 It is simple to graph as the zero contour of a function of x and y. ContourPlot[imp == 0, {x, 0, 10}, {y, 0, 10}] Daniel Lichtblau Wolfram Research