Tell me more ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.
up vote 4 down vote favorite

I've been using Mathematica to explore historical records. I have two long lists (one is 69k, the second 17k) of unequal length. They are like so (FWIW, the first list is the first 40 entries from the surnames of First World War attestation papers; the second list is the first 30 entries from the surnames of First World War war grave surnames - I have created percentage lists, to get a sense of how frequent their names were amongst all names):

atts={{"SMITH", 0.10031}, {"BROWN", 0.0555427}, {"WILSON", 
  0.0451438}, {"MCDONALD", 0.0411175}, {"JONES", 
  0.0375836}, {"TAYLOR", 0.0356139}, {"CAMPBELL", 
  0.033398}, {"JOHNSON", 0.0320656}, {"ANDERSON", 
  0.0303276}, {"WILLIAMS", 0.0298352}, {"THOMPSON", 
  0.0289952}, {"MARTIN", 0.0279669}, {"SCOTT", 0.0257944}, {"WHITE", 
  0.0250413}, {"STEWART", 0.0243606}, {"MILLER", 0.0240854}, {"CLARK",
   0.0237088}, {"MACDONALD", 0.0224054}, {"WALKER", 
  0.0216233}, {"JOHNSTON", 0.0212322}, {"MOORE", 0.0212177}, {"YOUNG",
   0.0211888}, {"ROBINSON", 0.0209426}, {"ROSS", 
  0.0196391}, {"WRIGHT", 0.018437}, {"MURRAY", 
  0.0182053}, {"ROBERTSON", 0.0181763}, {"MITCHELL", 
  0.0177273}, {"MCLEOD", 0.0176839}, {"JACKSON", 0.0175825}};    

kia={{"SMITH", 0.0452787}, {"BROWN", 0.0260468}, {"WILSON", 
      0.0195784}, {"JONES", 0.0174415}, {"TAYLOR", 
      0.0169217}, {"CAMPBELL", 0.0166907}, {"McDONALD", 
      0.0146694}, {"ANDERSON", 0.0127057}, {"JOHNSON", 
      0.012417}, {"STEWART", 0.0123592}, {"SCOTT", 0.0120705}, {"WHITE", 
      0.0118394}, {"WILLIAMS", 0.0116662}, {"THOMPSON", 
      0.0115507}, {"MARTIN", 0.0107421}, {"WALKER", 0.0106844}, {"MOORE", 
      0.0103956}, {"CLARK", 0.0102224}, {"YOUNG", 0.0101646}, {"MILLER", 
      0.0101646}, {"ROSS", 0.00987583}, {"ROBERTSON", 
      0.00981808}, {"REID", 0.00958706}, {"WRIGHT", 0.00918279}, {"KING", 
      0.00912504}, {"MURRAY", 0.00895178}, {"MITCHELL", 
      0.008432}, {"JOHNSTON", 0.00825874}, {"HALL", 
      0.00820098}, {"MORRISON", 0.00814323}};

Does Mathematica have a function that could help compare these two lists? I'm trying to think of a systematic way to establish that McDonald, for example, is under-represented in the war graves (4% of enlistees had the last name McDonald, whereas only 1.4% of dead did so). But since our lists are so long, would there be any way to do this systematically?

