fixing matrices; fixing examples
parent
bbb5d90d31
commit
7a3a34d364
|
@ -0,0 +1,50 @@
|
||||||
|
Factor 0.74:
|
||||||
|
------------
|
||||||
|
|
||||||
|
C library interface ported to Linux/PPC and Mac OS X.
|
||||||
|
|
||||||
|
Developer's handbook rewritten to be more up to date and complete.
|
||||||
|
|
||||||
|
Added the sequences vocabulary that unifies code for working with lists,
|
||||||
|
vectors, strings, and string buffers. There are many changes, and most
|
||||||
|
of the old type-specific words such as vector-nth and string-map are
|
||||||
|
gone.
|
||||||
|
|
||||||
|
Added the matrices vocabulary for working with mathematical vectors and
|
||||||
|
matrices.
|
||||||
|
|
||||||
|
Added two words for modular arithmetic in the math vocabulary: mod-inv
|
||||||
|
and ^mod.
|
||||||
|
|
||||||
|
Added HTTP client API supporting GET and POST requests in the
|
||||||
|
http-client vocabulary.
|
||||||
|
|
||||||
|
Removed some inspection words: vocabs. words. usages. Now, just put a
|
||||||
|
space before the . and write vocabs . words . usages .
|
||||||
|
|
||||||
|
Redefining words that are used by compiled words automatically
|
||||||
|
decompiles the compiled words. This fixes the problem of new definitions
|
||||||
|
not taking effect. In a future release, there will be automatic
|
||||||
|
recompilation, rather than decompilation.
|
||||||
|
|
||||||
|
As a result of the previous change, there is now a cross-referencing
|
||||||
|
database, and the usages word lists indirect dependencies and is much
|
||||||
|
faster. The usage word behaves like the old usages, and lists direct
|
||||||
|
dependencies only.
|
||||||
|
|
||||||
|
The dump word in the dump vocabulary prints the memory bytes comprising
|
||||||
|
an object. The dump* word prints the bytes at an arbitrary address.
|
||||||
|
|
||||||
|
New words in words vocabulary for inspecting classes and methods: classes implements.
|
||||||
|
|
||||||
|
The Unix I/O code was rewritten in Factor using the C library interface.
|
||||||
|
Many new features will be added in future releases, such as socket
|
||||||
|
timeouts and Unicode character encodings.
|
||||||
|
|
||||||
|
Lazy lists and parser combinators library in contrib/parser-combinators/
|
||||||
|
(Chris Double).
|
||||||
|
|
||||||
|
Quotations containing \ foo are prettyprinted in that form.
|
||||||
|
|
||||||
|
The watch word now causes annotated words to dump the stack, in addition
|
||||||
|
to printing a log message.
|
|
@ -2,30 +2,31 @@
|
||||||
|
|
||||||
- faster layout
|
- faster layout
|
||||||
- faster repaint
|
- faster repaint
|
||||||
- implement fcopy
|
- open large listener by default
|
||||||
- win32 updates
|
|
||||||
|
|
||||||
- get all-tests to run with -no-compile
|
|
||||||
- scalar * matrix, vector * matrix, matrix * vector need to work
|
|
||||||
- make-matrix is slow and ugly
|
- make-matrix is slow and ugly
|
||||||
- move 2repeat somewhere else
|
- move 2repeat somewhere else
|
||||||
- rotating cube demo
|
- fix infix (dan)
|
||||||
|
|
||||||
|
+ plugin:
|
||||||
|
|
||||||
- if external factor is down, don't add tons of random shit to the
|
- if external factor is down, don't add tons of random shit to the
|
||||||
dictionary
|
dictionary
|
||||||
- plugin: extra space in stack effects
|
- plugin: extra space in stack effects
|
||||||
- plugin: type "re" in edit word dialog --> hang
|
- plugin: type "re" in edit word dialog --> hang
|
||||||
|
- word preview for parsing words
|
||||||
|
|
||||||
+ ui:
|
+ ui:
|
||||||
|
|
||||||
- console with presentations
|
- console with presentations
|
||||||
- ui browser
|
- ui browser
|
||||||
- auto-updating inspector, mirrors abstraction
|
- auto-updating inspector, mirrors abstraction
|
||||||
- word preview for parsing words
|
|
||||||
- mouse enter onto overlapping with interior, but not child, gadget
|
- mouse enter onto overlapping with interior, but not child, gadget
|
||||||
- menu dragging
|
- menu dragging
|
||||||
- fix up the min thumb size hack
|
- fix up the min thumb size hack
|
||||||
- frame gap
|
- frame gap
|
||||||
|
- tiled window manager
|
||||||
|
- rotating cube demo
|
||||||
|
|
||||||
+ ffi:
|
+ ffi:
|
||||||
|
|
||||||
|
@ -44,6 +45,8 @@
|
||||||
|
|
||||||
+ compiler:
|
+ compiler:
|
||||||
|
|
||||||
|
- get all-tests to run with -no-compile
|
||||||
|
- fix i/o on generic x86/ppc unix
|
||||||
- alien primitives need a more general input type
|
- alien primitives need a more general input type
|
||||||
- [ [ dup call ] dup call ] infer hangs
|
- [ [ dup call ] dup call ] infer hangs
|
||||||
- more accurate types for various words
|
- more accurate types for various words
|
||||||
|
@ -66,15 +69,16 @@
|
||||||
- ensure-capacity: don't be generic
|
- ensure-capacity: don't be generic
|
||||||
- vector's ensure-capacity will crash if not given fixnums!
|
- vector's ensure-capacity will crash if not given fixnums!
|
||||||
- dipping seq-2nmap, seq-2each
|
- dipping seq-2nmap, seq-2each
|
||||||
- remove seq- prefixes
|
- generic each some? all? member? memq? all=? index? subseq? map
|
||||||
- generic each some? all? member? memq? all=? top
|
|
||||||
index? subseq?
|
|
||||||
- index and index* are very slow with lists
|
- index and index* are very slow with lists
|
||||||
- list map, subset, project, append: not tail recursive
|
- list map, subset: not tail recursive
|
||||||
- phase out sbuf-append
|
- phase out sbuf-append, index-of, substring
|
||||||
- decide what to do with index-of
|
- unsafe-sbuf>string
|
||||||
|
- generic subseq
|
||||||
- GENERIC: map
|
- GENERIC: map
|
||||||
- list impl same as now
|
- list impl same as now
|
||||||
|
- generic parser::scan
|
||||||
|
- array sort
|
||||||
|
|
||||||
+ kernel:
|
+ kernel:
|
||||||
|
|
||||||
|
@ -92,9 +96,11 @@
|
||||||
- generational gc
|
- generational gc
|
||||||
- doc comments of generics
|
- doc comments of generics
|
||||||
- M: object should not inhibit delegation
|
- M: object should not inhibit delegation
|
||||||
|
- renumber types appopriately
|
||||||
|
|
||||||
+ i/o:
|
+ i/o:
|
||||||
|
|
||||||
|
- faster stream-copy
|
||||||
- rename prettyprint to pprint
|
- rename prettyprint to pprint
|
||||||
- reading and writing byte arrays
|
- reading and writing byte arrays
|
||||||
- merge unix and win32 io where appropriate
|
- merge unix and win32 io where appropriate
|
||||||
|
@ -108,21 +114,21 @@
|
||||||
- stream server can hang because of exception handler limitations
|
- stream server can hang because of exception handler limitations
|
||||||
- better i/o scheduler
|
- better i/o scheduler
|
||||||
- add a socket timeout
|
- add a socket timeout
|
||||||
- renumber types appopriately
|
|
||||||
- unify unparse and prettyprint
|
- unify unparse and prettyprint
|
||||||
|
- utf16, utf8 encoding
|
||||||
|
|
||||||
+ nice to have libraries:
|
+ nice to have libraries:
|
||||||
|
|
||||||
- regexps
|
- regexps
|
||||||
- XML
|
- XML
|
||||||
- HTTP client
|
|
||||||
- real Unicode support (strings are already 16 bits and can be extended
|
- real Unicode support (strings are already 16 bits and can be extended
|
||||||
to 21 if the need arises, but we need full character classification
|
to 21 if the need arises, but we need full character classification
|
||||||
predicates, comparison, case conversion, sorting...)
|
predicates, comparison, case conversion, sorting...)
|
||||||
- full Win32 binding
|
- full Win32 binding
|
||||||
- Cairo binding
|
- Cairo binding
|
||||||
|
|
||||||
+ httpd:
|
+ http:
|
||||||
|
|
||||||
|
- http client post requests
|
||||||
- virtual hosts
|
- virtual hosts
|
||||||
- keep alive
|
- keep alive
|
||||||
|
|
|
@ -1,9 +1,5 @@
|
||||||
IN: format
|
IN: format
|
||||||
USE: kernel
|
USING: kernel math sequences strings test ;
|
||||||
USE: math
|
|
||||||
USE: namespaces
|
|
||||||
USE: strings
|
|
||||||
USE: test
|
|
||||||
|
|
||||||
: decimal-split ( string -- string string )
|
: decimal-split ( string -- string string )
|
||||||
#! Split a string before and after the decimal point.
|
#! Split a string before and after the decimal point.
|
||||||
|
@ -11,12 +7,12 @@ USE: test
|
||||||
|
|
||||||
: decimal-tail ( count str -- string )
|
: decimal-tail ( count str -- string )
|
||||||
#! Given a decimal, trims all but a count of decimal places.
|
#! Given a decimal, trims all but a count of decimal places.
|
||||||
[ string-length min ] keep string-head ;
|
[ length min ] keep string-head ;
|
||||||
|
|
||||||
: decimal-cat ( before after -- string )
|
: decimal-cat ( before after -- string )
|
||||||
#! If after is of zero length, return before, otherwise
|
#! If after is of zero length, return before, otherwise
|
||||||
#! return "before.after".
|
#! return "before.after".
|
||||||
dup string-length 0 = [
|
dup length 0 = [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
"." swap cat3
|
"." swap cat3
|
||||||
|
|
|
@ -1,16 +1,8 @@
|
||||||
! A simple IRC client written in Factor.
|
! A simple IRC client written in Factor.
|
||||||
|
|
||||||
IN: irc
|
IN: irc
|
||||||
USE: generic
|
USING: kernel lists math namespaces stdio streams strings
|
||||||
USE: stdio
|
threads words ;
|
||||||
USE: namespaces
|
|
||||||
USE: streams
|
|
||||||
USE: kernel
|
|
||||||
USE: threads
|
|
||||||
USE: lists
|
|
||||||
USE: strings
|
|
||||||
USE: words
|
|
||||||
USE: math
|
|
||||||
|
|
||||||
SYMBOL: irc-stream
|
SYMBOL: irc-stream
|
||||||
SYMBOL: channels
|
SYMBOL: channels
|
||||||
|
@ -78,7 +70,7 @@ M: privmsg irc-display ( line -- )
|
||||||
channel get [ (msg) ] [ "No channel." print ] ifte* ;
|
channel get [ (msg) ] [ "No channel." print ] ifte* ;
|
||||||
|
|
||||||
: talk ( input -- ) "/" ?string-head [ command ] [ say ] ifte ;
|
: talk ( input -- ) "/" ?string-head [ command ] [ say ] ifte ;
|
||||||
: talk-loop ( -- ) read [ talk talk-loop ] when* ;
|
: talk-loop ( -- ) read-line [ talk talk-loop ] when* ;
|
||||||
|
|
||||||
: irc ( nick server -- )
|
: irc ( nick server -- )
|
||||||
[
|
[
|
||||||
|
|
|
@ -8,7 +8,7 @@ USING: sequences kernel math stdio strings ;
|
||||||
} nth >r 4 * dup 4 + r> substring ;
|
} nth >r 4 * dup 4 + r> substring ;
|
||||||
|
|
||||||
: lcd-row ( num row -- )
|
: lcd-row ( num row -- )
|
||||||
swap [ CHAR: 0 - over lcd-digit write ] string-each drop ;
|
swap [ CHAR: 0 - over lcd-digit write ] seq-each drop ;
|
||||||
|
|
||||||
: lcd ( num -- str )
|
: lcd ( num -- str )
|
||||||
3 [ 2dup lcd-row terpri ] repeat drop ;
|
3 [ 2dup lcd-row terpri ] repeat drop ;
|
||||||
|
|
|
@ -1,20 +1,9 @@
|
||||||
USE: random
|
IN: random
|
||||||
USE: kernel
|
USING: kernel lists math namespaces sequences test ;
|
||||||
USE: lists
|
|
||||||
USE: math
|
|
||||||
USE: test
|
|
||||||
USE: namespaces
|
|
||||||
|
|
||||||
: nth ( n list -- list[n] )
|
|
||||||
#! nth element of a proper list.
|
|
||||||
#! Supplying n <= 0 pushes the first element of the list.
|
|
||||||
#! Supplying an argument beyond the end of the list raises
|
|
||||||
#! an error.
|
|
||||||
swap [ cdr ] times car ;
|
|
||||||
|
|
||||||
: random-element ( list -- random )
|
: random-element ( list -- random )
|
||||||
#! Returns a random element from the given list.
|
#! Returns a random element from the given list.
|
||||||
dup >r length 1 - 0 swap random-int r> nth ;
|
[ length 1 - 0 swap random-int ] keep nth ;
|
||||||
|
|
||||||
: random-boolean ( -- ? ) 0 1 random-int 0 = ;
|
: random-boolean ( -- ? ) 0 1 random-int 0 = ;
|
||||||
|
|
||||||
|
@ -78,7 +67,7 @@ USE: namespaces
|
||||||
[[ 20 f ]]
|
[[ 20 f ]]
|
||||||
[[ 30 "monkey" ]]
|
[[ 30 "monkey" ]]
|
||||||
[[ 24 1/2 ]]
|
[[ 24 1/2 ]]
|
||||||
[ 13 | { "Hello" "Banana" } ]
|
[[ 13 { "Hello" "Banana" } ]]
|
||||||
] "random-pairs" set
|
] "random-pairs" set
|
||||||
|
|
||||||
"random-pairs" get [ cdr ] map "random-values" set
|
"random-pairs" get [ cdr ] map "random-values" set
|
||||||
|
@ -94,8 +83,4 @@ USE: namespaces
|
||||||
"random-pairs" get
|
"random-pairs" get
|
||||||
check-random-subset
|
check-random-subset
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ 1 ] [ -1 [ 1 2 ] nth ] unit-test
|
|
||||||
[ 1 ] [ 0 [ 1 2 ] nth ] unit-test
|
|
||||||
[ 2 ] [ 1 [ 1 2 ] nth ] unit-test
|
|
||||||
] with-scope
|
] with-scope
|
||||||
|
|
|
@ -34,6 +34,7 @@ hashtables ;
|
||||||
"/library/collections/hashtables.factor"
|
"/library/collections/hashtables.factor"
|
||||||
"/library/collections/namespaces.factor"
|
"/library/collections/namespaces.factor"
|
||||||
"/library/collections/sbuf.factor"
|
"/library/collections/sbuf.factor"
|
||||||
|
"/library/math/matrices.factor"
|
||||||
"/library/words.factor"
|
"/library/words.factor"
|
||||||
"/library/vocabularies.factor"
|
"/library/vocabularies.factor"
|
||||||
"/library/errors.factor"
|
"/library/errors.factor"
|
||||||
|
@ -49,6 +50,7 @@ hashtables ;
|
||||||
"/library/syntax/parser.factor"
|
"/library/syntax/parser.factor"
|
||||||
"/library/syntax/parse-stream.factor"
|
"/library/syntax/parse-stream.factor"
|
||||||
"/library/syntax/generic.factor"
|
"/library/syntax/generic.factor"
|
||||||
|
"/library/syntax/math.factor"
|
||||||
"/library/syntax/parse-syntax.factor"
|
"/library/syntax/parse-syntax.factor"
|
||||||
"/library/alien/aliens.factor"
|
"/library/alien/aliens.factor"
|
||||||
"/library/cli.factor"
|
"/library/cli.factor"
|
||||||
|
|
|
@ -19,10 +19,6 @@ t [
|
||||||
"/library/syntax/unparser.factor"
|
"/library/syntax/unparser.factor"
|
||||||
"/library/syntax/prettyprint.factor"
|
"/library/syntax/prettyprint.factor"
|
||||||
|
|
||||||
! This has to be loaded here because it overloads sequence
|
|
||||||
! generics, and we don't want to compile twice.
|
|
||||||
"/library/math/matrices.factor"
|
|
||||||
|
|
||||||
"/library/tools/debugger.factor"
|
"/library/tools/debugger.factor"
|
||||||
"/library/tools/gensym.factor"
|
"/library/tools/gensym.factor"
|
||||||
"/library/tools/interpreter.factor"
|
"/library/tools/interpreter.factor"
|
||||||
|
|
|
@ -129,7 +129,8 @@ M: cons hashcode ( cons -- hash ) car hashcode ;
|
||||||
#! Return the rest of the list, from the nth index onward.
|
#! Return the rest of the list, from the nth index onward.
|
||||||
[ cdr ] times ;
|
[ cdr ] times ;
|
||||||
|
|
||||||
M: general-list nth ( n list -- element ) tail car ;
|
M: cons nth ( n list -- element )
|
||||||
|
over 0 = [ nip car ] [ >r 1 - r> cdr nth ] ifte ;
|
||||||
|
|
||||||
: intersection ( list list -- list )
|
: intersection ( list list -- list )
|
||||||
#! Make a list of elements that occur in both lists.
|
#! Make a list of elements that occur in both lists.
|
||||||
|
|
|
@ -106,7 +106,7 @@ stdio streams strings unparser http ;
|
||||||
TUPLE: html-stream ;
|
TUPLE: html-stream ;
|
||||||
|
|
||||||
M: html-stream stream-write-attr ( str style stream -- )
|
M: html-stream stream-write-attr ( str style stream -- )
|
||||||
wrapper-stream-scope [
|
[
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
|
@ -114,7 +114,7 @@ M: html-stream stream-write-attr ( str style stream -- )
|
||||||
] file-link-tag
|
] file-link-tag
|
||||||
] icon-tag
|
] icon-tag
|
||||||
] browser-link-tag
|
] browser-link-tag
|
||||||
] bind ;
|
] with-wrapper ;
|
||||||
|
|
||||||
C: html-stream ( stream -- stream )
|
C: html-stream ( stream -- stream )
|
||||||
#! Wraps the given stream in an HTML stream. An HTML stream
|
#! Wraps the given stream in an HTML stream. An HTML stream
|
||||||
|
|
|
@ -54,12 +54,14 @@ M: sbuf stream-auto-flush drop ;
|
||||||
TUPLE: wrapper-stream scope ;
|
TUPLE: wrapper-stream scope ;
|
||||||
|
|
||||||
C: wrapper-stream ( stream -- stream )
|
C: wrapper-stream ( stream -- stream )
|
||||||
2dup set-delegate
|
2dup set-delegate [
|
||||||
[
|
|
||||||
>r <namespace> [ stdio set ] extend r>
|
>r <namespace> [ stdio set ] extend r>
|
||||||
set-wrapper-stream-scope
|
set-wrapper-stream-scope
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
|
: with-wrapper ( stream quot -- )
|
||||||
|
>r wrapper-stream-scope r> bind ;
|
||||||
|
|
||||||
! Combine an input and output stream into one, and flush the
|
! Combine an input and output stream into one, and flush the
|
||||||
! stream more often.
|
! stream more often.
|
||||||
TUPLE: duplex-stream in out flush? ;
|
TUPLE: duplex-stream in out flush? ;
|
||||||
|
|
|
@ -1,48 +1,31 @@
|
||||||
! Copyright (C) 2005 Slava Pestov.
|
! Copyright (C) 2005 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: matrices
|
IN: matrices
|
||||||
USING: errors generic kernel lists math namespaces prettyprint
|
USING: errors generic kernel lists math namespaces sequences
|
||||||
sequences stdio test vectors ;
|
vectors ;
|
||||||
|
|
||||||
! The major dimension is the number of elements per row.
|
: n*v ( n vec -- vec )
|
||||||
TUPLE: matrix rows cols sequence ;
|
#! Multiply a vector by a scalar.
|
||||||
|
[ * ] seq-map-with ;
|
||||||
! Vector and matrix protocol.
|
|
||||||
GENERIC: v+
|
|
||||||
GENERIC: v-
|
|
||||||
GENERIC: v* ( element-wise multiplication )
|
|
||||||
GENERIC: v. ( interior multiplication )
|
|
||||||
|
|
||||||
: v*n ( vec n -- vec ) swap [ * ] seq-map-with ;
|
|
||||||
|
|
||||||
! On numbers, these operations do the obvious thing
|
|
||||||
M: number v+ ( n n -- n ) + ;
|
|
||||||
M: number v- ( n n -- n ) - ;
|
|
||||||
M: number v* ( n n -- n ) * ;
|
|
||||||
|
|
||||||
M: number v. ( n n -- n )
|
|
||||||
over vector? [ v*n ] [ * ] ifte ;
|
|
||||||
|
|
||||||
! Vector operations
|
! Vector operations
|
||||||
DEFER: <row-vector>
|
: v+ ( v v -- v ) [ + ] seq-2map ;
|
||||||
DEFER: <col-vector>
|
: v- ( v v -- v ) [ - ] seq-2map ;
|
||||||
|
: v* ( v v -- v ) [ * ] seq-2map ;
|
||||||
M: object v+ ( v v -- v ) [ v+ ] seq-2map ;
|
|
||||||
M: object v- ( v v -- v ) [ v- ] seq-2map ;
|
|
||||||
M: object v* ( v v -- v ) [ v* ] seq-2map ;
|
|
||||||
|
|
||||||
! Later, this will fixed when seq-2each works properly
|
! Later, this will fixed when seq-2each works properly
|
||||||
! M: object v. ( v v -- x ) 0 swap [ * + ] seq-2each ;
|
! : v. ( v v -- x ) 0 swap [ * + ] seq-2each ;
|
||||||
: +/ ( seq -- n ) 0 swap [ + ] seq-each ;
|
: +/ ( seq -- n ) 0 swap [ + ] seq-each ;
|
||||||
|
: v. ( v v -- x ) v* +/ ;
|
||||||
GENERIC: vv. ( obj v -- v )
|
|
||||||
M: number vv. ( v n -- v ) v*n ;
|
|
||||||
M: matrix vv. ( v m -- v )
|
|
||||||
swap <col-vector> v. matrix-sequence ;
|
|
||||||
M: object vv. v* +/ ;
|
|
||||||
M: object v. ( v v -- x ) swap vv. ;
|
|
||||||
|
|
||||||
! Matrices
|
! Matrices
|
||||||
|
! The major dimension is the number of elements per row.
|
||||||
|
TUPLE: matrix rows cols sequence ;
|
||||||
|
: >matrix<
|
||||||
|
[ matrix-rows ] keep
|
||||||
|
[ matrix-cols ] keep
|
||||||
|
matrix-sequence ;
|
||||||
|
|
||||||
M: matrix clone ( matrix -- matrix )
|
M: matrix clone ( matrix -- matrix )
|
||||||
clone-tuple
|
clone-tuple
|
||||||
dup matrix-sequence clone over set-matrix-sequence ;
|
dup matrix-sequence clone over set-matrix-sequence ;
|
||||||
|
@ -79,9 +62,8 @@ SYMBOL: matrix-maker
|
||||||
2dup <zero-matrix> matrix set
|
2dup <zero-matrix> matrix set
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[
|
[ matrix-maker get call ] 2keep
|
||||||
swap matrix-maker get call
|
matrix get matrix-set
|
||||||
] 2keep matrix get matrix-set
|
|
||||||
] 2keep
|
] 2keep
|
||||||
] 2repeat
|
] 2repeat
|
||||||
matrix get
|
matrix get
|
||||||
|
@ -103,77 +85,62 @@ M: row length row-matrix matrix-cols ;
|
||||||
M: row nth ( n row -- ) >row< swapd matrix-get ;
|
M: row nth ( n row -- ) >row< swapd matrix-get ;
|
||||||
M: row thaw >vector ;
|
M: row thaw >vector ;
|
||||||
|
|
||||||
! A sequence of rows.
|
|
||||||
TUPLE: row-seq matrix ;
|
|
||||||
M: row-seq length row-seq-matrix matrix-rows ;
|
|
||||||
M: row-seq nth row-seq-matrix <row> ;
|
|
||||||
|
|
||||||
! Sequence of elements in a column of a matrix.
|
! Sequence of elements in a column of a matrix.
|
||||||
TUPLE: col index matrix ;
|
TUPLE: col index matrix ;
|
||||||
: >col< dup col-index swap col-matrix ;
|
: >col< dup col-index swap col-matrix ;
|
||||||
M: col length col-matrix matrix-rows ;
|
M: col length col-matrix matrix-rows ;
|
||||||
M: col nth ( n column -- ) >col< swapd matrix-get ;
|
M: col nth ( n column -- ) >col< matrix-get ;
|
||||||
M: col thaw >vector ;
|
M: col thaw >vector ;
|
||||||
|
|
||||||
! A sequence of columns.
|
: +check ( matrix matrix -- )
|
||||||
TUPLE: col-seq matrix ;
|
|
||||||
M: col-seq length col-seq-matrix matrix-cols ;
|
|
||||||
M: col-seq nth col-seq-matrix <col> ;
|
|
||||||
|
|
||||||
: +check ( matrix matrix -- matrix matrix )
|
|
||||||
#! Check if the two matrices have dimensions compatible
|
#! Check if the two matrices have dimensions compatible
|
||||||
#! for being added or subtracted.
|
#! for being added or subtracted.
|
||||||
over matrix-rows over matrix-rows = >r
|
over matrix-rows over matrix-rows = >r
|
||||||
over matrix-cols over matrix-cols = r> and [
|
swap matrix-cols swap matrix-cols = r> and [
|
||||||
"Matrix dimensions do not match" throw
|
"Matrix dimensions do not equal" throw
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
: +dimensions ( matrix -- rows cols )
|
: element-wise ( m m -- v v )
|
||||||
dup matrix-rows swap matrix-cols ;
|
2dup +check >r >matrix< r> matrix-sequence ;
|
||||||
|
|
||||||
: matrix+/-
|
! Matrix operations
|
||||||
+check
|
: m+ ( m m -- m ) element-wise v+ <matrix> ;
|
||||||
>r dup +dimensions rot r>
|
: m- ( m m -- m ) element-wise v- <matrix> ;
|
||||||
swap matrix-sequence swap matrix-sequence ;
|
|
||||||
|
|
||||||
M: matrix v+ ( m m -- m ) matrix+/- v+ <matrix> ;
|
: m* ( m m -- m )
|
||||||
M: matrix v- ( m m -- m ) matrix+/- v- <matrix> ;
|
#! Multiply two matrices element-wise. This is NOT matrix
|
||||||
M: matrix v* ( m m -- m ) matrix+/- v* <matrix> ;
|
#! multiplication in the usual mathematical sense. For that,
|
||||||
|
#! see the m. word.
|
||||||
|
element-wise v* <matrix> ;
|
||||||
|
|
||||||
: *check ( matrix matrix -- matrix matrix )
|
: *check ( matrix matrix -- )
|
||||||
over matrix-rows over matrix-cols = >r
|
swap matrix-cols swap matrix-rows = [
|
||||||
over matrix-cols over matrix-rows = r> and [
|
|
||||||
"Matrix dimensions inappropriate for composition" throw
|
"Matrix dimensions inappropriate for composition" throw
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
: *dimensions ( m m -- rows cols )
|
: *dimensions ( m m -- rows cols )
|
||||||
swap matrix-rows swap matrix-cols ;
|
swap matrix-rows swap matrix-cols ;
|
||||||
|
|
||||||
M: matrix v. ( m1 m2 -- m )
|
: m. ( m1 m2 -- m )
|
||||||
2dup *dimensions [
|
#! Composition of two matrices.
|
||||||
( m1 m2 row col )
|
2dup *check 2dup *dimensions [
|
||||||
|
( m1 m2 row col -- m1 m2 )
|
||||||
>r >r 2dup r> rot <row> r> rot <col> v.
|
>r >r 2dup r> rot <row> r> rot <col> v.
|
||||||
] make-matrix 2nip ;
|
] make-matrix 2nip ;
|
||||||
|
|
||||||
! Reading and writing matrices
|
: n*m ( n m -- m )
|
||||||
|
#! Multiply a matrix by a scalar.
|
||||||
|
>matrix< >r rot r> n*v <matrix> ;
|
||||||
|
|
||||||
: M[ f ; parsing
|
: m.v ( m v -- v )
|
||||||
|
#! Multiply a matrix by a column vector.
|
||||||
|
<col-vector> m. matrix-sequence ;
|
||||||
|
|
||||||
: ]M
|
: v.m ( v m -- v )
|
||||||
reverse
|
#! Multiply a row vector by a matrix.
|
||||||
[ dup length swap car length ] keep
|
>r <row-vector> r> m. matrix-sequence ;
|
||||||
concat >vector <matrix> swons ; parsing
|
|
||||||
|
|
||||||
: row-list ( matrix -- list )
|
: row-list ( matrix -- list )
|
||||||
#! A list of lists, where each sublist is a row of the
|
#! A list of lists, where each sublist is a row of the
|
||||||
#! matrix.
|
#! matrix.
|
||||||
[ <row-seq> [ >list , ] seq-each ] make-list ;
|
dup matrix-rows [ swap <row> >list ] project-with ;
|
||||||
|
|
||||||
: matrix-rows. ( indent list -- indent )
|
|
||||||
uncons >r [ one-line on prettyprint* ] with-scope r>
|
|
||||||
[ over ?prettyprint-newline matrix-rows. ] when* ;
|
|
||||||
|
|
||||||
M: matrix prettyprint* ( indent obj -- indent )
|
|
||||||
\ M[ word. >r <prettyprint r>
|
|
||||||
row-list matrix-rows.
|
|
||||||
bl \ ]M word. prettyprint> ;
|
|
||||||
|
|
|
@ -0,0 +1,28 @@
|
||||||
|
! Copyright (C) 2005 Slava Pestov.
|
||||||
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
|
|
||||||
|
IN: !syntax
|
||||||
|
USING: kernel lists math matrices parser sequences syntax
|
||||||
|
vectors ;
|
||||||
|
|
||||||
|
! Complex numbers
|
||||||
|
: #{ f ; parsing
|
||||||
|
: }# 2unlist swap rect> swons ; parsing
|
||||||
|
|
||||||
|
! Reading integers in other bases
|
||||||
|
: (BASE) ( base -- )
|
||||||
|
#! Reads an integer in a specific base.
|
||||||
|
scan swap base> swons ;
|
||||||
|
|
||||||
|
: HEX: 16 (BASE) ; parsing
|
||||||
|
: DEC: 10 (BASE) ; parsing
|
||||||
|
: OCT: 8 (BASE) ; parsing
|
||||||
|
: BIN: 2 (BASE) ; parsing
|
||||||
|
|
||||||
|
! Matrices
|
||||||
|
: M[ f ; parsing
|
||||||
|
|
||||||
|
: ]M
|
||||||
|
reverse
|
||||||
|
[ dup length swap car length ] keep
|
||||||
|
concat >vector <matrix> swons ; parsing
|
|
@ -52,10 +52,6 @@ BUILTIN: f 9 ; : f f swons ; parsing
|
||||||
: << f ; parsing
|
: << f ; parsing
|
||||||
: >> reverse literal-tuple swons ; parsing
|
: >> reverse literal-tuple swons ; parsing
|
||||||
|
|
||||||
! Complex numbers
|
|
||||||
: #{ f ; parsing
|
|
||||||
: }# 2unlist swap rect> swons ; parsing
|
|
||||||
|
|
||||||
! Do not execute parsing word
|
! Do not execute parsing word
|
||||||
: POSTPONE: ( -- ) scan-word swons ; parsing
|
: POSTPONE: ( -- ) scan-word swons ; parsing
|
||||||
|
|
||||||
|
@ -142,14 +138,3 @@ BUILTIN: f 9 ; : f f swons ; parsing
|
||||||
: #!
|
: #!
|
||||||
#! Documentation comment.
|
#! Documentation comment.
|
||||||
until-eol parsed-documentation ; parsing
|
until-eol parsed-documentation ; parsing
|
||||||
|
|
||||||
! Reading numbers in other bases
|
|
||||||
|
|
||||||
: (BASE) ( base -- )
|
|
||||||
#! Read a number in a specific base.
|
|
||||||
scan swap base> swons ;
|
|
||||||
|
|
||||||
: HEX: 16 (BASE) ; parsing
|
|
||||||
: DEC: 10 (BASE) ; parsing
|
|
||||||
: OCT: 8 (BASE) ; parsing
|
|
||||||
: BIN: 2 (BASE) ; parsing
|
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2003, 2005 Slava Pestov.
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factor.sf.net/license.txt for BSD license.
|
||||||
IN: prettyprint
|
IN: prettyprint
|
||||||
USING: alien errors generic hashtables kernel lists math memory
|
USING: alien errors generic hashtables kernel lists math
|
||||||
namespaces parser presentation sequences stdio streams strings
|
matrices memory namespaces parser presentation sequences stdio
|
||||||
unparser vectors words ;
|
streams strings unparser vectors words ;
|
||||||
|
|
||||||
SYMBOL: prettyprint-limit
|
SYMBOL: prettyprint-limit
|
||||||
SYMBOL: one-line
|
SYMBOL: one-line
|
||||||
|
@ -154,6 +154,15 @@ M: tuple prettyprint* ( indent tuple -- indent )
|
||||||
M: alien prettyprint* ( alien -- str )
|
M: alien prettyprint* ( alien -- str )
|
||||||
\ ALIEN: word. bl alien-address unparse write ;
|
\ ALIEN: word. bl alien-address unparse write ;
|
||||||
|
|
||||||
|
: matrix-rows. ( indent list -- indent )
|
||||||
|
uncons >r [ one-line on prettyprint* ] with-scope r>
|
||||||
|
[ over ?prettyprint-newline matrix-rows. ] when* ;
|
||||||
|
|
||||||
|
M: matrix prettyprint* ( indent obj -- indent )
|
||||||
|
\ M[ word. >r <prettyprint r>
|
||||||
|
row-list matrix-rows.
|
||||||
|
bl \ ]M word. prettyprint> ;
|
||||||
|
|
||||||
: prettyprint ( obj -- )
|
: prettyprint ( obj -- )
|
||||||
[
|
[
|
||||||
recursion-check off
|
recursion-check off
|
||||||
|
|
|
@ -1,6 +1,9 @@
|
||||||
IN: temporary
|
IN: temporary
|
||||||
USING: kernel lists sequences test ;
|
USING: kernel lists sequences test ;
|
||||||
|
|
||||||
|
[ 1 ] [ 0 [ 1 2 ] nth ] unit-test
|
||||||
|
[ 2 ] [ 1 [ 1 2 ] nth ] unit-test
|
||||||
|
|
||||||
[ [ ] ] [ [ ] [ ] append ] unit-test
|
[ [ ] ] [ [ ] [ ] append ] unit-test
|
||||||
[ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
|
[ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
|
||||||
[ [ 2 ] ] [ [ ] [ 2 ] append ] unit-test
|
[ [ 2 ] ] [ [ ] [ 2 ] append ] unit-test
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
IN: temporary
|
IN: temporary
|
||||||
USING: matrices test ;
|
USING: kernel lists matrices namespaces test ;
|
||||||
|
|
||||||
[
|
[
|
||||||
M[ [ 0 ] [ 0 ] [ 0 ] ]M
|
M[ [ 0 ] [ 0 ] [ 0 ] ]M
|
||||||
|
@ -34,7 +34,7 @@ USING: matrices test ;
|
||||||
[ 0 5 0 ]
|
[ 0 5 0 ]
|
||||||
[ 6 0 0 ] ]M
|
[ 6 0 0 ] ]M
|
||||||
|
|
||||||
v+
|
m+
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[
|
[
|
||||||
|
@ -50,19 +50,31 @@ USING: matrices test ;
|
||||||
[ 0 -5 0 ]
|
[ 0 -5 0 ]
|
||||||
[ -6 0 0 ] ]M
|
[ -6 0 0 ] ]M
|
||||||
|
|
||||||
v-
|
m-
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[
|
[
|
||||||
{ 10 20 30 }
|
{ 10 20 30 }
|
||||||
] [
|
] [
|
||||||
10 { 1 2 3 } v.
|
10 { 1 2 3 } n*v
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[
|
[
|
||||||
{ 10 20 30 }
|
M[ [ 6 ] ]M
|
||||||
] [
|
] [
|
||||||
{ 1 2 3 } 10 v.
|
M[ [ 3 ] ]M M[ [ 2 ] ]M m.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
M[ [ 11 ] ]M
|
||||||
|
] [
|
||||||
|
M[ [ 1 3 ] ]M M[ [ 5 ] [ 2 ] ]M m.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
[ [[ 0 0 ]] [[ 1 0 ]] ]
|
||||||
|
] [
|
||||||
|
[ 2 1 [ 2dup cons , ] 2repeat ] make-list
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[
|
[
|
||||||
|
@ -73,5 +85,16 @@ USING: matrices test ;
|
||||||
|
|
||||||
{ 3 4 }
|
{ 3 4 }
|
||||||
|
|
||||||
v.
|
m.v
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
{ 4 3 }
|
||||||
|
] [
|
||||||
|
M[ [ 0 1 ]
|
||||||
|
[ 1 0 ] ]M
|
||||||
|
|
||||||
|
{ 3 4 }
|
||||||
|
|
||||||
|
m.v
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -46,15 +46,15 @@ prettyprint sequences stdio streams strings words ;
|
||||||
TUPLE: jedit-stream ;
|
TUPLE: jedit-stream ;
|
||||||
|
|
||||||
M: jedit-stream stream-readln ( stream -- str )
|
M: jedit-stream stream-readln ( stream -- str )
|
||||||
wrapper-stream-scope
|
[
|
||||||
[ CHAR: r write flush read-big-endian-32 read ] bind ;
|
CHAR: r write flush read-big-endian-32 read
|
||||||
|
] with-wrapper ;
|
||||||
|
|
||||||
M: jedit-stream stream-write-attr ( str style stream -- )
|
M: jedit-stream stream-write-attr ( str style stream -- )
|
||||||
wrapper-stream-scope [ jedit-write-attr ] bind ;
|
[ jedit-write-attr ] with-wrapper ;
|
||||||
|
|
||||||
M: jedit-stream stream-flush ( stream -- )
|
M: jedit-stream stream-flush ( stream -- )
|
||||||
wrapper-stream-scope
|
[ CHAR: f write flush ] with-wrapper ;
|
||||||
[ CHAR: f write flush ] bind ;
|
|
||||||
|
|
||||||
C: jedit-stream ( stream -- stream )
|
C: jedit-stream ( stream -- stream )
|
||||||
[ >r <wrapper-stream> r> set-delegate ] keep ;
|
[ >r <wrapper-stream> r> set-delegate ] keep ;
|
||||||
|
|
Loading…
Reference in New Issue