aboutsummaryrefslogtreecommitdiffstats
path: root/lib/prelude/standard.ml
blob: 572597807071bb576e295647ab1389584a4cf890 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
let less_than_natural: Relation.t =
  let rec generator (position: int option): Generator.result =
    let pair_of_nat n =
      let nf = float_of_int n in
      let r =
        int_of_float (floor ((1. +. sqrt (1. +. 8. *. nf)) /. 2.))
      in
      let t_prev = (r * (r - 1)) / 2 in
      let left = n - t_prev in
      (left, r) in
    match position with
    | Some position -> 
      let left, right = pair_of_nat position in
      let attributes: Attribute.materialized Tuple.AttributeMap.t =
        Tuple.AttributeMap.of_list [("left", Obj.magic left); ("right", Obj.magic right)]
      in Generator.Value (Tuple.make_materialized ~relation: "less_than" ~attributes: attributes, generator)
    | None -> Error "Cannot produce a randomly enumerated value for less_than over naturals."
  in let membership_criteria: Tuple.t -> bool = function 
        | Tuple.Materialized materialized -> 
            let left = Tuple.AttributeMap.find "left" materialized.attributes
            in let right = Tuple.AttributeMap.find "right" materialized.attributes
            in left < right
        | Tuple.NonMaterialized _non_materialized -> false (* TODO: Handle references later *)
  in Relation.make
    ~hash: None
    ~name: "natural_natural_less_than"
    ~schema: (Schema.empty |> Schema.add "left" "natural" |> Schema.add "right" "natural")
    ~tree: None
    ~constraints: None
    ~cardinality: Conventions.Cardinality.AlephZero
    ~generator: (Some generator)
    ~membership_criteria: membership_criteria
    ~provenance: (Relation.Provenance.Base "less_than")
    ~lineage: (Relation.Lineage.Base "less_than")