nnet code

-- Copyright 2012 gatoatigrado (nicholas tung) [ntung at ntung]
-- Licensed under the Apache License, Version 2.0 (the "License"); you may
-- not use this file except in compliance with the License. You may obtain a
-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0 .

-- enable to remove excess imports {-# OPTIONS_GHC -fwarn-unused-imports #-}
{-# LANGUAGE Arrows,
             BangPatterns,
             ConstraintKinds,
             DefaultSignatures,
             DeriveDataTypeable,
             EmptyDataDecls,
             FlexibleContexts,
             FlexibleInstances,
             FunctionalDependencies,
             GADTs,
             GeneralizedNewtypeDeriving,
             ImpredicativeTypes,
             MultiParamTypeClasses,
             NamedFieldPuns,
             NoMonomorphismRestriction,
             RankNTypes,
             ScopedTypeVariables,
             StandaloneDeriving,
             TemplateHaskell,
             TupleSections,
             TypeFamilies,
             TypeOperators,
             TypeSynonymInstances,
             UndecidableInstances,
             ViewPatterns #-}

module Test where

import Prelude hiding (id, (.))
import Control.Arrow
import Control.Applicative
import Control.Category
-- import Control.Exception
import Control.Monad
import Control.Monad.Trans.Class
-- import Control.Monad.ST
-- import Control.Monad.State

-- import qualified Data.Map as Map
-- import qualified Data.List as List
-- import qualified Data.List.HT as HT
import qualified Data.List.Key as Key
-- import Data.Maybe
-- import Data.StateRef

-- import Debug.Trace

import Text.Printf

newtype Node = Node Char deriving (Eq, Ord, Show)

data Weight = Weight Node Node Float

nodes = map Node "abcde"

weights = [
    Weight (Node 'a') (Node 'c') 1,
    Weight (Node 'b') (Node 'c') 1,
    Weight (Node 'a') (Node 'd') (-2),
    Weight (Node 'c') (Node 'd') 2,
    Weight (Node 'd') (Node 'e') 3,
    Weight (Node 'c') (Node 'e') 2,
    Weight (Node 'b') (Node 'e') (-3)]

assns :: [[Node]]
assns = assign_nodes "abcde" where
    assign_nodes [] = return []
    assign_nodes (x:xs) = do
        (++) <$> assign x <*> assign_nodes xs
        where
            assign (Node -> c) = [[], [c]]

energy :: [Weight] -> [Node] -> Float
energy [] _ = 0
energy ((Weight x y w):ws) nodes
    | elem x nodes && elem y nodes = w + energy ws nodes
    | otherwise = energy ws nodes

byEnergy = Key.sort (energy weights) assns