MESSAGE
DATE | 2016-11-03 |
FROM | Ruben Safir
|
SUBJECT | Re: [Learn] Fitch Algorithm - C++
|
From learn-bounces-at-nylxs.com Thu Nov 3 02:15:39 2016 Return-Path: X-Original-To: archive-at-mrbrklyn.com Delivered-To: archive-at-mrbrklyn.com Received: from www.mrbrklyn.com (www.mrbrklyn.com [96.57.23.82]) by mrbrklyn.com (Postfix) with ESMTP id CA9FF161312; Thu, 3 Nov 2016 02:15:38 -0400 (EDT) X-Original-To: learn-at-nylxs.com Delivered-To: learn-at-nylxs.com Received: from mailbackend.panix.com (mailbackend.panix.com [166.84.1.89]) by mrbrklyn.com (Postfix) with ESMTP id 0A2CD160E77 for ; Thu, 3 Nov 2016 02:15:33 -0400 (EDT) Received: from [10.0.0.62] (www.mrbrklyn.com [96.57.23.82]) by mailbackend.panix.com (Postfix) with ESMTPSA id 4E30819BE3; Thu, 3 Nov 2016 02:15:33 -0400 (EDT) To: Bayna Robertson , learn-at-nylxs.com References: <20161102182751.GA10998-at-www.mrbrklyn.com> <87k2cl7184.fsf-at-contrapunctus.net> <2ab889a4-74bd-7670-b872-04bb8af301ce-at-panix.com> From: Ruben Safir Message-ID: <5f728739-0e87-30d4-6883-d3d5808e116f-at-panix.com> Date: Thu, 3 Nov 2016 02:15:32 -0400 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.4.0 MIME-Version: 1.0 In-Reply-To: Subject: Re: [Learn] Fitch Algorithm - C++ X-BeenThere: learn-at-nylxs.com X-Mailman-Version: 2.1.17 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: quoted-printable Errors-To: learn-bounces-at-nylxs.com Sender: "Learn"
On 11/03/2016 01:47 AM, Bayna Robertson wrote: > The language is very interesting I understand it mostly and what it does > I just might have questions on some parts of the program. > =
Maybe so but Haskell is not going on my language stack at this point. I have R, Python and I need to refresh my C++, in addition to the statistics. And I'm planning on integrating CLIPS into this along the way for some AI.
If I write the C++ template correctly, I should be able to flip in and out different algorithms onto the tree, and connect the data to a RBMS for storage and retrieval.
> On Wednesday, November 2, 2016, Ruben Safir > > wrote: > =
> On 11/02/2016 10:20 PM, Christopher League wrote: > > Tonight I put together a small Haskell script for the Fitch algorit= hm. > > You specify a tree with its leaves labeled, and it figures out the > > labels for the interior nodes. There are no transition weights. It > > outputs the tree in GraphViz format, so we use |dot| to generate the > > image=E2=80=A6 see attached. > > > =
> I knew you were going to go impatient and do that. > =
> =
> > |{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, > TupleSections #-} > > import Data.List (intersperse) import Data.Set (Set) import > > Control.Monad.State import Control.Monad.Writer import qualified > > Data.Set as Set data Tree a b =3D Leaf {leafValue :: b } | Branch > > {branchValue :: a ,branchLeft :: Tree a b ,branchRight :: Tree a b } > > deriving Show value :: Tree a a -> a value (Leaf a) =3D a value > (Branch a > > _ _) =3D a -- Bottom up phase1 :: Ord b =3D> Tree a b -> (Set b, Tr= ee (Set > > b) b) phase1 (Leaf b) =3D (Set.singleton b, Leaf b) phase1 (Branch _ > l r) > > =3D (s3, Branch s3 l' r') where (s1, l') =3D phase1 l (s2, r') =3D > phase1 r s3 > > =3D if Set.null i then u else i where u =3D Set.union s1 s2 i =3D > > Set.intersection s1 s2 -- Top down phase2 :: Ord b =3D> Tree (Set b) > b -> > > Maybe b -> Tree b b phase2 (Leaf b) _ =3D Leaf b phase2 (Branch set= left > > right) parentOpt =3D Branch b (phase2 left (Just b)) (phase2 right = (Just > > b)) where b =3D case parentOpt of Just p | Set.member p set -> p _ = -> > > Set.elemAt 0 set -- Combine them together fitch :: Ord b =3D> Tree a > b -> > > Tree b b fitch t =3D phase2 t' Nothing where (_, t') =3D phase1 t > > ------------------------------------------------------------------ = -- > > This part is about visualizing the trees using GraphViz (dot) class > > ToLabel a where toLabel :: a -> String instance ToLabel Char where > > toLabel c =3D [c] instance ToLabel String where toLabel =3D id inst= ance > > ToLabel a =3D> ToLabel (Set a) where toLabel s =3D "{" ++ concat > > (intersperse "," (map toLabel (Set.toList s))) ++ "}" next :: > State Int > > Int next =3D get <* modify (+1) numberTree :: Tree a b -> State Int > (Tree > > (Int,a) (Int,b)) numberTree (Leaf b) =3D Leaf . (,b) <$> next numbe= rTree > > (Branch a l r) =3D Branch . (,a) <$> next <*> numberTree l <*> > numberTree > > r graphViz' :: (ToLabel a, ToLabel b) =3D> Tree (Int,a) (Int,b) -> > Writer > > String String graphViz' (Leaf (i,b)) =3D do let n =3D "n" ++ show i > tell $ n > > ++ " [shape=3Dbox, label=3D\"" ++ toLabel b ++ "\"]\n" return n gra= phViz' > > (Branch (i,a) l r) =3D do n1 <- graphViz' l n2 <- graphViz' r let np > =3D "n" > > ++ show i tell $ np ++ " [shape=3Doval, label=3D\"" ++ toLabel a ++ > "\"]\n" > > tell $ np ++ " -> " ++ n1 ++ "\n" tell $ np ++ " -> " ++ n2 ++ "\n" > > return np graphViz :: (ToLabel a, ToLabel b) =3D> Tree a b -> String > > graphViz t =3D "digraph{\n" ++ execWriter (graphViz' t') ++ "}\n" > where t' > > =3D evalState (numberTree t) 0 -- Sample tree from > > > http://www.cse.nd.edu/~cse/2013fa/40532/lectures/lecture23/lecture23.= pdf > 23.pdf> > > t1 :: Tree () Char t1 =3D Branch () ( Branch () ( Branch () (Leaf '= C') > > (Leaf 'G') ) ( Branch () (Leaf 'T') (Leaf 'G') ) ) (Leaf 'A') main > :: IO > > () main =3D putStrLn $ graphViz $ fitch t1| > > > > > > > > _______________________________________________ > > Learn mailing list > > Learn-at-nylxs.com > > http://lists.mrbrklyn.com/mailman/listinfo/learn > > > > =
> =
> -- > So many immigrant groups have swept through our town > that Brooklyn, like Atlantis, reaches mythological > proportions in the mind of the world - RI Safir 1998 > http://www.mrbrklyn.com > =
> DRM is THEFT - We are the STAKEHOLDERS - RI Safir 2002 > http://www.nylxs.com - Leadership Development in Free Software > http://www2.mrbrklyn.com/resources > - Unpublished Archive > http://www.coinhangout.com - coins! > http://www.brooklyn-living.com > =
> Being so tracked is for FARM ANIMALS and and extermination camps, > but incompatible with living as a free human being. -RI Safir 2013 > _______________________________________________ > Learn mailing list > Learn-at-nylxs.com > http://lists.mrbrklyn.com/mailman/listinfo/learn > > =
-- =
So many immigrant groups have swept through our town that Brooklyn, like Atlantis, reaches mythological proportions in the mind of the world - RI Safir 1998 http://www.mrbrklyn.com
DRM is THEFT - We are the STAKEHOLDERS - RI Safir 2002 http://www.nylxs.com - Leadership Development in Free Software http://www2.mrbrklyn.com/resources - Unpublished Archive http://www.coinhangout.com - coins! http://www.brooklyn-living.com
Being so tracked is for FARM ANIMALS and and extermination camps, but incompatible with living as a free human being. -RI Safir 2013 _______________________________________________ Learn mailing list Learn-at-nylxs.com http://lists.mrbrklyn.com/mailman/listinfo/learn
|
|