
Data Structure

This illustrates a data structure, a means of storing data within a program.

You may see other such structures in the Data Structures category.
A   set  is a collection of elements, without duplicates and without order.



Task

Show each of these set operations:

 Set creation
 Test m ∈ S -- "m is an element in set S"
 A ∪ B -- union; a set of all elements either in set A or in set B.
 A ∩ B -- intersection; a set of all elements in both set A and set B.
 A ∖ B -- difference; a set of all elements in set A, except those in set B.
 A ⊆ B -- subset; true if every element in set A is also in set B.
 A = B -- equality; true if every element of set A is in set B and vice versa.


As an option, show some other set operations.

(If A ⊆ B, but A ≠ B, then A is called a true or proper subset of B, written A ⊂ B or A ⊊ B.)

As another option, show how to modify a mutable set.



One might implement a set using an associative array (with set elements as array keys and some dummy value as the values).

One might also implement a set with a binary search tree, or with a hash table, or with an ordered array of binary bits (operated on with bit-wise binary operators).

The basic test, m ∈ S, is O(n) with a sequential list of elements, O(log n) with a balanced binary search tree, or (O(1) average-case, O(n) worst case) with a hash table.



See also

 Array
 Associative array: Creation, Iteration
 Collections
 Compound data type
 Doubly-linked list: Definition, Element definition, Element insertion, List Traversal, Element Removal
 Linked list
 Queue: Definition, Usage
 Set
 Singly-linked list: Element definition, Element insertion, List Traversal, Element Removal
 Stack


(*------------------------------------------------------------------*)
 
#define ATS_DYNLOADFLAG 0
 
#include "share/atspre_staload.hats"
 
(*------------------------------------------------------------------*)
(* String hashing using XXH3_64bits from the xxHash suite.          *)
 
#define ATS_EXTERN_PREFIX "hashsets_postiats_"
 
%{^ /* Embedded C code. */
 
#include <xxhash.h>
 
ATSinline() atstype_uint64
hashsets_postiats_mem_hash (atstype_ptr data, atstype_size len)
{
  return (atstype_uint64) XXH3_64bits (data, len);
}
 
%}
 
extern fn mem_hash : (ptr, size_t) -<> uint64 = "mac#%"
 
fn
string_hash (s : string) :<> uint64 =
  let
    val len = string_length s
  in
    mem_hash ($UNSAFE.cast{ptr} s, len)
  end
 
(*------------------------------------------------------------------*)
(* A trimmed down version of the AVL trees from the AVL Tree task.  *)
 
datatype bal_t =
| bal_minus1
| bal_zero
| bal_plus1
 
datatype avl_t (key_t  : t@ype+,
                data_t : t@ype+,
                size   : int) =
| avl_t_nil (key_t, data_t, 0)
| {size_L, size_R : nat}
  avl_t_cons (key_t, data_t, size_L + size_R + 1) of
    (key_t, data_t, bal_t,
     avl_t (key_t, data_t, size_L),
     avl_t (key_t, data_t, size_R))
typedef avl_t (key_t  : t@ype+,
               data_t : t@ype+) =
  [size : int] avl_t (key_t, data_t, size)
 
extern fun {key_t : t@ype}
avl_t$compare (u : key_t, v : key_t) :<> int
 
#define NIL avl_t_nil ()
#define CONS avl_t_cons
#define LNIL list_nil ()
#define :: list_cons
#define F false
#define T true
 
typedef fixbal_t = bool
 
prfn
lemma_avl_t_param {key_t : t@ype} {data_t : t@ype} {size : int}
                  (avl : avl_t (key_t, data_t, size)) :<prf>
    [0 <= size] void =
  case+ avl of NIL => () | CONS _ => ()
 
fn {}
minus_neg_bal (bal : bal_t) :<> bal_t =
  case+ bal of
  | bal_minus1 () => bal_plus1
  | _ => bal_zero ()
 
fn {}
minus_pos_bal (bal : bal_t) :<> bal_t =
  case+ bal of
  | bal_plus1 () => bal_minus1
  | _ => bal_zero ()
 
fn
avl_t_is_empty {key_t : t@ype} {data_t : t@ype} {size   : int}
               (avl : avl_t (key_t, data_t, size)) :<>
    [b : bool | b == (size == 0)] bool b =
  case+ avl of
  | NIL => T
  | CONS _ => F
 
fn
avl_t_isnot_empty {key_t : t@ype} {data_t : t@ype} {size   : int}
                  (avl : avl_t (key_t, data_t, size)) :<>
    [b : bool | b == (size <> 0)] bool b =
  ~avl_t_is_empty avl
 
fn {key_t : t@ype} {data_t : t@ype}
avl_t_search_ref {size  : int}
                 (avl   : avl_t (key_t, data_t, size),
                  key   : key_t,
                  data  : &data_t? >> opt (data_t, found),
                  found : &bool? >> bool found) :<!wrt>
    #[found : bool] void =
  let
    fun
    search (p     : avl_t (key_t, data_t),
            data  : &data_t? >> opt (data_t, found),
            found : &bool? >> bool found) :<!wrt,!ntm>
        #[found : bool] void =
      case+ p of
      | NIL =>
        {
          prval _ = opt_none {data_t} data
          val _ = found := F
        }
      | CONS (k, d, _, left, right) =>
        begin
          case+ avl_t$compare<key_t> (key, k) of
          | cmp when cmp < 0 => search (left, data, found)
          | cmp when cmp > 0 => search (right, data, found)
          | _ =>
            {
              val _ = data := d
              prval _ = opt_some {data_t} data
              val _ = found := T
            }
        end
  in
    $effmask_ntm search (avl, data, found)
  end
 
fn {key_t : t@ype} {data_t : t@ype}
avl_t_search_opt {size : int}
                 (avl  : avl_t (key_t, data_t, size),
                  key  : key_t) :<>
    Option (data_t) =
  let
    var data : data_t?
    var found : bool?
    val _ = $effmask_wrt avl_t_search_ref (avl, key, data, found)
  in
    if found then
      let
        prval _ = opt_unsome data
      in
        Some {data_t} data
      end
    else
      let
        prval _ = opt_unnone data
      in
        None {data_t} ()
      end
  end
 
fn {key_t : t@ype} {data_t : t@ype}
avl_t_insert_or_replace {size : int}
                        (avl  : avl_t (key_t, data_t, size),
                         key  : key_t,
                         data : data_t) :<>
    [sz : pos] (avl_t (key_t, data_t, sz), bool) =
  let
    fun
    search {size   : nat}
           (p      : avl_t (key_t, data_t, size),
            fixbal : fixbal_t,
            found  : bool) :<!ntm>
        [sz : pos]
        (avl_t (key_t, data_t, sz), fixbal_t, bool) =
      case+ p of
      | NIL => (CONS (key, data, bal_zero, NIL, NIL), T, F)
      | CONS (k, d, bal, left, right) =>
        case+ avl_t$compare<key_t> (key, k) of
        | cmp when cmp < 0 =>
          let
            val (p1, fixbal, found) = search (left, fixbal, found)
          in
            case+ (fixbal, bal) of
            | (F, _) => (CONS (k, d, bal, p1, right), F, found)
            | (T, bal_plus1 ()) =>
              (CONS (k, d, bal_zero (), p1, right), F, found)
            | (T, bal_zero ()) =>
              (CONS (k, d, bal_minus1 (), p1, right), fixbal, found)
            | (T, bal_minus1 ()) =>
              let
                val+ CONS (k1, d1, bal1, left1, right1) = p1
              in
                case+ bal1 of
                | bal_minus1 () =>
                  let
                    val q = CONS (k, d, bal_zero (), right1, right)
                    val q1 = CONS (k1, d1, bal_zero (), left1, q)
                  in
                    (q1, F, found)
                  end
                | _ =>
                  let
                    val p2 = right1
                    val- CONS (k2, d2, bal2, left2, right2) = p2
                    val q = CONS (k, d, minus_neg_bal bal2,
                                  right2, right)
                    val q1 = CONS (k1, d1, minus_pos_bal bal2,
                                   left1, left2)
                    val q2 = CONS (k2, d2, bal_zero (), q1, q)
                  in
                    (q2, F, found)
                  end
              end
          end
        | cmp when cmp > 0 =>
          let
            val (p1, fixbal, found) = search (right, fixbal, found)
          in
            case+ (fixbal, bal) of
            | (F, _) => (CONS (k, d, bal, left, p1), F, found)
            | (T, bal_minus1 ()) =>
              (CONS (k, d, bal_zero (), left, p1), F, found)
            | (T, bal_zero ()) =>
              (CONS (k, d, bal_plus1 (), left, p1), fixbal, found)
            | (T, bal_plus1 ()) =>
              let
                val+ CONS (k1, d1, bal1, left1, right1) = p1
              in
                case+ bal1 of
                | bal_plus1 () =>
                  let
                    val q = CONS (k, d, bal_zero (), left, left1)
                    val q1 = CONS (k1, d1, bal_zero (), q, right1)
                  in
                    (q1, F, found)
                  end
                | _ =>
                  let
                    val p2 = left1
                    val- CONS (k2, d2, bal2, left2, right2) = p2
                    val q = CONS (k, d, minus_pos_bal bal2,
                                  left, left2)
                    val q1 = CONS (k1, d1, minus_neg_bal bal2,
                                   right2, right1)
                    val q2 = CONS (k2, d2, bal_zero (), q, q1)
                  in
                    (q2, F, found)
                  end
              end
          end
        | _ => (CONS (key, data, bal, left, right), F, T)
  in
    if avl_t_is_empty avl then
      (CONS (key, data, bal_zero, NIL, NIL), F)
    else
      let
        prval _ = lemma_avl_t_param avl
        val (avl, _, found) = $effmask_ntm search (avl, F, F)
      in
        (avl, found)
      end
  end
 
