let group_distances ?(commutative=true) f_key
      ~intra ~inter dm =
    let t = Hashtbl.create 13 in
    let add element ind =
      let key = f_key element in
      try
        let l = Hashtbl.find t key in
        Hashtbl.replace t key (ind :: l)
      with
        Not_found -> Hashtbl.add t key [ind]
    in
    Array.iteri
      (fun i element -> add element i)
      dm.dist_elements;

    let key_indices = Hashtbl.fold
        (fun key l acc -> Array.append [| key, l |] acc)
        t
        [| |]
    in
    let new_len = Array.length key_indices in
    let mat = Array.make_matrix
        new_len new_len dm.dist_matrix.(0).(0)
    in
    let new_elements = Array.map fst key_indices in
    let old_indices i = snd key_indices.(i) in
    for i = 0 to new_len - 1 do
      for j = i to new_len - 1 do
        let old_i_s = old_indices i in
        let old_j_s = old_indices j in
        let g_group = if i = j then intra else inter in
        let v =
          let ll_dists =
            List.map
              (fun oi ->
                List.map
                  (fun oj ->
                    dm.dist_matrix.(oi).(oj)
                  )
                  old_j_s
              )
              old_i_s
          in
          g_group ll_dists
        in
        mat.(i).(j) <- v;
        if i <> j then
          if commutative then
            mat.(j).(i) <- v
          else
            let v =
              let ll_dists =
                List.map
                  (fun oj ->
                    List.map
                      (fun oi ->
                        dm.dist_matrix.(oj).(oi)
                      )
                      old_i_s
                  )
                  old_j_s
              in
              inter ll_dists
            in
            mat.(j).(i) <- v
      done
    done;
    { dist_elements = new_elements ;
      dist_matrix = mat ;
      dist_samples =
      Array.map
        (fun (_,l) ->
          List.fold_left (fun acc i -> acc + dm.dist_samples.(i)) 0
            l
        )
        key_indices ;
    }