Paste: Two Sums solution (Rosetta Code)

Author:	CapitalEx
Mode:	factor
Date:	Thu, 27 Jul 2023 02:54:58

Plain Text |

Delete Paste

: find-pair ( seq target -- pair )
    '[ first2 + _ = ] find nip ;

: find-indices ( seq pair -- pair )
    [ '[ _ index ] map ] when* ;

: two-sum ( target seq -- pair )
    [ 2 <combinations> swap find-pair ] keep find-indices ;

Annotation: More Factoring

Author:	CapitalEx
Mode:	factor
Date:	Thu, 27 Jul 2023 03:06:55

Plain Text |

Delete Annotation

: (find-pair) ( seq target -- pair )
    '[ first2 + _ = ] find nip ;

: find-pairs ( target seq -- seq pair/f )
   [ 2 <combinations> swap find-pair ] keep ;

: find-indices ( seq pair/f -- indices/f )
    [ '[ _ index ] map ] when* ;

: two-sum ( target seq -- pair )
     find-pairs find-indices ;

Annotation: Non-combinatorics solution

Author:	CapitalEx
Mode:	factor
Date:	Thu, 27 Jul 2023 16:53:00

Plain Text |

Delete Annotation

: prep-hashtable ( sum seq -- hashtable sum seq )
    tuck [ H{ } [ spin [ set-at ] keep ] reduce-index ] 2dip ;

: complements ( sum seq -- seq' )
    [ - ] with map ;

: find-indices ( key assoc -- index/f index/f )
    [ [ ?of nip ] with find ] keepd at ;

: result/empty ( index/f index/f -- pair )
    2dup and [ 2array ] [ 2drop { } ] if ;

: two-sum ( sum seq -- pair ) 
    prep-hashtable complements find-indices result/empty ;

Annotation: Another One

Author:	CapitalEx
Mode:	factor
Date:	Thu, 27 Jul 2023 21:51:57

Plain Text |

Delete Annotation

: build-lookup ( seq -- hashtable )
    H{ } [ set-of ] reduce-index ;

: build-pairs ( sum seq -- pairs )
    [ [ - ] keep 2array ] with map! ;

: lookup ( hashtable pairs -- index/f )
    first2 [ of ] bi-curry@ bi and ;

: find-sum ( hashtable seq -- sum )
    [ lookup ] with map! sift ;

: two-sum ( sum seq -- pair )
    [ nip build-lookup ] [ build-pairs ] 2bi find-sum ;

Annotation: Final Version

Author:	CapitalEx
Mode:	factor
Date:	Fri, 28 Jul 2023 02:30:28

Plain Text |

Delete Annotation

math.combinatorics sequences ;
IN: rosetta-code.two-sum

DEFER: (two-sum)
TUPLE: helper
     sum seq index hash ;

: <two-sum-helper> ( sum seq -- helper )
    \ helper new 
        swap >>seq 
        swap >>sum
        0 >>index 
        H{ } clone >>hash ;

: no-sum ( helper -- empty ) 
    drop { } ;

: in-bounds? ( helper -- ? )
    [      index>> ] 
    [ seq>> length ] bi < ;

: next-sum ( helper -- pair )
    dup in-bounds? [ (two-sum) ] 
                   [    no-sum ] if ;

: next-index ( helper -- helper )
    [ 1 + ] change-index ;

: remember-item ( helper -- helper )
    dup [      hash>> ]
        [ index>> dup ] 
        [       seq>> ] tri nth swap set-of drop ;

: result ( helper index -- helper )
    swap index>> 2array ;

: find-compliment-index ( helper -- helper index/f )
    dup [       sum>> ] 
        [     index>> ] 
        [ seq>> nth - ] 
        [             ] quad hash>> at ;

: (two-sum) ( helper -- pair )
    remember-item find-compliment-index 
        [ result ] [ next-index next-sum ] if* ;

: two-sum ( sum seq -- pair )

Annotation: Fix mistakes

Author:	CapitalEx
Mode:	factor
Date:	Fri, 28 Jul 2023 03:59:22

Plain Text |

Delete Annotation

USING: accessors arrays assocs combinators.extras kernel math
math.combinatorics sequences ;
IN: rosetta-code.two-sum

DEFER: (two-sum)
TUPLE: helper
     sum seq index hash ;

: <two-sum-helper> ( sum seq -- helper )
    \ helper new 
        swap >>seq 
        swap >>sum
        0 >>index 
        H{ } clone >>hash ;

: no-sum ( helper -- empty ) 
    drop { } ;

: in-bounds? ( helper -- ? )
    [      index>> ] 
    [ seq>> length ] bi < ;

: next-sum ( helper -- pair )
    dup in-bounds? [ (two-sum) ] 
                   [    no-sum ] if ;

: next-index ( helper -- helper )
    [ 1 + ] change-index ;

: remember-item ( helper -- helper )
    dup [    hash>> ]
        [   index>> ] 
        [ seq>> nth ]
        [   index>> ] quad set-of drop ;

: result ( helper index -- helper )
    swap index>> 2array ;

: find-compliment-index ( helper -- helper index/f )
    dup [       sum>> ] 
        [     index>> ] 
        [ seq>> nth - ] 
        [             ] quad hash>> at ;

: (two-sum) ( helper -- pair )
    remember-item find-compliment-index 
        [ result ] [ next-index next-sum ] if* ;

: two-sum ( sum seq -- pair )
    <two-sum-helper>  (two-sum) ;

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done