Advertisement
Guest User

Untitled

a guest
Jun 12th, 2019
145
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.29 KB | None | 0 0
  1. (defun flatten-children-at-depth (tree depth)
  2. (cond ((minusp depth) tree)
  3. ((zerop depth) (if (tree-leaf-p tree)
  4. tree
  5. (tree-make-tree (tree-label tree)
  6. (mapcan (lambda (child)
  7. (if (tree-leaf-p child)
  8. (list child)
  9. (copy-list (tree-children child))))
  10. (tree-children tree)))))
  11. (t (if (tree-leaf-p tree)
  12. tree
  13. (tree-make-tree (tree-label tree)
  14. (mapcar (lambda (child)
  15. (flatten-children-at-depth child (- depth 1)))
  16. (tree-children tree)))))))
  17.  
  18. (defun flatten-deepest-children (tree)
  19. (flatten-children-at-depth tree (- (depth tree) 3)))
  20.  
  21. (flatten-deepest-children (tree-make-tree nil (list (tree-make-leaf 'a) (tree-make-tree nil (list (tree-make-leaf 'b))) (tree-make-leaf 'c))))
  22. ;; -> (a b c)
  23.  
  24. (flatten-deepest-children
  25. ;; (a (b (c) d) e ((f g) h i) j)
  26. (tree-make-tree nil (list (tree-make-leaf 'a)
  27. (tree-make-tree nil (list (tree-make-leaf 'b)
  28. (tree-make-tree nil (list (tree-make-leaf 'c)))
  29. (tree-make-leaf 'd)))
  30. (tree-make-leaf 'e)
  31. (tree-make-tree nil (list (tree-make-tree nil (list (tree-make-leaf 'f)
  32. (tree-make-leaf 'g)))
  33. (tree-make-leaf 'h)
  34. (tree-make-leaf 'i)))
  35. (tree-make-leaf 'j))))
  36. ;; --> (a (b c d) e (f g h i) j)
  37.  
  38.  
  39.  
  40. (flatten-deepest-children
  41. ;; (a (b (c) d) e ((f (e a d) g) h i) j)
  42. (tree-make-tree nil (list (tree-make-leaf 'a)
  43. (tree-make-tree nil (list (tree-make-leaf 'b)
  44. (tree-make-tree nil (list (tree-make-leaf 'c)))
  45. (tree-make-leaf 'd)))
  46. (tree-make-leaf 'e)
  47. (tree-make-tree nil (list (tree-make-tree nil (list (tree-make-leaf 'f)
  48. (tree-make-tree nil (list (tree-make-leaf 'e)
  49. (tree-make-leaf 'a)
  50. (tree-make-leaf 'd)))
  51. (tree-make-leaf 'g)))
  52. (tree-make-leaf 'h)
  53. (tree-make-leaf 'i)))
  54. (tree-make-leaf 'j))))
  55. ;; --> (a (b (c) d) e ((f e a d g) h i) j)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement