Remove duplicate code that is now in dph-examples
authorBen Lippmeier <benl@ouroborus.net>
Fri, 11 Nov 2011 05:27:45 +0000 (16:27 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Fri, 11 Nov 2011 05:27:45 +0000 (16:27 +1100)
31 files changed:
examples/quickhull/Makefile [deleted file]
examples/quickhull/QuickHull.hs [deleted file]
examples/quickhull/QuickHullVect.hs [deleted file]
examples/quickhull/SVG.hs [deleted file]
examples/quickhull/TestData.hs [deleted file]
examples/quickhull/Types.hs [deleted file]
examples/quickhull/gen.hs [deleted file]
examples/quickhull/legacy/c/Main.c [deleted file]
examples/quickhull/legacy/c/QuickHull.c [deleted file]
examples/quickhull/legacy/c/SVG.c [deleted file]
examples/quickhull/legacy/c/Timing.c [deleted file]
examples/quickhull/legacy/c/Timing.h [deleted file]
examples/quickhull/legacy/c/Vector.h [deleted file]
examples/quickhull/legacy/vector/Main.hs [deleted file]
examples/quickhull/legacy/vector/QuickHullIO.hs [deleted file]
examples/quickhull/legacy/vector/QuickHullSplit.hs [deleted file]
examples/quickhull/legacy/vector/QuickHullVector.hs [deleted file]
examples/quickhull/legacy/vector/SVG.hs [deleted file]
examples/quickhull/legacy/vector/TestDataVector.hs [deleted file]
examples/quickhull/legacy/vector/Timing.hs [deleted file]
examples/quickhull/vect.hs [deleted file]
examples/quickhull/vectSVG.hs [deleted file]
examples/sumsq/Makefile [deleted file]
examples/sumsq/SumSqPrim.hs [deleted file]
examples/sumsq/SumSqVect.hs [deleted file]
examples/sumsq/prim.hs [deleted file]
examples/sumsq/sumsq-c.c [deleted file]
examples/sumsq/vect.hs [deleted file]
examples/words/Main.hs [deleted file]
examples/words/WordsVect.hs [deleted file]
examples/words/legacy/WordsList.hs [deleted file]

diff --git a/examples/quickhull/Makefile b/examples/quickhull/Makefile
deleted file mode 100644 (file)
index 5e5f488..0000000
+++ /dev/null
@@ -1,43 +0,0 @@
-TOPDIR = ..
-BINARIES = quickhull quickhullSVG QuickHull gen
-
-HCCFLAGS = -optc-O3
-
-quickhull_DPH = quickhull
-quickhull_SOURCES = vect.hs QuickHullVect.hs Types.hs
-
-QuickHull_SOURCES = QuickHull.hs
-QuickHull_FLAGS   = -O2 -package dph-prim-seq
-
-quickhullSVG_DPH = quickhullSVG
-quickhullSVG_SOURCES = vectSVG.hs QuickhullVect.hs Types.hs SVG.hs TestData.hs
-
-gen_SOURCES = gen.hs TestData.hs
-gen_FLAGS = -package dph-seq
-
-
-include $(TOPDIR)/mk/test.mk
-
-
-# -- C version
-quickhullc_SOURCES = legacy/c/Main.c legacy/c/QuickHull.c legacy/c/SVG.c legacy/c/Timing.c
-quickhullc_HEADER  = legacy/c/Timing.h legacy/c/Vector.h
-
-seq/quickhullc : $(quickhullc_SOURCES) $(quickhullc_HEADER)
-       gcc -std=c99 -O3 $(quickhullc_SOURCES) -o seq/quickhullc -lm
-
-
-# -- Vector versions
-quickhullv_SOURCES = \
-       legacy/vector/Main.hs \
-       legacy/vector/QuickHullIO.hs \
-       legacy/vector/QuickHullSplit.hs \
-       legacy/vector/QuickHullVector.hs \
-       legacy/vector/TestDataVector.hs \
-       legacy/vector/SVG.hs \
-       legacy/vector/Timing.hs
-       
-seq/quickhullv : $(quickhullv_SOURCES)
-       ghc -Odph -ilegacy/vector --make legacy/vector/Main.hs -o seq/quickhullv \
-               -package dph-prim-seq -package dph-seq -threaded -rtsopts
-
diff --git a/examples/quickhull/QuickHull.hs b/examples/quickhull/QuickHull.hs
deleted file mode 100644 (file)
index a15f32d..0000000
+++ /dev/null
@@ -1,274 +0,0 @@
--- For lists, this program is heavily GC bound unless we use a very large heap (eg, -H500M)
-
-import GHC.Conc (par, pseq)
-
-import System.IO
-import Control.Exception (evaluate)
-import System.Environment
-import System.CPUTime
-import System.Time
-import System.Random
-
-import Control.Monad
-import Data.Sequence (Seq, (<|), (><))
-import qualified Data.Sequence as Seq
-import qualified Data.Foldable as Fold
-
-import qualified Data.Array.Parallel.Unlifted as U
-
-
--- Time
---
-
-data Time = Time { cpu_time  :: Integer
-                 , wall_time :: Integer
-                 }
-
-type TimeUnit = Integer -> Integer
-
-picoseconds :: TimeUnit
-picoseconds = id
-
-milliseconds :: TimeUnit
-milliseconds n = n `div` 1000000000
-
-seconds :: TimeUnit
-seconds n = n `div` 1000000000000
-
-cpuTime :: TimeUnit -> Time -> Integer
-cpuTime f = f . cpu_time
-
-wallTime :: TimeUnit -> Time -> Integer
-wallTime f = f . wall_time
-
-getTime :: IO Time
-getTime =
-  do
-    cpu          <- getCPUTime
-    TOD sec pico <- getClockTime
-    return $ Time cpu (pico + sec * 1000000000000)
-
-zipT :: (Integer -> Integer -> Integer) -> Time -> Time -> Time
-zipT f (Time cpu1 wall1) (Time cpu2 wall2) =
-  Time (f cpu1 cpu2) (f wall1 wall2)
-
-minus :: Time -> Time -> Time
-minus = zipT (-)
-
-fromTime :: Time -> (Integer, Integer)
-fromTime t = (wallTime milliseconds t, cpuTime milliseconds t)
-
-instance Show Time where
-  showsPrec n t = showsPrec n (wallTime milliseconds t)
-                . showChar '/'
-                . showsPrec n (cpuTime milliseconds t)
-
-
--- Random points generation
---
-
--- IMPORTANT: We use the same seed with the same random generator in all
---            quickhull codes.  The asymptotic work complexity of quickhull
---            is between O (N) and O (N^2) depending on the input.
---            To compare benchmark results, they always need to use the same
---            input.
-
-generatePoints :: Int -> [Point]
-generatePoints n
-  = let rg = mkStdGen 42742     -- always use the same seed
-    in toPoints (take (2*n) (randomRs (-100, 100) rg))
-  where
-    toPoints []        = []
-    toPoints (x:y:pts) = Point x y : toPoints pts
-
-loadPoints :: String -> IO [Point]
-loadPoints file
-  = do
-      h <- openBinaryFile file ReadMode
-      upts <- U.hGet h
-      hClose h
-      convert (U.fsts upts) (U.snds upts)
-
-convert :: U.Array Double -> U.Array Double -> IO [Point]
-convert xs ys
-  = do
-      let pts = zipWith Point (U.toList xs) (U.toList ys)
-      evaluate $ nf pts
-      return pts
-
-
--- Benchmark
--- 
-
-data Point = Point !Double !Double
-data Line  = Line  Point Point
-
-instance Show Point where
-  show (Point x y) = show (x, y)
-  
-nf (Point x y:xs) = x `seq` y `seq` nf xs
-nf []             = ()
-
-distance :: Point -> Line -> Double
-distance (Point xo yo) (Line (Point x1 y1) (Point x2 y2))
-  = (x1-xo) * (y2 - yo) - (y1 - yo) * (x2 - xo)
-  
-
--- Sequential list version
-
-upper :: (a -> a -> Bool) -> [(a, b)] -> b
-upper above = snd . foldl1 pick
-  where
-    pick left@(kl, _) right@(kr, _) | kl `above` kr = left
-                                    | otherwise     = right
-
-hsplitList :: [Point] -> Line -> [Point]
-hsplitList points line@(Line p1 p2)
-  | length packed < 2 = p1:packed
-  | otherwise         = hsplitList packed (Line p1 pm) ++ hsplitList packed (Line pm p2)
-  where
-    cross  = [ (distance p line, p) | p <- points ]
-    packed = [ p | (p, (c, _)) <- zip points cross, c > 0.0 ]
-
-    pm     = upper (>) cross
-
-quickHullList :: [Point] -> [Point]
-quickHullList [] = []
-quickHullList points
-  = hsplitList points (Line minx maxx) ++ hsplitList points (Line maxx minx)
-  where
-    xs   = [ (x, p) | p@(Point x y) <- points ]
-    minx = upper (<) xs
-    maxx = upper (>) xs
-
-
--- Parallel list version
-
-hsplitListPar :: [Point] -> Line -> [Point]
-hsplitListPar points line@(Line p1 p2)
-  | length packed < 2 = p1:packed
-  | otherwise         = let left  = hsplitListPar packed (Line p1 pm)
-                            right = hsplitListPar packed (Line pm p2)
-                        in
-                        right `par` 
-                        (left ++ right)
-  where
-    cross  = [ (distance p line, p) | p <- points ]
-    packed = [ p | (p, (c, _)) <- zip points cross, c > 0.0 ]
-
-    pm     = upper (>) cross
-
-quickHullListPar :: [Point] -> [Point]
-quickHullListPar [] = []
-quickHullListPar points
-  = let left  = hsplitListPar points (Line minx maxx)
-        right = hsplitListPar points (Line maxx minx)
-    in
-    right `par`
-    (left ++ right)
-  where
-    xs   = [ (x, p) | p@(Point x y) <- points ]
-    minx = upper (<) xs
-    maxx = upper (>) xs
-
--- OBSERVATION: If we use nf on 'right' in 'quickHullPar' and 'hsplitPar' (and maybe even 
---   'nf right `par` nf left `pseq` ...') the parallel GC takes a big hit and makes everything much
---   slower.  (Keep in mind that even in the good case, this program spends 2/3 of its running time
---   in the GC.)
-
-
--- Sequential finger-tree version
-
-upperSeq :: (a -> a -> Bool) -> Seq (a, b) -> b
-upperSeq above = snd . Fold.foldl1 pick
-  where
-    pick left@(kl, _) right@(kr, _) | kl `above` kr = left
-                                    | otherwise     = right
-
-hsplitSeq :: Seq Point -> Line -> Seq Point
-hsplitSeq points line@(Line p1 p2)
-  | Seq.length packed < 2 = p1<|packed
-  | otherwise             = hsplitSeq packed (Line p1 pm) >< hsplitSeq packed (Line pm p2)
-  where
-    cross  = fmap (\p -> (distance p line, p)) points
-    packed = fmap fst $ Seq.filter (\(p, (c, _)) -> c > 0.0) (Seq.zip points cross)
-
-    pm     = upperSeq (>) cross
-
-quickHullSeq :: Seq Point -> Seq Point
-quickHullSeq points 
-  | Seq.null points = points
-  | otherwise       = hsplitSeq points (Line minx maxx) >< hsplitSeq points (Line maxx minx)
-  where
-    xs   = fmap (\p@(Point x y) -> (x, p)) points
-    minx = upperSeq (<) xs
-    maxx = upperSeq (>) xs
-
-
--- Parallel finger-tree version
-
-hsplitSeqPar :: Seq Point -> Line -> Seq Point
-hsplitSeqPar points line@(Line p1 p2)
-  | Seq.length packed < 2 = p1<|packed
-  | otherwise             = let left  = hsplitSeqPar packed (Line p1 pm)
-                                right = hsplitSeqPar packed (Line pm p2)
-                            in
-                            right `par`
-                            (left >< right)
-  where
-    cross  = fmap (\p -> (distance p line, p)) points
-    packed = fmap fst $ Seq.filter (\(p, (c, _)) -> c > 0.0) (Seq.zip points cross)
-
-    pm     = upperSeq (>) cross
-
-quickHullSeqPar :: Seq Point -> Seq Point
-quickHullSeqPar points 
-  | Seq.null points = points
-  | otherwise       = let left  = hsplitSeqPar points (Line minx maxx)
-                          right = hsplitSeqPar points (Line maxx minx)
-                      in
-                      right `par`
-                      (left >< right)
-  where
-    xs   = fmap (\p@(Point x y) -> (x, p)) points
-    minx = upperSeq (<) xs
-    maxx = upperSeq (>) xs
-
-
--- main
---
-
-main :: IO ()
-main
-  = do
-      [mode, args1, args2] <- getArgs
-      let runs = read args1
-      --     n    = read args2
-      -- 
-      -- let pts  = generatePoints n
-      -- eval pts `seq` return ()
-      pts <- loadPoints args2
-      let {-# NOINLINE oneRun #-}       -- important to execute multiple runs
-          oneRun pts = do 
-                         t1 <- getTime
-                         let res = case mode of 
-                                     "seq-list" -> quickHullList pts
-                                     "par-list" -> quickHullListPar pts
-                                     "seq-seq"  -> Fold.toList . quickHullSeq    . Seq.fromList $ pts
-                                     "par-seq"  -> Fold.toList . quickHullSeqPar . Seq.fromList $ pts
-                                     _          -> error "mode must be 'seq-list', 'par-list', \
-                                                         \'seq-seq', or 'par-seq'"
-                         evaluate $ nf res
-                         t2 <- getTime
-                         return (length res, fromTime (t2 `minus` t1))
-      results <- sequence (replicate runs (oneRun pts))
-
-      let (lens, times) = unzip results
-          (walls, cpus) = unzip times
-      putStrLn $ "Result length = " ++ show (head lens) ++ ": " ++
-                 showWallCPU (minimum walls) (minimum cpus) ++ " " ++
-                 showWallCPU (sum walls `div` toInteger runs) 
-                             (sum cpus  `div` toInteger runs) ++ " " ++
-                 showWallCPU (maximum walls) (maximum cpus)
-  where
-    showWallCPU wall cpu = show wall ++"/" ++ show cpu
\ No newline at end of file
diff --git a/examples/quickhull/QuickHullVect.hs b/examples/quickhull/QuickHullVect.hs
deleted file mode 100644 (file)
index b1a9f2e..0000000
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE ParallelArrays #-}
-{-# OPTIONS -fvectorise #-}
-
-module QuickHullVect (quickhull) where
-
-import Types
-
-import Data.Array.Parallel.Prelude
-import Data.Array.Parallel.Prelude.Double
-import qualified Data.Array.Parallel.Prelude.Int as Int
-
-import qualified Prelude as P
-
-distance :: Point -> Line -> Double
-distance (xo, yo) ((x1, y1), (x2, y2))
-  = (x1-xo) * (y2 - yo) - (y1 - yo) * (x2 - xo)
-
-hsplit :: [:Point:] -> Line -> [:Point:]
-hsplit points line@(p1, p2)
-  | lengthP packed Int.== 0 = [:p1:]
-  | otherwise
-  = concatP [: hsplit packed ends | ends <- [:(p1, pm), (pm, p2):] :]
-  where
-    cross  = [: distance p line | p <- points :]
-    packed = [: p | (p,c) <- zipP points cross, c > 0.0 :]
-    pm     = points !: maxIndexP cross
-
-quickHull' :: [:Point:] -> [:Point:]
-quickHull' points
-  | lengthP points Int.== 0 = points
-  | otherwise
-  = concatP [: hsplit points ends | ends <- [: (minx, maxx), (maxx, minx) :] :]
-  where
-    xs   = [: x | (x, y) <- points :]
-    minx = points !: minIndexP xs
-    maxx = points !: maxIndexP xs
-
-quickhull :: PArray Point -> PArray Point
-{-# NOINLINE quickhull #-}
-quickhull ps = toPArrayP (quickHull' (fromPArrayP ps))
-
diff --git a/examples/quickhull/SVG.hs b/examples/quickhull/SVG.hs
deleted file mode 100644 (file)
index f4183a7..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-
-module SVG where
-
--- Making a SVG diagram of the points and hull
-makeSVG :: [(Int, Int)] -> [(Int, Int)] -> String
-makeSVG points hull
-       = unlines
-       $  [ "<svg width=\"100%\" height=\"100%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">" ]
-       ++ [svgPolygon hull]
-       ++ map svgPoint points
-       ++ map svgPointHull hull
-       ++ ["</svg>"]
-
-svgPolygon  :: [(Int, Int)] -> String
-svgPolygon points
-       =  "<polygon"
-       ++ " points=\"" ++ (concat [show x ++ "," ++ show y ++ " " | (x, y) <- points]) ++ "\"" 
-       ++ " style=\"fill:#d0d0ff;stroke:#000000;stroke-width:1\""
-       ++ "/>"
-
-svgPoint :: (Int, Int) -> String
-svgPoint (x, y)
-       = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"0.5\""
-       ++ " style=\"stroke:#000000\""
-       ++ "/>"
-
-svgPointHull :: (Int, Int) -> String
-svgPointHull (x, y)
-       = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"1\""
-       ++ " style=\"stroke:#ff0000\""
-       ++ "/>"
-       
-roundPoints :: [(Double, Double)] -> [(Int, Int)]
-roundPoints ps = [(round x, round y) | (x, y) <- ps]
diff --git a/examples/quickhull/TestData.hs b/examples/quickhull/TestData.hs
deleted file mode 100644 (file)
index 785aa88..0000000
+++ /dev/null
@@ -1,91 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-module TestData 
-       ( genPointsUniform
-       , genPointsDisc
-       , genPointsCombo
-       , toPArrayPoints )
-where
-
-import qualified Types as QH
-import qualified Data.Array.Parallel.Unlifted      as U
-import qualified Data.Array.Parallel.Prelude       as P
-import qualified Data.Array.Parallel.Prelude.Double as D
-import qualified Data.Array.Parallel.PArray         as P
-import Data.Array.Parallel.PArray                  (PArray)
-
-import System.Random
-import Control.Exception
-
--- Random points generation
--- IMPORTANT: We use the same seed with the same random generator in all
---            quickhull codes.  The asymptotic work complexity of quickhull
---            is between O (N) and O (N^2) depending on the input.
---            To compare benchmark results, they always need to use the same
---            input.
-seed           = 42742
-
--- | Some uniformly distributed points
-genPointsUniform 
-       :: Int                  -- ^ number of points
-       -- -> Double            -- ^ minimum coordinate
-       -- -> Double            -- ^ maximum coordinate
-        -> U.Array (Double,Double)
-       -- -> [(Double, Double)]
-
-genPointsUniform n -- minXY maxXY
- = let
-       pointMin        = 50
-       pointMax        = 150
-       gen             = mkStdGen seed
-        pts             = U.randomRs (n*2) (pointMin, pointMax) gen
-        xs              = U.extract pts 0 n
-        ys              = U.extract pts n n
-   in
-   U.zip xs ys
-
--- | Some points distributed as a disc
-genPointsDisc'
-       :: Int                  -- ^ number of points
-       -> (Double, Double)     -- ^ center of disc
-       -> Double               -- ^ radius of disc
-        -> U.Array (Double,Double)
-       -- -> [(Double, Double)]
-
-genPointsDisc' n (originX, originY) radiusMax
- = let (genRadius, genAngle)           
-               = split $ mkStdGen seed
-       
-       -- radius       = take n $ randomRs (0, radiusMax) genRadius 
-       -- angle        = take n $ randomRs (- pi, pi) genAngle
-       radius = U.randomRs n (0, radiusMax) genRadius
-        angle  = U.randomRs n (-pi,pi) genAngle
-
-       makeXY r a      
-               = (originX + r * cos a, originY + r * sin a)    
-    in
-    originX `seq` originY `seq` U.zipWith makeXY radius angle
-
-genPointsDisc :: Int -> U.Array (Double,Double)
-genPointsDisc n = genPointsDisc' n (150,150) 100
-
--- | A point cloud with areas of high an low density
-genPointsCombo 
-       :: Int                  -- ^ number of points
-        -> U.Array (Double,Double)
-
-genPointsCombo n
-       =  genPointsDisc' (n `div` 5) (250, 250) 200
-       U.+:+ genPointsDisc' (n `div` 5) (100, 100) 80 
-       U.+:+ genPointsDisc' (n `div` 5) (150, 300) 30 
-       U.+:+ genPointsDisc' (n `div` 5) (500, 120) 30 
-       U.+:+ genPointsDisc' (n `div` 5) (300, 200) 150
-
--- | Convert a list of points to a PArray
-toPArrayPoints :: U.Array (Double,Double) -> IO (PArray QH.Point)
-toPArrayPoints ps
-  = do
-      let pts = QH.points (P.fromUArrPA' (U.fsts ps))
-                          (P.fromUArrPA' (U.snds ps))
-      evaluate $ P.nf pts
-      return pts
-
diff --git a/examples/quickhull/Types.hs b/examples/quickhull/Types.hs
deleted file mode 100644 (file)
index eebc392..0000000
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE ParallelArrays #-}
-{-# OPTIONS -fvectorise #-}
-
-module Types ( Point, Line, points, xsOf, ysOf) where
-
-import Data.Array.Parallel.Prelude
-
-type Point = (Double, Double)
-type Line  = (Point, Point)
-
-points' :: [:Double:] -> [:Double:] -> [:Point:]
-points' = zipP
-
-points :: PArray Double -> PArray Double -> PArray Point
-{-# NOINLINE points #-}
-points xs ys = toPArrayP (points' (fromPArrayP xs) (fromPArrayP ys))
-
-xsOf' :: [:Point:] -> [:Double:]
-xsOf' ps = [: x | (x, _) <- ps :]
-
-xsOf :: PArray Point -> PArray Double
-{-# NOINLINE xsOf #-}
-xsOf ps = toPArrayP (xsOf' (fromPArrayP ps))
-
-ysOf' :: [:Point:] -> [:Double:]
-ysOf' ps = [: y | (_, y) <- ps :]
-
-ysOf :: PArray Point -> PArray Double
-{-# NOINLINE ysOf #-}
-ysOf ps = toPArrayP (ysOf' (fromPArrayP ps))
-
-
diff --git a/examples/quickhull/gen.hs b/examples/quickhull/gen.hs
deleted file mode 100644 (file)
index d4ebb82..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-import Data.Array.Parallel.Unlifted as U
-import TestData
-import System.IO
-import System.Environment
-
-dists :: [(String, Int -> U.Array (Double :*: Double))]
-dists = [("square", genPointsUniform)
-        ,("disc", genPointsDisc)]
-
-main = do
-         [sn,dist,file] <- getArgs
-         let n   = read sn
-             gen = case lookup dist dists of
-                     Just f  -> f
-                     Nothing -> error $ "Unknown distribution " ++ dist
-             pts = gen n
-         pts `seq` return ()
-         h <- openBinaryFile file WriteMode
-         U.hPut h pts
-         hClose h
-
diff --git a/examples/quickhull/legacy/c/Main.c b/examples/quickhull/legacy/c/Main.c
deleted file mode 100644 (file)
index 7d02d8c..0000000
+++ /dev/null
@@ -1,90 +0,0 @@
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <math.h>
-#include "Vector.h"
-#include "Timing.h"
-
-// FFS people.
-#ifndef M_PI
-#define M_PI 3.1415926535
-#endif
-
-
-extern int  quickHull  (Vector* points, Vector* hull);
-extern void dumpSVG    (FILE* file, Vector* points, Vector* hull);
-
-
-int main(int argc, char** argv)
-{
-       // Parse cmd line args.
-       int     pointCount      = 0;
-       char*   outSVG          = 0;
-
-       if(argc == 2) {
-               pointCount      = atoi(argv[1]);
-               outSVG          = 0;
-       }
-       else if (argc == 3) {
-               pointCount      = atoi(argv[1]);
-               outSVG          = argv[2];
-       }
-       else {
-               printf("usage: quickhull <points> [out.svg]\n");
-               exit(1);
-       }
-
-       // Initialise the vector to hold the hull.
-       Vector* hull            = vector_new(pointCount);
-               
-       // Use random points for test data.
-       Vector* points          = vector_new(pointCount);
-
-       double  originX         = 300;
-       double  originY         = 300;
-       long    maxDist         = 250;
-       
-       srandom(170);
-       for (int i = 0; i < pointCount; i++) {
-               double r        = (random() % (maxDist * 2)) - maxDist;
-               double a        = M_PI * (random() % 360) / 360;
-
-               vector_append
-                       ( points
-                       , originX + r * cos (a)
-                       , originY + r * sin (a));
-       }
-
-       // Timing setup
-        struct timeval start, finish;
-        struct rusage start_ru, finish_ru;
-
-        gettimeofday( &start, NULL );
-        getrusage( RUSAGE_SELF, &start_ru );
-
-       // Do the deed.
-       int depth = quickHull (points, hull);
-
-       // Print how long it took.
-        gettimeofday( &finish, NULL );
-        getrusage( RUSAGE_SELF, &finish_ru );
-
-       printf("depth          = %d\n", depth);
-       printf("points on hull = %d\n", hull->length);
-
-        sub_timeval( &finish, &start );
-        sub_timeval( &finish_ru.ru_utime, &start_ru.ru_utime );
-        sub_timeval( &finish_ru.ru_stime, &start_ru.ru_stime );
-        add_timeval( &finish_ru.ru_utime, &finish_ru.ru_stime );
-
-       printf("timing         = ");
-        print_timeval( &finish ); putchar( '/' );
-        print_timeval( &finish_ru.ru_utime); putchar( '\n' );
-
-       // Write output to file if requested.
-       if(outSVG != 0) {
-               FILE* file = fopen(outSVG, "w");
-               dumpSVG (file, points, hull);   
-               fclose  (file);
-       }
-}
diff --git a/examples/quickhull/legacy/c/QuickHull.c b/examples/quickhull/legacy/c/QuickHull.c
deleted file mode 100644 (file)
index fc048e7..0000000
+++ /dev/null
@@ -1,136 +0,0 @@
-
-#include <math.h>
-#include <stdlib.h>
-
-#include "Vector.h"
-
-// Compute the square of the distance between a point and a line.
-static inline double distance
-       ( double x0, double y0          // point
-       , double x1, double y1          // a point on the line
-       , double x2, double y2)         // another point on the line
-{
-       return  ((x1 - x0) * (y2 - y0)) - ((y1 - y0) * (x2 - x0));
-}
-
-
-int hsplit
-       ( int depth,            int maxDepth
-       , Vector** pointss,     Vector* hull
-       , double  x1,           double y1
-       , double  x2,           double y2)
-{
-       // The maximum depth to use is statically determined by the caller.
-       assert(depth < maxDepth);
-
-       // We read our points from the buffer at the current depth.
-       Vector* points  = pointss[depth];
-
-       // No hull points here.
-       if (points->length == 0) 
-               return depth;
-
-       // The packed points go into the buffer at the next lowest depth.
-       Vector* packed  = pointss[depth + 1];
-       vector_rewind(packed);
-               
-       // Find the point that is furthest away from the line.
-       // While we're doing this, record the points that are on the left of the line.
-       double maxX     = 0;
-       double maxY     = 0;
-       double maxDist  = 0;
-       for (int i = 0; i < points->length; i++) {
-               double px       = points->x[i];
-               double py       = points->y[i];
-               double d        = distance(px, py, x1, y1, x2, y2);
-
-               if (d > 0) {
-                       vector_append(packed, px, py);
-
-                       if (d > maxDist) {
-                               maxDist = d;
-                               maxX    = px;
-                               maxY    = py;
-                       }
-               }
-       }
-       
-       // All the points were on the right of the line
-       if (packed->length == 0) {
-               vector_append(hull, x1, y1);
-               return depth;
-       } 
-       else {
-               
-               // Check the left segment
-               int depthLeft  = hsplit(depth + 1, maxDepth, pointss, hull, x1, y1, maxX, maxY);
-
-               // Check the right segment
-               int depthRight = hsplit(depth + 1, maxDepth, pointss, hull, maxX, maxY, x2, y2);
-                       
-               if (depthLeft > depthRight)
-                       return depthLeft;
-               else    return depthRight;
-       }
-}
-
-
-// Compute the convex hull of a set of points.
-//     Returns the maximum depth used in the recursion.
-int quickHull 
-       ( Vector* points        // The 2d points to use.
-       , Vector* hull)         // Buffer to write the hull points to.
-{
-       // We're preallocating buffers to hold packed points at each level
-       // to avoid the overhead of calls to malloc/free.
-       // Maximum algorithm depth we're handling. 
-       // Instead of statically setting this we could do a check at each level
-       // And allocate some more if needed.
-       int maxDepth            = 15;
-
-       // No points, nothing to do.
-       if (points->length == 0)
-               return 0;
-
-       // Handle special case of just one point here, so we don't end up
-       // adding it to the hull twice.
-       if (points->length == 1) {
-               vector_append(hull, points->x[0], points->y[1]);
-               return 1;
-       }
-       
-       // Initialise point buffers.
-       // Buffer 0 is set to the incoming points.
-       Vector** pointss        = malloc(sizeof(Vector*) * maxDepth);
-       pointss[0]              = points;
-       for(int i = 1; i < maxDepth; i++)
-               pointss[i]      = vector_new(points->length);
-       
-       // Find the left and right-most points.
-       double leftX    = points->x[0];
-       double leftY    = points->y[0];
-       double rightX   = points->x[0];
-       double rightY   = points->y[0];
-       for(int i = 0; i < points->length; i++) {
-               double px       = points->x[i];
-               double py       = points->y[i];
-
-               if (px < leftX) {
-                       leftX   = px;
-                       leftY   = py;
-               }
-               if (px > rightX) {
-                       rightX  = px;
-                       rightY  = py;
-               }
-       }
-
-       // Determine hull points above and below the split.
-       int depthLeft  = hsplit (0, maxDepth, pointss, hull, leftX,  leftY,  rightX, rightY);
-       int depthRight = hsplit (0, maxDepth, pointss, hull, rightX, rightY, leftX,  leftY);
-
-       // Return maximum recursion depth reached.
-       if(depthLeft > depthRight)
-               return depthLeft;
-       else    return depthRight;
-}
diff --git a/examples/quickhull/legacy/c/SVG.c b/examples/quickhull/legacy/c/SVG.c
deleted file mode 100644 (file)
index 8ee7f45..0000000
+++ /dev/null
@@ -1,63 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include "Vector.h"
-
-void svgLine
-       ( FILE*         file
-       , char*         strColor
-       , int x1, int y1
-       , int x2, int y2)
-{      
-       fprintf ( file
-               , "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" style=\"stroke:%s;stroke-width:2\"/>\n"
-               , x1, y1, x2, y2, strColor);
-}
-
-
-void dumpPoints
-       ( FILE*         file
-       , char*         strColor
-       , int           radius
-       , Vector*       points)
-{
-       for(int i = 0; i < points->length; i++) {
-               double px       = points->x[i];
-               double py       = points->y[i];
-               fprintf ( file
-                       , "<circle cx=\"%d\" cy=\"%d\" r=\"%d\" style=\"stroke:%s\"/>\n"
-                       , (int)px
-                       , (int)py
-                       , radius
-                       , strColor);
-       }
-}
-
-
-void dumpLineLoop 
-       ( FILE*         file
-       , char*         strColor
-       , Vector*       points)
-{
-       for(int i = 0; i < points->length - 1; i++)
-               svgLine ( file, strColor
-                       , points->x[i],   points->y[i]
-                       , points->x[i+1], points->y[i+1]);
-       
-       int j = points->length - 1;
-       svgLine ( file, strColor
-               , points->x[0], points->y[0]
-               , points->x[j], points->y[j]);
-}
-       
-
-void dumpSVG
-       ( FILE*         file
-       , Vector*       points
-       , Vector*       hull)
-{
-       fprintf(file, "<svg width=\"100%%\" height=\"100%%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">\n");
-       dumpPoints   (file, "#000000", 1, points);
-       dumpPoints   (file, "#ff0000", 5, hull);
-       dumpLineLoop (file, "#0000ff", hull);
-       fprintf(file, "</svg>\n");
-}
diff --git a/examples/quickhull/legacy/c/Timing.c b/examples/quickhull/legacy/c/Timing.c
deleted file mode 100644 (file)
index 6bc4e53..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-#include <sys/time.h>
-#include <sys/resource.h>
-#include <stdio.h>
-
-void
-add_timeval( struct timeval *x, const struct timeval *y )
-{
-  x->tv_sec += y->tv_sec;
-  x->tv_usec += y->tv_usec;
-  if( x->tv_usec > 1000000 ) {
-    ++x->tv_sec;
-    x->tv_usec -= 1000000;
-  }
-}
-
-
-void
-sub_timeval( struct timeval *x, const struct timeval *y )
-{
-  x->tv_sec -= y->tv_sec;
-  if( x->tv_usec < y->tv_usec ) {
-    --x->tv_sec;
-    x->tv_usec = x->tv_usec + (1000000 - y->tv_usec);
-  } else
-    x->tv_usec -= y->tv_usec;
-}
-
-
-void
-print_timeval( const struct timeval *t )
-{
-  printf( "%ld", (long int) t->tv_sec * 1000 + (long int) t->tv_usec / 1000 );
-}
-
diff --git a/examples/quickhull/legacy/c/Timing.h b/examples/quickhull/legacy/c/Timing.h
deleted file mode 100644 (file)
index 6929e14..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-#ifndef _Timing_h_
-#define _Timing_h_
-
-#include <sys/time.h>
-#include <sys/resource.h>
-
-void
-add_timeval( struct timeval *x, const struct timeval *y );
-
-void
-sub_timeval( struct timeval *x, const struct timeval *y );
-
-void
-print_timeval( const struct timeval *t );
-
-
-
-#endif
-
diff --git a/examples/quickhull/legacy/c/Vector.h b/examples/quickhull/legacy/c/Vector.h
deleted file mode 100644 (file)
index 45ee2b2..0000000
+++ /dev/null
@@ -1,50 +0,0 @@
-
-#ifndef _Vector_
-#define _Vector_
-
-#include <assert.h>
-
-typedef struct {
-       int     capacity;
-       int     length;
-       double* x;
-       double* y;
-} Vector;
-
-
-static inline void vector_append(Vector* vector, double x, double y)
-{
-       assert(vector->length + 1 <= vector->capacity);
-       
-       int i           = vector->length;
-       vector->x[i]    = x;
-       vector->y[i]    = y;
-       vector->length++;
-}
-
-
-static inline Vector* vector_new(int capacity)
-{
-       Vector* vector   = malloc(sizeof(Vector));
-       vector->capacity = capacity;
-       vector->length   = 0;
-       vector->x        = malloc(sizeof(double) * capacity);
-       vector->y        = malloc(sizeof(double) * capacity);
-       return vector;
-}
-
-static inline void vector_rewind(Vector* vector)
-{
-       vector->length = 0;
-}
-
-
-static inline void vector_delete(Vector* vector)
-{
-       free(vector->x);
-       free(vector->y);
-       free(vector);
-}
-
-#endif
-
diff --git a/examples/quickhull/legacy/vector/Main.hs b/examples/quickhull/legacy/vector/Main.hs
deleted file mode 100644 (file)
index c88a8f1..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-{-# LANGUAGE PatternGuards #-}
-
-import System.Environment
-import Data.Function
-import qualified Data.Vector.Unboxed   as V
-import Data.Vector.Unboxed             (Vector)
-import Control.Monad
-
-import qualified QuickHullVector
-import qualified QuickHullIO
-import qualified QuickHullSplit
-import TestDataVector
-import Timing
-import SVG
-
-algs =         [ ("vector",    (\v -> return $ QuickHullVector.quickHull v))
-       , ("io",        QuickHullIO.quickHull)
-       , ("split",     (\v -> return $ QuickHullSplit.quickHull v)) ]
-
-parseArgs args
-       | [alg, strCount]       <- args
-       , Just fun              <- lookup alg algs
-       = Just (fun, read strCount, Nothing)
-
-       | [alg, strCount, file] <- args
-       , Just fun              <- lookup alg algs
-       = Just (fun, read strCount, Just file)
-
-       | otherwise
-       = Nothing
-
-
-main :: IO ()
-main
- = do  argStrs         <- getArgs
-       case parseArgs argStrs of
-        Just args      -> run args
-        _              -> putStr $ unlines
-                               [ "usage: quickhull <alg> <points> [out.svg]"
-                               , "   algs: " ++ (show $ map fst algs) ++ "\n" ]
-
-run (fun, pointCount, mFileSVG) 
- = do
-       let vPoints     = genPointsDisc pointCount (400, 400) 350 
-
-       -- Force points to create the input vector.
-       V.force vPoints `seq` return ()
-
-       -- Compute the convex hull.
-       timeStart       <- getTime
-       vHull           <- fun vPoints
-       V.force vHull `seq` return ()
-       timeEnd         <- getTime
-
-       -- Print how long it took.
-       print (timeEnd `minus` timeStart)
-
-       -- Dump to .svg file if requested.
-       let hull        = V.toList vHull
-       maybe   (return ())
-               (\file -> writeFile file $ makeSVG 
-                               (roundPoints $ V.toList vPoints)
-                               (roundPoints $ V.toList vHull))
-               mFileSVG
-
-
-
-
diff --git a/examples/quickhull/legacy/vector/QuickHullIO.hs b/examples/quickhull/legacy/vector/QuickHullIO.hs
deleted file mode 100644 (file)
index f406f4e..0000000
+++ /dev/null
@@ -1,269 +0,0 @@
-{-# LANGUAGE BangPatterns, PatternGuards, RankNTypes #-}
-
-module QuickHullIO
-       (quickHull)
-where
-import Data.Function
-import Control.Monad
-import Control.Exception
-import Control.Concurrent
-import Control.Concurrent.MVar
-import Control.Monad.ST
-import GHC.Conc
-import Data.IORef
-import Data.List
-import Data.Ord
-import Data.Vector.Unboxed                     (Vector)
-import qualified Data.Vector.Unboxed           as V
-import qualified Data.Vector.Unboxed.Mutable   as MV
-import qualified Data.Vector.Generic           as G
-import Debug.Trace
-
-type Point     = (Double, Double)
-type Line      = (Point, Point)
-
-
--- | Compute the convex hull of a vector of points.
-quickHull :: Vector Point -> IO (Vector Point)
-quickHull !points
-  | V.length points == 0       
-  = return points
-
-  | otherwise
-  = do -- Find the left and right-most points.
-       let (minx, maxx)        = minmax points
-
-       -- Hull points get written to the vector in this IORef.
-       hullRef <- newIORef V.empty
-
-       -- Fork off computations to handle half of the points each.
-       -- For uniformly distributed points this first iteration takes most of the time.
-       parIO   [ hsplit hullRef points minx maxx
-               , hsplit hullRef points maxx minx]
-
-       -- Grab the finished hull points.
-       hull    <- readIORef hullRef
-
-       -- We've got the hull points, but they can appear in arbitrary order.
-       -- Do a rubbish via-lists merge phase so that they appear clockwise around the edge.
-       -- This isn't too expensive if there aren't many points on the hull.
-       let (above, below) 
-               = V.unstablePartition 
-                       (\p -> distance minx maxx p > 0)
-                       hull
-       
-       let aboveSorted = V.fromList $ sortBy (comparing fst) $ V.toList above
-       let belowSorted = V.fromList $ sortBy (comparing fst) $ V.toList below
-       let hull' = aboveSorted V.++ V.reverse belowSorted
-
-       return hull'
-       
-
-hsplit :: IORef (Vector Point) -> Vector Point -> Point -> Point -> IO ()
-{-# INLINE hsplit #-}
-hsplit hullRef !points !p1@(!p1X, !p1Y) !p2@(!p2X, !p2Y)
-       -- we've found one.
-       | V.length packed == 0
-       = addHullPoint hullRef p1
-       
-       -- do the two new segments in parallel.
-       | V.length packed > 1000
-       = parIO
-               [ hsplit hullRef packed p1 pm
-               , hsplit hullRef packed pm p2 ]
-               
-       | otherwise
-       = do    hsplit hullRef packed p1 pm
-               hsplit hullRef packed pm p2
-
-       where   (packed, pm)    = parPackPoints points p1X p1Y p2X p2Y
-       
-
--- | Copy points from the input vector that are on the left of the line into a
---     new buffer. While we're doing this, determine the point that is furthest
---     from the line.
---
---     If we have a big enough vector then split it in two and do both halves
---     in parallel. Doing this requires a copy afterwards to join the two
---     results back together. It's a trade off between decreased FP load and 
---     increased memory traffic. 
---
-parPackPoints 
-       :: Vector Point 
-       -> Double -> Double
-       -> Double -> Double
-       -> ( Vector Point
-          , Point)
-       
-{-# INLINE parPackPoints #-}
-parPackPoints !points !p1X !p1Y !p2X !p2Y
- |   numCapabilities == 1
-  || V.length points < 1000
- = packPoints p1X p1Y p2X p2Y points
-
- | otherwise
- = let 
-       numSegments     = numCapabilities
-
-       -- Total number of points to process.
-       lenPoints       = V.length points
-
-       -- How many points to process in each segment.
-       lenSeg          = lenPoints `div` numSegments
-
-       -- If the total number of points doesn't divide evenly into segments
-       -- then there may be an odd number. Make sure to get the rest into the last segment.
-       splitPacked count ixStart 
-           | count == 0        = []
-
-           | count == 1        
-           = let points'               = V.unsafeSlice ixStart (lenPoints - ixStart) points
-                 result@(packed', _)   = packPoints p1X p1Y p2X p2Y points'
-             in  packed' `pseq` (result : [])
-
-           | otherwise 
-           = let points'               = V.unsafeSlice ixStart lenSeg points
-                 result@(packed', _)   = packPoints p1X p1Y p2X p2Y points'
-                 rest                  = splitPacked (count - 1) (ixStart + lenSeg)
-             in  packed' `par` rest `par` (result : rest)
-
-       results = splitPacked numSegments 0
-       vResult = concatVectors $ map fst results
-       pMax    = selectFurthest p1X p1Y p2X p2Y results
-       
-   in  (vResult, pMax)
-
-
-selectFurthest 
-       :: Double -> Double 
-       -> Double -> Double
-       -> [(Vector Point, Point)] 
-       -> Point
-       
-selectFurthest !p1X !p1Y !p2X !p2Y ps
- = go (0, 0) 0 ps
-
- where go pMax !distMax []     
-        = pMax
-
-       go pMax !distMax ((packed, pm):rest)
-        | V.length packed == 0
-        = go pMax distMax rest
-       
-        | otherwise
-        , dist         <-  distance (p1X, p1Y) (p2X, p2Y) pm 
-        = if dist > distMax
-               then go pm   dist    rest
-               else go pMax distMax rest
-
-
-packPoints 
-       :: Double -> Double             -- First point on dividing line.
-       -> Double -> Double             -- Second point on dividing line.
-       -> Vector Point                 -- Source points.
-       -> ( Vector Point               -- Packed vector containing only points on the left of the line.
-          , Point)                     -- The point on the left that was furthest from the line.
-
-{-# INLINE packPoints #-}
-packPoints !p1X !p1Y !p2X !p2Y !points 
- = let
-       result  
-        = G.create 
-        $ do   packed           <- MV.new (V.length points + 1)
-               (pMax, ixPacked) <- fill points packed p1X p1Y p2X p2Y 0 0
-
-               -- We stash the maximum point on the end of the vector to get
-               -- it through the create call.
-               MV.unsafeWrite packed ixPacked pMax
-               return $ MV.unsafeSlice 0 (ixPacked + 1) packed
-       
-   in  ( V.unsafeSlice 0 (V.length result - 1) result
-       , result `V.unsafeIndex` (V.length result - 1))
-                       
-
-fill   :: forall s
-       .  Vector Point                 -- Source points.
-       -> MV.MVector s Point           -- Vector to write packed points into.
-       -> Double -> Double             -- First point on dividing line.
-       -> Double -> Double             -- Second poitn on dividing line.
-       -> Int                          -- Index into source points to start reading from.
-       -> Int                          -- Index into packed points to start writing to.
-       -> ST s 
-               ( Point                 -- Furthest point from the line that was found.
-               , Int)                  -- The number of packed points written.
-
-{-# INLINE fill #-}
-fill !points !packed !p1X !p1Y !p2X !p2Y !ixPoints' !ixPacked'
- = go (0, 0) 0 ixPoints' ixPacked'
- where go pMax !distMax !ixPoints !ixPacked
-       | ixPoints >= V.length points   
-       = do    return (pMax, ixPacked)
-               
-       | p     <- points `V.unsafeIndex` ixPoints
-       , d     <- distance (p1X, p1Y) (p2X, p2Y) p
-       , d > 0
-       = do    MV.unsafeWrite packed ixPacked p
-               if d > distMax
-                then   go p    d       (ixPoints + 1) (ixPacked + 1)
-                else   go pMax distMax (ixPoints + 1) (ixPacked + 1)
-                       
-       | otherwise
-       = go pMax distMax (ixPoints + 1) ixPacked
-
-
-minmax :: Vector Point -> (Point, Point)
-{-# INLINE minmax #-}
-minmax !vec
- = go first first 0
- where first   = vec V.! 0
-
-       go pMin@(!minX, !minY) pMax@(!maxX, !maxY) !ix
-         | ix >= V.length vec  = (pMin, pMax)
-
-         | (x, y)      <- vec `V.unsafeIndex` ix
-         = if       x < minX then go (x, y) pMax   (ix + 1)
-           else if  x > maxX then go pMin   (x, y) (ix + 1)
-           else go pMin pMax (ix + 1)
-       
-
-distance :: Point -> Point -> Point -> Double
-{-# INLINE distance #-}
-distance (x1, y1) (x2, y2) (xo, yo)
-  = (x1-xo) * (y2 - yo) - (y1 - yo) * (x2 - xo)
-
-
-addHullPoint :: IORef (Vector Point) -> Point -> IO ()
-addHullPoint hullRef p
- = atomicModifyIORef hullRef
- $ \hull -> (V.singleton p V.++ hull, ())
-
-
-
--- Can't find an equivalent for this in Control.Concurrent.
-parIO :: [IO ()] -> IO ()
-parIO stuff
- = do  mVars   <- replicateM (length stuff) newEmptyMVar
-       zipWithM_ (\c v -> forkIO $ c `finally` putMVar v ()) stuff mVars
-       mapM_ readMVar mVars
-       
-
--- We really want a function in the vector library for this.
-concatVectors :: [Vector Point] -> Vector Point
-{-# NOINLINE concatVectors #-}
-concatVectors vectors
- = G.create
- $ do  let len = sum $ map V.length vectors
-       vOut    <- MV.new len
-       go vectors vOut 0
-       return vOut
-
- where {-# INLINE go #-}
-       go [] _ _
-        = return ()
-
-       go (vSrc:vsSrc) vDest !ixStart  
-        = do   let lenSrc      = V.length vSrc
-               let vDestSlice  = MV.unsafeSlice ixStart lenSrc vDest
-               V.copy vDestSlice vSrc
-               go vsSrc vDest (ixStart + lenSrc) 
-
diff --git a/examples/quickhull/legacy/vector/QuickHullSplit.hs b/examples/quickhull/legacy/vector/QuickHullSplit.hs
deleted file mode 100644 (file)
index 13a3f58..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-
-module QuickHullSplit
-       (quickHull)
-where
-import qualified Data.Vector.Unboxed   as V
-import Data.Vector.Unboxed             (Vector)
-
-quickHull :: Vector (Double, Double) -> Vector (Double, Double)
-quickHull vv
-       = uncurry V.zip $ quickhull $ V.unzip vv
-
-quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double)
-{-# NOINLINE quickhull #-}
-quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys')
-    where
-      (xs',ys') = V.unzip
-                $ hsplit points pmin pmax V.++ hsplit points pmax pmin
-
-      imin = V.minIndex xs
-      imax = V.maxIndex xs
-
-      points = V.zip xs ys
-      pmin   = points V.! imin
-      pmax   = points V.! imax
-
-
-      hsplit points p1 p2
-        | V.length packed < 2 = p1 `V.cons` packed
-        | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2
-        where
-          cs     = V.map (\p -> cross p p1 p2) points
-          packed = V.map fst
-                 $ V.filter (\t -> snd t > 0)
-                 $ V.zip points cs
-
-          pm     = points V.! V.maxIndex cs
-
-      cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x)
diff --git a/examples/quickhull/legacy/vector/QuickHullVector.hs b/examples/quickhull/legacy/vector/QuickHullVector.hs
deleted file mode 100644 (file)
index e4d7bc6..0000000
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE BangPatterns, PatternGuards #-}
-
-module QuickHullVector
-       (quickHull)
-where
-import Data.Function
-import Data.Vector.Unboxed             as V
-import Data.Vector.Unboxed.Mutable     as MV
-import Data.Vector.Unboxed             (Vector)
-import qualified Data.Vector.Generic   as G
-import System.IO.Unsafe
-
-type Point     = (Double, Double)
-type Line      = (Point, Point)
-
-
-distance :: Point -> Point -> Point -> Double
-{-# INLINE distance #-}
-distance (x1, y1) (x2, y2) (xo, yo)
-  = (x1-xo) * (y2 - yo) - (y1 - yo) * (x2 - xo)
-
-
-hsplit :: Vector Point -> Point -> Point -> Vector Point
-{-# INLINE hsplit #-}
-hsplit !points !p1@(!p1X, !p1Y) !p2@(!p2X, !p2Y)
- = let !packed = packPoints points p1X p1Y p2X p2Y
-   in  if V.length packed == 1
-        then V.singleton p1
-        else   let pm          = packed `V.unsafeIndex` (V.length packed - 1)
-                   packed'     = V.unsafeSlice 0 (V.length packed - 1) packed
-               in  hsplit packed' p1 pm V.++ hsplit packed' pm p2
-
-
-packPoints :: Vector Point -> Double -> Double -> Double -> Double -> Vector Point
-{-# INLINE packPoints #-}
-packPoints !points !p1X !p1Y !p2X !p2Y
- = G.create 
- $ do  packed  <- MV.new (V.length points + 1)
-       
-       -- stash the furthest point on the end of the returned vector.  
-       let fill !pMax !distMax !ixPoints !ixPacked
-               | ixPoints >= V.length points   
-               = do    MV.unsafeWrite packed ixPacked pMax
-                       return $ MV.unsafeSlice 0 (ixPacked + 1) packed
-
-               | p     <- points `V.unsafeIndex` ixPoints
-               , d     <- distance (p1X, p1Y) (p2X, p2Y) p
-               , d > 0
-               = do    MV.unsafeWrite packed ixPacked p
-                       if d > distMax
-                        then   fill p    d       (ixPoints + 1) (ixPacked + 1)
-                        else   fill pMax distMax (ixPoints + 1) (ixPacked + 1)
-                       
-               | otherwise
-               = fill pMax distMax (ixPoints + 1) ixPacked
-                       
-       fill (0, 0) 0 0 0
-
-
-quickHull :: Vector Point -> Vector Point
-quickHull !points
-       | V.length points == 0  = points
-
-       | (minx, maxx)          <- minmax points
-       = hsplit points minx maxx V.++ hsplit points maxx minx
-
-
-minmax :: Vector Point -> (Point, Point)
-{-# INLINE minmax #-}
-minmax !vec
- = go first first 0
- where first   = vec V.! 0
-
-       go pMin@(!minX, !minY) pMax@(!maxX, !maxY) !ix
-         | ix >= V.length vec  = (pMin, pMax)
-
-         | (x, y)      <- vec `V.unsafeIndex` ix
-         = if       x < minX then go (x, y) pMax   (ix + 1)
-           else if  x > maxX then go pMin   (x, y) (ix + 1)
-           else go pMin pMax (ix + 1)
-       
diff --git a/examples/quickhull/legacy/vector/SVG.hs b/examples/quickhull/legacy/vector/SVG.hs
deleted file mode 100644 (file)
index f4183a7..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-
-module SVG where
-
--- Making a SVG diagram of the points and hull
-makeSVG :: [(Int, Int)] -> [(Int, Int)] -> String
-makeSVG points hull
-       = unlines
-       $  [ "<svg width=\"100%\" height=\"100%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">" ]
-       ++ [svgPolygon hull]
-       ++ map svgPoint points
-       ++ map svgPointHull hull
-       ++ ["</svg>"]
-
-svgPolygon  :: [(Int, Int)] -> String
-svgPolygon points
-       =  "<polygon"
-       ++ " points=\"" ++ (concat [show x ++ "," ++ show y ++ " " | (x, y) <- points]) ++ "\"" 
-       ++ " style=\"fill:#d0d0ff;stroke:#000000;stroke-width:1\""
-       ++ "/>"
-
-svgPoint :: (Int, Int) -> String
-svgPoint (x, y)
-       = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"0.5\""
-       ++ " style=\"stroke:#000000\""
-       ++ "/>"
-
-svgPointHull :: (Int, Int) -> String
-svgPointHull (x, y)
-       = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"1\""
-       ++ " style=\"stroke:#ff0000\""
-       ++ "/>"
-       
-roundPoints :: [(Double, Double)] -> [(Int, Int)]
-roundPoints ps = [(round x, round y) | (x, y) <- ps]
diff --git a/examples/quickhull/legacy/vector/TestDataVector.hs b/examples/quickhull/legacy/vector/TestDataVector.hs
deleted file mode 100644 (file)
index 25365b4..0000000
+++ /dev/null
@@ -1,133 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, BangPatterns  #-}
-{-# OPTIONS -fwarn-unused-imports #-}
-module TestDataVector
-       ( genPointsUniform
-       , genPointsDisc
-       , genPointsCombo)
-where
-import qualified Data.Vector.Unboxed.Mutable   as MV
-import qualified Data.Vector.Unboxed           as V
-import Data.Vector.Unboxed                     (Vector)
-import qualified Data.Vector.Generic           as G            
-import System.Random
-import Data.Word
-
--- Random points generation
--- IMPORTANT: We use the same seed with the same random generator in all
---            quickhull codes.  The asymptotic work complexity of quickhull
---            is between O (N) and O (N^2) depending on the input.
---            To compare benchmark results, they always need to use the same
---            input.
-seed           = 42742
-
--- | Some uniformly distributed points
-genPointsUniform 
-       :: Int                  -- ^ number of points
-       -> Double               -- ^ minimum coordinate
-       -> Double               -- ^ maximum coordinate
-       -> [(Double, Double)]
-
-genPointsUniform n minXY maxXY
- = let
-       pointMin        = 10
-       pointMax        = 510
-       gen             = mkStdGen seed
-   in  toPairs $ take (2*n) $ randomRs (pointMin, pointMax) gen
-
-toPairs []        = []
-toPairs (x:y:pts) = (x, y) : toPairs pts
-
-
--- | Some points distributed as a disc
-genPointsDisc 
-       :: Int                  -- ^ number of points
-       -> (Double, Double)     -- ^ center of disc
-       -> Double               -- ^ radius of disc
-       -> Vector (Double, Double)
-
-genPointsDisc n (originX, originY) radiusMax
- = let 
-
-{-     (genRadius, genAngle)           
-               = split $ mkStdGen seed
-       
-       radius  = V.fromList $ take n $ randomRs (0, radiusMax) genRadius
-       angle   = V.fromList $ take n $ randomRs (- pi, pi) genAngle
--}
-       radius  = V.map (\x -> (fromIntegral x / 100000) * radiusMax)
-               $ randomInts n 0 100000 seed
-
-       angle   = V.map (\x -> (fromIntegral x / 100000) * (2 * pi))
-               $ randomInts n 0 100000 (seed + 1)
-
-       makeXY r a
-               = ( originX + r * cos a
-                 , originY + r * sin a)        
-
-   in  V.zipWith makeXY radius angle   
-
-
--- | A point cloud with areas of high an low density
-genPointsCombo 
-       :: Int                  -- ^ number of points
-       -> Vector (Double, Double)
-
-genPointsCombo n
-       =  genPointsDisc (n `div` 5) (250, 250) 200
-       V.++ genPointsDisc (n `div` 5) (100, 100) 80 
-       V.++ genPointsDisc (n `div` 5) (150, 300) 30 
-       V.++ genPointsDisc (n `div` 5) (500, 120) 30 
-       V.++ genPointsDisc (n `div` 5) (300, 200) 150
-
-
--- | Use the "minimal standard" Lehmer generator to quickly generate some random
---   numbers with reasonable statistical properties. By "reasonable" we mean good
---   enough for games and test data, but not cryptography or anything where the
---   quality of the randomness really matters.
--- 
---   From "Random Number Generators: Good ones are hard to find"
---   Stephen K. Park and Keith W. Miller.
---   Communications of the ACM, Oct 1988, Volume 31, Number 10.
---
-randomInts 
-       :: Int          -- Length of vector.
-       -> Int          -- Minumum value in output.
-       -> Int          -- Maximum value in output.
-       -> Int          -- Random seed. 
-       -> Vector Int   -- Vector of random numbers.
-
-randomInts !len !valMin' !valMax' !seed'
-       
- = let -- a magic number (don't change it)
-       multiplier :: Word64
-       multiplier = 16807
-
-       -- a merzenne prime (don't change it)
-       modulus :: Word64
-       modulus = 2^31 - 1
-
-       -- if the seed is 0 all the numbers in the sequence are also 0.
-       seed    
-        | seed' == 0   = 1
-        | otherwise    = seed'
-
-       !valMin = fromIntegral valMin'
-       !valMax = fromIntegral valMax' + 1
-       !range  = valMax - valMin
-
-       {-# INLINE f #-}
-       f x             = multiplier * x `mod` modulus
- in G.create 
-     $ do      
-       vec             <- MV.new len
-
-       let go !ix !x 
-               | ix == len     = return ()
-               | otherwise
-               = do    let x'  = f x
-                       MV.write vec ix $fromIntegral $ (x `mod` range) + valMin
-                       go (ix + 1) x'
-
-       go 0 (f $ fromIntegral seed)
-       return vec
-       
diff --git a/examples/quickhull/legacy/vector/Timing.hs b/examples/quickhull/legacy/vector/Timing.hs
deleted file mode 100644 (file)
index e9d4842..0000000
+++ /dev/null
@@ -1,48 +0,0 @@
-
-module Timing where
-import System.CPUTime
-import System.Time
-
-data Time = Time { cpu_time  :: Integer
-                 , wall_time :: Integer
-                 }
-
-type TimeUnit = Integer -> Integer
-
-picoseconds :: TimeUnit
-picoseconds = id
-
-milliseconds :: TimeUnit
-milliseconds n = n `div` 1000000000
-
-seconds :: TimeUnit
-seconds n = n `div` 1000000000000
-
-cpuTime :: TimeUnit -> Time -> Integer
-cpuTime f = f . cpu_time
-
-wallTime :: TimeUnit -> Time -> Integer
-wallTime f = f . wall_time
-
-getTime :: IO Time
-getTime =
-  do
-    cpu          <- getCPUTime
-    TOD sec pico <- getClockTime
-    return $ Time cpu (pico + sec * 1000000000000)
-
-zipT :: (Integer -> Integer -> Integer) -> Time -> Time -> Time
-zipT f (Time cpu1 wall1) (Time cpu2 wall2) =
-  Time (f cpu1 cpu2) (f wall1 wall2)
-
-minus :: Time -> Time -> Time
-minus = zipT (-)
-
-fromTime :: Time -> (Integer, Integer)
-fromTime t = (wallTime milliseconds t, cpuTime milliseconds t)
-
-instance Show Time where
-  showsPrec n t = showsPrec n (wallTime milliseconds t)
-                . showChar '/'
-                . showsPrec n (cpuTime milliseconds t)
-
diff --git a/examples/quickhull/vect.hs b/examples/quickhull/vect.hs
deleted file mode 100644 (file)
index b7cf206..0000000
+++ /dev/null
@@ -1,135 +0,0 @@
-import qualified Types as QH
-import QuickHullVect (quickhull)
-
-import Data.Array.Parallel.Unlifted as U
-import Data.Array.Parallel.Prelude
-import qualified Data.Array.Parallel.Prelude.Double as D
-import Data.Array.Parallel.PArray as P
-import Data.Array.Parallel
-import Data.Array.Parallel.Prelude ( fromUArrPA_2' )
-
-import Prelude as Prel
-import qualified System.Random as R
-import System.IO
-import Control.Exception (evaluate)
-
-import Bench.Benchmark
-import Bench.Options
-import TestData
-
-
--- Random points generation
---
-
--- IMPORTANT: We use the same seed with the same random generator in all
---            quickhull codes.  The asymptotic work complexity of quickhull
---            is between O (N) and O (N^2) depending on the input.
---            To compare benchmark results, they always need to use the same
---            input.
-
-generatePoints :: Int -> Maybe String -> IO (Point (PArray QH.Point))
-generatePoints n s
-  = do
-      let rg = R.mkStdGen 42742     -- always use the same seed
-          ds = U.randomRs (n*2) (-100, 100) rg
-          xs = U.extract ds 0 n
-          ys = U.extract ds n n
-      save s xs ys
-      convert xs ys
-  where
-    save Nothing  _ _ = return ()
-    save (Just s) xs ys = do
-                            h <- openBinaryFile s WriteMode
-                            U.hPut h (U.zip xs ys)
-                            hClose h
-
-{-
-          ps  = toPairs (take (2*n) (R.randomRs (-100, 100) rg))
-          pts = QH.points (P.fromList (Prel.map fst ps))
-                          (P.fromList (Prel.map snd ps))
-      evaluate $ nf pts -- force pts
-      return $ ("N = " ++ show n) `mkPoint` pts
-  where
-    toPairs []        = []
-    toPairs (x:y:pts) = (x, y) : toPairs pts
-
-    force pts = toUArrPA (QH.xsOf pts) U.!: 0 D.+ 
-                toUArrPA (QH.ysOf pts) U.!: 0
--}
-
-loadPoints :: String -> IO (Point (PArray QH.Point))
-loadPoints file
-  = do
-      h <- openBinaryFile file ReadMode
-      upts <- U.hGet h
-      hClose h
-      convert (U.fsts upts) (U.snds upts)
-{-
-      let pts = QH.points (fromUArrPA' (U.fsts upts)) (fromUArrPA' (U.snds upts))
-      evaluate $ nf pts
-      return $ ("N = " ++ show (U.length upts)) `mkPoint` pts
--}
-
-convert :: U.Array Double -> U.Array Double -> IO (Point (PArray QH.Point))
-convert xs ys
-  = do
-      let pts = QH.points (fromUArrPA' xs) (fromUArrPA' ys)
-      evaluate $ nf pts
-      return $ ("N = " ++ show (U.length xs)) `mkPoint` pts
-
-
-
--- Main
--- ----
-
-{- Simple test
-pts = points (P.fromList (Prel.map fst coords))
-             (P.fromList (Prel.map snd coords))
-  where
-    coords = [(3,3),(2,7),(0,0),(8,5), (4,6),(5,3),(9,6),(10,0)]
-
-result = Prel.zip (U.toList (toUArrPA (xsOf ps)))
-                  (U.toList (toUArrPA (ysOf ps)))
-  where
-    ps = quickhull pts
-
-main = print result
- -}
-
-main = ndpMain "Quick hull"
-               "[OPTION] ... SIZES ..."
-               run [] ()
-
-run opts () [] = failWith ["No sizes or input files specified"]
-run opts () args =
-  do
-    benchmark opts quickhull
-        (gen args)
-        nf
-        (\ps -> "Result length = " ++ show (P.length ps))
-    return ()
-  where
-    gen [] = []
-    gen (arg:args)
-      = case reads arg of
-          [(n,"")] -> case args of
-                        ("w" : s : args') -> generatePoints n (Just s) : gen args'
-                        _                  -> generatePoints n Nothing  : gen args
-          _        -> loadPoints arg : gen args
-
-{-
-  case Prel.map read sizes of
-    []  -> failWith ["No sizes or input files specified"]
-    szs -> do
-             benchmark opts runQuickhull
-                (Prel.map generatePoints szs)
-                (`seq` ()) (("Result length = " ++) . show)
-             return ()
-  where
-    runQuickhull :: PArray QH.Point -> Int
-    runQuickhull pts = let result = quickhull pts
-                           resxs  = toUArrPA (QH.xsOf result)
-                       in
-                       resxs U.!: 0 `seq` U.length resxs
--}
-        
diff --git a/examples/quickhull/vectSVG.hs b/examples/quickhull/vectSVG.hs
deleted file mode 100644 (file)
index 9c542e9..0000000
+++ /dev/null
@@ -1,49 +0,0 @@
-
--- This version prints a SVG of the test data and computed hull to stdout.
--- usage:  vectSVG <POINTS>
---
-import qualified Types as QH
-import QuickHullVect (quickhull)
-
-import qualified Data.Array.Parallel.Unlifted      as U
-import qualified Data.Array.Parallel.Prelude       as P
-
-import qualified Data.Array.Parallel.PArray         as P
-import Data.Array.Parallel.PArray                  (PArray)
-
-import System.Environment
-import System.IO
-import Data.List
-
-import SVG
-import TestData
-
-
------
-runQuickhull :: PArray QH.Point -> [(Double, Double)]
-runQuickhull pts 
- = let result = quickhull pts
-       resxs  = P.toUArrPA (QH.xsOf result)
-       resys  = P.toUArrPA (QH.ysOf result)
-   in  resxs U.!: 0 `seq` (zip (U.toList resxs) (U.toList resys))
-
-
--- Main Program ---------------------------------------------------------------
-main 
- = do  [arg]   <- getArgs
-        pts     <- case reads arg of
-                     [(n,"")] -> return $ genPointsCombo n
-                     _        -> do
-                                   h <- openBinaryFile arg ReadMode
-                                   pts <- U.hGet h
-                                   hClose h
-                                   return pts
-        paInput <- toPArrayPoints pts
-
-       let psHull  = runQuickhull paInput
-           psInput = P.toList paInput
-       
-       putStr 
-        $ makeSVG 
-               (roundPoints psInput)
-               (roundPoints psHull)
diff --git a/examples/sumsq/Makefile b/examples/sumsq/Makefile
deleted file mode 100644 (file)
index d20d6f6..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-TOPDIR = ..
-BINARIES = sumsq prim sumsq-c
-
-sumsq_DPH = sumsq
-sumsq_SOURCES = vect.hs SumSqVect.hs
-sumsq_seq_FLAGS = -fsimplifier-phases=3
-sumsq_par_FLAGS = -fsimplifier-phases=3
-
-prim_DPH = prim
-prim_SOURCES = prim.hs SumSqPrim.hs
-
-CFLAGS = -I$(TOPDIR)/../../../includes
-sumsq-c_CSOURCES = sumsq-c.c
-
-include $(TOPDIR)/mk/test.mk
diff --git a/examples/sumsq/SumSqPrim.hs b/examples/sumsq/SumSqPrim.hs
deleted file mode 100644 (file)
index e9939f6..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-module SumSqPrim (sumSq)
-where
-
-import Data.Array.Parallel.Unlifted as U
-
-sumSq :: Int -> Int
-{-# NOINLINE sumSq #-}
-sumSq n = U.sum (U.map (\x -> x * x) (U.enumFromTo 1 n))
diff --git a/examples/sumsq/SumSqVect.hs b/examples/sumsq/SumSqVect.hs
deleted file mode 100644 (file)
index 6be50c7..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# LANGUAGE ParallelArrays #-}
-{-# OPTIONS -fvectorise #-}
-module SumSqVect (sumSq)
-where
-
-import Data.Array.Parallel.Prelude
-import Data.Array.Parallel.Prelude.Int as I
-
-import qualified Prelude
-
-sumSq :: Int -> Int
-{-# NOINLINE sumSq #-}
-sumSq n = I.sumP (mapP (\x -> x * x) (enumFromToP 1 n))
---sumSq n = I.sumP [:x * x | x <- [:1..n:]:]
-  -- complains about: Variable not vectorised: GHC.PArr.$senumFromToP
diff --git a/examples/sumsq/prim.hs b/examples/sumsq/prim.hs
deleted file mode 100644 (file)
index 55f2511..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-import SumSqPrim ( sumSq )
-
-import Control.Exception (evaluate)
-import System.Console.GetOpt
-import qualified System.Random as R
-
-import qualified Data.Array.Parallel.Unlifted as U
-
-import Bench.Benchmark
-import Bench.Options
-
-main = ndpMain "Sum squares"
-               "[OPTION] ... SIZES ..."
-               run [] ()
-
-run opts () sizes =
-  case map read sizes of
-    []  -> failWith ["No sizes specified"]
-    szs -> do
-             benchmark opts sumSq
-                (map (\n -> return $ ("N = " ++ show n) `mkPoint` n) szs)
-                (`seq` ()) show
-             return ()
-
diff --git a/examples/sumsq/sumsq-c.c b/examples/sumsq/sumsq-c.c
deleted file mode 100644 (file)
index bb711f1..0000000
+++ /dev/null
@@ -1,42 +0,0 @@
-#include <unistd.h>
-#include <stdio.h>
-#include <fcntl.h>
-#include <stdlib.h>
-#include <time.h>
-
-#include <HsFFI.h>
-
-HsInt compute(HsInt n)
-{
-  HsInt sum = 0;
-
-  while ( n >= 1 ) {
-    sum += n * n;
-    n--;
-  }
-  return sum;
-}
-
-int main( int argc, char * argv[] )
-{
-  HsInt result, n, r, i;
-  clock_t start, finish, acc;
-
-  n = atoi( argv[2] );
-  r = atoi( argv[1] );
-  printf( "n = %ld; r = %ld \n", (long)n, (long)r );
-
-  acc = 0;
-  for (i = 0; i < r; i++) {
-    start = clock();
-    result = compute( n ); 
-    finish = clock();
-    acc += finish - start;
-  }
-
-  printf( "time = %ld; value = %ld\n", 
-         (long int)((acc/r) / (CLOCKS_PER_SEC/1000)),
-         (long)result);
-  return 0;
-}
-
diff --git a/examples/sumsq/vect.hs b/examples/sumsq/vect.hs
deleted file mode 100644 (file)
index 0099da1..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-import SumSqVect ( sumSq )
-
-import Control.Exception (evaluate)
-import System.Console.GetOpt
-import qualified System.Random as R
-
-import qualified Data.Array.Parallel.Unlifted as U
-
-import Bench.Benchmark
-import Bench.Options
-
-main = ndpMain "Sum squares"
-               "[OPTION] ... SIZES ..."
-               run [] ()
-
-run opts () sizes =
-  case map read sizes of
-    []  -> failWith ["No sizes specified"]
-    szs -> do
-             benchmark opts sumSq
-                (map (\n -> return $ ("N = " ++ show n) `mkPoint` n) szs)
-                (`seq` ()) show
-             return ()
-
diff --git a/examples/words/Main.hs b/examples/words/Main.hs
deleted file mode 100644 (file)
index 027c6b9..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-
-import WordsVect
-import Data.Array.Parallel.Prelude
-import qualified Data.Array.Parallel.Prelude.Word8     as W
-import qualified Data.Array.Parallel.PArray            as P
-import qualified Data.Array.Parallel.Unlifted          as U
-import Data.Char
-
-main 
- = do  -- take the filename containing the words as the first arg
-       let str =  "When   I   look  into  the   looking glass I'm always sure to see"
-               ++ " no matter how I dodge         about, me looking      back at me."
-
-       -- convert string to a PArray
-       let paStr   :: PArray W.Word8
-           paStr = fromUArrPA' $ U.map W.fromInt $ U.fromList $ map ord str
-       
-       
-       -- break the string into words then flatten it back             
-       let str' :: String
-           str' = map chr 
-                $ map fromIntegral
-                $ P.toList 
-                $ wordsOfPArray paStr
-                       
-
-       -- count the number of words in the string, using the vectorised program
-       let wordCountVect = fromIntegral $ wordCountOfPArray paStr
-       
-       -- count the number of words with the ye'olde list way
-       let wordCountList = length $ words str
-       
-       -- 
-       putStr  $  show str' ++ "\n"
-               ++ "word count vect  = " ++ show wordCountVect ++ "\n"
-               ++ "word count lists = " ++ show wordCountList ++ "\n"
-               
diff --git a/examples/words/WordsVect.hs b/examples/words/WordsVect.hs
deleted file mode 100644 (file)
index da08409..0000000
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# LANGUAGE PArr, ParallelListComp #-}
-{-# OPTIONS -fvectorise #-}
-
-module WordsVect
-       ( wordsOfPArray
-       , wordCountOfPArray )
-where
-import qualified Data.Array.Parallel.Prelude.Word8     as W
-import Data.Array.Parallel.Prelude.Word8               (Word8)
-import Data.Array.Parallel.Prelude.Int
-import Data.Array.Parallel.Prelude
-
-import qualified Prelude as Prel
-
-
--- We can't use the Prelude Char and String types in vectorised code yet..
-type Char      = Word8
-char_space     = W.fromInt 32
-
-type String    = [: Char :]
-
-
--- | Word state
-data State
-       = Chunk String
-       | Seg   String          -- initial word chunk
-               [:String:]      -- complete words in the middle of the segment
-               String          -- final word chunk
-
-
--- | Compose two wordstates.
-plusState :: State -> State -> State
-plusState str1 str2
- = case (str1, str2) of
-       (Chunk as, Chunk bs)            -> Chunk (as +:+ bs)
-       (Chunk as, Seg bl bss br)       -> Seg (as +:+ bl) bss br
-       (Seg al ass ar, Chunk bs)       -> Seg al ass (ar +:+ bs)
-       (Seg al ass ar, Seg bl bss br)  -> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br
-
-joinEmpty :: [:[:Word8:]:] -> [:[:Word8:]:]
-joinEmpty ws 
-       | lengthP ws == 1 && lengthP (ws !: 0) == 0     = [::]
-       | otherwise                                     = ws
-
-
--- | Convert a single char to a wordstate.
-stateOfChar :: Char -> State
-stateOfChar c
-       | c W.== char_space     = Seg [::] [::] [::]
-       | otherwise             = Chunk [:c:]
-       
-       
--- | Break this string into words.
-stateOfString :: String -> State
-stateOfString str
- = let         len     = lengthP str
-       result
-        | len == 0     = Chunk [::]
-        | len == 1     = stateOfChar (str !: 0)
-        | otherwise    
-        =  let half    = len `div` 2
-               s1      = sliceP 0    half str
-               s2      = sliceP half len  str
-           in  plusState (stateOfString s1) (stateOfString s2)
-    in result
-
-
--- | Count the number of words in a string.
-countWordsOfState :: State -> Int
-countWordsOfState state
- = case state of
-       Chunk c         -> wordsInChunkArr c
-       Seg c1 ws c2    -> wordsInChunkArr c1 + lengthP ws + wordsInChunkArr c2
-       
-wordsInChunkArr :: [:Word8:] -> Int
-wordsInChunkArr arr
-       | lengthP arr == 0      = 0
-       | otherwise             = 1
-
-
--- | Flatten a state back to an array of Word8s,
---     inserting spaces between the words.
-flattenState :: State -> [:Word8:]
-flattenState ss
- = case ss of
-       Chunk s -> s
-
-       Seg   w1 ws w2  
-               ->  w1 
-               +:+ [:char_space:]
-               +:+ concatP [: w +:+ [:char_space:] | w <- ws :]
-               +:+ w2
-
--- Interface ------------------------------------------------------------------
-
--- | Break up an array of chars into words then flatten it back.
-wordsOfPArray :: PArray Word8 -> PArray Word8
-wordsOfPArray arr
- = let str     = fromPArrayP arr
-       state   = stateOfString str
-       strOut  = flattenState state
-   in  toPArrayP strOut
-
-
--- | Count the number of words in an array
-wordCountOfPArray :: PArray Word8 -> Int
-wordCountOfPArray arr
- = let str     = fromPArrayP arr
-       state   = stateOfString str
-   in  countWordsOfState state
-
diff --git a/examples/words/legacy/WordsList.hs b/examples/words/legacy/WordsList.hs
deleted file mode 100644 (file)
index 1827616..0000000
+++ /dev/null
@@ -1,47 +0,0 @@
-
-
--- | A word state
-data State
-       = Nil
-               
-       -- | A piece of string containing no spaces
-       | Chunk String
-
-       -- | A piece of string containing spaces
-       | Seg   String          -- ^ left section
-               [String]        -- ^ words in middle
-               String          -- ^ right section
-       deriving Show
-       
-       
-stateOfChar :: Char -> State
-stateOfChar c
- = case c of
-       ' '     -> Seg "" [] ""
-       _       -> Chunk [c]
-       
-plusState :: State -> State -> State
-plusState s1 s2
- = case (s1, s2) of
-       (Nil, _)                        -> s2
-       (_,   Nil)                      -> s1
-       (Chunk aa, Chunk bb)            -> Chunk (aa ++ bb)
-       (Chunk aa, Seg bl bs br)        -> Seg (aa ++ bl) bs br
-       (Seg al as ar, Chunk bb)        -> Seg al as (ar ++ bb)
-       (Seg al as ar, Seg bl bs br)    -> Seg al (as ++ flatten [ar] ++ flatten [bl] ++ bs) br
-       
-stateOfString :: String -> State
-stateOfString ss
-       = foldl1 plusState (map stateOfChar ss) 
-               
-flatten [[]]           = []
-flatten xx             = xx
-
-str1   =  "Dude   I   look  into  the   looking glass I'm always sure to see"
-       ++ " no matter how I dodge         about, me looking      back at me."
-
-str2   = "Wibble  "
-
-main
- = do  -- take the filename containing the words as the first arg
-       print $ stateOfString str1
\ No newline at end of file