2
$\begingroup$

I have a dataset which associate each country to respective number, from a list with few countries, as shown below:

data={{2705423, "United States"}, {2118645, "China"}, {817134, 
  "Germany"}, {729343, "United Kingdom"}, {704522, "Japan"}, {605133, 
  "India"}, {538269, "France"}, {461010, "Italy"}, {413584, 
  "Canada"}, {389763, "Russian Federation"}, {336262, 
  "South Korea"}, {322491, "Spain"}, {302802, "Australia"}, {222126, 
  "Brazil"}, {212629, "Netherlands"}, {203047, 
  "Switzerland"}, {193764, "Iran"}, {192998, "Poland"}, {177421, 
  "Sweden"}, {159057, "Taiwan"}, {128128, "Turkey"}, {123813, 
  "Belgium"}, {112496, "Denmark"}, {105011, "Malaysia"}, {97200, 
  "Austria"}}

I would like to print, in color scale, the corresponding country to their number.

I would like to paint, in color scale, each country to their respective number, as shown in the examples below

enter image description here

enter image description here

I thought of building the code from

GeoGraphics[{EdgeForm[Gray], 
  Tooltip[Polygon[GeoVariant[#, "SimplifiedArea"]], CommonName[#]] & /@
    CountryData[]}, GeoBackground -> None]

But I couldn't move forward.

Can anybody help me?

P.s.: I have other lists of other countries and other numbers.

$\endgroup$

2 Answers 2

5
$\begingroup$
$Version

(* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *)

Clear["Global`*"]

data = {{2705423, "United States"}, {2118645, "China"}, {817134, 
    "Germany"}, {729343, "United Kingdom"}, {704522, 
    "Japan"}, {605133, "India"}, {538269, "France"}, {461010, 
    "Italy"}, {413584, "Canada"}, {389763, 
    "Russian Federation"}, {336262, "South Korea"}, {322491, 
    "Spain"}, {302802, "Australia"}, {222126, "Brazil"}, {212629, 
    "Netherlands"}, {203047, "Switzerland"}, {193764, 
    "Iran"}, {192998, "Poland"}, {177421, "Sweden"}, {159057, 
    "Taiwan"}, {128128, "Turkey"}, {123813, "Belgium"}, {112496, 
    "Denmark"}, {105011, "Malaysia"}, {97200, "Austria"}};

EDIT: Added Tooltip

GeoRegionValuePlot[(Tooltip[#[[2]], #[[1]]] -> #[[1]]) & /@
  (data /. str_String :> SemanticInterpretation[str])]

enter image description here

$\endgroup$
1
$\begingroup$
data = {{2705423, "United States"}, {2118645, "China"}, {817134, 
    "Germany"}, {729343, "United Kingdom"}, {704522, 
    "Japan"}, {605133, "India"}, {538269, "France"}, {461010, 
    "Italy"}, {413584, "Canada"}, {389763, 
    "Russian Federation"}, {336262, "South Korea"}, {322491, 
    "Spain"}, {302802, "Australia"}, {222126, "Brazil"}, {212629, 
    "Netherlands"}, {203047, "Switzerland"}, {193764, 
    "Iran"}, {192998, "Poland"}, {177421, "Sweden"}, {159057, 
    "Taiwan"}, {128128, "Turkey"}, {123813, "Belgium"}, {112496, 
    "Denmark"}, {105011, "Malaysia"}, {97200, "Austria"}};

drules = MapAt[Interpreter["Country"], data, {All, 2}] // 
    Map[Reverse] // Map[Apply[Rule]];

GeoRegionValuePlot[
 Tooltip[#, 
    Column[{CommonName@First@#, Last@#}, Alignment -> Center]] & /@ 
  drules
 , ColorFunction -> "Rainbow"
 , ColorFunctionScaling -> True
 , ImageSize -> 600
 , PlotLegends -> 
  Placed[BarLegend[Automatic, LegendMarkerSize -> 200], After]
 ]

enter image description here

--

Legended[GeoBubbleChart[
  Tooltip[#, Column[{CommonName@First@#, Last@#}
      , Alignment -> Center]] & /@ drules
  , ColorFunction -> "Rainbow"
  , ColorFunctionScaling -> True
  , ImageSize -> 600
  ]
 , Placed[BarLegend[{"Rainbow", MinMax[Values@asc]}
   , LegendMarkerSize -> 400, LegendLayout -> "Row"], {0.5, 0.1}]
 ]

enter image description here

$\endgroup$
1
  • $\begingroup$ It is low res screen capture to reduce file size thus making the legends look graduated in terms of color. These legends appear continuous on screen. $\endgroup$
    – Syed
    Apr 24 at 2:07

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.