 (defn- scan-relations [rels subgens table equiv n]
   (let [[table equiv]
         (reduce (fn [[t p] w] (scan t p w n)) [table equiv] rels)]
-    (reduce (fn [[t p] w] (scan t p w (pfind equiv 0))) [table equiv] subgens)))
+    (reduce (fn [[t p] w] (scan t p w (equiv 0))) [table equiv] subgens)))
 
 (defn- compressed-table [table equiv]
-  (let [reps (into #{} (filter #(= % (pfind equiv %)) (keys table)))
+  (let [reps (into #{} (filter #(= % (equiv %)) (keys table)))
         rep-to-idx (into {} (map vector reps (range)))
-        canon (comp rep-to-idx (partial pfind equiv))]
+        canon (comp rep-to-idx equiv)]
     (into {} (for [[i row] table :when (reps i)]
                [(canon i) (into {} (map (fn [[j v]] [j (canon v)]) row))]))))
+
+(defn- maybe-compressed [table equiv factor]
+  (let [nr-invalid (- (reduce + (map count equiv)) (count equiv))]
+    (if (> nr-invalid (* factor (count table)))
+      (compressed-table [table equiv])
+      [table equiv])))
 
 (defn coset-table [nr-gens relators subgroup-gens]
   (let [with-inverses (fn [ws] (vec (into #{} (concat ws (map inverse ws)))))

      (cond (>= i (count table))
            (compressed-table table equiv)
            
            (or (>= j (count gens)) (not= i (pfind equiv i)))
            (recur table equiv (inc i) 0)
            
            ((table i) (get gens j))

        row-a (merge (table a) (table b))
        row-b (merge (table b) (table a))
        q (into q (for [g (keys row-a)
                        :when (not= (equiv (row-a g)) (equiv (row-b g)))]
                    [(row-a g) (row-b g)]))
        table (conj table [a row-a] [b row-a])]
    [table q]))
