Лучше программирование в Haskell Tree

Question

меня такая ситуация:

data BT1 a = Nd a (BT1 a) (BT1 a) | Lf deriving (Show, Eq) 
data trG = trG { title :: String, authors :: [String], price :: Double } 
       deriving (Show, Eq, Ord) 

g1 = trG "Alsace" ["JP Robin"] 45 
g2 = trG "Picardie" ["Auguste Renoir"] 40 
g3 = trG "Gironde" ["Alain Schwartz"] 35 
g4 = trG "France" ["Jean Dalverny"] 42 
g5 = trG "GB" ["Vidal Cameron"] 50 
g6 = trG "Germany" ["Auguste Renoir"] 48 
g7 = trG "USA" ["John Kennedy"] 60 

g1..g7 находятся в BT1 дерева (не предполагается бинарным)

gtNam = Nd g4 
     (Nd g6 
      (Nd g5 Lf Lf) 
      (Nd g1 Lf Lf)) 
     (Nd g2 
      (Nd g3 Lf Lf) 
      (Nd g7 Lf Lf)) 

функцию, пытаясь найти книга данного автора в дереве gtNam (giveAuthor и giveTitle две небольшие функции, они дают автора и название книги)

treeFindAuthorBook :: String -> BT1 trG -> [[Char]] 
treeFindAuthorBook _ Lf = [""] 
treeFindAuthorBook str (Nd v l r) = do 
    let m = find (==str) (giveAuthor v) 
    if m == Nothing 
    then do 
     k <- treeFindAuthorBook str l 
     if k == "" 
     then treeFindAuthorBook str r 
     else 
     [k] 
    else 
     return (giveTitle v) 

1) Я хотел бы написать его более похожим на Haskell образом

2) Как я могу сделать, чтобы накапливать в списке все книги, возможно, написанные данным автором?

Answer 1

Я написал бы treeFindAuthorBook более функциональным способом, как это предполагается, что вы используете GHC:

{-# LANGUAGE RecordWildCards #-} 

data BT1 a = Nd a (BT1 a) (BT1 a) | Lf deriving (Show, Eq) 
data TrG = TrG { trgTitle :: String, trgAuthors :: [String], trgPrice :: Double } 
       deriving (Show, Eq, Ord) 


treeFindAuthorBook :: String -> BT1 TrG -> [String] 
treeFindAuthorBook _ Lf = [] 
treeFindAuthorBook author (Nd TrG {..} left right) 
    | author `elem` trgAuthors = trgTitle : rest 
    | otherwise = rest 
    where 
    rest = treeFindAuthorBook author left ++ treeFindAuthorBook author right 

директива «RecordWildcars» в начале позволяет GHC специфические синтаксические расширения, где мы можем использовать имена полей TrG «напрямую». См. Также here.

EDIT: Обратите внимание, что я переименовал поле записи с помощью добавления префикса «trg-» префикс, который более или менее условности, чтобы избежать конфликтов имен ...

Если вы хотите, чтобы вернуть список книги вместо названий, то легко адаптировать решение выше:

treeFindAuthorBook :: String -> BT1 TrG -> [TrG] 
treeFindAuthorBook _ Lf = [] 
treeFindAuthorBook author (Nd book@TrG {..} left right) 
    | author `elem` trgAuthors = book : rest 
    | otherwise = rest 
    where 
    rest = treeFindAuthorBook author left ++ treeFindAuthorBook author right 

Answer 2

Некоторые вопросы:

1. Вы говорите, что дерево BT1 «не считается двоичным» - но он определен быть бинарным деревом. Вы имели в виду, скажем, что это не считается полным или что-то в этом роде?
2. Вы хотите, чтобы у «Листов» не было элементов на них? Вы могли бы назвать это Empty, если это ваша цель, а не Lf.

Что касается написания этого в Haskell-подобным образом, вероятно, лучший способ для импорта Traversable:

import Control.Applicative 
import Data.Traversable 
import Data.Foldable 

data Tree x = Empty | Tree (Tree x) x (Tree x) 

instance Traversable Tree where 
    traverse _ Empty = pure Empty 
    traverse fb_a (Tree left a right) = 
     Tree <$> traverse fb_a left <*> fb_a a <*> traverse fb_a right 

instance Functor Tree where fmap = fmapDefault 
instance Foldable Tree where foldMap = foldMapDefault 

С помощью всего лишь те несколько строк кода, вы получите силу Data.Foldable, что позволяет вы должны сделать довольно произвольные агломерации на Дереве. Например, вы можете преобразовать дерево непосредственно в список, используя toList.

Тип foldMap: Monoid m => (a -> m) -> t a -> m. Мы можем определить «ищет авторов» с помощью [x] моноид как:

isAuthor :: String -> TrG -> [String] 
isAuthor auth trg | auth `elem` trgAuthors trg = [trgTitle trg] 
        | otherwise = [] 

, а затем ваш код foldMap (isAuthor "Auguste Renoir") gtNam. Если вы хотите получить всю запись книги, а не только название, вы можете заменить [trgTitle trg] на [trg] выше. Фактически, существует общая функция, которая должна быть в Data.Складная, но нет:

findAll :: (Foldable t) => (a -> Bool) -> t a -> [a] 
findAll pred = foldMap (\a -> if pred a then [a] else []) 

, который в некотором смысле является «фильтром» на произвольной складной.