fixing matrices; fixing examples

cvs
Slava Pestov 2005-05-03 08:40:13 +00:00
parent bbb5d90d31
commit 7a3a34d364
18 changed files with 219 additions and 174 deletions

50
CHANGES.txt Normal file
View File

@ -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.

View File

@ -2,30 +2,31 @@
- faster layout
- faster repaint
- implement fcopy
- win32 updates
- open large listener by default
- get all-tests to run with -no-compile
- scalar * matrix, vector * matrix, matrix * vector need to work
- make-matrix is slow and ugly
- 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
dictionary
- plugin: extra space in stack effects
- plugin: type "re" in edit word dialog --> hang
- word preview for parsing words
+ ui:
- console with presentations
- ui browser
- auto-updating inspector, mirrors abstraction
- word preview for parsing words
- mouse enter onto overlapping with interior, but not child, gadget
- menu dragging
- fix up the min thumb size hack
- frame gap
- tiled window manager
- rotating cube demo
+ ffi:
@ -44,6 +45,8 @@
+ 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
- [ [ dup call ] dup call ] infer hangs
- more accurate types for various words
@ -66,15 +69,16 @@
- ensure-capacity: don't be generic
- vector's ensure-capacity will crash if not given fixnums!
- dipping seq-2nmap, seq-2each
- remove seq- prefixes
- generic each some? all? member? memq? all=? top
index? subseq?
- generic each some? all? member? memq? all=? index? subseq? map
- index and index* are very slow with lists
- list map, subset, project, append: not tail recursive
- phase out sbuf-append
- decide what to do with index-of
- list map, subset: not tail recursive
- phase out sbuf-append, index-of, substring
- unsafe-sbuf>string
- generic subseq
- GENERIC: map
- list impl same as now
- generic parser::scan
- array sort
+ kernel:
@ -92,9 +96,11 @@
- generational gc
- doc comments of generics
- M: object should not inhibit delegation
- renumber types appopriately
+ i/o:
- faster stream-copy
- rename prettyprint to pprint
- reading and writing byte arrays
- merge unix and win32 io where appropriate
@ -108,21 +114,21 @@
- stream server can hang because of exception handler limitations
- better i/o scheduler
- add a socket timeout
- renumber types appopriately
- unify unparse and prettyprint
- utf16, utf8 encoding
+ nice to have libraries:
- regexps
- XML
- HTTP client
- real Unicode support (strings are already 16 bits and can be extended
to 21 if the need arises, but we need full character classification
predicates, comparison, case conversion, sorting...)
- full Win32 binding
- Cairo binding
+ httpd:
+ http:
- http client post requests
- virtual hosts
- keep alive

View File

@ -1,9 +1,5 @@
IN: format
USE: kernel
USE: math
USE: namespaces
USE: strings
USE: test
USING: kernel math sequences strings test ;
: decimal-split ( string -- string string )
#! Split a string before and after the decimal point.
@ -11,12 +7,12 @@ USE: test
: decimal-tail ( count str -- string )
#! 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 )
#! If after is of zero length, return before, otherwise
#! return "before.after".
dup string-length 0 = [
dup length 0 = [
drop
] [
"." swap cat3

View File

@ -1,16 +1,8 @@
! A simple IRC client written in Factor.
IN: irc
USE: generic
USE: stdio
USE: namespaces
USE: streams
USE: kernel
USE: threads
USE: lists
USE: strings
USE: words
USE: math
USING: kernel lists math namespaces stdio streams strings
threads words ;
SYMBOL: irc-stream
SYMBOL: channels
@ -78,7 +70,7 @@ M: privmsg irc-display ( line -- )
channel get [ (msg) ] [ "No channel." print ] 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 -- )
[

View File

@ -8,7 +8,7 @@ USING: sequences kernel math stdio strings ;
} nth >r 4 * dup 4 + r> substring ;
: 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 )
3 [ 2dup lcd-row terpri ] repeat drop ;

View File

@ -1,20 +1,9 @@
USE: random
USE: kernel
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 ;
IN: random
USING: kernel lists math namespaces sequences test ;
: random-element ( list -- random )
#! 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 = ;
@ -78,7 +67,7 @@ USE: namespaces
[[ 20 f ]]
[[ 30 "monkey" ]]
[[ 24 1/2 ]]
[ 13 | { "Hello" "Banana" } ]
[[ 13 { "Hello" "Banana" } ]]
] "random-pairs" set
"random-pairs" get [ cdr ] map "random-values" set
@ -94,8 +83,4 @@ USE: namespaces
"random-pairs" get
check-random-subset
] 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

