Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Notice: We are no longer accepting new posts, but the forums will continue to be readable.

Topic: Plotting Data By State
Replies: 1   Last Post: May 12, 2014 12:42 AM

 Bob Hanlon Posts: 906 Registered: 10/29/11
Re: Plotting Data By State
Posted: May 12, 2014 12:42 AM

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[
"Data"];

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

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

usaNames = polygons[[All, 1]];

usaNames does not include DC

Complement[states, usaNames]

{"District of Columbia"}

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],
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]],
"",
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"},
"Violent Crime", Control[{
{crime, crimeViolent[[1]], "Crime"},
Spacer[15],
Row[{
Control[{{state, states[[1]], "State"}, states}],
Spacer[15],
Control[{
{typeOfCrime, crimeTypeOf[[1]], "Type of Crime"},
crimeTypeOf}],
Spacer[15],
Control[{{year, 1973, "Year"},