share|improve this question
Is it guaranteed that the names are unique in each list? (BTW, I'd suggest to use strings instead of symbols for the names) – celtschk Oct 25 '12 at 14:50
@celtschk I've generated the list from getting a long list of names (some 650k of them) and then Sorting and Tallying, like so: Sort[Sort[Tally[names[[All, 1]]]], #1[[2]] > #2[[2]] &]. So they should be unique? – ian.milligan Oct 25 '12 at 14:53
@celtschk And if I head the name, it's a string - I'm not 100% clear what you mean by symbols vs. strings. – ian.milligan Oct 25 '12 at 14:54
Yes, that should ensure that the names are unique. BTW, I notice that the first list contains MCDONALD while the second list contains McDONALD (note the case difference of the c). Given that otherwise everything is in uppercase, I guess that's an error. – celtschk Oct 25 '12 at 14:56
@celtschk Good catch - I've now put a ToUpperCase in my code that generated these lists. Thanks! – ian.milligan Oct 25 '12 at 14:58
show 9 more comments

3 Answers

up vote 7 down vote accepted

Gathering together the unique names from both lists using Union and then selecting the cases for each name from the atts list and the kia list, we can then associated the name with the two relevant percentages and replace missing names with zero precentage.

With[{names = Union[atts[[All, 1]], kia[[All, 1]]]}, 
     {#, Cases[atts, {#, _}], Cases[kia, {#, _}]} 
     /. {{} -> 0, {{_, x_?NumericQ}} -> x} & 
     /@ names
    ]

Gives the following:

{{ANDERSON, 0.0303276, 0.0127057}, {BELL, 0.0171914, 0}, {BROWN, 0.0555427, 0.0260468}, {CAMPBELL, 0.033398, 0.0166907}, {CLARK, 0.0237088, 0.0102224}, {DAVIS, 0.016728, 0}, {GRAHAM, 0.0172059, 0}, {HALL, 0.016699, 0.00820098}, {HILL, 0.017148, 0}, {JACKSON, 0.0175825, 0}, {JOHNSON, 0.0320656, 0.012417}, {JOHNSTON, 0.0212322, 0.00825874}, {JONES, 0.0375836, 0.0174415}, {KING, 0.0168149, 0.00912504}, {MACDONALD, 0.0224054, 0}, {MARTIN, 0.0279669, 0.0107421}, {McDONALD, 0, 0.0146694}, {MCDONALD, 0.0411175, 0}, {MCLEAN, 0.0169452, 0}, {MCLEOD, 0.0176839, 0}, {MILLER, 0.0240854, 0.0101646}, {MITCHELL, 0.0177273, 0.008432}, {MOORE, 0.0212177, 0.0103956}, {MORRISON, 0, 0.00814323}, {MURRAY, 0.0182053, 0.00895178}, {REID, 0.0173218, 0.00958706}, {ROBERTSON, 0.0181763, 0.00981808}, {ROBINSON, 0.0209426, 0}, {ROSS, 0.0196391, 0.00987583}, {SCOTT, 0.0257944, 0.0120705}, {SMITH, 0.10031, 0.0452787}, {STEWART, 0.0243606, 0.0123592}, {TAYLOR, 0.0356139, 0.0169217}, {THOMPSON, 0.0289952, 0.0115507}, {WALKER, 0.0216233, 0.0106844}, {WATSON, 0.0174811, 0}, {WHITE, 0.0250413, 0.0118394}, {WILLIAMS, 0.0298352, 0.0116662}, {WILSON, 0.0451438, 0.0195784}, {WOOD, 0.0167859, 0}, {WRIGHT, 0.018437, 0.00918279}, {YOUNG, 0.0211888, 0.0101646}}

share|improve this answer
This is better than the half finished answer I was working on. Nice! – David Slater Oct 25 '12 at 15:09
@DavidSlater diversity is a good thing, don't stop working :) – image_doctor Oct 25 '12 at 15:11
up vote 4 down vote

@image_doctor 's solution gives you a nicely formatted data set with which you can then start looking at the differences. For instance you can just compare the difference between the two percentages:

output = With[{names = Union[atts[[All, 1]], 
   kia[[All, 1]]]}, {#, Cases[atts, {#, _}], 
    Cases[kia, {#, _}]} /. {{} -> 0, {{_, x_?NumericQ}} -> x} & /@
  names];
output2 = Sort[{#[[1]], #[[2]] - #[[3]]} & /@ output, (#1[[2]] > #2[[2]]) &];


 BarChart[output2[[1 ;; 10, 2]], ChartStyle -> 20, 
          ChartLabels -> Placed[(output2[[1 ;; 10, 1]]), {{.75, 0}, {1, 1}},
          Rotate[#, Pi/3] &], BaseStyle -> 16]

enter image description here

share|improve this answer
up vote 4 down vote

Here's another way, which keeps the order of atts, and the order of kia for the elements not in atts (which get collected at the end):

combine[a_, k_] :=
  Join[Append[#, First[Cases[k, {#[[1]], v_}:>v] /. {}->{0}]]& /@ a,
       {#[[1]], 0, #[[2]]}& /@ Select[k, FreeQ[a, #[[1]] ]&]]

all = combine[atts, kia]
(*
==> {{"SMITH", 0.10031, 0.0452787}, {"BROWN", 0.0555427, 0.0260468}, 
     {"WILSON", 0.0451438, 0.0195784}, {"MCDONALD", 0.0411175, 0}, 
     {"JONES", 0.0375836, 0.0174415}, {"TAYLOR", 0.0356139, 0.0169217}, 
     {"CAMPBELL", 0.033398, 0.0166907}, {"JOHNSON", 0.0320656, 0.012417}, 
     {"ANDERSON", 0.0303276, 0.0127057}, {"WILLIAMS", 0.0298352, 0.0116662}, 
     {"THOMPSON", 0.0289952, 0.0115507}, {"MARTIN", 0.0279669, 0.0107421}, 
     {"SCOTT", 0.0257944, 0.0120705}, {"WHITE", 0.0250413, 0.0118394}, 
     {"STEWART", 0.0243606, 0.0123592}, {"MILLER", 0.0240854, 0.0101646}, 
     {"CLARK", 0.0237088, 0.0102224}, {"MACDONALD", 0.0224054, 0}, 
     {"WALKER", 0.0216233, 0.0106844}, {"JOHNSTON", 0.0212322, 0.00825874}, 
     {"MOORE", 0.0212177, 0.0103956}, {"YOUNG", 0.0211888, 0.0101646}, 
     {"ROBINSON", 0.0209426, 0}, {"ROSS", 0.0196391, 0.00987583}, 
     {"WRIGHT", 0.018437, 0.00918279}, {"MURRAY", 0.0182053, 0.00895178}, 
     {"ROBERTSON", 0.0181763, 0.00981808}, {"MITCHELL", 0.0177273, 0.008432}, 
     {"MCLEOD", 0.0176839, 0}, {"JACKSON", 0.0175825, 0}, 
     {"McDONALD", 0, 0.0146694}, {"REID", 0, 0.00958706}, 
     {"KING", 0, 0.00912504}, {"HALL", 0, 0.00820098}, 
     {"MORRISON", 0, 0.00814323}}
*)

To get from this list all those underrepresented in the war graves, you can do

underrep = Select[all, #[[2]] > #[[3]]&]
(*
==> {{"SMITH", 0.10031, 0.0452787}, {"BROWN", 0.0555427, 0.0260468}, 
     {"WILSON", 0.0451438, 0.0195784}, {"MCDONALD", 0.0411175, 0}, 
     {"JONES", 0.0375836, 0.0174415}, {"TAYLOR", 0.0356139, 0.0169217}, 
     {"CAMPBELL", 0.033398, 0.0166907}, {"JOHNSON", 0.0320656, 0.012417}, 
     {"ANDERSON", 0.0303276, 0.0127057}, {"WILLIAMS", 0.0298352, 0.0116662}, 
     {"THOMPSON", 0.0289952, 0.0115507}, {"MARTIN", 0.0279669, 0.0107421}, 
     {"SCOTT", 0.0257944, 0.0120705}, {"WHITE", 0.0250413, 0.0118394}, 
     {"STEWART", 0.0243606, 0.0123592}, {"MILLER", 0.0240854, 0.0101646}, 
     {"CLARK", 0.0237088, 0.0102224}, {"MACDONALD", 0.0224054, 0}, 
     {"WALKER", 0.0216233, 0.0106844}, {"JOHNSTON", 0.0212322, 0.00825874}, 
     {"MOORE", 0.0212177, 0.0103956}, {"YOUNG", 0.0211888, 0.0101646}, 
     {"ROBINSON", 0.0209426, 0}, {"ROSS", 0.0196391, 0.00987583}, 
     {"WRIGHT", 0.018437, 0.00918279}, {"MURRAY", 0.0182053, 0.00895178}, 
     {"ROBERTSON", 0.0181763, 0.00981808}, {"MITCHELL", 0.0177273, 0.008432}, 
     {"MCLEOD", 0.0176839, 0}, {"JACKSON", 0.0175825, 0}}
*)

Or if you only want their names:

First /@ underrep
(*
==> {"SMITH", "BROWN", "WILSON", "MCDONALD", "JONES", "TAYLOR", "CAMPBELL", 
     "JOHNSON", "ANDERSON", "WILLIAMS", "THOMPSON", "MARTIN", "SCOTT", "WHITE", 
     "STEWART", "MILLER", "CLARK", "MACDONALD", "WALKER", "JOHNSTON", "MOORE", 
     "YOUNG", "ROBINSON", "ROSS", "WRIGHT", "MURRAY", "ROBERTSON", "MITCHELL", 
     "MCLEOD", "JACKSON"}
*)
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.