Re: Plotting Data By State

[Bob Hanlon]

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