packages feed

caffegraph (empty) → 0.1.0.0

raw patch · 15 files changed

+697/−0 lines, 15 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, fgl, filepath, graphviz, language-lua, lens, mtl, optparse-applicative, process, protocol-buffers, protocol-buffers-descriptor, template-haskell, temporary, text

Files

+ LICENSE view
@@ -0,0 +1,30 @@+The BSD License
+
+Copyright (c) <YEAR>, <OWNER>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without 
+modification, are permitted provided that the following conditions are met:
+
+   - Redistributions of source code must retain the above copyright notice, 
+     this list of conditions and the following disclaimer. 
+
+   - Redistributions in binary form must reproduce the above copyright notice, 
+     this list of conditions and the following disclaimer in the documentation 
+     and/or other materials provided with the distribution. 
+
+   - Neither the name of the <ORGANIZATION> nor the names of its contributors 
+     may be used to endorse or promote products derived from this software 
+     without specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
+POSSIBILITY OF SUCH DAMAGE
+ NN.hs view
@@ -0,0 +1,11 @@+module NN(module NN.DSL,+          module NN.CLI,+          module NN.Graph,+          module NN.Passes,+          module NN.Visualize) where++import           NN.CLI+import           NN.DSL+import           NN.Graph+import           NN.Passes+import           NN.Visualize
+ NN/Backend/Caffe.hs view
@@ -0,0 +1,19 @@+module NN.Backend.Caffe where++import           Gen.Caffe.NetParameter     as NP++import           Control.Lens+import           Data.Graph.Inductive.Query+import qualified Data.Sequence              as S++import           NN.DSL+import           NN.Passes++caffePasses :: [Pass]+caffePasses = [addConnection, addLabels] ++ optimizeInPlaceLayer ReLU ++ optimizeInPlaceLayer Dropout++middleEnd :: Net -> Net+middleEnd = optimizeWith caffePasses++backend :: Net -> NetParameter+backend gr = def & _layer <>~ S.fromList (topsort' gr)
+ NN/Backend/Torch.hs view
@@ -0,0 +1,9 @@+module NN.Backend.Torch(NN.Backend.Torch.backend) where++import           NN.Backend.Torch.Codegen+import           NN.Backend.Torch.Torch++import           NN.DSL++backend :: Net -> Maybe String+backend  = fmap (codegen . lower) . linearize . clean
+ NN/CLI.hs view
@@ -0,0 +1,56 @@+module NN.CLI where++import           Control.Applicative+import           Control.Lens          hiding ((<.>))+import           Control.Monad+import qualified Data.ByteString.Lazy  as BS+import           NN.Backend.Caffe      as Caffe+import           NN.Backend.Torch      as Torch+import           NN.DSL+import           NN.Passes+import           NN.Visualize+import           Options.Applicative   hiding ((&))+import           System.Exit+import           System.FilePath.Posix+import           System.Process+import           Text.ProtocolBuffers  as P++caffePrototxt :: NetBuilder -> FilePath -> FilePath -> IO ()+caffePrototxt net prototxtPath binaryToText' = do+  parse net & Caffe.middleEnd & Caffe.backend & messagePut & BS.writeFile binaryPath+  rawSystem binaryToText' [binaryPath, prototxtPath] >>= exitWith+    where+      binaryPath = prototxtPath <.> "protobinary"++netPdf :: NetBuilder -> FilePath -> IO ()+netPdf net path = void $ visualize (parse net) & pdf path++torchCode :: NetBuilder -> FilePath -> IO ()+torchCode net path = do+  let Just code = parse net & Torch.backend+  writeFile path code++data Command = Caffe String String | Torch String | PDF String++filename = strOption (long "output" <> help "Write output to FILE" <> metavar "FILE")+binaryToText = strOption (long "binary_to_text"+                          <> help "Path to binary_to_text.py BINARY"+                          <> showDefault+                          <> metavar "BINARY"+                          <> value "./binary_to_text.py")++opts :: Parser Command+opts = subparser (caffe <> torch <> pdf')+       where+         nc name parser desc = command name (info (helper <*> parser) (progDesc desc))+         caffe = nc "caffe" (Caffe <$> filename <*> binaryToText) "Generate a Caffe .prototxt to run with `caffe train --model=<>"+         torch = nc "torch" (Torch <$> filename) "Generate Lua code to be `require`'d into an existing Torch script"+         pdf' = nc "pdf" (PDF <$> filename) "Generate a PDF visualizing the model's connectivity"++run :: NetBuilder -> Command -> IO ()+run net (Caffe prototxtPath binaryToTextPath) = caffePrototxt net prototxtPath binaryToTextPath+run net (Torch path) = torchCode net path+run net (PDF path) = netPdf net path++cli :: NetBuilder -> IO ()+cli net = execParser (info (helper <*> opts) idm) >>= run net
+ NN/DSL.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE OverloadedStrings #-}+module NN.DSL(module NN.DSL, P.Phase(..), DP.DB(..), LP.LayerParameter) where++import           Gen.Caffe.AccuracyParameter           as AP+import           Gen.Caffe.ConvolutionParameter        as CP+import           Gen.Caffe.DataParameter               as DP+import           Gen.Caffe.DataParameter.DB            as DP+import           Gen.Caffe.DropoutParameter            as DP+import           Gen.Caffe.FillerParameter             as FP+import           Gen.Caffe.InnerProductParameter       as IP+import           Gen.Caffe.LayerParameter              as LP+import           Gen.Caffe.LRNParameter                as LRN+import           Gen.Caffe.NetStateRule                as NS+import           Gen.Caffe.ParamSpec                   as PS+import           Gen.Caffe.Phase                       as P+import           Gen.Caffe.PoolingParameter            as PP+import           Gen.Caffe.PoolingParameter.PoolMethod as PP+import           Gen.Caffe.TransformationParameter     as TP++import           Control.Lens+import           Data.Maybe+import           Data.Sequence+import           Text.ProtocolBuffers                  as P++import           NN.Graph++type Net = Gr LayerParameter ()+type AnnotatedNet a = Gr (LayerParameter, a) ()+type NetBuilder = G LayerParameter ()++data LayerTy = Data+             | Pool+             | Concat+             | Conv+             | IP+             | LRN+             | ReLU+             | Dropout+             | Accuracy+             | SoftmaxWithLoss+               deriving (Show, Eq, Enum)++-- Manually implement for exhausiveness checking + Caffe+-- idiosyncracies+asCaffe :: LayerTy -> String+asCaffe Data = "Data"+asCaffe Concat = "Concat"+asCaffe Pool = "Pooling"+asCaffe Conv = "Convolution"+asCaffe IP = "InnerProduct"+asCaffe LRN = "LRN"+asCaffe ReLU = "ReLU"+asCaffe Dropout = "Dropout"+asCaffe Accuracy = "Accuracy"+asCaffe SoftmaxWithLoss = "SoftmaxWithLoss"++toCaffe :: String -> Maybe LayerTy+toCaffe "Data" = Just Data+toCaffe "Concat" = Just Concat+toCaffe "Pooling" = Just Pool+toCaffe "Convolution" = Just Conv+toCaffe "InnerProduct" = Just IP+toCaffe "LRN" = Just LRN+toCaffe "ReLU" = Just ReLU+toCaffe "Dropout" = Just Dropout+toCaffe "Accuracy" = Just Accuracy+toCaffe "SoftmaxWithLoss" = Just SoftmaxWithLoss+toCaffe _ = Nothing++s = P.fromString++def :: Default a => a+def = P.defaultValue++ty type'' = LP._type' ?~ s (asCaffe type'')++layerTy :: LayerParameter -> LayerTy+layerTy l = fromJust (LP.type' l) & toString & toCaffe & fromJust++phase' phase'' = LP._include <>~ singleton (def & _phase ?~ phase'')++param' v = _param .~ fromList v++-- Data+setF outer f n = set (outer . _Just . f) (Just n)+source' source'' = setF _data_param DP._source (s source'')+cropSize' = setF _transform_param TP._crop_size+meanFile' meanFile'' = setF _transform_param TP._mean_file (s meanFile'')+mirror' = setF _transform_param TP._mirror+batchSize' = setF _data_param DP._batch_size+backend' =  setF _data_param DP._backend++-- Convolution+setConv = setF _convolution_param+numOutputC' = setConv CP._num_output+kernelSizeC' = setConv CP._kernel_size+padC' = setConv CP._pad+groupC' = setConv CP._group+strideC' = setConv CP._stride+biasFillerC' = setConv CP._bias_filler+weightFillerC' = setConv CP._weight_filler++-- Pooling+setPool = setF _pooling_param+pool' = setPool PP._pool+sizeP' = setPool PP._kernel_size+strideP' = setPool PP._stride+padP' = setPool PP._pad++-- Inner Product+setIP = setF _inner_product_param+weightFillerIP' = setIP IP._weight_filler+numOutputIP' = setIP IP._num_output+biasFillerIP' = setIP IP._bias_filler++-- LRN+setLRN = setF _lrn_param+localSize' = setLRN LRN._local_size+alphaLRN' = setLRN LRN._alpha+betaLRN' = setLRN LRN._beta++-- Fillers+constant value' = def & FP._type' ?~ s "constant" & _value ?~ value'+gaussian std' = def & FP._type' ?~ s "gaussian" & _std ?~ std'+xavier std' = def & FP._type' ?~ s "xavier" & _std ?~ std'+zero = constant 0.0++-- Multipler+lrMult' value' = _lr_mult ?~ value'+decayMult' value' = _decay_mult ?~ value'++-- Simple Layers+accuracy k' = def & ty Accuracy & phase' TEST & _accuracy_param ?~ (def & AP._top_k ?~ k')+softmax = def & ty SoftmaxWithLoss+dropout ratio = def & ty Dropout & _dropout_param ?~ (def & _dropout_ratio ?~ ratio)+relu = def & ty ReLU+conv = def & ty Conv & _convolution_param ?~ def+ip n = def & ty IP & _inner_product_param ?~ def & numOutputIP' n+data' = def & ty Data & _transform_param ?~ def & _data_param ?~ def+maxPool = def & ty Pool & _pooling_param ?~ def & pool' MAX+avgPool = def & ty Pool & _pooling_param ?~ def & pool' AVE+lrn = def & ty LRN & _lrn_param ?~ def+concat' = def & ty Concat
+ NN/Examples/AlexNet.hs view
@@ -0,0 +1,50 @@+module NN.Examples.AlexNet where++import           Control.Lens+import           Control.Monad++import           NN+import           NN.Examples.ImageNet++alexTrain = train & cropSize' 227 & batchSize' 256 & mirror' True+alexTest = test & cropSize' 227 & batchSize' 50 & mirror' False++alexLrn = lrn & localSize' 5 & alphaLRN' 0.0001 & betaLRN' 0.75+alexConv = conv & param' alexMult & weightFillerC' (gaussian 0.01) & biasFillerC' zero+alexIP n = ip n & param' alexMult & weightFillerIP' (gaussian 0.005) & biasFillerIP' (constant 0.1)+alexPool = maxPool & sizeP' 3++alexMult = [def & lrMult' 1 & decayMult' 1, -- weights+            def & lrMult' 2 & decayMult' 0] -- biases++-- |Model+conv1 = alexConv & numOutputC' 96 & kernelSizeC' 11 & strideC' 4+conv2 = alexConv & numOutputC' 256 & padC' 2 & kernelSizeC' 5 & groupC' 2+conv3 = alexConv & numOutputC' 384 & padC' 1 & kernelSizeC' 3+conv4 = alexConv & numOutputC' 384 & padC' 1 & kernelSizeC' 3 & groupC' 2 & biasFillerC' (constant 0.1)+conv5 = alexConv & numOutputC' 256 & padC' 1 & kernelSizeC' 3 & groupC' 2 & biasFillerC' (constant 0.1)++alexNetSmall = do+  (input', representation) <- sequential [conv1, relu, alexPool & strideP' 3]+  forM_ [alexTrain, alexTest] $ attach (To input')+  forM_ [accuracy 1, accuracy 5, softmax] $ attach (From representation)++alexNet = do+  -- Set up the model+  (input', representation) <-+      sequential [+           -- Convolutional Layers+           conv1, relu, alexLrn, alexPool & strideP' 3,+           conv2, relu, alexLrn, alexPool & strideP' 2,+           conv3, relu,+           conv4, relu,+           conv5, relu, alexPool & strideP' 2,+           -- FC Layers+           alexIP 4096, relu, dropout 0.5,+           alexIP 4096, relu, dropout 0.5,+           alexIP 1000 & weightFillerIP' (gaussian 0.01) & biasFillerIP' zero]++  forM_ [alexTrain, alexTest] $ attach (To input')+  forM_ [accuracy 1, accuracy 5, softmax] $ attach (From representation)++main = cli alexNet
+ NN/Examples/Demo.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+module NN.Examples.Demo where++import           Gen.Caffe.LayerParameter as LP+import           Gen.Caffe.NetParameter   as NP++import           Control.Lens+import           GHC.IO.Handle+import           System.IO.Temp+import           System.Process+import           Text.Printf++import           NN+import           NN.Backend.Caffe         as Caffe+import           NN.Backend.Torch         as Torch+import           NN.Examples.AlexNet+import           NN.Examples.GoogLeNet++caffe :: IO ()+caffe = do+  let output = parse googLeNet & Caffe.middleEnd & Caffe.backend+  let names = output ^. NP._layer ^..traverse . LP._name ^..traverse . _Just+  print names++torch :: IO ()+torch = do+  let Just output = parse alexNetSmall & Torch.backend+  putStr $ output ++ "\n"++visualizeGoogLeNet :: IO ()+visualizeGoogLeNet = do+  (file, handle) <- openTempFile "/tmp" "graph.pdf"+  hClose handle+  f <- parse googLeNet & visualize & pdf file+  _ <- system $ printf "open %s &" f+  return ()++visualizeGoogLeNetDensity :: IO ()+visualizeGoogLeNetDensity = do+  (file, handle) <- openTempFile "/tmp" "graph.pdf"+  hClose handle+  f <- parse googLeNet & visualizeWith (scaled downscaleReLU) & pdf file+  _ <- system $ printf "open %s &" f+  return ()+      where+        downscaleReLU lp = go (layerTy lp)+            where+              go ReLU = 1+              go _ = 2
+ NN/Examples/GoogLeNet.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE RecordWildCards #-}+module NN.Examples.GoogLeNet where++import           Gen.Caffe.FillerParameter       as FP+import           Gen.Caffe.InnerProductParameter as IP+import           Gen.Caffe.LayerParameter        as LP++import           Control.Lens+import           Control.Monad+import           Data.Sequence                   (singleton)+import           Data.Word++import           NN+import           NN.Examples.ImageNet+++googleTrain = train & mirror' True & batchSize' 32 & cropSize' 224+googleTest = test & mirror' False & batchSize' 50 & cropSize' 224++googleMult = [def & lrMult' 1 & decayMult' 1, -- weights+              def & lrMult' 2 & decayMult' 0] -- biases+googleConv = conv & param' googleMult & biasFillerC' (constant 0.2)+googleLRN = lrn & localSize' 5 & alphaLRN' 0.0001 & betaLRN' 0.75+googlePool = maxPool & sizeP' 3 & strideP' 2+googleIP n = ip n & param' googleMult++conv1 = googleConv & numOutputC' 64 & padC' 3 & kernelSizeC' 7 & strideC' 2 & weightFillerC' (xavier 0.1)+conv2 = googleConv & numOutputC' 192 & padC' 1 & kernelSizeC' 3 & weightFillerC' (xavier 0.03)++topPool = avgPool & sizeP' 7 & strideP' 1+topFc = googleIP 1000 & biasFillerIP' (constant 0) & weightFillerIP' (xavier 0.0)+        -- Weird, but in Caffe replication+        & _inner_product_param._Just.IP._weight_filler._Just._std .~ Nothing++data Inception = Inception {_1x1, _3x3reduce, _3x3, _5x5reduce, _5x5, _poolProj :: Word32}++inception :: Node -> Inception -> G LayerParameter Node+inception input Inception{..} = do+  columns' <- mapM sequential columns+  concat'' <- layer' concat'+  forM_ columns' $ \(bottom, top) -> input >-> bottom >> top >-> concat''+  return concat''+    where+      columns = [+       [googleConv & numOutputC' _1x1  & kernelSizeC' 1 & weightFillerC' (xavier 0.03), relu],+       [googleConv & numOutputC' _3x3reduce & kernelSizeC' 1 & weightFillerC' (xavier 0.09), relu, googleConv & numOutputC' _3x3 & kernelSizeC' 3 & weightFillerC' (xavier 0.03) & padC' 1, relu],+       [googleConv & numOutputC' _5x5reduce & kernelSizeC' 1 & weightFillerC' (xavier 0.2), relu, googleConv & numOutputC' _5x5 & kernelSizeC' 5 & weightFillerC' (xavier 0.03) & padC' 2, relu],+       [maxPool& sizeP' 3 & strideP' 3 & padP' 1, googleConv & numOutputC' _poolProj & kernelSizeC' 1 & weightFillerC' (xavier 0.1), relu]]++intermediateClassifier :: Node -> NetBuilder+intermediateClassifier source = do+  (input, representation) <- sequential [pool1, conv1', relu, fc1, relu, dropout 0.7, fc2]+  source >-> input++  forM_ [accuracy 1, accuracy 5, softmax & _loss_weight <>~ singleton 0.3] $ attach (From representation)+    where+      pool1 = avgPool & sizeP' 5 & strideP' 3+      conv1' = googleConv & numOutputC' 128 & kernelSizeC' 1 & weightFillerC' (xavier 0.08)+      fc1 = googleIP 1024 & weightFillerIP' (xavier 0.02) & biasFillerIP' (constant 0.2)+      fc2 = googleIP 1000 & weightFillerIP' (xavier 0.0009765625) & biasFillerIP' (constant 0)++-- What to do at each step in the inner column?+data ColumnStep = I Inception | Classifier | MaxPool++googLeNet = do+  (input, initial) <- sequential [conv1, relu, googlePool, googleLRN, conv2, relu, googleLRN, googlePool]++  incepted <- foldM inceptionClassifier initial [+             I $ Inception 64 96 128 16 32 32,+             I $ Inception 128 128 192 32 96 64,+             MaxPool,+             I $ Inception 192 96 208 16 48 64,+             Classifier,+             I $ Inception 150 112 224 24 64 64,+             I $ Inception 128 128 256 24 64 64,+             I $ Inception 112 144 288 32 64 64,+             Classifier,+             I $ Inception 256 160 320 32 128 128,+             MaxPool,+             I $ Inception 256 160 320 32 128 128,+             I $ Inception 384 192 384 48 128 128]++  (_, representation) <- return (incepted, incepted) >- sequential [topPool, dropout 0.4, topFc]++  forM_ [accuracy 1, accuracy 5, softmax] $ attach (From representation)+  forM_ [googleTrain, googleTest] $ attach (To input)+    where+      inceptionClassifier input (I inceptor) = inception input inceptor+      inceptionClassifier input Classifier = intermediateClassifier input >> return input+      inceptionClassifier input MaxPool = do {node <- layer' googlePool; input >-> node; return node}++main :: IO ()+main = cli googLeNet
+ NN/Examples/ImageNet.hs view
@@ -0,0 +1,16 @@+module NN.Examples.ImageNet(test, train) where++import           Gen.Caffe.DataParameter.DB as DP++import           Control.Lens++import           NN.DSL++-- |Base layer specifications+imagenetData = data'+               & meanFile' "data/ilsvrc12/imagenet_mean.binaryproto"+               & backend' LMDB++-- |Data+test = imagenetData & phase' TEST & source' "examples/imagenet/ilsvrc12_train_lmdb"+train = imagenetData & phase' TRAIN & source' "examples/imagenet/ilsvrc12_train_lmdb"
+ NN/Graph.hs view
@@ -0,0 +1,41 @@+module NN.Graph(module NN.Graph, Gr, Node) where++import           Control.Arrow+import           Control.Monad.State.Strict+import           Data.Graph.Inductive.Graph+import           Data.Graph.Inductive.PatriciaTree++-- Useful Graph Combinators+type G a = State (Node, Gr a ())++sequential :: [a] -> G a (Node, Node)+sequential = stack . map layer++layer :: a -> G a (Node, Node)+layer l = do+  gid <- layer' l+  return (gid, gid)++layer' :: a -> G a Node+layer' l = do+  (gid, s) <- get+  put (gid + 1, insNode (gid, l) s)+  return gid++data Attach = From Node | To Node+attach :: Attach -> a -> G a ()+attach (From n) l = do {l' <- layer' l; n >-> l'}+attach (To n) l = do {l' <- layer' l; l' >-> n}++(>->) :: Node -> Node -> G a ()+(>->) from to = modify (second (insEdge (from, to, ())))++stack :: [G a (Node, Node)] -> G a (Node, Node)+stack = foldl1 (>-)++(>-) :: G a (Node, Node) -> G a (Node, Node) -> G a (Node, Node)+base >- above = do+  (from, midBelow) <- base+  (midAbove, top) <- above+  midBelow >-> midAbove+  return (from, top)
+ NN/Passes.hs view
@@ -0,0 +1,86 @@+module NN.Passes(module NN.Passes) where++import           NN.DSL+import           NN.Graph++import           Gen.Caffe.LayerParameter   as LP++import           Control.Lens+import           Control.Monad.State.Strict+import           Data.Char+import qualified Data.Foldable              as F+import           Data.Graph.Inductive.Graph hiding ((&))+import qualified Data.Graph.Inductive.Graph as G+import           Data.Maybe+import qualified Data.Sequence              as S++import           Text.Printf+import           Text.ProtocolBuffers       as P++type Pass = (Net, Node, LayerParameter) -> LayerParameter++layerName :: LayerParameter -> Int -> Utf8+layerName l i = printf "%s_%d" (type' l & fromJust & toString & map toLower) i & s++runPass :: Net -> Pass -> Net+runPass gr pass = gmap run gr+    where+      run (_pre, i, lp, _suc) = (_pre, i, pass (gr, i, lp), _suc)++addLabels :: Pass+addLabels (_, _, lp) = update (layerTy lp)+    where+      update Data = lp & LP._top <>~ S.singleton (s "label")+      update SoftmaxWithLoss = lp & LP._bottom <>~ S.singleton (s "label")+      update Accuracy = lp & LP._bottom <>~ S.singleton (s "label")+      update _ = lp++-- |If our layerTy is the given layer that is performed in-place, then+-- update `top` to point to `bottom`.+-- If any of our parents are performed in-place, update `bottom` to+-- point to our parents `top`+optimizeInPlaceLayer :: LayerTy -> [Pass]+optimizeInPlaceLayer layerTy' = [updateIfInPlace, updateIfParentInPlace] where+    inPlace lp = layerTy lp == layerTy'+    inPlaceParents gr i = filter inPlace . map fst $ pres gr i++    updateIfInPlace (_, i, lp) =+        case (layerTy lp == layerTy', F.toList (top lp)) of+          (True, [_]) -> lp & LP._top .~ bottom lp+          (True, _) -> error $ printf "Can only have one output for an in-place layer" ++ show (layerName lp i)+          (False, _) -> lp++    updateIfParentInPlace :: Pass+    updateIfParentInPlace (gr, i, lp) =+        case updateFromParents (gr, i, lp) of+          Left e -> error e+          Right lp' -> lp'++    updateFromParents :: (Net, Node, LayerParameter) -> Either String LayerParameter+    updateFromParents (gr, i, lp) =+       case (inPlaceParents gr i, F.toList (bottom lp)) of+         ([], _) -> Right lp+         (parents, bottoms) ->+             -- TODO this is super dodgy and incorrect in the general+             -- case (there are some weird invariants we rely on), but it works for now.+             if length parents /= length bottoms+             then Left $ printf "Must have all parents in-place for in-place optimizations" ++ show (layerName lp i)+             else let parentTops = F.concatMap (F.toList . LP.top) parents in+                  if length parentTops == length ((F.toList . LP.bottom) lp)+                  then Right $ lp & LP._bottom .~ S.fromList parentTops+                  else Left $ error "asdf"++labelled gr = map (\ j -> (lab' (context gr j), j))+pres gr j = labelled gr (G.pre gr j)++addConnection :: Pass+addConnection (gr, i, lp) = lp+                            & LP._name ?~ layerName lp i+                            & LP._bottom .~ S.fromList (map (uncurry layerName) (pres gr i))+                            & LP._top <>~ S.singleton (layerName lp i)++optimizeWith :: [Pass] -> Net -> Net+optimizeWith passes gr = foldl runPass gr passes++parse :: G a b -> Gr a ()+parse g = snd (execState g (1, empty))
+ NN/Visualize.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module NN.Visualize where++import           Data.GraphViz+import           Data.GraphViz.Attributes.Colors.Brewer+import           Data.GraphViz.Attributes.Complete+import qualified Data.Text.Lazy                         as L++import           Data.Graph.Inductive.Graph+import           NN.DSL++type NetVizParams = GraphvizParams Node LayerParameter () () LayerParameter++defaultNNParams =+    nonClusteredParams {+  -- Let's visualize neural networks from the bottom up+  globalAttributes = [GraphAttrs [RankDir FromBottom]],+  fmtNode = fmtLabelParameter+}+++scaled :: (LayerParameter -> Double) -> NetVizParams+scaled f = defaultNNParams { fmtNode = setSize }+    where+      setSize n@(_, lp) = fmtNode defaultNNParams n ++ [Width width', Height height']+          where+            width' = 0.75 * scale+            height' = 0.5 * scale+            scale = f lp++visualizeWith :: NetVizParams -> Net -> DotGraph Node+visualizeWith = graphToDot++visualize :: Net -> DotGraph Node+visualize = visualizeWith defaultNNParams++png :: FilePath -> DotGraph Node -> IO FilePath+png path g = runGraphviz g Png path++pdf :: FilePath -> DotGraph Node -> IO FilePath+pdf path g = runGraphviz g Pdf path++fmtLabelParameter :: (Node, LayerParameter) -> [Attribute]+fmtLabelParameter (_, lp) =+    [FontName "Source Code Pro",+     textLabel label,+     style filled,+     fillColor color']+    where+      maxColors = 8+      idx = ((+1) . (`mod` maxColors) . fromEnum . layerTy) lp+      scheme = BScheme Pastel2 (fromIntegral maxColors)+      color' = BC scheme (fromIntegral idx)+      label = (L.pack . asCaffe . layerTy) lp
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ caffegraph.cabal view
@@ -0,0 +1,38 @@+name:                caffegraph+version:             0.1.0.0+synopsis:            A compiler for building, optimizing, visualizing, and generating (Caffe/Torch) DNNs+license:             BSD3+license-file:        LICENSE+author:              Andrew Tulloch+maintainer:          andrew@tullo.ch+homepage:            https://github.com/ajtulloch/caffegraph/+category:            Math+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10+source-repository head+  type:     git+  location: https://github.com/ajtulloch/caffegraph/++Library+  GHC-Options: -Wall -fno-warn-missing-signatures+  Hs-Source-Dirs: .+  exposed-modules: NN, NN.CLI, NN.DSL, NN.Graph, NN.Passes, NN.Visualize, NN.Backend.Caffe, NN.Backend.Torch+                   NN.Examples.ImageNet, NN.Examples.AlexNet, NN.Examples.GoogLeNet, NN.Examples.Demo+  build-depends:       base >=4.7 && <4.8+                     , bytestring+                     , containers+                     , fgl+                     , filepath+                     , graphviz+                     , language-lua+                     , lens+                     , mtl+                     , process+                     , protocol-buffers+                     , protocol-buffers-descriptor+                     , template-haskell+                     , temporary+                     , optparse-applicative+                     , text+  default-language:    Haskell2010