View File

@ -34,6 +34,7 @@ hashtables ;
"/library/collections/hashtables.factor"
"/library/collections/namespaces.factor"
"/library/collections/sbuf.factor"
"/library/math/matrices.factor"
"/library/words.factor"
"/library/vocabularies.factor"
"/library/errors.factor"
@ -49,6 +50,7 @@ hashtables ;
"/library/syntax/parser.factor"
"/library/syntax/parse-stream.factor"
"/library/syntax/generic.factor"
"/library/syntax/math.factor"
"/library/syntax/parse-syntax.factor"
"/library/alien/aliens.factor"
"/library/cli.factor"

View File

@ -19,10 +19,6 @@ t [
"/library/syntax/unparser.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/gensym.factor"
"/library/tools/interpreter.factor"

View File

@ -129,7 +129,8 @@ M: cons hashcode ( cons -- hash ) car hashcode ;
#! Return the rest of the list, from the nth index onward.
[ 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 )
#! Make a list of elements that occur in both lists.

View File

@ -106,7 +106,7 @@ stdio streams strings unparser http ;
TUPLE: html-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
] icon-tag
] browser-link-tag
] bind ;
] with-wrapper ;
C: html-stream ( stream -- stream )
#! Wraps the given stream in an HTML stream. An HTML stream

View File

