Четвёртая неделя курса Algorithmic Toolbox началась с изучения принципа "разделяй и властвуй" на примере бинарного поиска в отсортированном массиве. А я вслед за лекторами попробовал сделать свою реализацию этого алгоритма на OCaml.

Вообще лектор честно предупреждает, что несмотря на всю рекурсивную природу принципа "разделяй и властвуй" рекурсивная реализация может быть более затратной из-за стека. Делай я это на Python, то так бы оно и было, но в OCaml у меня есть хвостовая рекурсия, которой я и хочу воспользоваться.

Работать алгоритм будет примерно так, как описано в лекции. Если искомые элемент есть, то возвращается его индекс, если его нет, то максимальный индекс, где data[i] < key, если key < data[low], то результат low - 1.

Цель, как и прежде, не столько в эталонной реализации алгоритмов, сколько практика программирования на OCaml. Поэтому вводные условия такие.

• на вход программе поиска через stdin - отсортированный список целых чисел;
• на выход - индекс;
• проверяющая программа - тоже на OCaml;
• реализация алгоритма в проверяющей программе - линейный поиск в отсортированном массиве;
• если нужно, то можно использовать Core.Std (жаль, что она недоступна на codingame).

open Core.Std


let rec binary_search data low high key =
    if Array.length data = 0 || high < low then
        (low - 1)
    else
        let middle = low + (high - low) / 2 in
        if key = data.(middle) then
            middle
        else if key < data.(middle) then
            binary_search data low (middle - 1) key
        else
            binary_search data (middle + 1) high key


let () =
    let data =
        match In_channel.input_line In_channel.stdin with
        | Some "" -> [||]
        | Some line -> String.split line ' ' |> List.map ~f:int_of_string |> Array.of_list
        | None -> invalid_arg "You should input sorted array"
    in
    let key =
        input_line stdin |> int_of_string
    in

    binary_search data 0 ((Array.length data) - 1) key |> string_of_int |> print_endline;

Теперь нужно написать программу, которая запустит эту, как внешний процесс, отдаст данные на вход, получит результат и сравнит со своим вариантом. Получилась вот такая программа:

open Core.Std


let search data key =
    if Array.length data = 0 || key < data.(0) then
        -1
    else if key > data.((Array.length data) - 1) then
        Array.length data - 1
    else
        let rec _search _data i =
            if _data.(i) = key then
                i
            else if _data.(i) < key then
                _search _data (i + 1)
            else
                i - 1
        in
        _search data 0


let () =
    let rec gen = function
        | 0 -> []
        | num -> Random.int 10 :: gen (num - 1)
    in

    let create_test_data length =
        List.sort (gen length) ~cmp:compare |> Array.of_list, Random.int 10
    in

    let prepare numbers key =
        (String.concat_array ~sep:" " (Array.map numbers ~f:string_of_int)) ^ "\n", string_of_int key ^ "\n"
    in

    let path = Unix.getcwd () ^ "/" ^ "binary_search.ml.byte" in

    let run_process numbers_line key_line =
        let procin, procout = Unix.open_process path in
        Out_channel.output_string procout numbers_line;
        Out_channel.output_string procout key_line;
        Out_channel.flush procout;

        let result = match In_channel.input_line procin with
        | None -> invalid_arg "Broken channel"
        | Some line -> int_of_string line
        in

        Unix.close_process (procin, procout);

        result
    in

    let check numbers key linear_result binary_result =
        (
            (linear_result = binary_result) ||
            (
                linear_result < Array.length numbers &&
                binary_result < Array.length numbers &&
                numbers.(linear_result) = numbers.(binary_result)
            )
        )
    in

    let print_state linear_result binary_result numbers key =
        printf " linear_result: %d\n" linear_result;
        printf " binary_result: %d\n" binary_result;
        printf " data: %s\n" (String.concat_array ~sep:" " (Array.map numbers ~f:string_of_int));
        printf " key: %d\n" key;
        printf " -----------\n\n";
        printf "%!";
    in

    for i = 0 to 100 do
        let numbers, key = create_test_data i in
        let numbers_line, key_line = prepare numbers key in
        let binary_result = run_process numbers_line key_line in

        let linear_result = search numbers key in

        if not (check numbers key linear_result binary_result) then begin
            printf "Error:\n";
            print_state linear_result binary_result numbers key;
        end
    done;

    printf "Done\n"

