3
$\begingroup$

How can the Mathematica 11.3 module below be improved (it builds a frequency table)? The data source is a Dataset object (dbase) and the row/column variables are respectively rowDIN and colDIN. Here the table entries would give the grade distribution within subject.

Dataset's documentation has an example that suggests a solution (see the line titanic[GroupBy["sex"],GroupBy["class"],ratio,"survived"]). Although I've tweaked this to get the desired table, it works because the table has no zeros. When applied to another database whose table would have zeros, Mathematica doesn't return a table -- that's why I use Count below.

There must be an easier way, and hopefully someone here knows it. Thanks.

myTable[dbase_, rowDIN_, colDIN_] := Module[{
columns = Sort@Normal@DeleteDuplicates@dbase[[All, colDIN]],
group,
X = GroupBy[dbase, rowDIN]},   

X = (group = #; {group[[1, rowDIN]], 
    Count[Normal@group[[All, colDIN]], #] & /@ columns}) & /@ X;
X = X // Normal // Normal // Last /@ # &;
Grid@Prepend[Flatten /@ X, Prepend[columns, rowDIN]]];

myTable[schoolInfo, "Subject", "Grade"]

where

schoolInfo = Dataset@{<|"Subject" -> "XYZ", 
"Grade" -> "A"|>, <|"Subject" -> "XYZ", 
"Grade" -> "B"|>, <|"Subject" -> "XYZ", 
"Grade" -> "A"|>, <|"Subject" -> "ABC", 
"Grade" -> "A"|>, <|"Subject" -> "ABC", 
"Grade" -> "C"|>, <|"Subject" -> "ABC", 
"Grade" -> "C"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>}

(J.M., I'm sorry for posting the wrong dataset a moment ago. The above is correct.)

$\endgroup$
5
$\begingroup$

This is also a bit ugly, but at least it's short:

schoolInfo = Dataset @ {<|"Subject" -> "XYZ", "Grade" -> "A"|>,
                        <|"Subject" -> "XYZ", "Grade" -> "B"|>,
                        <|"Subject" -> "XYZ", "Grade" -> "A"|>,
                        <|"Subject" -> "ABC", "Grade" -> "A"|>,
                        <|"Subject" -> "ABC", "Grade" -> "C"|>,
                        <|"Subject" -> "ABC", "Grade" -> "C"|>,
                        <|"Subject" -> "ABC", "Grade" -> "A"|>};

grades = {"A", "B", "C", "D", "E", "F"};

schoolInfo[GroupBy["Subject"], 
           Lookup["Grade"] /* Counts /*
           (AssociationThread[grades, Lookup[#, grades, 0]] &)]

derived dataset

$\endgroup$
  • 1
    $\begingroup$ This is perhaps more readable (to my eyes at least): schoolInfo[GroupBy[Key["Subject"] ->Key["Grade"]], KeySort@Merge[{Counts[#], Thread[grades -> 0]}, First] &]. Or perhaps this: schoolInfo[GroupBy[Key["Subject"] -> Key["Grade"]], KeySort@Join[AssociationThread[grades, 0], Counts[#]] &] $\endgroup$ – b3m2a1 Mar 25 '18 at 3:08
  • $\begingroup$ Thanks J.M. This was the "raw Mathematica" that I was looking for. A friend (who has read these posts) has recently sent a merciful R solution that is tidy. $\endgroup$ – bcolletti Mar 25 '18 at 17:56
3
$\begingroup$

Transpose imputes Missing expressions so can commute around it with a numerical imputation using Replace:

transposeCommute[f_]:=Query[Transpose]/*f/*Query[Transpose[#1]&]

(note: as of 11.3 the slot lookup #1 is required to work around a bug in Dataset typesystem)

Then:

infoTable = schoolInfo[GroupBy["Subject"], GroupBy["Grade"], Length][
 transposeCommute[Query[All,KeySort, Replace[_Missing :> 0]]]]

enter image description here

If you want to add additional grades that don't appear anywhere in the input, another function is useful:

appendIfNoKey[key_->f_][as_Association]:=If[KeyExistsQ[as,key],as,Append[as,{key->f}]]

appendIfNoKey[ruleList_List][as_Association]:=Query[Apply[RightComposition][Map[appendIfNoKey][ruleList]]][as]

Then, to pad grades "A" through "F":

infoTable[All, appendIfNoKey[Thread[{"A", "B", "C", "E", "F"} -> 0]]]

enter image description here

So while there are gaps in the language, workarounds for such generic patterns are often 1-liners. These functions are from a API of mostly 1-liners to be bundled w/ a data science book I'm writing.

$\endgroup$
2
$\begingroup$

I am not sure is this a solution you are looking for, but you can use the package CrossTabulate.m:

schoolInfo = 
  Dataset@{<|"Subject" -> "XYZ", "Grade" -> "A"|>, <|
     "Subject" -> "XYZ", "Grade" -> "B"|>, <|"Subject" -> "XYZ", 
     "Grade" -> "A"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>, <|
     "Subject" -> "ABC", "Grade" -> "C"|>, <|"Subject" -> "ABC", 
     "Grade" -> "C"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>};

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/CrossTabulate.m"]

MatrixForm[CrossTabulate[schoolInfo]]

enter image description here

I consider the making of contingency tables to be a fundamental operation. More detailed explanations are given in the blog post "Contingency tables creation examples".

Update (2018-04-05)

Because the answers of @alancalvitti and @J.M. provide extensions of the columns of the contingency table with all grades (from "A" to "F") here is code to do that extension for my answer above.

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/SSparseMatrix.m"]

rct = ToSSparseMatrix[ct]
rct2 = ImposeColumnNames[rct, CharacterRange["A", "F"]]
MatrixForm[rct2]

enter image description here

(For details on SSparseMatrix see SSparseMatrix.pdf(GitHub) or this blog post.)

$\endgroup$
  • $\begingroup$ Thank you, Anton. I'll spend time looking at what you've created and then will use it. Although I was looking for ideas that J.M. and Dulgerci have provided, using your *.m file is the most expedient approach. I'll also look for other work you've created. See you again at WTC2018. $\endgroup$ – bcolletti Mar 25 '18 at 18:09
1
$\begingroup$

This might be ugly but here how I did.

schoolInfo = {<|"Subject" -> "XYZ", "Grade" -> "A"|>, <|
    "Subject" -> "XYZ", "Grade" -> "B"|>, <|"Subject" -> "XYZ", 
    "Grade" -> "A"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>, <|
    "Subject" -> "ABC", "Grade" -> "C"|>, <|"Subject" -> "ABC", 
    "Grade" -> "C"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>};

val = GatherBy[Values@schoolInfo, First];

Grid[Join @@ {{{"Subject", "A", "B", "C", "D", "E", "F"}}, 
   Table[Flatten@{val[[i, 1, 1]], 
      Map[Length, 
       Cases[val[[i]], #] & /@ {{_, "A"}, {_, "B"}, {_, "C"}, {_, 
          "D"}, {_, "E"}, {_, "F"}}, 2]}, {i, Length@val}]}, 
 Dividers -> {{2 -> Black}, {2 -> Black}}]

\begin{array}{c|cccccc} \text{Subject} & \text{A} & \text{B} & \text{C} & \text{D} & \text{E} & \text{F} \\ \hline \text{XYZ} & 2 & 1 & 0 & 0 & 0 & 0 \\ \text{ABC} & 2 & 0 & 2 & 0 & 0 & 0 \\ \end{array}

Edit Probably there is more fancy and easy way to do it. This is the first time I am working with Dataset

schoolInfo = {<|"Subject" -> "XYZ", "Grade" -> "A"|>, <|
    "Subject" -> "XYZ", "Grade" -> "B"|>, <|"Subject" -> "XYZ", 
    "Grade" -> "A"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>, <|
    "Subject" -> "ABC", "Grade" -> "C"|>, <|"Subject" -> "ABC", 
    "Grade" -> "C"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>};
val = GatherBy[Values@schoolInfo, First];
val2 = Flatten@{"Subject", 
    DeleteDuplicates@Flatten@val[[All, All, 2]]};

Grid[Join @@ {{val2}, 
   Table[Flatten@{val[[i, 1, 1]], 
      Map[Length, Cases[val[[i]], #] & /@ ({_, #} & /@ Rest@val2), 
       2]}, {i, Length@val}]}, 
 Dividers -> {{2 -> Black}, {2 -> Black}}]

\begin{array}{c|ccc} \text{Subject} & \text{A} & \text{B} & \text{C} \\ \hline \text{XYZ} & 2 & 1 & 0 \\ \text{ABC} & 2 & 0 & 2 \\ \end{array}

Here is different dataset:

schoolInfo = {<|"Subject" -> "XYZ", "Grade" -> "A"|>, <|
    "Subject" -> "XYZ", "Grade" -> "B"|>, <|"Subject" -> "XYZ", 
    "Grade" -> "A"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>, <|
    "Subject" -> "ABC", "Grade" -> "C"|>, <|"Subject" -> "ABC", 
    "Grade" -> "C"|>, <|"Subject" -> "ABC", "Grade" -> "A"|>, <|
    "Subject" -> "DEF", "Grade" -> "D"|>};

\begin{array}{c|cccc} \text{Subject} & \text{A} & \text{B} & \text{C} & \text{D} \\ \hline \text{XYZ} & 2 & 1 & 0 & 0 \\ \text{ABC} & 2 & 0 & 2 & 0 \\ \text{DEF} & 0 & 0 & 0 & 1 \\ \end{array}

$\endgroup$
  • $\begingroup$ Thank you, Okkes. Although I was looking for J.M.'s solution, your approach was very instructive (we're both learning how to use Datasets -- your code reinforced some concepts that I better appreciate now). $\endgroup$ – bcolletti Mar 25 '18 at 18:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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