HELP: <promise>
{ $values { "quot" { $quotation ( -- x ) } } { "promise" "a promise object" } }
-{ $description "Creates a promise to return a value. When forced this quotation is called and the value returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } ;
+{ $description "Creates a promise to return a value. When forced this quotation is called and the value returned. The value is memorized so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } ;
HELP: force
{ $values { "promise" "a promise object" } { "value" "a factor object" } }
QUALIFIED-WITH: models.range mr
IN: boids
-TUPLE: boids-gadget < gadget paused boids behaviours dt ;
+TUPLE: boids-gadget < gadget paused boids behaviors dt ;
CONSTANT: initial-population 100
CONSTANT: initial-dt 5
-: initial-behaviours ( -- seq )
+: initial-behaviors ( -- seq )
1.0 75 -0.1 <cohesion>
1.0 40 -0.5 <alignment>
1.0 25 -1.0 <separation>
t >>clipped?
${ WIDTH HEIGHT } >>pref-dim
initial-population random-boids >>boids
- initial-behaviours >>behaviours
+ initial-behaviors >>behaviours
initial-dt >>dt ;
M: boids-gadget ungraft*
boids>> draw-boids ;
: iterate-system ( boids-gadget -- )
- dup [ boids>> ] [ behaviours>> ] [ dt>> ] tri
+ dup [ boids>> ] [ behaviors>> ] [ dt>> ] tri
simulate >>boids drop ;
:: start-boids-thread ( gadget -- )
boids-gadget simulation-panel
add-gadget
- boids-gadget behaviours>>
+ boids-gadget behaviors>>
[ behavior-panel add-gadget ] each
{ 5 5 } <border> add-gadget ;
CONSTANT: WIDTH 512
CONSTANT: HEIGHT 512
-TUPLE: behaviour
+TUPLE: behavior
{ weight float }
{ radius float }
{ angle-cos float } ;
: in-view? ( self other angle-cos -- ? )
[ relative-angle ] dip >= ; inline
-:: within-neighborhood? ( self other behaviour -- ? )
+:: within-neighborhood? ( self other behavior -- ? )
self other {
[ eq? not ]
- [ behaviour radius>> in-radius? ]
- [ behaviour angle-cos>> in-view? ]
+ [ behavior radius>> in-radius? ]
+ [ behavior angle-cos>> in-view? ]
} 2&& ; inline
-:: neighbors ( boid boids behaviour -- neighbors )
- boid boids [ behaviour within-neighborhood? ] with filter ;
+:: neighbors ( boid boids behavior -- neighbors )
+ boid boids [ behavior within-neighborhood? ] with filter ;
-GENERIC: force ( neighbors boid behaviour -- force )
+GENERIC: force ( neighbors boid behavior -- force )
-:: (force) ( boid boids behaviour -- force )
- boid boids behaviour neighbors
- [ { 0.0 0.0 } ] [ boid behaviour force ] if-empty ;
+:: (force) ( boid boids behavior -- force )
+ boid boids behavior neighbors
+ [ { 0.0 0.0 } ] [ boid behavior force ] if-empty ;
: wrap-pos ( pos -- pos )
WIDTH HEIGHT 2array [ [ + ] keep mod ] 2map ;
-:: simulate ( boids behaviours dt -- boids )
+:: simulate ( boids behaviors dt -- boids )
boids [| boid |
- boid boids behaviours
+ boid boids behaviors
[ [ (force) ] keep weight>> v*n ] 2with map vsum :> a
boid vel>> a dt v*n v+ normalize :> vel
<boid>
] replicate ;
-TUPLE: cohesion < behaviour ;
-TUPLE: alignment < behaviour ;
-TUPLE: separation < behaviour ;
+TUPLE: cohesion < behavior ;
+TUPLE: alignment < behavior ;
+TUPLE: separation < behavior ;
C: <cohesion> cohesion
C: <alignment> alignment
C: <separation> separation
-M: cohesion force ( neighbors boid behaviour -- force )
+M: cohesion force ( neighbors boid behavior -- force )
drop [ [ pos>> ] map vavg ] [ pos>> ] bi* v- normalize ;
-M: alignment force ( neighbors boid behaviour -- force )
+M: alignment force ( neighbors boid behavior -- force )
2drop [ vel>> ] map vsum normalize ;
-M:: separation force ( neighbors boid behaviour -- force )
- behaviour radius>> :> r
+M:: separation force ( neighbors boid behavior -- force )
+ behavior radius>> :> r
boid pos>> neighbors
[ pos>> v- [ normalize ] [ r v/n ] bi v- ] with map vsum ;
: almost-to-collision ( player -- distance )
distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ;
-: from ( player -- radius distance-from-centre )
+: from ( player -- radius distance-from-center )
[ nearest-segment>> dup radius>> swap ] [ location>> ] bi
- distance-from-centre ;
+ distance-from-center ;
: distance-from-wall ( player -- distance ) from - ;
-: fraction-from-centre ( player -- fraction ) from swap / ;
+: fraction-from-center ( player -- fraction ) from swap / ;
: fraction-from-wall ( player -- fraction )
- fraction-from-centre 1 swap - ;
+ fraction-from-center 1 swap - ;
: update-nearest-segment2 ( heading player -- )
2dup distance-to-heading-segment-area 0 <= [
: test-segment-oint ( -- oint )
{ 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
-{ { -1 0 0 } } [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
-{ { 1 0 0 } } [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
-{ { 0 -1 0 } } [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
-{ { 0 1 0 } } [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
-{ { -1 0 0 } } [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
-{ { 1 0 0 } } [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
-{ { 0 -1 0 } } [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
-{ { 0 1 0 } } [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
+{ { -1 0 0 } } [ test-segment-oint { 1 0 0 } vector-to-center ] unit-test
+{ { 1 0 0 } } [ test-segment-oint { -1 0 0 } vector-to-center ] unit-test
+{ { 0 -1 0 } } [ test-segment-oint { 0 1 0 } vector-to-center ] unit-test
+{ { 0 1 0 } } [ test-segment-oint { 0 -1 0 } vector-to-center ] unit-test
+{ { -1 0 0 } } [ test-segment-oint { 1 0 -1 } vector-to-center ] unit-test
+{ { 1 0 0 } } [ test-segment-oint { -1 0 -1 } vector-to-center ] unit-test
+{ { 0 -1 0 } } [ test-segment-oint { 0 1 -1 } vector-to-center ] unit-test
+{ { 0 1 0 } } [ test-segment-oint { 0 -1 -1 } vector-to-center ] unit-test
: simplest-straight-ahead ( -- oint segment )
{ 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
next current half-way-between-oints :> h
cf h vdot cf location vdot - cf heading vdot / ;
-: vector-to-centre ( seg loc -- v )
+: vector-to-center ( seg loc -- v )
over location>> swap v- swap forward>> proj-perp ;
-: distance-from-centre ( seg loc -- distance )
- vector-to-centre norm ;
+: distance-from-center ( seg loc -- distance )
+ vector-to-center norm ;
: wall-normal ( seg oint -- n )
- location>> vector-to-centre normalize ;
+ location>> vector-to-center normalize ;
CONSTANT: distant 1000
[ v+ ] with map
[ unvisited? ] filter ;
-: random-neighbour ( cell -- newcell ) choices random ;
+: random-neighbor ( cell -- newcell ) choices random ;
: vertex ( pair -- )
first2 [ 0.5 + line-width * ] bi@ glVertex2d ;
GL_LINE_STRIP glBegin
dup vertex
dup visit
- dup random-neighbour [
+ dup random-neighbor [
(draw-maze) (draw-maze)
] [
drop
HELP: astar
{ $description "This tuple must be subclassed and its method " { $link cost } ", "
- { $link heuristic } ", and " { $link neighbours } " must be implemented. "
+ { $link heuristic } ", and " { $link neighbors } " must be implemented. "
"Alternatively, the " { $link <astar> } " word can be used to build a non-specialized version." } ;
HELP: cost
{ "n" number }
}
{ $description "Return the cost to go from " { $snippet "from" } " to " { $snippet "to" } ". "
- { $snippet "to" } " is necessarily a neighbour of " { $snippet "from" } "."
+ { $snippet "to" } " is necessarily a neighbor of " { $snippet "from" } "."
} ;
HELP: heuristic
{ "n" number }
}
{ $description "Return the estimated (undervalued) cost to go from " { $snippet "from" } " to " { $snippet "to" } ". "
- { $snippet "from" } " and " { $snippet "to" } " are not necessarily neighbours."
+ { $snippet "from" } " and " { $snippet "to" } " are not necessarily neighbors."
} ;
-HELP: neighbours
+HELP: neighbors
{ $values
{ "node" "a node" }
{ "astar" "an instance of a subclassed " { $link astar } " tuple" }
HELP: <astar>
{ $values
- { "neighbours" { $quotation ( node -- seq ) } }
+ { "neighbors" { $quotation ( node -- seq ) } }
{ "cost" { $quotation ( from to -- cost ) } }
{ "heuristic" { $quotation ( pos target -- cost ) } }
{ "astar" astar }
}
{ $description "Build an astar object from the given quotations. The "
- { $snippet "neighbours" } " one builds the list of neighbours. The "
+ { $snippet "neighbors" } " one builds the list of neighbours. The "
{ $snippet "cost" } " and " { $snippet "heuristic" } " ones represent "
- "respectively the cost for transitioning from a node to one of its neighbour, "
+ "respectively the cost for transitioning from a node to one of its neighbor, "
"and the underestimated cost for going from a node to the target. This solution "
"may not be as efficient as subclassing the " { $link astar } " tuple."
} ;
HELP: <bfs>
{ $values
- { "neighbours" assoc }
+ { "neighbors" assoc }
{ "astar" astar }
}
-{ $description "Build an astar object from the " { $snippet "neighbours" } " assoc. "
+{ $description "Build an astar object from the " { $snippet "neighbors" } " assoc. "
"When used with " { $link find-path } ", this astar tuple will use the breadth-first search (BFS) "
"path finding algorithm which is a particular case of the general A* algorithm."
} ;
ARTICLE: "path-finding" "Path finding using the A* algorithm"
"The " { $vocab-link "path-finding" } " vocabulary implements a graph search algorithm for finding the least-cost path from one node to another using the A* algorithm." $nl
-"The " { $link astar } " tuple may be derived from and its " { $link cost } ", " { $link heuristic } ", and " { $link neighbo
urs } " methods overwritten, or the " { $link <astar> } " or " { $link <bfs> } " words can be used to build a new tuple." $nl
+"The " { $link astar } " tuple may be derived from and its " { $link cost } ", " { $link heuristic } ", and " { $link neighbors } " methods overwritten, or the " { $link <astar> } " or " { $link <bfs> } " words can be used to build a new tuple." $nl
"Make an A* object:"
{ $subsections <astar> <bfs> }
"Find a path between nodes:"
8 X X X X X X X X X X"
split-lines ] nth nth CHAR: X = not ;
-M: maze neighbours
+M: maze neighbors
drop
first2
{ [ 1 + 2array ] [ 1 - 2array ] [ [ 1 + ] dip 2array ] [ [ 1 - ] dip 2array ] } 2cleave
MEMO: routes ( -- hash ) $[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array ] map >hashtable ] ;
-: n ( pos -- neighbours )
+: n ( pos -- neighbors )
routes at ;
: c ( from to -- cost )
TUPLE: astar g in-closed-set ;
GENERIC: cost ( from to astar -- n )
GENERIC: heuristic ( from to astar -- n )
-GENERIC: neighbours ( node astar -- seq )
+GENERIC: neighbors ( node astar -- seq )
<PRIVATE
[ over ] [ over [ [ origin>> at ] keep ] dip ] produce 2nip reverse ;
: handle ( node astar -- )
- dupd [ astar>> neighbours ] keep [ ?set-g ] curry with each ;
+ dupd [ astar>> neighbors ] keep [ ?set-g ] curry with each ;
: (find-path) ( astar -- path/f )
dup open-set>> heap-empty? [
<min-heap> >>open-set
[ 0 ] 2dip [ (add-to-open-set) ] [ astar>> g>> set-at ] 3bi ;
-TUPLE: astar-simple < astar cost heuristic neighbours ;
+TUPLE: astar-simple < astar cost heuristic neighbors ;
M: astar-simple cost cost>> call( n1 n2 -- c ) ;
M: astar-simple heuristic heuristic>> call( n1 n2 -- c ) ;
-M: astar-simple neighbours neighbours>> call( n -- neighbours ) ;
+M: astar-simple neighbors neighbours>> call( n -- neighbours ) ;
-TUPLE: bfs < astar neighbours ;
+TUPLE: bfs < astar neighbors ;
M: bfs cost 3drop 1 ;
M: bfs heuristic 3drop 0 ;
-M: bfs neighbours neighbours>> at ;
+M: bfs neighbors neighbours>> at ;
TUPLE: dijkstra < astar costs ;
M: dijkstra cost costs>> swapd at at ;
M: dijkstra heuristic 3drop 0 ;
-M: dijkstra neighbours costs>> at keys ;
+M: dijkstra neighbors costs>> at keys ;
PRIVATE>
: find-path ( start target astar -- path/f )
(astar) new [ astar<< ] keep [ (init) ] [ (find-path) ] bi ;
-: <astar> ( neighbours cost heuristic -- astar )
- astar-simple new swap >>heuristic swap >>cost swap >>neighbours ;
+: <astar> ( neighbors cost heuristic -- astar )
+ astar-simple new swap >>heuristic swap >>cost swap >>neighbors ;
: considered ( astar -- considered )
in-closed-set>> members ;
-: <bfs> ( neighbours -- astar )
- [ bfs new ] dip >>neighbours ;
+: <bfs> ( neighbors -- astar )
+ [ bfs new ] dip >>neighbors ;
: <dijkstra> ( costs -- astar )
[ dijkstra new ] dip >>costs ;
! Performance
{ 0 } [ long-string ".{0,15}foobar.{0,10}" findall length ] unit-test
-! Empty matches, corner case behaviour is copied from pcredemo.c
+! Empty matches, corner case behavior is copied from pcredemo.c
{ { { { f "foo" } } { { f "" } } } }
[ "foo" ".*" findall ] unit-test
! {20,48,52}, {24,45,51}, {30,40,50}
-! For which value of p < 1000, is the number of solutions maximised?
+! For which value of p < 1000, is the number of solutions maximized?
! SOLUTION
! --------
! For n/φ(n) to be minimised, φ(n) must be as close to n as possible; that is,
-! we want to maximise φ(n). The minimal solution for n/φ(n) would be if n was
+! we want to maximize φ(n). The minimal solution for n/φ(n) would be if n was
! prime giving n/(n-1) but since n-1 never is a permutation of n it cannot be
! prime.
! DESCRIPTION ! -----------
-! If a box contains twenty-one coloured discs, composed of fifteen blue discs
+! If a box contains twenty-one colored discs, composed of fifteen blue discs
! and six red discs, and two discs were taken at random, it can be seen that
! the probability of taking two blue discs, P(BB) = (15/21)*(14/20) = 1/2.
! -----------
! A row of five black square tiles is to have a number of its tiles replaced
-! with coloured oblong tiles chosen from red (length two), green (length
+! with colored oblong tiles chosen from red (length two), green (length
! three), or blue (length four).
! If red tiles are chosen there are exactly seven ways this can be done.
! If green tiles are chosen there are three ways.
! And if blue tiles are chosen there are two ways.
-! Assuming that colours cannot be mixed there are 7 + 3 + 2 = 12 ways of
+! Assuming that colors cannot be mixed there are 7 + 3 + 2 = 12 ways of
! replacing the black tiles in a row measuring five units in length.
! How many different ways can the black tiles in a row measuring fifty units in
-! length be replaced if colours cannot be mixed and at least one coloured tile
+! length be replaced if colors cannot be mixed and at least one coloured tile
! must be used?
! -----------
! A printing shop runs 16 batches (jobs) every week and each batch requires a
-! sheet of special colour-proofing paper of size A5.
+! sheet of special color-proofing paper of size A5.
! Every Monday morning, the foreman opens a new envelope, containing a large
! sheet of the special paper with size A1.
! Let Sm = (x1, x2, ... , xm) be the m-tuple of positive real numbers
! with x1 + x2 + ... + xm = m for which Pm = x1 * x22 * ... * xmm is
-! maximised.
+! maximized.
! For example, it can be verified that [P10] = 4112 ([ ] is the integer
! part function).
! Custom frame control functions
! NOTE: Those functions are intended for advance users that want full control over the frame processing
! By default EndDrawing() does this job: draws everything + SwapScreenBuffer() + manage frame timming + PollInputEvents()
-! To avoid that behaviour and control frame processes manually, enable in config.h: SUPPORT_CUSTOM_FRAME_CONTROL
+! To avoid that behavior and control frame processes manually, enable in config.h: SUPPORT_CUSTOM_FRAME_CONTROL
FUNCTION-ALIAS: swap-screen-buffer void SwapScreenBuffer ( ) ! Swap back buffer with front buffer (screen drawing)
FUNCTION-ALIAS: poll-input-events void PollInputEvents ( ) ! Register all input events
FUNCTION-ALIAS: wait-time void WaitTime ( float ms ) ! Wait for some milliseconds (halt program execution)
! He can only take whole units of any item, but there is much
! more of any item than he could ever carry
-! How many of each item does he take to maximise the value of
+! How many of each item does he take to maximize the value of
! items he is carrying away with him?
! Note:
-! There are four solutions that maximise the value taken. Only
+! There are four solutions that maximize the value taken. Only
! one need be given.
CONSTANT: values { 3000 1800 2500 }
! Which items does the tourist carry in his knapsack so that
! their total weight does not exceed 400 dag [4 kg], and their
-! total value is maximised?
+! total value is maximized?
TUPLE: item
name weight value ;
! http://rosettacode.org/wiki/Multiplication_tables
! Produce a formatted 12×12 multiplication table of the kind
-! memorised by rote when in primary school.
+! memorized by rote when in primary school.
! Only print the top half triangle of products.
! Cells in the next generation of the array are calculated based
! on the value of the cell and its left and right nearest
-! neighbours in the current generation. If, in the following
+! neighbors in the current generation. If, in the following
! table, a live cell is represented by 1 and a dead cell by 0 then
! to generate the value of the cell at a particular index in the
! array of cellular values you use the following table:
! 000 -> 0 #
! 001 -> 0 #
-! 010 -> 0 # Dies without enough neighbours
-! 011 -> 1 # Needs one neighbour to survive
+! 010 -> 0 # Dies without enough neighbors
+! 011 -> 1 # Needs one neighbor to survive
! 100 -> 0 #
-! 101 -> 1 # Two neighbours giving birth
-! 110 -> 1 # Needs one neighbour to survive
+! 101 -> 1 # Two neighbors giving birth
+! 110 -> 1 # Needs one neighbor to survive
! 111 -> 0 # Starved to death.
: bool-sum ( bool1 bool2 -- sum )
[ [ 2 ] [ 1 ] if ]
[ [ 1 ] [ 0 ] if ] if ;
-:: neighbours ( index world -- # )
+:: neighbors ( index world -- # )
index [ 1 - ] [ 1 + ] bi [ world ?nth ] bi@ bool-sum ;
-: count-neighbours ( world -- neighbours )
- [ length <iota> ] keep [ neighbours ] curry map ;
+: count-neighbors ( world -- neighbours )
+ [ length <iota> ] keep [ neighbors ] curry map ;
-: life-law ( alive? neighbours -- alive? )
+: life-law ( alive? neighbors -- alive? )
swap [ 1 = ] [ 2 = ] if ;
: step ( world -- world' )
- dup count-neighbours [ life-law ] ?{ } 2map-as ;
+ dup count-neighbors [ life-law ] ?{ } 2map-as ;
: print-cellular ( world -- )
[ CHAR: # CHAR: _ ? ] "" map-as print ;
: board@block ( board block -- n row )
[ second swap rows>> nth ] keep first swap ;
-: set-block ( board block colour -- ) -rot board@block set-nth ;
+: set-block ( board block color -- ) -rot board@block set-nth ;
-: block ( board block -- colour ) board@block nth ;
+: block ( board block -- color ) board@block nth ;
: block-free? ( board block -- ? ) block not ;
level 1 - 60 * 1,000,000,000 swap - ;
: add-block ( tetris block -- )
- over [ board>> ] 2dip current-piece tetromino>> colour>> set-block ;
+ over [ board>> ] 2dip current-piece tetromino>> color>> set-block ;
: game-over? ( tetris -- ? )
[ board>> ] [ next-piece ] bi piece-valid? not ;
piece-blocks [ draw-block ] each ;
: draw-piece ( piece -- )
- dup tetromino>> colour>> gl-color draw-piece-blocks ;
+ dup tetromino>> color>> gl-color draw-piece-blocks ;
: draw-next-piece ( piece -- )
- dup tetromino>> colour>>
+ dup tetromino>> color>>
>rgba-components drop 0.2 <rgba> gl-color draw-piece-blocks ;
! TODO: move implementation specific stuff into tetris-board
IN: tetris.tetromino
-TUPLE: tetromino states colour ;
+TUPLE: tetromino states color ;
C: <tetromino> tetromino
projects / factor.git / commitdiff