// BitonicSort
// 
// http://www.diku.dk/forskning/performance-engineering/Ramon/thesis.pdf

let inline isPow2 x =
  match x with
  | 0 -> false
  | _ -> x &&& (x - 1) = 0

let comparator x y =
  match x with
  | _ when x < y -> (x,y)
  | _ -> (y,x)

let halfCleaner bs =
  let n = bs |> Array.length
  let m = n/2
    
  match isPow2(n) with
  | true -> ()
  | false -> failwith "Input array %A, must be n=2^k" bs

  Array.mapi(fun i x -> 
             match i with
             | _ when i < m -> fst (comparator x bs.[m+i])
             | _ -> snd (comparator x bs.[i-m])) bs

let rec bitonicSorter bs =
  let n = bs |> Array.length
  let m = n/2

  match isPow2(n) with
  | true -> ()
  | false -> failwith "Input array %A, must be n=2^k" bs

  let bs' = halfCleaner bs
  let bs1 = bs'.[0 .. (m - 1)]
  let bs2 = bs'.[m .. (n - 1)]

  match n with
  | _ when 2 < n ->
    Array.append (bitonicSorter bs1) (bitonicSorter bs2)
  | _ -> bs'

let merger ss1 ss2 =
  let m1 = ss1 |> Array.length
  let m2 = ss2 |> Array.length
  let n = m1 + m2
  let m = n/2

  match (m1 = m2) with
  | true -> ()
  | false -> failwith "Input arrays (%A,%A), must have the same length" ss1 ss2
    
  match isPow2(n) with
  | true -> ()
  | false -> failwith "Comibnation of (%A,%A) arrays, must be n=2^k" ss1 ss2

  let ss2' = ss2 |> Array.rev

  let ss1'' = Array.map2(fun x y -> fst (comparator x y)) ss1 ss2'
  let ss2'' = Array.map2(fun x y -> snd (comparator x y)) ss1 ss2'

  match n with
  | _ when 2 < n -> Array.append (bitonicSorter ss1'') (bitonicSorter ss2'')
  | _ -> Array.append ss1'' ss2''

let rec sorter array =
  let n = array |> Array.length
  let m = n/2
    
  match isPow2(n) with
  | true -> ()
  | false -> failwith "Input array %A, must be n=2^k" array

  let as1 = array.[0 .. (m - 1)]
  let as2 = array.[m .. (n - 1)]

  match n with
  | _ when 2 < n -> merger (sorter as1) (sorter as2)
  | _ -> merger as1 as2

let n = 1 <<< 16
let a = Array.init n (fun i -> i % 2)

sorter a