lomeo: (лямбда)
[personal profile] lomeo
На RSDN Tonal- задаёт вопрос о сериализации взаимно-рекурсивных данных.

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

Поэтому в голову приходит замечательный пакет data-reify от Andy Gill. О его применении можно прочитать в статье Type-Safe Observable Sharing in Haskell.

Смысл в том, что мы можем разложить рекурсивные данные на нерекурсивные данные со ссылками - то, что нам и нужно.

Т.е. для типов из примера Tonal-
data A = A {a_unuqId :: Int, a_refs :: [B]}
data B = B {b_unuqId :: Int, b_refs :: [A]}

это будет
data N u = AN { an_uniqId :: Int, an_refs :: [u] }
         | BN { bn_uniqId :: Int, bn_refs :: [u] }

Обратите внимание на дырки `u', оставленные для рекурсии - по сути A ~ N B и наоборот.
Пишем instance для MuRef
instance MuRef A where
    type DeRef A = N
    mapDeRef f (A i rs) = AN i <$> sequenceA (map f rs)

instance MuRef B where
    type DeRef B = N
    mapDeRef f (B i rs) = BN i <$> sequenceA (map f rs)

и получаем нужный граф, например
> let { a = A 1 [b] ; b = B 2 [a] }
> reifyGraph a
let [(1,AN {an_uniqId = 1, an_refs = [2]}),(2,BN {bn_uniqId = 2, bn_refs = [1]})] in 1

или
> let { a1 = A 1 [b1, b2] ; a2 = A 2 [b2] ; b1 = B 3 [a1] ; b2 = B 4 [a1, a2] }
> reifyGraph a1
let [(1,AN {an_uniqId = 1, an_refs = [2,3]}),
     (3,BN {bn_uniqId = 4, bn_refs = [1,4]}),
     (4,AN {an_uniqId = 2, an_refs = [3]}),
     (2,BN {bn_uniqId = 3, bn_refs = [1]})] in 1

Меня здесь смущает тип [(Unique, g Unique)], всё таки хочется IntMap (g Unique) - быстрее и десериализация будет проще. Впрочем, переписать библиотеку должно быть несложно.

При десериализации придётся обращать граф в конкретный тип, например, A. Это дополнительные телодвижения, но зато весь код у нас более общий и не привязан конкретно к сериализации. Например, необходимо использовать мемоизацию:
graphToA :: Graph (DeRef A) -> A
graphToA (Graph gs i) = ma ! i
    where
        ma = fromList [ (i, A ai $ map (mb!) rs) | (i, AN ai rs) <- gs ]
        mb = fromList [ (i, B bi $ map (ma!) rs) | (i, BN bi rs) <- gs ]


Покритикуйте.

Date: 2010-02-05 01:55 pm (UTC)
From: [identity profile] migmit.vox.com (from livejournal.com)
Мне не слишком нравится сваливание всех типов в один. Если у них будут по нескольку конструкторов - станет messy. Not terribly, но всё же.

Надо будет подумать, как это получше написать.

Date: 2010-02-05 02:01 pm (UTC)
From: [identity profile] lomeo.livejournal.com
Меня это тоже смутило. Но я не нашёл, как выкрутиться, DeRef у них, похоже должен быть общим :(

Date: 2010-02-05 02:30 pm (UTC)
From: [identity profile] migmit.vox.com (from livejournal.com)
Хотя бы разнести, чтобы они не перемешивались:
data N :: * -> * -> * where
    N_A :: Int -> [u] -> N A u
    N_B :: Int -> [u] -> N B u

Date: 2010-02-05 01:56 pm (UTC)
From: [identity profile] voidex.livejournal.com
Как раз недавно возился с такой задачей, жаль на библиотеку не наткнулся. Правда, у меня были некоторые особенности, так что библиотека вряд ли подошла бы именно в таком виде, но возможно я бы её подправил.

Date: 2010-02-05 02:02 pm (UTC)
From: [identity profile] lomeo.livejournal.com
Я вот тут подумал, а что если подправить uniplate так, чтобы он возвращал только уникальные значения? Тогда легко можно делать что-то вроде

[ id | A id _ <- universeBi a ]

чтобы получить _конечный_ список всех нужных полей.

спасибо

Date: 2010-02-05 02:41 pm (UTC)
From: [identity profile] nealar.livejournal.com
Для одной задачи нужно то же самое преобразование. Только не для сериализации.

Date: 2010-02-05 06:22 pm (UTC)
From: [identity profile] permea-kra.livejournal.com
может, правильней добавить в конструктор поле, которому будет при создании экземпляра типа присваиваться уникальное значение? (как это сделать - вопрос отдельный)

Date: 2010-02-06 07:07 am (UTC)
From: [identity profile] lomeo.livejournal.com
Не понял, разве при создании графа не то же самое происходит?

Date: 2010-02-06 11:09 am (UTC)
From: [identity profile] permea-kra.livejournal.com
протупил.

для
data A = A {a_unuqId :: Int, a_refs :: [B]}
data B = B {b_unuqId :: Int, b_refs :: [A]}
сериализуем в монаде
type Ser a = StateT (Set.Set Int) (Writer [Word8]) a


посещённые Id добавляем в стейт, рекурсивный обход можно делать чем угодно, главное, чтоб было удобно.
Чем плохо такое решение в лоб ?

Date: 2010-02-06 09:44 pm (UTC)
From: [identity profile] lomeo.livejournal.com
Тем, что всё делаем руками.

Date: 2010-02-07 07:37 am (UTC)
From: [identity profile] lomeo.livejournal.com
Руками работаем с Id - добавляем их в стейт.

Date: 2010-02-07 07:57 am (UTC)
From: [identity profile] permea-kra.livejournal.com
есть мнение, что Data.Generics.mkM , Data.Data.gmapQ и один newtype Id = Id Int deriving (Data,Typeable) позволят всё написать один раз (и достаточно компактно) и забыть. И по крайней мере для меня это было бы проще, чем разбираться с тараканами в чужих библиотеках.

Date: 2010-02-07 08:50 am (UTC)
From: [identity profile] lomeo.livejournal.com
Покажи код.

Date: 2010-02-07 11:40 am (UTC)
From: [identity profile] permea-kra.livejournal.com
inspired by Data.Generics.Text

 
module Ser
where
import Data.Generics
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Identity
import qualified Data.Set as Set
import Data.Maybe

ifIsId :: (Monad m, MonadState (Set.Set Id) m ) => Id -> m () -> m () -> m ()
ifIsId iD onS onF =	do
			s <- get
			let is = Set.member iD s
			if is then onS else onF

newtype Id = Id { unId :: Int} deriving (Data,Typeable,Show,Read,Ord,Eq)

getIdMaybe :: (Data a, Typeable a) => a -> Maybe Id 
-- ^ get Id for this node. 
-- Limitation : no more then one id per node or undefined behaivor
getIdMaybe = listToMaybe . catMaybes . (gmapQ (mkQ Nothing (Just :: Id -> Maybe Id)))

type SerM a = StateT (Set.Set Id) (WriterT String Identity) a

serV :: (Data v, Typeable v) => v -> SerM ()
serV v =	do
		tell "{ " 
		case (getIdMaybe v) of -- brunch if value has identifier
			Just iD	-> ifIsId iD ( tell $ "linkTo " ++ (show $ unId iD) ) (serRi v iD)
			Nothing -> (serRs v)
		tell " }"
		where 	serRi v iD = 	(modify $ Set.insert iD) >>
					tell (showConstr $ toConstr v) >>
		                     	tell (" id = " ++ (show $ unId iD) ) >>
					(sequence_ $ gmapQ serV v)  
			serRs v = tell (showConstr $ toConstr v) >> (sequence_ $ gmapQ serV v)
		
runSer :: (Data v, Typeable v) => v -> String
runSer v = runIdentity $ execWriterT $ evalStateT (serV v) Set.empty

data A = A { id_A :: Id , ref_B :: Maybe B } 			deriving (Data,Typeable)
data B = B { id_B :: Id , ref_A :: Maybe A, ref_C :: Maybe C } 	deriving (Data,Typeable)
data C = C { ind_ref_A :: Maybe A }				deriving (Data,Typeable)

test :: A
test = 	let 	top = A (Id 1) (Just sb)
		sb  = B (Id 2) (Just top) (Just sc)
		sc  = C (Just top)
	in top


Тест:
*Ser> runSer test
"{ A id = 1{ Id{ 1 } }{ Just{ B id = 2{ Id{ 2 } }{ Just{ linkTo 1 } }{ Just{ C{ Just{ linkTo 1 } } } } } } }"


Десериализацию с ходу не напишу, надо будет gread покурить. По идее, пишется.

Date: 2010-02-08 06:58 am (UTC)
From: [identity profile] lomeo.livejournal.com
Да, понял, спасибо за код.

Версия, которая не зависит от Id (пользую StableName)
http://hpaste.org/fastcgi/hpaste.fcgi/view?id=17329#a17329

В uniplate, чтобы поддерживал рекурсивные данные, это красиво не засунешь :-( Потому что IO.

Date: 2010-02-08 07:06 am (UTC)
From: [identity profile] permea-kra.livejournal.com
Ошибка базы. Может, в pre-теге в коммент кинете ?

Date: 2010-02-08 07:08 am (UTC)
From: [identity profile] lomeo.livejournal.com
А я уже убил. Но вот uniplate-like с unsafePerformIO

{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
module Ser
where
import Data.Generics
import Control.Monad.State
import Control.Monad.Writer
import qualified Data.Set as Set
import Data.Maybe
import System.Mem.StableName
import System.IO.Unsafe
import Debug.Trace

type LinkSet = Set.Set Int

presents :: (Monad m, MonadState LinkSet m) => Int -> m Bool
presents iD = gets (Set.member iD)

type SerM r a = StateT LinkSet (WriterT [r] IO) a

goRec :: (Data v, Data r) => v -> SerM r ()
goRec v = do
    iD <- v `seq` (hashStableName `fmap` liftIO (makeStableName v))
    p <- presents iD
    unless p $ do
        modify $ Set.insert iD
        case cast v of
            Just v0 -> serRi v0 iD
            Nothing -> continue
    where
        serRi v iD = tell [v] >> continue
        continue = sequence_ $ gmapQ goRec v

recUniplate :: (Data v, Data r) => v -> [r]
recUniplate v = unsafePerformIO $ execWriterT $ evalStateT (goRec v) Set.empty

data Rose = Rose { roseId :: Int, roses :: [Rose] }
    deriving (Data,Typeable)

testRose = let
        a = Rose 1 [b,c]
        b = Rose 2 [a,c]
        c = Rose 3 [a,b]
    in a


Работаем...

> [id | Rose id _ <- recUniplate testRose]
[1,2,3]

Date: 2010-02-08 07:12 am (UTC)
From: [identity profile] permea-kra.livejournal.com
Ага. Спасибо, симпатичненько.

Date: 2010-02-08 12:34 pm (UTC)
From: [identity profile] permea-kra.livejournal.com
Хм. Это вы ручками код выправили или какой-то тульзой ?

Date: 2010-02-08 01:09 pm (UTC)
From: [identity profile] lomeo.livejournal.com
Ручками, пока разбирался с вашим :)

Date: 2010-02-08 03:17 pm (UTC)
From: [identity profile] permea-kra.livejournal.com
Бгы. Надо бы какие-то гайдлайны по форматированию хаскельного кода что ли поискать...

Date: 2010-02-08 04:05 pm (UTC)
From: [identity profile] lomeo.livejournal.com
http://www.haskell.org/haskellwiki/Programming_guidelines
http://haskell.org/haskellwiki/Things_to_avoid - тут не форматирование

Ещё есть соглашения для GHC sources, оттуда тоже можно взять что-нибудь полезное.

Поиск haskell beautifier не дал ничего полезного :(

Date: 2010-02-08 05:55 pm (UTC)
From: [identity profile] permea-kra.livejournal.com
Спасибо, почитаем.

Date: 2010-02-05 08:14 pm (UTC)
From: [identity profile] migmit.vox.com (from livejournal.com)
Вообще, смахивает на подходящую работу для multirec.

Date: 2010-02-05 10:10 pm (UTC)
From: [identity profile] migmit.vox.com (from livejournal.com)
http://hackage.haskell.org/package/multirec

Re: а оно уже работает?

Date: 2010-02-05 11:14 pm (UTC)
From: [identity profile] migmit.vox.com (from livejournal.com)
http://hackage.haskell.org/packages/archive/multirec/0.4.1/logs/failure/ghc-6.12

haddock: internal Haddock or GHC error: dist/doc/html/multirec/haddock-prolog4983.txt: hGetContents: invalid argument (Invalid or incomplete multibyte or wide character)

Я думаю, мы переживём отсутствие автодокументации. Но даже если оно не скомпилится - идея там достаточно простая, можно и самостоятельно воспроизвести.

Re: а оно уже работает?

Date: 2010-02-05 11:17 pm (UTC)
From: [identity profile] nealar.livejournal.com
Это понятно, просто если оно хотя бы теоретически работает, то можно идею вкуривать. А если нет - лень время тратить. Уж очень я медленно по-английски читаю.

Re: а оно уже работает?

Date: 2010-02-06 12:03 am (UTC)
From: [identity profile] migmit.vox.com (from livejournal.com)
Под ghc 6.10 сбилдилось нормально.

Date: 2010-02-06 08:29 am (UTC)
From: [identity profile] lomeo.livejournal.com
Спасибо! Посмотрю.

Profile

lomeo: (Default)
Dmitry Antonyuk

December 2015

S M T W T F S
  12345
6789101112
131415 16171819
20212223242526
2728293031  

Most Popular Tags

Style Credit

Expand Cut Tags

No cut tags
Page generated Jul. 22nd, 2017 04:45 pm
Powered by Dreamwidth Studios