fn {key_t : t@ype} {data_t : t@ype}
avl_t_insert {size : int}
             (avl  : avl_t (key_t, data_t, size),
              key  : key_t,
              data : data_t) :<>
    [sz : pos] avl_t (key_t, data_t, sz) =
  (avl_t_insert_or_replace<key_t><data_t> (avl, key, data)).0
 
fun {key_t : t@ype} {data_t : t@ype}
push_all_the_way_left (stack : List (avl_t (key_t, data_t)),
                       p     : avl_t (key_t, data_t)) :
    List0 (avl_t (key_t, data_t)) =
  let
    prval _ = lemma_list_param stack
  in
    case+ p of
    | NIL => stack
    | CONS (_, _, _, left, _) =>
      push_all_the_way_left (p :: stack, left)
  end
 
fun {key_t : t@ype} {data_t : t@ype}
update_generator_stack (stack     : List (avl_t (key_t, data_t)),
                        right     : avl_t (key_t, data_t)) :
    List0 (avl_t (key_t, data_t)) =
  let
    prval _ = lemma_list_param stack
  in
    if avl_t_is_empty right then
      stack
    else
      push_all_the_way_left<key_t><data_t> (stack, right)
  end
 
fn {key_t : t@ype} {data_t : t@ype}
avl_t_make_data_generator {size : int}
                          (avl  : avl_t (key_t, data_t, size)) :
    () -<cloref1> Option data_t =
  let
    typedef avl_t = avl_t (key_t, data_t)
 
    val stack = push_all_the_way_left<key_t><data_t> (LNIL, avl)
    val stack_ref = ref stack
 
    (* Cast stack_ref to its (otherwise untyped) pointer, so it can be
       enclosed within ‘generate’. *)
    val p_stack_ref = $UNSAFE.castvwtp0{ptr} stack_ref
 
    fun
    generate () :<cloref1> Option data_t =
      let
        (* Restore the type information for stack_ref. *)
        val stack_ref =
          $UNSAFE.castvwtp0{ref (List avl_t)} p_stack_ref
 
        var stack : List0 avl_t = !stack_ref
        var retval : Option data_t
      in
        begin
          case+ stack of
          | LNIL => retval := None ()
          | p :: tail =>
            let
              val- CONS (_, d, _, left, right) = p
            in
              retval := Some d;
              stack :=
                update_generator_stack<key_t><data_t> (tail, right)
            end
        end;
        !stack_ref := stack;
        retval
      end
  in
    generate
  end
 
