14
|
22136 Views
|
15 Replies
|
70 Total Likes
View groups...
Share
GROUPS:

# Mystery location of XKCD Astronaut Vandalism sign

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 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 miand for JacksonGeoDistance[Entity["City", {"Derma", "Mississippi", "UnitedStates"}], Entity["City", {"Jackson", "Mississippi", "UnitedStates"}], UnitSystem -> "Imperial"]Out[] = 109.373 miI am sure someone could do better than this - please do  GeoNearest possibly?
15 Replies
Sort By:
Posted 11 years ago
 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 11 years ago
 Hi there, As I don't have Mathematica v10 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"]]/1609results = {#, (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 11 years ago
 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 11 years ago
 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@pairsOut[]= 14Then 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 11 years ago
 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 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.5808In[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 11 years ago
 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 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 11 years ago
 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 11 years ago
 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 11 years ago
 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 11 years ago
 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 11 years ago
 Yes, Hans, thanks for noticing - of course we need Memphis, TN. Very nice detective work in general ;-)
Posted 11 years ago
 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 11 years ago
 Mystery solved! Good job :) SPace, MS ? 62 mi Jackson, MS ? 115 mi Memphis, TN ? 98 miGeoGraphics[{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]]