Path: csiph.com!v102.xanadu-bbs.net!xanadu-bbs.net!news.glorb.com!newspump.sol.net!posts.news.twtelecom.net!nnrp3.twtelecom.net!not-for-mail
From: Bob Hanlon <hanlonr357@gmail.com>
Newsgroups: comp.soft-sys.math.mathematica
Subject: Re: Plotting Data By State
Date: Mon, 12 May 2014 04:42:41 +0000 (UTC)
Sender: steve@smc.vnet.net
Approved: Steven M. Christensen <steve@smc.vnet.net>, Moderator
Message-ID: <lkpjg1$lk4$1@smc.vnet.net>
References: <20140502061816.325216A3A@smc.vnet.net>
Lines: 166
Organization: Time-Warner Telecom
NNTP-Posting-Date: 12 May 2014 04:49:02 GMT
NNTP-Posting-Host: 333b8451.news.twtelecom.net
X-Trace: DXC=VSg[=hEnjIVF`5M@]Oe7e\C_A=>8kQj6];[h;PUXBgbTPm3bW^Q9cmVEFiONJ7[GoV<U07f8f2N^[
X-Complaints-To: abuse@twtelecom.net
Xref: csiph.com comp.soft-sys.math.mathematica:16930


See http://stackoverflow.com/questions/8957067/mathematica-north-america-map


Clear[crimeDataElements, population];


populationData =
  Flatten[{#[[1, {1, 2}]], Total[#[[All, 3]]]}] & /@
   GatherBy[
    Cases[
     Drop[
       Import[
         "http://www.census.gov/popest/data/state/asrh/pre-1980/tables/PE-19
.\
xls",
         "Data"][[1]],
       5] // Rest,
     {year_, _, stateName_, _,
       populationsByAge__} :>
      {ToExpression[year], stateName,
       Total[Round /@ {populationsByAge}]}],
    Most]; (* {year, state, population} *)


populationYears = populationData[[All, 1]] // Union;


crimeData = Select[
   Import[
     "http://hci.stanford.edu/jheer/workshop/data/crime/CrimeStatebyState.\
csv"
     ] /. "Oaklahoma" -> "Oklahoma",
   Head[#[[4]]] === String || MemberQ[populationYears, #[[4]]] &];


AppendTo[crimeData[[1]], "Count per 100K"];


crimeData = crimeData /. {st_, type_, crime_, yr_Integer, count_} :>
    {st, type, crime, yr, count, 100000.*count/population[yr, st]};


usa = Import[
   "http://code.google.com/apis/kml/documentation/us_states.kml",
   "Data"];


transform[s_] :=
  StringTrim[s, Whitespace ~~ "(" ~~ ___ ~~ ")"];


polygons = Thread[
   transform["PlacemarkNames" /. usa[[1]]] -> ("Geometry" /. usa[[1]])];


usaNames = polygons[[All, 1]];


usaNames does not include DC


Complement[states, usaNames]


{"District of Columbia"}


crimeDataElements[header_?(MemberQ[crimeData[[1]], #] &)] :=
  crimeData[[All, Position[crimeData[[1]], header][[1, 1]]]] //
    Rest //
   Union;


population[year_Integer?(MemberQ[populationYears, #] &),
   state_String?(MemberQ[states, #] &)] :=
  Cases[populationData, {year, state, pop_} :> pop][[1]];


crimeTypeOf = crimeDataElements["Type of Crime"];


crimeProperty =
  Select[crimeData, #[[2]] == "Property Crime" &][[All, 3]] //
   Union;


crimeViolent =
  Select[crimeData, #[[2]] == "Violent Crime" &][[All, 3]] //
   Union;


Manipulate[
  Manipulate[
    Module[{allCounts, colorData, counts, max, min},
     crime = Which[
       typeOfCrime == "Property Crime" &&
        !
         MemberQ[crimeProperty, crime], crimeProperty[[1]],
       typeOfCrime == "Violent Crime" &&
        !
         MemberQ[crimeViolent, crime], crimeViolent[[1]],
       True, crime];
     counts = Cases[crimeData,
        {state, typeOfCrime, crime, year, cnt_, cntPer_} :>
         {cnt,
          cntPer}][[1]];
     allCounts = Cases[crimeData,
       {st_, typeOfCrime, crime, year, cnt_, cntPer_} :>
        cntPer];
     min = Floor[Min @@ allCounts, 5];
     max = Ceiling[Max @@ allCounts, 5];
     colorData = Cases[crimeData,
       {st_, typeOfCrime, crime, year, cnt_,
         cntPer_} :>
        (st -> Rescale[cntPer, {min, max}])];
     element[value_, poly_] :=
      GraphicsGroup[{EdgeForm[Black],
        FaceForm[ColorData[colorGradient][value]], poly}];
     Column[{
       StringForm[("`` `` population = ``"), year, state,
        NumberForm[population[year, state], DigitBlock -> 3]],
       StringForm[("`` `` `` count = ``"),
        year, state, ToLowerCase[crime],
        NumberForm[counts[[1]], DigitBlock -> 3]],
       StringForm[("`` `` `` count per 100,000 people = ``"),
        year, state, ToLowerCase[crime], NumberForm[counts[[2]], 4]],
       "",
       Row[{min, Spacer[5], ColorData[colorGradient, "Image"],
         Spacer[5], max}],
       Graphics[
        {element @@@ Transpose[

           usaNames /. {colorData,
             polygons /.

              Rule[st_, {pt_, poly__}] :>

               Rule[st, Tooltip[#, st] & /@ {pt, poly}]}]},
        ImageSize -> 600]}]],
    Row[{Switch[
       typeOfCrime,
       "Property Crime", Control[{
         {crime, crimeProperty[[1]], "Crime"},
         crimeProperty, ControlType -> "PopupMenu"}],
       "Violent Crime",  Control[{
         {crime, crimeViolent[[1]], "Crime"},
         crimeViolent, ControlType -> "PopupMenu"}]],
      Spacer[15],
      Control[{{colorGradient, "TemperatureMap", "Color Gradient"},
        ColorData["Gradients"]}]}]] // Quiet,
  Row[{
    Control[{{state, states[[1]], "State"}, states}],
    Spacer[15],
    Control[{
      {typeOfCrime, crimeTypeOf[[1]], "Type of Crime"},
      crimeTypeOf}],
    Spacer[15],
    Control[{{year, 1973, "Year"},
      populationYears, ControlType -> "PopupMenu"}]
    }]] // Quiet



Bob Hanlon