From 580ccceed9e044dcf9e6d1fd0942696ad1ae2d55 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 22 Jan 2018 20:09:15 -0500 Subject: [PATCH 1/3] STArray: in-place sort --- src/Data/Array/ST.js | 10 ++++++++++ src/Data/Array/ST.purs | 35 +++++++++++++++++++++++++++++++++++ test/Test/Data/Array/ST.purs | 17 ++++++++++++++++- 3 files changed, 61 insertions(+), 1 deletion(-) diff --git a/src/Data/Array/ST.js b/src/Data/Array/ST.js index 629e07cd..e142a3be 100644 --- a/src/Data/Array/ST.js +++ b/src/Data/Array/ST.js @@ -58,6 +58,16 @@ exports.copyImpl = function (xs) { }; }; +exports.sortByImpl = function (comp) { + return function (xs) { + return function () { + return xs.sort(function (x, y) { + return comp(x)(y); + }); + }; + }; +}; + exports.toAssocArray = function (xs) { return function () { var n = xs.length; diff --git a/src/Data/Array/ST.purs b/src/Data/Array/ST.purs index 80149bf9..ab4006d8 100644 --- a/src/Data/Array/ST.purs +++ b/src/Data/Array/ST.purs @@ -14,6 +14,9 @@ module Data.Array.ST , modifySTArray , pushAllSTArray , spliceSTArray + , sort + , sortBy + , sortWith , freeze , thaw , unsafeFreeze @@ -80,6 +83,38 @@ foreign import emptySTArray :: forall a h r. Eff (st :: ST h | r) (STArray h a) thaw :: forall a h r. Array a -> Eff (st :: ST h | r) (STArray h a) thaw = copyImpl +-- | Sort a mutable array in place. +sort :: forall a h r. Ord a => STArray h a -> Eff (st :: ST h | r) (STArray h a) +sort = sortBy compare + +-- | Sort a mutable array in place using a comparison function. +sortBy + :: forall a h r + . (a -> a -> Ordering) + -> STArray h a + -> Eff (st :: ST h | r) (STArray h a) +sortBy comp = sortByImpl comp' + where + comp' x y = case comp x y of + GT -> 1 + EQ -> 0 + LT -> -1 + +foreign import sortByImpl + :: forall a h r + . (a -> a -> Int) + -> STArray h a + -> Eff (st :: ST h | r) (STArray h a) + +-- | Sort a mutable array in place based on a projection. +sortWith + :: forall a b h r + . Ord b + => (a -> b) + -> STArray h a + -> Eff (st :: ST h | r) (STArray h a) +sortWith f = sortBy (comparing f) + -- | Create an immutable copy of a mutable array. freeze :: forall a h r. STArray h a -> Eff (st :: ST h | r) (Array a) freeze = copyImpl diff --git a/test/Test/Data/Array/ST.purs b/test/Test/Data/Array/ST.purs index fbe587f7..518675da 100644 --- a/test/Test/Data/Array/ST.purs +++ b/test/Test/Data/Array/ST.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.ST (ST, pureST) -import Data.Array.ST (STArray, emptySTArray, freeze, peekSTArray, pokeSTArray, pushAllSTArray, pushSTArray, spliceSTArray, thaw, toAssocArray, unsafeThaw, unsafeFreeze) +import Data.Array.ST (STArray, emptySTArray, freeze, peekSTArray, pokeSTArray, pushAllSTArray, pushSTArray, sort, sortBy, sortWith, spliceSTArray, thaw, toAssocArray, unsafeThaw, unsafeFreeze) import Data.Foldable (all) import Data.Maybe (Maybe(..), isNothing) import Test.Assert (assert, ASSERT) @@ -132,6 +132,21 @@ testArrayST = do void $ pokeSTArray arr 1 2 pure arr) == [1] + log "sort should reorder a list into ascending order based on the result of compare" + assert $ run ( + sort =<< unsafeThaw [1, 3, 2, 5, 6, 4] + ) == [1, 2, 3, 4, 5, 6] + + log "sortBy should reorder a list into ascending order based on the result of a comparison function" + assert $ run ( + sortBy (flip compare) =<< unsafeThaw [1, 3, 2, 5, 6, 4] + ) == [6, 5, 4, 3, 2, 1] + + log "sortWith should reorder a list into ascending order based on the result of compare over a projection" + assert $ run ( + sortWith id =<< unsafeThaw [1, 3, 2, 5, 6, 4] + ) == [1, 2, 3, 4, 5, 6] + log "spliceSTArray should be able to delete multiple items at a specified index" assert $ run (do From 3b4e5a8b11d08281efe8a11dab0e71101a0de1f9 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Thu, 26 Apr 2018 17:39:20 +0100 Subject: [PATCH 2/3] Add Semigroup NonEmptyArray instance --- src/Data/Array/NonEmpty.purs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Data/Array/NonEmpty.purs b/src/Data/Array/NonEmpty.purs index 65921840..46fa59cc 100644 --- a/src/Data/Array/NonEmpty.purs +++ b/src/Data/Array/NonEmpty.purs @@ -125,6 +125,8 @@ derive newtype instance eq1NonEmptyArray :: Eq1 NonEmptyArray derive newtype instance ordNonEmptyArray :: Ord a => Ord (NonEmptyArray a) derive newtype instance ord1NonEmptyArray :: Ord1 NonEmptyArray +derive newtype instance semigroupNonEmptyArray :: Semigroup (NonEmptyArray a) + derive newtype instance functorNonEmptyArray :: Functor NonEmptyArray derive newtype instance functorWithIndexNonEmptyArray :: FunctorWithIndex Int NonEmptyArray From 813147c117b9be1255fc62df38cf696e017abca1 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Thu, 5 Apr 2018 20:42:09 -0400 Subject: [PATCH 3/3] NonEmptyArray: Unfoldable1 support Will amend bower.json after merge of https://github.com/purescript/purescript-nonempty/pull/29 --- bower.json | 5 ++--- src/Data/Array/NonEmpty.js | 21 +++++++++++++++++++++ src/Data/Array/NonEmpty.purs | 26 ++++++++++++++++++++++++-- test/Test/Data/Array/NonEmpty.purs | 9 +++++++++ 4 files changed, 56 insertions(+), 5 deletions(-) diff --git a/bower.json b/bower.json index a8fc8a4c..4705653c 100644 --- a/bower.json +++ b/bower.json @@ -17,13 +17,12 @@ ], "dependencies": { "purescript-foldable-traversable": "^3.3.0", - "purescript-nonempty": "^4.0.0", "purescript-partial": "^1.2.0", "purescript-st": "^3.0.0", "purescript-tailrec": "^3.0.0", "purescript-tuples": "^4.0.0", - "purescript-unfoldable": "^3.0.0", - "purescript-unsafe-coerce": "^3.0.0" + "purescript-unsafe-coerce": "^3.0.0", + "purescript-nonempty": "^4.3.0" }, "devDependencies": { "purescript-assert": "^3.0.0", diff --git a/src/Data/Array/NonEmpty.js b/src/Data/Array/NonEmpty.js index 0971fc45..06874b45 100644 --- a/src/Data/Array/NonEmpty.js +++ b/src/Data/Array/NonEmpty.js @@ -11,6 +11,27 @@ exports.fold1Impl = function (f) { }; }; +exports.unfoldr1Impl = function (isNothing) { + return function (fromJust) { + return function (fst) { + return function (snd) { + return function (f) { + return function (value) { + var result = []; + while (true) { // eslint-disable-line no-constant-condition + var tuple = f(value); + result.push(fst(tuple)); + var maybe = snd(tuple); + if (isNothing(maybe)) return result; + value = fromJust(maybe); // eslint-disable-line no-param-reassign + } + }; + }; + }; + }; + }; +}; + exports.traverse1Impl = function () { function Cont(fn) { this.fn = fn; diff --git a/src/Data/Array/NonEmpty.purs b/src/Data/Array/NonEmpty.purs index 46fa59cc..be8b368c 100644 --- a/src/Data/Array/NonEmpty.purs +++ b/src/Data/Array/NonEmpty.purs @@ -8,6 +8,7 @@ module Data.Array.NonEmpty , fromFoldable , fromFoldable1 , toUnfoldable + , toUnfoldable1 , singleton , (..), range , replicate @@ -103,15 +104,16 @@ import Data.Eq (class Eq1) import Data.Foldable (class Foldable) import Data.FoldableWithIndex (class FoldableWithIndex) import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.Maybe (Maybe(..), fromJust) +import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.NonEmpty (NonEmpty, (:|)) import Data.Ord (class Ord1) import Data.Semigroup.Foldable (class Foldable1, foldMap1Default) import Data.Semigroup.Traversable (class Traversable1, sequence1Default) import Data.Traversable (class Traversable) import Data.TraversableWithIndex (class TraversableWithIndex) -import Data.Tuple (Tuple) +import Data.Tuple (Tuple(..), fst, snd) import Data.Unfoldable (class Unfoldable) +import Data.Unfoldable1 (class Unfoldable1, unfoldr1) import Partial.Unsafe (unsafePartial) newtype NonEmptyArray a = NonEmptyArray (Array a) @@ -137,6 +139,9 @@ instance foldable1NonEmptyArray :: Foldable1 NonEmptyArray where foldMap1 = foldMap1Default fold1 = fold1Impl (<>) +instance unfoldable1NonEmptyArray :: Unfoldable1 NonEmptyArray where + unfoldr1 = unfoldr1Impl isNothing (unsafePartial fromJust) fst snd + derive newtype instance traversableNonEmptyArray :: Traversable NonEmptyArray derive newtype instance traversableWithIndexNonEmptyArray :: TraversableWithIndex Int NonEmptyArray @@ -154,6 +159,16 @@ derive newtype instance monadNonEmptyArray :: Monad NonEmptyArray derive newtype instance altNonEmptyArray :: Alt NonEmptyArray +foreign import unfoldr1Impl + :: forall a b + . (forall x. Maybe x -> Boolean) + -> (forall x. Maybe x -> x) + -> (forall x y. Tuple x y -> x) + -> (forall x y. Tuple x y -> y) + -> (b -> Tuple a (Maybe b)) + -> b + -> NonEmptyArray a + -- | Internal - adapt an Array transform to NonEmptyArray -- -- Note that this is unsafe: if the transform returns an empty array, this can @@ -200,6 +215,13 @@ fromFoldable1 = unsafeFromArray <<< A.fromFoldable toUnfoldable :: forall f a. Unfoldable f => NonEmptyArray a -> f a toUnfoldable = adaptAny A.toUnfoldable +toUnfoldable1 :: forall f a. Unfoldable1 f => NonEmptyArray a -> f a +toUnfoldable1 xs = unfoldr1 f 0 + where + len = length xs + f i = Tuple (unsafePartial unsafeIndex xs i) $ + if i < (len - 1) then Just (i + 1) else Nothing + singleton :: forall a. a -> NonEmptyArray a singleton = NonEmptyArray <<< A.singleton diff --git a/test/Test/Data/Array/NonEmpty.purs b/test/Test/Data/Array/NonEmpty.purs index 1b92db8b..f087d04a 100644 --- a/test/Test/Data/Array/NonEmpty.purs +++ b/test/Test/Data/Array/NonEmpty.purs @@ -4,15 +4,18 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) +import Data.Array as A import Data.Array.NonEmpty as NEA import Data.Const (Const(..)) import Data.Foldable (for_, sum, traverse_) import Data.FunctorWithIndex (mapWithIndex) import Data.Maybe (Maybe(..), fromJust) import Data.Monoid.Additive (Additive(..)) +import Data.NonEmpty ((:|)) import Data.Semigroup.Foldable (foldMap1) import Data.Semigroup.Traversable (traverse1) import Data.Tuple (Tuple(..)) +import Data.Unfoldable1 as U1 import Partial.Unsafe (unsafePartial) import Test.Assert (ASSERT, assert) @@ -285,6 +288,12 @@ testNonEmptyArray = do , fromArray [4,0,0,1,25,36,458,5842,23757] ]) + log "toUnfoldable1" + assert $ NEA.toUnfoldable1 (NEA.range 0 9) == 0 :| A.range 1 9 + + log "Unfoldable instance" + assert $ U1.range 0 9 == NEA.range 0 9 + log "foldl should work" -- test through sum assert $ sum (fromArray [1, 2, 3, 4]) == 10