@ -54,12 +54,14 @@ M: sbuf stream-auto-flush drop ;
TUPLE: wrapper-stream scope ;
C: wrapper-stream ( stream -- stream )
2dup set-delegate
[
2dup set-delegate [
>r <namespace> [ stdio set ] extend r>
set-wrapper-stream-scope
] keep ;
: with-wrapper ( stream quot -- )
>r wrapper-stream-scope r> bind ;
! Combine an input and output stream into one, and flush the
! stream more often.
TUPLE: duplex-stream in out flush? ;

View File

@ -1,48 +1,31 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: matrices
USING: errors generic kernel lists math namespaces prettyprint
sequences stdio test vectors ;
USING: errors generic kernel lists math namespaces sequences
vectors ;
! The major dimension is the number of elements per row.
TUPLE: matrix rows cols sequence ;
! 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 ;
: n*v ( n vec -- vec )
#! Multiply a vector by a scalar.
[ * ] seq-map-with ;
! Vector operations
DEFER: <row-vector>
DEFER: <col-vector>
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 ;
: v+ ( v v -- v ) [ + ] seq-2map ;
: v- ( v v -- v ) [ - ] seq-2map ;
: v* ( v v -- v ) [ * ] seq-2map ;
! 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 ;
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. ;
: v. ( v v -- x ) v* +/ ;
! 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 )
clone-tuple
dup matrix-sequence clone over set-matrix-sequence ;
@ -79,9 +62,8 @@ SYMBOL: matrix-maker
2dup <zero-matrix> matrix set
[
[
[
swap matrix-maker get call
] 2keep matrix get matrix-set
[ matrix-maker get call ] 2keep
matrix get matrix-set
] 2keep
] 2repeat
matrix get
@ -103,77 +85,62 @@ M: row length row-matrix matrix-cols ;
M: row nth ( n row -- ) >row< swapd matrix-get ;
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.
TUPLE: col index matrix ;
: >col< dup col-index swap col-matrix ;
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 ;
! A sequence of columns.
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 ( matrix matrix -- )
#! Check if the two matrices have dimensions compatible
#! for being added or subtracted.
over matrix-rows over matrix-rows = >r
over matrix-cols over matrix-cols = r> and [
"Matrix dimensions do not match" throw
swap matrix-cols swap matrix-cols = r> and [
"Matrix dimensions do not equal" throw
] unless ;
: +dimensions ( matrix -- rows cols )
dup matrix-rows swap matrix-cols ;
: element-wise ( m m -- v v )
2dup +check >r >matrix< r> matrix-sequence ;
: matrix+/-
+check
>r dup +dimensions rot r>
swap matrix-sequence swap matrix-sequence ;
! Matrix operations
: m+ ( m m -- m ) element-wise v+ <matrix> ;
: m- ( m m -- m ) element-wise v- <matrix> ;
M: matrix v+ ( m m -- m ) matrix+/- v+ <matrix> ;
M: matrix v- ( m m -- m ) matrix+/- v- <matrix> ;
M: matrix v* ( m m -- m ) matrix+/- v* <matrix> ;
: m* ( m m -- m )
#! Multiply two matrices element-wise. This is NOT matrix
#! multiplication in the usual mathematical sense. For that,
#! see the m. word.
element-wise v* <matrix> ;
: *check ( matrix matrix -- matrix matrix )
over matrix-rows over matrix-cols = >r
over matrix-cols over matrix-rows = r> and [
: *check ( matrix matrix -- )
swap matrix-cols swap matrix-rows = [
"Matrix dimensions inappropriate for composition" throw
] unless ;
: *dimensions ( m m -- rows cols )
swap matrix-rows swap matrix-cols ;
M: matrix v. ( m1 m2 -- m )
2dup *dimensions [
( m1 m2 row col )
: m. ( m1 m2 -- m )
#! Composition of two matrices.
2dup *check 2dup *dimensions [
( m1 m2 row col -- m1 m2 )
>r >r 2dup r> rot <row> r> rot <col> v.
] 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
reverse
[ dup length swap car length ] keep
concat >vector <matrix> swons ; parsing
: v.m ( v m -- v )
#! Multiply a row vector by a matrix.
>r <row-vector> r> m. matrix-sequence ;
: row-list ( matrix -- list )
#! A list of lists, where each sublist is a row of the
#! matrix.
[ <row-seq> [ >list , ] seq-each ] make-list ;
: 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> ;
dup matrix-rows [ swap <row> >list ] project-with ;

View File

@ -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

View File

@ -52,10 +52,6 @@ BUILTIN: f 9 ; : f f swons ; parsing
: << f ; parsing
: >> reverse literal-tuple swons ; parsing
! Complex numbers
: #{ f ; parsing
: }# 2unlist swap rect> swons ; parsing
! Do not execute parsing word
: POSTPONE: ( -- ) scan-word swons ; parsing
@ -142,14 +138,3 @@ BUILTIN: f 9 ; : f f swons ; parsing
: #!
#! Documentation comment.
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

View File

@ -1,9 +1,9 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: prettyprint
USING: alien errors generic hashtables kernel lists math memory
namespaces parser presentation sequences stdio streams strings
unparser vectors words ;
USING: alien errors generic hashtables kernel lists math
matrices memory namespaces parser presentation sequences stdio
streams strings unparser vectors words ;
SYMBOL: prettyprint-limit
SYMBOL: one-line
@ -154,6 +154,15 @@ M: tuple prettyprint* ( indent tuple -- indent )
M: alien prettyprint* ( alien -- str )
\ 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 -- )
[
recursion-check off

View File

@ -1,6 +1,9 @@
IN: temporary
USING: kernel lists sequences test ;
[ 1 ] [ 0 [ 1 2 ] nth ] unit-test
[ 2 ] [ 1 [ 1 2 ] nth ] unit-test
[ [ ] ] [ [ ] [ ] append ] unit-test
[ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
[ [ 2 ] ] [ [ ] [ 2 ] append ] unit-test

View File

@ -1,5 +1,5 @@
IN: temporary
USING: matrices test ;
USING: kernel lists matrices namespaces test ;
[
M[ [ 0 ] [ 0 ] [ 0 ] ]M
@ -34,7 +34,7 @@ USING: matrices test ;
[ 0 5 0 ]
[ 6 0 0 ] ]M
v+
m+
] unit-test
[
@ -50,19 +50,31 @@ USING: matrices test ;
[ 0 -5 0 ]
[ -6 0 0 ] ]M
v-
m-
] unit-test
[
{ 10 20 30 }
] [
10 { 1 2 3 } v.
10 { 1 2 3 } n*v
] 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
[
@ -73,5 +85,16 @@ USING: matrices test ;
{ 3 4 }
v.
m.v
] unit-test
[
{ 4 3 }
] [
M[ [ 0 1 ]
[ 1 0 ] ]M
{ 3 4 }
m.v
] unit-test

View File

@ -46,15 +46,15 @@ prettyprint sequences stdio streams strings words ;
TUPLE: jedit-stream ;
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 -- )
wrapper-stream-scope [ jedit-write-attr ] bind ;
[ jedit-write-attr ] with-wrapper ;
M: jedit-stream stream-flush ( stream -- )
wrapper-stream-scope
[ CHAR: f write flush ] bind ;
[ CHAR: f write flush ] with-wrapper ;
C: jedit-stream ( stream -- stream )
[ >r <wrapper-stream> r> set-delegate ] keep ;