mechanical sound amplifications using a Limacon
- To: mathgroup at smc.vnet.net
- Subject: [mg48158] mechanical sound amplifications using a Limacon
- From: Roger Bagula <tftn at earthlink.net>
- Date: Fri, 14 May 2004 20:59:18 -0400 (EDT)
- Reply-to: tftn at earthlink.net
- Sender: owner-wri-mathgroup at wolfram.com
The sound box of a guitar is an Oval of Cassini based cylinder.
It is known for it's resonance and sound amplification properties.
Modeling these simple figures as billiards games showed me a unique
feature of the Limacon:
The bulb acts as a focal reflecting point. I've attached a picture that
shows one of the
billiards pictures.
It would appear if you put a microphone inside the bulb
all the sounds in a Limacon cylinder made like a guitar sound box would
be amplified
since the all hit this relatively small area.
I was really trying to get a fractal border as an implicit, but
all the more complex implicits just don't work.
In my investigation of 2d implicits I also found a fuzzy logic implicit:
(1-Abs(x-y))+(1-abs(x+y-1))-1=0
and as simple as that seems the billiards program won't do it either on
my machine.
My proposal is that an electric guitar made in the limacon cylinder shape
with the microphone pick up inside the bulb would be more effective than
current designs. .
(* Ovals of Cassini:guitar sound box*)
a=2.9
c=3
play[(x^2+y^2+a^2)^2-4*a^2*x^2-c^4,NumPts->100]
(* Limacon Billiards: *)
a=2
c=3
play[(x^2+y^2-c*x)^2-a^2*(x^2+y^2),NumPts->100,StartV -> {0,
N[Sqrt[3]/2]}]
--
Respectfully, Roger L. Bagula
tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
URL : http://home.earthlink.net/~tftn
URL : http://victorian.fortunecity.com/carmelita/435/
Billiards Library file:
(* Copyright 1992 David Glaubman. *)
(*:Version: Mathematica 2.0 *)
(*:Title: billiards.m *)
(*:Author:
David Glaubman
*)
(*:Keywords:
billiards, ergodic
*)
(*:Sources: none. *)
(*:Summary: Given a planar region bounded by level curves, draws billiard
trajectory. Modified by Sha Xin Wei to run on NeXt and Mac's too.
*)
BeginPackage["`billiards`", "Graphics`Animation`",
"Graphics`ImplicitPlot`"]
play::usage=
"play[expression, options] animates the motion of a billiard ball\n
on a table whose shape is given by the equation 'expression == 0'.\n
expression should be given in terms of global variables x and y.\n
Examples:\n
play[] -- animates circular table of radius 1, ball starting\n
\tfrom {0,.2} at angle Pi/4, for 25 collisions.\n
play[x^2 + 2y^2 -1, NumPts-> 40] -- elliptical table, longer\n
\tanimation, other values the same.
\n\n
Bugs:\tUser supplied boundary test function not implemented.\n
\tNo sanity checking or error handling.\n
\tShould highlight foci and boundary regions of interest.\n"
Options[play] =
{ StartPt -> {0,.2},
StartV -> {N[Sqrt[2]/2], N[Sqrt[2]/2]},
NumPts -> 25,
BdryTest -> bordertest,
Title -> "Billiards"
}
StartPt::usage="Billiard ball starts here. (Default: {0,.2})"
StartV::usage="Initial direction of motion. (Default: {Sqrt[2]/2,Sqrt[2]/2})"
NumPts::usage="How many bounces to compute. (Default: 25)"
Title::usage="Title of animation. (Default: Billiards)"
BdryTest::usage="Not yet implemented. Test to determine hitting of wall."
Begin["`Private`"]
Clear[x,y]
normed[a_,b_] := {a,b}/Sqrt[a^2 + b^2]; (* returns unit vector *)
size[{a_,b_}] := a^2 + b^2; (* square of length *)
play[ function_:Automatic, opts___ ] :=
Module[ {expr = function,
start,
n,j,
v, numPts, title,
next, oneframe, border,
w, pt,oldv, curve,i},
If[function === Automatic,
expr = Global`x^2 + Global`y^2 -1];
start = StartPt /. {opts} /. Options[play];
v = StartV /. {opts} /. Options[play];
numPts = NumPts /. {opts} /. Options[play];
inside = BdryTest /. {opts} /. Options[play];
title = Title /. {opts} /. Options[play];
(* Binary search: returns interior point within sqrt(epsilon)
of bounding curve *)
bsearch[start_, v_List] := Module[
{hi, lo, delta = .1, epsilon = .00000001},
lo = hi = start;
While[ inside[expr,hi], hi += delta v ];
While[ size[hi - lo] > epsilon,
mid = (hi + lo)/2;
If[ inside[expr, mid], lo = mid, hi = mid ] ];
Return[lo]
];
(* Plots border curve for superposition with billiard path *)
border[conic_] :=
ImplicitPlot[conic == 0,
{Global`x, 0, 4},
AspectRatio -> Automatic,
PlotStyle -> RGBColor[0,0,1],
PlotRange -> {{0,4}, {0,4}},
AxesOrigin -> {0,0},
DisplayFunction -> Identity];
(* returns $\partial f/\partial y, -\partial f/\partial x$ *)
der[expr_] := normed[D[expr,Global`y], - D[expr,Global`x]];
(* tests if f(pt) is negative (i.e., within bounding curve)*)
bordertest[expr_, {a_,b_}] :=
(expr /. {Global`x->a, Global`y->b}) < 0;
(* next[i] is the i'th point of the billiard path. *)
Clear[next];
next[1] = start;
next[i_] := next[i] = Module[{},
pt = bsearch[next[i - 1], v];
w = der[expr] /. {Global`x -> pt[[1]], Global`y -> pt[[2]]};
v = Apply[normed,2 (v . w) w - v];
Return[pt]
];
curve = border[expr]; (* Create bounding curve *)
(* returns Graphics object depicting first n-1 bounces *)
oneframe[n_] := Graphics[Line[Table[next[i], {i, 1, n}]]];
(* Creates numPts frames of path and bounding curve *)
all = Table[{oneframe[j], curve}, {j,1,numPts}];
(* rigamarole to change animation window name *)
saveDisplayTitle = $DisplayTitle;
$DisplayTitle = title;
(* Display the animation *)
(* If on NeXT or Mac, show in Front End window *)
If[
Length[StringPosition[$MachineType, {"NeXT", "Mac"}]]>0,
Show[#, DisplayFunction->$DisplayFunction]& /@ all,
ShowAnimation[all, DisplayFunction -> $DisplayFunction,
PlotRange -> {{0,4},{0,4}}];
];
(* restore the default window name *)
$DisplayTitle = saveDisplayTitle;
]
End[]
EndPackage[]