Message Boards Message Boards

14
|
22651 Views
|
15 Replies
|
70 Total Likes
View groups...
Share
Share this post:

Mystery location of XKCD Astronaut Vandalism sign

Vitaliy Kaurov, WOLFRAM Research
Posted 11 years ago
One of our members, Allison Newman, was wondering where the sign from recent XKCD comic - Astronaut Vandalism could be really located.



Could we locate where the sign is? At first it seems like a triangulation problem but because "Space" is probably not a point emoticon we have to live with two possible solutions from disk intersections. Check out first GeoGraphics and GeoDisk. With just a little bit of code we can build:
GeoGraphics[{
  Red, GeoDisk[
   Entity["City", {"Memphis", "Tennessee", "UnitedStates"}], Quantity[98, "Miles"], {135, 225}],
  Blue, GeoDisk[
   Entity["City", {"Jackson", "Mississippi", "UnitedStates"}], Quantity[115, "Miles"], {-45, 45}]
  }, GeoZoomLevel -> 9, ImageSize -> 500]




So if you zoom a bit you'll se that eastern point could be somewhere around Derma, Mississippi. Indeed for Memphis:
GeoDistance[
Entity["City", {"Derma", "Mississippi", "UnitedStates"}],
Entity["City", {"Memphis", "Tennessee", "UnitedStates"}],
UnitSystem -> "Imperial"]

Out[] = 83.5647 mi

and for Jackson

GeoDistance[
Entity["City", {"Derma", "Mississippi", "UnitedStates"}],
Entity["City", {"Jackson", "Mississippi", "UnitedStates"}],
UnitSystem -> "Imperial"]

Out[] = 109.373 mi

I am sure someone could do better than this - please do emoticon  GeoNearest possibly?
POSTED BY: Vitaliy Kaurov
15 Replies
Sort By:
As a starting point, we can identify all cities that fall within that overlap:
 In[7]:= jackson =
   GeoNearest["City",
    Entity["City", {"Jackson", "Mississippi", "UnitedStates"}], {All,
     Quantity[115, "Miles"]}, DistanceFunction -> "Boundary"];
 
 In[9]:= memphis =
   GeoNearest["City",
    Entity["City", {"Memphis", "Tennessee", "UnitedStates"}], {All,
     Quantity[98, "Miles"]}, DistanceFunction -> "Boundary"];

In[11]:= Intersection[jackson, memphis]

Out[11]= {Entity["City", {"Beulah", "Mississippi", "UnitedStates"}],
Entity["City", {"BigCreek", "Mississippi", "UnitedStates"}],
Entity["City", {"Boyle", "Mississippi", "UnitedStates"}],
Entity["City", {"CalhounCity", "Mississippi", "UnitedStates"}],
Entity["City", {"Charleston", "Mississippi", "UnitedStates"}],
Entity["City", {"Cleveland", "Mississippi", "UnitedStates"}],
Entity["City", {"Coffeeville", "Mississippi", "UnitedStates"}],
Entity["City", {"Derma", "Mississippi", "UnitedStates"}],
Entity["City", {"Doddsville", "Mississippi", "UnitedStates"}],
Entity["City", {"Drew", "Mississippi", "UnitedStates"}],
Entity["City", {"DuckHill", "Mississippi", "UnitedStates"}],
Entity["City", {"Glendora", "Mississippi", "UnitedStates"}],
Entity["City", {"Grenada", "Mississippi", "UnitedStates"}],
Entity["City", {"Gunnison", "Mississippi", "UnitedStates"}],
Entity["City", {"Mantee", "Mississippi", "UnitedStates"}],
Entity["City", {"Merigold", "Mississippi", "UnitedStates"}],
Entity["City", {"MoundBayou", "Mississippi", "UnitedStates"}],
Entity["City", {"Oakland", "Mississippi", "UnitedStates"}],
Entity["City", {"Pace", "Mississippi", "UnitedStates"}],
Entity["City", {"Pittsboro", "Mississippi", "UnitedStates"}],
Entity["City", {"Renova", "Mississippi", "UnitedStates"}],
Entity["City", {"Rosedale", "Mississippi", "UnitedStates"}],
Entity["City", {"Ruleville", "Mississippi", "UnitedStates"}],
Entity["City", {"Schlater", "Mississippi", "UnitedStates"}],
Entity["City", {"Shelby", "Mississippi", "UnitedStates"}],
Entity["City", {"SlateSprings", "Mississippi", "UnitedStates"}],
Entity["City", {"Sumner", "Mississippi", "UnitedStates"}],
Entity["City", {"Tillatoba", "Mississippi", "UnitedStates"}],
Entity["City", {"Tutwiler", "Mississippi", "UnitedStates"}],
Entity["City", {"Vardaman", "Mississippi", "UnitedStates"}],
Entity["City", {"Webb", "Mississippi", "UnitedStates"}],
Entity["City", {"Winstonville", "Mississippi", "UnitedStates"}],
Entity["City", {"Woodland", "Mississippi", "UnitedStates"}]}
Depending on the curveature of the roads, any of these is a possibility. W|A estimates that the driving distance from Derma to Jackson is 146.9 miles, so the GeoDisk/GeoNearest methods are probably inadequite for this task, unless the XKCD sign is intended to be for pilots. Perhaps this will be a nice jumping off point for someone else?
POSTED BY: Ben Hammerslag
Diego Zviovich
Diego Zviovich
Posted 11 years ago
Hi there,

