Merge commit 'erg/master'
Slava Pestov
commit
02fc6cdaed
|
|
@ -0,0 +1,7 @@
|
|||
USING: crypto.sha1 io.files kernel ;
|
||||
IN: benchmark.sha1
|
||||
|
||||
: sha1-primes-list ( -- seq )
|
||||
"extra/math/primes/list/list.factor" resource-path file>sha1 ;
|
||||
|
||||
MAIN: sha1-primes-list
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup channels ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: channels
|
||||
|
||||
HELP: <channel>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup channels channels.remote concurrency.distributed ;
|
||||
USING: help.syntax help.markup channels concurrency.distributed ;
|
||||
IN: channels.remote
|
||||
|
||||
HELP: <remote-channel>
|
||||
|
|
@ -59,4 +59,4 @@ $nl
|
|||
{ $snippet "\"myhost.com\" 9001 <node> \"ID123456\" <remote-channel>\n\"hello\" over to" }
|
||||
;
|
||||
|
||||
ABOUT: { "remote-channels" "remote-channels" }
|
||||
ABOUT: { "remote-channels" "remote-channels" }
|
||||
|
|
|
|||
|
|
@ -0,0 +1,3 @@
|
|||
USING: io.backend ;
|
||||
|
||||
HOOK: sniff-channel io-backend ( -- channel )
|
||||
|
|
@ -2,8 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! Wrap a sniffer in a channel
|
||||
USING: kernel channels channels.sniffer concurrency io
|
||||
io.sniffer io.sniffer.bsd io.unix.backend ;
|
||||
USING: kernel channels channels.sniffer.backend concurrency io
|
||||
io.sniffer.backend io.sniffer.bsd io.unix.backend ;
|
||||
IN: channels.sniffer.bsd
|
||||
|
||||
M: unix-io sniff-channel ( -- channel )
|
||||
"/dev/bpf0" "en1" <sniffer-spec> <sniffer> <channel> [
|
||||
|
|
|
|||
|
|
@ -3,11 +3,9 @@
|
|||
!
|
||||
! Wrap a sniffer in a channel
|
||||
USING: kernel channels concurrency io io.backend
|
||||
io.sniffer system vocabs.loader ;
|
||||
io.sniffer io.sniffer.backend system vocabs.loader ;
|
||||
|
||||
: (sniff-channel) ( stream channel -- )
|
||||
4096 pick stream-read-partial over to (sniff-channel) ;
|
||||
|
||||
HOOK: sniff-channel io-backend ( -- channel )
|
||||
|
||||
bsd? [ "channels.sniffer.bsd" require ] when
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
|
||||
USING: help.markup help.syntax coroutines ;
|
||||
USING: help.markup help.syntax ;
|
||||
IN: coroutines
|
||||
|
||||
HELP: cocreate
|
||||
{ $values { "quot" "a quotation with stack effect ( value -- )" } { "co" "a coroutine" } }
|
||||
|
|
@ -51,4 +52,4 @@ HELP: coterminate
|
|||
HELP: current-coro
|
||||
{ $description "Variable which contains the currently executing coroutine, or " { $link f } " if none is executing. User code should treat this variable as read-only." }
|
||||
{ $see-also cocreate coresume coyield }
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -12,14 +12,11 @@ USING: alien kernel system combinators alien.syntax ;
|
|||
|
||||
IN: cryptlib.libcl
|
||||
|
||||
: load-libcl ( -- )
|
||||
"libcl" {
|
||||
<< "libcl" {
|
||||
{ [ win32? ] [ "cl32.dll" "stdcall" ] }
|
||||
{ [ macosx? ] [ "libcl.dylib" "cdecl" ] }
|
||||
{ [ unix? ] [ "libcl.so" "cdecl" ] }
|
||||
} cond add-library ; parsing
|
||||
|
||||
load-libcl
|
||||
} cond add-library >>
|
||||
|
||||
! ===============================================
|
||||
! Machine-dependant types
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: help.markup help.syntax kernel math sequences quotations
|
||||
crypto.common crypto.md5 ;
|
||||
crypto.common ;
|
||||
IN: crypto.md5
|
||||
|
||||
HELP: stream>md5
|
||||
{ $values { "stream" "a stream" } { "byte-array" "md5 hash" } }
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
USING: definitions help help.markup help.syntax io io.files
|
||||
editors words ;
|
||||
USING: definitions help help.markup help.syntax io io.files editors words ;
|
||||
IN: editors.vim
|
||||
|
||||
ARTICLE: { "vim" "vim" } "Vim support"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! -*-factor-*-
|
||||
|
||||
USING: kernel unix vars mortar slot-accessors
|
||||
USING: kernel unix vars mortar mortar.sugar slot-accessors
|
||||
x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu
|
||||
factory.commands factory.load ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel parser io io.files namespaces sequences editors threads vars
|
||||
mortar slot-accessors
|
||||
mortar mortar.sugar slot-accessors
|
||||
x
|
||||
x.widgets.wm.root
|
||||
x.widgets.wm.frame
|
||||
|
|
|
|||
|
|
@ -0,0 +1,14 @@
|
|||
IN: hardware-info.backend
|
||||
|
||||
SYMBOL: os
|
||||
HOOK: cpus os ( -- n )
|
||||
|
||||
HOOK: memory-load os ( -- n )
|
||||
HOOK: physical-mem os ( -- n )
|
||||
HOOK: available-mem os ( -- n )
|
||||
HOOK: total-page-file os ( -- n )
|
||||
HOOK: available-page-file os ( -- n )
|
||||
HOOK: total-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-extended-mem os ( -- n )
|
||||
|
||||
|
|
@ -1,26 +1,15 @@
|
|||
USING: alien.syntax math prettyprint system combinators
|
||||
vocabs.loader ;
|
||||
USING: alien.syntax kernel math prettyprint system
|
||||
combinators vocabs.loader hardware-info.backend ;
|
||||
IN: hardware-info
|
||||
|
||||
SYMBOL: os
|
||||
HOOK: cpus os ( -- n )
|
||||
|
||||
HOOK: memory-load os ( -- n )
|
||||
HOOK: physical-mem os ( -- n )
|
||||
HOOK: available-mem os ( -- n )
|
||||
HOOK: total-page-file os ( -- n )
|
||||
HOOK: available-page-file os ( -- n )
|
||||
HOOK: total-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-extended-mem os ( -- n )
|
||||
|
||||
: kb. ( x -- ) 10 2^ /f . ;
|
||||
: megs. ( x -- ) 20 2^ /f . ;
|
||||
: gigs. ( x -- ) 30 2^ /f . ;
|
||||
|
||||
{
|
||||
<< {
|
||||
{ [ windows? ] [ "hardware-info.windows" ] }
|
||||
{ [ linux? ] [ "hardware-info.linux" ] }
|
||||
{ [ macosx? ] [ "hardware-info.macosx" ] }
|
||||
} cond require
|
||||
{ [ t ] [ f ] }
|
||||
} cond [ require ] when* >>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: alien alien.c-types alien.syntax byte-arrays kernel
|
||||
namespaces sequences unix hardware-info ;
|
||||
namespaces sequences unix hardware-info.backend ;
|
||||
IN: hardware-info.macosx
|
||||
|
||||
TUPLE: macosx ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: alien.c-types hardware-info hardware-info.windows
|
||||
kernel math namespaces windows windows.kernel32 ;
|
||||
kernel math namespaces windows windows.kernel32
|
||||
hardware-info.backend ;
|
||||
IN: hardware-info.windows.ce
|
||||
|
||||
T{ wince } os set-global
|
||||
|
|
@ -29,5 +30,3 @@ M: wince total-virtual-mem ( -- n )
|
|||
|
||||
M: wince available-virtual-mem ( -- n )
|
||||
memory-status MEMORYSTATUS-dwAvailVirtual ;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: alien alien.c-types hardware-info hardware-info.windows
|
||||
kernel libc math namespaces
|
||||
kernel libc math namespaces hardware-info.backend
|
||||
windows windows.advapi32 windows.kernel32 ;
|
||||
IN: hardware-info.windows.nt
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: alien alien.c-types kernel libc math namespaces
|
||||
windows windows.kernel32 windows.advapi32 hardware-info
|
||||
words combinators vocabs.loader ;
|
||||
windows windows.kernel32 windows.advapi32
|
||||
words combinators vocabs.loader hardware-info.backend ;
|
||||
IN: hardware-info.windows
|
||||
|
||||
TUPLE: wince ;
|
||||
|
|
@ -70,7 +70,8 @@ M: windows cpus ( -- n )
|
|||
: system-windows-directory ( -- str )
|
||||
\ GetSystemWindowsDirectory get-directory ;
|
||||
|
||||
{
|
||||
<< {
|
||||
{ [ wince? ] [ "hardware-info.windows.ce" ] }
|
||||
{ [ winnt? ] [ "hardware-info.windows.nt" ] }
|
||||
} cond require
|
||||
{ [ t ] [ f ] }
|
||||
} cond [ require ] when* >>
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@ USING: assocs circular combinators continuations hashtables
|
|||
hashtables.private io kernel math
|
||||
namespaces prettyprint quotations sequences splitting
|
||||
state-parser strings ;
|
||||
USING: html.parser ;
|
||||
IN: html.parser.utils
|
||||
|
||||
: string-parse-end?
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax http.basic-authentication crypto.sha2 ;
|
||||
USING: help.markup help.syntax crypto.sha2 ;
|
||||
IN: http.basic-authentication
|
||||
|
||||
HELP: realms
|
||||
{ $description
|
||||
|
|
@ -65,4 +66,4 @@ $nl
|
|||
"it is best to use Basic Authentication with SSL." ;
|
||||
|
||||
IN: http.basic-authentication
|
||||
ABOUT: { "http-authentication" "basic-authentication" }
|
||||
ABOUT: { "http-authentication" "basic-authentication" }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Coyright (C) 2007 Adam Wendt
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: id3 help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: id3
|
||||
|
||||
ARTICLE: "id3-tags" "ID3 Tags"
|
||||
"The " { $vocab-link "id3" } " vocabulary is used to read ID3 tags from MP3 audio streams."
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
USING: inverse help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: inverse
|
||||
|
||||
HELP: [undo]
|
||||
{ $values { "quot" "a quotation" } { "undo" "the inverse of the quotation" } }
|
||||
|
|
|
|||
|
|
@ -63,7 +63,9 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
|||
{
|
||||
{ [ dup word? not over symbol? or ] [ , ] }
|
||||
{ [ dup explicit-inverse? ] [ , ] }
|
||||
{ [ dup compound? over { if dispatch } member? not and ]
|
||||
! { [ dup compound? over { if dispatch } member? not and ]
|
||||
! [ word-def [ inline-word ] each ] }
|
||||
{ [ dup word? over { if dispatch } member? not and ]
|
||||
[ word-def [ inline-word ] each ] }
|
||||
{ [ drop t ] [ "Quotation is not invertible" throw ] }
|
||||
} cond ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
USING: io.backend kernel system vocabs.loader ;
|
||||
IN: io.sniffer.backend
|
||||
|
||||
SYMBOL: sniffer-type
|
||||
TUPLE: sniffer ;
|
||||
HOOK: <sniffer> io-backend ( obj -- sniffer )
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2007 Elie Chaftari, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax destructors hexdump io
|
||||
io.buffers io.nonblocking io.sniffer io.sockets io.streams.lines
|
||||
io.buffers io.nonblocking io.sockets io.streams.lines
|
||||
io.unix.backend io.unix.files kernel libc locals math qualified
|
||||
sequences ;
|
||||
sequences io.sniffer.backend ;
|
||||
QUALIFIED: unix
|
||||
IN: io.sniffer.bsd
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,17 @@
|
|||
USING: byte-arrays combinators io io.backend
|
||||
io.sockets.headers io.sniffer.backend kernel
|
||||
prettyprint sequences ;
|
||||
IN: io.sniffer.filter.backend
|
||||
|
||||
HOOK: sniffer-loop io-backend ( stream -- )
|
||||
HOOK: packet. io-backend ( string -- )
|
||||
|
||||
: (packet.) ( string -- )
|
||||
dup 14 head >byte-array
|
||||
"--Ethernet Header--" print
|
||||
dup etherneth.
|
||||
dup etherneth-type {
|
||||
! HEX: 800 [ ] ! IP
|
||||
! HEX: 806 [ ] ! ARP
|
||||
[ "Unknown type: " write .h ]
|
||||
} case 2drop ;
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
USING: alien.c-types hexdump io io.backend io.sockets.headers
|
||||
io.sockets.headers.bsd kernel io.sniffer io.sniffer.bsd
|
||||
io.sniffer.filter io.streams.string io.unix.backend math
|
||||
sequences system byte-arrays ;
|
||||
io.streams.string io.unix.backend math
|
||||
sequences system byte-arrays io.sniffer.filter.backend
|
||||
io.sniffer.filter.backend io.sniffer.backend ;
|
||||
IN: io.sniffer.filter.bsd
|
||||
|
||||
! http://www.iana.org/assignments/ethernet-numbers
|
||||
|
|
|
|||
|
|
@ -1,19 +1,8 @@
|
|||
USING: alien.c-types byte-arrays combinators hexdump io
|
||||
io.backend io.streams.string io.sockets.headers kernel math
|
||||
prettyprint io.sniffer sequences system vocabs.loader ;
|
||||
prettyprint io.sniffer sequences system vocabs.loader
|
||||
io.sniffer.filter.backend ;
|
||||
IN: io.sniffer.filter
|
||||
|
||||
HOOK: sniffer-loop io-backend ( stream -- )
|
||||
HOOK: packet. io-backend ( string -- )
|
||||
|
||||
: (packet.) ( string -- )
|
||||
dup 14 head >byte-array
|
||||
"--Ethernet Header--" print
|
||||
dup etherneth.
|
||||
dup etherneth-type {
|
||||
! HEX: 800 [ ] ! IP
|
||||
! HEX: 806 [ ] ! ARP
|
||||
[ "Unknown type: " write .h ]
|
||||
} case 2drop ;
|
||||
|
||||
bsd? [ "io.sniffer.filter.bsd" require ] when
|
||||
|
|
|
|||
|
|
@ -1,10 +1,4 @@
|
|||
USING: io.backend kernel system vocabs.loader ;
|
||||
IN: io.sniffer
|
||||
|
||||
SYMBOL: sniffer-type
|
||||
|
||||
TUPLE: sniffer ;
|
||||
|
||||
HOOK: <sniffer> io-backend ( obj -- sniffer )
|
||||
|
||||
bsd? [ "io.sniffer.bsd" require ] when
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: kernel opengl arrays sequences jamshred jamshred.tunnel
|
||||
USING: kernel opengl arrays sequences jamshred.tunnel
|
||||
jamshred.player math.vectors ;
|
||||
IN: jamshred.game
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: colors jamshred.game jamshred.oint jamshred.tunnel kernel
|
||||
USING: colors jamshred.oint jamshred.tunnel kernel
|
||||
math math.constants sequences ;
|
||||
IN: jamshred.player
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax json.reader ;
|
||||
USING: help.markup help.syntax ;
|
||||
IN: json.reader
|
||||
|
||||
HELP: json> "( string -- object )"
|
||||
{ $values { "string" "a string in JSON format" } { "object" "yhe object deserialized from the JSON string" } }
|
||||
{ $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
|
||||
{ $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax json.writer ;
|
||||
USING: help.markup help.syntax ;
|
||||
IN: json.writer
|
||||
|
||||
HELP: >json "( obj -- string )"
|
||||
{ $values { "obj" "an object" } { "string" "the object converted to JSON format" } }
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ GENERIC: json-print ( obj -- )
|
|||
[ json-print ] string-out ;
|
||||
|
||||
M: f json-print ( f -- )
|
||||
"false" write ;
|
||||
drop "false" write ;
|
||||
|
||||
M: string json-print ( obj -- )
|
||||
CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ USING: kernel parser namespaces io prettyprint math arrays sequences
|
|||
|
||||
IN: lisp.listener
|
||||
|
||||
: parse-stdio ( -- quot/f ) stdio get parse-interactive ;
|
||||
: parse-stdio ( -- quot/f ) stdio get read-quot ;
|
||||
|
||||
: stuff? ( -- ? ) datastack length 0 > ;
|
||||
|
||||
|
|
@ -25,4 +25,4 @@ use [ clone ] change
|
|||
{ "lisp" "lisp.syntax" } add-use
|
||||
! [ listener-hook get call prompt. lisp-listen ] until-quit
|
||||
until-quit
|
||||
] with-scope ;
|
||||
] with-scope ;
|
||||
|
|
|
|||
|
|
@ -4,14 +4,11 @@
|
|||
USING: alien alien.c-types alien.syntax combinators kernel math system ;
|
||||
IN: mad
|
||||
|
||||
: load-mad-library ( -- )
|
||||
"mad" {
|
||||
<< "mad" {
|
||||
{ [ macosx? ] [ "libmad.0.dylib" ] }
|
||||
{ [ unix? ] [ "libmad.so" ] }
|
||||
{ [ windows? ] [ "mad.dll" ] }
|
||||
} cond "cdecl" add-library ; parsing
|
||||
|
||||
load-mad-library
|
||||
} cond "cdecl" add-library >>
|
||||
|
||||
LIBRARY: mad
|
||||
|
||||
|
|
|
|||
|
|
@ -26,10 +26,8 @@ TUPLE: positive-even-expected n ;
|
|||
dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
|
||||
|
||||
: factor-2s ( n -- r s )
|
||||
#! factor an even number into s * 2 ^ r
|
||||
dup even? over 0 > and [
|
||||
positive-even-expected construct-boa throw
|
||||
] unless 0 swap (factor-2s) ;
|
||||
#! factor an integer into s * 2^r
|
||||
0 swap (factor-2s) ;
|
||||
|
||||
:: (miller-rabin) | n prime?! |
|
||||
n 1- factor-2s s set r set
|
||||
|
|
|
|||
|
|
@ -1,20 +1,23 @@
|
|||
USING: help.markup help.syntax ;
|
||||
USING: help.markup help.syntax math sequences ;
|
||||
IN: math.primes.factors
|
||||
|
||||
{ factors count-factors unique-factors } related-words
|
||||
{ factors group-factors unique-factors } related-words
|
||||
|
||||
HELP: factors
|
||||
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
|
||||
{ $description { "Factorize an integer and return an ordered list of factors, possibly repeated." } } ;
|
||||
{ $values { "n" "a positive integer" } { "seq" sequence } }
|
||||
{ $description { "Return an ordered list of a number's prime factors, possibly repeated." } }
|
||||
{ $examples { $example "300 factors ." "{ 2 2 3 5 5 }" } } ;
|
||||
|
||||
HELP: count-factors
|
||||
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
|
||||
{ $description { "Return a sequence of pairs representing each factor in the number and its corresponding power." } } ;
|
||||
HELP: group-factors
|
||||
{ $values { "n" "a positive integer" } { "seq" sequence } }
|
||||
{ $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } }
|
||||
{ $examples { $example "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ;
|
||||
|
||||
HELP: unique-factors
|
||||
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
|
||||
{ $description { "Return an ordered list of unique prime factors." } } ;
|
||||
{ $values { "n" "a positive integer" } { "seq" sequence } }
|
||||
{ $description { "Return an ordered list of a number's unique prime factors." } }
|
||||
{ $examples { $example "300 unique-factors ." "{ 2 3 5 }" } } ;
|
||||
|
||||
HELP: totient
|
||||
{ $values { "n" "a positive integer" } { "t" "an integer" } }
|
||||
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " relatively prime to " { $snippet "n" } "." } } ;
|
||||
{ $values { "n" "a positive integer" } { "t" integer } }
|
||||
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: math.primes.factors tools.test ;
|
||||
|
||||
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
|
||||
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 count-factors ] unit-test
|
||||
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
|
||||
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
|
||||
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
|
||||
|
|
|
|||
|
|
@ -6,36 +6,36 @@ IN: math.primes.factors
|
|||
<PRIVATE
|
||||
|
||||
: (factor) ( n d -- n' )
|
||||
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
|
||||
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
|
||||
|
||||
: (count) ( n d -- n' )
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
|
||||
|
||||
: (unique) ( n d -- n' )
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ first , ] if ;
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ first , ] if ;
|
||||
|
||||
: (factors) ( quot list n -- )
|
||||
dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
|
||||
dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
|
||||
|
||||
: (decompose) ( n quot -- seq )
|
||||
[ lprimes rot (factors) ] { } make ;
|
||||
[ lprimes rot (factors) ] { } make ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: factors ( n -- seq )
|
||||
[ (factor) ] (decompose) ; foldable
|
||||
[ (factor) ] (decompose) ; foldable
|
||||
|
||||
: count-factors ( n -- seq )
|
||||
[ (count) ] (decompose) ; foldable
|
||||
: group-factors ( n -- seq )
|
||||
[ (count) ] (decompose) ; foldable
|
||||
|
||||
: unique-factors ( n -- seq )
|
||||
[ (unique) ] (decompose) ; foldable
|
||||
[ (unique) ] (decompose) ; foldable
|
||||
|
||||
: totient ( n -- t )
|
||||
dup 2 < [
|
||||
drop 0
|
||||
] [
|
||||
[ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep *
|
||||
] if ; foldable
|
||||
dup 2 < [
|
||||
drop 0
|
||||
] [
|
||||
dup unique-factors dup 1 [ 1- * ] reduce swap product / *
|
||||
] if ; foldable
|
||||
|
|
|
|||
|
|
@ -1,50 +1,50 @@
|
|||
USING: help.markup help.syntax debugger ;
|
||||
IN: math.statistics
|
||||
IN: math.statistics
|
||||
|
||||
HELP: geometric-mean
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
|
||||
{ $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." }
|
||||
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } }
|
||||
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } }
|
||||
{ $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ;
|
||||
|
||||
HELP: harmonic-mean
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
|
||||
{ $description "Computes the harmonic mean of the elements in " { $snippet "seq" } ". The harmonic mean is appropriate when the average of rates is desired." }
|
||||
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } harmonic-mean ." "6/11" } }
|
||||
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } harmonic-mean ." "6/11" } }
|
||||
{ $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
|
||||
|
||||
HELP: mean
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
|
||||
{ $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." }
|
||||
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } mean ." "2" } }
|
||||
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } mean ." "2" } }
|
||||
{ $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
|
||||
|
||||
HELP: median
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
|
||||
{ $description "Computes the median of " { $snippet "seq" } " by sorting the sequence from lowest value to highest and outputting the middle one. If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is outputted." }
|
||||
{ $examples
|
||||
{ $examples
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 } median ." "2" }
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 4 } median ." "5/2" } }
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 4 } median ." "5/2" } }
|
||||
{ $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
|
||||
|
||||
HELP: range
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
|
||||
{ $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." }
|
||||
{ $examples
|
||||
{ $examples
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 } range ." "2" }
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 4 } range ." "3" } } ;
|
||||
|
||||
HELP: std
|
||||
{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
|
||||
{ $description "Computes the standard deviation of " { $snippet "seq" } " by squaring the variance of the sequence. It measures how widely spread the values in a sequence are about the mean." }
|
||||
{ $examples
|
||||
{ $examples
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 } std ." "1.0" }
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 4 } std ." "1.290994448735806" } } ;
|
||||
|
||||
HELP: ste
|
||||
{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
|
||||
{ $description "Computes the standard error of the mean for " { $snippet "seq" } ". It's defined as the standard deviation divided by the square root of the length of the sequence, and measures uncertainty associated with the estimate of the mean." }
|
||||
{ $examples
|
||||
{ $examples
|
||||
{ $example "USE: math.statistics" "{ -2 2 } ste ." "2.0" }
|
||||
{ $example "USE: math.statistics" "{ -2 2 2 } ste ." "1.333333333333333" } } ;
|
||||
|
||||
|
|
@ -52,7 +52,7 @@ HELP: var
|
|||
{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
|
||||
{ $description "Computes the variance of " { $snippet "seq" } ". It's a measurement of the spread of values in a sequence. The larger the variance, the larger the distance of values from the mean." }
|
||||
{ $notes "If the number of elements in " { $snippet "seq" } " is 1 or less, it outputs 0." }
|
||||
{ $examples
|
||||
{ $examples
|
||||
{ $example "USE: math.statistics" "{ 1 } var ." "0" }
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 } var ." "1" }
|
||||
{ $example "USE: math.statistics" "{ 1 2 3 4 } var ." "5/3" } } ;
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ over object-class class-methods 1 head* assoc-stack call ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: new* ( class -- object ) <<- create ;
|
||||
! : new* ( class -- object ) <<- create ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -136,13 +136,20 @@ IN: slot-accessors
|
|||
|
||||
IN: mortar
|
||||
|
||||
! : generate-slot-getter ( name -- )
|
||||
! "$" over append "slot-accessors" create swap [ slot-value ] curry
|
||||
! define-compound ;
|
||||
|
||||
: generate-slot-getter ( name -- )
|
||||
"$" over append "slot-accessors" create swap [ slot-value ] curry
|
||||
define-compound ;
|
||||
"$" over append "slot-accessors" create swap [ slot-value ] curry define ;
|
||||
|
||||
! : generate-slot-setter ( name -- )
|
||||
! ">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
|
||||
! define-compound ;
|
||||
|
||||
: generate-slot-setter ( name -- )
|
||||
">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
|
||||
define-compound ;
|
||||
define ;
|
||||
|
||||
: generate-slot-accessors ( name -- )
|
||||
dup
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
|
||||
USING: mortar ;
|
||||
|
||||
IN: mortar.sugar
|
||||
|
||||
: new* ( class -- object ) <<- create ;
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup parser-combinators
|
||||
parser-combinators.simple ;
|
||||
USING: help.syntax help.markup parser-combinators ;
|
||||
IN: parser-combinators.simple
|
||||
|
||||
HELP: 'digit'
|
||||
{ $values
|
||||
|
|
|
|||
|
|
@ -24,14 +24,18 @@ IN: project-euler.006
|
|||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: sum-of-squares ( seq -- n )
|
||||
0 [ sq + ] reduce ;
|
||||
|
||||
: square-of-sums ( seq -- n )
|
||||
0 [ + ] reduce sq ;
|
||||
: square-of-sum ( seq -- n )
|
||||
sum sq ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler006 ( -- answer )
|
||||
1 100 [a,b] dup sum-of-squares swap square-of-sums - abs ;
|
||||
1 100 [a,b] dup sum-of-squares swap square-of-sum - abs ;
|
||||
|
||||
! [ euler006 ] 100 ave-time
|
||||
! 0 ms run / 0 ms GC ave time - 100 trials
|
||||
|
|
|
|||
|
|
@ -0,0 +1,71 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.primes math.ranges sequences ;
|
||||
IN: project-euler.026
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=26
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! A unit fraction contains 1 in the numerator. The decimal representation of
|
||||
! the unit fractions with denominators 2 to 10 are given:
|
||||
|
||||
! 1/2 = 0.5
|
||||
! 1/3 = 0.(3)
|
||||
! 1/4 = 0.25
|
||||
! 1/5 = 0.2
|
||||
! 1/6 = 0.1(6)
|
||||
! 1/7 = 0.(142857)
|
||||
! 1/8 = 0.125
|
||||
! 1/9 = 0.(1)
|
||||
! 1/10 = 0.1
|
||||
|
||||
! Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can be
|
||||
! seen that 1/7 has a 6-digit recurring cycle.
|
||||
|
||||
! Find the value of d < 1000 for which 1/d contains the longest recurring cycle
|
||||
! in its decimal fraction part.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: source-026 ( -- seq )
|
||||
1 1000 (a,b) [ prime? ] subset [ 1 swap / ] map ;
|
||||
|
||||
: (mult-order) ( n a m -- k )
|
||||
3dup ^ swap mod 1 = [ 2nip ] [ 1+ (mult-order) ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: coprime? ( m n -- ? )
|
||||
gcd 1 = nip ;
|
||||
|
||||
: recurring-period? ( a/b -- ? )
|
||||
denominator 10 coprime? ;
|
||||
|
||||
! Multiplicative order a.k.a. modulo order
|
||||
: mult-order ( a n -- k )
|
||||
swap 1 (mult-order) ;
|
||||
|
||||
: period-length ( a/b -- n )
|
||||
dup recurring-period? [ denominator 10 swap mult-order ] [ drop 0 ] if ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: max-period ( seq -- elt n )
|
||||
dup [ period-length ] map dup supremum
|
||||
over index [ swap nth ] curry 2apply ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler026 ( -- answer )
|
||||
source-026 max-period drop denominator ;
|
||||
|
||||
! [ euler026 ] 100 ave-time
|
||||
! 724 ms run / 7 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler026
|
||||
|
|
@ -34,9 +34,6 @@ IN: project-euler.common
|
|||
: propagate ( bottom top -- newtop )
|
||||
[ over 1 tail rot first2 max rot + ] map nip ;
|
||||
|
||||
: reduce-2s ( n -- r s )
|
||||
dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
|
||||
|
||||
: shift-3rd ( seq obj obj -- seq obj obj )
|
||||
rot 1 tail -rot ;
|
||||
|
||||
|
|
@ -88,11 +85,11 @@ PRIVATE>
|
|||
|
||||
! The divisor function, counts the number of divisors
|
||||
: tau ( m -- n )
|
||||
count-factors flip second 1 [ 1+ * ] reduce ;
|
||||
group-factors flip second 1 [ 1+ * ] reduce ;
|
||||
|
||||
! Optimized brute-force, is often faster than prime factorization
|
||||
: tau* ( m -- n )
|
||||
reduce-2s [ perfect-square? -1 0 ? ] keep
|
||||
factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
|
||||
dup sqrt >fixnum [1,b] [
|
||||
dupd mod zero? [ >r 2 + r> ] when
|
||||
dupd mod zero? [ [ 2 + ] dip ] when
|
||||
] each drop * ;
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
|
|||
project-euler.013 project-euler.014 project-euler.015 project-euler.016
|
||||
project-euler.017 project-euler.018 project-euler.019 project-euler.020
|
||||
project-euler.021 project-euler.022 project-euler.023 project-euler.024
|
||||
project-euler.025 project-euler.067 project-euler.134 project-euler.169
|
||||
project-euler.173 project-euler.175 ;
|
||||
project-euler.025 project-euler.026 project-euler.067 project-euler.134
|
||||
project-euler.169 project-euler.173 project-euler.175 ;
|
||||
IN: project-euler
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
|
||||
USING: kernel namespaces arrays x11.xlib mortar slot-accessors x x.font ;
|
||||
USING: kernel namespaces arrays x11.xlib mortar mortar.sugar
|
||||
slot-accessors x x.font ;
|
||||
|
||||
IN: x.gc
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel arrays math.vectors mortar x.gc slot-accessors geom.pos ;
|
||||
USING: kernel arrays math.vectors mortar mortar.sugar x.gc slot-accessors geom.pos ;
|
||||
|
||||
IN: x.pen
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel combinators math x11.xlib
|
||||
mortar slot-accessors x.gc x.widgets.label ;
|
||||
mortar mortar.sugar slot-accessors x.gc x.widgets.label ;
|
||||
|
||||
IN: x.widgets.button
|
||||
|
||||
|
|
@ -11,7 +11,7 @@ SYMBOL: <button>
|
|||
{ "action-1" "action-2" "action-3" } accessors
|
||||
define-simple-class
|
||||
|
||||
<button> "create" ( <button> -- button ) [
|
||||
<button> "create" !( <button> -- button ) [
|
||||
new-empty
|
||||
<gc> new* >>gc ExposureMask ButtonPressMask bitor >>mask <- init-widget
|
||||
] add-class-method
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel strings arrays sequences sequences.lib math x11.xlib
|
||||
mortar slot-accessors x x.pen x.widgets ;
|
||||
mortar mortar.sugar slot-accessors x x.pen x.widgets ;
|
||||
|
||||
IN: x.widgets.keymenu
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel x11.xlib mortar slot-accessors x.gc x.widgets ;
|
||||
USING: kernel x11.xlib mortar mortar.sugar slot-accessors x.gc x.widgets ;
|
||||
|
||||
IN: x.widgets.label
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel combinators namespaces math.vectors x11.xlib x11.constants
|
||||
mortar slot-accessors x x.gc x.widgets.wm.frame.drag ;
|
||||
mortar mortar.sugar slot-accessors x x.gc x.widgets.wm.frame.drag ;
|
||||
|
||||
IN: x.widgets.wm.frame.drag.move
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel combinators namespaces math.vectors x11.xlib x11.constants
|
||||
mortar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
|
||||
mortar mortar.sugar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
|
||||
|
||||
IN: x.widgets.wm.frame.drag.size
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
USING: kernel io combinators namespaces quotations arrays sequences
|
||||
math math.vectors
|
||||
x11.xlib x11.constants
|
||||
mortar slot-accessors
|
||||
mortar mortar.sugar slot-accessors
|
||||
geom.rect
|
||||
x x.gc x.widgets
|
||||
x.widgets.button
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel x11.constants mortar slot-accessors x.widgets.keymenu ;
|
||||
USING: kernel x11.constants mortar mortar.sugar slot-accessors x.widgets.keymenu ;
|
||||
|
||||
IN: x.widgets.wm.menu
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
USING: xml-rpc help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: xml-rpc
|
||||
|
||||
HELP: send-rpc
|
||||
{ $values { "rpc" "an RPC data type" } { "xml" "an XML document" } }
|
||||
|
|
|
|||
Loading…
Reference in New Issue