radixtree (empty) → 0.4.0.0
raw patch · 7 files changed
+2292/−0 lines, 7 filesdep +QuasiTextdep +attoparsecdep +basesetup-changed
Dependencies added: QuasiText, attoparsec, base, containers, criterion, deepseq, microlens, mtl, parsers, radixtree, smallcheck, store, tasty, tasty-smallcheck, text, vector
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- bench/Parsing.hs +932/−0
- bench/Search.hs +935/−0
- radixtree.cabal +75/−0
- src/Data/RadixTree.hs +281/−0
- test/Spec.hs +37/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Mike Ledger (c) 2016-2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Parsing.hs view
@@ -0,0 +1,932 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+import Control.DeepSeq+import Criterion.Main+import qualified Data.Attoparsec.Text as A+import Data.List (sortOn)+import qualified Data.RadixTree as R+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Text.QuasiText++parseNaiive :: [Text] -> A.Parser Text+parseNaiive = A.choice . map A.string . sortOn (negate . T.length)++main :: IO ()+main = defaultMain+ [ env (return (source, sourceRadix, sourceRadixCompressed, tests0)) $ \+ ~(src, radix, radix2, tests) ->+ bgroup "attoparsec"+ [ bench "radix" $+ V.foldl' (\() t -> rnf $ A.parseOnly (R.parse radix) t) () `nf` tests+ , bench "radix compressed" $+ V.foldl' (\() t -> rnf $ A.parseOnly (R.parse radix2) t) () `nf` tests+ , bench "naiive" $+ V.foldl' (\() t -> rnf $ A.parseOnly (parseNaiive src) t) () `nf` tests+ ]+ ]++tests0 :: V.Vector Text+tests0 = V.fromList $! T.lines+ "acceleration\n\+ \acceleration, braking or coasting\n\+ \axle\n\+ \AAA\n\+ \2+2 seating\n\+ \long thing that doesn't parse\n\+ \z"++sourceRadixCompressed :: R.CompressedRadixTree+sourceRadixCompressed =+ case R.compressBy (T.concat source) sourceRadix of+ Just ct -> ct+ Nothing -> error "could not compress source"++sourceRadix :: R.RadixTree+sourceRadix = R.fromFoldable source++source :: [Text]+source = T.lines [embed|+%++/-+2+2 seating+A.+AAA+AAR-10A Contoured Coupler+able+able-bodied+AC auxiliary power+accelerating, braking or coasting+acceleration+access+accessible+accessible toilet+accidental operation+accordance+accreditation+accumulate+accuracy+action+activation+active+activities+Adapter Coupling+adjacent+adjust+adverse+air+air pressure+Air Spring+air suspension+aisle+alarm+alerts+aligned+allocated+Alpha-Numeric Trip Codes+alternative+aluminium+announcements+apples+apportioned+appropriate+approval+approved+area calculation+armrests+arrival+ASA standards+asdf+asdff+Asset Information System+assistive listening+attack+audio+Australian+Authorised Crew Member+Authorised Crew Members+authorised personnel+authorised persons+autocoupler electrical connections+automatic+Automatic Coupler+Average+away+axle+Axle Bod+axle box+Axle Box+Axle Load+B.+baby change table+Ballast+Ballast strikes+balr+based+battery+bearings+being+bell+bend+bicycles+blue+body+bodyside+bogie+Bogie+Bogie Conditions+bogies+Bogies+bottom+bounce+bounce test+boundary+brake+brake controller+braking+build quality+button+C.+cab+cable+Cabling and Earth Brush+calculation+call+calls+camera+camera location+cameras+cant+capability+capacity+capital spares+car+Car+cars+Cars+case+casting+cat+Category-1b Train+CCTV+CCTV cameras+CCTV system storage+character+chemical substances+clauses+clear+clearances+climate+climate requirements+closing+coefficient of friction+colour+combined+comfort+Commencement+communication+company+comparable+compared+compatible+complete+completely+components+compressed air+Compressed Air Supply+concurrently+condition+condition+conditions+configuration+connections+connectivity+considering+contact+control+control panels+conversely+converters+cores+Coupling Faces+cover+coverage+covers+cow+cows+crane+crew+crew.+Crew+crew cab door+Crew calls+Crew-Only Accessible Panel+critical+Critical Speed+Crush Load+cubic metres+cups+current+curve stability test+cyclists+D.+damage+damper+data+data storage+date+day+days+dB(A) LpAFmax+DCS 1800 Frequency Band+Dead Mass+decals+deficiency+defined+deflated+deflating+degC+degraded+degrees+degrees of freedom+departure+deployment+design+Design+Design Category C-I+design life+Design Life+destination+detail+details+detection+developed+device+devices+diameter+different+differentiate+direction+direct solar heat transmission+dispatch+distance+Distance+dog+door+doors+doorways+downloadable+draught+draught screen+drawings+drinking fountain+drinking fountains+drinks+driver+Driver+drivers ear+drivers workstation+driving+drop down table+drop down tables+dry conditions+DSAPT+DTS Area Numbers+Duggan Method+E.+ears+Earth Brush+Earth Brush+ease+edge+effluent+egress+EIRENE Functional Numbers+electrical+electrical power+Electric Traction and Brake+electro-dynamic+electromotive force+emergency+emergency brake+Emergency Brakes+Emergency Services+EN 14752+EN 15227+end+End Detrainment System+engagement+enter+envelope+environmental+environmental conditions+Environmental Conditions+equipment+equivalent+etching+ETCS level 2 operation+evacuation+event+event recorder+events+exceptional+Exceptional Payload+Exceptional Pay Load+existing+existing intercity trains+Existing Tanking Facilities+exposed+exterior+external+external passenger information displays+facilities+facility+factor+failure+failures of self-tests should be recorded in the train-borne recorder+fasteners+fault+faults+film+finishes+fire+fire and smoke detection system (NIF_RSS_460).+first+fish+flexible+flood+flooring+floors+following+Forward call to the driver handportable+forward facing+four+four-hour maintenance window+fourth+frame+freedom+freight+freight traffic+fresh air intake dampers+Fresh Air Intake Dampers+From+fruit+full-duplex+funtional+future+g+gangway+gangways+gap+Gavin+Gearbox+gear hanger bracket+generated+geographical location+glass+grabrails+graffiti+green+ground+groups+GSM-R Train radio equipment+GUS+hail stones+handrails+heights+hello+High Speed Boards+high voltage+holding brake+hook+hooks+hoses+hours+Hunter Rail Car+Hunting+identical+identification+identity+image+images+In+incapacitated+incorporates+index+individuals+information+infrared+initial+Initiate automated request+input+inserting+intercar access doors+inter-car connections+intercar jumper+interchangeable+intercom+interface+interior+intermediate+Intermediate Cars+intermittent noises+internal+internal noise+internal passenger information display+internal tonal noise+international standards+internet+interval+intervention+isolated+items+joints+kg+kg/m2+kilo+kilograms+kinematic+km+km/h+kN+ladder+ladders+Landing Edge+lateral+Lathe+Leading Edge+legible+legislation.+length+letters+level+levels+life+lifting+lifting points+line+liner(s)+Line Speed+liquid+list+live OHLE+load+location+Location information+locations+lock+logo+Long Distance Train+Long Train+Long Unit+lower deck+lowered+low-level+luggage+luminous transmittance+m2+magnetic particle testing+Maintainer+Maintainers+maintenance+Maintenance Facility+major+management+manual+manually+manufactured+mass+material+materials+maximum+Maximum+Maximum Design Speed+maximum safe operating speed+Maximum Safe Operating Speed+Maximum Service Speed+MDBF+Mean Comfort Complete Method+mechanical+Mechanical Brakes+medical+medical devices+Medium Electric Outline+member+members+messages+methods+metres+MetroNet Transponder System+minimum+Minimum Operating Standards+minute+minutes+mm+MMT+mobile telecommunication network+mode+More+MOS+Motor Bogie+movements+MTTR+n+name+nearest+network+Network+Network Re-railing facility+new+New+newton+next+night.+NN+noise+nominated MMT tasks+Non-destructive test+non-receptive network+normal+Normal Seats+normal use+NSW Digital Train Radio System (DTRS)+obstruction+occupant+odours+office+OHW Current Draw Limit+OHW Current Limited Zone+OHW Current Return Limit+onboard+one+open+opening+operable+operating+operating speed+operation+operational spares+Operator+OPEX+orange+OSCar+OSCar Motor Bogie+OSCar Trailer Bogie+Other Elastomer components+otherwise+OTR+outlet+output+overhaul+overhead+Overhead Crane+Overhead Power Supply Harmonics+P2 force+pad+pairs+panels+parking brake+passage+passenger+passenger bodyside door+Passenger Bodyside Door+Passenger Bodyside Doors+passenger ears+passenger information system+passenger loading+passengers+passengers ear+passenger services+path+paths+payload+Payload Conditions+Peak Heat Release Rate+performance+performed+permitted+person+persons+photo luminescent+pitch+Plan+planned+platform+platforms+Pneumatic+points+pony bogie+Pony Bogie+portable+portal+position+possible+power+power cable+power distribution panel+practicable+Preparation+pre-recorded+presentation+primary+Primary Controller+Primary Suspension+priority+Priority+procedures+profile+Prohibited Items+protective+proven+provision+psi+public address announcements+public address system+push-button+quality+Quality Assurance system+radio+Radio faults+radius+rail+Rail Emergency Train Recovery Unit+rail network+Rail Safety National Law+rain+raised+rate+ready+real time+real-time+rear+rear pasenger door+recessed region+recorder+recovered+recovery+recovery.+rectification+red+reduce+Reference Masses+reflectance+regenerative mode+rejection+relevant+remain+remote+remotely+removable+required+requirement+requirements+re-railing+reservoir+resonance+restraints+results+RETRU+rheostatic mode+ride+Ride Comfort Index+robust interior fittings+route+rows+running+running times+safe+safe operating speed+Safety Device+Safety Management System+saloon+Scharfenberg Type-10 Coupler+schedule+Schedule of Finishes+scratching+screens+sdfsdf+seat+seated+seating+seats+second+Secondary+seconds+Section 13.3.2.2 of AS 7533.3+Section-2-1-1-3+Section 4.1.1.1 of EN 14752+Section 5.2.1.4 of EN 14752+Section 6.5 of GM/RT 2100+Section-8.3+secure+securing mechanism+Selective Door Operation+separation+service+Serviceable+Service Type B+servicing+shear+shear pad casting+Short Train+Short Unit+side+sides+sign+signage+signs+similar+simultaneous+situations+slip resistant surfaces+slogan+smart card+smart cards+socket+solution+sound+spaces+spare+special tools+specific+specification+speech transmission index+speed+speeding+spreader+spreader beam+spring+stable+staff members+stakeholder+standard+standard toilet+standees+standing+Standing Area+Standing Area Calculation+Standing Passenger Density+startup+static+Static Rolling Stock Outline+station+stationary+status+steps+stiffness+stopping+Stopping Pattern+storage+stove+strategy+strength+stretcher+subsystem+sub-system+sub-systems+suitable+sunlight+super+supplier+Supplier+surface+surface finish+surfing+suspension+Suspension+suspensions+Sustained+swept path+Sydney Trains+Sydney Trains Washplants+synchronised+system+systems+table+tailored+tampering+tangent+tanks+TBD+temperature+Terminal End+termination+test+Test Routes+tests+text+TfNSW+TfNSW+TfNSW External Livery Principles for 'NSW Trains'+TfNSW Internal Decal Approach for 'Trains' or 'NSW Trains'+than+third+third party freight services+through+T HR RS 00100 ST+T HR RS 08001 ST+T HR RS 12001 ST+T HR TE 41001+T HR TE 41002+T HR TE 81001+T HR TE 81002+time+Timetable+Timetable.+Tip Up Seats+TMS+T MU RS 01000 ST for P-II vehicles+toilet+toilets+tolerances+ton+tonnes+total solar energy rejection+track+Track+track cant deficiency+Track Gauge+traction+traction equipment+Traction Motor+traffic+Trailer Bogie+trailing edge+Trailing Edge+train+train+Train+Train Controller+Train Management System+Train Protection and Security+trains+transmission+transverse+transverse seats+travel+trespasser+Trip Codes+Trip Gear+tunnels+tyjhgdyfhukfhk+ultrasonic testing+underframe+unique car identification+Unit+unloading+unrestricted+update+upper deck+upright+USB socket+use+used+user decisions+user groups+users+UV+VAC+vandalism+vehicle+Vehicle Body+vehicles+vertical+vestibule+vision impairment+visual and audible alarm+volume+warning+warranty spares+washplant+waste+water+weather conditions+weekday+weld+Weld+Welding+weld quality+wet conditions+wheel+Wheel+wheelchair+wheelchairs+wheel-rail adhesion modifiers+wheel slide+wheel slip+width+window+windowr+windows+wire+work+workshop+Workstation+worn+xxxx1+yaw+year+years+yellow|]+
+ bench/Search.hs view
@@ -0,0 +1,935 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+import Control.DeepSeq+import Criterion.Main+import qualified Data.Attoparsec.Text as A+import qualified Data.RadixTree as R+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Text.QuasiText++searchNaiive :: [Text] -> Text -> [Text]+searchNaiive src t = go src+ where+ go [] = []+ go (x:xs) =+ if x `T.isInfixOf` t+ then x : go xs+ else go xs++main :: IO ()+main = defaultMain+ [ env (return (source, sourceRadixCompressed, tests0)) $ \+ ~(src, radix, tests) ->+ bgroup "search"+ [ bench "radixtree" $+ V.foldl' (\() t -> rnf $ A.parseOnly (R.search radix) t) () `nf` tests+ , bench "repeated isInfixOf" $+ V.foldl' (\() t -> rnf $ searchNaiive src t) () `nf` tests+ ]+ ]++tests0 :: V.Vector Text+tests0 = V.fromList $! T.lines+ "acceleration\n\+ \acceleration, braking or coasting\n\+ \axle\n\+ \AAA\n\+ \2+2 seating\n\+ \long thing that doesn't parse\n\+ \z"++sourceRadixCompressed :: R.CompressedRadixTree+sourceRadixCompressed =+ case R.compressBy (T.concat source) sourceRadix of+ Just ct -> ct+ Nothing -> error "could not compress source"++sourceRadix :: R.RadixTree+sourceRadix = R.fromFoldable source++source :: [Text]+source = T.lines [embed|+%++/-+2+2 seating+A.+AAA+AAR-10A Contoured Coupler+able+able-bodied+AC auxiliary power+accelerating, braking or coasting+acceleration+access+accessible+accessible toilet+accidental operation+accordance+accreditation+accumulate+accuracy+action+activation+active+activities+Adapter Coupling+adjacent+adjust+adverse+air+air pressure+Air Spring+air suspension+aisle+alarm+alerts+aligned+allocated+Alpha-Numeric Trip Codes+alternative+aluminium+announcements+apples+apportioned+appropriate+approval+approved+area calculation+armrests+arrival+ASA standards+asdf+asdff+Asset Information System+assistive listening+attack+audio+Australian+Authorised Crew Member+Authorised Crew Members+authorised personnel+authorised persons+autocoupler electrical connections+automatic+Automatic Coupler+Average+away+axle+Axle Bod+axle box+Axle Box+Axle Load+B.+baby change table+Ballast+Ballast strikes+balr+based+battery+bearings+being+bell+bend+bicycles+blue+body+bodyside+bogie+Bogie+Bogie Conditions+bogies+Bogies+bottom+bounce+bounce test+boundary+brake+brake controller+braking+build quality+button+C.+cab+cable+Cabling and Earth Brush+calculation+call+calls+camera+camera location+cameras+cant+capability+capacity+capital spares+car+Car+cars+Cars+case+casting+cat+Category-1b Train+CCTV+CCTV cameras+CCTV system storage+character+chemical substances+clauses+clear+clearances+climate+climate requirements+closing+coefficient of friction+colour+combined+comfort+Commencement+communication+company+comparable+compared+compatible+complete+completely+components+compressed air+Compressed Air Supply+concurrently+condition+condition+conditions+configuration+connections+connectivity+considering+contact+control+control panels+conversely+converters+cores+Coupling Faces+cover+coverage+covers+cow+cows+crane+crew+crew.+Crew+crew cab door+Crew calls+Crew-Only Accessible Panel+critical+Critical Speed+Crush Load+cubic metres+cups+current+curve stability test+cyclists+D.+damage+damper+data+data storage+date+day+days+dB(A) LpAFmax+DCS 1800 Frequency Band+Dead Mass+decals+deficiency+defined+deflated+deflating+degC+degraded+degrees+degrees of freedom+departure+deployment+design+Design+Design Category C-I+design life+Design Life+destination+detail+details+detection+developed+device+devices+diameter+different+differentiate+direction+direct solar heat transmission+dispatch+distance+Distance+dog+door+doors+doorways+downloadable+draught+draught screen+drawings+drinking fountain+drinking fountains+drinks+driver+Driver+drivers ear+drivers workstation+driving+drop down table+drop down tables+dry conditions+DSAPT+DTS Area Numbers+Duggan Method+E.+ears+Earth Brush+Earth Brush+ease+edge+effluent+egress+EIRENE Functional Numbers+electrical+electrical power+Electric Traction and Brake+electro-dynamic+electromotive force+emergency+emergency brake+Emergency Brakes+Emergency Services+EN 14752+EN 15227+end+End Detrainment System+engagement+enter+envelope+environmental+environmental conditions+Environmental Conditions+equipment+equivalent+etching+ETCS level 2 operation+evacuation+event+event recorder+events+exceptional+Exceptional Payload+Exceptional Pay Load+existing+existing intercity trains+Existing Tanking Facilities+exposed+exterior+external+external passenger information displays+facilities+facility+factor+failure+failures of self-tests should be recorded in the train-borne recorder+fasteners+fault+faults+film+finishes+fire+fire and smoke detection system (NIF_RSS_460).+first+fish+flexible+flood+flooring+floors+following+Forward call to the driver handportable+forward facing+four+four-hour maintenance window+fourth+frame+freedom+freight+freight traffic+fresh air intake dampers+Fresh Air Intake Dampers+From+fruit+full-duplex+funtional+future+g+gangway+gangways+gap+Gavin+Gearbox+gear hanger bracket+generated+geographical location+glass+grabrails+graffiti+green+ground+groups+GSM-R Train radio equipment+GUS+hail stones+handrails+heights+hello+High Speed Boards+high voltage+holding brake+hook+hooks+hoses+hours+Hunter Rail Car+Hunting+identical+identification+identity+image+images+In+incapacitated+incorporates+index+individuals+information+infrared+initial+Initiate automated request+input+inserting+intercar access doors+inter-car connections+intercar jumper+interchangeable+intercom+interface+interior+intermediate+Intermediate Cars+intermittent noises+internal+internal noise+internal passenger information display+internal tonal noise+international standards+internet+interval+intervention+isolated+items+joints+kg+kg/m2+kilo+kilograms+kinematic+km+km/h+kN+ladder+ladders+Landing Edge+lateral+Lathe+Leading Edge+legible+legislation.+length+letters+level+levels+life+lifting+lifting points+line+liner(s)+Line Speed+liquid+list+live OHLE+load+location+Location information+locations+lock+logo+Long Distance Train+Long Train+Long Unit+lower deck+lowered+low-level+luggage+luminous transmittance+m2+magnetic particle testing+Maintainer+Maintainers+maintenance+Maintenance Facility+major+management+manual+manually+manufactured+mass+material+materials+maximum+Maximum+Maximum Design Speed+maximum safe operating speed+Maximum Safe Operating Speed+Maximum Service Speed+MDBF+Mean Comfort Complete Method+mechanical+Mechanical Brakes+medical+medical devices+Medium Electric Outline+member+members+messages+methods+metres+MetroNet Transponder System+minimum+Minimum Operating Standards+minute+minutes+mm+MMT+mobile telecommunication network+mode+More+MOS+Motor Bogie+movements+MTTR+n+name+nearest+network+Network+Network Re-railing facility+new+New+newton+next+night.+NN+noise+nominated MMT tasks+Non-destructive test+non-receptive network+normal+Normal Seats+normal use+NSW Digital Train Radio System (DTRS)+obstruction+occupant+odours+office+OHW Current Draw Limit+OHW Current Limited Zone+OHW Current Return Limit+onboard+one+open+opening+operable+operating+operating speed+operation+operational spares+Operator+OPEX+orange+OSCar+OSCar Motor Bogie+OSCar Trailer Bogie+Other Elastomer components+otherwise+OTR+outlet+output+overhaul+overhead+Overhead Crane+Overhead Power Supply Harmonics+P2 force+pad+pairs+panels+parking brake+passage+passenger+passenger bodyside door+Passenger Bodyside Door+Passenger Bodyside Doors+passenger ears+passenger information system+passenger loading+passengers+passengers ear+passenger services+path+paths+payload+Payload Conditions+Peak Heat Release Rate+performance+performed+permitted+person+persons+photo luminescent+pitch+Plan+planned+platform+platforms+Pneumatic+points+pony bogie+Pony Bogie+portable+portal+position+possible+power+power cable+power distribution panel+practicable+Preparation+pre-recorded+presentation+primary+Primary Controller+Primary Suspension+priority+Priority+procedures+profile+Prohibited Items+protective+proven+provision+psi+public address announcements+public address system+push-button+quality+Quality Assurance system+radio+Radio faults+radius+rail+Rail Emergency Train Recovery Unit+rail network+Rail Safety National Law+rain+raised+rate+ready+real time+real-time+rear+rear pasenger door+recessed region+recorder+recovered+recovery+recovery.+rectification+red+reduce+Reference Masses+reflectance+regenerative mode+rejection+relevant+remain+remote+remotely+removable+required+requirement+requirements+re-railing+reservoir+resonance+restraints+results+RETRU+rheostatic mode+ride+Ride Comfort Index+robust interior fittings+route+rows+running+running times+safe+safe operating speed+Safety Device+Safety Management System+saloon+Scharfenberg Type-10 Coupler+schedule+Schedule of Finishes+scratching+screens+sdfsdf+seat+seated+seating+seats+second+Secondary+seconds+Section 13.3.2.2 of AS 7533.3+Section-2-1-1-3+Section 4.1.1.1 of EN 14752+Section 5.2.1.4 of EN 14752+Section 6.5 of GM/RT 2100+Section-8.3+secure+securing mechanism+Selective Door Operation+separation+service+Serviceable+Service Type B+servicing+shear+shear pad casting+Short Train+Short Unit+side+sides+sign+signage+signs+similar+simultaneous+situations+slip resistant surfaces+slogan+smart card+smart cards+socket+solution+sound+spaces+spare+special tools+specific+specification+speech transmission index+speed+speeding+spreader+spreader beam+spring+stable+staff members+stakeholder+standard+standard toilet+standees+standing+Standing Area+Standing Area Calculation+Standing Passenger Density+startup+static+Static Rolling Stock Outline+station+stationary+status+steps+stiffness+stopping+Stopping Pattern+storage+stove+strategy+strength+stretcher+subsystem+sub-system+sub-systems+suitable+sunlight+super+supplier+Supplier+surface+surface finish+surfing+suspension+Suspension+suspensions+Sustained+swept path+Sydney Trains+Sydney Trains Washplants+synchronised+system+systems+table+tailored+tampering+tangent+tanks+TBD+temperature+Terminal End+termination+test+Test Routes+tests+text+TfNSW+TfNSW+TfNSW External Livery Principles for 'NSW Trains'+TfNSW Internal Decal Approach for 'Trains' or 'NSW Trains'+than+third+third party freight services+through+T HR RS 00100 ST+T HR RS 08001 ST+T HR RS 12001 ST+T HR TE 41001+T HR TE 41002+T HR TE 81001+T HR TE 81002+time+Timetable+Timetable.+Tip Up Seats+TMS+T MU RS 01000 ST for P-II vehicles+toilet+toilets+tolerances+ton+tonnes+total solar energy rejection+track+Track+track cant deficiency+Track Gauge+traction+traction equipment+Traction Motor+traffic+Trailer Bogie+trailing edge+Trailing Edge+train+train+Train+Train Controller+Train Management System+Train Protection and Security+trains+transmission+transverse+transverse seats+travel+trespasser+Trip Codes+Trip Gear+tunnels+tyjhgdyfhukfhk+ultrasonic testing+underframe+unique car identification+Unit+unloading+unrestricted+update+upper deck+upright+USB socket+use+used+user decisions+user groups+users+UV+VAC+vandalism+vehicle+Vehicle Body+vehicles+vertical+vestibule+vision impairment+visual and audible alarm+volume+warning+warranty spares+washplant+waste+water+weather conditions+weekday+weld+Weld+Welding+weld quality+wet conditions+wheel+Wheel+wheelchair+wheelchairs+wheel-rail adhesion modifiers+wheel slide+wheel slip+width+window+windowr+windows+wire+work+workshop+Workstation+worn+xxxx1+yaw+year+years+yellow|]+
+ radixtree.cabal view
@@ -0,0 +1,75 @@+name: radixtree+version: 0.4.0.0+description: A prefix-tree parsing library+homepage: https://gitlab.com/transportengineering/radixtree+license: BSD3+license-file: LICENSE+author: Mike Ledger+maintainer: mike@quasimal.com+copyright: 2018 Mike Ledger+category: Web+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.RadixTree+ build-depends: base >= 4.7 && < 5+ , containers >= 0.5+ , vector+ , text+ , deepseq+ , microlens+ , parsers >= 0.12+ , store >= 0.4+ , mtl >= 2.0+ default-language: Haskell2010++benchmark radixtree-parsing+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Parsing.hs+ ghc-options: -O2+ build-depends: base+ , radixtree+ , text+ , QuasiText+ , criterion+ , attoparsec+ , deepseq+ , vector+ default-language: Haskell2010+++benchmark radixtree-search+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Search.hs+ ghc-options: -O2+ build-depends: base+ , radixtree+ , text+ , QuasiText+ , criterion+ , attoparsec+ , deepseq+ , vector+ default-language: Haskell2010++test-suite radixtree-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , radixtree+ , attoparsec+ , smallcheck+ , tasty+ , tasty-smallcheck+ , text+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://gitlab.com/tranpsortengineering/radixtree
+ src/Data/RadixTree.hs view
@@ -0,0 +1,281 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.RadixTree+ ( RadixTree (..)+ , RadixNode (..)+ , CompressedRadixTree+ -- * Construction+ , fromFoldable+ , compressBy+ -- * Parsing with radix trees+ , RadixParsing (..)+ , search+ ) where+import Control.Applicative+import Control.DeepSeq+import Data.Data (Data, Typeable)+import Data.Foldable (asum, foldr', toList)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.Monoid+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Store ()+import Data.Store.TH (makeStore)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Array as TI (Array)+import qualified Data.Text.Internal as TI (Text (..), text)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Lens.Micro+import Text.Parser.Char (CharParsing (anyChar, text))+import Text.Parser.Combinators (Parsing (try))++--------------------------------------------------------------------------------+-- Stuff to help construct RadixTrees+--+-- I'm not clever enough to write a function to go directly from a 'Foldable' to+-- a fully-optimised RadixTree. Instead, I generate a prefix-tree using a 'Map'+-- directly ('Trie'), and then gradually compress that ('CompressedTrie') before+-- packing the final result into an efficient structure using 'Text' nodes.+--+-- TODO:+-- - generate RadixTree directly, instead of going through 'Trie'/'CompressedTrie'+-- - use compact regions?++data PrefixNode a = Accept !Text !a | Skip !a+ deriving (Show, Eq)++newtype Trie = Trie (PrefixNode (Map Char Trie))+ deriving (Show, Eq)++newtype CompressedTrie = CompressedTrie (PrefixNode (Map (Seq Char) CompressedTrie))+ deriving (Show, Eq)++{-# INLINE node #-}+node :: Lens (PrefixNode a) (PrefixNode b) a b+node = lens+ (\x -> case x of { Accept _ t -> t; Skip t -> t })+ (\x a -> case x of { Accept l _ -> Accept l a; Skip _ -> Skip a })++leaf :: Text -> Text -> Trie+leaf ft t = go (T.unpack t)+ where+ go (x:xs) = Trie (Skip (M.singleton x (go xs)))+ go [] = Trie (Accept ft M.empty)++insert :: Text -> Text -> Trie -> Trie+insert ft text' (Trie n) = case T.uncons text' of+ Just (c, cs) -> Trie ((node %~+ M.insertWith+ (\_ orig -> Data.RadixTree.insert ft cs orig)+ c+ (leaf ft cs)) n)+ Nothing ->+ Trie (n^.node.to (Accept ft))++makeCompressable :: Trie -> CompressedTrie+makeCompressable (Trie n) = CompressedTrie (+ over node (M.map makeCompressable . M.mapKeysMonotonic Seq.singleton) n)++compress :: Trie -> CompressedTrie+compress = go . makeCompressable+ where+ go :: CompressedTrie -> CompressedTrie+ go (CompressedTrie n) = case n of+ Accept l m -> CompressedTrie (Accept l (M.map go m))+ Skip m -> CompressedTrie (Skip (M.foldMapWithKey compress1 m))++ compress1 :: Seq Char -> CompressedTrie -> Map (Seq Char) CompressedTrie+ compress1 k c@(CompressedTrie n) =+ case M.size sm of+ 0 -> M.singleton k c+ 1 | Skip _ <- n -> compress1 (k <> k') sm'+ where (k', sm') = M.findMax sm+ _ -> M.singleton k (go (n & node .~ sm & CompressedTrie))+ where sm = n^.node++--------------------------------------------------------------------------------++-- | A node in a radixtree. To advance from here a parser must parse the 'Text'+-- (i.e., the prefix) value at this node.+data RadixNode = RadixNode {-# UNPACK #-} !Text !RadixTree+ deriving (Eq, Show, Typeable, Data)++-- | A radixtree. Construct with 'fromFoldable', and use with 'parse'.+data RadixTree+ = -- | Can terminate a parser successfully, returning the 'Text' value given.+ RadixAccept+ {-# UNPACK #-} !Text -- the final value to return+ {-# UNPACK #-} !(Vector RadixNode) -- possible subtrees beyond this point+ | RadixSkip+ {-# UNPACK #-} !(Vector RadixNode) -- possible subtrees beyond this point+ deriving (Eq, Show, Typeable, Data)++instance NFData RadixNode where+ {-# INLINE rnf #-}+ rnf (RadixNode l t) = rnf l `seq` rnf t++instance NFData RadixTree where+ {-# INLINE rnf #-}+ rnf (RadixAccept t v) = t `seq` rnf v+ rnf (RadixSkip v) = rnf v++-- | Compress a totally-unoptimised 'Trie' into a nice and easily-parsable+-- 'RadixTree'+fromTrie :: Trie -> RadixTree+fromTrie = go . compress+ where+ !z = V.empty++ radixNode :: Seq Char -> CompressedTrie -> RadixNode+ radixNode l t = RadixNode (T.pack (toList l)) (go t)++ mapToVector :: Map k a -> Vector (k, a)+ mapToVector m = case M.size m of+ 0 -> z+ sz -> V.fromListN sz (M.toList m)++ go :: CompressedTrie -> RadixTree+ go (CompressedTrie n) = case n of+ Accept l m -> RadixAccept l . V.map (uncurry radixNode) . mapToVector $! m+ Skip m -> RadixSkip . V.map (uncurry radixNode) . mapToVector $! m++data TextSlice = TextSlice+ { tsOffset16 :: {-# UNPACK #-} !Int -- ^ offset (in units of Word16)+ , tsLength16 :: {-# UNPACK #-} !Int -- ^ length (in units of Word16)+ }++-- | Probably dangerous magic+--+-- When the second argument is found to be within the first, we re-use the+-- 'Text' array of the first. This should allow the second argument to be+-- garbage collected. This is to improve locality and memory use.+magicallySaveSpaceSometimes :: Text -> Text -> Maybe TextSlice+magicallySaveSpaceSometimes full s@(TI.Text _ _ slen) =+ case T.breakOn s full of+ (TI.Text{}, r@(TI.Text _ remoffs _))+ | T.null r -> Nothing+ | otherwise -> Just TextSlice{tsOffset16 = remoffs, tsLength16 = slen}++-- | A normal 'RadixTree' stores a new 'Text' at every node. In contrast, a+-- 'CompressedRadixTree' takes a single corpus 'Text' which is indexed into by+-- nodes. This can save a lot of memory (e.g., using the radix trees from the+-- parsing benchmarks in this package, the 'CompressedRadixTree' version is+-- 254032 bytes, whereas the ordinary 'RadixTree' is a rotund 709904 bytes) at+-- no runtime cost.+data CompressedRadixTree+ = CompressedRadixTree {-# UNPACK #-} !TI.Array !CompressedRadixTree1++data CompressedRadixTree1+ = CompressedRadixAccept+ {-# UNPACK #-} !TextSlice+ {-# UNPACK #-} !(Vector CompressedRadixNode)+ | CompressedRadixSkip {-# UNPACK #-} !(Vector CompressedRadixNode)++data CompressedRadixNode+ = CompressedRadixNode {-# UNPACK #-} !TextSlice !CompressedRadixTree1++instance NFData CompressedRadixNode where+ {-# INLINE rnf #-}+ rnf (CompressedRadixNode ts t) = ts `seq` rnf t++instance NFData CompressedRadixTree where+ {-# INLINE rnf #-}+ rnf (CompressedRadixTree arr v) = arr `seq` rnf v++instance NFData CompressedRadixTree1 where+ {-# INLINE rnf #-}+ rnf (CompressedRadixAccept ts v) = ts `seq` rnf v+ rnf (CompressedRadixSkip v) = rnf v++-- | Compress a 'RadixTree' given a corpus. All values in the tree be findable+-- within the corpus, though the corpus does not have to necessarily be the+-- direct source of the tree+compressBy :: Text -> RadixTree -> Maybe CompressedRadixTree+compressBy full@(TI.Text arr _ _) rt =+ CompressedRadixTree arr <$> recompressT rt++ where+ magic = magicallySaveSpaceSometimes full++ recompressN :: RadixNode -> Maybe CompressedRadixNode+ recompressN (RadixNode t tree) = CompressedRadixNode <$> magic t <*> recompressT tree++ recompressT :: RadixTree -> Maybe CompressedRadixTree1+ recompressT (RadixSkip v) = CompressedRadixSkip <$> V.mapM recompressN v+ recompressT (RadixAccept t v) = CompressedRadixAccept <$> magic t <*> V.mapM recompressN v++-- | *Slow*+fromFoldable :: Foldable f => f Text -> RadixTree+fromFoldable =+ fromTrie . foldr' (\t -> insert t t) (Trie (Skip M.empty))++makeStore ''RadixNode+makeStore ''RadixTree++--------------------------------------------------------------------------------+-- Parsers from 'RadixTree's++class RadixParsing radixtree where+ parse :: CharParsing m => radixtree -> m Text++{-# INLINE search #-}+-- | Find all occurences of the terms in a 'RadixTree' from this point on. This+-- will consume the entire remaining input. Can lazily produce results (but this+-- depends on your parser).+search :: (Monad m, CharParsing m, RadixParsing radixtree)+ => radixtree -> m [Text]+search r = go+ where+ go =+ (parse r >>= \x -> (x:) <$> go) <|>+ (anyChar >> go) <|>+ return []++instance RadixParsing RadixTree where+ {-# INLINE parse #-}+ -- | Parse from a 'RadixTree'+ parse :: CharParsing m => RadixTree -> m Text+ parse = go+ where+ go r = case r of+ RadixAccept l nodes+ | T.null l -> empty+ | otherwise -> asum (V.map parseRadixNode nodes) <|> pure l+ RadixSkip nodes -> asum (V.map parseRadixNode nodes)++ {-# INLINE parseRadixNode #-}+ parseRadixNode (RadixNode prefix tree)+ | T.null prefix = go tree+ | otherwise = try (text prefix *> go tree)++instance RadixParsing CompressedRadixTree where+ {-# INLINE parse #-}+ -- | Parse from a 'RadixTree'+ parse :: CharParsing m => CompressedRadixTree -> m Text+ parse (CompressedRadixTree arr crt) = go crt+ where+ fromSlice (TextSlice offs len) = TI.text arr offs len++ go r = case r of+ CompressedRadixAccept ts nodes -> case fromSlice ts of+ l | T.null l -> empty+ | otherwise -> asum (V.map parseRadixNode nodes) <|> pure l+ CompressedRadixSkip nodes -> asum (V.map parseRadixNode nodes)++ {-# INLINE parseRadixNode #-}+ parseRadixNode (CompressedRadixNode ts tree) = case fromSlice ts of+ prefix | T.null prefix -> go tree+ | otherwise -> try (text prefix *> go tree)+
+ test/Spec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Data.Attoparsec.Text+import Data.Coerce+import Data.List (sortOn)+import qualified Data.RadixTree as R+import qualified Data.Text as T+import Test.SmallCheck+import Test.SmallCheck.Series+import Test.Tasty+import Test.Tasty.SmallCheck++sortOnLengthDesc :: [T.Text] -> [T.Text]+sortOnLengthDesc = sortOn (negate . T.length)++naiiveSameAsRadix :: Monad m => Bool -> Property m+naiiveSameAsRadix doCompress =+ forAll $ \(alternativesS :: NonEmpty (NonEmpty Char)) ->+ let+ alternatives = sortOnLengthDesc (map T.pack (coerce alternativesS))+ rparse+ | doCompress = R.parse $! R.fromFoldable alternatives+ | otherwise = case R.compressBy (T.concat alternatives) (R.fromFoldable alternatives) of+ Just crt -> R.parse $! crt+ Nothing -> error "could not compress radixtree!"++ in forAll $ \(textS :: NonEmpty Char) ->+ let text = T.pack (coerce textS)+ in parseOnly (choice (map string alternatives)) text ==+ parseOnly rparse text++main :: IO ()+main = defaultMain $ testGroup "radixtree"+ [ testProperty "naiive parsing has the same result as radix tree parsing" (naiiveSameAsRadix False)+ , testProperty "naiive parsing has the same result as radix tree parsing when compressed"+ (naiiveSameAsRadix True)+ ]