remove 1-, 1+, use iota somewhere
parent
ffbd19faba
commit
d168f76ab0
|
|
@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ;
|
|||
C: <bits> bits
|
||||
|
||||
: make-bits ( number -- bits )
|
||||
dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1+ <bits> ] if ; inline
|
||||
dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if ; inline
|
||||
|
||||
M: bits length length>> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -13,10 +13,10 @@ IN: math.bitwise
|
|||
: unmask? ( x n -- ? ) unmask 0 > ; inline
|
||||
: mask ( x n -- ? ) bitand ; inline
|
||||
: mask? ( x n -- ? ) mask 0 > ; inline
|
||||
: wrap ( m n -- m' ) 1- bitand ; inline
|
||||
: wrap ( m n -- m' ) 1 - bitand ; inline
|
||||
: bits ( m n -- m' ) 2^ wrap ; inline
|
||||
: mask-bit ( m n -- m' ) 2^ mask ; inline
|
||||
: on-bits ( n -- m ) 2^ 1- ; inline
|
||||
: on-bits ( n -- m ) 2^ 1 - ; inline
|
||||
: toggle-bit ( m n -- m' ) 2^ bitxor ; inline
|
||||
|
||||
: shift-mod ( n s w -- n )
|
||||
|
|
@ -64,8 +64,8 @@ DEFER: byte-bit-count
|
|||
<<
|
||||
|
||||
\ byte-bit-count
|
||||
256 [
|
||||
8 <bits> 0 [ [ 1+ ] when ] reduce
|
||||
256 iota [
|
||||
8 <bits> 0 [ [ 1 + ] when ] reduce
|
||||
] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
|
||||
(( byte -- table )) define-declared
|
||||
|
||||
|
|
@ -97,12 +97,12 @@ PRIVATE>
|
|||
|
||||
! Signed byte array to integer conversion
|
||||
: signed-le> ( bytes -- x )
|
||||
[ le> ] [ length 8 * 1- on-bits ] bi
|
||||
[ le> ] [ length 8 * 1 - on-bits ] bi
|
||||
2dup > [ bitnot bitor ] [ drop ] if ;
|
||||
|
||||
: signed-be> ( bytes -- x )
|
||||
<reversed> signed-le> ;
|
||||
|
||||
: >signed ( x n -- y )
|
||||
2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
|
||||
2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -164,7 +164,7 @@ M: VECTOR element-type
|
|||
M: VECTOR Vswap
|
||||
(prepare-swap) [ XSWAP ] 2dip ;
|
||||
M: VECTOR Viamax
|
||||
(prepare-nrm2) IXAMAX 1- ;
|
||||
(prepare-nrm2) IXAMAX 1 - ;
|
||||
|
||||
M: VECTOR (blas-vector-like)
|
||||
drop <VECTOR> ;
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ M: real sqrt
|
|||
: factor-2s ( n -- r s )
|
||||
#! factor an integer into 2^r * s
|
||||
dup 0 = [ 1 ] [
|
||||
0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while
|
||||
0 swap [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while
|
||||
] if ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -216,17 +216,17 @@ M: real tanh ftanh ;
|
|||
: coth ( x -- y ) tanh recip ; inline
|
||||
|
||||
: acosh ( x -- y )
|
||||
dup sq 1- sqrt + log ; inline
|
||||
dup sq 1 - sqrt + log ; inline
|
||||
|
||||
: asech ( x -- y ) recip acosh ; inline
|
||||
|
||||
: asinh ( x -- y )
|
||||
dup sq 1+ sqrt + log ; inline
|
||||
dup sq 1 + sqrt + log ; inline
|
||||
|
||||
: acosech ( x -- y ) recip asinh ; inline
|
||||
|
||||
: atanh ( x -- y )
|
||||
[ 1+ ] [ 1- neg ] bi / log 2 / ; inline
|
||||
[ 1 + ] [ 1 - neg ] bi / log 2 / ; inline
|
||||
|
||||
: acoth ( x -- y ) recip atanh ; inline
|
||||
|
||||
|
|
@ -259,7 +259,7 @@ M: real atan fatan ;
|
|||
|
||||
: floor ( x -- y )
|
||||
dup 1 mod dup zero?
|
||||
[ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
|
||||
[ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable
|
||||
|
||||
: ceiling ( x -- y ) neg floor neg ; foldable
|
||||
|
||||
|
|
|
|||
|
|
@ -380,7 +380,7 @@ SYMBOL: incomparable
|
|||
[
|
||||
to>> first 1 max dup most-positive-fixnum >
|
||||
[ drop full-interval interval-log2 ]
|
||||
[ 1+ >integer log2 0 swap [a,b] ]
|
||||
[ 1 + >integer log2 0 swap [a,b] ]
|
||||
if
|
||||
]
|
||||
} case ;
|
||||
|
|
@ -407,7 +407,7 @@ SYMBOL: incomparable
|
|||
|
||||
: integral-closure ( i1 -- i2 )
|
||||
dup special-interval? [
|
||||
[ from>> first2 [ 1+ ] unless ]
|
||||
[ to>> first2 [ 1- ] unless ]
|
||||
[ from>> first2 [ 1 + ] unless ]
|
||||
[ to>> first2 [ 1 - ] unless ]
|
||||
bi [a,b]
|
||||
] unless ;
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ PRIVATE>
|
|||
: n*p ( n p -- n*p ) n*v ;
|
||||
|
||||
: pextend-conv ( p q -- p q )
|
||||
2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ;
|
||||
2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ;
|
||||
|
||||
: p* ( p q -- r )
|
||||
2unempty pextend-conv <reversed> dup length
|
||||
|
|
@ -44,7 +44,7 @@ PRIVATE>
|
|||
2ptrim
|
||||
2dup [ length ] bi@ -
|
||||
dup 1 < [ drop 1 ] when
|
||||
[ over length + 0 pad-head pextend ] keep 1+ ;
|
||||
[ over length + 0 pad-head pextend ] keep 1 + ;
|
||||
|
||||
: /-last ( seq seq -- a )
|
||||
#! divide the last two numbers in the sequences
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ TUPLE: range
|
|||
{ step read-only } ;
|
||||
|
||||
: <range> ( a b step -- range )
|
||||
[ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline
|
||||
[ over - ] dip [ /i 1 + 0 max ] keep range boa ; inline
|
||||
|
||||
M: range length ( seq -- n )
|
||||
length>> ;
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ IN: math.statistics
|
|||
|
||||
: median ( seq -- n )
|
||||
natural-sort dup length even? [
|
||||
[ midpoint@ dup 1- 2array ] keep nths mean
|
||||
[ midpoint@ dup 1 - 2array ] keep nths mean
|
||||
] [
|
||||
[ midpoint@ ] keep nth
|
||||
] if ;
|
||||
|
|
@ -33,7 +33,7 @@ IN: math.statistics
|
|||
drop 0
|
||||
] [
|
||||
[ [ mean ] keep [ - sq ] with sigma ] keep
|
||||
length 1- /
|
||||
length 1 - /
|
||||
] if ;
|
||||
|
||||
: std ( seq -- x )
|
||||
|
|
@ -47,7 +47,7 @@ IN: math.statistics
|
|||
0 [ [ [ pick ] dip swap - ] bi@ * + ] 2reduce 2nip ;
|
||||
|
||||
: (r) ( mean(x) mean(y) {x} {y} sx sy -- r )
|
||||
* recip [ [ ((r)) ] keep length 1- / ] dip * ;
|
||||
* recip [ [ ((r)) ] keep length 1 - / ] dip * ;
|
||||
|
||||
: [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy )
|
||||
first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue