Paint Problem

A 4 inch chord is constrained to keep its ends on the perimeter of a 12 inch square. Find the area swept out by the chord as it traverses the square. (Think of the chord as a stick as coated with fresh paint. The problem becomes one of finding the painted area.)

Solution

Analysis: To be specific, take the square to be the one with coodinates [0,0], [12,0],[12,12], and [0,12]. We can draw it thus.

> restart;

> sqr := plot([[0,0],[12,0],[12,12],[0,12],[0,0]],color=red,thickness=3,scaling =constrained):

> sqr;

When one end of the chord is at [0,t], 0 <= t <= 4, Pythagoras says the other is at

We can draw any one of these with the ch function defined below.

> ch := t->
plot([[t,0],[0,sqrt(16-t^2) ]],color=blue,thickness=3);

Draw 10 of these and save them in chds[1], then display them on the square.

> chds[1] := [seq(ch(4*i/9),i=0..9)]:

> plots[display]([sqr,op(chds[1])],scaling=constrained);

To get chords in the other 3 corners, rotate. Then display them all in the square.

> for i from 2 to 4 do

> chds[i] :=map( plottools[rotate],chds[i-1],Pi/2, [6,6] ): od:

> drawing2 :=plots[display]([sqr,seq(op(chds[i]),i=1..4)],scaling=constrained):

> drawing2;

By inspection, I would guess that the chords form an arc of a circle, perhaps not the same circle.

We can get the (possible) center of the one in the lower left hand corner by intersecting the lines perpendicular to the extreme chords. We come up with the center of [4,4] and radius of 4.

We need to check that. So just draw the circle of radius 4 centered at [4,4] on the square.

> circ := plot([4+4*cos(theta),4+4*sin(theta),theta=0..2*Pi],thickness=3,color=tan):

> plots[display]([circ,drawing2]);

Clearly, my intuition was wrong on this. What we need to do is remember some of our differential equations.

Let be point on the envelope of the chords in the lower left corner. We know the chord through is tangent to the envelope, so since the chord is 4 inches long we get an initial value problem

> diffeqn:= (diff(f(x),x)^2+1)*(f(x)-x*diff(f(x),x))^2 - (4*diff(f(x),x))^2;
init := f(4)=0;

Play as we might with this, it does not submit to dsolve. So we will try the approach suggested by R. Brown,

who notes that the envelope curve f(x) is defined by f(x) = max { h | [x,h] lies under a chord}. for t > x let

[x,g(x,t)] be the point on the chord . Setting up a ratio and solving for g(x,t),

we get g(x,t) = (t-x)/t*sqrt(16-t^2). f(x) is the maximum of g(x,t) for x <= t <= 4.

> g :=(x,t)-> (t-x)/t*sqrt(16-t^2);

Look at the graph of g

> plot3d(g(x,t),x=0..4,t=x..4,axes=boxed,orientation=[19,73]);

Clearly for fixed x, g(x,t) takes on a maximum between x and 4.

To find that place take the partial wrt t and solve for t.

> gt := diff(g(x,t)^2,t);

> sol:=solve(gt,t);

The only real candidate is sol[2].

> p := unapply(sol[2],x);

So our envelope function f is defined like so:

> f := unapply(g(x,p(x)),x);

Lets see if f looks like the envelope.

> pltf := plot(f,0..4,scaling=constrained,color=magenta,thickness=3):

> plots[display]([pltf,op(chds[1]),sqr]);

Great fit!

Let's check to see that f satisfies diffeqn

> chk:=unapply(simplify(diffeqn),x);

Yes! So this is a good example of a messy differential equation which arises out of a problem where

none of the standard methods work, yet if one looks at the problem another way and gets an answer, one

gets free of charge a solution to the messy differential equation.

The area asked for in the problem is around 18.85

> area := 4*evalf(int(f(x),x=0..4));

On closer inspection of the envelope function, we can see that it simplifies greatly, although when you ask Maple to simplify it, nothing happens, because it is not used to looking for common factors with fractional exponents to factor out.

>

First note that the x^(1/3) on the bottom cancels in the first factor of the top and second that if a 2^(1/3) is pulled out of the square root and combined with the 2^(2/3) on top then the 2 on the bottom cancels it, leaving us with

> fs := x-> (2^(4/3)-x^(2/3))^(3/2);

Problem here: Try to get Maple to perform this simplification. Good luck!

> simplify(f(x)-fs(x),symbolic,assume=positive,assume=real);

Even though we would stake our life on the fact that these expressions are equivalent (when x is between 0 and 4), let's check visually by plotting.

> plot({f,fs},0..4,color=[green,red]);

there seems to be some difference near 0. Is it a real difference? Check the difference near 0 with various precisions.

> evalf(f(1/10000000)-fs(1/10000000),70);

I conclude the difference is pure floating point arithemtic error.

Spin off problem

As the stick gets longer the area swept out gets bigger. Get the area swept out as a function of the length a of the stick. Find the maximum area swept out. Find the stick a which sweeps out 144/2 = 72 square inches.

Analysis: Our approach is to go back through the previous solution, substituting a in for 4 and making needed adjustments in reasoning. First restart and draw the square again.

> restart;

> sqr := plot([[0,0],[12,0],[12,12],[0,12],[0,0]],color=red,thickness=3,scaling =constrained):

> sqr;

When one end of the chord is at [0,t], 0 <= t <= a, Pythagoras says the other is at

We can draw any one of these with the ch function defined below. Note ch is now a function of a and t.

> ch := (a,t)->
plot([[t,0],[0,sqrt(a^2-t^2) ]],color=blue,thickness=3);

Draw 10 of these and save them in chds[1], then display them on the square.

>

> llhc := a->[seq(ch(a,a*i/9),i=0..9)]:

