From 197aa26ca0ec5ce19c08e1d0f02384f8581999d6 Mon Sep 17 00:00:00 2001 From: Sam Jones Date: Fri, 1 Oct 2021 13:32:49 +0100 Subject: [PATCH 1/6] created type and base functions for kdtree --- src/DataStructures/KDTree.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 src/DataStructures/KDTree.hs diff --git a/src/DataStructures/KDTree.hs b/src/DataStructures/KDTree.hs new file mode 100644 index 0000000..6e217e6 --- /dev/null +++ b/src/DataStructures/KDTree.hs @@ -0,0 +1,13 @@ +module DataStructures.KDTree where + + +data KDTree a = Empty | Node [a] (KDTree a) (KDTree a) deriving Show + +-- Create a balanced k-d tree from a list of points +kdtree :: (Ord a) => [[a]] -> KDTree a +kdtree ps = kdtree' ps 0 + +-- Recursive helper function for kdtree, takes an extra parameter: depth +kdtree' :: (Ord a) => [[a]] -> Int -> KDTree a +kdtree' [] _ = Empty +kdtree' ps depth = Empty \ No newline at end of file From 00a92d173f7c26bdd17a564b088843c6dad4a1df Mon Sep 17 00:00:00 2001 From: Sam Jones Date: Fri, 1 Oct 2021 14:54:06 +0100 Subject: [PATCH 2/6] added KDTree construction --- src/DataStructures/KDTree.hs | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/src/DataStructures/KDTree.hs b/src/DataStructures/KDTree.hs index 6e217e6..3cc5d34 100644 --- a/src/DataStructures/KDTree.hs +++ b/src/DataStructures/KDTree.hs @@ -1,13 +1,30 @@ module DataStructures.KDTree where - +import Data.List (sort) data KDTree a = Empty | Node [a] (KDTree a) (KDTree a) deriving Show +-- Point type where an axis is selected, for sorting points +data Point a = P [a] Int deriving Eq +instance (Ord a) => Ord (Point a) where + (P p1 k1) <= (P p2 k2) = p1!!k1 <= p2!!k2 + -- Create a balanced k-d tree from a list of points kdtree :: (Ord a) => [[a]] -> KDTree a -kdtree ps = kdtree' ps 0 +kdtree [] = Empty +kdtree (p:ps) = kdtree' (p:ps) (length p) 0 + +-- Recursive helper function for kdtree, takes extra parameters k and depth +kdtree' :: (Ord a) => [[a]] -> Int -> Int -> KDTree a +kdtree' [] _ _ = Empty +kdtree' ps k depth = let axis = (depth `mod` k) + sps = pointSort ps axis + m = (length sps) `div` 2 + l = take m sps + r = drop (m+1) sps + in Node (sps!!m) (kdtree' l k (depth+1)) (kdtree' r k (depth + 1)) --- Recursive helper function for kdtree, takes an extra parameter: depth -kdtree' :: (Ord a) => [[a]] -> Int -> KDTree a -kdtree' [] _ = Empty -kdtree' ps depth = Empty \ No newline at end of file +-- Sort a list of points with respect to an axis +pointSort :: (Ord a) => [[a]] -> Int -> [[a]] +pointSort [] _ = [] +pointSort [x] _ = [x] +pointSort ps axis = map (\(P p axis) -> p) (sort (map (\p -> P p axis) ps)) \ No newline at end of file From 817f2a032c3974309f107f4a494c9b28d1c35529 Mon Sep 17 00:00:00 2001 From: github-actions <${GITHUB_ACTOR}@users.noreply.github.com> Date: Fri, 1 Oct 2021 13:54:33 +0000 Subject: [PATCH 3/6] updating DIRECTORY.md --- DIRECTORY.md | 1 + 1 file changed, 1 insertion(+) diff --git a/DIRECTORY.md b/DIRECTORY.md index 3594d0f..07f0aca 100644 --- a/DIRECTORY.md +++ b/DIRECTORY.md @@ -18,6 +18,7 @@ * [Binarysearchtree](https://github.com/TheAlgorithms/Haskell/blob/master/src/BinaryTree/BinarySearchTree.hs) * [Binarytree](https://github.com/TheAlgorithms/Haskell/blob/master/src/BinaryTree/BinaryTree.hs) * Datastructures + * [Kdtree](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/KDTree.hs) * [Maxheap](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/MaxHeap.hs) * Graph * [Dfs](https://github.com/TheAlgorithms/Haskell/blob/master/src/Graph/Dfs.hs) From 44549855e762348b83c6a04af611d6b2d4b4786a Mon Sep 17 00:00:00 2001 From: Sam Jones Date: Fri, 1 Oct 2021 22:11:31 +0100 Subject: [PATCH 4/6] added 'addPoint' function for adding points to a k-d tree --- src/DataStructures/KDTree.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/DataStructures/KDTree.hs b/src/DataStructures/KDTree.hs index 3cc5d34..f934e83 100644 --- a/src/DataStructures/KDTree.hs +++ b/src/DataStructures/KDTree.hs @@ -27,4 +27,16 @@ kdtree' ps k depth = let axis = (depth `mod` k) pointSort :: (Ord a) => [[a]] -> Int -> [[a]] pointSort [] _ = [] pointSort [x] _ = [x] -pointSort ps axis = map (\(P p axis) -> p) (sort (map (\p -> P p axis) ps)) \ No newline at end of file +pointSort ps axis = map (\(P p axis) -> p) (sort (map (\p -> P p axis) ps)) + +-- Add a point to a k-d tree +addPoint :: (Ord a) => [a] -> KDTree a -> KDTree a +addPoint p tree = addPoint' p tree 0 (length p) + +-- Recursive helper function for add point +addPoint' :: (Ord a) => [a] -> KDTree a -> Int -> Int -> KDTree a +addPoint' p Empty _ _ = Node p Empty Empty +addPoint' p (Node root l r) d k + | (P p axis) < (P root axis) = Node root (addPoint' p l (d+1) k) r + | otherwise = Node root l (addPoint' p r (d+1) k) + where axis = d `mod` k From 00faa65e6f9ed098be60e641531bffb0d2a853f2 Mon Sep 17 00:00:00 2001 From: Sam Jones Date: Sun, 3 Oct 2021 11:59:26 +0100 Subject: [PATCH 5/6] added 'removePoint' for removing points from a k-d tree --- src/DataStructures/KDTree.hs | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/src/DataStructures/KDTree.hs b/src/DataStructures/KDTree.hs index f934e83..80b153a 100644 --- a/src/DataStructures/KDTree.hs +++ b/src/DataStructures/KDTree.hs @@ -27,16 +27,35 @@ kdtree' ps k depth = let axis = (depth `mod` k) pointSort :: (Ord a) => [[a]] -> Int -> [[a]] pointSort [] _ = [] pointSort [x] _ = [x] -pointSort ps axis = map (\(P p axis) -> p) (sort (map (\p -> P p axis) ps)) +pointSort ps axis = map (\(P p _) -> p) (sort (map (`P` axis) ps)) -- Add a point to a k-d tree addPoint :: (Ord a) => [a] -> KDTree a -> KDTree a -addPoint p tree = addPoint' p tree 0 (length p) +addPoint p tree = addPoint' p tree 0 (length p) --- Recursive helper function for add point +-- Recursive helper function for addPoint addPoint' :: (Ord a) => [a] -> KDTree a -> Int -> Int -> KDTree a addPoint' p Empty _ _ = Node p Empty Empty addPoint' p (Node root l r) d k - | (P p axis) < (P root axis) = Node root (addPoint' p l (d+1) k) r - | otherwise = Node root l (addPoint' p r (d+1) k) + | P p axis < P root axis = Node root (addPoint' p l (d+1) k) r + | otherwise = Node root l (addPoint' p r (d+1) k) where axis = d `mod` k + +-- Remove a point from a k-d tree +-- First, traverse the tree until the targeted point is found. Then, replace this node with a new tree, +-- formed from the set of all children of the removed node. +removePoint :: (Ord a) => [a] -> KDTree a -> KDTree a +removePoint p tree = removePoint' p tree 0 (length p) + +-- Recursive helper function for removePoint +removePoint' :: (Ord a) => [a] -> KDTree a -> Int -> Int -> KDTree a +removePoint' _ Empty _ _ = Empty +removePoint' p (Node root l r) d k + | p == root = kdtree (pointSet l ++ pointSet r) + | P p axis < P root axis = Node root (removePoint' p l (d+1) k) r + | otherwise = Node root l (removePoint' p r (d+1) k) + where axis = d `mod` k + +pointSet :: (Ord a) => KDTree a -> [[a]] +pointSet Empty = [] +pointSet (Node root l r) = root : pointSet l ++ pointSet r From 751698db3a76efb8b6a6dc957b7bfc73ecde6bcd Mon Sep 17 00:00:00 2001 From: Sam Jones Date: Sun, 3 Oct 2021 13:51:18 +0100 Subject: [PATCH 6/6] added nearest neighbor search --- src/DataStructures/KDTree.hs | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/DataStructures/KDTree.hs b/src/DataStructures/KDTree.hs index 80b153a..a3c2b3c 100644 --- a/src/DataStructures/KDTree.hs +++ b/src/DataStructures/KDTree.hs @@ -56,6 +56,36 @@ removePoint' p (Node root l r) d k | otherwise = Node root l (removePoint' p r (d+1) k) where axis = d `mod` k +-- Given a k-d tree, return the set of all points on the tree pointSet :: (Ord a) => KDTree a -> [[a]] pointSet Empty = [] pointSet (Node root l r) = root : pointSet l ++ pointSet r + +-- Find the point on the given k-d tree which is closest to the given point +-- Return nothing if the tree is empty +nnSearch :: (Num a, Ord a) => [a] -> KDTree a -> Maybe [a] +nnSearch p tree = nnSearch' p tree 0 (length p) + +-- Recursive helper function for nnSearch +nnSearch' :: (Num a, Ord a) => [a] -> KDTree a -> Int -> Int -> Maybe [a] +nnSearch' _ Empty _ _ = Nothing +nnSearch' _ (Node root Empty Empty) _ _ = Just root +nnSearch' p (Node root l r) d k = + let axis = d `mod` k + (next, other) = if P p axis < P root axis then (l, r) else (r, l) + nextBest = nnSearch' p next (d+1) k + best = case nextBest of + Just nb -> if sqrDist p nb < sqrDist p root then nb else root + Nothing -> root + otherBest = + if (p!!axis - root!!axis) * (p!!axis - root!!axis) < sqrDist p best then + nnSearch' p other (d+1) k + else + Nothing + in case otherBest of + Just ob -> if sqrDist p ob < sqrDist p best then Just ob else Just best + Nothing -> Just best + +-- Compute squared distance between two points +sqrDist :: (Num a) => [a] -> [a] -> a +sqrDist x y = sum [(b - a) * (b - a) | (a,b) <- zip x y]