Wolfram Cloud Document

This essay was written as part of the Wolfram Emerging Leaders Program : Undergraduate, which is a year long, project - based program designed for gifted undergraduate students to take a deep dive into a topic of their choice . Students work remotely to take their project from ideation to completion, with the guidance of Wolfram experts . Wolfram Emerging Leaders Program participants are selected from the Wolfram High School Summer Research Program or the Wolfram Summer School, which is open to talented, STEM - oriented students.

Abstract: Exploring the relationship between the shape of the voice box and mouth to the sound produced by the voice through computation and visualization

Introduction

Basis

With a basic understanding of physics and a background in singing, I've understood the theory behind why changes in mouth shape affect the sound quality, or timbre, of anything produced by the vocal cords. However, I wanted to explore the direct relationship between the physics of bouncing sound waves and changes in sound tone. In this project, I created a basic model that visually demonstrates how changes in the geometry of the mouth can affect the path of sound waves.

Path

I started this process by creating functions that simulate a particle (representing a wave) bouncing around a space defined by bounds. I started in 2 dimensions with simple bounds, and expanded to bounds defined by a piecewise function, then to 3 dimensions. From there, I created a basic model of the anatomy from the vocal cords through the mouth. I then combined these two, creating a model of a wave bouncing around the throat and mouth.

Computational Bouncing - Simple 2-Dimensional Space

The easiest place to start was with a particle bouncing around a two dimension space with bounds defined by a single equation. In this case, I will use the equation for a circle with radius 2.

In[]:=

circle = x^2+y^2==4;domain = (*x range*){-2,2};

To simulate the physics of bouncing, I created 4 functions:

intersectionQ

◼

takes the current equation of the particle, the equation of the bounds, the current location of the particle, and the direction (left or right) it is traveling

◼

determines boolean value for if the particle will intersect the bounds on its current path

In[]:=

intersectionQ[eq_(*{m,b} for y=mx+b*),const_,ptx_,pos_]:=domainMargin=(domain[[2]]-domain[[1]])10000; (*domainMargin allows for individual domains to be exact without errors involving the edge of domains*)If[pos,currentDomain={ptx[[1]],domain[[2]]}, currentDomain={domain[[1]],ptx[[1]]}];(*define the current domain*)Quiet[SolveValues[ (*determines whether solving for an intersection produces any result*)eq[[1]]*x+eq[[2]]==y&&const&&currentDomain[[1]]<x<currentDomain[[2]],{x,y}]]!={}[[1]]

intersection

◼

takes same input as intersectionQ

◼

returns the intersection of the particle and the bounds that is closest to the particle's original location

In[]:=

intersection[eq_,const_,ptx_,pos_]:={If[pos,currentDomain={ptx[[1]],domain[[2]]},currentDomain={domain[[1]],ptx[[1]]}]; (*define current domain*)If[pos, (*determines whether the closest intersection is least or greatest*)First[Quiet[SolveValues[eq[[1]]*x+eq[[2]]==y&&const&&currentDomain[[1]]<x<currentDomain[[2]],{x,y}]]],Last[Quiet[SolveValues[eq[[1]]*x+eq[[2]]==y&&const&&currentDomain[[1]]<x<currentDomain[[2]],{x,y}]]]]}[[1]]

reflection

◼

takes same input as intersectionQ and intersection

◼

calls intersection, and uses geometry to find the new equation for the particle once it bouncing off the bounds

In[]:=

