4
$\begingroup$

I'm new to Mathematica, coming from Python, and I'm having a hard time trying to build a matrix from relational data.

The data looks like this:

BOB,fr
STEVE,us
STEVE,gb
BOB,us

Which once imported look like this:

test = Import["test.csv"]

{{"BOB", "fr"}, {"STEVE", "us"}, {"STEVE", "gb"}, {"BOB", "us"}}

My aim is to reach this kind of format:

       fr   us   gb
BOB    1    1    0
STEVE  0    1    1

The only thing I managed to achieve, probably over-complicating (and slowing) the procedure is:

Function[y, {y, Counts[Select[test, Function[x, x[[1]] == y]][[All, 2]]]}] /@ deleteDuplicates[test[[All, 1]]] // TableForm

Which yields:

BOB    <|fr-> 1, us-> 1|>
STEVE  <|fr-> 1, gb-> 1|>

Please, what is the obvious thing I'm missing ? Any keyword or way of doing things I could look for ?

Thanks !

$\endgroup$
3
  • 4
    $\begingroup$ I guess, something like grp = Counts /@ GroupBy[test, First -> Last]; Dataset[AssociationThread[Keys[grp], KeyUnion[Values[grp], 0 &]]]? $\endgroup$ Apr 1, 2017 at 7:51
  • $\begingroup$ I learned quite a lot looking at the doc of every function you used, thanks very much ! $\endgroup$
    – sereizam
    Apr 1, 2017 at 8:09
  • $\begingroup$ It's a bit clunky, due to the need to decompose and recompose an Association[] just to be able to use KeyUnion[]. Somebody better than me should be able to come up with something slicker. $\endgroup$ Apr 1, 2017 at 8:14

4 Answers 4

5
$\begingroup$

Here is a way based upon GroupBy:

countTable[list_] :=
  GroupBy[
    KeyUnion[<| "" -> #[[1]], #[[2]] -> 1 |> & /@ list, 0&]
  , #[""]& -> KeyDrop[""]
  , Total
  ]

This presumes that there are no empty strings in the source data. The role played by "" could be filled equally well by 0, Null, {}, a symbol, or any other convenient unused value.

Usage:

test = {{"BOB", "fr"}, {"STEVE", "us"}, {"STEVE", "gb"}, {"BOB",  "us"}};

result = countTable[test]

(* <| "BOB"   -> <|"fr" -> 1, "us" -> 1, "gb" -> 0|>
    , "STEVE" -> <|"fr" -> 0, "us" -> 1, "gb" -> 1|>
    |>
*)

This representation is convenient for further querying:

result["STEVE"]
(* <|"fr" -> 0, "us" -> 1, "gb" -> 1|> *)

result["STEVE", "us"]
(* 1 *)

result[["STEVE", {"fr", "gb"}]]
(* <|"fr" -> 0, "gb" -> 1|> *)

We can use Dataset to visualize the result:

result // Dataset

dataset screenshot

The method accounts for duplicates within the source data:

test ~Join~ {{"STEVE", "us"}, {"BOB", "fr"}} // countTable // Dataset

dataset screenshot

$\endgroup$
3
  • $\begingroup$ Wow! $\phantom{}$ $\endgroup$ Apr 1, 2017 at 16:01
  • $\begingroup$ @J.M. Thanks. I quite liked your method too. $\endgroup$
    – WReach
    Apr 1, 2017 at 16:02
  • $\begingroup$ @J.M. Funny,why I cannot "Wow!"?And can you also "Wow" my answer? :) $\endgroup$
    – yode
    Apr 1, 2017 at 16:49
3
$\begingroup$
ClearAll[f]
f = Module[{e = Rule @@@ SortBy[#, { First, Last}], 
   v = DeleteDuplicates /@ Transpose[SortBy[#, {First, Last}]], l}, 
   l = Length /@ v;
   AdjacencyMatrix[Graph[Join @@ v, e]][[;; First@l, 1 + First@l ;;]]] &;

f@test // MatrixForm

Mathematica graphics

TableForm[Normal@f@test, 
  TableHeadings -> DeleteDuplicates /@ Transpose[SortBy[test, {First, Last}]]]

Mathematica graphics

test2 = Join[test, {{"ALICE", "hu"}, {"BOB", "ua"}}];

TableForm[Normal@f@test2, TableHeadings -> 
  DeleteDuplicates /@ Transpose[SortBy[test2, {First, Last}]]]

Mathematica graphics

Also

ClearAll[f2]
f2 = Module[{ff, a = DeleteDuplicates /@ Transpose[SortBy[#, {First, Last}]]}, 
    (ff[##] = 1) & @@@ #; ff[__] := 0; Outer[ff, First@a, Last@a]] &;

f2 @ test // MatrixForm

Mathematica graphics

f2 @ test2 // MatrixForm

Mathematica graphics

$\endgroup$
1
$\begingroup$
list={{"BOB","fr"},{"STEVE","us"},{"STEVE","gb"},{"BOB","us"}};    
pos = Flatten[Position[VertexList[Rule @@@ list], _String?#]] & /@ {UpperCaseQ,LowerCaseQ};
MatrixForm[AdjacencyMatrix[Rule @@@ list][[##]] & @@ pos]

$\endgroup$
0
$\begingroup$

We can also use Merge:

list = {{"BOB", "fr"}, {"STEVE", "us"}, {"STEVE", "gb"}, {"BOB", "us"}};

m = Merge[Apply @ Association] @ ReplaceAll[{a_, b_} :> {a -> {b -> 1}}] @ list

<|"BOB" -> <|"fr" -> 1, "us" -> 1|>, "STEVE" -> <|"us" -> 1, "gb" -> 1|>|>

Method 1

AssociationThread[Keys[m] -> KeyUnion[Values[m], 0 &]] // Dataset

enter image description here

Method 2

 Query[Transpose] @ m // Dataset

enter image description here

Query[Transpose] has automatically inserted the missing values!

Maybe this is the form we want, if not:

 Query[Transpose] @  m /. _Missing :> 0 // Query[Transpose] // Dataset

(* Output like Method 1 *)

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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