Commits

Joby Poriyath  committed 664685a

need to work on database applications (ch6)

  • Participants
  • Parent commits e86bac8

Comments (0)

Files changed (1)

+(* utility functions *)
+
+let is_whitespace = function
+  | ' ' | '\n' | '\t' | '\r' -> true
+  | _ -> false
+
+let split_on fn s =
+  let s_len = String.length s in
+  let rec sub_string lst i j =
+    if j == s_len then String.sub s i (j - i) :: lst
+    else if fn (s.[j]) then sub_string (String.sub s i (j - i) :: lst) (j + 1) (j + 1)
+    else sub_string lst i (j + 1)
+  in
+  List.rev (sub_string [] 0 0)
+
+(* Same as Python's split *)
+let split s = List.filter (function s -> s <> "") (split_on is_whitespace s)
+
+let strip s =
+  let s_len = String.length s in
+  let rec index_l i =
+    if i = s_len then (i - 1) 
+    else if is_whitespace (s.[i]) then index_l (i + 1)
+    else i in
+  let rec index_r i j = 
+    if (j = i) then j
+    else if j <= 0 then 0
+    else if is_whitespace (s.[j]) then index_r i (j - 1)
+    else j + 1 in
+  let i = index_l 0 in
+  let j = index_r i (s_len - 1) in
+  if s = "" then "" else String.sub s i (j - i)
+  
+
+let rec join s = function
+  | [] -> ""
+  | (w::ws) -> (w ^ s) ^ join s ws
+
+(* end of utility functions *)
+
+
+type data_card = string array
+type data_base = {card_index : string -> int; data : data_card list}
+
+let field db n (dc : data_card) = dc.(db.card_index n)
+
+let mk_index lst =
+  let enum lst = 
+    let rec enum_aux i = function 
+      | [] -> []
+      | (w::ws) -> (w, i) :: enum_aux (i + 1) ws
+    in enum_aux 0 lst in
+  let enum_names = enum lst in
+  function name -> List.assoc name enum_names
+
+
+let read_db db_file =
+  let channel = open_in db_file in
+  let index = mk_index (split_on (fun c -> c = '|') (input_line channel)) in
+  let rec read_file lst =
+    try
+      let line = input_line channel in
+      let dc = Array.of_list (split_on (fun c -> c = ':') line) in
+      read_file (dc :: lst)
+    with End_of_file -> close_in channel; List.rev lst in
+  let dc_lst = read_file [] in
+  {card_index = index; data = dc_lst}
+
+let base_ex = read_db "ch6_db.dat"
+
+(* 
+   The goal of database processing is to obtain a state of the database.
+   Building such a state may be decomposed into three steps:
+
+   1. Select according to some criteria, a set of data cards.
+   2. Process each of the selected cards
+   3. Process all the data collected from the cards.
+
+   According to this decomposition, we need three functions of the following
+   types:
+   
+   1. (data_card -> bool) -> data_card list -> data_card list
+   2. (data_card -> 'a) -> data_card list -> 'a list
+   3. ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
+
+   List.find_all;
+   List.map;
+   List.fold_right
+
+*)
+
+(*
+  Selecting on some field is usually done using a function of type 
+  
+  data_base -> 'a -> string -> data_card -> bool
+
+  The 'a type parameter corresponds to the type of the information 
+  contained in the field. The string argument corresponds to name
+  of the field.
+*)
+
+(* We define two simple tests on strings: equlity with another string, non-emptiness *)
+
+let eq_sfield db s n =
+  function (dc : data_card) -> (dc.(db.card_index n) = s)
+
+let nonempty_sfield db n = 
+  function (dc : data_card) -> (dc.(db.card_index n) <> "")
+
+(* Float fields *)
+
+let tst_ffield (r : float -> float -> bool) db v n (dc : data_card) =
+  r v (float_of_string dc.(db.card_index n))
+
+let eq_ffield = tst_ffield (=)
+let lt_ffield = tst_ffield (<)
+let le_ffield = tst_ffield (<=)
+
+(* Dates  (e.g "18.08.1980") *)
+
+let split_date = split_on (fun c -> c = '.')
+
+let ints_of_string s = 
+  try
+    match (split_date s) with
+      | [_;_;_] as d -> List.rev (List.map (function "_" -> 0 | i -> int_of_string i) d)
+      | _ -> failwith "Bad date format"
+  with Failure "int_of_string" -> failwith "Bad date format"
+
+type date_cmp = LT | EQ | GT 
+
+let rec dt_cmp d1 d2 =
+  match (d1, d2) with
+    | ([], []) -> EQ
+    | (0::l1, _::l2) -> dt_cmp l1 l2
+    | (_::l1, 0::l2) -> dt_cmp l1 l2
+    | (n1::l1, n2::l2) -> 
+      if n1 < n2 then LT 
+      else if n1 > n2 then GT
+      else dt_cmp l1 l2
+    | (_, _) -> failwith "Bad date format or pattern"
+
+let tst_dfield r db dp n (dc : data_card) = 
+  r (dt_cmp (ints_of_string (dc.(db.card_index n))) (ints_of_string dp))
+
+let eq_dfield = tst_dfield (function EQ -> true | _ -> false)
+let lt_dfield = tst_dfield (function LT -> true | _ -> false)
+let gt_dfield = tst_dfield (function GT -> true | _ -> false)
+let le_dfield = tst_dfield (function LT|EQ -> true | _ -> false)
+let ge_dfield = tst_dfield (function GT|EQ -> true | _ -> false)
+
+
+(* fold_funs:  b = base value
+               c = boolean operator
+              fs = list of (data_card -> bool) functions
+*)
+let fold_funs (b : bool) (c : bool -> bool -> bool) fs (dc : data_card) =
+  List.fold_right (fun f -> fun r -> c (f dc) r) fs b
+
+let and_fold fs = fold_funs true (&&) fs
+let or_fold fs = fold_funs false (||) fs
+
+let date_interval db d1 d2 =
+  and_fold [(ge_dfield db d1 "Date"); (le_dfield db d2 "Date")]
+
+let str_join c lst = 
+  let s = String.make 1 c in
+  List.fold_left (fun x y -> if x = "" then y else x ^ s ^ y) "" lst
+
+let extract_fields db ns dc = 
+  List.map (fun n -> field db n dc) ns
+
+let format_line db ns dc =
+  String.uppercase (field db "Lastname" dc) ^ " "
+  ^ (field db "Firstname" dc) ^ " " ^ (str_join ' ' (extract_fields db ns dc)) ^ "\n"
+
+
+let (++) f g x = g (f x)
+
+let total db dcs = 
+  List.fold_right ((field db "Amount") ++ float_of_string ++ (+.)) dcs 0.0
+
+