reflection[eq_,constant_,ptx_,pos_]:={{xcoor,ycoor}=intersection[eq,constant,ptx,pos]; (*find intersection coordinates*)lim=Limit[ImplicitD[constant,y,x],{x->xcoor,y->ycoor}]; (*get derivative of bounds at intersection*)angle1=Mod[ArcTan[ (*find angle of line tangent to bounds*)lim],2Pi];angle2=Mod[ArcTan[ (*find angle of particle's current path*)eq[[1]]],2Pi];angle3=Mod[ (*calculate angle of new path*)2*angle1-angle2,2Pi];{Tan[angle3],(eq[[1]]*xcoor+eq[[2]])-Tan[angle3]*xcoor}, (*return new equation*)If[Pi/2<angle3<3Pi/2,!pos,pos] (*return direction (left/right) of particles next motion*)}

bounce

◼

takes same input as previous functions, plus an integer for what round of recursive calling it is on.

◼

puts together all the functions, calling itself whenever there is an intersection, and once there is not (or the round number exceeds the maximum), it stops

In[]:=

bounce[eq_,const_,ptx_,pos_,round_]:=DeleteCases[Flatten[{If[round>0,ptx[[1]]], (*gives previous coordinates again, this is helpful in later steps*)If[intersectionQ[eq,const,ptx,pos]&&round<10, (*should it call itself again?*)(*keep going*){{{eq,ptx[[1]]},bounce[Flatten[{reflection[eq,const,ptx,pos][[1]]}], (*call bounce on this new information*)const,intersection[eq,const,ptx,pos],reflection[eq,const,ptx,pos][[2]],round+1]}},(*stop*)If[pos,{eq,ptx[[1]],domain[[2]]},{eq,ptx[[1]],domain[[1]]}]]}],Null]

Graphics

Bounce returns a list of points defining the places the particle hits in the form of their equations and the x values of each end point. I created two functions, toLine and toLines, that convert this into a format that can be used by Line to create graphics objects that display the particle's path.

In[]:=

toLine[eq_,x1_]:={x1,eq[[1]]*x1+eq[[2]]}toLines[list_]:={toLine[{#[[1]],#[[2]]},#[[3]]],toLine[{#[[1]],#[[2]]},#[[4]]]}&/@list

Now, this can all be put together to illustrate bouncing within the circle:

In[]:=

Graphics[{Line[toLines[Partition[bounce[{.8,1},circle,{.9,1.2},False,0],4]]],Circle[{0,0},2]},Axes->True]

Out[]=

Computational Bouncing - Piecewise 2-Dimensional Space

In order to expand the scope of these functions, I wanted to be able to define the bounds in terms of different equations, each with their own domains and ranges. I decided to represent each piecewise function in the form of:
{ { equation 1, { x min, x max}, {y min, y max} }, {equation 2, { x min, x max}....} ... }

Helper Functions For Piecewise Functions

In order to use this format of function for my bounce functions, I needed some helper functions. Those are:

functionPiece

◼

takes a piecewise function and coordinates

◼

returns the first equation that applies to those coordinates

In[]:=

functionPiece[list_,coordinates_]:=First[DeleteCases[If[#[[2]][[1]]<coordinates[[1]]<#[[2]][[2]] (*for each equation, is it in the domain?*)&& #[[3]][[1]]<coordinates[[2]]<#[[3]][[2]],#[[1]],]&/@list,Null],1==2] (*if none, returns an equation that is always false*)

isIntersectionHelper

◼

takes piecewise function

◼

returns boolean phrase that helps intersectionQ and intersection determine an intersection with any of the piecewise function's equations

In[]:=

isIntersectionHelper[list_]:={curr = False;(curr = Or[curr,(#[[1]] && #[[2]][[1]]<x<#[[2]][[2]]&& #[[3]][[1]]<y<#[[3]][[2]])])&/@list;curr}[[1]]

Adjustments

With this new format for bounds and these helper functions, our 3 functions that help bounce must be slightly adjusted.

Result

Now, we can make a piecewise-defined function:

In order to visualize any function of the above format in a Graphics object, I created functionToLines, which splits each individual equation into 1000 pieces to approximate any curve, having a straight Line object for each of those pieces.

Now, we can use Graphics to display the bounds and the bouncing.

Computational Bouncing - 3-Dimensional Space

Converting to 3 Dimensions

Changing my functions from 2D to 3D involved 2 main steps. The first was relatively simple: changing all elements that used coordinates to use a set of 3 instead of 2. The second was much more complicated: changing the format of the equation of the particle's movement.

Linear Equations in 3 Dimensions

My other 3 main functions had to be likewise adjusted, as well as the piecewise functions:

Graphics

The last thing to be adjusted to account for 3 dimensions is the function to turn all the equations into graphics. Similarly to in 2 dimensions, I split up the domains into smaller regions that are approximations based on edge points. Specifically, I split each equation into a 20 x 20 array of quadrilaterals.

Now, we can model the bouncing and the bounds of a 3D example:

Modeling Anatomy

The second part of this project was creating a model of the voice box through the mouth within which to demonstrating the bouncing functions. Using WL's built in anatomy data, we get:

Using trial and error, I created this piecewise function to approximate it, with a variable to adjust the vertical angle of the tongue:

Note: my function for turning functions into graphics does not work very well at displaying almost-vertical parts of functions; the empty spaces where a function goes almost vertical are only in the graphics, they are not empty in the function itself.

By overlaying this over the anatomy data, we can see that it is accurate enough to represent the idea.

Bouncing Within Anatomical Model

Now that we have 3D bounce functions and a piecewise function, we can demonstrate the results with different tongue angles.

Conclusion

An Area to Improve

As I approached the end of this project, it became clear how much time and space many of my functions are taking. With more time, I'd like to find more ways to make my functions more efficient, including eliminating the need to run one function multiple times with the same input.

Areas to Go Further

While this project was inspired by the desire to learn more about vocal anatomy, most of the time ended up being spent on simulating the physics of a bouncing particle. As such, there is much more room to move forward into vocal anatomy, with the physics as a foundation. Some such further steps are:

Creating a more exact model of the voice box through the mouth

Creating a model with more than a few waves to show more patterns

Accounting for sound waves as actual waves instead of particles

Modeling how bouncing on different tissues will affect the waves' frequency

CITE THIS NOTEBOOK

Exploring the Physics of Sound Waves in the Voice Box
by Eli Morton
Wolfram Community, STAFF PICKS, August 30, 2023
https://community.wolfram.com/groups/-/m/t/3002118