File: mList.ml

package info (click to toggle)
sks 1.1.6-14
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,296 kB
  • sloc: ml: 15,228; ansic: 1,069; sh: 358; makefile: 347
file content (307 lines) | stat: -rw-r--r-- 9,537 bytes parent folder | download | duplicates (2)
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
(***********************************************************************)
(* mList.ml - Various list operations                                  *)
(*                                                                     *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(*               2011, 2012, 2013  Yaron Minsky and Contributors       *)
(*                                                                     *)
(* This file is part of SKS.  SKS is free software; you can            *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 of the License, or (at your option) any later version.    *)
(*                                                                     *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of          *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU   *)
(* General Public License for more details.                            *)
(*                                                                     *)
(* You should have received a copy of the GNU General Public License   *)
(* along with this program; if not, write to the Free Software         *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>.                          *)
(***********************************************************************)

open StdLabels
open MoreLabels

open Printf

(************************************************************************)
(* START: List Operations **********************************************)
(************************************************************************)

(****** Numeric *************)
let average list =
  let sum = List.fold_left ~f:(+.) ~init:0.0 list in
    sum /. (float_of_int (List.length list))

let iaverage list =
  let sum = List.fold_left ~f:(+) ~init:0 list in
    (float sum) /. (float (List.length list))


(****** Initialization *************)

let init n ~f =
  let rec list_init ~n ~partial =
    match n with
        0 -> partial
      | _ -> list_init ~n:(n-1) ~partial:((f (n-1))::partial)
  in list_init ~n ~partial:[]

let init_by_value n ~value =
  let rec init_list_rec n value partial = match n with
    0 -> partial
  | _ -> init_list_rec (n - 1) value (value::partial)
  in init_list_rec n value []


(******** Printing *****************)

let to_string ~f list =
  let buf = Buffer.create ((List.length list) * 5) in
    Buffer.add_string buf "[ ";
    List.iter ~f:(fun el ->
                    Buffer.add_string buf (f el);
                    Buffer.add_string buf " "; )
      list;
    Buffer.add_string buf  "]";
    Buffer.contents buf

let print ~f list =
  let rec print_list_rec list = match list with
      [] -> ()
    | hd::tl ->
        f hd;
        print_string " ";
        print_list_rec tl
  in
    print_string "[ ";
    print_list_rec list;
    print_string "]"

let print_int_list = print ~f:(printf "%d ")

let print2 ~f list =
  let rec print_list_rec list = match list with
      [] -> ()
    | hd::tl ->
        f hd;
        print_string "\n  ";
        print_list_rec tl
  in
    print_string "[ ";
    print_list_rec list;
    print_string " ]"

(***********************************************)



let rec swap_pairs_rec list  partial = match list with
  [] -> partial
| (a,b)::tail -> swap_pairs_rec tail ( (b,a)::partial )

let swap_pairs list = swap_pairs_rec list []

(* tail recursive, constructs list from
   lower_bound (incl) to upper_bound (excl) *)
let range lower_bound upper_bound =
  let rec range_rec lower_bound upper_bound list =
    if lower_bound = upper_bound
      then list
      else range_rec lower_bound (upper_bound-1) ((upper_bound -1)::list)
  in range_rec lower_bound upper_bound []

let srange ?(step=1) lower_bound upper_bound =
  let rec range lower_bound partial =
    if lower_bound >= upper_bound
    then partial
    else range (lower_bound + step) (lower_bound::partial)
  in List.rev(range lower_bound [])

let rand_elem list =
  if (List.length list) = 0
    then raise (Failure "attempt to select random element of empty list")
    else List.nth list (Random.int (List.length list))

(* return list with first element dropped *)
let omit_first list = match list with
  [] -> raise (Failure "attempt to drop element from empty list")
| hd::tl -> tl;;

(* return list with kth element dropped *)
let rec drop_kth ~k list = match list, k with
    [],_ -> []
  | list,0  -> omit_first list
  | hd::tail,k -> hd::(drop_kth ~k:(k-1) tail)

(* return list with only the first k elements *)
let first_k ~k list =
  let rec first_k_rec list k partial = match list,k with
      [],_ -> partial
    | _,0  -> partial
    | hd::tl,k -> first_k_rec tl (k-1) (hd::partial)
  in List.rev (first_k_rec list k [])

let k_split ~k ~list =
  let rec k_split ~k part1 part2 =
    if k = 0 then (part1, part2)
    else (
      match part2 with
          [] -> (part1,[])
        | hd::tail ->  k_split ~k:(k-1) (hd::part1) tail
    )
  in
  let (part1, part2) = k_split ~k [] list
  in (List.rev part1, part2)


let rec last_elem list = match list with
    [] -> raise (Failure "Attempt to get end of empty list")
  | [hd] -> hd
  | hd::tl -> last_elem tl

let rec last_k ~k list =  match list with
  [] -> []
| hd::tl -> if k >= (List.length list)
    then list
    else last_k tl ~k

(* return list with all but first k *)
let rec drop_k ~k list = match list, k with
  [],_ -> []
| list,0 -> list
| hd::tail,k -> drop_k tail ~k:(k-1)

let drop_last_k ~k list =
  let rec drop_rec list k partial =
    if (List.length list) <= k
        then partial
        else match list with
          [] -> raise (Failure "drop_last_k: Unexpected error")
        | hd::tl -> drop_rec tl k (hd::partial)
  in List.rev (drop_rec list k [])

let drop_last list = drop_last_k ~k:1 list

let all_true list =
  List.fold_left ~f:(fun a b -> a && b) ~init:true list

let pri_split pri list =
  let rec pri_split_rec list low exact high = match list with
    [] -> (low,exact,high)
  | ((el_pri,_) as hd)::tl ->
        if el_pri < pri then pri_split_rec tl (hd::low) exact high
          else if el_pri > pri then pri_split_rec tl low exact (hd::high)
            else pri_split_rec tl low (hd::exact) high
  in let (low,exact,high)= pri_split_rec list [] [] [] in
  assert ( (List.length low) + (List.length exact) + (List.length high) =
             (List.length list) );
  (low,exact,high)

let has_dups list =
  let slist = List.sort compare list in
  let rec dup_scan list = match list with
    [] -> false
  | hd::[] -> false
  | hd1::hd2::tl -> if hd1 = hd2 then true else dup_scan (hd2::tl)
  in dup_scan slist

let dedup list =
  let slist = List.sort compare list in
  let rec dedup ~list ~partial = match list with
      [] -> partial
    | hd::[] -> dedup ~list:[] ~partial:(hd::partial)
    | hd1::hd2::tl ->
        if hd1 = hd2
        then dedup ~list:(hd2::tl) ~partial
        else dedup ~list:(hd2::tl) ~partial:(hd1::partial)
  in List.rev (dedup ~list:slist ~partial:[]);;

let choose_best ~f:best_chooser list =
  let rec choose_best ~list best_so_far =
    match list with
        [] -> best_so_far
      | hd::tl -> choose_best ~list:tl (best_chooser hd best_so_far)
  in match list with
      [] -> raise (Failure "Attempt to get best element of empty list")
    | hd::tl -> choose_best ~list:tl hd

let count_true list =
  let rec count_true list partial = match list with
      [] -> partial
    | hd::tl -> count_true tl (partial + if hd then 1 else 0)
  in count_true list 0

let max list = choose_best ~f:max list
let min list = choose_best ~f:min list


(******************************************************)
(*** Some functions that should be in module List ... *)
(******************************************************)

(* UNTESTED *)
let rec iteri_rec ~f list i = match list with
    [] -> ()
  | hd::tl -> f ~i hd; iteri_rec ~f tl (i+1)

let iteri ~f list =
  iteri_rec ~f list 0

(******************************************************)

(* UNTESTED *)
let rec mapi_rec ~f list i partial = match list with
    [] -> partial
  | hd::tl -> mapi_rec ~f tl (i+1)  ((f ~i hd)::partial)

let mapi ~f list =
  List.rev (mapi_rec ~f list 0 [])

(******************************************************)

let map ~f list = List.rev (List.rev_map ~f list)

(******************************************************)

(* UNTESTED *)
let rec filteri_rec ~f list i partial = match list with
    [] -> partial
  | hd::tl ->
      if f ~i hd
      then filteri_rec ~f tl (i+1) (hd::partial)
      else filteri_rec ~f tl (i+1) partial

let filteri ~f list =
  List.rev (filteri_rec ~f list 0 [])

(******************************************************)

let find_index el list =
  let rec find_index list loc = match list with
      [] -> -1
    | hd::tl ->
        if hd = el then loc
        else find_index tl (loc + 1)
  in
    find_index list 0

let cons_opt opt list =  match opt with
    None -> list
  | Some x -> x::list

let strip_opt list =
  let rec loop list stripped =  match list with
      [] -> List.rev stripped
    | None::tl -> loop tl stripped
    | (Some x)::tl -> loop tl (x::stripped)
  in
    loop list []

let rec reduce ~f list = match list with
      [] -> failwith "MList.reduce: list has two few elements"
    | hd::tl -> List.fold_left ~f tl ~init:hd