From 0fb945c142dc430e6a7b6235d9cf5f3afeca5c30 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Wed, 17 Jul 2024 14:05:27 +1200 Subject: [PATCH 1/3] Milestone 3 benchmark, test --- plutus-benchmark/bitwise/bench/Main.hs | 26 ++++++ .../bitwise/src/PlutusBenchmark/NQueens.hs | 79 +++++++++++++++++++ plutus-benchmark/bitwise/test/Main.hs | 12 +++ plutus-benchmark/plutus-benchmark.cabal | 35 ++++++++ 4 files changed, 152 insertions(+) create mode 100644 plutus-benchmark/bitwise/bench/Main.hs create mode 100644 plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs create mode 100644 plutus-benchmark/bitwise/test/Main.hs diff --git a/plutus-benchmark/bitwise/bench/Main.hs b/plutus-benchmark/bitwise/bench/Main.hs new file mode 100644 index 00000000000..110b460cb2e --- /dev/null +++ b/plutus-benchmark/bitwise/bench/Main.hs @@ -0,0 +1,26 @@ +module Main (main) where + +{- +import Criterion.Main (bench, defaultMain) +import PlutusBenchmark.Common (benchProgramCek, mkMostRecentEvalCtx) +import PlutusBenchmark.NQueens (nqueens) +import PlutusTx.Code (CompiledCode, getPlcNoAnn) +import PlutusTx.TH (compile) +-} + +main :: IO () +main = print "Pending" + +{- Currently not able to run, due to problems with writeBits compiling under PlutusTx + +main :: IO () +main = defaultMain [ + bench "8-queens" . benchProgramCek mkMostRecentEvalCtx . getPlcNoAnn $ nqueensCompiled + ] + +-- Helpers + +nqueensCompiled :: CompiledCode [(Integer, Integer)] +nqueensCompiled = $$(compile [||nqueens 8||]) + +-} diff --git a/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs b/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs new file mode 100644 index 00000000000..50550d62960 --- /dev/null +++ b/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs @@ -0,0 +1,79 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeApplications #-} + +module PlutusBenchmark.NQueens (nqueens) where + +import PlutusTx.Builtins (complementByteString, findFirstSetBit, orByteString, replicateByte, + shiftByteString, writeBits) +import PlutusTx.Prelude + +-- Based on Qiu, Zongyan (February 2002). "Bit-vector encoding of n-queen problem". ACM SIGPLAN Notices. 37 (2): 68–70 +-- For simplicity, this only accepts multiples of 8 for the dimension (so 8, 16, +-- 24, etc): in all other cases it will return an empty list. Results are (row, +-- column) pairs. +{-# INLINE nqueens #-} +nqueens :: Integer -> [(Integer, Integer)] +nqueens dim + | dim < 8 = [] + | dim `remainder` 8 /= 0 = [] + | otherwise = + let down = replicateByte bytesNeeded 0x00 + left = replicateByte bytesNeeded 0x00 + right = replicateByte bytesNeeded 0x00 + in go 0 0 down left right (replicateByte bytesNeeded 0xFF) + where + bytesNeeded :: Integer + bytesNeeded = dim `quotient` 8 + go :: + Integer -> + Integer -> + BuiltinByteString -> + BuiltinByteString -> + BuiltinByteString -> + BuiltinByteString -> + [(Integer, Integer)] + go selectIx row down left right control + | selectIx == dim = [] + | otherwise = + -- In the original writeup, 0 in a position meant 'occupied'. However, + -- this makes updates to the control vectors very annoying, because + -- now we have to 'shift in' 1 bits, which costs us an extra two + -- copies. We can reduce this by one by instead treating 0 as 'free'. + -- Ideally, we would eliminate one more redundant copy, but this + -- requires a select0 operation, which can't be implemented + -- efficiently. However, given that these copies are per recursive + -- call, we can save ourselves considerable effort by avoiding them. + let available = selectByteString selectIx control + in if + | available == (-1) -> [] + | row == lastRow -> [(row, available)] + | otherwise -> + let newDown = writeBit down available True + newLeft = shiftByteString (writeBit left available True) 1 + newRight = shiftByteString (writeBit right available True) (-1) + newRow = row + 1 + -- We 'hoist' the control vector as a parameter rather + -- than recomputing it every time we modify selectIx. + newControl = complementByteString . orByteString False newDown . orByteString False newLeft $ newRight + in case go 0 newRow newDown newLeft newRight newControl of + [] -> go (selectIx + 1) row down left right control + next -> (row, available) : next + lastRow :: Integer + lastRow = dim - 1 + +-- Helpers + +{-# INLINE selectByteString #-} +selectByteString :: Integer -> BuiltinByteString -> Integer +selectByteString which bs + | which <= 0 = findFirstSetBit bs + | otherwise = let i = selectByteString (which - 1) bs + in if i == (-1) + then (-1) + else i + 1 + findFirstSetBit (shiftByteString bs $ negate (i + 1)) + +{-# INLINE writeBit #-} +writeBit :: BuiltinByteString -> Integer -> Bool -> BuiltinByteString +writeBit bs i b = writeBits bs . toBuiltin @[(Integer, Bool)] $ [(i, b)] diff --git a/plutus-benchmark/bitwise/test/Main.hs b/plutus-benchmark/bitwise/test/Main.hs new file mode 100644 index 00000000000..70b551eba3b --- /dev/null +++ b/plutus-benchmark/bitwise/test/Main.hs @@ -0,0 +1,12 @@ +module Main (main) where + +import PlutusBenchmark.NQueens (nqueens) +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.HUnit (assertEqual, testCase) + +main :: IO () +main = defaultMain . testGroup "nqueens" $ [ + testCase "solves for 8 queens" $ assertEqual "" + [(0,0), (1,4), (2,7), (3,5), (4,2), (5,6), (6,1), (7,3)] + (nqueens 8) + ] diff --git a/plutus-benchmark/plutus-benchmark.cabal b/plutus-benchmark/plutus-benchmark.cabal index 85931299603..617e597d1df 100644 --- a/plutus-benchmark/plutus-benchmark.cabal +++ b/plutus-benchmark/plutus-benchmark.cabal @@ -593,3 +593,38 @@ benchmark marlowe-agda-cek , plutus-benchmark-common , plutus-ledger-api ^>=1.31 , plutus-tx ^>=1.31 + +-------------------- bitwise----------------------- + +library bitwise-internal + import: lang, ghc-version-support + hs-source-dirs: bitwise/src + exposed-modules: PlutusBenchmark.NQueens + build-depends: + , base >=4.9 && <5 + , plutus-tx ^>=1.30 + , plutus-tx-plugin ^>=1.30 + +test-suite bitwise-test + import: lang, ghc-version-support + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bitwise/test + build-depends: + , base >=4.9 && <5 + , bitwise-internal + , tasty + , tasty-hunit + +benchmark bitwise-bench + import: lang, ghc-version-support + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bitwise/bench + build-depends: base >=4.9 && <5 + +-- , bitwise-internal +-- , criterion +-- , plutus-benchmark-common +-- , plutus-tx ^>=1.30 +-- , plutus-tx-plugin ^>=1.30 From 6985d72837d30b0a69d50f77776657e81a1c8079 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Fri, 19 Jul 2024 11:56:48 +1200 Subject: [PATCH 2/3] Fix cabal file --- plutus-benchmark/plutus-benchmark.cabal | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/plutus-benchmark/plutus-benchmark.cabal b/plutus-benchmark/plutus-benchmark.cabal index 617e597d1df..28fd92ad75f 100644 --- a/plutus-benchmark/plutus-benchmark.cabal +++ b/plutus-benchmark/plutus-benchmark.cabal @@ -600,10 +600,7 @@ library bitwise-internal import: lang, ghc-version-support hs-source-dirs: bitwise/src exposed-modules: PlutusBenchmark.NQueens - build-depends: - , base >=4.9 && <5 - , plutus-tx ^>=1.30 - , plutus-tx-plugin ^>=1.30 + build-depends: plutus-tx ^>=1.31 test-suite bitwise-test import: lang, ghc-version-support From c9625a614faae47b6db87a3076db36fa50730707 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Fri, 19 Jul 2024 13:17:32 +1200 Subject: [PATCH 3/3] Update writeBits use in NQueens --- plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs b/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs index 50550d62960..8b87152940c 100644 --- a/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs +++ b/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs @@ -1,12 +1,10 @@ -- editorconfig-checker-disable-file {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TypeApplications #-} module PlutusBenchmark.NQueens (nqueens) where -import PlutusTx.Builtins (complementByteString, findFirstSetBit, orByteString, replicateByte, - shiftByteString, writeBits) +import PlutusTx.Builtins (replicateByte) import PlutusTx.Prelude -- Based on Qiu, Zongyan (February 2002). "Bit-vector encoding of n-queen problem". ACM SIGPLAN Notices. 37 (2): 68–70 @@ -76,4 +74,4 @@ selectByteString which bs {-# INLINE writeBit #-} writeBit :: BuiltinByteString -> Integer -> Bool -> BuiltinByteString -writeBit bs i b = writeBits bs . toBuiltin @[(Integer, Bool)] $ [(i, b)] +writeBit bs i b = writeBits bs [i] [b]