(*------------------------------------------------------------------*)
(* Sets implemented with a hash function, AVL trees and association *)
(* lists.                                                           *)
 
(* The interface  - - - - - - - - - - - - - - - - - - - - - - - - - *)
 
(* For simplicity, let us support only 64-bit hashes. *)
 
typedef hashset_t (key_t : t@ype+) =
  avl_t (uint64, List1 key_t)
 
extern fun {key_t : t@ype}  (* Implement a hash function with this. *)
hashset_t$hashfunc : key_t -<> uint64
 
extern fun {key_t : t@ype}     (* Implement key equality with this. *)
hashset_t$key_eq : (key_t, key_t) -<> bool
 
extern fun
hashset_t_nil :
  {key_t : t@ype}
  () -<> hashset_t key_t
 
extern fun {key_t : t@ype}
hashset_t_add_member :
  (hashset_t key_t, key_t) -<> hashset_t key_t
 
(*
"remove_member" is not implemented here, because the trimmed down AVL
tree implementation above does not include deletion. We shall
implement everything else without using a member deletion routine.
 
extern fun {key_t : t@ype}
hashset_t_remove_member :
  (hashset_t key_t, key_t) -<> hashset_t key_t
 
Of course you can remove a member by using hashset_t_difference.
*)
 
extern fun {key_t : t@ype}
hashset_t_has_member :
  (hashset_t key_t, key_t) -<> bool
 
typedef hashset_t_binary_operation (key_t : t@ype) =
  (hashset_t key_t, hashset_t key_t) -> hashset_t key_t
 
extern fun {key_t : t@ype}
hashset_t_union : hashset_t_binary_operation key_t
 
extern fun {key_t : t@ype}
hashset_t_intersection : hashset_t_binary_operation key_t
 
extern fun {key_t : t@ype}
hashset_t_difference : hashset_t_binary_operation key_t
 
extern fun {key_t : t@ype}
hashset_t_subset :
  (hashset_t key_t, hashset_t key_t) -> bool
 
extern fun {key_t : t@ype}
hashset_t_equal :
  (hashset_t key_t, hashset_t key_t) -> bool
 
(* Note: generators for hashset_t produce their output in unspecified
         order. *)
extern fun {key_t : t@ype}
hashset_t_make_generator :
  hashset_t key_t -> () -<cloref1> Option key_t
 
(* The implementation - - - - - - - - - - - - - - - - - - - - - - - *)
 
(* I make no promises that these are the most efficient
   implementations I could devise. They certainly are not! But they
   were easy to write and will work. *)
 
implement
hashset_t_nil () =
  avl_t_nil ()
 
fun {key_t  : t@ype}
find_key {n : nat} .<n>.
         (lst : list (key_t, n),
          key : key_t) :<>
    List0 key_t =
  (* This implementation is tail recursive. It will not build up the
     stack. *)
  case+ lst of
  | list_nil () => lst
  | list_cons (head, tail) =>
    if hashset_t$key_eq<key_t> (key, head) then
      lst
    else
      find_key (tail, key)
 
implement {key_t}
hashset_t_add_member (set, key) =
  (* The following implementation assumes equal keys are
     interchangeable. *)
  let
    implement
    avl_t$compare<uint64> (u, v) =
      if u < v then ~1 else if v < u then 1 else 0
    typedef lst_t = List1 key_t
    val hash = hashset_t$hashfunc<key_t> key
    val lst_opt = avl_t_search_opt<uint64><lst_t> (set, hash)
  in
    case+ lst_opt of
    | Some lst =>
      begin
        case+ find_key<key_t> (lst, key) of
        | list_cons _ => set
        | list_nil () =>
          avl_t_insert<uint64><lst_t>
            (set, hash, list_cons (key, lst))
      end
    | None () =>
      avl_t_insert<uint64><lst_t>
        (set, hash, list_cons (key, list_nil ()))
  end
 
implement {key_t}
hashset_t_has_member (set, key) =
  let
    implement
    avl_t$compare<uint64> (u, v) =
      if u < v then ~1 else if v < u then 1 else 0
    typedef lst_t = List1 key_t
    val hash = hashset_t$hashfunc<key_t> key
    val lst_opt = avl_t_search_opt<uint64><lst_t> (set, hash)
  in
    case+ lst_opt of
    | None () => false
    | Some lst =>
      begin
        case+ find_key<key_t> (lst, key) of
        | list_nil () => false
        | list_cons _ => true
      end
  end
 