Из-за немного разного принципа работы поиска, пришлось проверять не только найденные индексы, а ещё и равенство чисел по этим индексам, если они разные. Собственно, в лекции тоже упоминается этот случай и обе позиции считаются удовлетворяющими условию.

Нужно бы ещё проверить результат Unix.close_process, но не в этот раз.

Продолжаю слушать курс Algorithmic Toolbox.

Прослушал блок про оптимальную загрузку рюкзака жадным алгоритмом, и начал писать код для поиска оптимальной загрузки рюкзака (Fractional Knapsack).

Условия:

• Ввод и вывод данных через терминал.
• Результат поиска - максимальная стоимость продуктов в рюкзаке.
• Тестирующий код - отдельный процесс.

вместительность_рюкзака количество_продуктов [общая_цена вес]*

  7 3 20 4 14 2 18 3

let find_solution capacity items =
    let rec _solve free_capacity sorted_items =
        match sorted_items with
        | [] -> 0.0
        | (price, weight) :: tl ->
            if weight <= free_capacity then
                price +. (_solve (free_capacity -. weight) tl)
            else
                price /. weight *. free_capacity
    in

    List.sort (fun (p1, w1) (p2, w2) -> compare (p2 /. w2) (p1 /. w1)) items
        |> _solve capacity


let () =
    let knapsack_capacity = Scanf.scanf " %f" (fun x -> x) in

    let number_of_items =  Scanf.scanf " %d" (fun x -> x) in

    (* [(price, weight)] *)
    let rec scan_pairs = function
        | 0 -> []
        | n -> Scanf.scanf " %f %f" (fun a b -> (a, b)) :: scan_pairs (n - 1)
    in
    let items = scan_pairs number_of_items in

    find_solution knapsack_capacity items |> string_of_float |> print_endline;

#!/usr/bin/env python
# -*- coding: utf-8 -*-

'Тест для проверки корректности решения загрузки рюкзака порграммой на OCaml.'

import random

from subprocess import check_output


def solve(capacity, pairs):
    pairs = sorted(pairs, key=lambda x: x[0] / x[1], reverse=True)

    value = 0
    while capacity and pairs:
        (price, weight), *pairs = pairs
        if capacity < weight:
            value += (price / weight) * capacity
            capacity = 0
        else:
            value += price
            capacity -= weight

    return value


def main():
    random.seed(1)

    for number_of_pairs in range(15):
        capacity = random.randint(3, 30)

        pairs = [(random.randint(1, 20), random.randint(1, 20))
                 for _ in range(number_of_pairs)]

        test_data = '{capacity} {number_of_pairs} {pairs}'.format(
            capacity=capacity, number_of_pairs=number_of_pairs,
            pairs=' '.join(['{} {}'.format(*i) for i in pairs])
        )

        ocaml_result = check_output(
            './fractional_knapsack.ml.byte', input=bytes(test_data, 'utf-8'))

        py_result = solve(capacity, pairs)

        print(float(ocaml_result) == py_result,
              '[p {}, o {}]'.format(py_result, ocaml_result),
              test_data)


if __name__ == '__main__':
    main()

True [p 0, o b'0.\n'] 7 0
True [p 3, o b'3.\n'] 21 1 3 9
False [p 7.384615384615385, o b'7.38461538462\n'] 6 2 16 15 16 13
True [p 36, o b'36.\n'] 28 3 7 4 16 1 13 14
True [p 39.6, o b'39.6\n'] 22 4 1 15 9 8 19 4 11 1
True [p 1.6, o b'1.6\n'] 3 5 1 18 1 13 7 14 1 17 8 15
False [p 40.77777777777778, o b'40.7777777778\n'] 18 6 18 8 12 8 8 15 10 1 14 18 4 6
False [p 27.647058823529413, o b'27.6470588235\n'] 23 7 10 4 11 17 14 17 7 10 10 19 16 17 13 19
False [p 50.05882352941177, o b'50.0588235294\n'] 30 8 2 16 8 13 14 6 12 18 12 3 15 17 4 6 17 13
False [p 62.333333333333336, o b'62.3333333333\n'] 14 9 16 1 16 2 10 20 19 19 13 6 6 17 8 1 7 18 18 8
False [p 33.583333333333336, o b'33.5833333333\n'] 15 10 17 12 19 12 15 9 18 20 1 13 17 5 17 18 7 14 2 16 12 19
True [p 55.0, o b'55.\n'] 20 11 7 17 14 16 12 14 12 1 18 18 20 20 11 15 20 1 8 6 18 19 6 3
True [p 83.2, o b'83.2\n'] 28 12 18 9 2 3 3 1 15 1 9 8 9 4 20 6 12 10 3 6 6 9 17 6 9 10
True [p 64.0, o b'64.\n'] 17 13 11 16 16 4 1 10 13 11 14 7 9 4 9 17 7 20 14 1 8 1 13 5 2 6 15 17
True [p 61.0, o b'61.\n'] 24 14 14 18 8 17 15 8 17 1 13 19 11 14 2 10 5 7 2 10 3 3 10 10 6 14 19 9 5 1

let find_solution capacity items =
    let rec _solve free_capacity value sorted_items =
        match sorted_items with
        | [] -> value
        | (price, weight) :: tl ->
            if weight <= free_capacity then
                _solve (free_capacity -. weight) (value +. price) tl
            else
                value +. price /. weight *. free_capacity
    in

    List.sort (fun (p1, w1) (p2, w2) -> compare (p2 /. w2) (p1 /. w1)) items
        |> _solve capacity 0.0

let () =
    let knapsack_capacity = Scanf.scanf " %f" (fun x -> x) in

    let number_of_items =  Scanf.scanf " %d" (fun x -> x) in

    (* [(price, weight)] *)
    let rec scan_pairs = function
        | 0 -> []
        | n -> Scanf.scanf " %f %f" (fun a b -> (a, b)) :: scan_pairs (n - 1)
    in
    let items = scan_pairs number_of_items in

    find_solution knapsack_capacity items |> string_of_float |> print_endline;

import random

from subprocess import check_output


def solve(capacity, pairs):
    pairs = sorted(pairs, key=lambda x: x[0] / x[1], reverse=True)

    value = 0
    while capacity and pairs:
        (price, weight), *pairs = pairs
        if capacity < weight:
            value += (price / weight) * capacity
            capacity = 0
        else:
            value += price
            capacity -= weight

    return value


def main():
    random.seed(1)

    for number_of_pairs in range(1000):
        capacity = random.randint(3, 30)

        pairs = [(random.randint(1, 20), random.randint(1, 20))
                 for _ in range(number_of_pairs)]

        test_data = '{capacity} {number_of_pairs} {pairs}'.format(
            capacity=capacity, number_of_pairs=number_of_pairs,
            pairs=' '.join(['{} {}'.format(*i) for i in pairs])
        )

        ocaml_result = check_output(
            './fractional_knapsack.ml.byte', input=bytes(test_data, 'utf-8'))
        ocaml_result = float(ocaml_result)

        py_result = solve(capacity, pairs)

        precise = 3
        ocaml_result = round(ocaml_result, precise)
        py_result = round(py_result, precise)

        assert ocaml_result == py_result, ('[p {}, o {}] {}'.format(
            py_result, ocaml_result, test_data))

    print('Все тесты пройдены.')


if __name__ == '__main__':
    main()

Записался слушателем курса Algorithmic Toolbox (бесплатно халявный вариант).

Сегодня утром слушал про жадный алгоритм для поиска групп детей, у которых разница в возрасте не должна превышать год. Поскольку халявщикам нельзя отправлять свои решения, а платить за этот курс я не планирую, то написал свой жадный алгоритм на OCaml, вместо предлагаемых в курсе питона и С++.

Условия под которые писался этот код:

• данные вводятся из терминала;
• возраст даётся в месяцах, чтобы не возиться с преобразованием и обойтись одной функцией ввода;
• рекурсия должна быть хвостовой.

let scan_int () = Scanf.scanf " %d" (fun x -> x)


let rec scan_ages = function (* Возраст в месяцах *)
    | 0 -> []
    | n -> scan_int () :: scan_ages (n - 1)


let print_groups lst =
    print_endline "Groups: ";

    List.iter (fun sub_list ->
        sub_list |> List.map string_of_int
                 |> String.concat " "
                 |> print_endline
    ) lst


let find_groups lst =
    let max_diff = 12 in
    let rec _find lst first group total =
        match lst with
        | [] -> (
            match group with
            | [] -> total
            | _ -> group :: total)
        | hd :: tl -> (
            match compare (hd - first) max_diff with
            | 0 | -1 -> _find tl first (hd :: group) total
            | 1 -> _find tl hd [hd] (group :: total)
            | _ -> invalid_arg "Wrong answer from compare!")
    in

    match List.sort compare lst with
    | [] -> []
    | hd :: tl -> _find tl hd [hd] []


