From df8492f6ba77c74b64d3cf7d7b05be1263574801 Mon Sep 17 00:00:00 2001 From: Matei Adriel Date: Sun, 29 Oct 2023 01:21:05 +0200 Subject: [PATCH] Add `purescript/slice` --- purescript/README.md | 1 + purescript/slice/.gitignore | 11 +++ purescript/slice/package.json | 6 ++ purescript/slice/packages.dhall | 18 +++++ purescript/slice/pnpm-lock.yaml | 21 +++++ purescript/slice/spago.dhall | 10 +++ purescript/slice/src/Benchmarks.js | 23 ++++++ purescript/slice/src/Benchmarks.purs | 111 +++++++++++++++++++++++++++ purescript/slice/src/Main.purs | 20 +++++ purescript/slice/src/Slice.purs | 32 ++++++++ purescript/slice/test/Main.purs | 11 +++ 11 files changed, 264 insertions(+) create mode 100644 purescript/slice/.gitignore create mode 100644 purescript/slice/package.json create mode 100644 purescript/slice/packages.dhall create mode 100644 purescript/slice/pnpm-lock.yaml create mode 100644 purescript/slice/spago.dhall create mode 100644 purescript/slice/src/Benchmarks.js create mode 100644 purescript/slice/src/Benchmarks.purs create mode 100644 purescript/slice/src/Main.purs create mode 100644 purescript/slice/src/Slice.purs create mode 100644 purescript/slice/test/Main.purs diff --git a/purescript/README.md b/purescript/README.md index 5dd6ff9..aef2410 100644 --- a/purescript/README.md +++ b/purescript/README.md @@ -14,6 +14,7 @@ | [maps](./maps) | Attempt at implementing maps with membership proofs | | [proofs](./proofs) | Attempt at expressing mathematical proofs using Purescript's effect system | | [purpleflow](./purpleflow) | Unfinished dependently-typed programming language | +| [slice](./slice) | Basic benchmarks and a `Slice` type | | [sprint](./sprint) | Failled effect-system based on typelevel lists | | [streams](./streams) | Playing with `purescript-pipes` | | [typelevel](./typelevel) | Typelevel naturals, vectors, sum-types, orderings and lambda-calculus evaluation and a value-level bounded-type GADT | diff --git a/purescript/slice/.gitignore b/purescript/slice/.gitignore new file mode 100644 index 0000000..4d43025 --- /dev/null +++ b/purescript/slice/.gitignore @@ -0,0 +1,11 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago +/tmp diff --git a/purescript/slice/package.json b/purescript/slice/package.json new file mode 100644 index 0000000..6dfd504 --- /dev/null +++ b/purescript/slice/package.json @@ -0,0 +1,6 @@ +{ + "name": "purescript-experiments", + "dependencies": { + "benchmark": "^2.1.4" + } +} diff --git a/purescript/slice/packages.dhall b/purescript/slice/packages.dhall new file mode 100644 index 0000000..5f741ab --- /dev/null +++ b/purescript/slice/packages.dhall @@ -0,0 +1,18 @@ +let upstream = + https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20210118/packages.dhall sha256:a59c5c93a68d5d066f3815a89f398bcf00e130a51cb185b2da29b20e2d8ae115 + +let additions = + { zipperarray = + { dependencies = + [ "arrays", "maybe", "prelude", "naturals", "strictlypositiveint" ] + , repo = "https://github.com/jamieyung/purescript-zipperarray/" + , version = "master" + } + , strictlypositiveint = + { dependencies = [ "prelude" ] + , repo = "https://github.com/jamieyung/purescript-strictlypositiveint" + , version = "master" + } + } + +in additions ⫽ upstream diff --git a/purescript/slice/pnpm-lock.yaml b/purescript/slice/pnpm-lock.yaml new file mode 100644 index 0000000..de6a1f2 --- /dev/null +++ b/purescript/slice/pnpm-lock.yaml @@ -0,0 +1,21 @@ +dependencies: + benchmark: 2.1.4 +lockfileVersion: 5.1 +packages: + /benchmark/2.1.4: + dependencies: + lodash: 4.17.21 + platform: 1.3.6 + dev: false + resolution: + integrity: sha1-CfPeMckWQl1JjMLuVloOvzwqVik= + /lodash/4.17.21: + dev: false + resolution: + integrity: sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg== + /platform/1.3.6: + dev: false + resolution: + integrity: sha512-fnWVljUchTro6RiCFvCXBbNhJc2NijN7oIQxbwsyL0buWJPG85v81ehlHI9fXrJsMNgTofEoWIQeClKpgxFLrg== +specifiers: + benchmark: ^2.1.4 diff --git a/purescript/slice/spago.dhall b/purescript/slice/spago.dhall new file mode 100644 index 0000000..da71baf --- /dev/null +++ b/purescript/slice/spago.dhall @@ -0,0 +1,10 @@ +{- +Welcome to a Spago project! +You can edit this file as you like. +-} +{ name = "my-project" +, dependencies = + [ "benchotron", "console", "effect", "psci-support", "st", "zipperarray" ] +, packages = ./packages.dhall +, sources = [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/purescript/slice/src/Benchmarks.js b/purescript/slice/src/Benchmarks.js new file mode 100644 index 0000000..48c60f0 --- /dev/null +++ b/purescript/slice/src/Benchmarks.js @@ -0,0 +1,23 @@ +exports.arraySum = function (v) { + if (v.length) { + const [head, ...tail] = v; + return (head + exports.arraySum(tail)) | 0; + } + + return 0; +}; + +exports.arrayFib = (function () { + var go = function (a) { + return function (b) { + return function (v) { + if (v === 0) { + return []; + } + var c = (a + b) | 0; + return [c, ...go(c)(a)((v - 1) | 0)]; + }; + }; + }; + return go(1)(1); +})(); diff --git a/purescript/slice/src/Benchmarks.purs b/purescript/slice/src/Benchmarks.purs new file mode 100644 index 0000000..b967b06 --- /dev/null +++ b/purescript/slice/src/Benchmarks.purs @@ -0,0 +1,111 @@ +module Benchmarks where + +import Prelude + +import Benchotron.Core (Benchmark, benchFn, benchFn', mkBenchmark) +import Control.Monad.ST.Internal as ST +import Control.Monad.ST.Internal as STRef +import Data.Array (foldMap, foldr, foldl, (..)) +import Data.Array.NonEmpty as NonEmptyArray +import Data.Array.ST as STArray +import Data.List (List(..), (:)) +import Data.List as List +import Data.Maybe (Maybe(..)) +import Data.Monoid.Additive (Additive(..)) +import Data.ZipperArray (ZipperArray) +import Data.ZipperArray as ZipperArray +import Slice (Slice) +import Slice as Slice +import Test.QuickCheck (arbitrary) +import Test.QuickCheck.Gen (vectorOf) + +listSum :: List Int -> Int +listSum (head:tail) = head + listSum tail +listSum _ = 0 + +listSumTCO :: List Int -> Int +listSumTCO = go 0 + where + go s Nil = s + go s (head:tail) = go (s + head) tail + +zipperSum :: ZipperArray Int -> Int +zipperSum arr = ZipperArray.current arr + case ZipperArray.goNext arr of + Nothing -> 0 + Just next -> zipperSum next + +sliceSum :: Slice Int -> Int +sliceSum arr = case Slice.uncons arr of + Nothing -> 0 + Just { head, tail } -> head + sliceSum tail + +sliceSumTCO :: Slice Int -> Int +sliceSumTCO = go 0 + where + go s arr = case Slice.uncons arr of + Nothing -> s + Just { head, tail } -> go (s + head) tail + +listFib :: Int -> List Int +listFib = go 1 1 + where + go a b 0 = Nil + go a b n = c:go c a (n - 1) + where + c = a + b + +stArrayFib :: Int -> Array Int +stArrayFib to = STArray.run do + a <- STRef.new 1 + b <- STRef.new 1 + result <- STArray.empty + ST.for 1 to \_ -> do + a' <- STRef.read a + b' <- STRef.read b + let c = a' + b' + void + $ STArray.push c result + <* STRef.write a' b + <* STRef.write c a + pure result + +foreign import arraySum :: Array Int -> Int +foreign import arrayFib :: Int -> Array Int + +benchSum :: Benchmark +benchSum = mkBenchmark + { slug: "sum" + , title: "Finding the sum of a sequence of integers" + , sizes: (1..10) <#> (_ * 1000) + , sizeInterpretation: "Number of elements in the array" + , inputsPerSize: 1 + , gen: \n -> NonEmptyArray.cons' <$> arbitrary <*> vectorOf n arbitrary + , functions: [ + -- benchFn' "array" arraySum NonEmptyArray.toArray + benchFn' "list" listSum List.fromFoldable + , benchFn' "list (tail call optimization" listSumTCO List.fromFoldable + , benchFn' "zipper" zipperSum ZipperArray.fromNonEmptyArray + , benchFn' "array slice" sliceSum (NonEmptyArray.toArray >>> Slice.fromArray) + , benchFn' "array slice (tail call optimization)" sliceSumTCO (NonEmptyArray.toArray >>> Slice.fromArray) + , benchFn' "array foldr" (foldr (+) 0) NonEmptyArray.toArray + , benchFn' "array foldl" (foldl (+) 0) NonEmptyArray.toArray + , benchFn' "array foldMap" (foldMap Additive) NonEmptyArray.toArray + , benchFn' "list foldr" (foldr (+) 0) List.fromFoldable + , benchFn' "list foldl" (foldl (+) 0) List.fromFoldable + , benchFn' "list foldMap" (foldMap Additive) List.fromFoldable + ] + } + +benchFib :: Benchmark +benchFib = mkBenchmark + { slug: "fibonacci" + , title: "Generating the first n fibonacci numbers as a sequence" + , sizes: (1..10) <#> (_ * 100) + , sizeInterpretation: "Number of elements" + , inputsPerSize: 1 + , gen: pure + , functions: [ benchFn "array" arrayFib + , benchFn "list" listFib + , benchFn "stArray" stArrayFib + ] + } \ No newline at end of file diff --git a/purescript/slice/src/Main.purs b/purescript/slice/src/Main.purs new file mode 100644 index 0000000..c838aaa --- /dev/null +++ b/purescript/slice/src/Main.purs @@ -0,0 +1,20 @@ +module Main where + +import Prelude + +import Benchmarks (benchSum) +import Benchotron.UI.Console (runSuite) +import Control.Monad.ST.Internal as ST +import Control.Monad.ST.Internal as STRef +import Effect (Effect) + +factorial :: Int -> Int +factorial to = ST.run do + result <- STRef.new 1 + ST.for 2 to \index -> do + current <- STRef.read result + STRef.write (current * index) result + STRef.read result + +main :: Effect Unit +main = runSuite [benchSum] \ No newline at end of file diff --git a/purescript/slice/src/Slice.purs b/purescript/slice/src/Slice.purs new file mode 100644 index 0000000..a94b76c --- /dev/null +++ b/purescript/slice/src/Slice.purs @@ -0,0 +1,32 @@ +module Slice where + +import Prelude + +import Data.Array as Array +import Data.Maybe (Maybe(..)) +import Partial.Unsafe (unsafePartial) + +newtype Slice a + = Slice + { array :: Array a + , at :: Int + , length :: Int } + +uncons :: forall a. Slice a -> Maybe { head :: a, tail :: Slice a } +uncons (Slice { length, at, array }) + = if length == 0 + then Nothing + else Just + { head: unsafePartial $ Array.unsafeIndex array at + , tail: Slice { length: length - 1, at: at + 1, array } } + +uncons' :: forall a r. Slice a -> { nil :: r, cons :: a -> Slice a -> r } -> r +uncons' (Slice { length, at, array }) cases + = if length == 0 + then cases.nil + else cases.cons + (unsafePartial $ Array.unsafeIndex array at) + (Slice { length: length - 1, at: at + 1, array }) + +fromArray :: forall a. Array a -> Slice a +fromArray array = Slice { array, at: 0, length: Array.length array } \ No newline at end of file diff --git a/purescript/slice/test/Main.purs b/purescript/slice/test/Main.purs new file mode 100644 index 0000000..f91f98c --- /dev/null +++ b/purescript/slice/test/Main.purs @@ -0,0 +1,11 @@ +module Test.Main where + +import Prelude + +import Effect (Effect) +import Effect.Class.Console (log) + +main :: Effect Unit +main = do + log "🍝" + log "You should add some tests."