diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-12-05 04:22:32 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-12-05 04:22:32 +0400 |
commit | 36d3f9b1d3e536035a02bf0afd33c2f0efa6e892 (patch) | |
tree | 5f24d419e9b6dfbccfb2557124b698a4ed2e0327 /src/Data/Torrent | |
parent | 74df228e2d8cbe27049f65a70253a59e67c7acc0 (diff) |
Move piece selection algorithms to separate module
Diffstat (limited to 'src/Data/Torrent')
-rw-r--r-- | src/Data/Torrent/Bitfield.hs | 72 |
1 files changed, 1 insertions, 71 deletions
diff --git a/src/Data/Torrent/Bitfield.hs b/src/Data/Torrent/Bitfield.hs index c7ef0998..17278a2c 100644 --- a/src/Data/Torrent/Bitfield.hs +++ b/src/Data/Torrent/Bitfield.hs | |||
@@ -55,13 +55,6 @@ module Data.Torrent.Bitfield | |||
55 | , fromBitmap, toBitmap | 55 | , fromBitmap, toBitmap |
56 | , toList | 56 | , toList |
57 | 57 | ||
58 | -- * Selection | ||
59 | , Selector | ||
60 | , selector, strategyClass | ||
61 | |||
62 | , strictFirst, strictLast | ||
63 | , rarestFirst, randomFirst, endGame | ||
64 | |||
65 | #if defined (TESTING) | 58 | #if defined (TESTING) |
66 | -- * Debug | 59 | -- * Debug |
67 | , mkBitfield | 60 | , mkBitfield |
@@ -78,7 +71,7 @@ import qualified Data.Vector.Unboxed as V | |||
78 | import qualified Data.Vector.Unboxed.Mutable as VM | 71 | import qualified Data.Vector.Unboxed.Mutable as VM |
79 | import Data.IntervalSet (IntSet) | 72 | import Data.IntervalSet (IntSet) |
80 | import qualified Data.IntervalSet as S | 73 | import qualified Data.IntervalSet as S |
81 | import qualified Data.IntervalSet.ByteString as S | 74 | import qualified Data.IntervalSet.ByteString as S |
82 | import Data.List (foldl') | 75 | import Data.List (foldl') |
83 | import Data.Monoid | 76 | import Data.Monoid |
84 | import Data.Ratio | 77 | import Data.Ratio |
@@ -289,66 +282,3 @@ mkBitfield s ixs = Bitfield { | |||
289 | bfSize = s | 282 | bfSize = s |
290 | , bfSet = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs | 283 | , bfSet = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs |
291 | } | 284 | } |
292 | |||
293 | {----------------------------------------------------------------------- | ||
294 | Selection | ||
295 | -----------------------------------------------------------------------} | ||
296 | |||
297 | type Selector = Bitfield -- ^ Indices of client /have/ pieces. | ||
298 | -> Bitfield -- ^ Indices of peer /have/ pieces. | ||
299 | -> [Bitfield] -- ^ Indices of other peers /have/ pieces. | ||
300 | -> Maybe PieceIx -- ^ Zero-based index of piece to request | ||
301 | -- to, if any. | ||
302 | |||
303 | selector :: Selector -- ^ Selector to use at the start. | ||
304 | -> Ratio PieceCount | ||
305 | -> Selector -- ^ Selector to use after the client have | ||
306 | -- the C pieces. | ||
307 | -> Selector -- ^ Selector that changes behaviour based | ||
308 | -- on completeness. | ||
309 | selector start pt ready h a xs = | ||
310 | case strategyClass pt h of | ||
311 | SCBeginning -> start h a xs | ||
312 | SCReady -> ready h a xs | ||
313 | SCEnd -> endGame h a xs | ||
314 | |||
315 | data StartegyClass | ||
316 | = SCBeginning | ||
317 | | SCReady | ||
318 | | SCEnd | ||
319 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
320 | |||
321 | |||
322 | strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass | ||
323 | strategyClass threshold = classify . completeness | ||
324 | where | ||
325 | classify c | ||
326 | | c < threshold = SCBeginning | ||
327 | | c + 1 % numerator c < 1 = SCReady | ||
328 | -- FIXME numerator have is not total count | ||
329 | | otherwise = SCEnd | ||
330 | |||
331 | |||
332 | -- | Select the first available piece. | ||
333 | strictFirst :: Selector | ||
334 | strictFirst h a _ = Just $ findMin (difference a h) | ||
335 | |||
336 | -- | Select the last available piece. | ||
337 | strictLast :: Selector | ||
338 | strictLast h a _ = Just $ findMax (difference a h) | ||
339 | |||
340 | -- | | ||
341 | rarestFirst :: Selector | ||
342 | rarestFirst h a xs = rarest (map (intersection want) xs) | ||
343 | where | ||
344 | want = difference h a | ||
345 | |||
346 | -- | In average random first is faster than rarest first strategy but | ||
347 | -- only if all pieces are available. | ||
348 | randomFirst :: Selector | ||
349 | randomFirst = do | ||
350 | -- randomIO | ||
351 | error "randomFirst" | ||
352 | |||
353 | endGame :: Selector | ||
354 | endGame = strictLast | ||