<commit_before>! Copyright (C) 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators io kernel math namespaces
prettyprint sequences vectors ;
QUALIFIED-WITH: bitstreams bs
IN: compression.lzw

TUPLE: lzw
input
output
table
code
old-code
initial-code-size
code-size
clear-code
end-of-information-code ;

TUPLE: tiff-lzw < lzw ;
TUPLE: gif-lzw < lzw ;

: initial-uncompress-table ( size -- seq )
    iota [ 1vector ] V{ } map-as ;

: reset-lzw-uncompress ( lzw -- lzw )
    dup end-of-information-code>> 1 + initial-uncompress-table >>table
    dup initial-code-size>> >>code-size ;

: <lzw-uncompress> ( input code-size class -- obj )
    new
        swap >>code-size
        dup code-size>> >>initial-code-size
        dup code-size>> 1 - 2^ >>clear-code
        dup clear-code>> 1 + >>end-of-information-code
        swap >>input
        BV{ } clone >>output
        reset-lzw-uncompress ;

ERROR: not-in-table value ;

: lookup-old-code ( lzw -- vector )
    [ old-code>> ] [ table>> ] bi nth ;

: lookup-code ( lzw -- vector )
    [ code>> ] [ table>> ] bi nth ;

: code-in-table? ( lzw -- ? )
    [ code>> ] [ table>> length ] bi < ;

: code>old-code ( lzw -- lzw )
    dup code>> >>old-code ;

: write-code ( lzw -- )
    [ lookup-code ] [ output>> ] bi push-all ;

GENERIC: code-space-full? ( lzw -- ? )

M: tiff-lzw code-space-full?
    [ table>> length ] [ code-size>> 2^ 1 - ] bi = ;

M: gif-lzw code-space-full?
    [ table>> length ] [ code-size>> 2^ ] bi = ;

: maybe-increment-code-size ( lzw -- lzw )
    dup code-space-full? [ [ 1 + ] change-code-size ] when ;

: add-to-table ( seq lzw -- )
    [ table>> push ]
    [ maybe-increment-code-size 2drop ] 2bi ;<commit_msg>compression.lzw: additional refactoring<commit_after>! Copyright (C) 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators io kernel math namespaces
prettyprint sequences vectors ;
QUALIFIED-WITH: bitstreams bs
IN: compression.lzw

TUPLE: lzw
input
output
table
code
old-code
initial-code-size
code-size
clear-code
end-of-information-code ;

TUPLE: tiff-lzw < lzw ;
TUPLE: gif-lzw < lzw ;

: initial-uncompress-table ( size -- seq )
    iota [ 1vector ] V{ } map-as ;

: reset-lzw-uncompress ( lzw -- lzw )
    dup end-of-information-code>> 1 + initial-uncompress-table >>table
    dup initial-code-size>> >>code-size ;

: <lzw-uncompress> ( input code-size class -- obj )
    new
        swap >>code-size
        dup code-size>> >>initial-code-size
        dup code-size>> 1 - 2^ >>clear-code
        dup clear-code>> 1 + >>end-of-information-code
        swap >>input
        BV{ } clone >>output
        reset-lzw-uncompress ;

ERROR: not-in-table value ;

: lookup-old-code ( lzw -- vector )
    [ old-code>> ] [ table>> ] bi nth ;

: lookup-code ( lzw -- vector )
    [ code>> ] [ table>> ] bi nth ;

: code-in-table? ( lzw -- ? )
    [ code>> ] [ table>> length ] bi < ;

: code>old-code ( lzw -- lzw )
    dup code>> >>old-code ;

: write-code ( lzw -- )
    [ lookup-code ] [ output>> ] bi push-all ;

GENERIC: code-space-full? ( lzw -- ? )

: size-and-limit ( lzw -- m n ) [ table>> length ] [ code-size>> 2^ ] bi ;

M: tiff-lzw code-space-full? size-and-limit 1 - = ;
M: gif-lzw code-space-full? size-and-limit = ;

: maybe-increment-code-size ( lzw -- lzw )
    dup code-space-full? [ [ 1 + ] change-code-size ] when ;

: add-to-table ( seq lzw -- )
    [ table>> push ]
    [ maybe-increment-code-size 2drop ] 2bi ;
{'fraction_non_alphanumeric': 0.16500142734798745, 'fraction_numerical': 0.008278618327148159, 'mean_word_length': 2.5004995004995005, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 113, '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': '2468286', 'n_tokens_mistral': 1320, 'n_tokens_neox': 1280, 'n_words': 317}