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[]