<commit_before>! (c)2009 <NAME> bsd license
USING: accessors arrays assocs kernel locals math sequences ;
FROM: sequences => change-nth ;
IN: sequences.product

TUPLE: product-sequence { sequences array read-only } { lengths array read-only } ;

: <product-sequence> ( sequences -- product-sequence )
    >array dup [ length ] map product-sequence boa ;

INSTANCE: product-sequence sequence

M: product-sequence length lengths>> product ;

<PRIVATE

: ns ( n lengths -- ns )
    [ /mod ] map nip ;

: nths ( ns seqs -- nths )
    [ nth ] { } 2map-as ;

: product@ ( n product-sequence -- ns seqs )
    [ lengths>> ns ] [ nip sequences>> ] 2bi ;

:: (carry-n) ( ns lengths i -- )
    ns length i 1 + = [
        i ns nth i lengths nth = [
            0 i ns set-nth
            i 1 + ns [ 1 + ] change-nth
            ns lengths i 1 + (carry-n)
        ] when
    ] unless ;

: carry-ns ( ns lengths -- )
    0 (carry-n) ;

: product-iter ( ns lengths -- )
    [ 0 over [ 1 + ] change-nth ] dip carry-ns ;

: start-product-iter ( sequences -- ns lengths )
    [ length 0 <array> ] [ [ length ] map ] bi ;

: end-product-iter? ( ns lengths -- ? )
    [ last ] bi@ = ;

PRIVATE>

M: product-sequence nth
    product@ nths ;

:: product-each ( sequences quot: ( seq -- ) -- )
    sequences start-product-iter :> ( ns lengths )
    lengths [ 0 = ] any? [
        [ ns lengths end-product-iter? ]
        [ ns sequences nths quot call ns lengths product-iter ] until
    ] unless ; inline

:: product-map-as ( sequences quot: ( seq -- value ) exemplar -- sequence )
    0 :> i!
    sequences [ length ] [ * ] map-reduce exemplar
    [| result |
        sequences [ quot call i result set-nth i 1 + i! ] product-each
        result
    ] new-like ; inline

: product-map ( sequences quot: ( seq -- value ) -- sequence )
    over product-map-as ; inline

:: product-map>assoc ( sequences quot: ( seq -- key value ) exemplar -- assoc )
    0 :> i!
    sequences [ length ] [ * ] map-reduce { }
    [| result |
        sequences [ quot call 2array i result set-nth i 1 + i! ] product-each
        result
    ] new-like exemplar assoc-like ; inline
<commit_msg>sequences.product: improve stack effects.<commit_after>! (c)2009 <NAME> bsd license
USING: accessors arrays assocs kernel locals math sequences ;
FROM: sequences => change-nth ;
IN: sequences.product

TUPLE: product-sequence { sequences array read-only } { lengths array read-only } ;

: <product-sequence> ( sequences -- product-sequence )
    >array dup [ length ] map product-sequence boa ;

INSTANCE: product-sequence sequence

M: product-sequence length lengths>> product ;

<PRIVATE

: ns ( n lengths -- ns )
    [ /mod ] map nip ;

: nths ( ns seqs -- nths )
    [ nth ] { } 2map-as ;

: product@ ( n product-sequence -- ns seqs )
    [ lengths>> ns ] [ nip sequences>> ] 2bi ;

:: (carry-n) ( ns lengths i -- )
    ns length i 1 + = [
        i ns nth i lengths nth = [
            0 i ns set-nth
            i 1 + ns [ 1 + ] change-nth
            ns lengths i 1 + (carry-n)
        ] when
    ] unless ;

: carry-ns ( ns lengths -- )
    0 (carry-n) ;

: product-iter ( ns lengths -- )
    [ 0 over [ 1 + ] change-nth ] dip carry-ns ;

: start-product-iter ( sequences -- ns lengths )
    [ length 0 <array> ] [ [ length ] map ] bi ;

: end-product-iter? ( ns lengths -- ? )
    [ last ] bi@ = ;

PRIVATE>

M: product-sequence nth
    product@ nths ;

:: product-each ( ... sequences quot: ( ... seq -- ... ) -- ... )
    sequences start-product-iter :> ( ns lengths )
    lengths [ 0 = ] any? [
        [ ns lengths end-product-iter? ]
        [ ns sequences nths quot call ns lengths product-iter ] until
    ] unless ; inline

:: product-map-as ( ... sequences quot: ( ... seq -- ... value ) exemplar -- ... sequence )
    0 :> i!
    sequences [ length ] [ * ] map-reduce exemplar
    [| result |
        sequences [ quot call i result set-nth i 1 + i! ] product-each
        result
    ] new-like ; inline

: product-map ( ... sequences quot: ( ... seq -- ... value ) -- ... sequence )
    over product-map-as ; inline

:: product-map>assoc ( ... sequences quot: ( ... seq -- ... key value ) exemplar -- ... assoc )
    0 :> i!
    sequences [ length ] [ * ] map-reduce { }
    [| result |
        sequences [ quot call 2array i result set-nth i 1 + i! ] product-each
        result
    ] new-like exemplar assoc-like ; inline

{'fraction_non_alphanumeric': 0.14275956284153005, 'fraction_numerical': 0.009562841530054645, 'mean_word_length': 2.072027972027972, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5699731', 'n_tokens_mistral': 1444, 'n_tokens_neox': 1404, 'n_words': 449}