Как объединить узлы в поддереве с одним потомком?

Question

У меня есть дерево в виде вложенного списка:

(A (B (C (D word) (E word))) (F (G word)))

, и я хочу объединить узлы, когда у поддерева есть один дочерний элемент в формате Parent + Child, поэтому результат будет:

(A (B+C (D word) (E word)) (F+G word)) 

В настоящее время я использую рекурсивную функцию для обработки дерева. Я пытался

(defun my-func (tree)

  (cond
    ; base case
    ((null tree) nil)
    ; subtree has one child
    ((and (atom (car tree)) (listp (car(cdr tree))) (= (length (cdr tree)) 1))
      (my-func (cdr tree)))
    ; first element is atom
    ((atom (car tree)) (cons (car tree) (my-func (cdr tree))))
    ; else
    (t (cons (my-func (car tree)) (my-func (cdr tree)))))
)

Мой ввод: ("A" ("B" ("C" ("D" "word1") ("E" "word2"))) ("F" ("G" "word3")))

Вывод: ("A" (("C" ("D" "word1") ("E" "word2"))) (("G" "word3")))

Я уже близко, но мои вопросы сейчас:

Почему я получаю дополнительные скобки вокруг подсписков (("C" ("D" "word1") ("E" "word2"))) и (("G" "word3"))?

Кроме того, я все еще пытаюсь получить обозначение "Родитель + ребенок"

Answer 1

Хорошо, во-первых, уже 1970 год, и мы изобрели понятие использования абстракции. Вместо кода, который заполнен car, cdr & cons, мы можем использовать значимые имена для наших объектов: мы будем иметь дело с объектами, называемыми node , где каждый узел является либо дерево или лист . У дерева есть имя и список ветвей (списки ветвей - это списки, абстракция там не нужна), листья не имеют определенной структуры: они просто не деревья.

(defun node-tree-p (o)
  (consp o))

(defun node-leaf-p (o)
  (not (node-tree-p o)))

(defun tree-name (tree)
  (car tree))

(defun tree-branches (tree)
  (cdr tree))

(defun make-tree (name branches)
  (cons name branches))

Я собираюсь представлять имена объединенных деревьев в виде списков (например, они являются списками , поэтому можно использовать функции списков для них, нам не нужно их абстрагировать). Таким образом, нам понадобится функция для объединения имен, которая при этом оборачивает беспристрастность в зависимости от того, является ли вы уже списочным именем:

(defun coalesce-names (n1 n2)
  (append (if (listp n1) n1 (list n1))
          (if (listp n2) n2 (list n2))))

Итак, теперь мы можем написать функцию, которая обходит дерево и объединяет что является объединяемым:

(defun maybe-coalesce-node (node)
  (if (node-tree-p node)
      ;; it's a tree, which is a candidate
      (if (= (length (tree-branches node)) 1)
          ;; it's got one branch: it's a good candidate
          (let ((branch (first (tree-branches node))))
            (if (node-tree-p branch)
                ;; the branch is a tree: this is coalescable: coalesce
                ;; it and then recurse on the result
                (maybe-coalesce-node (make-tree (coalesce-names (tree-name node)
                                                                (tree-name branch))
                                                (tree-branches branch)))
              ;; the branch is a leaf: this is not coalescable
              node))
        ;; it's a tree, but it has more than one branch, so make a
        ;; tree whose branches have been coalesced
        (make-tree (tree-name node)
                   (mapcar #'maybe-coalesce-node (tree-branches node))))
    ;; it's a leaf, which is not a candidate
    node))

Обратите внимание, что это функция : она принимает узел в качестве аргумента и возвращает узел, который может быть тем же узлом, но он не изменяет узел.

А теперь:

> (maybe-coalesce-node
   '(a (b 1) (c (d (e 2))) (f (g (h 3) (i 4)))))
(a (b 1) ((c d e) 2) ((f g) (h 3) (i 4)))

Итак, результатом этого является то, что мы можем объединить деревья, чтобы создать деревья, имена которых являются списками имен. Теперь мы хотим превратить эти имена в строки. Чтобы сделать это, давайте напишем общую функцию отображения дерева, которая отобразит функцию на узле:

(defun map-node (f node)
  ;; map F over the nodes in TOP-NODE.  F should return a node, but it
  ;; may have a different structure than its argument.
  (let ((new-node (funcall f node)))
    (if (node-tree-p new-node)
        (make-tree (tree-name new-node)
                   (mapcar #'(lambda (n)
                               (map-node f n))
                           (tree-branches new-node)))
      new-node)))

А теперь давайте напишем функцию, которая переписывает имя дерева, используя вспомогательную функцию для выполнения работа:

(defun stringify-tree-name (name)
  (format nil "~{~A~^+~}" (if (listp name) name (list name))))

(defun maybe-rewrite-node-name (node &key (name-rewriter #'stringify-tree-name))
  (if (node-tree-p node)
      (make-tree (funcall name-rewriter (tree-name node))
                 (tree-branches node))
    node))

И теперь мы можем объединить и переписать имена узлов:

> (map-node #'maybe-rewrite-node-name
                       (maybe-coalesce-node
                        '(a (b 1) (c (d (e 2))) (f (g (h 3) (i 4))))))
("a" ("b" 1) ("c+d+e" 2) ("f+g" ("h" 3) ("i" 4)))

---

В качестве упражнения: переписать maybe-coalesce-node в терминах map-node.

Answer 2

Дополнительная скобка возникает при вызове (my-func (cdr tree)), потому что в этот момент (cadr tree) является списком, поэтому (cdr tree) получит две скобки. Я не уверен, что вы подразумеваете под B + C. Предположим, вы возвращаете его в виде строки "B + C", поэтому мы будем использовать format для их объединения.

(defun my-func (tree)
  (cond
    ; base case
    ((null tree) nil)
    ; subtree is an atom
    ((atom tree) tree)
    ; subtree has one 
    ((and (atom (car tree)) (listp (car(cdr tree))) (= (length (cdr tree)) 1))
      (cons (format nil "~a+~a" (car tree) (caadr tree)) (mapcar #'my-func (cdadr tree))) )
    ; first element is atom
    ((atom (car tree))
      (cons (car tree) (mapcar #'my-func (cdr tree))))
    ; else
    (t (cons (my-func (car tree)) (my-func (cdr tree)))))
)

Вы также можете объединить B + C в виде списка, поэтому используйте (list (car tree) '+ (caadr)) tree) вместо format.