about summary refs log tree commit diff stats
path: root/js/games/nluqo.github.io/~bh/v3ch3/algs.lg
diff options
context:
space:
mode:
authorelioat <elioat@tilde.institute>2023-08-23 07:52:19 -0400
committerelioat <elioat@tilde.institute>2023-08-23 07:52:19 -0400
commit562a9a52d599d9a05f871404050968a5fd282640 (patch)
tree7d3305c1252c043bfe246ccc7deff0056aa6b5ab /js/games/nluqo.github.io/~bh/v3ch3/algs.lg
parent5d012c6c011a9dedf7d0a098e456206244eb5a0f (diff)
downloadtour-562a9a52d599d9a05f871404050968a5fd282640.tar.gz
*
Diffstat (limited to 'js/games/nluqo.github.io/~bh/v3ch3/algs.lg')
-rw-r--r--js/games/nluqo.github.io/~bh/v3ch3/algs.lg252
1 files changed, 252 insertions, 0 deletions
diff --git a/js/games/nluqo.github.io/~bh/v3ch3/algs.lg b/js/games/nluqo.github.io/~bh/v3ch3/algs.lg
new file mode 100644
index 0000000..fd3cfdd
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/v3ch3/algs.lg
@@ -0,0 +1,252 @@
+;;; 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