implement {key_t}
hashset_t_union (u, v) =
  let
    val gen_u = hashset_t_make_generator<key_t> u
    val gen_v = hashset_t_make_generator<key_t> v
    var w : hashset_t key_t = hashset_t_nil ()
    var k_opt : Option key_t
  in
    for (k_opt := gen_u (); option_is_some k_opt; k_opt := gen_u ())
      w := hashset_t_add_member (w, option_unsome k_opt);
    for (k_opt := gen_v (); option_is_some k_opt; k_opt := gen_v ())
      w := hashset_t_add_member (w, option_unsome k_opt);
    w
  end
 
implement {key_t}
hashset_t_intersection (u, v) =
  let
    val gen_u = hashset_t_make_generator<key_t> u
    var w : hashset_t key_t = hashset_t_nil ()
    var k_opt : Option key_t
  in
    for (k_opt := gen_u (); option_is_some k_opt; k_opt := gen_u ())
      let
        val+ Some k = k_opt
      in
        if hashset_t_has_member<key_t> (v, k) then
          w := hashset_t_add_member (w, k)
      end;
    w
  end
 
implement {key_t}
hashset_t_difference (u, v) =
  let
    val gen_u = hashset_t_make_generator<key_t> u
    var w : hashset_t key_t = hashset_t_nil ()
    var k_opt : Option key_t
  in
    for (k_opt := gen_u (); option_is_some k_opt; k_opt := gen_u ())
      let
        val+ Some k = k_opt
      in
        if ~hashset_t_has_member<key_t> (v, k) then
          w := hashset_t_add_member (w, k)
      end;
    w
  end
 
implement {key_t}
hashset_t_subset (u, v) =
  let
    val gen_u = hashset_t_make_generator<key_t> u
    var subset : bool = true
    var done : bool = false
  in
    while (~done)
      case+ gen_u () of
      | None () => done := true
      | Some k =>
        if ~hashset_t_has_member<key_t> (v, k) then
          begin
            subset := false;
            done := true
          end;
    subset
  end
 
implement {key_t}
hashset_t_equal (u, v) =
  hashset_t_subset<key_t> (u, v)
    && hashset_t_subset<key_t> (v, u)
 
implement {key_t}
hashset_t_make_generator (set) =
  let
    typedef lst_t = List1 key_t
    typedef lst_t_0 = List0 key_t
 
    val avl_gen = avl_t_make_data_generator<uint64><lst_t> (set)
 
    val current_list_ref : ref lst_t_0 = ref (list_nil ())
    val current_list_ptr =
      $UNSAFE.castvwtp0{ptr} current_list_ref
  in
    lam () =>
      let
        val current_list_ref =
          $UNSAFE.castvwtp0{ref lst_t_0} current_list_ptr
      in
        case+ !current_list_ref of
        | list_nil () =>
          begin
            case+ avl_gen () of
            | None () => None ()
            | Some lst =>
              begin
                case+ lst of
                | list_cons (head, tail) =>
                  begin
                    !current_list_ref := tail;
                    Some head
                  end
              end
          end
        | list_cons (head, tail) =>
          begin
            !current_list_ref := tail;
            Some head
          end
      end
  end
 
(*------------------------------------------------------------------*)
 
implement
hashset_t$hashfunc<string> (s) =
  string_hash s
 
implement
hashset_t$key_eq<string> (s, t) =
  s = t
 
typedef strset_t = hashset_t string
 
fn {}
strset_t_nil () :<> strset_t =
  hashset_t_nil ()
 
fn
strset_t_add_member (set    : strset_t,
                     member : string) :<> strset_t =
  hashset_t_add_member<string> (set, member)
 
fn {}
strset_t_member_add (member : string,
                     set    : strset_t) :<> strset_t =
  strset_t_add_member (set, member)
 
#define SNIL strset_t_nil ()
infixr ( :: ) ++        (* Right associative, same precedence as :: *)
overload ++ with strset_t_member_add
 
