Data Analysis
using Real HS Data

Initialization:

<< "Statistics`DescriptiveStatistics`"<< "Graphics`Graphics`"<< "Statistics`DataManipulation`"<< "Statistics`LinearRegression`"<< "Graphics`Colors`"

Data Analysis

This is a data set of actual data from XXXXXX High School.  Theses are student admission scores from students selected for admission from the pool of applicants in Spring 1990.  The student is represented by an ID number, then the following: pre-admission GPA, SSAT Reading score, SSAT Verbal score, SSAT Quantitative score, SSAT Total score, and the student's GPA as of March 1994.  The letter L behind the ID indicates the student left XXXXXXX HS prior to March 1994, and the GPA was a the last one on record.
ID	preGPA	R	V	Q	Tot	GPA

data := {{1, 5.00, 98, 98, 99, 99, 4.70}, {2, 5.00, 91, 91, 99, 98, 
          5.00}, {3, 5.00, 93, 88, 99, 98, 4.89}, {5, 5.00, 80, 93, 77, 89, 
          3.85}, {6, 5.00, 89, 90, 98, 97, 4.85}, {7, 4.97, 89, 92, 99, 99, 
          4.98}, {9, 5.00, 28, 82, 92, 90, 4.88}, {15, 4.97, 83, 82, 83, 87, 
          4.52}, {19, 4.87, 41, 75, 98, 91, 4.08}, {20, 4.80, 67, 50, 95, 80, 
          4.00}, {21 L, 4.73, 49, 48, 68, 59, 2.67}, {22, 5.00, 51, 29, 59, 
          42, 3.31}, {28, 4.47, 96, 99, 89, 98, 3.89}, {29, 4.77, 86, 99, 99, 
          99, 4.16}, {30 L, 4.83, 85, 78, 97, 92, 4.91}, {32, 4.87, 67, 95, 
          97, 98, 4.52}, {33, 4.87, 69, 82, 80, 84, 3.85}, {34 L, 5.00, 63, 
          43, 89, 72, 4.21}, {44 L, 4.70, 97, 98, 96, 98, 4.00}, {48, 4.80, 
          98, 99, 98, 99, 4.90}, {49, 4.90, 91, 97, 99, 99, 5.00}, {50, 4.70, 
          98, 94, 85, 92, 4.86}, {52, 4.43, 94, 86, 94, 92, 3.96}, {54, 4.77, 
          73, 38, 98, 80, 4.92}, {58, 3.60, 98, 91, 66, 82, 3.70}, {71, 5.00, 
          83, 87, 92, 91, 4.48}, {72 L, 4.50, 80, 80, 94, 90, 4.47}, {73, 
          4.63, 59, 88, 82, 88, 3.85}, {78, 4.90, 74, 83, 99, 97, 4.74}, {79, 
          4.37, 82, 77, 85, 83, 3.64}, {82, 3.80, 62, 93, 89, 94, 3.08}, {83, 
          4.87, 85, 57, 92, 79, 4.96}, {84, 4.87, 91, 74, 83, 83, 4.73}, {85, 
          4.70, 84, 83, 90, 88, 4.85}, {86, 4.93, 51, 81, 83, 85, 5.00}, {92, 
          4.90, 97, 97, 95, 99, 3.95}, {93, 4.50, 78, 93, 86, 92, 3.58}, {95, 
          4.60, 97, 94, 97, 93, 4.41}, {96 L, 4.87, 80, 72, 97, 80, 4.10}, {
          98 L, 4.73, 95, 97, 72, 92, 3.94}, {99, 4.87, 95, 93, 97, 97, 
          4.82}, {100, 5.00, 80, 80, 86, 86, 4.55}, {101 L, 4.80, 85, 87, 
          70, 81, 3.94}, {105, 5.00, 31, 33, 86, 66, 4.92}, {109, 4.50, 95, 
          97, 80, 91, 4.24}, {110, 5.00, 47, 61, 70, 66, 4.92}, {111 L, 
          4.87, 74, 41, 72, 59, 4.55}, {112 L, 4.43, 11, 16, 26, 18, 2.80}}

