# Message Boards

Answer
(Unmark)

GROUPS:

12

# [WELP19] Detecting Gerrymandering with Visualization and Analysis

Posted 11 months ago

The Wolfram Emerging Leaders Program is a 4 month long project based program designed for gifted high school students to take a deep dive into a topic of their choice. Students work remotely in small groups to take their project from ideation to completion, with the guidance of Wolfram experts. Wolfram Emerging Leaders Program participants are selected from the Wolfram High School Summer Camp, which is open to talented, STEM oriented students age 17 and under.
Authors
Introduction to Gerrymandering and Political Redistributing Gerrymandering, the practice of manipulating political boundaries to favor a certain group, is a major hinderance to democracy in the United States and other countries. This project produces an algorithm that uses a completely random method to group vertices in a graph into continuous districts. Using the redistricted map, we perform various calculations that can quantitatively measure gerrymandering, such as Reock score and efficiency gap. With larger amounts of data, we use outlier analysis to attempt to detect intent in redistricting plans within our randomly generated data set. With the coming census in 2020, it is important to take a look at our country’s redistricting practices and assess the potential of computation in this political process.
How and why does political redistricting occur in the United States? Americans go to the polls to vote for their congressional representatives as well as their state legislature every couple years. Each state has existing districts that each have representatives for each position for national and state government. Therefore, the choices of candidates for each person depends on where he or she lives, and changing the lines decides exactly who votes for who. We redistrict in order to account for shifts in the population and demographics of a state over time. Redistricting occurs after every census which occurs every ten years. The census is an official count and survey of the entire population of the United States.
Rules for redistricting Equal Population: Each district must have approximately the same population. ◼ Compactness: Can be up to discretion, which has led to much debate. ◼ Contiguity: All parts must be connected ◼
Additional Criteria No discrimination on the basis of race ◼ Preserve counties and other political subdivisions ◼ Preserve communities of interest: neighborhoods with common political interests ◼ Preserve cores of previous districts ◼ Avoid paring incumbents ◼ Currently, state legislatures do most of the political redistricting. In 31 states, they draw congressional districts, and in 30 states, they draw state legislative districts. To approve a plan, there must be a majority in the chamber and can possibly be vetoed by the governor. Two other methods of redistricting are thorough advisory commissions and independent commissions. The advisory commission draws up plans that are then approved by the state legislature, and the independent commissions draw and approve the plans. In[]:= [3] Map describing the type of redistricting in each state
What is gerrymandering? Why should we care? Gerrymandering is the practice of manipulating political boundaries to favor a certain group. This problem has been prevalent since the beginning of the country, when Patrick Henry attempted drawing the districts to oppose James Madison gaining a seat in Congress. The term was first created inspired by Massachusetts governor Elbridge Gerry, who signed a redistricting plan that obviously favored his party. Opposition thought that his district looked like a salamander which is where the word “gerrymandering” came from. In[]:= First Gerrymandering [1] Gerrymandering is most typically done in two methods- cracking and packing. The meaning of these are just what they sound like. Cracking is when one party’s votes are split between districts to ensure they are not the majority. Packing is when one party’s votes are all concentrated in one district, to make it easier to win other districts. There are many reasons that gerrymandering occurs. Cherry-picking voters ◼ Eliminating incumbents ◼ Eliminating challengers ◼ Skewing statewide representation ◼ Diluting minority voters ◼ Splitting communities ◼ In[]:= What gerrymandering looks like [2]
Combating Gerrymandering
Judicial The role of the federal government in gerrymandering cases has been debated for years. In Davis v. Bandemer (1986), the Supreme Court held that gerrymandering could be held unconstitutional if the electoral system “is arranged in a manner that will consistently degrade a voter’s or a group of voters’ influence in the political process as a whole.” It did not hold that the court would take direct action against it. In Vieth v. Jubelirer (2004), the court decided once again to reject the challenge due to lack of standards, but Justice Anthony Kennedy pointed towards the future that standards had the potential to emerge especially with computer-assisted districting. One such standard was proposed in Gill v. Whitford (2018), using the efficiency gap, which measures the number of wasted votes in an election. They argued that an efficiency gap of more that 7% was legally significant, but the Court still decided the evidence was insufficient. Most recently in Rucho v. Common Cause, the Court declared that “partisan gerrymandering claims present political questions beyond the reach of the federal courts.”
State reform As mentioned before states have been moving away from redistricting done solely by the state legislatures. Several states, such as Alaska, Arizona and California, employ nonpartisan independent commissions. The problem with this is that it is difficult to assume that the procedure for selecting members of the commission will truly be nonpartisan and resistant from political manipulation.
Non-governmental organizations Fair Vote is a nonpartisan group that pushes or electoral reform across the United States. One of their main issues is gerrymandering, and the group supports legislative efforts that will reform the way we run elections and draw our boundaries. One of their proposed solutions is the Fair Representation Act where instead of having many districts with 1 representative, we have fewer districts with multiple representatives. Many organizations have also emerged in the states themselves. For instance, in Virginia, One Virginia 2021 is working towards amending the State Constitution to take the power of redistricting from the state legislature to a Virginia Redistricting Commission.
What has been done before on this subject in the math and computer science field?
Duke Quantifying Gerrymandering Duke Math has a nonpartisan research group that uses the ensemble method for outlier analysis. They generate a sample of nonpartisan maps and create questions of interest to assess these maps. They have been part of two gerrymandering legal cases in North Carolina and Wisconsin, as part of the argument against gerrymandering. They use the Markov chain Monte Carlo method to generate thousands of political maps creating distributions for analysis.
Princeton Gerrymandering Project This nonpartisan group aims to use analysis to “understand and eliminate partisan gerrymandering at a state-by-state level”. They do so by writing up reports that use statistical and legal analyses that help groups strategize reform at a state level. Through improved communication, they believe that math and statistics can be used to back reform and legal cases. They have also gathered and cleaned data from thousands of counties to be put in a central repository called OpenPrecincts, to encourage the public to take action.
Purpose and Goals
Our purpose Our purpose is to combat gerrymandering and encourage fair democratic procedures to be used in all states. We want to display how statistical analysis can be used in reform efforts and legal cases as a tool to detect gerrymandering
Our goal We want to create an algorithm that can redistrict and account for equal population, compactness and continuity. We would also like to perform data analysis and calculations to quantitatively measure gerrymandering for simple comparison.
Creating a Map
Random Graph To represent a map, we decided to use the Graph function, which can show both distance and relationships between locations. Each node in the graph would represent a community or county that would then be put in a district for an election. In our project, we assume that there is an equal population for each community for simplicity. We first generate a RandomGraph.
Format Graph To format the graph, we will randomly generate a number of votes for the “red” party and the “blue” party out of 100. The color of the vertex will depend on which party wins. The 100 can represent 100 people or a percentage of voters. generatemap[a_, b_] := With[{graph = RandomGraph[{a, b}, EdgeStyle -> Dashed, EdgeStyle -> Gray, GraphHighlightStyle -> Automatic]}, (*create a random graph*) graph2 = Fold[ SetProperty[{#1, #2}, "Votes" -> <|"Red" -> #, "Blue" -> 100 - #, "Winner" -> If[# > 100 - #, "Red", "Blue"] |> &@ RandomInteger[{1, 100}] ] &, graph, Range[1, Length[VertexList[graph]]] ];(*Set random votes and winner of each vertex*) graph3 = Fold[ SetProperty[ {#1, #2}, VertexStyle -> If[PropertyValue[{#1, #2}, "Votes"][["Winner"]] == "Red", Red, Blue] ] &, graph2, Range[1, Length[VertexList[graph2]]]] (*Color the vertices according to the winning party*) ] In[]:= Do[generatemap[9,15];Print[graph3],3]
Redistricting and Calculations Function
Our Algorithm We created a districting algorithm that takes these nodes in the graph and randomly puts them into 3 equal continuous districts. Each district is denoted by a number 1-3 and the nodes are connected by a colored line. We perform various calculations after generating the districts. In[]:= Figure: Inputs, outputs and eventual results from the districting functions We will use this complete graph, a graph where every pair of vertices is connected by an edge, in order to ensure that no error occurs in the reevaluations of this function. We recognize that this is unrealistic. In our algorithm, there is a flaw, where it will stop midway and return errors because it is not possible to create a continuous district when the remaining vertices have no adjacent vertices available to add to a district. We will account for these errors later when we generate our data. generatemap[9,36];completegraph=graph3; Because every vertex is connected to every other vertex and we want to create districts that have the most efficient, the shape would be a circle divided into equal parts. Theoretically, the map this graph would represent would look something like what is shown below. Every section of the graph is connected to every other section at the center where they all meet. PieChart[Table[1,9]] Out[]=
Random Redistricting Algorithm
District 1 Our algorithm creates one district, one vertex at a time . (*Calculate the district size*)districting1[map_]:= Do districtsize=VertexCount[map]3; vertex = RandomChoice[VertexList@map]; (*choose a random starting point*) remainingvertices1 = VertexList[map]; (*create a list of vertices that are available to be added to a district*) district1 = {}; (*set the list of vertices in the current district as an empty set*) redvotes1 = 0; bluevotes1 = 0; count = 0; Do remainingvertices1 = Delete[remainingvertices1,First@Flatten@Position[remainingvertices1,vertex]]; (*delete it from the list of available vertices*) district1 = Append[district1, vertex]; (*add it to the list of vertices in the district*) redvotes1 = redvotes1 + PropertyValue[{map,vertex},"Votes"]"Red"; (*add the votes to the vote totals for each party*) bluevotes1= bluevotes1 + PropertyValue[{map,vertex},"Votes"]"Blue"; count++; (*add it to the list of vertices in the district*) If[count>(districtsize-1), Break[] (*It will repeat the loop until the district has the correct number of vertices and determine the party that won that district*) ]; vertex= RandomChoice@Intersection[remainingvertices1, AdjacencyList[map,vertex]],{districtsize} (*select a new point from the intersection of the adjacent vertices and the available vertices*) ; graph4 = SetProperty[map,VertexLabelsNormal@AssociationThread[district1,Table[1,districtsize]]]; graph4; remainingvertices1,{1} In[]:= This is what it would look like with the district 1 vertices labeled. districting1[completegraph];Print[graph4]
District 2 This same process is repeated to create the next district. The map and the remaining vertices are passed on the the districting algorithm for district 2. Otherwise the algorithm proceeds in the exact same way. districting2[remainingvertices_,map_]:=Do remainingvertices2 = remainingvertices; vertex = RandomChoice[remainingvertices2]; district2 ={}; redvotes2 = 0; bluevotes2= 0; count = 0; Do remainingvertices2 = Delete[remainingvertices2,First@Flatten@Position[remainingvertices2,vertex]]; district2 = Append[district2,vertex]; redvotes2 = redvotes2 + PropertyValue[{map,vertex},"Votes"]"Red"; bluevotes2= bluevotes2 + PropertyValue[{map,vertex},"Votes"]"Blue"; count++; If[count>(districtsize-1),Break[]]; vertex = RandomChoice@Intersection[remainingvertices2,AdjacencyList[map,vertex]],{districtsize }; graph5=SetProperty[map,VertexLabelsNormal@AssociationThread[district2,Table[2,districtsize]]], {1} In[]:= This is the map with 2 districts created: districting1[completegraph];districting2[remainingvertices1,graph4];Print[graph5]
District 3 The reason we chose not to just label the remaining points as district 3 is to ensure that the districts will be continuous. If it is not possible to be continuous, then the algorithm will have error that will be detected by our algorithm when we are generating data. We repeat the process again. districting3[remainingvertices_,map_]:= Do remainingvertices3=remainingvertices; vertex= RandomChoice[remainingvertices3]; district3={}; redvotes3=0; bluevotes3=0; count=0; Do remainingvertices3 = Delete[remainingvertices3,First@Flatten@Position[remainingvertices3,vertex]]; district3= Append[district3,vertex]; redvotes3= redvotes3 + PropertyValue[{map,vertex},"Votes"]"Red"; bluevotes3= bluevotes3+ PropertyValue[{map,vertex},"Votes"]"Blue"; count++; If[count>(districtsize-1),Break[]]; vertex = RandomChoice@Intersection[remainingvertices3,AdjacencyList[map,vertex]],{districtsize} ; graph6=SetProperty[map,VertexLabelsNormal@AssociationThread[district3,Table[3,districtsize]]], {1} In[]:= This is the map with all three districts labeled. districting1[completegraph];districting2[remainingvertices1,graph4];districting3[remainingvertices2,graph5];Print[graph6];Grid[{{"","District 1","District 2","District 3"},{"Vertices",district1,district2,district3},{"Red votes",redvotes1,redvotes2,redvotes3},{"Blue votes",bluevotes1,bluevotes2,bluevotes3}},FrameAll,ItemStyle{{"Text"},{"Text"}}]
Out[]= Now we have three important things-- a map with the vertices labeled with three districts (graph6), the list of vertices in each district (district1, district2, district3), and the vote counts for each party in each district (redvotes1, redvotes2, redvotes3, bluevotes1, bluevotes2, bluevotes3).
Count the votes and determine the winner We now must determine which party won each district and determine the overall winner. We already have the counts of votes (redvotes1, redvotes2, redvotes3, bluevotes1, bluevotes2, bluevotes3), so we will use those to choose the winners. We use the color itself to denote a winner as a simpler visualization. In this step, we will also sum the votes for the map overall. Determine the winners countvotes[redvotes1_,redvotes2_,redvotes3_,bluevotes1_,bluevotes2_,bluevotes3_]:= Do[ redwindistricts=0; bluewindistricts=0; winner1 = If[redvotes1 > bluevotes1, Red, Blue]; (*If there are more red votes than blue votes, set the winner as Red,otherwise set it as blue*) If[redvotes1 > bluevotes1, redwindistricts++, bluewindistricts++];(*Also, add to the counts of red-won districts and blue-won districts, repeat for other 2 districts*) winner2 = If[redvotes2 > bluevotes2, Red, Blue]; If[redvotes2 > bluevotes2, redwindistricts++, bluewindistricts++]; winner3 = If[redvotes3 > bluevotes3, Red, Blue]; If[redvotes3 > bluevotes3, redwindistricts++, bluewindistricts++]; totalredvotes = (redvotes1 + redvotes2 + redvotes3); (*Sum up the votes to get the red/blue vote totals.*) totalbluevotes = (bluevotes1 + bluevotes2 + bluevotes3); winner = If[redwindistricts > 1, Red, Blue], {1} ] (*Determine the winner of the entire map using the count of red-winning districts*) In[]:= Here, we can visualize the results of the countvotes[] function. countvotes[redvotes1,redvotes2,redvotes3,bluevotes1,bluevotes2,bluevotes3];Grid[{{"Winner 1","Winner 2","Winner 3","Total Red Votes","Total Blue Votes","Red Districts","Blue Districts","Winner Overall"},{winner1,winner2,winner3,totalredvotes,totalbluevotes,redwindistricts,bluewindistricts,winner}},FrameAll,ItemStyle{Automatic,{"Text"}}]
Out[]=
Format Map Now, we want to make our map more visually appealing, and incorporate the winning parties of each district. This function highlights the edges that connect vertices of the same district with the color that won that district. formatmap[map_,district1_,district2_,district3_,winner1_,winner2_,winner3_]:=graph7=HighlightGraph[map,{Style[First@#Last@#,winner1]&/@Partition[district1,2,1],Style[First@#Last@#,winner2]&/@Partition[district2,2,1],Style[First@#Last@#,winner3]&/@Partition[district3,2,1]},EdgeShapeFunction"FilledArrow"]; In[]:= formatmap[graph6,district1,district2,district3,winner1,winner2,winner3] Out[]=
Measuring Fairness: Efficiency Gap Efficiency gap is a way to quantitatively measure gerrymandering, by comparing the number of wasted votes to total votes as a percentage. It was created by Eric McGhee and Nicholas Stephanopoulos. It has been theorized that if the efficiency gap is greater than 7 % then the map is likely to be gerrymandered. There are two circumstances of a wasted vote: If the party won, the number of votes they did not need to win are considered to be wasted. ◼ If the party lost, then all the votes in that district for their party are considered to be wasted. ◼ To demonstrate this calculation, we will use an example with 15 red voters and 15 blue voters that are split between 3 districts with 10 people. The following table shows the vote counts of each district. Grid[{{"","District 1","District 2","District 3"},{Red,7,6,2},{Blue,3,4,8}},FrameAll,ItemStyle{Automatic,{"Text"}}]
Out[]= Now, we can calculate the wasted vote totals for each party. If the party won, then any vote over the majority, which is 6, is wasted, so we subtract 6. If the party lost, then all of their votes are wasted. In the following chart, you can follow the process. Grid[{{"","District 1","District 2","District 3","Wasted Votes"},{Red,Style["7-6=1",Darker[Green]],Style["6-6=0",Darker[Green]],Style["2",Pink],3},{Blue,Style["3",Pink],Style["4",Pink],Style["8-6=2",Darker[Green]],9}},FrameAll,ItemStyle{Automatic,{"Text"}}]
Out[]= The efficiency gap is then calculated by the given by the absolute difference of the wasted votes of the two parties divided by the total amount of votes. This is the efficiency gap of this example. PercentForm[N[(9-3)/30]] 20% Out[]//PercentForm= This following function calculates the efficiency gap for the districts created by the districting functions. Calculate efficiency gap efficiencygap[districtsize_,redvotes1_,redvotes2_,redvotes3_,bluevotes1_,bluevotes2_,bluevotes3_]:=Do[majorityvote=((100*districtsize)/2)+1; (*Determine the number of votes needed to get the majority in one district by multiplying the vertices per district by 100 and dividing by 2 and the total number of votes*)votetotal= (300*districtsize);redwastedvotes = Total[ (*Calculate the number of wasted votes for each party*) If[ # > majorityvote (*If they are the majority*), # - majorityvote (*add the difference between the votes and number of votes for majority*), # (* If they are the losing party, add the votes*) ]&/@{redvotes1, redvotes2, redvotes3} ]; bluewastedvotes = Total[If[# > majorityvote,# - majorityvote, #]&/@{bluevotes1, bluevotes2, bluevotes3}]; efficiencygapvalue = N[Abs[redwastedvotes-bluewastedvotes]/votetotal,3]; (*eg is the difference between the wasted votes divided by the total votes*),{1}] In[]:= These are the results from carrying the function out: efficiencygap[districtsize,redvotes1,redvotes2,redvotes3,bluevotes1,bluevotes2,bluevotes3];Grid[{{"Red Wasted Votes","Blue Wasted Votes","Efficiency Gap"},{redwastedvotes,bluewastedvotes,efficiencygapvalue}},FrameAll,ItemStyle{Automatic,{"Text"}}] Although efficiency gap can be a useful tool in measuring gerrymandering, it is not able to detect if these wasted votes are caused by gerrymandering or natural causes. For example, Democrats tend to win major cities with a overwhelming majority, which means there are a lot of wasted votes, but they are still supposed to be redistricted together.
Calculating Compactness: Reock Score The Reock score was used to quantify the amount of compactness of the districts. A challenge with this was that the regions of our map were supposed to be represented by distinct vertices, with the lines between the vertices only used as an identification for the orientation of each region (vertex). This made the idea of the ratio between areas ambiguous. However, the graphing of the map was essentially done to visualize the shapes of the districts, and it didn’t make sense to disregard the visual aspects of the map, such as the length or area between the vertices. We therefore decided to take into account the area and length between the vertices to calculate the Reock score. Consider a random graph, representing an entire district: randomgraph=RandomGraph[{6,8}] Out[]= The area of the district would be then computed, through creating a polygon with all of the vertices in the district, and getting the area of the polygon. To create a polygon that encompasses the entire district, the vertices of the polygon must be the outer vertices of the district. However, a major problem with this was that there wasn’t a good way to identify the outer vertices. WIthout identifying the outer vertices, problems like this would happen: Graphics[Polygon[Last[First[AbsoluteOptions[randomgraph,VertexCoordinates]]/.Rule{}]]] Out[]= The order in which the vertices were entered into the polygon affected the shape of the polygon with the inner points. Therefore, the best solution was to find a region union of all polygons created with every permutation possible by the vertices in the district, and create another polygon with that. Graphics[RegionUnion[Table[Polygon[x],{x,Permutations[Last[First[AbsoluteOptions[randomgraph,VertexCoordinates]]/.Rule{}],{6}]}]]]AreaofGraph=Area[RegionUnion[Table[Polygon[x],{x,Permutations[Last[First[AbsoluteOptions[randomgraph,VertexCoordinates]]/.Rule{}],{6}]}]]]; Out[]= Notice how the polygon created with the region union of all permutations of vertex coordinates resemble the outer convex shape of the district. Then the smallest circle the encompasses the district was obtained by generating a list of every possible pairs of coordinates of the district, then getting the length of the distance between two coordinates furthest apart, which would be the diameter of the circle. This was then combined into one function: Calculate the Reock Score for one district ReockScore[map_,district_]:=(Area[RegionUnion[Table[Polygon[x],{x,Permutations[Part[Last[First[AbsoluteOptions[map,VertexCoordinates]]/.Rule{}],district],{Length[district]}]}]]])(*Area of the polygon created with the region union of all permutations of vertex coordinates of the district*)/(((Max[Table[EuclideanDistance[x[[1]],x[[2]]],(*Distance between every combination of two vertices in a district, then finding the max distance*){x,Permutations[Part[Last[First[AbsoluteOptions[map,VertexCoordinates]]/.Rule{}],district],{2}]}]]/2)^2)*Pi) In[]:= Calculate the Reock Score for all 3 districts and the average ReockAll[map_,district1_,district2_,district3_]:=Do[reockdistrict1=ReockScore[map,district1];reockdistrict2=ReockScore[map,district2];reockdistrict3=ReockScore[map,district3];reockaverage=(reockdistrict1+reockdistrict2+reockdistrict3)/3,{1}] In[]:= These are the results Reock scores from our current example: ReockAll[graph7,district1,district2,district3];Grid[{{"Reock Score 1","Reock Score 2","Reock Score 3","Reock Score Average"},{reockdistrict1,reockdistrict2,reockdistrict3,reockaverage}},FrameAll,ItemStyle{Automatic,{"Text"}}]
Out[]=
Summary of our results The following function was created to call all of the functions that we wrote with a single input of a map, which simplifies the process a lot: Complete redistricting and calculations with a single input of a map redistrict[map_]:= Do[ districting1[map]; districting2[remainingvertices1,graph4]; districting3[remainingvertices2,graph5]; countvotes[redvotes1,redvotes2,redvotes3,bluevotes1,bluevotes2,bluevotes3]; formatmap[graph6,district1,district2,district3,winner1,winner2,winner3]; efficiencygap[districtsize,redvotes1,redvotes2,redvotes3,bluevotes1,bluevotes2,bluevotes3]; ReockAll[graph7,district1,district2,district3]; Summary[redvotes1,bluevotes1,winner1,reockdistrict1,redvotes2,bluevotes2,winner2,reockdistrict2, redvotes3,bluevotes3,winner3,reockdistrict3,redwastedvotes,bluewastedvotes,efficiencygapvalue, winner,reockaverage,redwindistricts,redwindistricts ], {1} ] In[]:= Now, this is all the code needed to complete the districting algorithm and following calculations. redistrict[completegraph] In[]:= We can also generate a summary of all the values and calculations we have completed. Summary[redvotes1_,bluevotes1_,winner1_,reockdistrict1_,redvotes2_,bluevotes2_,winner2_,reockdistrict2_,redvotes3_,bluevotes3_,winner3_,reockdistrict3_,redwastedvotes_,bluewastedvotes_,efficiencygap_,winner_,reockaverage_,redwindistricts_,bluewindistricts_]:=Do[gr |