Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2014

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Plotting Data By State

  • To: mathgroup at smc.vnet.net
  • Subject: [mg132712] Re: Plotting Data By State
  • From: Bob Hanlon <hanlonr357 at gmail.com>
  • Date: Mon, 12 May 2014 00:42:23 -0400 (EDT)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • Delivered-to: l-mathgroup@wolfram.com
  • Delivered-to: mathgroup-outx@smc.vnet.net
  • Delivered-to: mathgroup-newsendx@smc.vnet.net
  • References: <20140502061816.325216A3A@smc.vnet.net>

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



  • Prev by Date: Re: Numerical solution from Module
  • Next by Date: Cirlce in 3D?
  • Previous by thread: Plotting Data By State
  • Next by thread: Re: Plotting Data By State