Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.soft-sys.math.mathematica > #1952 > unrolled thread

Re: Learning Mathematica with neat projects

Back to article view | Back to comp.soft-sys.math.mathematica

Contents

  Re: Learning Mathematica with neat projects Daniel Lichtblau <danl@wolfram.com> - 2011-04-28 10:35 +0000

#1952 — Re: Learning Mathematica with neat projects

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

[toc] | [standalone]

Back to top | Article view | comp.soft-sys.math.mathematica

csiph-web