diff --git a/hgeometry.cabal b/hgeometry.cabal
--- a/hgeometry.cabal
+++ b/hgeometry.cabal
@@ -1,5 +1,5 @@
 name:                hgeometry
-version:             0.12.0.3
+version:             0.12.0.4
 synopsis:            Geometric Algorithms, Data structures, and Data types.
 description:
   HGeometry provides some basic geometry types, and geometric algorithms and
@@ -14,7 +14,7 @@
 maintainer:          frank@fstaals.net
 -- copyright:
 
-tested-with:         GHC >= 8.2
+tested-with:         GHC >= 8.8
 
 category:            Geometry
 build-type:          Simple
@@ -141,6 +141,7 @@
                     Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer
                     Algorithms.Geometry.DelaunayTriangulation.Naive
 
+                    Algorithms.Geometry.PolyLineSimplification.ImaiIri
                     Algorithms.Geometry.PolyLineSimplification.DouglasPeucker
 
                     Algorithms.Geometry.EuclideanMST
@@ -225,7 +226,7 @@
   -- other-extensions:
   build-depends:
                 base                    >= 4.11      &&     < 5
-              , hgeometry-combinatorial >= 0.12.0.0
+              , hgeometry-combinatorial >= 0.12.0.3
 
               , bifunctors              >= 4.1
               , bytestring              >= 0.10
@@ -237,7 +238,7 @@
               -- , singletons              >= 2.0
               , linear                  >= 1.10
               , fixed-vector            >= 1.0
-              , vector-builder          >= 0.3.7   && <= 0.3.8
+              , vector-builder          >= 0.3.7
               , vinyl                   >= 0.10
               , deepseq                 >= 1.1
               , fingertree              >= 0.1
@@ -260,6 +261,7 @@
               , nonempty-vector         >= 0.2.0.0
               , text                    >= 1.1.1.0
               , vector-algorithms
+              , witherable              >= 0.4
 
               , aeson                   >= 1.0
               , yaml                    >= 0.8
diff --git a/src/Algorithms/Geometry/PolyLineSimplification/DouglasPeucker.hs b/src/Algorithms/Geometry/PolyLineSimplification/DouglasPeucker.hs
--- a/src/Algorithms/Geometry/PolyLineSimplification/DouglasPeucker.hs
+++ b/src/Algorithms/Geometry/PolyLineSimplification/DouglasPeucker.hs
@@ -21,11 +21,11 @@
 --------------------------------------------------------------------------------
 
 -- | Line simplification with the well-known Douglas Peucker alogrithm. Given a distance
