(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(AllCountries = Union[Take[CountryData["Countries"], All], {"Antarctica"}]);


Area[reg_Region] := Abs[Dot[
Sin[List @@ Last /@ reg],
((RotateLeft[#]-#)& )@ (List @@ First /@ reg)
]];
Area[c_CountryShape] := (Plus @@ Area /@ c);
Area[s_String] := Area[CountryShape[s]];


CountryShape[c_String] := Sort[
Select[
Map[(LonLat@@N[# Degree])&,
Apply[Region,
CountryShape @@ First[CountryData[c, "SchematicPolygon"]],
{1}
],
{2}
],
Area[#]>10^(-5)&
],
Area[#]&
]
(* /. LonLat[ln_, lt_] \[RuleDelayed] LonLat[-Pi/2+ln, lt] *)


MakeColourScheme[ac_List, newborders_List] := Module[
{c, nbd, cnbd, addborders, k, oc, nc, changes, change},
(nbd[#] = CountryData[#,"BorderingCountries"])& /@ ac;
addborders[{c1_, c2_}] := (
nbd[c1] = Union[nbd[c1], {c2}];
nbd[c2] = Union[nbd[c2], {c1}];
);
addborders[l_List] := Do[
addborders[{l[[i]], l[[j]]}],
{i, 2, Length[l]}, {j, i}
];
addborders /@ newborders;
(CountryColour[#] = RandomReal[])& /@ AllCountries;
changes={}; change=0;
Do[
Do[
cnbd = Sort[CountryColour /@  nbd[c]];
If[cnbd != {},
AppendTo[cnbd, 1+First[cnbd]];
{k}=Ordering[Rest[RotateRight[cnbd]-cnbd], 1];
oc = CountryColour[c];
nc = FractionalPart[(cnbd[[k]]+cnbd[[k+1]])/2];
oc = Abs[oc-nc]; If[oc>0.5, oc=1-oc];
change += oc;
CountryColour[c] = nc
],
{c, AllCountries}
];
AppendTo[changes, change];
change=0,
{32}
];
Print["Country colouring process changes: ", changes]
];
MakeColourScheme[ac_] := MakeColourScheme[ac, {}];
LoadColourScheme[s_String] := Module[
{rule},
rule=Get[s<>".m"];
(CountryColour[#] = (#/.rule))& /@ (First /@ rule);
];
SaveColourScheme[] := SaveColourScheme[
DateString[{"YearShort","Month","Day","-","Hour24","Minute","Second"}]
];
SaveColourScheme[dt_String] := Module[
{},
Put[
(# -> CountryColour[#])& /@ AllCountries,
dt<>".m"
];
Export[dt<>".png",
Graphics[{
EdgeForm[White],
{
Hue[CountryColour[#]],
CountryShape[#] /. {CountryShape  -> List, Region[pts___] :> Polygon[{pts} /. LonLat-> List]}
}& /@ 
(AllCountries)
},
Background -> Black, ImageSize -> 640
]
]
]


MakeColourScheme[AllCountries,{
{"Canada", "Greenland"}, {"Canada", "Russia"}, {"UnitedStates", "Russia"}, {"Canada", "Mexico"}, {"Malaysia", "PapuaNewGuinea"}, {"Japan", "Russia"}, {"Japan", "SouthKorea"}, 
{"Kazakhstan", "Mongolia"}, {"Australia", "NewZealand"}, {"Australia", "Indonesia"}, {"Australia", "PapuaNewGuinea"}, {"China", "Japan"}, {"China", "SouthKorea"}, {"NorthKorea", "Japan"}, {"UnitedStates", "Greenland"}, {"Greenland", "Russia"}, {"Pakistan", "Tajikistan"}, {"Canada", "Japan"}, {"Canada", "Italy"}, {"Italy", "Japan"}, {"Italy", "Germany"}, {"France", "UnitedKingdom"}
}]


MapCenteredAt[coord_String, excl___] := MapCenteredAt[FromDMS[coord] Degree // N, excl];
MapCenteredAt[{BLat_, BLon_}]  := MapCenteredAt[{BLat, BLon}, {}] ;
MapCenteredAt[{BLat_, BLon_}, excl_List] := Module[{M, P, Draw},
M=RotationMatrix[({
 {Cos[BLat]Cos[BLon], 0},
 {Cos[BLat]Sin[BLon], 0},
 {Sin[BLat], 1}
})//Transpose];
P[LonLat[\[Theta]_,\[Phi]_]] := (
{x,y,z}=M.{Cos[\[Phi]]Cos[\[Theta]],Cos[\[Phi]]Sin[\[Theta]], Sin[\[Phi]]};
(*Sqrt[1/(2(1+z))]{x,y}*)  ArcCos[z]/(\[Pi] Sqrt[1-z^2]) {x,y}
);
Draw[c_String] := {Hue[CountryColour[c]], (List @@ CountryShape[c])/. {Region[pts___] -> Polygon@{pts}} /. p_LonLat :> P[p]};
Graphics[{Circle[{0,0},1], Draw /@ Complement[AllCountries, excl]}]
]