> plots[display](llhc(4));

Here is a little procedure to draw the square with chords a in all corners.

> sweepitout := proc(a)
local i,chds;
chds[1] := plots[display]([sqr,op(llhc(a))],scaling=constrained):

To get chords in the other 3 corners, rotate. Then display them all in the square.

> for i from 2 to 4 do

> chds[i] :=plottools[rotate](chds[i-1],Pi/2, [6,6] ): od:

> plots[display]([sqr,seq(chds[i],i=1..4)],scaling=constrained);

> end:

Here is an animation of the area swept out as a runs from 0 to 12.

> plots[display]([seq(sweepitout(i/2),i=0..24)],insequence=true,scaling=constrained);

Lets set up the initial value problem here:

Let be point on the envelope of the chords in the lower left corner. We know the chord through is tangent to the envelope, so since the chord is a inches long we get an initial value problem

> diffeqn:= (diff(f(a,x),x)^2+1)*(f(a,x)-x*diff(f(a,x),x))^2 - (a*diff(f(a,x),x))^2;
init := f(a,x)=0;

> dsolve({diffeqn,init},f(a,x));

Error, (in sdsolve/info) found extra arguments [f(a,x)]

>

We won't bother to try hard to solve this with dsolve. Rather, we will go to the Brown approach

noting that the envelope curve f(a,x) is defined by f(a,x) = max { h | [x,h] lies under a chord}. for t > x let

[x,g(a,x,t)] be the point on the chord . Setting up a ratio and solving for g(x,t),

we get . f(x) is the maximum of g(a,x,t) for x <= t <= a.

> g :=(a,x,t)-> (t-x)/t*sqrt(a^2-t^2);

Look at the graph of g for various values of a

> plots[display]([seq(plot3d(g(4+i/5,x,t),x=0..(4+i/5),t=x..(4+i/5),axes=boxed,orientation=[19,73]),i=0..20)],insequence=true,scaling=constrained);

> grh := a-> plot3d(g(a,x,t),x=0..a,t=x..a,axes=boxed,orientation=[19,73]);

> grh(12);

Clearly for fixed a and x, g(a,x,t) takes on a maximum between x and a.

>

>

To find that place take the partial wrt t and solve for t.

> gt := diff(g(a,x,t)^2,t);

> sol:=solve(gt,t);

The only real candidate is sol[2].

> p := unapply(sol[2],x);

So our envelope function f is defined like so:

> fg := unapply(g(a,x,p(x)),a,x);

As in the case a = 4, this can be seen to simplify (although Maple can't do it) to

> fgs :=unapply( ((a^2)^(1/3)-x^(2/3))*sqrt(a^(2/3)-x^(2/3)),a,x);

> plot({fs(x),fgs(4,x)},x=0..4);

pltf graphs the envelope curve f(a,x). exactpic graphs the total envelope.

> pltf := a -> plot(fgs(a,x),x=0..a,scaling=constrained,color=magenta,thickness=3);

> exactpic := a->plots[display]([seq(plottools[rotate](pltf(a),i*Pi/2,[6,6]),i=0..3),sqr],view=[0..12,0..12]);

Here is the extreme case (stick 12 inches long).

> exactpic(12);

The area swept out is just , from a = 0 to 6. After that we have to subtract the overlap which is , where f(a,b) = 6.

> sol:=solve(6=fgs(a,x),x);

The root we want is the positive square root (it comes up in different positions: this time 2nd.

> b:= unapply(sol[2],a);

To get the maximum area, take the stick to be 12 inches long

> area1 := int(fgs(12,x),x=0..12);

> area2 :=int(2*fgs(12,x)-12,x=0..b(12));

>

> evalf(4*(area1-area2));

Now lets check that f(a,x) satisfies diffeqn

> chk:=unapply((simplify(subs(f(a,x)=fgs(a,x),diffeqn))),a,x);

Check that chk(a,x) simplifies to 0

> simplify(chk(a,x),assume=real);

Nope. What about various values of a?

> seq(simplify(chk(a,x)),a=0..12);

Yes! So it would appear that f(a,x) is the solution to the initial value problem:

> diffeqn,init;

> sweepitout2 := proc(a)
local i,chds;
chds[1] := plots[display]([exactpic(a),sqr,op(llhc(a))],scaling=constrained):

To get chords in the other 3 corners, rotate. Then display them all in the square.

> for i from 2 to 4 do

> chds[i] :=plottools[rotate](chds[i-1],Pi/2, [6,6] ): od:

> plots[display]([sqr,seq(chds[i],i=1..4)],scaling=constrained);

> end:

Here is an animation of the area swept out as a runs from 0 to 12.

> plots[display]([seq(sweepitout2(i/2),i=0..24),
seq(sweepitout2(12-i/2),i=0..24)],insequence=true,scaling=constrained);

Here is an implementation of the area function

> area := proc(a)
local bill,sam;
if a = 0 then RETURN(0) fi;
bill := evalf(int(fgs(a,x),x=0..a));
if a < 6 then 4*bill else
sam := evalf(int(fgs(a,x)-(12-fgs(a,x)),x=0..b(a)));
Re(4*(bill-sam)) fi;end:

> area(.1);

> (area(9));

Small problem here! In the range near 9, the area has a small imaginary part (complex floating point error). I fixed it by returning the real part only.

>

> plot([seq([i,area(i)],i=0..12)]);

>

The length of the stick needed to sweep out exactly 1/2 the square:

> fsolve(area(a)=144/2,a,8..8.1);

Error, (in area) cannot evaluate boolean: a < 6

Well, we would have to tune the area function in order to get fsolve to work. By just doing hand bisection method we can get it

pretty close.

> area(8.01795);

Close to 8.01795