cup2.erl

%% erlang版 (動作未確認)
%%
%% 関数(節)本体を一行で書こうキャンペーン中
-module(cup2).

-export([solve/1, solve_node/1]).
-export([make_node/0, make_node/1]).

-record(node,
        {
          memo          :: undefined | [{value(), total()}],
          children = [] :: [tree_node()]
        }).

-type value() :: non_neg_integer(). % ノードの値
-type total() :: non_neg_integer(). % 自ノードのルートとしたツリーの各ノードの値の合計値

-type tree_node() :: #node{}.

-spec make_node() -> tree_node().
make_node() -> #node{}.

-spec make_node([tree_node()]) -> tree_node().
make_node(Children) -> #node{children = Children}.

-spec solve(tree_node()) -> total().
solve(Node) ->
    lists:min([Total || {_, Total} <- (solve_node(Node))#node.memo]).

-spec solve_node(tree_node()) -> tree_node().
solve_node(Node = #node{memo = [_|_]})  -> Node;                               % 探索済みノード
solve_node(Node = #node{children = []}) -> Node#node{memo = [{0, 0}, {1, 1}]}; % リーフノード
solve_node(Node = #node{children = Cs}) -> calc_memo(Node#node{children = lists:map(fun solve_node/1, Cs)}).

-spec calc_memo(#node{}) -> #node{}.
calc_memo(Node = #node{children = Children}) ->
    Node#node{memo = [{Value, children_total(Value, Children)} || Value <- lists:seq(0, length(Children))]}.

-spec children_total(value(), [#node{}]) -> total().
children_total(ParentValue, Children) ->
    ParentValue + lists:sum([child_total(ParentValue, C) || C <- Children])
  
-spec child_total(value(), #node{}) -> total().
child_total(ParentValue, #node{memo = Memo}) ->
    lists:min([Total || {Value, Total} <- Memo, Value =/= ParentValue]).

cup2.lisp

;;;
;;; problem
;;;

;; Facebook Hacker Cup より
;; （難易度：高）
;; 木が与えられる。各ノードの値を、その直接の子ノードの値すべてと異なるように決めたい。値の合計の最小値を求めよ。
;; ノード数≦200,000、実行時間目安：2 秒以内

;;;
;;; program
;;;
;;; 仮定: ノードの値は非負の整数と仮定する
(defstruct node
  memo ; ((value . cost) ...). ordered by value
  children)

(defun solve (node)
  (solve-node node)
  (values (list :result (apply #'min (mapcar #'cdr (node-memo node))))
          node))

(defun solve-node (node)
  (cond ((node-memo node)
         t)
        ((node-children node)
         (mapcar #'solve-node (node-children node))
         (calc-memo node (length (node-children node)))
         (solve-node node))
        (t
         (setf (node-memo node) (list (cons 0 0) (cons 1 1)))))
  node)

;; invariant: all children's memo have been calculated
(defun calc-memo (node limit &optional (value 0))
  (calc-memo-one node value)
  (if (= value limit)
      (setf (node-memo node) (reverse (node-memo node)))
    (calc-memo node limit (1+ value))))

(defun calc-memo-one (node value)
  (let ((cost 0))
    (dolist (child (node-children node))
      (multiple-value-bind (child-value child-cost)
                           (select-min-except-this value child)
        (incf cost child-cost)))
    (push `(,value . ,(+ cost value)) (node-memo node))))

(defun select-min-except-this (value node)
  ;; (print (list value (node-memo node)))
  (let ((rlt (find-if (lambda (x) (/= value (car x)))
                      (stable-sort (copy-list (node-memo node)) #'< :key #'cdr))))
    (assert rlt)
    (values (car rlt) (cdr rlt))))

(defun node (&rest children)
  (make-node :memo '() :children children))

;;;
;;; execution
;;;
(solve
 (node
  (node)
  (node)
  (node)
  (node)
  (node
   (node)
   (node)
   (node)
   (node))))

(defun gen-balanced-tree (n)
  (case n
    (0 nil)
    (1 (node))
    (t (apply #'node
              (remove-if-not
               #'identity
               (list (gen-balance-tree (floor n 2))
                     (gen-balance-tree (floor n 2))))))))

(values
 (solve (gen-balanced-tree 200000)))