[Date Index] [Thread Index] [Author Index]

Volcanic Ash Cloud over Europe in 14 lines of Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg109253] Volcanic Ash Cloud over Europe in 14 lines of Mathematica
• From: Luc Barthelet <luc at tirnua.com>
• Date: Mon, 19 Apr 2010 02:50:13 -0400 (EDT)
• References: <hq0mnl$ju9$1@smc.vnet.net> <hq4142$3bi$1@smc.vnet.net> <hqc119$fuv$1@smc.vnet.net> <201004180959.FAA22725@smc.vnet.net>

My dear friend Sarah is in Europe and needs to fly back in the US this 
week end. I wanted to follow up on the ash cloud evolution.
Here is the code that reads the reports from the London Volcanic Ash 
Advisory Center, and displays it in Mathematica, which I think is pretty 
cool.

Hopefully some of you will feel the need to improve on these few lines. 
Make sure you copy me on the improvements. Maybe this would be worth a 
wolfram blog post?
I searched for Volcanic Ash Cloud in Wolfram Alpha, but did not get any 
answer.
( This is in version 7)
Enjoy,
Luc

VAAMessageLinks=Import /@ 
Select[Import["http://www.ssd.noaa.gov/VAAC/OTH/UK/messages.html","Hyperlinks";], 
StringCases[#,".txt"]!={}&];
FormatDate[str_]:=DateString[ToExpression [StringTake[str,#]]&/@ 
{{1,4},{5,6},{7,8},{10,11},{12,13}}];
extractLatLong[str_]:=Reverse /@ 
Select[(StringCases[#,{"N"~~u__:>ToExpression[u]/100.,"S"~~u__:>-ToExpression[u]/100.,"W"~~u__:>-ToExpression[u]/100.,"E"~~u__:>ToExpression[u]/100.}][[1]]& 
/@StringSplit[#," "])& /@ StringSplit[str,{"-","\n"}],Length[#]>0&];
renderVAAMessage[msg_]:=Module[{Observation,polys,color,Title,date},
date = StringCases[msg,"\nDTG: "~~Shortest[x__]~~"\n":>x][[1]];
Title="Volcanic Ash Cloud Over Europe Observed On "<>FormatDate[date];
Observation = StringReplace[StringCases[msg,"OBS VA 
CLD:"~~Shortest[x__]~~Alternatives["FCST VA 
CLD",EndOfString]:>x][[1]],"\n"->" "];
polys = 
StringCases[Observation,Alternatives["SFC/FL"~~DigitCharacter..~~" 
","FL"~~DigitCharacter..~~"/FL"~~DigitCharacter..]~~ 
Shortest[x__]~~Alternatives["FL"~~DigitCharacter..~~"/FL"~~DigitCharacter..,EndOfString]:>extractLatLong[x],Overlaps->True];
Graphics[{White,{EdgeForm[Gray],CountryData[#,"SchematicPolygon"]}&/@CountryData["Europe"],
Opacity[.5],MapIndexed[{color={Yellow,Red,Orange}[[#2[[1]]]];EdgeForm[color],FaceForm[color],Polygon[#1]}&,polys]
},ImageSize->700,PlotRange->{{-30,30},{35,70}},PlotLabel->Title]];
Manipulate[ 
renderVAAMessage[VAAMessageLinks[[date]]],{date,1,Length[VAAMessageLinks],1}]

• References:
  • Re: Formatting GraphicsRow/column
    • From: Helen Read <hpr@together.net>