let () =
    scan_int () |> scan_ages
                |> List.sort compare
                |> find_groups
                |> print_groups;

let make_test () =
    let rec gen n =
        match compare n 0 with
        | 0 | 1 -> (Random.int 115) + 6 :: gen (n - 1) (* Возраст от 6 месяцев до 10 лет *)
        | _ -> []
    in
    gen ((Random.int 100) + 1) (* От одного до 100 детей в группе *)

let compare_groups g1 g2 =
    let sorted lst =
        List.map (List.sort compare) lst |> List.sort compare
    in
    let even = match compare (List.length g1) (List.length g2) with
    | 0 -> sorted(g1) = sorted(g2)
    | _ -> false
    in
    even

let greedy_iter lst =
    let sorted_lst = List.sort compare lst in
    let groups = ref [] in
    let i = ref 0 in
    while !i < List.length sorted_lst do
        let first = List.nth sorted_lst !i in
        let group = ref [first] in
        i := !i + 1;
        while !i < List.length sorted_lst && compare 12 ((List.nth sorted_lst !i) - first) >= 0 do
            group := (List.nth sorted_lst !i) :: !group;
            i := !i +1;
        done;
        groups := !group :: !groups
    done;
    !groups

let test () =
    for i = 0 to 50 do
        let ages = make_test () in
        let g1 = greedy_iter ages in
        let g2 = find_groups ages in
        if compare_groups g1 g2 then
            print_endline "Ok"
        else begin
            print_endline "Error";
            print_endline "Ages: ";
            ages |> List.map string_of_int |> String.concat " " |> print_endline;
            print_endline "Imperative:";
            print_groups g1;
            print_endline "----";
            print_endline "Functional:";
            print_groups g2;
            print_endline "";
        end
    done


let () =
    test();

Продолжаю свои упражнения на codingame, где тренируюсь в программировании на OCaml. В этот раз столкнулся с нехваткой нужных библиотек в составе компилятора на площадке.

Тут стоит сказать, что стандартная библиотека OCaml очень маленькая, и писать код, используя только её, никому в голову не приходит. Одна из популярных - переписанная Core программистами из jane street. Этим OCaml сильно отличается от питона, у которого стандартная библиотека просто огромна, а на codingame сверху установлен numpy.

В задаче про поиск температуры, ближайшей к нулю - Temperatures, нужно было взять строку из stdin и разделить её на числа. Вот только в стандартной библиотеке такого функционала нет. То, что там нет Core меня расстроило. Первой мыслью было отказаться от OCaml и либо перейти на Python3 либо вообще забросить codingame. Второй мыслью было, сделать необходимый функционал самому, задача не особо трудная.

Сделал.

Само собой, что такой код в реальный продакшн я бы не послал, хотя бы из-за того, что у меня списки конкатенируются, что каждый раз создаёт новые. И не факт, что функция хорошо будет работать на граничных случаях или корректно обработает два разделителя подряд. Однако мне она позволила решить задачу, а на игровой площадке мне пока большего не нужно.

let split delimiter str =
    let max = String.length str in

    let rec _split str i lst =
        if i < max then
            let ch = String.get str i in
            if ch = delimiter then
                (String.concat "" lst) :: (_split str (i + 1) [])
            else
                _split str (i + 1) (lst @ [String.make 1 ch])
        else
            [String.concat "" lst]
    in
    _split str 0 []
;;

Публикую только функцию, а не всё решение. Вроде по правилам решение публиковать нельзя.

P.S. После публикации посмотрел решения других людей и увидел использование Scanf.scanf, чтобы получить список чисел.

let get_int () = Scanf.scanf " %d" (fun x -> x);;


let rec get_ints = function
    | 0 -> []
    | n -> get_int () :: get_ints (n - 1)
;;


let () =
    get_ints 3 |> List.map string_of_int
               |> String.concat " "
               |> print_endline
;;

Это то, чего я не смог сделать сам, хотя пробовал несколько способов. Кстати, этот код сохраняет список в обратном порядке, что стоит помнить, если порядок имеет значение.

Жаль, что с каждым решённым заданием, список чужих решений всё короче (в этот раз - 9). Интересно, как много решений на Haskell?

Мне нужно было найти себе задачник, чтобы тренироваться в программировании на OCaml. Для этого завёл себе акканут на codingame - grigoriy-tretyakov.

Пока что решил только две первых задачи:

• The Descent
• Power of Thor - Episode 1

Площадка мне уже понравилась. Только на OCaml, похоже, там пишут немногие.