As I don't have Mathematica v10 emoticon

This is my attempt to the problem with the prior version.
 cities = {{"Memphis", "Tennessee", "UnitedStates"}, {"Jackson",
     "Mississippi", "UnitedStates"}};
 targets =
  Flatten[CityData[{All, #, "UnitedStates"}] & /@ {"Tennessee",
     "Mississippi"}, 1]; targets =
  Delete[targets, #] & @@ Flatten[Position[targets, #] & /@ cities, 2];
 distInMiles[town1_, town2_] :=
  GeoDistance[CityData[town1, "Coordinates"],
    CityData[town2, "Coordinates"]]/1609
results = {#, (distInMiles[cities[[1]], #] -
         98)^2 + (distInMiles[cities[[2]], #] - 115)^2,
     Round@distInMiles[cities[[1]], #],
     Round@distInMiles[cities[[2]], #]} & /@ targets;
topResults = Sort[results, #2[[2]] > #1[[2]] &][[;; 8]
(*{{{"MoundBayou", "Mississippi", "UnitedStates"}, 21.429, 95,
  112}, {{"Winstonville", "Mississippi", "UnitedStates"}, 22.7545, 93,
   114}, {{"Gunnison", "Mississippi", "UnitedStates"}, 25.2871, 97,
  120}, {{"Derma", "Mississippi", "UnitedStates"}, 29.7748, 94,
  119}, {{"CalhounCity", "Mississippi", "UnitedStates"}, 29.8558, 94,
  118}, {{"BigCreek", "Mississippi", "UnitedStates"}, 31.0204, 92,
  115}, {{"SlateSprings", "Mississippi", "UnitedStates"}, 32.6061,
  100, 110}, {{"Merigold", "Mississippi", "UnitedStates"}, 35.1273,
  97, 109}}*)
usMap = Graphics[{FaceForm[Lighter@Brown],
   CountryData["UnitedStates", "Polygon"], Black,
   Circle[Reverse@CityData[cities[[1]], "Coordinates"], 1.75],
   Circle[Reverse@CityData[cities[[2]], "Coordinates"], 1.75], Yellow,
    Point[Reverse@CityData[#, "Coordinates"] & /@
     Join[cities, topResults[[All, 1]]]]}, ImageSize -> 1024]
POSTED BY: Diego Zviovich
How about I widen the location? What makes you think you've got the right Jackson and Memphis?
 allcities = CityData[];
 
 jackson = Select[allcities, First[CanonicalName[#]] === "Jackson" &];
 
 memphis = Select[allcities, First[CanonicalName[#]] === "Memphis" &];
 
 GeoGraphics[{{Red, (Tooltip[GeoDisk[#1, Quantity[115, "Miles"]],
               CanonicalName[#1]] & ) /@ jackson},
      {Blue, (Tooltip[GeoDisk[#1, Quantity[98, "Miles"]],
       CanonicalName[#1]] & ) /@
         memphis}}, GeoRange -> Entity["Country", "UnitedStates"]]
POSTED BY: Brett Champion
You can narrow your selection with GeoNearest, selecting only pairs which distance is less than 98+115 miles:

pairs = Flatten[Thread /@
   Thread[CityData["Jackson"] -> GeoNearest[CityData["Memphis"],
      CityData["Jackson"], {All, Quantity[98 + 115, "Miles"]}]]];

In[]:= Length@pairs
Out[]= 14

Then you can think that the arrows point to opposite directions, so the distance between both cities should be as closest as possible to 98+115:

 In[]:= distances = GeoDistance @@@ pairs
 Out[]= {Quantity[114.074, "Miles"], Quantity[173.227, "Miles"],
  Quantity[177.979, "Miles"], Quantity[49.9258, "Miles"],
  Quantity[84.5157, "Miles"], Quantity[167.923, "Miles"],
  Quantity[91.4924, "Miles"], Quantity[144.194, "Miles"],
  Quantity[169.071, "Miles"], Quantity[168.609, "Miles"],
  Quantity[109.636, "Miles"], Quantity[188.157, "Miles"],
  Quantity[142.184, "Miles"], Quantity[93.2786, "Miles"]}
 

In[]:= pairs[[Last@Ordering[distances]]]
Out[]= Entity["City", {"Jackson", "Minnesota", "UnitedStates"}] -> Entity["City", {"Memphis", "Nebraska", "UnitedStates"}]

Those cities have a distance of 188 miles, which makes them the best candidates.
POSTED BY: Francisco Rodríguez
How about I widen the location? What makes you think you've got the right Jackson and Memphis?

because astronauts have been trained for years and even if they commit an act of vandalism - which, of course, is highly unlikely - , they will do it not too far away from a Space Flight Center, right?
POSTED BY: Udo Krause
Hans Milton
Hans Milton
Posted 11 years ago
A navigation problem! Great, gives me a chance to exercise my Demonstration http://demonstrations.wolfram.com/CelestialNavigation/.
First, convert the given data. To a form as if they are the results of a navigator taken sights of two stars, located directly above Jackson and Memphis:
 In[1]:= earthRadius =
   3956.5467; (* Average in miles, from Wolfram Alpha *)
 
 In[2]:= altitudeJackson = 90 - 115/earthRadius/\[Degree]
 
 Out[2]= 88.3347
 
 In[3]:= altitudeMemphis = 90 - 98/earthRadius/\[Degree]
 
Out[3]= 88.5808

In[4]:= latlongJackson =
CityData[{"Jackson", "Mississippi", "UnitedStates"}, "Coordinates"]

Out[4]= {32.3158, -90.2128}

In[5]:= latlongMemphis =
CityData[{"Memphis", "Tennessee", "UnitedStates"}, "Coordinates"]

Out[5]= {35.1035, -89.9785}
Then, input the data into the Demonstration:

Where are these two solutions on a map? Using http://itouchmap.com/latlong.html:

The distances shown on a road sign will generally be longer than the great circle distances. Therefore the actual location of the sign will be somewhere between the two solutions given by the Demonstration. A good guess is that the sign (if it does exists!) is somewhere along I55, close to Grenada MS.
POSTED BY: Hans Milton
I'll go with slightly NE of Russellville AL, if "Space" = Huntsville.

GeoGraphics[{Red,
  GeoDisk[Entity["City", {"Memphis", "Alabama", "UnitedStates"}],
   Quantity[98, "Miles"], {0, 90}], Blue,
  GeoDisk[Entity["City", {"Jackson", "Tennessee", "UnitedStates"}],
   Quantity[115, "Miles"], {80, 190}], Green,
  GeoDisk[Entity["City", {"Huntsville", "Alabama", "UnitedStates"}],
   Quantity[62, "Miles"], {120, 320}]}, GeoZoomLevel -> 9,
ImageSize -> 500]
POSTED BY: Daniel Lichtblau
Hans Milton
Hans Milton
Posted 11 years ago
Not that it is really within the scope of this community, but still .....
Driving distance between Jackson MS and Memphis TN is generally reported to be around 210 miles. Close to the cartoon sign of 115+98. In fact, I have an old Rand McNally atlas which states 213 miles.
And for the distance to "Space", 62 miles. From Wikipedia:

So the boring answer to the question of the signs location might well be: Along I55, between Jackson and Memphis.
POSTED BY: Hans Milton
Hans, your rather practical answer reminded me of another way we can check our work here: Google's Maps service lets you drop an arbirary point on the map, and it will tell you the distance. Thus, a little experimentation shows that a route on I55 98 miles away from Memphis puts you just a short drive away from Grenada, MS., which confirms your earlier guess.
POSTED BY: Ben Hammerslag

In Ben's answer there is a City called "Pace". 

Entity["City", {"Pace", "Mississippi", "UnitedStates"}]

If this is vandalism then adding an "S" to a sign to be vandalized may not be far fetched.
POSTED BY: Hans Michel

Hans, this is a very keen observation - and it hits close, plus minus just few miles. Distance from Grenada, MS to:

{#, WolframAlpha[
      "driving distance Grenada, MS to " <> #, {{"Driving", 1}, "ComputableData"}, 
      PodStates -> {"Driving__Show non\[Hyphen]metric units"}][[2, 2]]} & /@ 
      {"Pace, MS", "Jackson, MS", "Memphis, MS"} // TableForm
  • Pace, MS 63.53 mi
  • Jackson, MS 113.7 mi
  • Memphis, MS 90.29 mi
POSTED BY: Vitaliy Kaurov

Vitaliy, change "Memphis, MS" to Memphis, TN" hones (or home) in on possible solution.

{#, WolframAlpha[
      "driving distance Grenada, MS to " <> #, {{"Driving", 1}, 
       "ComputableData"}, 
      PodStates -> {"Driving__Show non\[Hyphen]metric units"}][[2, 
      2]]} & /@ {"Pace, MS", "Jackson, MS", 
   "Memphis, TN"} // TableForm
  • Pace, MS 63.53mi
  • Jackson, MS 113.7mi
  • Memphis, TN 99.24mi

{62, 115, 98} - {63.53, 113.7, 99.24} = {-1.53, 1.3, -1.24} Thanks for the code.
POSTED BY: Hans Michel

Yes, Hans, thanks for noticing - of course we need Memphis, TN. Very nice detective work in general ;-)
POSTED BY: Vitaliy Kaurov

This seems like the best possible answer to me. Makes the joke funnier, really: We had all been assuming someone had merely added a sign reading "Space", rather than defacing an existing sigh.

Well done, Hans.
POSTED BY: Ben Hammerslag

Mystery solved! Good job :)

  • SPace, MS ? 62 mi
  • Jackson, MS ? 115 mi

  • Memphis, TN ? 98 mi

    GeoGraphics[{PointSize[Large], Point[GeoPosition[ Entity["City", {"Pace", "Mississippi", "UnitedStates"}]]], Point[GeoPosition[ Entity["City", {"Jackson", "Mississippi", "UnitedStates"}]]], Point[GeoPosition[ Entity["City", {"Memphis", "Tennessee", "UnitedStates"}]]], Red, Point[ location = GeoPosition[ Entity["City", {"Grenada", "Mississippi", "UnitedStates"}]]]}, GeoCenter -> GeoPosition[location]]

enter image description here
POSTED BY: Bernat Espigulé
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract