Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 27ffbdd

Browse files
committed
Update library
1 parent cb87242 commit 27ffbdd

File tree

7 files changed

+101
-3
lines changed

7 files changed

+101
-3
lines changed

‎lib/BinaryIndexedTree.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import qualified Data.Vector.Mutable as VM
1212
import qualified Data.Vector.Unboxed.Mutable as UM
1313

1414
--
15-
-- Binary Indexed Tree (BIT)
15+
-- Binary Indexed Tree (BIT), or Fenwick Tree
1616
--
1717

1818
type CommutativeMonoid a = Monoid a

‎lib/Input.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ import qualified Data.Vector.Unboxed as U
66
import qualified Data.Vector.Unboxed.Mutable as UM
77
import qualified Data.ByteString.Char8 as BS
88
import Data.Bifunctor (first)
9+
import Data.Int (Int64)
910

1011
main = do
1112
_ :: [Int] <- map (read . BS.unpack) . BS.words <$> BS.getLine

‎lib/MergeSort.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22
module MergeSort where
33
import qualified Data.Vector.Unboxed as U
44
import qualified Data.Vector.Unboxed.Mutable as UM
5+
import qualified Data.Vector.Generic as G
6+
import qualified Data.Vector.Algorithms.Merge as A
57

68
mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
79
mergeSortBy !cmp !vec = doSort vec
@@ -31,3 +33,10 @@ mergeSortBy !cmp !vec = doSort vec
3133

3234
mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
3335
mergeSort = mergeSortBy compare
36+
37+
sortVector :: (G.Vector v a, Ord a) => v a -> v a
38+
sortVector v = G.create do
39+
v' <- G.thaw v
40+
A.sort v'
41+
return v'
42+
{-# INLINE sortVector #-}

‎lib/ModularArithmetic.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
3838
| otherwise = N (n `mod` modulo)
3939

4040
{-# RULES
41-
"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . fromIntegral
41+
"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
4242
"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
4343
#-}
4444

‎lib/ModularArithmetic_TypeNats.hs‎

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
{-# LANGUAGE BangPatterns #-}
2+
{-# LANGUAGE MultiParamTypeClasses #-}
3+
{-# LANGUAGE TypeFamilies #-}
4+
{-# LANGUAGE DataKinds #-}
5+
{-# LANGUAGE TypeOperators #-}
6+
{-# LANGUAGE NoStarIsType #-}
7+
module ModularArithmetic_TypeNats where
8+
import Data.Int
9+
import GHC.TypeNats (Nat, KnownNat, natVal, type (^), type (+))
10+
11+
--
12+
-- Modular Arithmetic
13+
--
14+
15+
-- type N = IntMod (10^9 + 7)
16+
17+
newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
18+
19+
instance Show (IntMod m) where
20+
show (IntMod x) = show x
21+
22+
instance KnownNat m => Num (IntMod m) where
23+
t@(IntMod x) + IntMod y
24+
| x + y >= modulus = IntMod (x + y - modulus)
25+
| otherwise = IntMod (x + y)
26+
where modulus = fromIntegral (natVal t)
27+
t@(IntMod x) - IntMod y
28+
| x >= y = IntMod (x - y)
29+
| otherwise = IntMod (x - y + modulus)
30+
where modulus = fromIntegral (natVal t)
31+
t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
32+
where modulus = fromIntegral (natVal t)
33+
fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
34+
modulus = natVal result
35+
in result
36+
abs = undefined; signum = undefined
37+
38+
{-# RULES
39+
"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
40+
"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
41+
#-}
42+
43+
fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
44+
fromIntegral_Int64_IntMod n = result
45+
where
46+
result | 0 <= n && n < modulus = IntMod n
47+
| otherwise = IntMod (n `mod` modulus)
48+
modulus = fromIntegral (natVal result)
49+
50+
{-# RULES
51+
"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
52+
"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
53+
#-}
54+
55+
---
56+
57+
exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
58+
exEuclid !f !g = loop 1 0 0 1 f g
59+
where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
60+
loop !u0 !u1 !v0 !v1 !f g =
61+
case divMod f g of
62+
(q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
63+
64+
instance KnownNat m => Fractional (IntMod m) where
65+
recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
66+
(1,a,_) -> a `mod` modulus
67+
(-1,a,_) -> (-a) `mod` modulus
68+
_ -> error "not invertible"
69+
where modulus = fromIntegral (natVal t)
70+
fromRational = undefined

‎lib/Primes.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,10 @@ import Control.Monad (forM_,when)
55
import qualified Data.Vector.Unboxed as U
66
import qualified Data.Vector.Unboxed.Mutable as UM
77

8+
--
9+
-- Sieve of Eratosthenes
10+
--
11+
812
infixr 5 !:
913
(!:) :: a -> [a] -> [a]
1014
(!x) !: xs = x : xs
@@ -70,3 +74,13 @@ factor x = loop x primes
7074
-- 48
7175
euler :: Int64 -> Int64
7276
euler !x = product [(p - 1) * p^(n-1) | (p,n) <- factor x]
77+
78+
{-
79+
-- |
80+
-- >>> positiveDivisors 24
81+
-- fromList [(1,fromList [1]),(2,fromList [1,2]),(3,fromList [1,3]),(4,fromList [1,2,4]),(6,fromList [1,2,3,6]),(8,fromList [1,2,4,8]),(12,fromList [1,2,3,4,6,12]),(24,fromList [1,2,3,4,6,8,12,24])]
82+
positiveDivisors :: Int -> IntMap.IntMap IntSet.IntSet
83+
positiveDivisors n = foldl' go (IntMap.singleton 1 (IntSet.singleton 1)) $ factor n
84+
where go !m (!p,!k) = iterate go2 m !! k
85+
where go2 !m = m `IntMap.union` IntMap.fromAscList [(a*p, b `IntSet.union` IntSet.map (*p) b) | (a,b) <- IntMap.assocs m]
86+
-}

‎lib/SegmentTree.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ update_SegTree (SegTree depth vec) !i !x = loop ((1 `shiftL` depth) + i) x
4646
{-# INLINE update_SegTree #-}
4747

4848
new_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (SegTree mvec (PrimState m) a)
49-
new_SegTree n = do let depth = ceiling (logBase2 (fromIntegral n) ::Double) ::Int
49+
new_SegTree n = do let depth = ceil_log2 n
5050
vec <- GM.replicate ((1 `shiftL` (depth + 1)) - 1) mempty
5151
return (SegTree depth vec)
5252
{-# INLINE new_SegTree #-}
@@ -56,3 +56,7 @@ asBoxedSegTree = id
5656

5757
asUnboxedSegTree :: (PrimMonad m) => m (SegTree UM.MVector (PrimState m) a) -> m (SegTree UM.MVector (PrimState m) a)
5858
asUnboxedSegTree = id
59+
60+
ceil_log2 :: Int -> Int
61+
ceil_log2 0 = 0
62+
ceil_log2 x = finiteBitSize x - countLeadingZeros (x - 1)

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /