1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
|
;;; 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
|