fn
strset_t_has_member (set    : strset_t,
                     member : string) :<> bool =
  hashset_t_has_member<string> (set, member)
overload [] with strset_t_has_member
 
fn
strset_t_union (u : strset_t, v : strset_t) : strset_t =
  hashset_t_union<string> (u, v)
overload + with strset_t_union
 
fn
strset_t_intersection (u : strset_t, v : strset_t) : strset_t =
  hashset_t_intersection<string> (u, v)
infixl ( + ) ^
overload ^ with strset_t_intersection
 
fn
strset_t_difference (u : strset_t, v : strset_t) : strset_t =
  hashset_t_difference<string> (u, v)
overload - with strset_t_difference
 
fn
strset_t_subset (u : strset_t, v : strset_t) : bool =
  hashset_t_subset<string> (u, v)
overload <= with strset_t_subset
 
fn
strset_t_equal (u : strset_t, v : strset_t) : bool =
  hashset_t_equal<string> (u, v)
overload = with strset_t_equal
 
fn
strset_t_make_generator (set : strset_t) :
    () -<cloref1> Option string =
  hashset_t_make_generator<string> set
 
fn
strset_t_print (set : strset_t) : void =
  let
    val gen = strset_t_make_generator set
    var s_opt : Option string
    var separator : string = ""
  in
    print! ("#<strset_t ");
    for (s_opt := gen (); option_is_some s_opt; s_opt := gen ())
      case+ s_opt of
      | Some s =>
        begin
          (* The following quick and dirty implemenetation does not
             insert escape sequences. *)
          print! (separator, "\"", s, "\"");
          separator := " "
        end;
    print! (">")
  end
 
implement
main0 () =
  let
    val set1 =
      "one" ++ "two" ++ "three" ++ "guide" ++ "design" ++ SNIL
    val set2 =
      "ett" ++ "två" ++ "tre" ++ "guide" ++ "design" ++ SNIL
  in
    print! ("set1 = ");
    strset_t_print set1;
 
    println! ();
    println! ();
    println! ("set1[\"one\"] = ", set1["one"]);
    println! ("set1[\"two\"] = ", set1["two"]);
    println! ("set1[\"three\"] = ", set1["three"]);
    println! ("set1[\"four\"] = ", set1["four"]);
 
    println! ();
    print! ("set2 = ");
    strset_t_print set2;
 
    println! ();
    println! ();    
    println! ("set2[\"ett\"] = ", set2["ett"]);
    println! ("set2[\"två\"] = ", set2["två"]);
    println! ("set2[\"tre\"] = ", set2["tre"]);
    println! ("set2[\"fyra\"] = ", set2["fyra"]);
 
    println! ();
    print! ("Union\nset1 + set2 = ");
    strset_t_print (set1 + set2);
    println! ();
 
    println! ();
    print! ("Intersection\nset1 ^ set2 = ");
    strset_t_print (set1 ^ set2);
    println! ();
 
    println! ();
    print! ("Difference\nset1 - set2 = ");
    strset_t_print (set1 - set2);
    println! ();
 
    println! ();
    println! ("Subset");
    println! ("set1 <= set1: ", set1 <= set1);
    println! ("set2 <= set2: ", set2 <= set2);
    println! ("set1 <= set2: ", set1 <= set2);
    println! ("set2 <= set1: ", set2 <= set1);
    println! ("(set1 ^ set2) <= set1: ", (set1 ^ set2) <= set1);
    println! ("(set1 ^ set2) <= set2: ", (set1 ^ set2) <= set2);
 
    println! ();
    println! ("Equal");
    println! ("set1 = set1: ", set1 = set1);
    println! ("set2 = set2: ", set2 = set2);
    println! ("set1 = set2: ", set1 = set2);
    println! ("set2 = set1: ", set2 = set1);
    println! ("(set1 ^ set2) = (set2 ^ set1): ",
              (set1 ^ set2) = (set2 ^ set1));
    println! ("(set1 ^ set2) = set1: ", (set1 ^ set2) = set1);
    println! ("(set1 ^ set2) = set2: ", (set1 ^ set2) = set2)
  end
 
(*------------------------------------------------------------------*)