Деревья и графы

@Ligeros · Регистрация: 06.11.2013

Студворк — интернет-сервис помощи студентам

Здравствуйте, помогите пожалуйста переписать данный код на язык Haskell.

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
(defun forsome (L p) (COND ((NULL L) NIL) ((FUNCALL p (CAR L)) T) (T (forsome (CDR L) p))))
 
FORSOME
 
(defun del-node (tree v)
   (cond ((forsome tree #'(lambda (x) (eq (car x) v)))
          (let ((qq (cdar (remove-if-not #'(lambda (x) (eq v (car x))) tree)))
                (vv (remove-if #'(lambda (x) (eq v (car x))) tree)))
                (mapcar #'(lambda (x) (if (member v x)
                                          (append (remove v x) qq)
                                          x)) vv)))
         (t (remove-if #'(lambda (y) (null (cdr y)))
                 (mapcar #'(lambda (x) (remove v x)) tree))))) 
DEL-NODE
 
(setq *t* '((r a b) (a c d e) (b k l m) (d f g) (k n o) (l p)))
 
;((R A B) (A C D E) (B K L M) (D F G) (K N O) (L P))
 
(del-node *t* 'd)
 
;((R A B) (A C E F G) (B K L M) (K N O) (L P))
 
(del-node *t* 'g)
 
;((r a b) (a c d e) (b k L m) (d f) (k n o) (L p))

Заранее спасибо

@Shamil1 · 19.05.2015, 18:45

Для начала перевёл на понятный мне LISP

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
#lang racket
(define (forsome L p) (cond ((null? L) #f) 
                            ((p (car L)) #t) 
                            (else (forsome (cdr L) p))))
 
(define (del-node tree v)
   (cond ((forsome tree (lambda (x) (eqv? (car x) v)))
          (let ((qq (cdar (filter (lambda (x) (eqv? v (car x))) tree)))
                (vv (filter-not (lambda (x) (eqv? v (car x))) tree)))
                (map (lambda (x) (if (member v x)
                                          (append (remove v x) qq)
                                          x)) vv)))
         (else (filter-not (lambda (y) (null? (cdr y)))
                 (map (lambda (x) (remove v x)) tree))))) 
 
(define *t* '((r a b) (a c d e) (b k l m) (d f g) (k n o) (l p)))
 
(display *t*)
(newline)
(display (del-node *t* 'd))
(newline)
(display (del-node *t* 'g))

А потом уже Haskell (переводил "дословно"):

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
foresome :: (Eq a) => [a] -> (a -> Bool) -> Bool
foresome [] p     = False
foresome (x:xs) p = if (p x) then True
                                else foresome xs p 
 
remove v = filter (\x -> x /= v)
 
delnode :: (Eq a) => [[a]] -> a -> [[a]]
delnode tree v = if foresome tree (\x -> (head x) == v)
                 then do
                   let qq = tail $ head $ filter (\x -> v == head x) tree
                   let vv = filter (\x -> (head x) /= v) tree
                   map (\x -> if (elem v x) then ((remove v x) ++ qq) else x) vv
                 else filter (\y -> (tail y) /= []) (map (\x -> remove v x) tree)
 
tr = [['r', 'a', 'b'], ['a', 'c', 'd', 'e'], ['b', 'k', 'l', 'm'], ['d', 'f', 'g'], ['k', 'n', 'o'], ['l', 'p']]
 
main = do
  print $ tr
  print $ delnode tr 'd'
  print $ delnode tr 'g'

https://ideone.com/TpCQaa

@Catstail · 20.05.2015, 18:21

В Haskell эту задачу (в такой формулировке) можно решить проще. Например, так:

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
import Data.List
 
delNode :: [String] -> Char -> [String]
delNode tree v | (rnode == []) = map (delete v) tree               -- удаление листа
               | otherwise     = map (\ n -> if (v `elem` n) then  -- удаление вершины
                                                (delete v n)++(tail $ head rnode)
                                             else
                                                n) $ delete (head rnode) tree                                             
                 where rnode =  filter ((v ==).head) tree
 
-- Проба:
 
*Main Data.List> delNode ["rab", "acde", "bklm", "dfg","kno", "lp"] 'a'
["rbcde","bklm","dfg","kno","lp"]
 
 
*Main Data.List> delNode ["rab", "acde", "bklm", "dfg","kno", "lp"] 'b'
["raklm","acde","dfg","kno","lp"]
 
 
*Main Data.List> delNode ["rab", "acde", "bklm", "dfg","kno", "lp"] 'p'
["rab","acde","bklm","dfg","kno","l"]
 
 
*Main Data.List> delNode ["rab", "acde", "bklm", "dfg","kno", "lp"] 'l'
["rab","acde","bkmp","dfg","kno"]

Новые блоги и статьи Все статьи Все блоги /
Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ	Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .	Использование значений реквизитов справочника в документе, с определенными условиями и правами Maks 07.04.2026 1. Контроль срока действия договора Алгоритм из решения ниже реализован на примере нетипового документа "ЗаявкаНаРаботу", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если. . .
Доступность команды формы по условию Maks 07.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: сделать доступной кнопку (команда формы "ЗавершитьСписание") при. . .	Уведомление о неверно выбранном значении справочника Maks 06.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "НарядПутевка", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если в документе выбран неверный склад. . .	Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .	AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .