path: root/js/games/nluqo.github.io/~bh/v3ch3/algs.lg

;;; Algorithms and Data Structures

;; Local optimization of quadratic formula

to quadratic :a :b :c
localmake "root sqrt (:b * :b-4 * :a * :c)
localmake "x1 (-:b+:root)/(2 * :a)
localmake "x2 (-:b-:root)/(2 * :a)
print (sentence [The solutions are] :x1 "and :x2)
end

;; Memoization of T function

to t :n :k
localmake "result gprop :n :k
if not emptyp :result [output :result]
make "result realt :n :k
pprop :n :k :result
output :result
end

to realt :n :k
if equalp :k 0 [output 1]
if equalp :n 0 [output 0]
output (t :n :k-1) + (t :n-1 :k)
end

;; Speedup of Simplex function

to simplex :buttons
output 2 * first (cascade :buttons
                          [fput (sumprods butfirst ?2 ?1) ?1] [1]
                          [fput 1 nextrow ?2] [1 1])
end

to sumprods :a :b
output reduce "sum (map "product :a :b)
end

to nextrow :combs
if emptyp butfirst :combs [output :combs]
output fput (sum first :combs first butfirst :combs) ~
            nextrow butfirst :combs
end

;; Sorting -- selection sort

to ssort :list
if emptyp :list [output []]
output ssort1 (first :list) (butfirst :list) []
end

to ssort1 :min :in :out
if emptyp :in [output fput :min ssort :out]
if lessthanp :min (first :in) ~
   [output ssort1 :min (butfirst :in) (fput first :in :out)]
output ssort1 (first :in) (butfirst :in) (fput :min :out)
end

;; Sorting -- partition sort

to psort :list
if emptyp :list [output []]
if emptyp butfirst :list [output :list]
localmake "split ((first :list) + (last :list)) / 2
if lessthanp first :list :split ~
   [output psort1 :split (butfirst :list) (list first :list) []]
output psort1 :split (butlast :list) (list last :list) []
end

to psort1 :split :in :low :high
if emptyp :in [output sentence (psort :low) (psort :high)]
if lessthanp first :in :split ~
   [output psort1 :split (butfirst :in) (fput first :in :low) :high]
output psort1 :split (butfirst :in) :low (fput first :in :high)
end

;; Sorting -- count comparisons

to lessthanp :a :b
if not namep "comparisons [make "comparisons 0]
make "comparisons :comparisons+1
output :a < :b
end

to howmany
print :comparisons
ern "comparisons
end

;; Abstract Data Type for Trees: Constructor

to tree :datum :children
output fput :datum :children
end

;; Tree ADT: Selectors

to datum :node
output first :node
end

to children :node
output butfirst :node
end

;; Tree ADT: Mutator

to addchild :tree :child
.setbf :tree (fput :child butfirst :tree)
end

;; Tree ADT: other procedures

to leaf :datum
output tree :datum []
end

to leaves :leaves
output map [leaf ?] :leaves
end

to leafp :node
output emptyp children :node
end

;; The World tree

to worldtree
make "world ~
     tree "world ~
          (list (tree "France leaves [Paris Dijon Avignon])
                (tree "China leaves [Beijing Shanghai Guangzhou Suzhou])
                (tree [United States]
                      (list (tree [New York]
                                  leaves [[New York] Albany Rochester
                                          Armonk] )
                            (tree "Massachusetts
                                  leaves [Boston Cambridge Sudbury
                                          Maynard] )
                            (tree "California
                                  leaves [[San Francisco] Berkeley
                                          [Palo Alto] Pasadena] )
                            (tree "Washington
                                  leaves [Seattle Olympia] ) ) )
                (tree "Canada
                      (list (tree "Ontario
                                  leaves [Toronto Ottawa Windsor] )
                            (tree "Quebec
                                  leaves [Montreal Quebec Lachine] )
                            (tree "Manitoba leaves [Winnipeg]) ) ) )
end

to locate :city
output locate1 :city :world "false
end

to locate1 :city :subtree :wanttree
if and :wanttree (equalp :city datum :subtree) [output :subtree]
if leafp :subtree ~
   [ifelse equalp :city datum :subtree
           [output (list :city)]
           [output []]]
localmake "lower locate.in.forest :city (children :subtree) :wanttree
if emptyp :lower [output []]
output ifelse :wanttree [:lower] [fput (datum :subtree) :lower]
end

to locate.in.forest :city :forest :wanttree
if emptyp :forest [output []]
localmake "child locate1 :city first :forest :wanttree
if not emptyp :child [output :child]
output locate.in.forest :city butfirst :forest :wanttree
end

to cities :name
output cities1 (finddatum :name :world)
end

to cities1 :subtree
if leafp :subtree [output (list datum :subtree)]
output map.se [cities1 ?] children :subtree
end

to finddatum :datum :tree
output locate1 :name :tree "true
end

;; Area code/city pairs ADT

to areacode :pair
output first :pair
end

to city :pair
output butfirst :pair
end

;; Area code linear search

make "codelist [[202 Washington] [206 Seattle] [212 New York]
                [213 Los Angeles] [215 Philadelphia] [303 Denver]
                [305 Miami] [313 Detroit] [314 St. Louis]
                [401 Providence] [404 Atlanta] [408 Sunnyvale]
                [414 Milwaukee] [415 San Francisco] [504 New Orleans]
                [608 Madison] [612 St. Paul] [613 Kingston]
                [614 Columbus] [615 Nashville] [617 Boston]
                [702 Las Vegas] [704 Charlotte]
                [712 Sioux City] [714 Anaheim] [716 Rochester]
                [717 Scranton] [801 Salt Lake City] [804 Newport News]
                [805 Ventura] [808 Honolulu]]

to listcity :code
output city find [equalp :code areacode ?] :codelist
end

;; Area code binary tree search

to balance :list
if emptyp :list [output []]
if emptyp butfirst :list [output leaf first :list]
output balance1 (int (count :list)/2) :list []
end

to balance1 :count :in :out
if equalp :count 0 ~
   [output tree (first :in) (list balance reverse :out
                                  balance butfirst :in)]
output balance1 (:count-1) (butfirst :in) (fput first :in :out)
end

to treecity :code
output city treecity1 :code :codetree
end

to treecity1 :code :tree
if emptyp :tree [output [0 no city]]
localmake "datum datum :tree
if :code = areacode :datum [output :datum]
if :code < areacode :datum [output treecity1 :code lowbranch :tree]
output treecity1 :code highbranch :tree
end

to lowbranch :tree
if leafp :tree [output []]
output first children :tree
end

to highbranch :tree
if leafp :tree [output []]
output last children :tree
end