Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated about a month ago

total matches: more than 1000

alsa-seq-0.6.0.7
2 matches
src/Sound/ALSA/Sequencer/Queue.hs

alloc :: Seq.T mode -> IO Queue.T -- ^ Queue.T identifier.
alloc (Seq.Cons h) =
  fmap Queue.imp $ Exc.checkResult "Queue.alloc" =<< alloc_ h

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_queue"
  alloc_ :: Ptr Seq.Core -> IO C.CInt

with :: Seq.T mode -> (Queue.T -> IO a) -> IO a

            
src/Sound/ALSA/Sequencer/Queue.hs

allocNamed :: Seq.T mode -> String -> IO Queue.T
allocNamed (Seq.Cons h) x = withCAString x $ \s ->
  fmap Queue.imp $ Exc.checkResult "Queue.allocNamed" =<< allocNamed_ h s

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_named_queue"
  allocNamed_ :: Ptr Seq.Core -> CString -> IO C.CInt

withNamed :: Seq.T mode -> String -> (Queue.T -> IO a) -> IO a

            
apportionment-0.0.0.3
6 matches
src/Math/Apportionment.hs
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Function.HT (compose2, )
import Data.Tuple.HT (mapSnd, )
import Data.Ord.HT (comparing, )


{- |
Like 'largestRemainder' but result values

            
src/Math/Apportionment.hs
_largestRemainderSort xs =
   let (d, intFracs) = fractions xs
       (intUps, intDowns) =
          splitAt d $ map fst $
          List.sortBy (comparing (negate.snd)) intFracs
   in  map (1+) intUps ++ intDowns

{- |
This function rounds values
such that the sum of the rounded values
matches the rounded sum of the original values.

            
src/Math/Apportionment.hs
largestRemainderCore :: (RealFrac a) => Fractions a -> [Int]
largestRemainderCore (d, intFracs) =
   let (intUps, intDowns) =
          splitAt d $ map (mapSnd fst) $
          List.sortBy (comparing (negate . snd . snd)) $
          zip [(0::Int) .. ] intFracs
   in  map snd $ List.sortBy (comparing fst) $
       map (mapSnd (1+)) intUps ++ intDowns

fractions :: (RealFrac a) => [a] -> Fractions a
fractions xs =
   let xsum = round $ sum xs
       intFracs = map properFraction xs

            
src/Math/Apportionment.hs
fractions :: (RealFrac a) => [a] -> Fractions a
fractions xs =
   let xsum = round $ sum xs
       intFracs = map properFraction xs
       isum = sum $ map fst intFracs
   in  (xsum-isum, intFracs)

fractionsScaled :: (RealFrac a) => Int -> [a] -> Fractions a
fractionsScaled xsum xs =
   let c = fromIntegral xsum / sum xs

            
src/Math/Apportionment.hs
fractionsScaled :: (RealFrac a) => Int -> [a] -> Fractions a
fractionsScaled xsum xs =
   let c = fromIntegral xsum / sum xs
       intFracs = map (properFraction . (* c)) xs
       isum = sum $ map fst intFracs
   in  (xsum-isum, intFracs)


{- |
<https://en.wikipedia.org/wiki/Highest_averages_method>

            
src/Math/Apportionment.hs
highestAveragesScaled :: (RealFrac a) => [a] -> Int -> [a] -> [Int]
highestAveragesScaled divs s xs =
   let m = Map.fromList $ zip [(0::Int) ..] xs
   in  Map.elems $ flip Map.union (fmap (const 0) m) $
       Map.fromListWith (+) $ map (mapSnd (const 1)) $
       take s $ Fold.foldl (ListHT.mergeBy (compose2 (>=) snd)) [] $
       Map.mapWithKey (map . (,)) $ outerProduct (/) m divs

dHondtDivisors :: Num a => [a]
dHondtDivisors = iterate (1+) 1

sainteLagueDivisors :: Num a => [a]

            
audacity-0.0.2
2 matches
example/Combine.hs
         sequs <-
            (maybe chanExc return . NonEmpty.fetch =<<) $
            waveSummary sh numChan input sig
         return $ flip fmap sequs $ \sequ ->
            (Audacity.WaveTrack $
             ProjectWaveTrack.deflt {
               ProjectWaveTrack.name_ = FilePath.takeBaseName input,
               ProjectWaveTrack.rate_ = round $ defltRate maybeRate,
               ProjectWaveTrack.clips_ = [ProjectWaveTrack.Clip 0 sequ]

            
example/Combine.hs
            return $ NonEmpty.singleton $
               (projectLabelTrack (FilePath.takeBaseName input) labels,
                NonEmpty.maximum $ (0!:) $
                map (snd.fst) $ LabelTrack.decons labels)
         else
            withSound input $ \ _fmt rate numChan sig ->
               write sh rate numChan input sig
   let (tracks, lengths) = FuncHT.unzip $ join trackLengths


            
battleship-combinatorics-0.0.0.2
20 matches
src/Combinatorics/Battleship/Count/CountMap.hs

import qualified Data.NonEmpty as NonEmpty
import qualified Data.List.Match as Match
import Data.Monoid (Monoid, mempty, mappend, mconcat, )
import Data.Semigroup (Semigroup, (<>))
import Data.List.HT (sliceVertical, )
import Text.Printf (printf, )

import Data.Word (Word64, )

            
src/Combinatorics/Battleship/Count/CountMap.hs

fromAscList :: (Storable a) => [KeyCount w a] -> T w a
fromAscList =
   Cons . SVL.pack defaultChunkSize . map (uncurry Element)

fromMap :: (Storable a) => Map (Key w) a -> T w a
fromMap = fromAscList . Map.toAscList

fromList :: (Counter.C a, Storable a) => [KeyCount w a] -> T w a

            
src/Combinatorics/Battleship/Count/CountMap.hs
fromList = fromMap . Map.fromListWith add

fromListStorable :: (Counter.C a, Storable a) => [KeyCount w a] -> T w a
fromListStorable = mconcat . map (uncurry singleton)


toAscList :: (Storable a) => T w a -> [KeyCount w a]
toAscList (Cons m) = map pairFromElement $ SVL.unpack m

toMap :: (Storable a) => T w a -> Map (Key w) a
toMap = Map.fromAscList . toAscList



            
src/Combinatorics/Battleship/Count/CountMap.hs
      zipWith
         (\n bucket -> writeFile (formatPath dir n) bucket >> return n)
         [0 ..] $
      map fromList $
      sliceVertical bucketSize xs
   case formatPath dir (2*lastN) of
      finalPath -> do
         forM_ (take lastN $ zip (iterate (2+) 0) [lastN+1 ..]) $
            \(srcN, dstN) ->

            
src/Combinatorics/Battleship/Count/CountMap.hs
   (Counter.C a, Storable a) => Path w a -> [[KeyCount w a]] -> IO ()
writeSorted dst xs =
   Temp.withSystemTempDirectory "battleship" $ \dir -> do
      let chunks = map fromList xs
      let unary = void chunks
      let paths =
            {-
            Matching with () makes sure
            that references from 'unary' to 'chunks' are removed

            
src/Combinatorics/Battleship/Count/CountMap.hs

instance (Counter.C a, Storable a) => Monoid (T w a) where
   mempty = empty
   mappend = merge
   mconcat = mergeMany

            
src/Combinatorics/Battleship/SetCover.hs
import qualified Data.List as List
import Data.Foldable (foldMap, forM_)
import Data.Maybe.HT (toMaybe)
import Data.Maybe (mapMaybe, catMaybes)
import Data.Tuple.HT (mapFst)
import Data.Word (Word64)


shipShape :: Ship -> Map (Int, Int) Bool
shipShape (Ship size orient (x,y)) =

            
src/Combinatorics/Battleship/SetCover.hs

shipShape :: Ship -> Map (Int, Int) Bool
shipShape (Ship size orient (x,y)) =
   Map.fromAscList $ map (flip (,) True) $
   case orient of
      Horizontal -> map (flip (,) y) [x .. x+size-1]
      Vertical -> map ((,) x) [y .. y+size-1]

shipReserve :: Ship -> Set (Int, Int)
shipReserve (Ship size orient (x,y)) =
   let lx = max 0 (x-1)
       ly = max 0 (y-1)

            
src/Combinatorics/Battleship/SetCover.hs
   [ShipSize] -> (Int, Int) ->
   [ESC.Assign (Maybe ShipSize, Map (Int, Int) Bool) (Set (Int, Int))]
assigns sizes boardSize =
   map
      (\asn -> asn{ESC.label = mapFst Just (ESC.label asn)})
      (assignsShip sizes boardSize) ++
   assignsSquare boardSize


formatBoard :: (Int, Int) -> Map (Int, Int) Bool -> String

            
src/Combinatorics/Battleship/SetCover.hs
enumerateFirst :: IO ()
enumerateFirst = do
   let boardSize = standardBoardSize
   mapM_
      (printState boardSize)
      (ESC.step $ ESC.initState $ assigns (map fst standardFleetList) boardSize)

enumerateMixed :: IO ()
enumerateMixed = do
   let boardSize = standardBoardSize
   let fleetList = standardFleetList

            
src/Combinatorics/Battleship/SetCover.hs
   let fleet = Fleet.fromList fleetList
   let loop state =
         let usedFleet =
               Fleet.fromList $ map (flip (,) 1) $
               mapMaybe (fst . ESC.label) $ ESC.usedSubsets state
         in  when (Fleet.subset usedFleet fleet) $
             if usedFleet == fleet
               then printState boardSize state
               else mapM_ loop (ESC.step state)
   loop $ ESC.initState $ assigns (map fst fleetList) boardSize


type AssignShipBitSet =
      ESC.Assign (ShipSize, Map (Int, Int) Bool) (BitSet.Set Integer)


            
src/Combinatorics/Battleship/SetCover.hs
         MS.put $ ESC.updateState place state
   liftM (foldMap (snd . ESC.label) . ESC.usedSubsets) $
      MS.execStateT
         (mapM_ layoutShip $ concatMap (uncurry $ flip replicate) fleetList) $
      ESC.initState $
      ESC.bitVectorFromSetAssigns $ assignsShip (map fst fleetList) boardSize


enumerateShip :: IO ()
enumerateShip = do
   let boardSize = standardBoardSize

            
src/Combinatorics/Battleship/SetCover.hs
enumerateShip = do
   let boardSize = standardBoardSize
   let fleetList = standardFleetList
   mapM_ (printBoard boardSize) $ enumerateGen id boardSize fleetList


select :: (RandomGen g) => [a] -> MS.StateT g Maybe a
select xs = MS.StateT $ \g ->
   toMaybe (not $ null xs) $ mapFst (xs!!) $ randomR (0, length xs - 1) g

            
src/Combinatorics/Battleship/SetCover.hs

select :: (RandomGen g) => [a] -> MS.StateT g Maybe a
select xs = MS.StateT $ \g ->
   toMaybe (not $ null xs) $ mapFst (xs!!) $ randomR (0, length xs - 1) g

enumerateRandom :: IO ()
enumerateRandom = do
   let boardSize = standardBoardSize
   let fleetList = standardFleetList

            
src/Combinatorics/Battleship/SetCover.hs
   let boardSize = standardBoardSize
   let fleetList = standardFleetList
   forM_ [0..] $ \seed ->
      Fold.mapM_ (printBoard boardSize) $
      MS.evalStateT
         (enumerateGen select boardSize fleetList)
         (mkStdGen seed)



            
src/Combinatorics/Battleship/SetCover.hs

formatDistr :: (Int, Int) -> Map (Int, Int) Float -> String
formatDistr boardSize set =
   unlines $ map unwords $ listsFromBoard (printf "%.3f") boardSize set

formatAbsDistr :: (Int, Int) -> Map (Int, Int) Word64 -> String
formatAbsDistr boardSize set =
   unlines $ map unwords $ listsFromBoard (printf "%d") boardSize set

sumMaps :: [Map (Int, Int) Int] -> Map (Int, Int) Int
sumMaps = List.foldl' ((force .) . Map.unionWith (+)) Map.empty

sumMapsStorable ::

            
src/Combinatorics/Battleship/SetCover.hs
   (Int, Int) -> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
sumMapsStorable boardSize =
   Map.fromList . zip (boardCoords boardSize) . SV.unpack .
   let zeroBoard = Map.fromList $ map (flip (,) 0) (boardCoords boardSize)
       numSquares = uncurry (*) boardSize
       checkLength x =
         if SV.length x == numSquares
           then x
           else error "invalid keys in counter board"

            
src/Combinatorics/Battleship/SetCover.hs
           then x
           else error "invalid keys in counter board"
   in List.foldl' ((force .) . SV.zipWith (+)) (SV.replicate numSquares 0) .
      map (checkLength . SV.pack . Map.elems . flip Map.union zeroBoard)

estimateDistribution :: IO ()
estimateDistribution = do
   let boardSize = standardBoardSize
   let fleetList = standardFleetList

            
src/Combinatorics/Battleship/SetCover.hs
   let fleetList = standardFleetList
   let num = 100000
   putStr $ ('\n':) $ formatDistr boardSize $
      Map.map (\n -> fromIntegral n / fromIntegral num) $
      sumMapsStorable boardSize $
      map (Map.map (\b -> if b then 1 else 0)) $
      take num $ catMaybes $
      flip map [0..] $ \seed ->
      MS.evalStateT
         (enumerateGen select boardSize fleetList)
         (mkStdGen seed)

exactDistribution :: IO ()

            
src/Combinatorics/Battleship/SetCover.hs
   let fleetList = [(2,1), (3,2)]
   putStr $ ('\n':) $ formatAbsDistr boardSize $
      sumMapsStorable boardSize $
      map (Map.map (\b -> if b then 1 else 0)) $
      enumerateGen id boardSize fleetList

{-
110984 157686 189232 183236 181578 181578 183236 189232 157686 110984
157686 190520 213246 203776 201766 201766 203776 213246 190520 157686