Mathematica Projects by High School Students

Jamie Ding, Vivian Feig, Alan Joyce, Victoria Le, and Ernest Lee

Torrey Pines High School

Why We Use Mathematica

Quick visualization of course material

Expansion from in-class concepts to related fields

Cross-curricular interaction

Unified format for collaborative learning and development

Real-World Applications of Mathematica

Two Examples: Weather Conditions and the Doppler Effect

Alan Joyce

Torrey Pines High School

Real-Time Weather Conditions

weatherManipulate[]

Illustrating the Doppler Effect

dopplerManipulate[]

Many Thanks To

Michael Pilat and Peter Overmann (sound generation)

Lou D'Andria (Manipulate controls)

Faisal Mohamed (plot fine-tuning)

Theo Gray (general help)

Abby Brown

weatherManipulate[]:=Manipulate[
 If[! custom, theAirport = airport;, 
  theAirport = letter1 <> letter2 <> letter3 <> letter4];
 
 {data = Quiet[
     Import["http://www.weather.gov/data/current_obs/" <> theAirport <> 
       ".xml"]];,
  elements = 
    First[Cases[data, XMLElement["current_observation", _, _]]][[3]];,
  
  code = First[
    First[Cases[elements, 
      XMLElement["station_id", _, value_] -> value]]],
  
  location = 
   First[First[
     Cases[elements, XMLElement["location", _, value_] -> value]]],
  
  lat = ToExpression[
    First[First[
      Cases[elements, XMLElement["latitude", _, value_] -> value]]]],
  
  lon = ToExpression[
    First[First[
      Cases[elements, XMLElement["longitude", _, value_] -> value]]]],
  
  obsTime = 
   First[First[
     Cases[elements, 
      XMLElement["observation_time_rfc822", _, value_] -> value]]],
  
  weather = 
   First[First[
     Cases[elements, XMLElement["weather", _, value_] -> value]]],
  
  tempF = 
   ToExpression[
    First[First[
      Cases[elements, XMLElement["temp_f", _, value_] -> value]]]],
  
  humidity = 
   First[First[
     Cases[elements, 
      XMLElement["relative_humidity", _, value_] -> value]]],
  
  windDirection = 
   First[First[
     Cases[elements, XMLElement["wind_dir", _, value_] -> value]]],
  
  windMPH = 
   First[First[
     Cases[elements, XMLElement["wind_mph", _, value_] -> value]]],
  
  pressure = 
   First[First[
     Cases[elements, XMLElement["pressure_in", _, value_] -> value]]],
  
  visibility = 
   First[First[
     Cases[elements, XMLElement["visibility_mi", _, value_] -> value]]],
  
  iconBase = 
   First[First[
     Cases[elements, XMLElement["icon_url_base", _, value_] -> value]]],
  
  iconName = 
   First[First[
     Cases[elements, XMLElement["icon_url_name", _, value_] -> value]]],
  
  iconURL = iconBase <> iconName
  };
 
 Pane[
  Grid[If[theAirport == code, {
     {"last update:", obsTime},
     {"location:", location},
     {Show[{Graphics[{FontSize -> 20, 
          Text[ToString[tempF] <> "º", {30, tempF/2}]}], 
        ParametricPlot[{5, t}, {t, -45, tempF}, 
         PlotStyle -> {Red, Thickness[0.2]}]}, 
       PlotRange -> {{0, 50}, {-50, 150}}, Axes -> {False, True}, 
       Ticks -> {None, Automatic}], 
      Graphics[{{Gray, 
         CountryData[#, {"SchematicPolygon", {"LambertAzimuthal", {lat, 
               lon}}}] & /@ CountryData[]}, {Blue, PointSize[Large], 
         Point[{0, 0}]}}]},
     {"", "wind " <> windDirection <> " at " <> windMPH <> " MPH"},
     {Import[iconURL], 
      Grid[{{ToLowerCase[weather], 
         humidity <> "% humidity"}, {pressure <> " in. pressure", 
         visibility <> " mi. visibility"}}, Alignment -> {Left, Center}, 
       Spacings -> {1, 1}]}
     }, {{"Invalid airport code."}}], Spacings -> {1, 0.5}, 
   Alignment -> {Left, Center}], Alignment -> {Left, Center}],
 {{airport, "KSAN"}, 
  Sort[{"KSAN" -> "KSAN: San Diego", "KLAX" -> "KLAX: Los Angeles", 
    "KSFO" -> "KSFO: San Francisco", "KJFK" -> "KJFK: New York", 
    "KLGA" -> "KLGA: New York", "KORD" -> "KORD: Chicago", 
    "KSEA" -> "KSEA: Seattle", "KCMI" -> "KCMI: Champaign/Urbana", 
    "KATL" -> "KATL: Atlanta", "KBOS" -> "KBOS: Boston", 
    "KMCO" -> "KMCO: Orlando", "KAUS" -> "KAUS: Austin"}]},
 "",
 {{custom, False, "custom airport"}, {True, False}}, {{letter1, "K"}, 
  None}, {{letter2, "M"}, None}, {{letter3, "D"}, None}, {{letter4, "W"}, 
  None},
 Row[{
   "custom code",
   PopupMenu[Dynamic[letter1], CharacterRange["A", "Z"], 
    Enabled -> custom],
   PopupMenu[Dynamic[letter2], CharacterRange["A", "Z"], 
    Enabled -> custom],
   PopupMenu[Dynamic[letter3], CharacterRange["A", "Z"], 
    Enabled -> custom],
   PopupMenu[Dynamic[letter4], CharacterRange["A", "Z"], 
    Enabled -> custom]
   }, Spacer[5]],
 FrameLabel -> 
  "Weather data courtesy of the U.S. National Oceanic and Atmospheric \
Administration."]



