diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,196 +1,24 @@ ---- -title: SLOANE(1) Sloane User Manual | Version 2.0.5 -date: 7 Jan 2015 ---- - -# NAME - -sloane - a command line interface to Sloane's -On-Line Encyclopedia of Integer Sequences - -# SYNOPSIS - -sloane [-a|--all] [-k KEYS] [-n N] [--url] [--local] TERMS... - -sloane -A NUMBER - -sloane --filter [--invert] - -sloane --transform NAME - -sloane (--list-transforms | --update | --version | --help) - -# DESCRIPTION - -The `sloane` command searches Sloane's On-Line Encyclopedia of Integer -Sequences (OEIS). The search terms are typically the leading term of a -sequence. For example, - - sloane 1,1,2,5,15,52,203,877,4140 - -returns entry A000110 (Bell numbers), and four more entries. One can -also search by sequence id (A-number), or even search for arbitrary -words. See the **EXAMPLES** section. - -Alternatively, using the `--local` option, the search can be done -locally against a downloaded local database of known sequences. This -mode works by "grepping" for the query in the sequence field. - -To check a large number of sequences one can use `--filter`. When this -option is set, `sloane` reads the standard input line-by-line, if the -sequence read is in the local database, then it is returned to the -standard output; if not, it is ignored. This way one can quickly filter -out the sequences from the input that are in the local database. In -other words, assuming that *FILE* contains one sequence per line, - - sloane --filter . - ---list-transforms -: List the names of all transforms. - ---update -: Update the local database. - ---version -: Print version information. - ---help -: Briefly describe the available options. - -# EXAMPLES - -The most common search is for entries matching a sequence of consecutive terms: - - sloane 1,3,19,183,2371,38703 - -At the time of writing this particular query would return - - S A006531 1,1,3,19,183,2371,38703,763099,17648823,468603091,14050842303, - N A006531 Semiorders on n elements. - -As this illustrates, the default is to return just the sequence (S) and -the name (N) fields. To override the default one can use the keys -option. For instance, the following search shows the sequence, name, -comments, and formula fields of the sequence whose A-number is A006531: - - sloane -k SNCF id:A006531 - -The next example returns at most 3 results of a free text search: - - sloane -n 3 "(2+2)-free posets" - -To view the full entries of these 3 results in a browser (e.g., Firefox) -one can use the url option: - - firefox `sloane --url -n 3 "(2+2)-free posets"` - -To retrieve sequence A022493 from the local database use the `-A` option: - - sloane -A022493 - -In the final example the local database is used to filter out sequences -from the standard input that are in OEIS: - - sloane --filter <. - - I ID number - - S 1st line of unsigned sequence - T 2nd line of unsigned sequence - U 3rd line of unsigned sequence - - V 1st line of signed sequence - W 2nd line of signed sequence - X 3rd line of signed sequence +# sloane [![Build Status](https://travis-ci.org/akc/sloane.svg)](https://travis-ci.org/akc/sloane) - N Name - C Comments - D References - H Links - F Formula - e Examples +A command line interface to +[The On-Line Encyclopedia of Integer Sequences](http://oeis.org). - p Maple program - t Mathematica program - o Program in other language +![demo](demo.gif) - Y Cross-references - K Keywords - O Offset - A Author - E Extensions and errors +## Install -# NOTES +If using the [nix](https://nixos.org/nix/) package manager: -Please use this program with moderation as not to overburden the -OEIS-server; see OEIS' policy on searching the database: -. +``` +$ nix-env -f "" -iA haskellPackages.sloane +``` -# SEE ALSO +Otherwise, use [cabal](https://www.haskell.org/cabal/): -The sloane source code may be downloaded from -. +``` +$ cabal install sloane +``` -# AUTHOR +## Usage -Anders Claesson +See the [man page](sloane.md). diff --git a/Sloane/Bloom.hs b/Sloane/Bloom.hs new file mode 100644 --- /dev/null +++ b/Sloane/Bloom.hs @@ -0,0 +1,52 @@ +-- | +-- Copyright : Anders Claesson 2015 +-- Maintainer : Anders Claesson +-- License : BSD-3 +-- + +module Sloane.Bloom + ( mkBloomFilter + , isFactorOf + ) where + +import Data.ByteString.Char8 (ByteString) +import Data.BloomFilter (Bloom) +import qualified Data.BloomFilter as F +import Data.BloomFilter.Hash +import Sloane.OEIS +import Sloane.DB + +newtype T9 = T9 ( ByteString, ByteString, ByteString + , ByteString, ByteString, ByteString + , ByteString, ByteString, ByteString ) + +type BlF = Bloom T9 + +instance Hashable T9 where + hashIO32 (T9 (a,b,c,d,e,f,g,h,i)) salt = + hashIO32 a salt >>= hashIO32 b >>= hashIO32 c >>= hashIO32 d >>= hashIO32 e + >>= hashIO32 f >>= hashIO32 g >>= hashIO32 h >>= hashIO32 i + +zip9 :: [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]->[i] -> [(a,b,c,d,e,f,g,h,i)] +zip9 (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) (i:is) + = (a,b,c,d,e,f,g,h,i) : zip9 as bs cs ds es fs gs hs is +zip9 _ _ _ _ _ _ _ _ _ = [] + +ninegrams :: [ByteString] -> [T9] +ninegrams xs = map T9 $ zip9 xs (drop 1 xs) (drop 2 xs) (drop 3 xs) (drop 4 xs) + (drop 5 xs) (drop 6 xs) (drop 7 xs) (drop 8 xs) + +-- | Make a Bloom filter of all nine integer segments of all sequences +-- in the given data base. +mkBloomFilter :: DB Sequences -> BlF +mkBloomFilter (DB db) = F.fromList (cheapHashes numHashes) numBits ts + where + ts = ninegrams (parseTermsOfRecords db) + numHashes = 3 + numBits = 2^(26 :: Int) + +-- | Are all the nine element factors of the given (packed) sequence +-- members of the Bloom filter. May give a false positive answer, but +-- never a false negative answer. +isFactorOf :: PackedSeq -> BlF -> Bool +isFactorOf (PSeq s) bf = all (`F.elem` bf) $ ninegrams (parseTermsErr s) diff --git a/Sloane/Config.hs b/Sloane/Config.hs --- a/Sloane/Config.hs +++ b/Sloane/Config.hs @@ -3,41 +3,41 @@ -- Maintainer : Anders Claesson -- License : BSD-3 -- -module Sloane.Config (Config (..), defaultConfig) where +-- Constants determined at runtime such as the home directory. +module Sloane.Config + ( Config (..) + , getConfig + ) where + import System.Console.Terminal.Size (width, size) import System.FilePath (()) import System.Directory -type URL = String - +-- | A data type holding "constants" determined at runtime. data Config = Config - { nameVer :: String - , home :: FilePath - , sloaneDir :: FilePath - , sloaneDB :: FilePath - , oeisHost :: URL - , oeisURL :: URL - , sURL :: URL - , nURL :: URL - , termWidth :: Int + { + -- | The home directory + home :: FilePath + -- | Path to the '.sloane' directory. + , sloaneDir :: FilePath + -- | Path to 'stripped' file. + , seqDBPath :: FilePath + -- | Path to 'names' file. + , namesDBPath :: FilePath + -- | The width of the terminal. + , termWidth :: Int } -defaultConfig :: IO Config -defaultConfig = do +-- | Get configuration. +getConfig :: IO Config +getConfig = do w <- maybe maxBound width `fmap` size h <- getHomeDirectory - let dsloane = h ".sloane" - return Config - { nameVer = "sloane 2.0.5" - , home = h - , sloaneDir = dsloane - , sloaneDB = dsloane "sloane.db" - , oeisHost = oeisorg - , oeisURL = oeisorg ++ "search?fmt=text" - , sURL = oeisorg ++ "stripped.gz" - , nURL = oeisorg ++ "names.gz" - , termWidth = w - } - where - oeisorg = "https://oeis.org/" + let c = Config { home = h + , sloaneDir = h ".sloane" + , seqDBPath = sloaneDir c "stripped" + , namesDBPath = sloaneDir c "names" + , termWidth = w + } + return c diff --git a/Sloane/DB.hs b/Sloane/DB.hs --- a/Sloane/DB.hs +++ b/Sloane/DB.hs @@ -1,160 +1,70 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + -- | --- Copyright : Anders Claesson 2014-2015 +-- Copyright : Anders Claesson 2015 -- Maintainer : Anders Claesson -- License : BSD-3 -- module Sloane.DB - ( DB - , ANumber - , Seq - , Reply - , update - , read - , write - , put - , null - , insert - , lookup - , lookupSeq + ( DB (..), Sequences, Names + , readSeqDB + , readNamesDB + , grepN , grep - , take - , aNumbers - , parseOEISEntries ) where -import Prelude hiding (lookup, null, take, read) -import qualified Prelude as P -import Data.List (intersect) -import qualified Data.ByteString.Search as Search -import qualified Data.ByteString.Char8 as Ch8 -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import Data.Map.Strict (Map, (!)) -import qualified Data.Map.Strict as M -import Data.Serialize hiding (put) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as IO -import Data.Text.Encoding (decodeUtf8) -import Control.Monad (forM_, unless) -import qualified Codec.Compression.GZip as GZ -import Network.Curl.Download (openURI) -import System.Console.ANSI -import Sloane.Config -import System.Directory - -type ANumber = ByteString -type Seq = ByteString -type Key = Char -type Entry = ByteString -type Reply = Map Key Entry - -type DB = Map ANumber Reply - -gzCompress :: ByteString -> ByteString -gzCompress = BL.toStrict . GZ.compress . BL.fromStrict - -compressDB :: DB -> ByteString -compressDB = gzCompress . encode - -gzDecompress :: ByteString -> ByteString -gzDecompress = BL.toStrict . GZ.decompress . BL.fromStrict - -decompressDB :: ByteString -> Either String DB -decompressDB = decode . gzDecompress - -update :: Config -> IO () -update cfg = do - createDirectoryIfMissing False (sloaneDir cfg) - putStrLn $ "Downloading " ++ sURL cfg - dbS <- either error (return . mkDB 'S') =<< openURI (sURL cfg) - putStrLn $ "Downloading " ++ nURL cfg - dbN <- either error (return . mkDB 'N') =<< openURI (nURL cfg) - putStrLn "Building database" - write cfg $ unionDB dbS dbN - putStrLn "Done." - where - unionDB = M.unionWith M.union - mkDB key = mkMap key . gzDecompress - mkMap key = M.fromList . map (aNumberAndReply key) . drop 4 . Ch8.lines - mkReply key = M.singleton key . Ch8.dropWhile (==',') . Ch8.drop 8 - aNumberAndReply key line = (Ch8.take 7 line, mkReply key line) - -read :: Config -> IO DB -read cfg = doesFileExist (sloaneDB cfg) >>= \updated -> - if updated - then B.readFile (sloaneDB cfg) >>= either error return . decompressDB - else error $ "No local database found. " ++ - "You need to run \"sloane --update\" first." - -write :: Config -> DB -> IO () -write cfg = B.writeFile (sloaneDB cfg) . compressDB - -null :: DB -> Bool -null = M.null - -insert :: ANumber -> Reply -> DB -> DB -insert = M.insert - -lookup :: ANumber -> DB -> Maybe Reply -lookup = M.lookup - -lookupSeq :: ANumber -> DB -> Maybe Seq -lookupSeq anum db = lookup anum db >>= M.lookup 'S' +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Data.Maybe +import Data.List +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Search as S +import System.Directory +import Sloane.OEIS +import Sloane.Config -isInfix :: ByteString -> ByteString -> Bool -isInfix q = not . P.null . Search.indices q +-- | An empty data declaration used with the phantom `DB` data type. +data Sequences -grep :: ByteString -> DB -> DB -grep q = M.filter $ \reply -> - case M.lookup 'S' reply of - Nothing -> False - Just r -> q `isInfix` r +-- | An empty data declaration used with the phantom `DB` data type. +data Names -take :: Int -> DB -> DB -take n = M.fromList . P.take n . M.toList +-- | A data base (DB) is just a wrapped `ByteString`. +newtype DB a = DB {unDB :: ByteString} deriving Show -aNumbers :: DB -> [ANumber] -aNumbers = M.keys +-- | Read the DB at the given location. +readDB :: FilePath -> IO (DB a) +readDB fpath = doesFileExist fpath >>= \b -> + if b then DB <$> B.readFile fpath + else error "No local database; run 'sloane --update' first." -unions :: [DB] -> DB -unions = M.unionsWith . M.unionWith $ \s t -> - (s `B.append` Ch8.pack "\n") `B.append` t +-- | Read the sequence DB (derived from \"stripped.gz\"). +readSeqDB :: Config -> IO (DB Sequences) +readSeqDB = readDB . seqDBPath -singleton :: ANumber -> Key -> Entry -> DB -singleton aNum key = M.singleton aNum . M.singleton key +-- | Read the names DB (derived from \"names.gz\"). +readNamesDB :: Config -> IO (DB Names) +readNamesDB = readDB . namesDBPath -parseOEISEntries :: ByteString -> DB -parseOEISEntries = unions . map parseLine . trim +-- | Return all A-numbers whose associated sequence contains a given +-- sequence as a factor. +grep :: PackedSeq -> DB Sequences -> [ANum] +grep (PSeq p) (DB bs) = mapMaybe locateANum (S.indices q bs) where - trim = map (Ch8.drop 1) . reverse . drop 2 . reverse . drop 5 . Ch8.lines - parseLine = parseWords . Ch8.words - parseWords (key:aNum:rest) = singleton aNum (Ch8.head key) (Ch8.unwords rest) - parseWords _ = M.empty - -put :: Config -> [Key] -> DB -> IO () -put cfg keys db = do - unless (null db) $ putStrLn "" - forM_ (M.toList db) $ \(aNum, reply) -> do - forM_ (keys `intersect` M.keys reply) $ \key -> do - let entry = reply ! key - forM_ (Ch8.lines entry) $ \line -> do - let line' = decodeUtf8 line - setSGR [ SetColor Foreground Dull Green ] - putStr [key] - setSGR [ SetColor Foreground Dull Yellow ] - putStr " " >> Ch8.putStr aNum - setSGR [] - putStr " " >> IO.putStrLn (crop key (termWidth cfg - 10) line') - putStrLn "" + q = B.snoc (B.cons ',' p) ',' + locateANum i = listToMaybe + [ ANum (B.take 7 v) + | j <- [i,i-1..0] + , B.index bs j == 'A' + , let (_,v) = B.splitAt j bs + ] -crop :: Key -> Int -> Text -> Text -crop key = - let cropText f maxLen s = if maxLen < T.length s then f maxLen s else s - in if key `elem` ['S'..'X'] - then cropText $ \maxLen -> - T.reverse . T.dropWhile (/= ',') . T.reverse . T.take maxLen - else cropText $ \maxLen s -> - T.take (maxLen-2) s `T.append` T.pack ".." +-- | Similar to `grep` but return at most 'n' unique hits. +grepN :: Int -> PackedSeq -> DB Sequences -> [ANum] +grepN n q db = Prelude.take n $ map head $ group (grep q db) diff --git a/Sloane/Download.hs b/Sloane/Download.hs new file mode 100644 --- /dev/null +++ b/Sloane/Download.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE CPP #-} +-- | +-- Copyright : Anders Claesson 2015 +-- Maintainer : Anders Claesson +-- License : BSD-3 +-- +module Sloane.Download (download, requestPage) where + +import Numeric +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Conduit hiding (($$)) +import Data.Conduit.Zlib (ungzip) +import qualified Data.Conduit.Binary as CB +import Network.HTTP.Conduit hiding (Proxy) +import Network.HTTP.Types (hContentLength) +import Control.Monad.IO.Class (liftIO) +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Sloane.OEIS (URL) +import System.Console.ANSI +import System.IO + +-- | Request a page at a given URL with specified key-value pairs (query +-- string). +requestPage :: URL -> [(ByteString, ByteString)] -> IO ByteString +requestPage url kvs = do + req <- setQueryString [(k, Just v) | (k,v) <- kvs] <$> parseUrl url + res <- withManager (httpLbs req) + return $ BL.toStrict (responseBody res) + +-- | Download a file at a given URL showing a progress indicator at the +-- given column, and save it at a specified path. +download :: Int -> URL -> FilePath -> IO () +download col url fpath = withManager $ \manager -> do + req <- parseUrl url + res <- http req manager + let Just cl = lookup hContentLength (responseHeaders res) + let n = read (B.unpack cl) :: Int + responseBody res $$+- progress n 0 =$ ungzip =$ CB.sinkFile fpath + where + progress total acc = await >>= maybe (return ()) (\chunk -> do + let acc' = acc + B.length chunk + let percent = fromIntegral (100*acc') / fromIntegral total :: Double + liftIO $ setCursorColumn col + liftIO $ putStr $ showFFloat (Just 2) percent "" ++ "%" + liftIO $ hFlush stdout + yield chunk + progress total acc') diff --git a/Sloane/Entry.hs b/Sloane/Entry.hs new file mode 100644 --- /dev/null +++ b/Sloane/Entry.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} + +-- | +-- Copyright : Anders Claesson 2015 +-- Maintainer : Anders Claesson +-- License : BSD-3 +-- + +module Sloane.Entry + ( PackedPrg (..) + , PackedEntry (..) + , parsePackedEntry + , parsePackedEntryErr + ) where + +import GHC.Generics (Generic) +import Data.Maybe +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.Attoparsec.ByteString.Char8 as Ch +import Data.Attoparsec.ByteString.Char8 +import Control.Monad +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Sloane.Utils +import Sloane.OEIS + +-- | A compact `ByteString` representation of a `Prg`. +newtype PackedPrg = PPrg ByteString deriving (Eq, Show, Generic) + +-- | Similary, a packed entry consists of a packed program together with +-- a packed sequence. +data PackedEntry = PackedEntry + { getPackedPrg :: PackedPrg + , getPackedSeq :: PackedSeq + } deriving (Eq, Show, Generic) + +packedEntry :: Parser PackedEntry +packedEntry = + let f w = if B.last w == '=' then return (PPrg (B.init w)) else mzero + in PackedEntry <$> (Ch.takeWhile1 (/='>') >>= f) + <*> (char '>' *> packedSeq) + +-- | A parser for packed entries. +parsePackedEntry :: ByteString -> Maybe PackedEntry +parsePackedEntry = parse_ packedEntry . B.filter (/=' ') + +-- | Like `parsePackedEntry` but throws an error rather than returning +-- `Nothing` in case the parse fails. +parsePackedEntryErr :: ByteString -> PackedEntry +parsePackedEntryErr = fromMaybe (error "cannot parse input") . parsePackedEntry diff --git a/Sloane/GF.hs b/Sloane/GF.hs deleted file mode 100644 --- a/Sloane/GF.hs +++ /dev/null @@ -1,159 +0,0 @@ --- | --- Copyright : Anders Claesson 2012-2015 --- Maintainer : Anders Claesson --- License : BSD-3 --- -module Sloane.GF - ( Series (..) - , GF - , imap - , diff - , squareRoot - , (^^^) - , o - , ogf - , egf - , ogfCoeffs - , egfCoeffs - )where - -import Data.List -import Data.Maybe -import Data.Ratio - --- Reference: M. D. McIlroy, The music of streams, --- Information Processing Letters 77 (2001) 189-195. - -newtype Series a = Series { coeffs :: [a] } deriving (Show, Eq) - -type GF = Series Rational - -instance Functor Series where - fmap f = Series . fmap f . coeffs - -instance (Eq a, Num a) => Num (Series a) where - (+) = lift2 add - (*) = lift2 mul - fromInteger c = Series [fromInteger c] - negate = fmap negate - signum = undefined - abs = undefined - -instance (Eq a, Fractional a) => Fractional (Series a) where - fromRational c = Series [fromRational c] - (/) = lift2 divide - -degree :: (Num a, Eq a) => Series a -> Int -degree (Series [0]) = -1 -degree (Series cs) = length cs - 1 --- degree (Series cs) = length (dropWhile (==0) (reverse cs)) - 1 - -o :: (Eq a, Fractional a) => Series a -> Series a -> Series a -o = lift2 compose - -lift :: ([a] -> [b]) -> Series a -> Series b -lift f (Series as) = Series (f as) - -lift2 :: ([a] -> [b] -> [c]) -> Series a -> Series b -> Series c -lift2 op (Series as) (Series bs) = Series (as `op` bs) - -add :: Num a => [a] -> [a] -> [a] -add [] ds = ds -add cs [] = cs -add (c:cs) (d:ds) = c+d : add cs ds - -sub :: Num a => [a] -> [a] -> [a] -cs `sub` ds = cs `add` map negate ds - -(!*!) :: (Eq a, Num a) => a -> a -> a -(!*!) _ 0 = 0 -(!*!) 0 _ = 0 -(!*!) a b = a*b - -mul :: (Eq a, Num a) => [a] -> [a] -> [a] -mul (c:ct) ds@(d:dt) = c!*!d : map (c !*!) dt `add` (ct `mul` ds) -mul _ _ = [] - -divide :: (Eq a, Fractional a) => [a] -> [a] -> [a] -divide [] (0:_) = undefined -divide [] _ = [] -divide (0:ct) (0:dt) = ct `divide` dt -divide (c:ct) ds@(d:dt) = q : (ct `sub` ([q] `mul` dt)) `divide` ds where q = c/d -divide _ [] = undefined - -diff :: GF -> GF -diff = lift dF where {dF [] = []; dF (_:ct) = zipWith (*) [1..] ct} - -nthRootApprox :: Integer -> GF -> [GF] -nthRootApprox n f@(Series (1:_)) = - iterateUntilFixed (nthRootNext n f) (Series [1]) -nthRootApprox _ _ = error "GF has constant term different from 1" - -nthRootNext :: Integer -> GF -> GF -> GF -nthRootNext n f g = Series (take (1 + 2*degree f) ds) - where - Series ds = (Series [n%1-1] * g^n + f) / (Series [n%1] * g^(n-1)) - -iterateUntilFixed :: Eq a => (a -> a) -> a -> [a] -iterateUntilFixed f x = x : (if x == y then [] else ys) - where - ys@(y:_) = iterateUntilFixed f (f x) - -saddlePoint :: Eq a => [a] -> Maybe a -saddlePoint [c] = Just c -saddlePoint cs = listToMaybe [ c | (c,d) <- zip cs (drop 1 cs), c == d ] - -nthRoot1 :: Integer -> GF -> GF -nthRoot1 n f@(Series (1:_)) = - let css = transpose (map coeffs (nthRootApprox n f)) - in Series $ map fromJust (takeWhile isJust (map saddlePoint css)) -nthRoot1 _ _ = error "GF has constant term different from 1" - -nthRoot :: Integer -> GF -> GF -nthRoot _ (Series []) = Series [] -nthRoot n (Series cs@(c:_)) = Series [d] * nthRoot1 n (Series $ map (/c) cs) - where - d = toRational (fromRational c ** fromRational (1%n) :: Double) - -(^^^) :: GF -> Rational -> GF -(^^^) f r = case (numerator r, denominator r) of - (n, 1) -> f ^^ n - (0, _) -> ogf [1::Int] - (n, k) -> nthRoot k f ^^ n - --- XXX: Deprecate and use (^^^(1%2)) instead? -squareRoot :: GF -> GF -squareRoot = Series . map toRational . squareRoot' . map fromRational . coeffs - --- XXX: Deprecate? -squareRoot' :: [Double] -> [Double] -squareRoot' [] = [] -squareRoot' (c:ct) = ds - where - ds = d : ct `divide` ([d] `add` ds) - d = sqrt c - -compose :: (Eq a, Fractional a) => [a] -> [a] -> [a] -[] `compose` _ = [] -(c:_) `compose` [] = [c] -(c:ct) `compose` ds@(0:dt) = c : dt `mul` (ct `compose` ds) -(c:ct) `compose` ds = [c] `add` ds `mul` (ct `compose` ds) - -- ct must be finite - -imap :: (Integer -> a -> b) -> Series a -> Series b -imap f = Series . zipWith f [0..] . coeffs - -factorial :: Integer -> Integer -factorial n = product [1..n] - -ogf :: Real a => [a] -> GF -ogf = Series . map toRational - -ogfCoeffs :: GF -> [Rational] -ogfCoeffs = coeffs - -egf :: Real a => [a] -> GF -egf = Series . zipWith (\n c -> toRational c * (1 % factorial n)) [0..] - -egfCoeffs :: GF -> [Rational] -egfCoeffs = ogfCoeffs . imap (\i -> (* (factorial i % 1))) diff --git a/Sloane/OEIS.hs b/Sloane/OEIS.hs new file mode 100644 --- /dev/null +++ b/Sloane/OEIS.hs @@ -0,0 +1,291 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} + +-- | +-- Copyright : Anders Claesson 2015 +-- Maintainer : Anders Claesson +-- License : BSD-3 +-- + +module Sloane.OEIS + ( + -- * Types + URL + , Key + , Name + , ANum (..) + , PackedSeq (..) + , Table (..) + , Reply (..) + -- * Parse names.gz and stripped.gz + , parseNames + , parseStripped + , parseTermsErr + , parseTermsOfRecords + -- * Parse replies from oeis.org + , oeisKeys + , parseReplies + -- * Parse sequences + , shave + , parseSeqErr + , parseIntegerSeq + , packedSeq + , packSeq + -- * Parse A-numbers and B-numbers + , aNumInt + , parseANum + , packANum + , tag + ) where + +import GHC.Generics (Generic) +import Data.Maybe +#if __GLASGOW_HASKELL__ < 710 +import Data.Monoid +#endif +import Data.String +import Data.Ratio +import Data.Map (Map) +import qualified Data.Map as M +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8, decodeUtf8) +import Data.Aeson +import qualified Data.Attoparsec.ByteString as A +import qualified Data.Attoparsec.ByteString.Char8 as Ch +import Data.Attoparsec.ByteString.Char8 +import Control.Monad +import Control.Applicative +import Sloane.Utils + +-- | An OEIS key is `Char`. +type Key = Char + +-- | The name of an OEIS entry is a short description of the +-- sequence. Here represented as a `ByteString`. +type Name = ByteString + +type Row = (Key, ANum, ByteString) + +-- | A URL is currently just a synonym for `String`. +type URL = String + +-- | An A-number is the character \'A\' followed by a six digit +-- number. Here we represent that by a wrapped (7 character) +-- `ByteString`. +newtype ANum = ANum {unANum :: ByteString} deriving (Eq, Ord, Show, Generic) + +-- | A `PackedSeq` is a wrapped `ByteString`. +newtype PackedSeq = PSeq {unPSeq :: ByteString} deriving (Eq, Show, Generic) + +instance Monoid PackedSeq where + mempty = PSeq mempty + mappend (PSeq x) (PSeq y) = PSeq (mappend x y) + +instance IsString PackedSeq where + fromString = PSeq . fromString + +-- | A `Table` represents an OEIS entry. It is a `Map` from OEIS keys to +-- lists of `ByteString`s. +newtype Table = Table (Map Key [ByteString]) deriving Show + +-- | A `Reply` is an A-number together with an associated `Table` (OEIS +-- entry). +data Reply = Reply ANum Table deriving Show + +instance ToJSON ANum where + toJSON (ANum bs) = String (decodeUtf8 bs) + +instance FromJSON ANum where + parseJSON (String s) = pure $ ANum (encodeUtf8 s) + parseJSON _ = mzero + +instance ToJSON PackedSeq where + toJSON (PSeq bs) = String (decodeUtf8 bs) + +instance FromJSON PackedSeq where + parseJSON (String s) = pure $ PSeq (encodeUtf8 s) + parseJSON _ = mzero + +instance ToJSON Table where + toJSON (Table tbl) = + object [ T.singleton key .= toJSON (map decodeUtf8 ls) + | (key, ls) <- M.toList tbl + ] + +instance ToJSON Reply where + toJSON (Reply anum table) = + object [ "A-number" .= toJSON anum + , "table" .= toJSON table + ] + +instance FromJSON Table where + parseJSON (Object v) = + let f k = (,) <$> pure k <*> (map encodeUtf8 <$> v .: T.singleton k) + in Table . M.fromList <$> mapM f oeisKeys + parseJSON _ = mzero + +instance FromJSON Reply where + parseJSON (Object v) = Reply <$> v .: "A-number" <*> v .: "table" + parseJSON _ = mzero + +spc :: Parser Char +spc = char ' ' + +aNum :: Parser ANum +aNum = ANum <$> (B.cons <$> char 'A' <*> takeWhile1 isDigit) + +------------------------------------------------------------------------------- +-- Parsing names.gz and stripped.gz +------------------------------------------------------------------------------- + +dropHeader :: [ByteString] -> [ByteString] +dropHeader = dropWhile (\line -> B.head line == '#') + +parseRecords :: ByteString -> [(ANum, ByteString)] +parseRecords = mapMaybe (parse_ record) . dropHeader . B.lines + where + record = (,) <$> (aNum <* spc) <*> A.takeByteString + +-- | Parse a list of A-number-names pairs and build a `Map` from the +-- result. It's purpose is to parse lines of the @names@ file. A typical +-- line of that file looks like this: +-- +-- > A000108 Catalan numbers: C(n) = binomial(2n,n)/(n+1) = (2n)!/(n!(n+1)!). +-- +parseNames :: ByteString -> [(ANum, ByteString)] +parseNames = parseRecords + +-- | Parse a list of A-number-sequence pairs. It's purpose is to parse +-- lines of the @stripped@ file. A typical line of that file looks like +-- this: +-- +-- > A000108 ,1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900, +-- +parseStripped :: ByteString -> [(ANum, PackedSeq)] +parseStripped bs = [ (anum, PSeq (shave s)) | (anum, s) <- parseRecords bs ] + +------------------------------------------------------------------------------- +-- Building the Bloom filter +------------------------------------------------------------------------------- + +terms :: Parser [ByteString] +terms = takeWhile1 (/=',') `sepBy` char ',' + +-- | Extract the list of terms from a `ByteString` of comma separated +-- terms. +parseTermsErr :: ByteString -> [ByteString] +parseTermsErr = fromMaybe (error "error parsing terms") . parse_ terms + +-- | The purpose of this function is extract all terms from the records +-- (lines) of the @stripped@ file (skipping over A-numbers). +parseTermsOfRecords :: ByteString -> [ByteString] +parseTermsOfRecords = + concat + . mapMaybe (parse_ ((aNum <* spc) *> char ',' *> terms)) + . dropHeader . B.lines + +------------------------------------------------------------------------------- +-- Parsing replies from oeis.org/search?fmt=text +------------------------------------------------------------------------------- + +-- | The complete list of keys used by OEIS (). +oeisKeys :: String +oeisKeys = "ISTUVWXNDHFYAOEeptoKC" + +row :: Parser Row +row = (,,) + <$> (char '%' *> anyChar) + <*> (spc *> aNum) + <*> ((spc *> rest) <|> (endOfLine *> return B.empty)) + where + rest = A.takeTill isEndOfLine <* endOfLine + +rows :: Parser Reply +rows = mkMap1 <$> many1 row + where + mkMap2 = Table . M.fromListWith (flip (++)) + mkMap1 rs@((_,a,_):_) = Reply a $ mkMap2 (map (\(key, _, r) -> (key, [r])) rs) + mkMap1 [] = error "internal error" + +noise :: Parser () +noise = skipMany (notChar '%') + +replies :: Parser [Reply] +replies = concat <$> (noise *> (many1 rows `sepBy` many1 endOfLine) <* noise) + +-- | Parse OEIS replies as recieved from @oeis.org/search?fmt=text@. +parseReplies :: ByteString -> [Reply] +parseReplies = fromMaybe [] . parse_ replies + +------------------------------------------------------------------------------- +-- Parse sequences +------------------------------------------------------------------------------- + +rat :: Parser Rational +rat = (%) <$> signed decimal <*> ((char '/' *> decimal) <|> return 1) + +ratSeq :: Parser [Rational] +ratSeq = rat `sepBy` char ',' + +integerSeq :: Parser [Integer] +integerSeq = signed decimal `sepBy` char ',' + +parseSeq :: ByteString -> Maybe [Rational] +parseSeq = parse_ (ratSeq <* endOfInput) . B.filter (/=' ') + +-- | Parse a sequence of `Rational`s. +parseSeqErr :: ByteString -> [Rational] +parseSeqErr = fromMaybe (error "error parsing sequence") . parseSeq + +-- | Parse a sequence of `Integer`s. +parseIntegerSeq :: ByteString -> Maybe [Integer] +parseIntegerSeq = parse_ (integerSeq <* endOfInput) . B.filter (/=' ') + +-- | Parser for `PackedSeq`. +packedSeq :: Parser PackedSeq +packedSeq = PSeq <$> (char '{' *> Ch.takeWhile (/='}') <* char '}') + +-- | Pack a sequence of `Rational`s into a `PackedSeq`. E.g. +-- +-- > packSeq [1,1/2,1/3] = PSeq {unPSeq = "1,1/2,1/3"} +-- +packSeq :: [Rational] -> PackedSeq +packSeq = PSeq . B.intercalate (B.pack ",") . map (B.pack . f) + where + f r = case (numerator r, denominator r) of + (n, 1) -> show n + (n, d) -> show n ++ '/':show d + +------------------------------------------------------------------------------- +-- Utility functions +------------------------------------------------------------------------------- + +-- | \"Shave\" off the first and last element of a `ByteString`. E.g. +-- +-- > shave "{1,2,3}" = "1,2,3" +-- +shave :: ByteString -> ByteString +shave = B.init . B.tail + +-- | A parser for A-numbers as `Int`s. +aNumInt :: Parser Int +aNumInt = char 'A' >> decimal + +-- | Run the `aNumInt` parser. +parseANum :: ByteString -> Maybe ANum +parseANum = parse_ (packANum <$> aNumInt) + +-- | Pack an A-number given as an `Int` into a wrapped `ByteString` +-- consistsing of an \'A\' followed by six digits. E.g. +-- +-- > packANum 1234 = ANum {unANum = "A001234"} +-- +packANum :: Int -> ANum +packANum anum = ANum $ B.cons 'A' (pad 6 anum) + +-- | A parser for tags (B-numbers) as `Int`s. +tag :: Parser Int +tag = string "TAG" >> decimal diff --git a/Sloane/Options.hs b/Sloane/Options.hs new file mode 100644 --- /dev/null +++ b/Sloane/Options.hs @@ -0,0 +1,111 @@ +-- | +-- Copyright : Anders Claesson 2015 +-- Maintainer : Anders Claesson +-- License : BSD-3 +-- +-- Command line options for sloane. + +module Sloane.Options + ( Palette + , monochrome + , Options (..) + , getOptions + ) where + +import Options.Applicative +import Sloane.OEIS + +-- | A palette is either colorful or monochrome. +data Palette = Colorful | Monochrome deriving (Eq, Enum, Show, Read) + +-- | Is the palette monochrome? +monochrome :: Palette -> Bool +monochrome Monochrome = True +monochrome Colorful = False + +-- | Command line options: +data Options = Options + { + -- | Search the local DB. + query :: Bool + -- | Search oeis.org. + , oeis :: Bool + -- | Print all fields? + , longFormat :: Bool + -- | Keys of fields to print. + , keys :: String + -- | Fetch at most this many entries. + , limit :: Int + -- | Fetch all entries (that match). + , limitless :: Bool + -- | Should we colorize the output? + , palette :: Palette + -- | Filter out sequences in local DB. + , tojson :: Bool + -- | Return sequences NOT in DB + , filtr :: Bool + -- | Return sequences NOT in DB + , invert :: Bool + -- | Output all the sequences of the local DB + , update :: Bool + -- | Show version info + , version :: Bool + -- Search terms or programs + , terms :: [String] + } + +-- | Parse command line options. +optionsParser :: Parser Options +optionsParser = + abortOption ShowHelpText (long "help") <*> (Options + <$> switch + ( short 'q' + <> long "query" + <> help "Search the local database" ) + <*> switch + ( long "oeis" + <> help "Search oeis.org" ) + <*> switch + ( long "long" + <> help "Long format; print all fields" ) + <*> strOption + ( short 'k' + <> metavar "KEYS" + <> value "SN" + <> help "Keys of fields to print [default: SN]" ) + <*> option auto + ( short 'n' + <> metavar "N" + <> value 5 + <> help "Fetch at most this many entries [default: 5]" ) + <*> switch + ( long "all" + <> help "Fetch all matching entries (equivalent to -n 999999)" ) + <*> (toEnum . fromEnum <$> switch + ( long "monochrome" + <> help "Do not colorize the output" ) ) + <*> switch + ( long "json" + <> help "Return results is JSON format" ) + <*> switch + ( long "filter" + <> help ("Read sequences from stdin and return" + ++ " those that are in the local database") ) + <*> switch + ( long "invert" + <> help "When filtering return sequences NOT in the database." ) + <*> switch + ( long "update" + <> help "Update the local database" ) + <*> switch + ( long "version" + <> help "Show version info" ) + <*> many (argument str (metavar "TERMS..."))) + +-- | Run the command line options parser (above). +getOptions :: IO Options +getOptions = updateOpts <$> execParser (info optionsParser fullDesc) + where + updateOpts = updateLimit . updateKeys + updateKeys opts = if longFormat opts then opts {keys = oeisKeys} else opts + updateLimit opts = if limitless opts then opts {limit = 999999} else opts diff --git a/Sloane/Transform.hs b/Sloane/Transform.hs deleted file mode 100644 --- a/Sloane/Transform.hs +++ /dev/null @@ -1,291 +0,0 @@ --- | --- Copyright : Anders Claesson 2012-2015 --- Maintainer : Anders Claesson --- License : BSD-3 --- -module Sloane.Transform - ( NamedTransform (..) - , ($$) - , tLEFT - , tRIGHT - , tM2 - , tM2i - , tBINOMIAL - , tBINOMIALi - , tBIN1 - , tBISECT0 - , tBISECT1 - , tCONV - , tCONVi - , tEXPCONV - , tDIFF - , tMOBIUS - , tMOBIUSi - , tEULER - , tEXP - , tLOG - , tNEGATE - , tPRODS - , tPSUM - , tPSUMSIGN - , tSTIRLING - , tTRISECT0 - , tTRISECT1 - , tTRISECT2 - , tPOINT - , tWEIGHT - , tPARTITION - , transforms - , lookupTranform - , applyAllTransforms - ) where - -import Data.List -import Data.Ratio -import Data.Monoid -import Control.Monad -import Sloane.GF - -type Transform = [Rational] -> [Rational] - -data NamedTransform = NT - { name :: String - , eval :: Transform - } - -instance Show NamedTransform where - show = ('t':) . name - -instance Eq NamedTransform where - t == s = name t == name s - -instance Monoid NamedTransform where - mempty = NT "" id - mappend f g = NT tname teval - where - tname = name f ++ "." ++ name g - teval = eval f . eval g - -infixr 0 $$ - -isInteger :: Rational -> Bool -isInteger = (1==) . denominator - -toIntSeq :: [Rational] -> [Integer] -toIntSeq cs = [ numerator c | c <- cs, all isInteger cs ] - -($$) :: NamedTransform -> [Integer] -> [Integer] -f $$ cs = toIntSeq $ take (length cs) (eval f (map toRational cs)) - -x :: GF -x = ogf [0::Integer, 1] - --- addSeq :: [Integer] -> Transform --- addSeq seq0 = zipWith (+) seq0 - --- mulOGF :: [Integer] -> Transform --- mulOGF seq0 = \cs -> ogfCoeffs (ogf seq0 * ogf cs) - --- mulEGF :: [Integer] -> Transform --- mulEGF seq0 = \cs -> egfCoeffs (egf seq0 * egf cs) - -geoSeries :: Rational -> GF -geoSeries c = ogf [ c^k | k<-[0::Int ..] ] - -expSeries :: Rational -> GF -expSeries c = egf [ c^k | k<-[0::Int ..] ] - -bisect0 :: [a] -> [a] -bisect0 [] = [] -bisect0 (c:cs) = c : bisect1 cs - -bisect1 :: [a] -> [a] -bisect1 [] = [] -bisect1 (_:cs) = bisect0 cs - -trisect0 :: [a] -> [a] -trisect0 [] = [] -trisect0 (c:cs) = c : trisect2 cs - -trisect1 :: [a] -> [a] -trisect1 [] = [] -trisect1 (_:cs) = trisect0 cs - -trisect2 :: [a] -> [a] -trisect2 [] = [] -trisect2 (_:cs) = trisect1 cs - -signed :: GF -> GF -signed = imap $ \i c -> (-1%1)^i * c - -tLEFT :: NamedTransform -tLEFT = NT "LEFT" (drop 1) - -tRIGHT :: NamedTransform -tRIGHT = NT "RIGHT" (1:) - -tM2 :: NamedTransform -tM2 = NT "M2" f where f [] = []; f (c:cs) = c : map ((2%1)*) cs - -tM2i :: NamedTransform -tM2i = NT "M2i" (ogfCoeffs . Series . f) - where - f [] = [] - f cs = let (d:ds) = map toRational cs in d : map (/(2%1)) ds - -tBINOMIAL :: NamedTransform -tBINOMIAL = NT "BINOMIAL" (\cs -> egfCoeffs (expSeries (1%1) * egf cs)) - -tBINOMIALi :: NamedTransform -tBINOMIALi = NT "BINOMIALi" (\cs -> egfCoeffs (expSeries ((-1)%1) * egf cs)) - -tBIN1 :: NamedTransform -tBIN1 = NT "BIN1" (\cs -> - drop 1 . egfCoeffs $ -expSeries (-1%1) * signed (egf (0:cs))) - -tBISECT0 :: NamedTransform -tBISECT0 = NT "BISECT0" bisect0 - -tBISECT1 :: NamedTransform -tBISECT1 = NT "BISECT1" bisect1 - -tCONV :: NamedTransform -tCONV = NT "CONV" (\cs -> ogfCoeffs (ogf cs ^ (2::Int))) - -tCONVi :: NamedTransform -tCONVi = NT "CONVi" (ogfCoeffs . squareRoot . ogf) - -tEXPCONV :: NamedTransform -tEXPCONV = NT "EXPCONV" (\cs -> egfCoeffs (egf cs ^ (2::Int))) - -tDIFF :: NamedTransform -tDIFF = NT "DIFF" (\cs -> zipWith (-) (drop 1 cs) cs) - --- The Mobius function of the poset of integers under divisibility -mobius :: Integer -> Integer -> Integer -mobius a b - | a == b = 1 - | b `rem` a == 0 = -sum [ mobius a c | c <- [a..b-1], b `rem` c == 0 ] - | otherwise = 0 - --- The number theoretical Mobius function -mu :: Integer -> Integer -mu = mobius 1 - -tMOBIUS :: NamedTransform -tMOBIUS = NT "MOBIUS" $ \cs -> - [ sum [mu (n `div` k) % 1 * (cs !! (fromInteger k-1)) - | k<-[1..n], n `rem` k == 0 - ] - | (n,_) <- zip [1..] cs - ] - -tMOBIUSi :: NamedTransform -tMOBIUSi = NT "MOBIUSi" $ \cs -> - [ sum [ cs !! (fromInteger k-1) | k<-[1..n], n `rem` k == 0 ] - | (n,_) <- zip [1..] cs - ] - -tEULER :: NamedTransform -tEULER = NT "EULER" (\cs -> - let f = product $ zipWith (\n c -> (1 - x^n)^^^c) [1::Int ..] cs - in drop 1 $ ogfCoeffs (1/f)) - -tEULERi :: NamedTransform -tEULERi = NT "EULERi" undefined - --- EXP converts [a_1, a_2, ...] to [b_1, b_2,...] where --- 1 + EGF_B (x) = exp EGF_A (x) -tEXP :: NamedTransform -tEXP = NT "EXP" (\cs -> drop 1 . egfCoeffs $ expSeries 1 `o` egf (0:cs)) - --- LOG converts [a_1, a_2, ...] to [b_1, b_2,...] where --- 1 + EGF_A (x) = exp EGF_B (x) i.e. EGF_B (x) = log(1 + EGF_A (x)). -tLOG :: NamedTransform -tLOG = NT "LOG" (\cs -> drop 1 $ egfCoeffs (log1 `o` (-1 * egf (0:cs)))) - where - log1 = Series (0 : [-1 % n | n <- [1..]]) - -tNEGATE :: NamedTransform -tNEGATE = NT "NEGATE" f where f [] = []; f (c:cs) = c : map negate cs - -tPRODS :: NamedTransform -tPRODS = NT "PRODS" (drop 1 . scanl (*) (1%1)) - -tPSUM :: NamedTransform -tPSUM = NT "PSUM" (drop 1 . scanl (+) (0%1)) - -tPSUMSIGN :: NamedTransform -tPSUMSIGN = NT "PSUMSIGN" (ogfCoeffs . (geoSeries (-1%1) *) . ogf) - -tSTIRLING :: NamedTransform -tSTIRLING = NT "STIRLING" (\cs -> - drop 1 . egfCoeffs $ egf (0:cs) `o` (expSeries (1%1) - 1)) - -tTRISECT0 :: NamedTransform -tTRISECT0 = NT "TRISECT0" trisect0 - -tTRISECT1 :: NamedTransform -tTRISECT1 = NT "TRISECT1" trisect1 - -tTRISECT2 :: NamedTransform -tTRISECT2 = NT "TRISECT2" trisect2 - -tPOINT :: NamedTransform -tPOINT = NT "POINT" (zipWith (*) [0..]) - -tWEIGHT :: NamedTransform -tWEIGHT = NT "WEIGHT" $ - drop 1 . ogfCoeffs . product . zipWith (\n c -> (1 + x^n)^^^c) [1::Int ..] - -increasing :: Ord a => [a] -> Bool -increasing cs = and $ zipWith (<=) cs (drop 1 cs) - -tPARTITION :: NamedTransform -tPARTITION = NT "PARTITION" $ \cs -> do - guard $ not (null cs) && all (>0) cs && increasing cs - let f = product $ map (\c -> 1 - x^^^c) (nub cs) - drop 1 . ogfCoeffs $ 1/f - --- New transform: tSTIELTJES -- continued fraction coefficients - - -transforms :: [NamedTransform] -transforms = - [ tLEFT - , tRIGHT - , tM2 - , tM2i - , tBINOMIAL - , tBINOMIALi - , tBIN1 - , tBISECT0 - , tBISECT1 - , tCONV - , tCONVi - , tEXPCONV - , tDIFF - , tMOBIUS - , tMOBIUSi - , tEULER --- , tEULERi - , tEXP - , tLOG - , tNEGATE - , tPRODS - , tPSUM - , tPSUMSIGN - , tSTIRLING - , tTRISECT0 - , tTRISECT1 - , tTRISECT2 - , tPOINT - , tWEIGHT - , tPARTITION - ] - -lookupTranform :: String -> Maybe NamedTransform -lookupTranform tname = lookup tname [ (name f, f) | f <- transforms ] - -applyAllTransforms :: [Rational] -> [(NamedTransform, [Rational])] -applyAllTransforms cs = [ (f, eval f cs) | f <- transforms ] diff --git a/Sloane/Utils.hs b/Sloane/Utils.hs new file mode 100644 --- /dev/null +++ b/Sloane/Utils.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Copyright : Anders Claesson 2015 +-- Maintainer : Anders Claesson +-- License : BSD-3 +-- + +module Sloane.Utils + ( pad + , parens + , oneOf + , chainl1 + , parse_ + ) where + +import Data.Monoid +import qualified Data.ByteString.Char8 as B +import Data.ByteString.Char8 (ByteString) +import Data.Attoparsec.ByteString.Char8 +import Control.Applicative + + +-- | @pad d n@ packs the integer @n@ into a `ByteString` padding with +-- \'0\' on the right to achieve length @d@. +-- +-- > pad 6 123 = "000123" +-- +pad :: Int -> Int -> ByteString +pad d n = B.replicate (d - B.length s) '0' <> s where s = B.pack (show n) + +-- | Parse @p@ enclosed in parenthesis. +parens :: Parser a -> Parser a +parens p = string "(" *> p <* string ")" + +-- | Parse one of the words in the given `ByteString`. +oneOf :: ByteString -> Parser ByteString +oneOf s = choice (map string (B.words s)) + +-- | Parse one or more occurrences of @p@, separated by an operator. +-- Returns a value obtained by a left associative application. +chainl1 :: (Monad f, Alternative f) => f a -> f (a -> a -> a) -> f a +chainl1 p op = p >>= rest + where + rest a = do { f <- op; b <- p; rest $! f a b } <|> pure a + +-- | Run a parser. +parse_ :: Parser t -> ByteString -> Maybe t +parse_ f = either (const Nothing) Just . parseOnly f diff --git a/sloane.1 b/sloane.1 --- a/sloane.1 +++ b/sloane.1 @@ -1,156 +1,73 @@ -.TH "SLOANE" "1" "7 Jan 2015" "Sloane User Manual" "Version 2.0.4" +.TH "SLOANE" "1" "18 Aug 2015" "User Manual" "Version 4.0.0" .SH NAME .PP -sloane \- a command line interface to Sloane\[aq]s On\-Line Encyclopedia -of Integer Sequences +sloane: A command line interface to Sloane\[aq]s OEIS. .SH SYNOPSIS .PP -sloane [\-a|\-\-all] [\-k KEYS] [\-n N] [\-\-url] [\-\-local] TERMS... -.PP -sloane \-A NUMBER -.PP -sloane \-\-filter [\-\-invert] -.PP -sloane \-\-transform NAME -.PP -sloane (\-\-list\-transforms | \-\-update | \-\-version | \-\-help) +\f[B]sloane\f[] OPTIONS \-\-oeis TERMS... +.PD 0 +.P +.PD +\f[B]sloane\f[] OPTIONS (\-q|\-\-query) A\-NUMBER/SEQUENCE... +.PD 0 +.P +.PD +\f[B]sloane\f[] [\-\-invert] \-\-filter .SH DESCRIPTION .PP -The \f[C]sloane\f[] command searches Sloane\[aq]s On\-Line Encyclopedia -of Integer Sequences (OEIS). -The search terms are typically the leading term of a sequence. -For example, -.IP -.nf -\f[C] -sloane\ 1,1,2,5,15,52,203,877,4140 -\f[] -.fi -.PP -returns entry A000110 (Bell numbers), and four more entries. -One can also search by sequence id (A\-number), or even search for -arbitrary words. -See the \f[B]EXAMPLES\f[] section. -.PP -Alternatively, using the \f[C]\-\-local\f[] option, the search can be -done locally against a downloaded local database of known sequences. -This mode works by "grepping" for the query in the sequence field. -.PP -To check a large number of sequences one can use \f[C]\-\-filter\f[]. -When this option is set, \f[C]sloane\f[] reads the standard input -line\-by\-line, if the sequence read is in the local database, then it -is returned to the standard output; if not, it is ignored. -This way one can quickly filter out the sequences from the input that -are in the local database. -In other words, assuming that \f[I]FILE\f[] contains one sequence per -line, -.IP -.nf -\f[C] -sloane\ \-\-filter\ . -.RS -.RE -.TP -.B \-\-list\-transforms -List the names of all transforms. +Fetch at most this many entries (default: 5). .RS .RE .TP -.B \-\-update -Update the local database. +.B \-\-all +Fetch all matching entries (equivalent to \-n 999999). .RS .RE .TP -.B \-\-version -Print version information. +.B \-\-monochrome +Do not colorize the output. +Useful when piping the output to another program. .RS .RE .TP -.B \-\-help -Briefly describe the available options. +.B \-\-json +Output results is JSON format. .RS .RE -.SH EXAMPLES +.SS Examples .PP The most common search is for entries matching a sequence of consecutive terms: .IP .nf \f[C] -sloane\ 1,3,19,183,2371,38703 +sloane\ \-\-oeis\ 1,3,19,183,2371,38703 \f[] .fi .PP @@ -171,7 +88,7 @@ .IP .nf \f[C] -sloane\ \-k\ SNCF\ id:A006531 +sloane\ \-k\ SNCF\ \-\-oeis\ id:A006531 \f[] .fi .PP @@ -179,47 +96,116 @@ .IP .nf \f[C] -sloane\ \-n\ 3\ "(2+2)\-free\ posets" +sloane\ \-n\ 3\ \-\-oeis\ "(2+2)\-free\ posets" \f[] .fi .PP -To view the full entries of these 3 results in a browser (e.g., Firefox) -one can use the url option: +Sloane normally crops long lines to fit the widths of the terminal. +If this is unwanted, pipe the output through cat or less: .IP .nf \f[C] -firefox\ `sloane\ \-\-url\ \-n\ 3\ "(2+2)\-free\ posets"` +sloane\ \-\-long\ \-\-oeis\ id:A000110\ |\ less\ \-R \f[] .fi +.SH OPERATION \-\-query +.SS Synopsis .PP -To retrieve sequence A022493 from the local database use the -\f[C]\-A\f[] option: +sloane [\-\-long] [\-k KEYS] [\-n N] [\-\-all] [\-\-monochrome] +[\-\-json] (\-q|\-\-query) A\-NUMBER/SEQUENCE... +.SS Description +.PP +Search locally against a downloaded local database of known sequences. +This type of query is less flexible, but faster, than using the +\f[C]\-\-oeis\f[] operation: With \f[C]sloane\ \-\-query\f[] one can +only lookup A\-numbers and seqences; free text searches are not +supported. +Also, the fields returned by \f[C]sloane\ \-\-query\f[] are \[aq]S\[aq] +and \[aq]N\[aq]. +.SS Examples +.PP +Lookup A\-numbers: .IP .nf \f[C] -sloane\ \-A022493 +$\ sloane\ \-\-query\ A000111\ A000112 + +S\ A000111\ 1,1,1,2,5,16,61,272,1385,7936,50521,353792,2702765, +N\ A000111\ Euler\ or\ up/down\ numbers:\ e.g.f.\ sec(x)\ +\ tan(x).. + +S\ A000112\ 1,1,2,5,16,63,318,2045,16999,183231,2567284,46749427, +N\ A000112\ Number\ of\ partially\ ordered\ sets\ ("posets")\ with\ n.. \f[] .fi .PP -In the final example the local database is used to filter out sequences -from the standard input that are in OEIS: +Lookup a sequence: .IP .nf \f[C] -sloane\ \-\-filter\ <. @@ -256,13 +242,13 @@ .fi .SH NOTES .PP -Please use this program with moderation as not to overburden the -OEIS\-server; see OEIS\[aq] policy on searching the database: +Please use the \f[C]\-\-oeis\f[] option with moderation as not to +overburden the OEIS\-server; see OEIS\[aq] policy on searching the +database: . .SH SEE ALSO .PP -The sloane source code may be downloaded from -. + .SH AUTHOR .PP Anders Claesson diff --git a/sloane.cabal b/sloane.cabal --- a/sloane.cabal +++ b/sloane.cabal @@ -1,10 +1,10 @@ Name: sloane -Version: 2.0.5 -Synopsis: A command line interface to Sloane's On-Line Encyclopedia - of Integer Sequences -Description: A command line interface to Sloane's On-Line Encyclopedia - of Integer Sequences. For usage see - . +Version: 4.0.0 +Synopsis: A command line interface to Sloane's OEIS. + +Description: A command line interface to Sloane's On-Line Encyclopedia of + Integer Sequences with offline capabilities. + Homepage: http://github.com/akc/sloane License: BSD3 License-file: LICENSE @@ -22,23 +22,33 @@ Executable sloane Main-is: sloane.hs - Other-Modules: Sloane.DB + + Other-Modules: Sloane.Bloom Sloane.Config - Sloane.GF - Sloane.Transform - ghc-options: -Wall - Build-depends: base >=3 && <5, - containers >=0.5, - optparse-applicative >=0.10.0, - download-curl >= 0.1.4, - HTTP >=4000.0.9, - cereal >=0.4, - network >=2.4, - bytestring >=0.9, - text >=0.11, + Sloane.DB + Sloane.Download + Sloane.Entry + Sloane.OEIS + Sloane.Options + Sloane.Utils + + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-missing-signatures + + Build-depends: aeson >=0.8, ansi-terminal >=0.6, - terminal-size >=0.2, - filepath >=1.3, + attoparsec >=0.11, + base >=4 && <5, + bloomfilter >=2.0, + bytestring >=0.10, + conduit >=1, + conduit-extra >=1, + containers >=0.5, directory >=1.2, - zlib >=0.5, - stringsearch >=0.3.0 + filepath >=1.3, + http-conduit >=2, + http-types >=0.8, + optparse-applicative >=0.10, + stringsearch >=0.3, + terminal-size >=0.2, + text >=0.11, + transformers >=0.3 diff --git a/sloane.hs b/sloane.hs --- a/sloane.hs +++ b/sloane.hs @@ -1,179 +1,210 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + -- | -- Copyright : Anders Claesson 2012-2015 -- Maintainer : Anders Claesson -- License : BSD-3 -- -import Data.List (intercalate) -import Data.Maybe (maybeToList) -import Data.Monoid -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as Ch8 -import System.IO (isEOF) -import Network.HTTP (urlEncodeVars) -import Network.Curl.Download (openURI) -import Options.Applicative -import Sloane.Config -import Sloane.DB (DB, ANumber, Seq) -import qualified Sloane.DB as DB -import Sloane.Transform +module Main (main) where -type URL = String +import Data.List +import Data.Aeson +import Data.Bits (xor) +import Data.Maybe +import Data.Monoid +import Data.Map (Map, (!)) +import qualified Data.Map as M +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text as T +import qualified Data.Text.IO as IO +import Control.Applicative +import Control.Monad +import System.Directory +import System.Console.ANSI +import System.IO +import Sloane.OEIS +import Sloane.Entry +import Sloane.Options +import Sloane.Config +import Sloane.Download +import Sloane.Bloom +import Sloane.DB -data Options = Options - { full :: Bool -- Print all fields? - , keys :: String -- Keys of fields to print - , limit :: Int -- Fetch at most this many entries - , url :: Bool -- Print URLs of found entries - , local :: Bool -- Lookup in local DB - , anumber :: Int -- Get the sequence with this number from the local DB - , filtr :: Bool -- Filter out sequences in local DB - , invert :: Bool -- Return sequences NOT in DB - , transform :: String -- Apply the named transform - , listTransforms :: Bool -- List the names of all transforms - , update :: Bool -- Updated local DB - , version :: Bool -- Show version info - , terms :: [String] -- Search terms - } +nameVer = "sloane 4.0.0" :: String +oeisURL = "https://oeis.org/search" :: URL +strpdURL = "https://oeis.org/stripped.gz" :: URL +namesURL = "https://oeis.org/names.gz" :: URL -oeisKeys :: String -oeisKeys = "ISTUVWXNDHFYAOEeptoKC" -- Valid OEIS keys +type Query = B.ByteString +type Width = Int +type Limit = Int +type View = (Width, Palette, [Key]) -oeisUrls :: Config -> DB -> [URL] -oeisUrls cfg = map ((oeisHost cfg ++) . Ch8.unpack) . DB.aNumbers +data QA = QA Query [Reply] -oeisLookup :: Options -> Config -> IO DB -oeisLookup opts cfg = - (DB.parseOEISEntries . either error id) <$> - openURI (oeisURL cfg ++ "&" ++ urlEncodeVars [("n", show n), ("q", q)]) - where - n = limit opts - q = unwords $ terms opts +instance ToJSON QA where + toJSON (QA q rs) = + object [ "query" .= String (decodeUtf8 q) + , "reply" .= toJSON rs + ] -grepDB :: Options -> DB -> DB -grepDB opts = DB.take n . DB.grep (Ch8.pack q) - where - n = limit opts - q = intercalate "," (terms opts) +data Input + = SearchLocalDB (DB Sequences) (DB Names) Bool Limit View [Either ANum PackedSeq] + | SearchOEIS Bool Limit View String + | FilterSeqs (DB Sequences) Bool [PackedEntry] + | UpdateDBs FilePath FilePath FilePath + | Empty -applyTransform :: Options -> String -> IO () -applyTransform opts tname = - case lookupTranform tname of - Nothing -> error "No transform with that name" - Just f -> case f $$ input of - [] -> return () - cs -> putStrLn (showSeq cs) - where - tr c = if c `elem` ";," then ' ' else c - input = map read (words (map tr (unwords (terms opts)))) +data Output + = OEISReplies View [QA] + | OEISRepliesJSON [QA] + | Entries [PackedEntry] + | NOP -dropComment :: ByteString -> ByteString -dropComment = Ch8.takeWhile (/= '#') +nonEmptyLines :: BL.ByteString -> [B.ByteString] +nonEmptyLines = map BL.toStrict . filter (not . BL.null) . BL.lines -showSeq :: [Integer] -> String -showSeq = intercalate "," . map show +readStdin :: IO [B.ByteString] +readStdin = nonEmptyLines <$> BL.getContents -mkSeq :: ByteString -> Seq -mkSeq = Ch8.intercalate (Ch8.pack ",") . Ch8.words . clean . dropComment - where - clean = Ch8.filter (`elem` " 0123456789-") . Ch8.map tr - tr c = if c `elem` ";," then ' ' else c +readInput :: Options -> Config -> IO Input +readInput opts cfg + | version opts = return Empty -mkANumber :: Int -> ANumber -mkANumber n = let s = show n in Ch8.pack ('A' : replicate (6-length s) '0' ++ s) + | update opts = + return $ UpdateDBs (sloaneDir cfg) (seqDBPath cfg) (namesDBPath cfg) -filterDB :: Options -> DB -> IO [Seq] -filterDB opts db = filter match . parseSeqs <$> Ch8.getContents - where - match q = (if invert opts then id else not) (DB.null $ DB.grep q db) - parseSeqs = filter (not . Ch8.null) . map mkSeq . Ch8.lines + | filtr opts = do + db <- readSeqDB cfg + FilterSeqs db (invert opts) . map parsePackedEntryErr <$> readStdin -optionsParser :: Parser Options -optionsParser = - abortOption ShowHelpText (long "help") <*> (Options - <$> switch - ( short 'a' - <> long "all" - <> help "Print all fields" ) - <*> strOption - ( short 'k' - <> metavar "KEYS" - <> value "SN" - <> help "Keys of fields to print [default: SN]" ) - <*> option auto - ( short 'n' - <> metavar "N" - <> value 5 - <> help "Fetch at most this many entries [default: 5]" ) - <*> switch - ( long "url" - <> help "Print URLs of found entries" ) - <*> switch - ( long "local" - <> help "Use the local database rather than oeis.org" ) - <*> option auto - ( short 'A' - <> metavar "NUMBER" - <> value 0 - <> help "Fetch the sequence with this number from the local database" ) - <*> switch - ( long "filter" - <> help ("Read sequences from stdin and return" - ++ " those that are in the local database") ) - <*> switch - ( long "invert" - <> help ("Return sequences NOT in the database;" - ++ " only relevant when used with --filter") ) - <*> strOption - ( long "transform" - <> metavar "NAME" - <> value "" - <> help "Apply the named transform to input sequence") - <*> switch - ( long "list-transforms" - <> help "List the names of all transforms" ) - <*> switch - ( long "update" - <> help "Update the local database" ) - <*> switch - ( long "version" - <> help "Show version info" ) - <*> many (argument str (metavar "TERMS..."))) + | oeis opts = + return $ SearchOEIS (tojson opts) (limit opts) view (unwords (terms opts)) -search :: (Options -> Config -> IO DB) -> Options -> Config -> IO () -search f opts cfg = f opts cfg >>= put + | query opts = do + sdb <- readSeqDB cfg + ndb <- readNamesDB cfg + let parseInp t = fromMaybe (error "cannot parse input") + $ (Right . getPackedSeq <$> parsePackedEntry t) + <|> (Left <$> parseANum t) + <|> (Right . packSeq . map fromIntegral <$> parseIntegerSeq t) + SearchLocalDB sdb ndb (tojson opts) (limit opts) view . map parseInp + <$> case map B.pack (terms opts) of + [] -> readStdin + ts -> return ts + | otherwise = readInput (opts {query = True}) cfg where - put | url opts = putStr . unlines . oeisUrls cfg - | otherwise = DB.put cfg $ if full opts then oeisKeys else keys opts + view = (termWidth cfg, palette opts, keys opts) -getTerms :: Options -> IO Options -getTerms opts - | dont = return opts - | otherwise = (\xs -> opts {terms = xs}) <$> - case terms opts of - [] -> isEOF >>= \b -> - if b then error ": end of file" - else return <$> getLine - ts -> return ts +few :: [a] -> Bool +few (_:_:_) = False +few _ = True + +allANum :: [QA] -> Bool +allANum= all (\(QA q _) -> B.head q == 'A') + +printReply :: View -> Reply -> IO () +printReply (width, pal, ks) (Reply (ANum anum) (Table table)) = + forM_ (ks `intersect` M.keys table) $ \key -> do + let entry = table ! key + let crop' = crop key (width - 10) + let mono = monochrome pal + forM_ entry $ \line -> do + unless mono $ setSGR [ SetColor Foreground Dull Green ] + putStr [key] + unless mono $ setSGR [ SetColor Foreground Dull Yellow ] + B.putStr $ indent anum + unless mono $ setSGR [] + IO.putStrLn $ indent (crop' (decodeUtf8 line)) where - dont = or [ filtr opts, anumber opts > 0 - , listTransforms opts, update opts - , version opts + indent s = " " <> s + dropLastField = T.reverse . T.dropWhile (/= ',') . T.reverse + cropText f cap s = if cap < T.length s then f cap s else s + crop key = cropText $ \cap s -> + if key `elem` ['S'..'X'] + then dropLastField (T.take cap s) + else T.take (cap-2) s <> ".." + +printOutput :: Output -> IO () +printOutput NOP = return () +printOutput (Entries es) = + forM_ es $ \(PackedEntry (PPrg p) (PSeq s)) -> + B.putStrLn $ p <> " => {" <> s <> "}" + +printOutput (OEISRepliesJSON rss) = mapM_ (BL.putStrLn . encode) rss + +printOutput (OEISReplies view rss) = do + let hideQuery = few rss || allANum rss + let noReplies = null $ concat [ rs | QA _ rs <- rss ] + forM_ (zip [1::Int ..] rss) $ \(i, QA q replies) -> do + unless hideQuery $ do + when (i > 1) $ putStrLn "" + B.putStrLn ("query: " <> q) + forM_ replies $ \r -> do + putStrLn "" + printReply view r + unless noReplies $ putStrLn "" + +-- Construct a list of replies associated with a list of A-numbers. +mkReplies :: Map ANum PackedSeq -> Map ANum Name -> [ANum] -> [Reply] +mkReplies s n anums = + [ Reply k (Table $ M.fromList [('S', [unPSeq (s!k)]), ('N', [n!k])]) + | k <- anums + , M.member k s && M.member k n + ] + +sloane :: Input -> IO Output +sloane inp = + case inp of + + SearchLocalDB sdb ndb jsonflag maxReplies view ts -> do + let sm = M.fromList $ parseStripped (unDB sdb) + let nm = M.fromList $ parseNames (unDB ndb) + let qas = [ QA q (mkReplies sm nm ks) + | (q, ks) <- + [ case t of + Right s@(PSeq r) -> (r, grepN maxReplies s sdb) + Left (ANum anum) -> (anum, [ANum anum]) + | t <- ts + ] + ] + return $ if jsonflag then OEISRepliesJSON qas else OEISReplies view qas + + SearchOEIS jsonflag lim view q -> do + let kvs = [("n", B.pack (show lim)), ("q", B.pack q), ("fmt", "text")] + replies <- requestPage oeisURL kvs + let qas = [QA (B.pack q) (parseReplies replies)] + return $ if jsonflag then OEISRepliesJSON qas else OEISReplies view qas + + FilterSeqs db invFlag es -> do + let bloom = mkBloomFilter db + return $ Entries + [ e | e@(PackedEntry _ s) <- es + , not (B.null (unPSeq s)) + , invFlag `xor` (s `isFactorOf` bloom && not (null (grep s db))) ] + UpdateDBs sloanedir sdbPath ndbPath -> do + createDirectoryIfMissing False sloanedir + let msg1 = "Downloading " ++ strpdURL ++ ": " + let msg2 = "Downloading " ++ namesURL ++ ": " + putStr msg1 >> hFlush stdout + download (length msg1) strpdURL sdbPath >> putStrLn "" + putStr msg2 >> hFlush stdout + download (length msg2) namesURL ndbPath >> putStrLn "" + return NOP + + Empty -> putStrLn nameVer >> return NOP + +-- | Main function and entry point for sloane. main :: IO () main = do - opts <- getTerms =<< execParser (info optionsParser fullDesc) - let tname = transform opts - let anum = anumber opts - let lookupSeq = maybeToList . DB.lookupSeq (mkANumber anum) - let sloane - | version opts = putStrLn . nameVer - | update opts = DB.update - | listTransforms opts = const $ mapM_ (putStrLn . name) transforms - | anum > 0 = \c -> lookupSeq <$> DB.read c >>= mapM_ Ch8.putStrLn - | filtr opts = \c -> DB.read c >>= filterDB opts >>= mapM_ Ch8.putStrLn - | not (null tname) = const $ applyTransform opts tname - | local opts = search (\o cfg -> grepDB o <$> DB.read cfg) opts - | otherwise = search oeisLookup opts - defaultConfig >>= sloane + c <- getConfig + t <- getOptions + readInput t c >>= sloane >>= printOutput