A particular column can be extracted from the matrix, and analyzed seperately.  The reading score was extracted, grouped by 10's, and put into a bar chart to view frequencies of scores; also, some descriptive statistics were found for this score.

read := Column[data, 3]Clear[n]tens := Table[10 n, {n, 1, 9}]rc := RangeCounts[read, tens]fread := Transpose[RowJoin[{rc, Append[tens, 100]}]]N[LocationReport[read]]N[DispersionReport[read]]

BarChart[fread, 
      BarLabels 
        -> {"1-10", "11-20", "21-30", "31-40", 
          "41-50", "51-60", "61-70", "71-80", "81-90", 
          "91-100"}, BarValues -> True, AspectRatio ->  .5, 
      PlotRange -> {0, 17}, 
      PlotLabel -> "Frequency of Reading Scores"];

By dropping ID, the independent variables preGPA, Reading, Verbal, Quantitative, and Total can be regressed onto GPA.  The regression analysis compares the model to a smaller one of only a constant term.

newdata := ColumnDrop[data, 1]Clear[x1, x2, x3, x4, x5, y]Regress[newdata, {1, x1, x2, x3, x4, x5}, {x1, x2, x3, x4, x5}, 
      BasisNames 
        -> {"Constant", "preGPA", "Read", "Verbal", 
          "Quant", "Total"}]

Predicted GPA can be compared to actual GPA and these predicted values plotted against the residuals.

newdata := ColumnDrop[data, 1]Clear[x1, x2, x3, x4, x5, y]pred1 = 
      Regress[newdata, {1, x1, x2, x3, x4, x5}, {x1, x2, x3, x4, x5}, 
        OutputControl -> NoPrint, 
        OutputList 
          -> {PredictedResponse, FitResiduals, CorrelationMatrix}]

predict := PredictedResponse /. pred1errors := FitResiduals /. pred1ListPlot[Transpose[{predict, errors}], PlotRange -> All, 
      PlotStyle -> Blue];

pred5 = 
      Regress[newdata, {1, x1, x2, x3, x4, x5}, {x1, x2, x3, x4, x5}, 
        OutputControl -> NoPrint, 
        OutputList -> {BestFitCoefficients}]

Clear[m]halves = Table[ .5 m, {m, 4, 10}]

rc2 = RangeCounts[predict, halves]

fpredict = Transpose[RowJoin[{rc2, Append[halves, 5.5]}]]

It is apparent that the majority of the students achieved GPA's within 0.5 grade point of their predicted grade.  It may be of interest to note that the three students with lowest predicted GPA have either left XXXXXX HS or have been on academic probation at least one semester prior to this analysis.
The next step of this project is to redo the analysis using the entire set of applicant scores. I am interested in the comparison between the predicted GPA of students who were admitted to those who were not.

data2 := {{4, 4.93, 99, 99, 99, 99}, {8, 4.80, 54, 88, 99, 97}, {10, 
          4.70, 73, 86, 96, 93}, {11, 4.57, 63, 83, 59, 72}, {12, 4.53, 67, 
          50, 66, 59}, {13, 4.90, 39, 40, 99, 84}, {14, 3.37, 80, 88, 94, 
          93}, {16, 4.67, 80, 86, 97, 93}, {17, 4.97, 80, 69, 89, 84}, {18, 
          4.87, 67, 83, 89, 89}, {23, 5.00, 83, 53, 55, 55}, {24, 4.17, 89, 
          99, 71, 92}, {25, 4.83, 28, 59, 35, 44}, {26, 3.73, 83, 21, 28, 
          21}, {27, 3.87, 9, 4, 1, 1}, {31, 4.67, 78, 93, 87, 92}, {35, 4.93, 
          67, 75, 74, 78}, {36, 4.10, 91, 99, 96, 99}, {37, 4.27, 59, 72, 82, 
          78}, {38, 3.67, 93, 55, 92, 80}, {39, 4.23, 22, 70, 46, 59}, {40, 
          4.07, 30, 23, 26, 21}, {41, 3.77, 7, 29, 28, 26}, {42, 4.93, 99, 
          97, 98, 99}, {43, 4.93, 95, 98, 95, 98}, {45, 4.83, 95, 95, 89, 
          95}, {46, 4.80, 91, 93, 98, 98}, {47, 4.70, 89, 76, 97, 91}, {51, 
          4.90, 95, 80, 53, 68}, {53, 4.63, 59, 63, 88, 78}, {55, 5.00, 71, 
          75, 68, 72}, {56, 4.20, 91, 69, 68, 70}, {57, 4.63, 49, 78, 70, 
          75}, {59, 4.63, 67, 53, 49, 50}, {60, 4.57, 86, 59, 35, 47}, {61, 
          4.77, 71, 50, 68, 59}, {62, 4.83, 63, 40, 16, 26}, {63, 4.43, 54, 
          72, 59, 66}, {64, 4.20, 67, 61, 16, 37}, {65, 4.67, 41, 57, 71, 
          38}, {66, 4.40, 49, 48, 26, 32}, {67, 4.27, 76, 38, 22, 28}, {68, 
          4.03, 59, 8, 88, 47}, {69, 4.30, 54, 12, 55, 28}, {70, 4.27, 28, 5, 
          28, 11}, {74, 4.30, 41, 59, 24, 39}, {75, 4.50, 49, 76, 62, 72}, {
          76, 2.80, 7, 31, 32, 30}, {77, 4.70, 91, 92, 86, 92}, {80, 4.80, 
          54, 81, 70, 53}, {81, 4.90, 69, 57, 78, 68}, {87, 4.07, 82, 72, 61, 
          71}, {88, 4.90, 56, 22, 53, 36}, {89, 4.50, 78, 67, 47, 56}, {90, 
          4.43, 69, 67, 32, 49}, {91, 4.60, 27, 25, 32, 27}, {94, 4.73, 95, 
          93, 86, 93}, {97, 4.80, 27, 61, 68, 66}, {102, 5.00, 88, 47, 82, 
          68}, {103, 4.70, 88, 97, 72, 92}, {104, 4.73, 88, 55, 59, 59}, {
          106, 4.17, 63, 64, 80, 73}, {107, 4.47, 12, 1, 6, 1}, {108, 3.40, 
          49, 11, 53, 27}}

Clear[pred2]pred2[x1_, x2_, x3_, x4_, x5_] := 
      -1.82592 + 0.909263 x1 + 0.00420906 x2 - 0.0159426 x3 + 
        0.000375868 x4 + 0.0316178 x5

newdata2 = ColumnDrop[data2, 1]; predict2 = MapThread[pred2, Transpose[newdata2]]

rc3 := RangeCounts[predict2, halves]fpredict3 := Transpose[RowJoin[{rc3, Append[halves, 5.5]}]]

This is a bar graph of predicted grades of students who were admitted

Bar1 = 
      BarChart[fpredict, 
        BarLabels 
          -> {"0-2", "2-2.5", "2.5-3", "3-3.5", 
            "3.5-4", "4-4.5", "4.5-5", "5"}, 
        BarValues -> True, PlotRange -> {0, 25}, 
        PlotLabel -> "Frequency of Predicted Grades"];

This is a bar graph of predicted grades of students who were not admitted.

Bar2 = 
      BarChart[fpredict3, 
        BarLabels 
          -> {"0-2", "2-2.5", "2.5-3", "3-3.5", 
            "3.5-4", "4-4.5", "4.5-5", "5"}, 
        BarValues -> True, BarStyle -> {Green}, 
        BarSpacing -> 0.25, PlotRange -> {0, 25}];

This is a comparison between the predicted GPA of students who were admitted to those who were not.

Show[Bar1, Bar2];