mcts.lisp

(defvar *example-tensor-list* '((p i) (q j) (i j k l) (r k) (s l)))
(defvar *example-tensor-goal* '(p q r s))

(defclass tensor-contraction-node (micmac.uct:uct-node)
  ((tensor-list :accessor tensor-list
                :initarg :tensor-list
                :type list)))

(defclass tensor-contraction-edge (micmac.uct:uct-edge)
  ((first-tensor :accessor first-tensor
                 :initarg :first-tensor
                 :type integer)
   (second-tensor :accessor second-tensor
                  :initarg :second-tensor
                  :type integer)))

(defmethod micmac.uct:list-edges ((node tensor-contraction-node) state)
  (loop for i from 0 below (length (tensor-list node)) appending
        (loop for j from (+ 1 i) below (length (tensor-list node)) collecting
              (make-instance 'tensor-contraction-edge
                             :first-tensor i
                             :second-tensor j
                             :from-node node))))

(defmethod micmac.uct:state ((node tensor-contraction-node) parent edge parent-state)
  nil)
;(defmethod micmac.uct:outcome->reward ((node tensor-contraction-node) outcome))
;(defmethod micmac.uct:average-reward ((edge tensor-contraction-node)))
(defmethod micmac.uct:play-out ((node tensor-contraction-node) state path))
(defmethod micmac.uct:make-uct-node ((parent tensor-contraction-node) (edge tensor-contraction-edge) parent-state)
  (make-instance 'tensor-contraction-node :tensor-list (contract-tensor-list (tensor-list parent)
                                                                             (first-tensor edge)
                                                                             (second-tensor edge))))

(defun contract-tensors (first-tensor second-tensor)
  (set-exclusive-or first-tensor second-tensor))

(defun contract-tensor-list (tensor-list first-tensor-index second-tensor-index)
  (append (remove (nth first-tensor-index tensor-list)
                  (remove (nth second-tensor-index tensor-list) tensor-list))
          (list (contract-tensors (nth first-tensor-index tensor-list)
                                  (nth second-tensor-index tensor-list)))))

(defun tensor-contraction-scaling (tensor-list first-tensor-index second-tensor-index)
  (length (union (nth first-tensor-index tensor-list)
                 (nth second-tensor-index tensor-list))))

(defun greedy-scaling (tensor-contraction-list)
  )