dopplerManipulate[]:=(getMaxTime[v0_] := 
 time /. Solve[(1/2) a time^2 + v0 time + x0 == 100, time][[1]];

x0 = -100;
temp = 25;
v = 332 (1 + temp/273)^(1/2);
a = 0;

Manipulate[
 x = (1/2) a t^2 + v0 t + x0;
 vs = a t + v0;
 factor = If[x < 0, -1, 1];
 freq = (v/(v + factor vr)) f;
 
 If[Abs[x] < 0.5, x = 0.5];
 
 theta = ArcTan[Abs[x]/y]/Degree;
 vr = vs/Sin[theta*Degree];
 
 If[t > maxTime, t = maxTime];
 
 Column[{
   EmitSound[
    Sound[SampledSoundFunction[Sin[2 Pi freq #/4000] &, 200, 4000], 
     SoundVolume -> 1/Max[Abs[x]/25, 1]]],
   Grid[{
     {
      "freq emitted = " <> ToString[SetAccuracy[f, 1]],
      "freq heard = " <> ToString[SetAccuracy[freq, 1]]
      },
     {
      "x = " <> ToString[SetAccuracy[x, 2]], 
      "v = " <> ToString[SetAccuracy[vs, 2]]
      },
     {
      "theta = " <> ToString[SetAccuracy[theta, 2]],
      "vr = " <> ToString[SetAccuracy[vr, 2]]
      }
     }, Alignment -> Center, Spacings -> 2],
   
   Graphics[{
     EdgeForm[Thick], Green,
     Disk[{0, -y}, 6],
     Black,
     Line[{{-110, 8}, {110, 8}}],
     Line[{{-110, -8}, {110, -8}}],
     Red,
     Line[{{x, 0}, {0, 0}, {0, -y}, {x, 0}}],
     Text[ToString[SetAccuracy[y, 2]] <> " m", {12, -y/2}],
     Black, Dashed, Thickness[Default],
     Line[{{-110, 0}, {110, 0}}],
     Thick,
     Blue,
     Polygon[{{x - 10, -5}, {x + 1, -5}, {x + 10, 0}, {x + 10, 0}, {x + 1, 
        5}, {x - 10, 5}}],
     Table[
      Circle[{theX, 0}, (x - theX)*2],
      {theX, -100, x, 5000/f}
      ]
     }, PlotRange -> {{-110, 110}, {-50, 30}}, 
    ImageSize -> {400, 175}
    ],
   
   Show[
    Plot[(v/(v + 
          If[((1/2) a theTime^2 + v0 theTime + x0) < 0, -1, 
            1] ((a theTime + v0)/
             Sin[(ArcTan[Abs[(1/2) a theTime^2 + v0 theTime + x0]/y]/Degree)*
               Degree])))*1000, {theTime, 0.001, getMaxTime[v0]},
     PlotRange -> {{0.001, getMaxTime[v0]}, {550, 1500}}, 
     ImageSize -> {400, 175}, Axes -> False, 
     RegionFunction -> Function[Abs[(1/2) a #1^2 + v0 #1 + x0] > 1]
     ],
    Graphics[{Blue, Thick, Line[{{t, 550}, {t, 1500}}]}]
    ]
   },
  Alignment -> Center],
 {{y, 30, "observer loc"}, 15, 40},
 {{f, 500, "source freq"}, 200, 1250},
 {{v0, 7.5, "initial velocity"}, 1, 15},
 {{t, 0.001, "time"}, 0.001, getMaxTime[v0], 0.04}
 ])