Fix partial heap sort

.github/workflows/haskell-ci.yml

@@ -6,11 +6,11 @@
 #
 #   haskell-ci regenerate
 #
-# For more information, see https://github.com/andreasabel/haskell-ci
+# For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.19.20241021
+# version: 0.19.20241121
 #
-# REGENDATA ("0.19.20241021",["github","vector-algorithms.cabal"])
+# REGENDATA ("0.19.20241121",["github","vector-algorithms.cabal"])
 #
 name: Haskell-CI
 on:
@@ -32,10 +32,10 @@ jobs:
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.12.20241014
+          - compiler: ghc-9.12.0.20241114
             compilerKind: ghc
-            compilerVersion: 9.12.20241014
-            setup-method: ghcup
+            compilerVersion: 9.12.0.20241114
+            setup-method: ghcup-prerelease
             allow-failure: false
           - compiler: ghc-9.10.1
             compilerKind: ghc
@@ -99,41 +99,60 @@ jobs:
             allow-failure: false
       fail-fast: false
     steps:
-      - name: apt
+      - name: apt-get install
         run: |
           apt-get update
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev
+      - name: Install GHCup
+        run: |
           mkdir -p "$HOME/.ghcup/bin"
           curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"
           chmod a+x "$HOME/.ghcup/bin/ghcup"
-          "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml;
-          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+      - name: Install cabal-install
+        run: |
           "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+      - name: Install GHC (GHCup)
+        if: matrix.setup-method == 'ghcup'
+        run: |
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+          HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
+          HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
+          HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
+          echo "HC=$HC" >> "$GITHUB_ENV"
+          echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
+          echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
           HCVER: ${{ matrix.compilerVersion }}
-      - name: Set PATH and environment variables
+      - name: Install GHC (GHCup prerelease)
+        if: matrix.setup-method == 'ghcup-prerelease'
         run: |
-          echo "$HOME/.cabal/bin" >> $GITHUB_PATH
-          echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
-          echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
-          echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
-          HCDIR=/opt/$HCKIND/$HCVER
+          "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml;
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
           HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
           HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
           HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
           echo "HC=$HC" >> "$GITHUB_ENV"
           echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
           echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
-          echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+        env:
+          HCKIND: ${{ matrix.compilerKind }}
+          HCNAME: ${{ matrix.compiler }}
+          HCVER: ${{ matrix.compilerVersion }}
+      - name: Set PATH and environment variables
+        run: |
+          echo "$HOME/.cabal/bin" >> $GITHUB_PATH
+          echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
+          echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
+          echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
           echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
           echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
           if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi
           echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
-          echo "GHCJSARITH=0" >> "$GITHUB_ENV"
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
@@ -264,8 +283,8 @@ jobs:
           rm -f cabal.project.local
           $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
       - name: save cache
-        uses: actions/cache/save@v4
         if: always()
+        uses: actions/cache/save@v4
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store

src/Data/Vector/Algorithms/Heap.hs

@@ -188,8 +188,8 @@ partialSortByBounds cmp a k l u
   | len == 3   = O.sort3ByOffset cmp a l
   | len == 4   = O.sort4ByOffset cmp a l
   | u <= l + k = sortByBounds cmp a l u
-  | otherwise  = do selectByBounds cmp a k l u
-                    sortHeap cmp a l (l + 4) (l + k)
+  | otherwise  = do selectByBounds cmp a (k + 1) l u
+                    sortHeap cmp a l (l + 4) (l + k + 1)
                     O.sort4ByOffset cmp a l
  where
  len = u - l

tests/properties/Properties.hs

@@ -97,8 +97,14 @@ sanity = 100
 prop_partialsort :: (Ord e, Arbitrary e, Show e)
                  => (forall s mv. G.MVector mv e => mv s e -> Int -> ST s ())
                  -> Positive Int -> Property
-prop_partialsort = prop_sized $ \algo k ->
-  prop_sorted . V.take k . modify algo
+prop_partialsort = prop_sized $ \algo k v -> do
+  let newVec = modify algo v
+      vhead = V.take k newVec
+      vtail = V.drop k newVec
+  prop_sorted vhead
+    .&&.
+      -- Every element in the head should be < every element in the tail.
+      if V.null vtail then 1 == 1 else V.maximum vhead <= V.minimum vtail
 
 prop_sized_empty :: (Ord e) => (forall s. MV.MVector s e -> Int -> ST s ()) -> Property
 prop_sized_empty algo = prop_empty (flip algo 0) .&&. prop_empty (flip algo 10)

vector-algorithms.cabal

@@ -18,7 +18,7 @@ build-type:        Simple
 extra-source-files: CHANGELOG.md
 
 tested-with:
-  GHC == 9.12.0
+  GHC == 9.12.1
   GHC == 9.10.1
   GHC == 9.8.2
   GHC == 9.6.3