--- value eps adn a polyline pl, constructs a simplification of pl (i.e. with
+-- value eps and a polyline pl, constructs a simplification of pl (i.e. with
 -- vertices from pl) s.t. all other vertices are within dist eps to the
 -- original polyline.
 --
--- Running time: \( O(n^2) \) worst case, \( O(n log n) \) expected.
+-- Running time: \( O(n^2) \) worst case, \( O(n log n) \) on average.
 douglasPeucker         :: (Ord r, Fractional r, Arity d)
                        => r -> PolyLine d p r -> PolyLine d p r
 douglasPeucker eps pl
diff --git a/src/Algorithms/Geometry/PolyLineSimplification/ImaiIri.hs b/src/Algorithms/Geometry/PolyLineSimplification/ImaiIri.hs
new file mode 100644
--- /dev/null
+++ b/src/Algorithms/Geometry/PolyLineSimplification/ImaiIri.hs
@@ -0,0 +1,138 @@
+-- |
+-- Module      :  Algorithms.Geometry.PolyLineSimplification.ImaiIri
+-- Copyright   :  (C) Frank Staals
+-- License     :  see the LICENSE file
+-- Maintainer  :  Frank Staals
+--------------------------------------------------------------------------------
+module Algorithms.Geometry.PolyLineSimplification.ImaiIri
+  ( simplify
+  , simplifyWith
+  ) where
+
+import           Algorithms.Graph.BFS (bfs')
+import           Control.Lens
+import           Data.Ext
+import qualified Data.Foldable as F
+import           Data.Geometry.LineSegment
+import           Data.Geometry.Point
+import           Data.Geometry.PolyLine
+import           Data.Geometry.Vector
+import qualified Data.LSeq as LSeq
+import           Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Sequence as Seq
+import           Data.Tree
+import qualified Data.Vector as V
+import           Witherable
+
+import Data.RealNumber.Rational
+type R = RealNumber 5
+
+--------------------------------------------------------------------------------
+
+-- | Line simplification with the Imai-Iri alogrithm. Given a distance
+-- value eps and a polyline pl, constructs a simplification of pl
+-- (i.e. with vertices from pl) s.t. all other vertices are within
+-- dist eps to the original polyline.
+--
+-- Running time: \( O(n^2) \) time.
+simplify     :: (Ord r, Fractional r, Arity d)
+             => r -> PolyLine d p r -> PolyLine d p r
+simplify eps = simplifyWith $ \shortcut subPoly -> all (closeTo shortcut) (subPoly^.points)
+  where
+    closeTo seg (p :+ _) = sqDistanceToSeg p seg  <= epsSq
+    epsSq = eps*eps
+
+-- | Given a function that tests if the shortcut is valid, compute a
+-- simplification using the Imai-Iri algorithm.
+--
+-- Running time: \( O(Tn^2 \) time, where \(T\) is the time to
+-- evaluate the predicate.
+simplifyWith            :: (LineSegment d p r -> PolyLine  d p r -> Bool)
+                        -> PolyLine d p r -> PolyLine d p r
+simplifyWith isValid pl = pl&points %~ (LSeq.promise @2 . extract path)
+  where
+    g    = mkGraph isValid pl
+    spt  = bfs' 0 g
+    path = case pathsTo (pl^.points.to F.length - 1) spt of
+             []      -> error "no path found?"
+             (pth:_) -> pth
+
+----------------------------------------
+
+type Graph = V.Vector [Int]
+
+-- | Constructs the shortcut graph
+mkGraph         :: (LineSegment d p r -> PolyLine d p r -> Bool) -> PolyLine d p r -> Graph
+mkGraph isValid = flip V.snoc [] . V.imap f . V.fromList . F.toList . allPrefixes
+  where
+    f i subPl = catMaybes
+              $ zipWith isValid' [i+1..] . F.toList . allSuffixes $ subPl
+
+    isValid' j subPoly = let shortcut = ClosedLineSegment (subPoly^.start) (subPoly^.end)
+                         in if isValid shortcut subPoly then Just j else Nothing
+
+-- | Generates all prefixes of the polyline; i.e. all contiguous
+-- polylines all starting at the original starting point.
+allPrefixes    :: PolyLine d p r -> Seq.Seq (PolyLine d p r)
+allPrefixes pl = mapMaybe mkPolyLine . Seq.tails . LSeq.toSeq $ pl^.points
+
+mkPolyLine :: Seq.Seq (Point d r :+ p) -> Maybe (PolyLine d p r)
+mkPolyLine = fmap PolyLine . LSeq.eval @2 . LSeq.fromSeq
+
+-- | Generates all suffixes of the polyline.
+allSuffixes :: PolyLine d p r -> Seq.Seq (PolyLine d p r)
+allSuffixes pl = mapMaybe mkPolyLine . Seq.drop 2 . Seq.inits . LSeq.toSeq $ pl^.points
+
+
+
+
+
+
+-- | Get all paths to the particular element in the tree.
+pathsTo   :: Eq a => a -> Tree a -> [NonEmpty a]
+pathsTo x = findPaths (== x)
+
+-- | All paths to the nodes satisfying the predicate.
+findPaths   :: (a -> Bool) -> Tree a -> [NonEmpty a]
+findPaths p = go
+  where
+    go (Node x chs) = case foldMap go chs of
+                        []    | p x       -> [x:|[]]
+                              | otherwise -> []
+                        paths | p x       -> (x:|[]) : map (x NonEmpty.<|) paths
+                              | otherwise ->           map (x NonEmpty.<|) paths
+
+
+
+
+-- | Given a non-empty list of indices, and some LSeq, extract the elemnets
+-- on those indices.
+--
+-- running time: \(O(n)\)
+extract    :: NonEmpty Int -> LSeq.LSeq n a -> LSeq.LSeq 0 a
+extract is = LSeq.fromList . extract' (F.toList is) 0 . F.toList
+
+extract'                                 :: [Int] -> Int -> [a] -> [a]
+extract' []         _ _                  = []
+extract' (_:_)      _ []                 = []
+extract' is'@(i:is) j (x:xs) | i == j    = x : extract' is (j+1) xs
+                             | otherwise = extract' is' (j+1) xs
+
+--------------------------------------------------------------------------------
+
+
+tr :: Tree Int
+tr = Node 0 [Node 1 [], Node 2 [Node 3 [], Node 2 [], Node 4 [Node 5 []]]]
+
+poly :: PolyLine 2 Int R
+poly = case fromPoints [origin :+ 0, Point2 1 1 :+ 1, Point2 2 2 :+ 2, Point2 3 3 :+ 3] of
+         Just p -> p
+
+test = Seq.fromList [0..5]
+
+myTree :: Tree Int
+myTree = Node {rootLabel = 0, subForest = [Node {rootLabel = 1, subForest = []}
+                                       ,Node {rootLabel = 2, subForest = []}
+                                       ,Node {rootLabel = 3, subForest = []}]
+           }
diff --git a/src/Data/Geometry/PolyLine.hs b/src/Data/Geometry/PolyLine.hs
--- a/src/Data/Geometry/PolyLine.hs
+++ b/src/Data/Geometry/PolyLine.hs
@@ -90,7 +90,7 @@
 
 -- | Builds a Polyline from a list of points, if there are sufficiently many points
 fromPoints :: [Point d r :+ p] -> Maybe (PolyLine d p r)
-fromPoints = fmap PolyLine . LSeq.eval (C @ 2) . LSeq.fromList
+fromPoints = fmap PolyLine . LSeq.eval @2 . LSeq.fromList
 
 -- | pre: The input list contains at least two points
 fromPointsUnsafe :: [Point d r :+ p] -> PolyLine d p r
