diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example/Main.hs b/example/Main.hs new file mode 100644 --- /dev/null +++ b/example/Main.hs @@ -0,0 +1,45 @@ +module Main where + +import System.Environment(getArgs) +import System.Exit +import Control.Monad(when) +import Data.Default(def) +import Pipes +import Data.Algorithm.TSNE + + +main :: IO () +main = do + putStrLn "Haskell tSNE example" + + args <- getArgs + let argc = length args + when (argc < 1 || argc > 2) $ do + putStrLn "Usage haskell_tsne_example {input file name} [{num input values}]" + exitFailure + + let inputFileName = head args + inputData <- readDataFile inputFileName + + let n = length inputData + putStrLn $ "total input: " ++ show n + + let n' = if (argc < 2) then n else (read (args !! 1)) + + putStrLn $ "using: " ++ show n' + + forTsne3D outputResult def $ take n' inputData + + --runEffect $ for (tsne3D def $ take n' inputData) $ \r -> do + -- lift $ outputResult r + +readDataFile :: FilePath -> IO [[Double]] +readDataFile f = do + d <- readFile f + return $ map read (lines d) + +outputResult :: TSNEOutput3D -> IO () +outputResult s = do + putStrLn $ "iteration: " ++ (show.tsneIteration) s + putStrLn $ "cost: " ++ (show.tsneCost) s + diff --git a/src/Data/Algorithm/TSNE.hs b/src/Data/Algorithm/TSNE.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/TSNE.hs @@ -0,0 +1,26 @@ +module Data.Algorithm.TSNE ( + tsne3D, + forTsne3D, + TSNEOptions(..), + TSNEOutput3D(..) + ) where + +import Pipes + +import Data.Algorithm.TSNE.Types +import Data.Algorithm.TSNE.Internals +import Data.Algorithm.TSNE.Utils + +-- | Generates an infinite stream of 3D tSNE iterations. +tsne3D :: TSNEOptions -> TSNEInput -> Producer TSNEOutput3D IO () +tsne3D opts input = do + st <- liftIO $ initState $ length input + runTSNE opts input ps st + where ps = neighbourProbabilities opts input + +-- | Executes an IO action for each iteration of the 3D tSNE algorithm. +forTsne3D :: (TSNEOutput3D -> IO ()) -> TSNEOptions -> TSNEInput -> IO () +forTsne3D action opts input = do + runEffect $ for (tsne3D opts input) $ \o -> do + lift $ action o + diff --git a/src/Data/Algorithm/TSNE/Checks.hs b/src/Data/Algorithm/TSNE/Checks.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/TSNE/Checks.hs @@ -0,0 +1,19 @@ +module Data.Algorithm.TSNE.Checks where + +import Data.Algorithm.TSNE.Types + +isSquare :: Int -> [[a]] -> Bool +isSquare 0 [] = True +isSquare _ [] = False +isSquare n xss = length xss == n && all (\xs -> length xs == n) xss + +has2DShape :: (Int, Int) -> [[a]] -> Bool +has2DShape (w,h) xss = length xss == h && all (\xs -> length xs == w) xss + +shape2D :: [[a]] -> (Int, Int) +shape2D [] = (undefined, 0) +shape2D xss = (length (head xss), length xss) + +isRectangular :: [[a]] -> Bool +isRectangular xss = has2DShape (shape2D xss) xss + diff --git a/src/Data/Algorithm/TSNE/Internals.hs b/src/Data/Algorithm/TSNE/Internals.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/TSNE/Internals.hs @@ -0,0 +1,177 @@ +module Data.Algorithm.TSNE.Internals where + +import Control.Applicative +import Control.DeepSeq +import Control.Exception (assert) +import Data.Default (def) +import Data.List(zipWith4) +import Data.Random.Normal (normalsIO') +import Pipes +--import Debug.Trace + +import Data.Algorithm.TSNE.Types +import Data.Algorithm.TSNE.Utils +import Data.Algorithm.TSNE.Checks + + +inputSize :: TSNEInput -> Int +inputSize = length + +inputValueSize :: TSNEInput -> Int +inputValueSize i = w + where (w,h) = shape2D i + +inputIsValid :: TSNEInput -> Either String () +inputIsValid [] = Left "empty input data" +inputIsValid xss + | not (isRectangular xss) = Left "input data values are not all the same length" + | otherwise = Right () + +isValidStateForInput :: TSNEInput -> TSNEState -> Either String () +isValidStateForInput i st + | not (has2DShape (n,3) s) = Left $ "solution is wrong shape: " ++ show (shape2D s) + | otherwise = Right () + where + n = inputSize i + s = stSolution st + +initState :: Int -> IO TSNEState +initState n = do + s <- initSolution3D n + return $ TSNEState 0 s (rr 1) (rr 0) + where + rr = repeat.repeat + +initSolution3D :: Int -> IO [[Double]] +initSolution3D n = do + let ns = normalsIO' (0, 1e-4) + xs <- ns + ys <- ns + zs <- ns + return $ take n <$> [xs,ys,zs] + +runTSNE :: TSNEOptions -> TSNEInput -> [[Probability]] -> TSNEState -> Producer TSNEOutput3D IO () +runTSNE opts vs ps st = do + let st' = force $ stepTSNE opts vs ps st + yield $ output3D ps st' + runTSNE opts vs ps st' + +stepTSNE :: TSNEOptions -> TSNEInput -> [[Probability]] -> TSNEState -> TSNEState +stepTSNE opts vs ps st = TSNEState i' s'' g' d' + where + i = stIteration st + s = stSolution st + g = stGains st + d = stDeltas st + gr = gradients ps st + i' = i + 1 + s' = recenter $ z (+) s d' + g' = z3 newGain g d gr + d' = z3 (newDelta (tsneLearningRate opts) i) g' d gr + z = zipWith.zipWith + z3 = zipWith3.zipWith3 + s'' = assert (length s' == length vs) s' + +newGain :: Gain -> Delta -> Gradient -> Gain +newGain g d gr = max 0.01 g' + where + g' = if signum d == signum gr + then g * 0.8 + else g + 0.2 + +newDelta :: Double -> Int -> Gain -> Delta -> Gradient -> Delta +newDelta e i g' d gr = (m * d) - (e * g' * gr) + where + m = if i < 250 then 0.5 else 0.8 + +gradients :: [[Probability]] -> TSNEState -> [[Gradient]] +gradients pss st = gradient <$> ss + where + gradient :: [Double] -> [Gradient] + gradient s = zipWith4 (f s) s pss qss qss' + ss = stSolution st + i = stIteration st + qss = qdist ss + qss' = qdist' ss + f :: [Double] -> Double -> [Double] -> [Double] -> [Double] -> Gradient + f s x ps qs qs' = sum $ zipWith4 g s ps qs qs' + where + g y p q q' = m * (x - y) + where + m = 4 * (k * p - q') * q + k = if i < 100 then 4 else 1 + +solution3D :: [[Double]] -> [Position3D] +solution3D (xs:ys:zs:_) = zip3 xs ys zs + +output3D :: [[Double]] -> TSNEState -> TSNEOutput3D +output3D pss st = TSNEOutput3D i s c + where + i = stIteration st + s = (solution3D . stSolution) st + c = cost pss st + +cost :: [[Double]] -> TSNEState -> Double +cost pss st = sumsum $ (zipWith.zipWith) c pss (qdist' (stSolution st)) + where + c p q = -p * log q + +targetEntropy :: TSNEOptions -> Entropy +targetEntropy = log.realToFrac.tsnePerplexity + +data Beta = Beta { + betaValue :: Double, + betaMin :: Double, + betaMax :: Double +} + +neighbourProbabilities :: TSNEOptions -> TSNEInput -> [[Probability]] +neighbourProbabilities opts vs = symmetrize $ rawNeighbourProbabilities opts vs + +rawNeighbourProbabilities :: TSNEOptions -> TSNEInput -> [[Probability]] +rawNeighbourProbabilities opts vs = map np vs + where + np a = aps (beta a) vs a + beta a = betaValue $ binarySearchBeta opts vs a + + aps :: Double -> TSNEInput -> TSNEInputValue -> [Probability] + aps beta bs a = map pj' bs + where + psum = sum $ map pj bs + pj b + | a == b = 0 + | otherwise = exp $ -(distanceSquared a b) * beta + pj' b = pj b / psum + +binarySearchBeta :: TSNEOptions -> TSNEInput -> TSNEInputValue -> Beta +binarySearchBeta opts vs = binarySearchBeta' opts vs 1e-4 0 (Beta 1 (-infinity) infinity) + +binarySearchBeta' :: TSNEOptions -> TSNEInput -> Double -> Int -> Beta -> TSNEInputValue -> Beta +binarySearchBeta' opts bs tol i beta a + | i == 50 = beta + | abs (e - t) < tol = beta + | e > t = r $ incPrecision beta + | otherwise = r $ decPrecision beta + where + t = targetEntropy opts + e = entropyForInputValue (betaValue beta) bs a + incPrecision (Beta b _ bmax) + | bmax == infinity = Beta (b * 2) b bmax + | otherwise = Beta ((b + bmax) / 2) b bmax + decPrecision (Beta b bmin _) + | bmin == -infinity = Beta (b / 2) bmin b + | otherwise = Beta ((b + bmin) / 2) bmin b + r beta' = binarySearchBeta' opts bs tol (i+1) beta' a + +entropyForInputValue :: Double -> TSNEInput -> TSNEInputValue -> Entropy +entropyForInputValue beta bs a = sum $ map h bs + where + h b = if x > 1e-7 then -x * log x else 0 + where x = pj' b + psum = sum $ map pj bs + pj b + | a == b = 0 + | otherwise = exp $ -(distanceSquared a b) * beta + pj' b = pj b / psum + + diff --git a/src/Data/Algorithm/TSNE/Types.hs b/src/Data/Algorithm/TSNE/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/TSNE/Types.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} + +module Data.Algorithm.TSNE.Types where + +import GHC.Generics (Generic) +import Control.DeepSeq +import Data.Default + + +data TSNEOptions = TSNEOptions { + tsnePerplexity :: Int, + tsneLearningRate :: Double +} + +type TSNEInputValue = [Double] +type TSNEInput = [TSNEInputValue] + +type Position3D = (Double,Double,Double) + +data TSNEOutput3D = TSNEOutput3D { + tsneIteration :: Int, + tsneSolution3D :: [Position3D], + tsneCost :: Double +} deriving (Show, Eq) + +instance Default TSNEOptions where + def = TSNEOptions 30 10 + +type Probability = Double +type Gain = Double +type Delta = Double +type Gradient = Double +type Entropy = Double + +data TSNEState = TSNEState { + stIteration :: Int, + stSolution :: [[Double]], + stGains :: [[Gain]], + stDeltas :: [[Delta]] +} deriving (Show, Generic, NFData) diff --git a/src/Data/Algorithm/TSNE/Utils.hs b/src/Data/Algorithm/TSNE/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/TSNE/Utils.hs @@ -0,0 +1,58 @@ +module Data.Algorithm.TSNE.Utils where + +import Data.List(foldr, transpose) + +infinity :: Double +infinity = read "Infinity" + +distanceSquared :: [Double] -> [Double] -> Double +distanceSquared as bs = foldr d 0 (zip as bs) + where d (a,b) t = t + (a-b) * (a-b) + +symmetrize :: [[Double]] -> [[Double]] +symmetrize m = (zipWith.zipWith) f m (transpose m) + where + f :: Double -> Double -> Double + f x y = max a 1e-100 + where a = (x + y) / (2 * (realToFrac.length) m) + +recenter :: [[Double]] -> [[Double]] +recenter ss = map r ss + where + r s = subtract (mean s) <$> s + mean s = sum s / (realToFrac.length) s + +qdist :: [[Double]] -> [[Double]] +qdist ss = symmetricalMatrixFromTopRight $ qd (transpose ss) + where + qd [] = [] + qd ps = [qr ps] ++ qd (tail ps) + qr :: [[Double]] -> [Double] + qr ps = [0::Double] ++ (q (head ps) <$> tail ps) + q as bs = 1 / (1 + s) + where + s = sum $ zipWith f as bs + f a b = (a-b) * (a-b) + +qdist' :: [[Double]] -> [[Double]] +qdist' ss = (map.map) f qd + where + qd = qdist ss + f :: Double -> Double + f q = max (q / sumsum qd) 1e-100 + +sumsum :: [[Double]] -> Double +sumsum m = sum $ sum <$> m + +reprep :: a -> [[a]] +reprep = repeat.repeat + +symmetricalMatrixFromTopRight :: [[a]] -> [[a]] +symmetricalMatrixFromTopRight tr = zipWith (++) bl tr + where + bl = zipWith take [0..] (transpose m) + m = zipWith (++) ebl tr + ebl = zipWith take [0..] (reprep undefined) + + + diff --git a/test/Data/Algorithm/TSNE/ChecksSpec.hs b/test/Data/Algorithm/TSNE/ChecksSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Algorithm/TSNE/ChecksSpec.hs @@ -0,0 +1,55 @@ +module Data.Algorithm.TSNE.ChecksSpec (main, spec) where + +import Test.Hspec +import Data.Algorithm.TSNE.Checks + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +u = undefined + +spec :: Spec +spec = do + describe "isSquare" $ do + it "empty is 0x0 square" $ do + isSquare 0 [] `shouldBe` True + it "empty is not 1x1 square" $ do + isSquare 1 [] `shouldBe` False + it "single is 1x1 square" $ do + isSquare 1 [[u]] `shouldBe` True + it "single is not 0x0 square" $ do + isSquare 0 [[u]] `shouldBe` False + it "2x2 square" $ do + isSquare 2 [[u,u],[u,u]] `shouldBe` True + it "2x2 is not 0x0" $ do + isSquare 0 [[u,u],[u,u]] `shouldBe` False + it "2x2 is not 0x0" $ do + isSquare 1 [[u,u],[u,u]] `shouldBe` False + it "2x2 is not 3x3" $ do + isSquare 3 [[u,u],[u,u]] `shouldBe` False + it "2x1 is not 1x1" $ do + isSquare 1 [[u,u]] `shouldBe` False + it "2x1 is not 2x2" $ do + isSquare 2 [[u,u]] `shouldBe` False + it "1x2 is not 1x1" $ do + isSquare 1 [[u,u]] `shouldBe` False + it "1x2 is not 2x2" $ do + isSquare 2 [[u,u]] `shouldBe` False + + describe "has2DShape" $ do + it "empty is 0x0" $ do + has2DShape (0,0) [] `shouldBe` True + --it "empty is not 1x0" $ do + -- has2DShape (1,0) [] `shouldBe` False + it "empty is not 0x1" $ do + has2DShape (0,1) [] `shouldBe` False + it "1x2 is 1x2" $ do + has2DShape (1,2) [[u],[u]] `shouldBe` True + it "2x1 is 2x1" $ do + has2DShape (2,1) [[u,u]] `shouldBe` True + it "1x2 is not 2x1" $ do + has2DShape (2,1) [[u],[u]] `shouldBe` False + it "2x1 is not 1x2" $ do + has2DShape (1,2) [[u,u]] `shouldBe` False diff --git a/test/Data/Algorithm/TSNE/InternalsSpec.hs b/test/Data/Algorithm/TSNE/InternalsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Algorithm/TSNE/InternalsSpec.hs @@ -0,0 +1,97 @@ +module Data.Algorithm.TSNE.InternalsSpec (main, spec) where + +import Data.Default (def) + +import Test.Hspec +import Data.Algorithm.TSNE.Internals +import Data.Algorithm.TSNE.Checks +import Data.Algorithm.TSNE.Types +import Data.Algorithm.TSNE.Utils + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +u = undefined + +spec :: Spec +spec = do + let n = inputSize testInput + w = inputValueSize testInput + + describe "testInput" $ do + it "is right shape" $ do + testInput `shouldSatisfy` has2DShape (64, 20) + it "is valid" $ do + inputIsValid testInput `shouldBe` Right () + it "has right size" $ do + inputSize testInput `shouldBe` 20 + it "has right value size" $ do + inputValueSize testInput `shouldBe` 64 + + describe "initSolution3D" $ do + it "is right shape" $ + --initSolution3D 99 >>= (`shouldSatisfy` (\s -> length s == 3 && all (\xs -> length xs == 99) s)) + initSolution3D n >>= (`shouldSatisfy` has2DShape (n,3)) + + describe "initState" $ do + it "is valid state" $ + initState n >>= (`shouldSatisfy` isRight . (isValidStateForInput testInput)) + + describe "neighbourProbabilities" $ do + it "is right shape" $ do + testNeighbourProbs `shouldSatisfy` has2DShape (n,n) + + describe "qdist" $ do + it "is right shape" $ do + s <- initSolution3D n + qdist s `shouldSatisfy` has2DShape (n,n) + + describe "qdist'" $ do + it "is right shape" $ do + s <- initSolution3D n + qdist' s `shouldSatisfy` has2DShape (n,n) + + describe "gradients" $ do + it "is right shape" $ do + s <- initState n + gradients testNeighbourProbs s `shouldSatisfy` has2DShape (n,3) + + describe "stepTSNE" $ do + it "works" $ do + s <- initState n + stepTSNE def testInput testNeighbourProbs s `shouldSatisfy` isRight . (isValidStateForInput testInput) + + +isRight :: Either a b -> Bool +isRight (Left _) = False +isRight (Right _) = True + +-- first 20 digits from the Python sklearn digits dataset +testInput :: TSNEInput +testInput = [ + [0.0,0.0,5.0,13.0,9.0,1.0,0.0,0.0,0.0,0.0,13.0,15.0,10.0,15.0,5.0,0.0,0.0,3.0,15.0,2.0,0.0,11.0,8.0,0.0,0.0,4.0,12.0,0.0,0.0,8.0,8.0,0.0,0.0,5.0,8.0,0.0,0.0,9.0,8.0,0.0,0.0,4.0,11.0,0.0,1.0,12.0,7.0,0.0,0.0,2.0,14.0,5.0,10.0,12.0,0.0,0.0,0.0,0.0,6.0,13.0,10.0,0.0,0.0,0.0], + [0.0,0.0,0.0,12.0,13.0,5.0,0.0,0.0,0.0,0.0,0.0,11.0,16.0,9.0,0.0,0.0,0.0,0.0,3.0,15.0,16.0,6.0,0.0,0.0,0.0,7.0,15.0,16.0,16.0,2.0,0.0,0.0,0.0,0.0,1.0,16.0,16.0,3.0,0.0,0.0,0.0,0.0,1.0,16.0,16.0,6.0,0.0,0.0,0.0,0.0,1.0,16.0,16.0,6.0,0.0,0.0,0.0,0.0,0.0,11.0,16.0,10.0,0.0,0.0], + [0.0,0.0,0.0,4.0,15.0,12.0,0.0,0.0,0.0,0.0,3.0,16.0,15.0,14.0,0.0,0.0,0.0,0.0,8.0,13.0,8.0,16.0,0.0,0.0,0.0,0.0,1.0,6.0,15.0,11.0,0.0,0.0,0.0,1.0,8.0,13.0,15.0,1.0,0.0,0.0,0.0,9.0,16.0,16.0,5.0,0.0,0.0,0.0,0.0,3.0,13.0,16.0,16.0,11.0,5.0,0.0,0.0,0.0,0.0,3.0,11.0,16.0,9.0,0.0], + [0.0,0.0,7.0,15.0,13.0,1.0,0.0,0.0,0.0,8.0,13.0,6.0,15.0,4.0,0.0,0.0,0.0,2.0,1.0,13.0,13.0,0.0,0.0,0.0,0.0,0.0,2.0,15.0,11.0,1.0,0.0,0.0,0.0,0.0,0.0,1.0,12.0,12.0,1.0,0.0,0.0,0.0,0.0,0.0,1.0,10.0,8.0,0.0,0.0,0.0,8.0,4.0,5.0,14.0,9.0,0.0,0.0,0.0,7.0,13.0,13.0,9.0,0.0,0.0], + [0.0,0.0,0.0,1.0,11.0,0.0,0.0,0.0,0.0,0.0,0.0,7.0,8.0,0.0,0.0,0.0,0.0,0.0,1.0,13.0,6.0,2.0,2.0,0.0,0.0,0.0,7.0,15.0,0.0,9.0,8.0,0.0,0.0,5.0,16.0,10.0,0.0,16.0,6.0,0.0,0.0,4.0,15.0,16.0,13.0,16.0,1.0,0.0,0.0,0.0,0.0,3.0,15.0,10.0,0.0,0.0,0.0,0.0,0.0,2.0,16.0,4.0,0.0,0.0], + [0.0,0.0,12.0,10.0,0.0,0.0,0.0,0.0,0.0,0.0,14.0,16.0,16.0,14.0,0.0,0.0,0.0,0.0,13.0,16.0,15.0,10.0,1.0,0.0,0.0,0.0,11.0,16.0,16.0,7.0,0.0,0.0,0.0,0.0,0.0,4.0,7.0,16.0,7.0,0.0,0.0,0.0,0.0,0.0,4.0,16.0,9.0,0.0,0.0,0.0,5.0,4.0,12.0,16.0,4.0,0.0,0.0,0.0,9.0,16.0,16.0,10.0,0.0,0.0], + [0.0,0.0,0.0,12.0,13.0,0.0,0.0,0.0,0.0,0.0,5.0,16.0,8.0,0.0,0.0,0.0,0.0,0.0,13.0,16.0,3.0,0.0,0.0,0.0,0.0,0.0,14.0,13.0,0.0,0.0,0.0,0.0,0.0,0.0,15.0,12.0,7.0,2.0,0.0,0.0,0.0,0.0,13.0,16.0,13.0,16.0,3.0,0.0,0.0,0.0,7.0,16.0,11.0,15.0,8.0,0.0,0.0,0.0,1.0,9.0,15.0,11.0,3.0,0.0], + [0.0,0.0,7.0,8.0,13.0,16.0,15.0,1.0,0.0,0.0,7.0,7.0,4.0,11.0,12.0,0.0,0.0,0.0,0.0,0.0,8.0,13.0,1.0,0.0,0.0,4.0,8.0,8.0,15.0,15.0,6.0,0.0,0.0,2.0,11.0,15.0,15.0,4.0,0.0,0.0,0.0,0.0,0.0,16.0,5.0,0.0,0.0,0.0,0.0,0.0,9.0,15.0,1.0,0.0,0.0,0.0,0.0,0.0,13.0,5.0,0.0,0.0,0.0,0.0], + [0.0,0.0,9.0,14.0,8.0,1.0,0.0,0.0,0.0,0.0,12.0,14.0,14.0,12.0,0.0,0.0,0.0,0.0,9.0,10.0,0.0,15.0,4.0,0.0,0.0,0.0,3.0,16.0,12.0,14.0,2.0,0.0,0.0,0.0,4.0,16.0,16.0,2.0,0.0,0.0,0.0,3.0,16.0,8.0,10.0,13.0,2.0,0.0,0.0,1.0,15.0,1.0,3.0,16.0,8.0,0.0,0.0,0.0,11.0,16.0,15.0,11.0,1.0,0.0], + [0.0,0.0,11.0,12.0,0.0,0.0,0.0,0.0,0.0,2.0,16.0,16.0,16.0,13.0,0.0,0.0,0.0,3.0,16.0,12.0,10.0,14.0,0.0,0.0,0.0,1.0,16.0,1.0,12.0,15.0,0.0,0.0,0.0,0.0,13.0,16.0,9.0,15.0,2.0,0.0,0.0,0.0,0.0,3.0,0.0,9.0,11.0,0.0,0.0,0.0,0.0,0.0,9.0,15.0,4.0,0.0,0.0,0.0,9.0,12.0,13.0,3.0,0.0,0.0], + [0.0,0.0,1.0,9.0,15.0,11.0,0.0,0.0,0.0,0.0,11.0,16.0,8.0,14.0,6.0,0.0,0.0,2.0,16.0,10.0,0.0,9.0,9.0,0.0,0.0,1.0,16.0,4.0,0.0,8.0,8.0,0.0,0.0,4.0,16.0,4.0,0.0,8.0,8.0,0.0,0.0,1.0,16.0,5.0,1.0,11.0,3.0,0.0,0.0,0.0,12.0,12.0,10.0,10.0,0.0,0.0,0.0,0.0,1.0,10.0,13.0,3.0,0.0,0.0], + [0.0,0.0,0.0,0.0,14.0,13.0,1.0,0.0,0.0,0.0,0.0,5.0,16.0,16.0,2.0,0.0,0.0,0.0,0.0,14.0,16.0,12.0,0.0,0.0,0.0,1.0,10.0,16.0,16.0,12.0,0.0,0.0,0.0,3.0,12.0,14.0,16.0,9.0,0.0,0.0,0.0,0.0,0.0,5.0,16.0,15.0,0.0,0.0,0.0,0.0,0.0,4.0,16.0,14.0,0.0,0.0,0.0,0.0,0.0,1.0,13.0,16.0,1.0,0.0], + [0.0,0.0,5.0,12.0,1.0,0.0,0.0,0.0,0.0,0.0,15.0,14.0,7.0,0.0,0.0,0.0,0.0,0.0,13.0,1.0,12.0,0.0,0.0,0.0,0.0,2.0,10.0,0.0,14.0,0.0,0.0,0.0,0.0,0.0,2.0,0.0,16.0,1.0,0.0,0.0,0.0,0.0,0.0,6.0,15.0,0.0,0.0,0.0,0.0,0.0,9.0,16.0,15.0,9.0,8.0,2.0,0.0,0.0,3.0,11.0,8.0,13.0,12.0,4.0], + [0.0,2.0,9.0,15.0,14.0,9.0,3.0,0.0,0.0,4.0,13.0,8.0,9.0,16.0,8.0,0.0,0.0,0.0,0.0,6.0,14.0,15.0,3.0,0.0,0.0,0.0,0.0,11.0,14.0,2.0,0.0,0.0,0.0,0.0,0.0,2.0,15.0,11.0,0.0,0.0,0.0,0.0,0.0,0.0,2.0,15.0,4.0,0.0,0.0,1.0,5.0,6.0,13.0,16.0,6.0,0.0,0.0,2.0,12.0,12.0,13.0,11.0,0.0,0.0], + [0.0,0.0,0.0,8.0,15.0,1.0,0.0,0.0,0.0,0.0,1.0,14.0,13.0,1.0,1.0,0.0,0.0,0.0,10.0,15.0,3.0,15.0,11.0,0.0,0.0,7.0,16.0,7.0,1.0,16.0,8.0,0.0,0.0,9.0,16.0,13.0,14.0,16.0,5.0,0.0,0.0,1.0,10.0,15.0,16.0,14.0,0.0,0.0,0.0,0.0,0.0,1.0,16.0,10.0,0.0,0.0,0.0,0.0,0.0,10.0,15.0,4.0,0.0,0.0], + [0.0,5.0,12.0,13.0,16.0,16.0,2.0,0.0,0.0,11.0,16.0,15.0,8.0,4.0,0.0,0.0,0.0,8.0,14.0,11.0,1.0,0.0,0.0,0.0,0.0,8.0,16.0,16.0,14.0,0.0,0.0,0.0,0.0,1.0,6.0,6.0,16.0,0.0,0.0,0.0,0.0,0.0,0.0,5.0,16.0,3.0,0.0,0.0,0.0,1.0,5.0,15.0,13.0,0.0,0.0,0.0,0.0,4.0,15.0,16.0,2.0,0.0,0.0,0.0], + [0.0,0.0,0.0,8.0,15.0,1.0,0.0,0.0,0.0,0.0,0.0,12.0,14.0,0.0,0.0,0.0,0.0,0.0,3.0,16.0,7.0,0.0,0.0,0.0,0.0,0.0,6.0,16.0,2.0,0.0,0.0,0.0,0.0,0.0,7.0,16.0,16.0,13.0,5.0,0.0,0.0,0.0,15.0,16.0,9.0,9.0,14.0,0.0,0.0,0.0,3.0,14.0,9.0,2.0,16.0,2.0,0.0,0.0,0.0,7.0,15.0,16.0,11.0,0.0], + [0.0,0.0,1.0,8.0,15.0,10.0,0.0,0.0,0.0,3.0,13.0,15.0,14.0,14.0,0.0,0.0,0.0,5.0,10.0,0.0,10.0,12.0,0.0,0.0,0.0,0.0,3.0,5.0,15.0,10.0,2.0,0.0,0.0,0.0,16.0,16.0,16.0,16.0,12.0,0.0,0.0,1.0,8.0,12.0,14.0,8.0,3.0,0.0,0.0,0.0,0.0,10.0,13.0,0.0,0.0,0.0,0.0,0.0,0.0,11.0,9.0,0.0,0.0,0.0], + [0.0,0.0,10.0,7.0,13.0,9.0,0.0,0.0,0.0,0.0,9.0,10.0,12.0,15.0,2.0,0.0,0.0,0.0,4.0,11.0,10.0,11.0,0.0,0.0,0.0,0.0,1.0,16.0,10.0,1.0,0.0,0.0,0.0,0.0,12.0,13.0,4.0,0.0,0.0,0.0,0.0,0.0,12.0,1.0,12.0,0.0,0.0,0.0,0.0,1.0,10.0,2.0,14.0,0.0,0.0,0.0,0.0,0.0,11.0,14.0,5.0,0.0,0.0,0.0], + [0.0,0.0,6.0,14.0,4.0,0.0,0.0,0.0,0.0,0.0,11.0,16.0,10.0,0.0,0.0,0.0,0.0,0.0,8.0,14.0,16.0,2.0,0.0,0.0,0.0,0.0,1.0,12.0,12.0,11.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,11.0,3.0,0.0,0.0,0.0,0.0,0.0,0.0,5.0,11.0,0.0,0.0,0.0,1.0,4.0,4.0,7.0,16.0,2.0,0.0,0.0,7.0,16.0,16.0,13.0,11.0,1.0] + ] + +testNeighbourProbs :: [[Probability]] +testNeighbourProbs = neighbourProbabilities def testInput diff --git a/test/Data/Algorithm/TSNE/UtilsSpec.hs b/test/Data/Algorithm/TSNE/UtilsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Algorithm/TSNE/UtilsSpec.hs @@ -0,0 +1,33 @@ +module Data.Algorithm.TSNE.UtilsSpec (main, spec) where + +import Test.Hspec +import Data.Algorithm.TSNE.Utils + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +u = undefined + +spec :: Spec +spec = do + describe "infinity" $ do + it "greater than 1e99" $ do + infinity `shouldSatisfy` (> 1e99) + + describe "symmetricalMatrixFromTopRight" $ do + it "passed nothing returns nothing" $ do + symmetricalMatrixFromTopRight [] `shouldBe` ([] :: [[Double]]) + it "passed one value returns one value" $ do + symmetricalMatrixFromTopRight [[42]] `shouldBe` ([[42]] :: [[Double]]) + it "passed 2x2 top right" $ do + symmetricalMatrixFromTopRight [["a1", "a2"], ["b2"]] `shouldBe` [["a1", "a2"], ["a2", "b2"]] + it "passed 3x3 top right" $ do + symmetricalMatrixFromTopRight [["a1", "a2", "a3"], ["b2", "b3"], ["c3"]] `shouldBe` [["a1", "a2", "a3"], ["a2", "b2", "b3"], ["a3", "b3", "c3"]] + + describe "qdist" $ do + it "passed nothing return nothing" $ do + pending + --qdist [] `shouldBe` ([] :: [[Double]]) + diff --git a/test/Data/Algorithm/TSNESpec.hs b/test/Data/Algorithm/TSNESpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Algorithm/TSNESpec.hs @@ -0,0 +1,17 @@ +module Data.Algorithm.TSNESpec (main, spec) where + +import Test.Hspec +import Data.Default (def) +import Data.Algorithm.TSNE + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "tsne" $ do + it "passed nothing returns nothing" $ do + pending + --tsne def [[]] `shouldReturn` [] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tsne.cabal b/tsne.cabal new file mode 100644 --- /dev/null +++ b/tsne.cabal @@ -0,0 +1,58 @@ +name: tsne +version: 1.0.0.1 +synopsis: t-SNE +description: Pure Haskell implementation of the t-SNE dimension reduction algorithm. +homepage: https://bitbucket.org/robagar/haskell-tsne +license: LGPL +license-file: LICENSE +author: Rob Agar +maintainer: robagar@fastmail.net +copyright: 2017 Rob Agar +category: Algorithms +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.Algorithm.TSNE, + Data.Algorithm.TSNE.Types, + Data.Algorithm.TSNE.Internals, + Data.Algorithm.TSNE.Utils, + Data.Algorithm.TSNE.Checks + build-depends: base >= 4.7 && < 5, + data-default, + deepseq, + normaldistribution, + pipes + default-language: Haskell2010 + +test-suite tSNE-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: Data.Algorithm.TSNESpec, + Data.Algorithm.TSNE.InternalsSpec, + Data.Algorithm.TSNE.UtilsSpec, + Data.Algorithm.TSNE.ChecksSpec + build-depends: base, + hspec, + data-default, + tsne + ghc-options: -threaded + -rtsopts + -with-rtsopts=-N + default-language: Haskell2010 + +executable haskell_tsne_example + hs-source-dirs: example + main-is: Main.hs + build-depends: base, + data-default, + pipes, + tsne + ghc-options: -threaded + default-language: Haskell2010 + +source-repository head + type: mercurial + location: https://bitbucket.org/robagar/haskell-tsne