xkcd: Geohashing in Mathematica

Question

On May 21, 2008, an xkcd comic proposed a method for creating a random, local meeting place that can't be determined until the day of the meeting.

This method is usually used for xkcd fan events, but can also be a fun way to create a random adventure (kinda like Geocaching without the cache.) More info about the specifics can be found on the Geohashing Wiki.

Since the random part of the hash is created from the Dow Jones Industrial Average, I thought it would be a fun algorithm to implement in Mathematica. I also wanted to create an excuse to learn about the Google Maps API and processing JSON data in general.

Given only a user's "home" coordinates, how would one compute the Geohash location in Mathematica?

Answer 1

I separated this project into two parts. The first is to compute the coordinates of the Geohash location.

(*Grab the user's geographical location. The location is based on IP
address, so it may not be completely accurate. It's usually good
enough to get your graticute. You can replace home with with known
coordinates in the form {hx, hy} if you like.*)
home = FindGeoLocation[];

(*An alternative, using Wolfram Alpha
home=N[FromDMS/@WolframAlpha["Where am I?",
{{"HostInformationPod",1},"ComputableData"}][[3,2,1]]];
*)

(*The current date string, accounting for the 30W Time Zone Rule
 http://wiki.xkcd.com/geohashing/30W_Time_Zone_Rule *)
date = DateString[If[home[[2]] > -30, DatePlus[-1], DateString[]], 
 {"Year", "/", "Month", "/", "Day"}
];

(*Most recent Dow Jones Average*)
dj = URLFetch["http://carabiner.peeron.com/xkcd/map/data/" <> date];

(*Current date. Combine with Dow Jones average.*)
str = StringJoin[{DateString[{"Year", "-", "Month", "-", "Day", "-"}],
     dj}];

(*Perform the string hash. Note that in MMA versions before 8, this
will return inconsistent results. See
http://mathematica.stackexchange.com/questions/13529/why-does-hash-
return-different-values-in-version-7 for a workaround*)
hsh = RealDigits[Hash[str, "MD5"], 16][[1]];

(*Mathematica chops off leading zeroes, this puts them back on*)
ConstantArray[0, 32 - Length[hsh]]~Join~hsh;

(*Split to two coordinates*)
{xhex, yhex} = Partition[hsh, 16];

(*Convert to decimal*)
{xhex, yhex} = Prepend[#, 0] & /@ {xhex, yhex};
{x, y} = (FromDigits[{#, 1}, 16] & /@ {xhex, yhex});

(*Compute coordinates*)
coords = Sign[#] (Abs[#] + {x, y}) &[IntegerPart /@ home] // N;

We now have the coordinates for the Geohash. We can use Google Maps API to show some relevant map data and travel info:

(*Create strings for Google API from coordinate pairs*)
fmt[s_] := StringReplace[ToString[s], # -> "" & /@ {"{", "}", " "}]

(*Use Google Directions API to find path to Geohash*)
path = Import[
   "http://maps.googleapis.com/maps/api/directions/json?origin=" <> 
    fmt[home] <> "&destination=" <> fmt[coords] <> "&sensor=false", 
   "JSON"];
pathString = 
  First["points" /. 
    Cases[path, HoldPattern["overview_polyline" -> value_] :> value, 
     Infinity]];

(*Use Google Static Maps API to show start and end points along with \
path*)
mapPath = 
  "http://maps.googleapis.com/maps/api/staticmap?size=600x600&maptype=\
roadmap&markers=color:red%7C" <> fmt[home] <> 
   "&markers=color:blue%7C" <> fmt[coords] <> 
   "&path=weight:4%7Ccolor:red%7Cenc:" <> pathString <> 
   "&sensor=false";

(*A close-up map of the Geohash location*)
mapHash = 
  "http://maps.googleapis.com/maps/api/staticmap?center=" <> 
   fmt[coords] <> 
   "&zoom=14&size=600x600&maptype=roadmap&markers=color:red%7C" <> 
   fmt[coords] <> "&sensor=false";

(*Show maps*)
GraphicsGrid[{{Import[mapPath], Import[mapHash]}}, ImageSize -> 1000]

(*Extract and print trip time/distance info*)
Print[Style[
   "Geohash coordinates: " <> ToString[coords] <> 
    ", Trip Distance: " <> 
    First["text" /. 
      Cases[path, HoldPattern["distance" -> value_] :> value, 
       Infinity]] <> ", Driving Time: " <> 
    First["text" /. 
      Cases[path, HoldPattern["duration" -> value_] :> value, 
       Infinity]], Large]];

Which gives us something like this:

I'd love to see any improvements or fun extensions that anybody can come up with!

EDIT:

After noticing that FinancialData[] only returns the DJI without decimals, I checked the Geohashing Wiki to see how other users grab this value and found several possibilities. Using

dj = URLFetch[
   "http://carabiner.peeron.com/xkcd/map/data/" <> 
    DateString[{"Year", "/", "Month", "/", "Day"}]];

Returns results that are consistent with the "Official" calculator.

EDIT 2:

While looking through other implementation details, I discovered the 30W Time Zone Rule. We can account for this with

DateString[
 If[home[[2]] > -30, 
  DatePlus[-1],
  DateString[]
 ], 
 {"Year", "/", "Month", "/", "Day"}
]

EDIT 3:

Alternative method for user's "home" coordinates using Wolfram Alpha:

home=N[FromDMS/@
WolframAlpha["Where am I?",{{"HostInformationPod",1},"ComputableData"}]
[[3,2,1]]
];