Repository: skanev/playground Branch: master Commit: 07b88d789391 Files: 1993 Total size: 4.1 MB Directory structure: gitextract_j8jnmwhq/ ├── .git-hooks/ │ ├── install-hooks │ └── prepare-commit-msg ├── .gitignore ├── README ├── Rakefile ├── advent-of-code/ │ ├── 2020/ │ │ ├── 01.1.pl │ │ ├── 01.2.pl │ │ ├── 02.1.pl │ │ ├── 02.2.pl │ │ ├── 03.1.pl │ │ ├── 03.2.pl │ │ ├── 04.1.pl │ │ ├── 04.2.pl │ │ ├── 05.1.pl │ │ ├── 05.2.pl │ │ ├── 06.1.pl │ │ ├── 06.2.pl │ │ ├── 07.1.pl │ │ ├── 07.2.pl │ │ ├── 08.1.pl │ │ ├── 08.2.pl │ │ ├── 09.1.pl │ │ ├── 09.2.pl │ │ ├── 10.1.pl │ │ ├── 10.2.pl │ │ ├── 11.1.pl │ │ ├── 11.2.pl │ │ ├── 12.1.pl │ │ ├── 12.2.pl │ │ ├── 13.1.pl │ │ ├── 13.2.pl │ │ ├── 14.1.pl │ │ ├── 14.2.pl │ │ ├── 15.1.pl │ │ ├── 15.2.pl │ │ ├── 16.1.pl │ │ ├── 16.2.pl │ │ ├── 17.1.pl │ │ ├── 17.2.pl │ │ ├── 18.1.pl │ │ ├── 18.2.pl │ │ ├── 19.1.pl │ │ ├── 19.2.pl │ │ ├── 20.1.pl │ │ ├── 20.2.pl │ │ ├── 21.1.pl │ │ ├── 21.2.pl │ │ ├── 22.1.pl │ │ ├── 22.2.pl │ │ ├── 23.1.pl │ │ ├── 23.2.pl │ │ ├── 24.1.pl │ │ ├── 24.2.pl │ │ ├── 25.1.pl │ │ ├── 25.2.pl │ │ └── inputs/ │ │ ├── 1.1 │ │ ├── 10 │ │ ├── 11 │ │ ├── 12 │ │ ├── 13 │ │ ├── 14 │ │ ├── 16 │ │ ├── 17 │ │ ├── 18 │ │ ├── 19 │ │ ├── 2 │ │ ├── 20 │ │ ├── 21 │ │ ├── 22 │ │ ├── 24 │ │ ├── 3 │ │ ├── 3.sample │ │ ├── 4 │ │ ├── 4.sample │ │ ├── 5 │ │ ├── 6 │ │ ├── 7 │ │ ├── 8 │ │ └── 9 │ ├── 2021/ │ │ ├── .gitignore │ │ ├── day01/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day02/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day03/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day04/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day05/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day06/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day07/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day08/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day09/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day10/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day11/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day12/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day13/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day14/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day15/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day16/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day17/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day18/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day19/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day20/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day21/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day22/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day23/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day24/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ ├── day25/ │ │ │ ├── Cargo.toml │ │ │ └── src/ │ │ │ └── main.rs │ │ └── inputs/ │ │ ├── 01 │ │ ├── 02 │ │ ├── 03 │ │ ├── 04 │ │ ├── 05 │ │ ├── 06 │ │ ├── 07 │ │ ├── 08 │ │ ├── 09 │ │ ├── 10 │ │ ├── 11 │ │ ├── 12 │ │ ├── 13 │ │ ├── 14 │ │ ├── 15 │ │ ├── 16 │ │ ├── 17 │ │ ├── 18 │ │ ├── 19 │ │ ├── 20 │ │ ├── 21 │ │ ├── 22 │ │ ├── 23 │ │ ├── 24 │ │ └── 25 │ └── 2022/ │ ├── .gitignore │ ├── day01/ │ │ ├── day01.nimble │ │ └── src/ │ │ └── day01.nim │ ├── day02/ │ │ ├── day02.nimble │ │ └── src/ │ │ └── day02.nim │ ├── day03/ │ │ ├── day03.nimble │ │ └── src/ │ │ └── day03.nim │ ├── day04/ │ │ ├── day04.nimble │ │ └── src/ │ │ └── day04.nim │ ├── day05/ │ │ ├── day05.nimble │ │ └── src/ │ │ └── day05.nim │ ├── day06/ │ │ ├── day06.nimble │ │ └── src/ │ │ └── day06.nim │ ├── day07/ │ │ ├── day07.nimble │ │ └── src/ │ │ └── day07.nim │ ├── day08/ │ │ ├── day08.nimble │ │ └── src/ │ │ └── day08.nim │ ├── day09/ │ │ ├── day09.nimble │ │ └── src/ │ │ └── day09.nim │ ├── day10/ │ │ ├── day10.nimble │ │ └── src/ │ │ └── day10.nim │ ├── day11/ │ │ ├── day11.nimble │ │ └── src/ │ │ └── day11.nim │ ├── day12/ │ │ ├── day12.nimble │ │ └── src/ │ │ └── day12.nim │ ├── day13/ │ │ ├── day13.nimble │ │ └── src/ │ │ └── day13.nim │ ├── day14/ │ │ ├── day14.nimble │ │ └── src/ │ │ └── day14.nim │ ├── day15/ │ │ ├── day15.nimble │ │ └── src/ │ │ └── day15.nim │ ├── day16/ │ │ ├── day16.nimble │ │ └── src/ │ │ └── day16.nim │ ├── day17/ │ │ ├── day17.nimble │ │ └── src/ │ │ └── day17.nim │ ├── day18/ │ │ ├── day18.nimble │ │ └── src/ │ │ └── day18.nim │ ├── day19/ │ │ ├── day19.nimble │ │ └── src/ │ │ └── day19.nim │ ├── day20/ │ │ ├── day20.nimble │ │ └── src/ │ │ └── day20.nim │ └── inputs/ │ ├── 01 │ ├── 02 │ ├── 03 │ ├── 04 │ ├── 05 │ ├── 06 │ ├── 07 │ ├── 08 │ ├── 09 │ ├── 10 │ ├── 11 │ ├── 12 │ ├── 13 │ ├── 14 │ ├── 15 │ ├── 16 │ ├── 17 │ ├── 18 │ ├── 19 │ └── 20 ├── git-hooks/ │ └── prepare-commit-msg ├── go/ │ └── gopl/ │ ├── .ruby-version │ ├── 01/ │ │ ├── 01/ │ │ │ ├── echo.go │ │ │ └── echo_test.go │ │ ├── 02/ │ │ │ ├── echo.go │ │ │ └── echo_test.go │ │ ├── 03/ │ │ │ ├── echo.go │ │ │ └── echo_test.go │ │ ├── 04/ │ │ │ ├── dup.go │ │ │ ├── dup_test.go │ │ │ └── fixtures/ │ │ │ ├── first │ │ │ ├── second │ │ │ └── third │ │ ├── 05/ │ │ │ └── lissajous.go │ │ ├── 06/ │ │ │ └── lissajous.go │ │ ├── 07/ │ │ │ └── fetch.go │ │ ├── 08/ │ │ │ └── fetch.go │ │ └── 09/ │ │ └── fetch.go │ ├── Gemfile │ ├── README.markdown │ └── Thorfile ├── haskell/ │ ├── aryth/ │ │ ├── Ast.hs │ │ ├── Interpreter.hs │ │ ├── Parser.hs │ │ └── World.hs │ ├── programming_haskell/ │ │ ├── Chapter01.hs │ │ ├── Chapter04.hs │ │ ├── Chapter05.hs │ │ ├── Chapter06.hs │ │ ├── Chapter07.hs │ │ ├── Chapter09.hs │ │ ├── Nim.hs │ │ └── README │ └── real_world_haskell/ │ ├── Find.hs │ ├── Glob.hs │ ├── PgmParser.hs │ ├── PgmSimple.hs │ ├── Traverse.hs │ ├── json/ │ │ ├── Main.hs │ │ ├── Prettify.hs │ │ ├── PrettyJSON.hs │ │ ├── PrettyStub.hs │ │ ├── PutJSON.hs │ │ ├── README │ │ └── SimpleJSON.hs │ └── sample/ │ └── foo.pgm ├── java/ │ └── tdd_by_example/ │ ├── Money.java │ ├── MoneyTest.java │ └── README ├── other/ │ ├── 7languages/ │ │ ├── erlang/ │ │ │ ├── day1/ │ │ │ │ ├── count_to_ten.erl │ │ │ │ ├── result_of.erl │ │ │ │ └── word_count.erl │ │ │ └── day2/ │ │ │ ├── pseudo_dict.erl │ │ │ ├── tictactoe.erl │ │ │ └── total_price.erl │ │ ├── io/ │ │ │ ├── day2/ │ │ │ │ ├── 1/ │ │ │ │ │ ├── loop.io │ │ │ │ │ └── recursive.io │ │ │ │ ├── 2.io │ │ │ │ ├── 3.io │ │ │ │ ├── 4.io │ │ │ │ ├── 5.io │ │ │ │ ├── 6.io │ │ │ │ ├── 7.io │ │ │ │ ├── 8.io │ │ │ │ └── reflection.io │ │ │ └── day3/ │ │ │ ├── 1.io │ │ │ ├── 2.io │ │ │ ├── 3.io │ │ │ ├── 3.xml.io │ │ │ ├── actors.io │ │ │ ├── builder.io │ │ │ ├── coroutine.io │ │ │ ├── futures.io │ │ │ └── phonebook.io │ │ ├── prolog/ │ │ │ ├── day1/ │ │ │ │ ├── food.prolog │ │ │ │ ├── friends.prolog │ │ │ │ └── map.prolog │ │ │ ├── day2/ │ │ │ │ ├── 2.1.prolog │ │ │ │ ├── 2.2.2.prolog │ │ │ │ ├── 2.2.prolog │ │ │ │ ├── 2.3.prolog │ │ │ │ ├── concatenate.prolog │ │ │ │ ├── fibonacci.prolog │ │ │ │ └── list_math.prolog │ │ │ ├── day3/ │ │ │ │ ├── queens.prolog │ │ │ │ └── sudoku.prolog │ │ │ └── other/ │ │ │ └── einstein.prolog │ │ └── scala/ │ │ ├── day1/ │ │ │ ├── 1.scala │ │ │ └── 2.scala │ │ ├── day2/ │ │ │ ├── 1.scala │ │ │ ├── 2.scala │ │ │ ├── 3.scala │ │ │ └── censored_words.txt │ │ └── day3/ │ │ └── sizer.scala │ └── clrs/ │ ├── .gitignore │ ├── .powrc │ ├── .ruby-version │ ├── .rvmrc │ ├── 01/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ └── 03.markdown │ │ └── problems/ │ │ └── 01.markdown │ ├── 02/ │ │ ├── 01/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 03/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.c │ │ │ ├── 02.markdown │ │ │ ├── 02.test.c │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ ├── 05.test.c │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ └── problems/ │ │ ├── 01.c │ │ ├── 01.markdown │ │ ├── 01.py │ │ ├── 01.run.c │ │ ├── 01.run.py │ │ ├── 02.markdown │ │ ├── 03.markdown │ │ ├── 04.c │ │ ├── 04.markdown │ │ └── 04.test.c │ ├── 03/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ └── 08.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ └── 08.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.markdown │ │ ├── 03.markdown │ │ ├── 04.markdown │ │ ├── 05.markdown │ │ └── 06.markdown │ ├── 04/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.c │ │ │ ├── 03.markdown │ │ │ ├── 03.run.c │ │ │ ├── 03.test.c │ │ │ ├── 04.c │ │ │ ├── 04.markdown │ │ │ ├── 04.test.c │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ └── 05.test.c │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.c │ │ │ ├── 02.markdown │ │ │ ├── 02.test.c │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ └── 09.markdown │ │ ├── 04/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.dot │ │ │ ├── 02.markdown │ │ │ ├── 03.dot │ │ │ ├── 03.markdown │ │ │ ├── 04.dot │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.dot │ │ │ ├── 07.markdown │ │ │ ├── 08.dot │ │ │ ├── 08.markdown │ │ │ ├── 09.dot │ │ │ └── 09.markdown │ │ ├── 05/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ ├── 06/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ └── 03.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.markdown │ │ ├── 03.markdown │ │ ├── 04.markdown │ │ ├── 05.markdown │ │ ├── 05.py │ │ ├── 05.test.py │ │ ├── 06.c │ │ ├── 06.markdown │ │ └── 06.test.c │ ├── 05/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ └── 03.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ └── 02.markdown │ ├── 06/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.dot │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ ├── 02/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ ├── 05.test.c │ │ │ └── 06.markdown │ │ ├── 03/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ └── 03.markdown │ │ ├── 04/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ ├── 05/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.dot │ │ │ ├── 02.markdown │ │ │ ├── 03.c │ │ │ ├── 03.markdown │ │ │ ├── 03.test.c │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.c │ │ │ ├── 06.markdown │ │ │ ├── 06.test.c │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ └── 09.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 01.py │ │ ├── 01.run.py │ │ ├── 02.c │ │ ├── 02.markdown │ │ ├── 02.test.c │ │ ├── 03.c │ │ ├── 03.markdown │ │ └── 03.test.c │ ├── 07/ │ │ ├── 01/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 02.py │ │ │ ├── 02.test.py │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ └── 06.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ └── 02.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ ├── 05.run.c │ │ │ ├── 05.test.c │ │ │ └── 06.markdown │ │ └── problems/ │ │ ├── 01.c │ │ ├── 01.dot │ │ ├── 01.markdown │ │ ├── 01.test.c │ │ ├── 02.c │ │ ├── 02.markdown │ │ ├── 02.test.c │ │ ├── 03.markdown │ │ ├── 04.c │ │ ├── 04.markdown │ │ ├── 04.test.c │ │ ├── 05.markdown │ │ ├── 06.c │ │ ├── 06.markdown │ │ └── 06.test.c │ ├── 08/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.c │ │ ├── 02.markdown │ │ ├── 02.test.c │ │ ├── 03.c │ │ ├── 03.markdown │ │ ├── 03.test.c │ │ ├── 04.c │ │ ├── 04.markdown │ │ ├── 04.test.c │ │ ├── 05.c │ │ ├── 05.markdown │ │ ├── 05.test.c │ │ ├── 06.markdown │ │ ├── 07.c │ │ ├── 07.markdown │ │ ├── 07.run.c │ │ └── 07.test.c │ ├── 09/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ └── 02.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.c │ │ │ ├── 03.markdown │ │ │ ├── 03.test.c │ │ │ └── 04.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 05.py │ │ │ ├── 05.test.py │ │ │ ├── 06.markdown │ │ │ ├── 06.py │ │ │ ├── 06.test.py │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ ├── 08.py │ │ │ ├── 08.test.py │ │ │ └── 09.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.markdown │ │ ├── 03.markdown │ │ └── 04.markdown │ ├── 10/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ ├── 05.test.c │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ ├── 05.test.c │ │ │ ├── 06.markdown │ │ │ ├── 07.c │ │ │ ├── 07.markdown │ │ │ ├── 07.test.c │ │ │ ├── 08.c │ │ │ ├── 08.markdown │ │ │ └── 08.test.c │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.c │ │ │ ├── 02.markdown │ │ │ ├── 02.test.c │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ └── 05.test.c │ │ ├── 04/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.c │ │ │ ├── 02.markdown │ │ │ ├── 02.test.c │ │ │ ├── 03.c │ │ │ ├── 03.markdown │ │ │ ├── 03.test.c │ │ │ ├── 04.c │ │ │ ├── 04.markdown │ │ │ ├── 04.test.c │ │ │ ├── 05.c │ │ │ ├── 05.markdown │ │ │ ├── 05.test.c │ │ │ └── 06.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.c │ │ ├── 02.markdown │ │ ├── 02.test.c │ │ └── 03.markdown │ ├── 11/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.c │ │ │ ├── 04.markdown │ │ │ ├── 04.test.c │ │ │ ├── 05.markdown │ │ │ └── 06.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 02.py │ │ │ ├── 02.test.py │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 04.py │ │ │ ├── 04.run.py │ │ │ ├── 05.markdown │ │ │ └── 06.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 01.py │ │ │ ├── 01.run.py │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 05.py │ │ │ └── 05.run.py │ │ ├── 05/ │ │ │ └── 01.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.markdown │ │ ├── 03.markdown │ │ └── 04.markdown │ ├── 12/ │ │ ├── 01/ │ │ │ ├── 01.dot │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.c │ │ │ ├── 04.markdown │ │ │ ├── 04.test.c │ │ │ └── 05.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.c │ │ │ ├── 02.markdown │ │ │ ├── 02.test.c │ │ │ ├── 03.c │ │ │ ├── 03.markdown │ │ │ ├── 03.test.c │ │ │ ├── 04.dot │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ └── 09.markdown │ │ ├── 03/ │ │ │ ├── 01.c │ │ │ ├── 01.markdown │ │ │ ├── 01.test.c │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.c │ │ │ ├── 05.debug.c │ │ │ ├── 05.markdown │ │ │ ├── 05.test.c │ │ │ └── 06.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 02.c │ │ ├── 02.markdown │ │ ├── 02.test.c │ │ ├── 03.markdown │ │ └── 04.markdown │ ├── 13/ │ │ ├── 01/ │ │ │ ├── 01.draw.py │ │ │ ├── 01.markdown │ │ │ ├── 02.draw.py │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.draw.py │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.draw.py │ │ │ └── 07.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ └── 05.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.draw.py │ │ │ ├── 02.markdown │ │ │ ├── 02.py │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ └── 06.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.draw.py │ │ │ ├── 03.markdown │ │ │ ├── 03.py │ │ │ ├── 03.test.py │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.draw.py │ │ │ └── 07.markdown │ │ ├── misc/ │ │ │ ├── red_black_tree.py │ │ │ └── red_black_tree_test.py │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 01.py │ │ ├── 01.test.py │ │ ├── 02.markdown │ │ ├── 03.markdown │ │ ├── 03.py │ │ ├── 03.test.py │ │ ├── 04.markdown │ │ ├── 04.py │ │ └── 04.test.py │ ├── 14/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 03.py │ │ │ ├── 03.test.py │ │ │ ├── 04.markdown │ │ │ ├── 04.py │ │ │ ├── 04.test.py │ │ │ ├── 05.markdown │ │ │ ├── 05.py │ │ │ ├── 05.test.py │ │ │ ├── 06.markdown │ │ │ ├── 06.py │ │ │ ├── 06.test.py │ │ │ ├── 07.markdown │ │ │ ├── 07.py │ │ │ ├── 07.test.py │ │ │ ├── 08.markdown │ │ │ ├── 08.py │ │ │ └── 08.test.py │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 01.py │ │ │ ├── 01.test.py │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ └── 04.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 01.py │ │ │ ├── 01.test.py │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 04.py │ │ │ ├── 04.test.py │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 06.py │ │ │ ├── 06.test.py │ │ │ ├── 07.markdown │ │ │ ├── 07.py │ │ │ └── 07.test.py │ │ ├── misc/ │ │ │ ├── augmentable_tree.py │ │ │ ├── augmentable_tree_test.py │ │ │ ├── interval_tree.py │ │ │ ├── interval_tree_test.py │ │ │ └── order_statistic_tree.py │ │ └── problems/ │ │ ├── 01.markdown │ │ ├── 01.py │ │ ├── 01.test.py │ │ ├── 02.markdown │ │ ├── 02.py │ │ └── 02.test.py │ ├── 15/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 03.py │ │ │ ├── 03.test.py │ │ │ ├── 04.markdown │ │ │ ├── 04.py │ │ │ ├── 04.test.py │ │ │ ├── 05.dot │ │ │ ├── 05.markdown │ │ │ ├── 05.py │ │ │ └── 05.test.py │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 01.py │ │ │ ├── 01.run.py │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ └── 06.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 04.py │ │ │ ├── 04.run.py │ │ │ ├── 05.markdown │ │ │ └── 06.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 01.py │ │ │ ├── 01.run.py │ │ │ ├── 02.markdown │ │ │ ├── 02.py │ │ │ ├── 02.test.py │ │ │ ├── 03.markdown │ │ │ ├── 03.py │ │ │ ├── 03.test.py │ │ │ ├── 04.markdown │ │ │ ├── 04.py │ │ │ ├── 04.test.py │ │ │ ├── 05.markdown │ │ │ ├── 05.py │ │ │ ├── 05.test.py │ │ │ ├── 06.markdown │ │ │ ├── 06.py │ │ │ └── 06.test.py │ │ └── 05/ │ │ ├── 01.markdown │ │ ├── 01.py │ │ ├── 01.run.py │ │ ├── 02.markdown │ │ ├── 02.py │ │ ├── 02.run.py │ │ ├── 03.markdown │ │ └── 04.markdown │ ├── C/ │ │ ├── 01/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ ├── 09.markdown │ │ │ ├── 10.markdown │ │ │ ├── 11.markdown │ │ │ ├── 12.markdown │ │ │ ├── 13.markdown │ │ │ ├── 14.markdown │ │ │ └── 15.markdown │ │ ├── 02/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ ├── 09.markdown │ │ │ └── 10.markdown │ │ ├── 03/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ ├── 09.markdown │ │ │ └── 10.markdown │ │ ├── 04/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ ├── 07.markdown │ │ │ ├── 08.markdown │ │ │ └── 09.markdown │ │ ├── 05/ │ │ │ ├── 01.markdown │ │ │ ├── 02.markdown │ │ │ ├── 03.markdown │ │ │ ├── 04.markdown │ │ │ ├── 05.markdown │ │ │ ├── 06.markdown │ │ │ └── 07.markdown │ │ └── problems/ │ │ └── 01.markdown │ ├── Gemfile │ ├── Rakefile │ ├── build/ │ │ ├── app.rb │ │ ├── build.rb │ │ ├── ext/ │ │ │ ├── debug_helpers.h │ │ │ ├── drawing.py │ │ │ └── test.h │ │ ├── lib/ │ │ │ ├── catalog.rb │ │ │ ├── chapter_number.rb │ │ │ ├── exercise.rb │ │ │ ├── generator.rb │ │ │ ├── graph.rb │ │ │ ├── problem.rb │ │ │ ├── renderer.rb │ │ │ ├── runtimes/ │ │ │ │ ├── c.rb │ │ │ │ └── python.rb │ │ │ ├── runtimes.rb │ │ │ └── solution.rb │ │ ├── public/ │ │ │ └── css/ │ │ │ └── clrs.scss │ │ └── views/ │ │ ├── catalog.erb │ │ ├── exercise.erb │ │ ├── layout.erb │ │ └── problem.erb │ ├── config.ru │ ├── notes/ │ │ ├── week-01.markdown │ │ ├── week-02.markdown │ │ ├── week-03.markdown │ │ ├── week-04.markdown │ │ ├── week-05.markdown │ │ ├── week-06.markdown │ │ ├── week-07.markdown │ │ └── week-08.markdown │ └── target/ │ └── .gitignore ├── ruby/ │ └── understanding-computation/ │ ├── .gitignore │ ├── 03/ │ │ ├── 03.rb │ │ ├── example.rb │ │ ├── lib/ │ │ │ ├── dfa.rb │ │ │ ├── dfa_design.rb │ │ │ ├── dfa_rulebook.rb │ │ │ ├── dot.rb │ │ │ ├── fa_rule.rb │ │ │ ├── grammar.treetop │ │ │ ├── index.html │ │ │ ├── nfa.rb │ │ │ ├── nfa_design.rb │ │ │ ├── nfa_rulebook.rb │ │ │ ├── nfa_simulation.rb │ │ │ └── pattern.rb │ │ └── rulebooks.rb │ ├── 04/ │ │ ├── 04.rb │ │ ├── lib/ │ │ │ ├── dpda.rb │ │ │ ├── dpda_design.rb │ │ │ ├── dpda_rulebook.rb │ │ │ ├── lexical_analyzer.rb │ │ │ ├── npda.rb │ │ │ ├── npda_design.rb │ │ │ ├── npda_rulebook.rb │ │ │ ├── pda_configuration.rb │ │ │ ├── pda_rule.rb │ │ │ ├── simple_parser.rb │ │ │ └── stack.rb │ │ └── rulebooks.rb │ └── Rakefile ├── scala/ │ ├── expr/ │ │ ├── .gitignore │ │ ├── README.markdown │ │ ├── project/ │ │ │ ├── build/ │ │ │ │ └── Expressions.scala │ │ │ └── build.properties │ │ └── src/ │ │ ├── main/ │ │ │ └── scala/ │ │ │ └── expr/ │ │ │ ├── ActorEvaluation.scala │ │ │ ├── BadInputException.scala │ │ │ ├── Callable.scala │ │ │ ├── Env.scala │ │ │ ├── Evaluation.scala │ │ │ ├── Expr.scala │ │ │ ├── ExprException.scala │ │ │ ├── Lambda.scala │ │ │ ├── Parser.scala │ │ │ ├── Printer.scala │ │ │ ├── ScalaCode.scala │ │ │ └── repl/ │ │ │ ├── Command.scala │ │ │ ├── ConsoleShell.scala │ │ │ ├── InteractiveInterpreter.scala │ │ │ ├── JLineShell.scala │ │ │ ├── REPL.scala │ │ │ └── Shell.scala │ │ └── test/ │ │ └── scala/ │ │ └── expr/ │ │ ├── EnvSpec.scala │ │ ├── EvaluationSpec.scala │ │ ├── ExprGen.scala │ │ ├── ExpressionSpec.scala │ │ ├── LambdaSpec.scala │ │ ├── ParsingSpec.scala │ │ ├── PrintingExpressionsSpec.scala │ │ ├── PropertiesSpec.scala │ │ ├── ScalaCodeSpec.scala │ │ └── repl/ │ │ ├── CommandSpec.scala │ │ ├── REPLSpec.scala │ │ └── RecordingShell.scala │ └── programming_in_scala/ │ ├── .gitignore │ ├── README │ ├── project/ │ │ ├── build/ │ │ │ └── ProgrammingInScala.scala │ │ └── build.properties │ └── src/ │ ├── main/ │ │ └── scala/ │ │ ├── actorsimulation/ │ │ │ ├── Adders.scala │ │ │ ├── Circuit.scala │ │ │ ├── Clock.scala │ │ │ ├── Demo.scala │ │ │ └── Simulant.scala │ │ ├── arithmetic/ │ │ │ └── Expr.scala │ │ ├── layout/ │ │ │ ├── Element.scala │ │ │ └── Spiral.scala │ │ └── simulation/ │ │ ├── BasicCircuitSimulation.scala │ │ ├── CircuitSimulation.scala │ │ ├── Simulation.scala │ │ └── StairwayBookSimulation.scala │ └── test/ │ └── scala/ │ ├── arithmetic/ │ │ ├── ExprFormatterSpec.scala │ │ └── SimplificationSpec.scala │ └── layout/ │ ├── CompositionSpec.scala │ ├── FactoryMethodsSpec.scala │ └── SpiralSpec.scala ├── scheme/ │ ├── eopl/ │ │ ├── .gitignore │ │ ├── .ruby-version │ │ ├── .rvmrc │ │ ├── 01/ │ │ │ ├── 01.scm │ │ │ ├── 02.scm │ │ │ ├── 03.scm │ │ │ ├── 04.scm │ │ │ ├── 05.scm │ │ │ ├── 06.scm │ │ │ ├── 07.scm │ │ │ ├── 08.scm │ │ │ ├── 09.scm │ │ │ ├── 10.scm │ │ │ ├── 11.scm │ │ │ ├── 12.scm │ │ │ ├── 13.scm │ │ │ ├── 14.scm │ │ │ ├── 15.scm │ │ │ ├── 16.scm │ │ │ ├── 17.scm │ │ │ ├── 18.scm │ │ │ ├── 19.scm │ │ │ ├── 20.scm │ │ │ ├── 21.scm │ │ │ ├── 22.scm │ │ │ ├── 23.scm │ │ │ ├── 24.scm │ │ │ ├── 25.scm │ │ │ ├── 26.scm │ │ │ ├── 27.scm │ │ │ ├── 28.scm │ │ │ ├── 29.scm │ │ │ ├── 30.scm │ │ │ ├── 31.scm │ │ │ ├── 32.scm │ │ │ ├── 33.scm │ │ │ ├── 34.scm │ │ │ ├── 35.scm │ │ │ ├── 36.scm │ │ │ └── tests/ │ │ │ ├── 07-tests.scm │ │ │ ├── 08-tests.scm │ │ │ ├── 09-tests.scm │ │ │ ├── 12-tests.scm │ │ │ ├── 13-tests.scm │ │ │ ├── 15-tests.scm │ │ │ ├── 16-tests.scm │ │ │ ├── 17-tests.scm │ │ │ ├── 18-tests.scm │ │ │ ├── 19-tests.scm │ │ │ ├── 20-tests.scm │ │ │ ├── 21-tests.scm │ │ │ ├── 22-tests.scm │ │ │ ├── 23-tests.scm │ │ │ ├── 24-tests.scm │ │ │ ├── 25-tests.scm │ │ │ ├── 26-tests.scm │ │ │ ├── 27-tests.scm │ │ │ ├── 28-tests.scm │ │ │ ├── 29-tests.scm │ │ │ ├── 30-tests.scm │ │ │ ├── 31-tests.scm │ │ │ ├── 32-tests.scm │ │ │ ├── 33-tests.scm │ │ │ ├── 34-tests.scm │ │ │ ├── 35-tests.scm │ │ │ └── 36-tests.scm │ │ ├── 02/ │ │ │ ├── 01.scm │ │ │ ├── 02.scm │ │ │ ├── 03.scm │ │ │ ├── 04.scm │ │ │ ├── 05.scm │ │ │ ├── 06.scm │ │ │ ├── 07.scm │ │ │ ├── 08.scm │ │ │ ├── 09.scm │ │ │ ├── 10.scm │ │ │ ├── 11.scm │ │ │ ├── 12.scm │ │ │ ├── 13.scm │ │ │ ├── 14.scm │ │ │ ├── 15.scm │ │ │ ├── 16.scm │ │ │ ├── 17.scm │ │ │ ├── 18.scm │ │ │ ├── 19.scm │ │ │ ├── 20.scm │ │ │ ├── 21.scm │ │ │ ├── 22.scm │ │ │ ├── 23.scm │ │ │ ├── 24.scm │ │ │ ├── 25.scm │ │ │ ├── 26.scm │ │ │ ├── 27.scm │ │ │ ├── 28.scm │ │ │ ├── 29.scm │ │ │ ├── 30.scm │ │ │ ├── 31.scm │ │ │ └── tests/ │ │ │ ├── 01-tests.scm │ │ │ ├── 03-tests.scm │ │ │ ├── 05-tests.scm │ │ │ ├── 06-tests.scm │ │ │ ├── 07-tests.scm │ │ │ ├── 08-tests.scm │ │ │ ├── 09-tests.scm │ │ │ ├── 10-tests.scm │ │ │ ├── 11-tests.scm │ │ │ ├── 12-tests.scm │ │ │ ├── 13-tests.scm │ │ │ ├── 14-tests.scm │ │ │ ├── 15-tests.scm │ │ │ ├── 16-tests.scm │ │ │ ├── 17-tests.scm │ │ │ ├── 18-tests.scm │ │ │ ├── 19-tests.scm │ │ │ ├── 20-tests.scm │ │ │ ├── 21-tests.scm │ │ │ ├── 22-tests.scm │ │ │ ├── 23-tests.scm │ │ │ ├── 24-tests.scm │ │ │ ├── 25-tests.scm │ │ │ ├── 26-tests.scm │ │ │ ├── 28-tests.scm │ │ │ ├── 29-tests.scm │ │ │ ├── 30-tests.scm │ │ │ └── 31-tests.scm │ │ ├── 03/ │ │ │ ├── 01.scm │ │ │ ├── 02.scm │ │ │ ├── 03.scm │ │ │ ├── 04.scm │ │ │ ├── 05.scm │ │ │ ├── 06.scm │ │ │ ├── 07.scm │ │ │ ├── 08.scm │ │ │ ├── 09.scm │ │ │ ├── 10.scm │ │ │ ├── 11.scm │ │ │ ├── 12.scm │ │ │ ├── 13.scm │ │ │ ├── 14.scm │ │ │ ├── 15.scm │ │ │ ├── 16.scm │ │ │ ├── 17.scm │ │ │ ├── 18.scm │ │ │ ├── 19.scm │ │ │ ├── 20.scm │ │ │ ├── 21.scm │ │ │ ├── 22.scm │ │ │ ├── 23.scm │ │ │ ├── 24.scm │ │ │ ├── 25.scm │ │ │ ├── 26.scm │ │ │ ├── 27.scm │ │ │ ├── 28.scm │ │ │ ├── 29.scm │ │ │ ├── 30.scm │ │ │ ├── 31.scm │ │ │ ├── 32.scm │ │ │ ├── 33.scm │ │ │ ├── 34.scm │ │ │ ├── 35.scm │ │ │ ├── 36.scm │ │ │ ├── 37.scm │ │ │ ├── 38.scm │ │ │ ├── 39.scm │ │ │ ├── 40.scm │ │ │ ├── 41.scm │ │ │ ├── 42.scm │ │ │ ├── 43.scm │ │ │ ├── 44.scm │ │ │ ├── cases/ │ │ │ │ ├── let/ │ │ │ │ │ ├── all.scm │ │ │ │ │ ├── env.scm │ │ │ │ │ ├── eval.scm │ │ │ │ │ ├── parser.scm │ │ │ │ │ ├── test-helpers.scm │ │ │ │ │ └── tests.scm │ │ │ │ ├── letrec/ │ │ │ │ │ ├── all.scm │ │ │ │ │ ├── env.scm │ │ │ │ │ ├── eval.scm │ │ │ │ │ ├── parser.scm │ │ │ │ │ ├── test-helpers.scm │ │ │ │ │ └── tests.scm │ │ │ │ ├── nameless/ │ │ │ │ │ ├── all.scm │ │ │ │ │ ├── env.scm │ │ │ │ │ ├── eval.scm │ │ │ │ │ ├── parser.scm │ │ │ │ │ ├── test-helpers.scm │ │ │ │ │ └── tests.scm │ │ │ │ └── proc/ │ │ │ │ ├── all.scm │ │ │ │ ├── env.scm │ │ │ │ ├── eval.scm │ │ │ │ ├── parser.scm │ │ │ │ ├── test-helpers.scm │ │ │ │ └── tests.scm │ │ │ └── tests/ │ │ │ ├── 06-tests.scm │ │ │ ├── 07-tests.scm │ │ │ ├── 08-tests.scm │ │ │ ├── 09-tests.scm │ │ │ ├── 10-tests.scm │ │ │ ├── 11-tests.scm │ │ │ ├── 12-tests.scm │ │ │ ├── 13-tests.scm │ │ │ ├── 14-tests.scm │ │ │ ├── 15-tests.scm │ │ │ ├── 16-tests.scm │ │ │ ├── 17-tests.scm │ │ │ ├── 18-tests.scm │ │ │ ├── 19-tests.scm │ │ │ ├── 20-tests.scm │ │ │ ├── 21-tests.scm │ │ │ ├── 22-tests.scm │ │ │ ├── 23-tests.scm │ │ │ ├── 24-tests.scm │ │ │ ├── 25-tests.scm │ │ │ ├── 26-tests.scm │ │ │ ├── 27-tests.scm │ │ │ ├── 28-tests.scm │ │ │ ├── 29-tests.scm │ │ │ ├── 31-tests.scm │ │ │ ├── 32-tests.scm │ │ │ ├── 33-tests.scm │ │ │ ├── 34-tests.scm │ │ │ ├── 35-tests.scm │ │ │ ├── 36-tests.scm │ │ │ ├── 37-tests.scm │ │ │ ├── 38-tests.scm │ │ │ ├── 39-tests.scm │ │ │ ├── 40-tests.scm │ │ │ ├── 41-tests.scm │ │ │ ├── 42-tests.scm │ │ │ ├── 43-tests.scm │ │ │ ├── 44-tests.scm │ │ │ └── helpers/ │ │ │ ├── let.scm │ │ │ ├── letrec.scm │ │ │ ├── nameless.scm │ │ │ └── proc.scm │ │ ├── 04/ │ │ │ ├── 01.scm │ │ │ ├── 02.scm │ │ │ ├── 03.scm │ │ │ ├── 04.scm │ │ │ ├── 05.scm │ │ │ ├── 06.scm │ │ │ ├── 07.scm │ │ │ ├── 08.scm │ │ │ └── cases/ │ │ │ └── explicit-refs/ │ │ │ ├── all.scm │ │ │ ├── env.scm │ │ │ ├── eval.scm │ │ │ ├── parser.scm │ │ │ ├── test-helpers.scm │ │ │ └── tests.scm │ │ ├── B/ │ │ │ ├── 01.scm │ │ │ ├── 02.scm │ │ │ ├── 03.scm │ │ │ ├── 04.scm │ │ │ ├── 05.scm │ │ │ └── tests/ │ │ │ ├── 01-tests.scm │ │ │ ├── 03-tests.scm │ │ │ ├── 04-tests.scm │ │ │ └── 05-tests.scm │ │ ├── Gemfile │ │ ├── Guardfile │ │ ├── Thorfile │ │ ├── build/ │ │ │ ├── exercise.rb │ │ │ └── templates/ │ │ │ ├── exercise.scm │ │ │ └── test.scm │ │ ├── notes/ │ │ │ ├── week-01.markdown │ │ │ ├── week-02.markdown │ │ │ └── week-03.markdown │ │ └── support/ │ │ └── eopl.scm │ └── sicp/ │ ├── .gitignore │ ├── 01/ │ │ ├── 01.scm │ │ ├── 02.scm │ │ ├── 03.scm │ │ ├── 04.scm │ │ ├── 05.scm │ │ ├── 06.scm │ │ ├── 07.scm │ │ ├── 08.scm │ │ ├── 09.scm │ │ ├── 10.scm │ │ ├── 11.scm │ │ ├── 12.scm │ │ ├── 13.scm │ │ ├── 14.scm │ │ ├── 15.scm │ │ ├── 16.scm │ │ ├── 17.scm │ │ ├── 18.scm │ │ ├── 19.scm │ │ ├── 20.scm │ │ ├── 21.scm │ │ ├── 22.scm │ │ ├── 23.scm │ │ ├── 24.scm │ │ ├── 25.scm │ │ ├── 26.scm │ │ ├── 27.scm │ │ ├── 28.scm │ │ ├── 29.scm │ │ ├── 30.scm │ │ ├── 31.scm │ │ ├── 32.scm │ │ ├── 33.scm │ │ ├── 34.scm │ │ ├── 35.scm │ │ ├── 36.scm │ │ ├── 37.scm │ │ ├── 38.scm │ │ ├── 39.scm │ │ ├── 40.scm │ │ ├── 41.scm │ │ ├── 42.scm │ │ ├── 43.scm │ │ ├── 44.scm │ │ ├── 45.scm │ │ ├── 46.scm │ │ └── tests/ │ │ ├── 03-tests.scm │ │ ├── 07-tests.scm │ │ ├── 08-tests.scm │ │ ├── 11-tests.scm │ │ ├── 12-tests.scm │ │ ├── 16-tests.scm │ │ ├── 17-tests.scm │ │ ├── 18-tests.scm │ │ ├── 19-tests.scm │ │ ├── 27-tests.scm │ │ ├── 28-tests.scm │ │ ├── 29-tests.scm │ │ ├── 30-tests.scm │ │ ├── 31-tests.scm │ │ ├── 32-tests.scm │ │ ├── 33-tests.scm │ │ ├── 35-tests.scm │ │ ├── 37-tests.scm │ │ ├── 38-tests.scm │ │ ├── 39-tests.scm │ │ ├── 40-tests.scm │ │ ├── 41-tests.scm │ │ ├── 42-tests.scm │ │ ├── 43-tests.scm │ │ ├── 44-tests.scm │ │ ├── 45-tests.scm │ │ └── 46-tests.scm │ ├── 02/ │ │ ├── 01.scm │ │ ├── 02.scm │ │ ├── 03.scm │ │ ├── 04.scm │ │ ├── 05.scm │ │ ├── 06.scm │ │ ├── 07.scm │ │ ├── 08.scm │ │ ├── 09.scm │ │ ├── 10.scm │ │ ├── 11.scm │ │ ├── 12.scm │ │ ├── 13.scm │ │ ├── 14.scm │ │ ├── 15.scm │ │ ├── 16.scm │ │ ├── 17.scm │ │ ├── 18.scm │ │ ├── 19.scm │ │ ├── 20.scm │ │ ├── 21.scm │ │ ├── 22.scm │ │ ├── 23.scm │ │ ├── 24.scm │ │ ├── 25.scm │ │ ├── 26.scm │ │ ├── 27.scm │ │ ├── 28.scm │ │ ├── 29.scm │ │ ├── 30.scm │ │ ├── 31.scm │ │ ├── 32.scm │ │ ├── 33.scm │ │ ├── 34.scm │ │ ├── 35.scm │ │ ├── 36.scm │ │ ├── 37.scm │ │ ├── 38.scm │ │ ├── 39.scm │ │ ├── 40.scm │ │ ├── 41.scm │ │ ├── 42.scm │ │ ├── 43.scm │ │ ├── 44.scm │ │ ├── 45.scm │ │ ├── 46.scm │ │ ├── 47.scm │ │ ├── 48.scm │ │ ├── 49.scm │ │ ├── 50.scm │ │ ├── 51.scm │ │ ├── 52.scm │ │ ├── 53.scm │ │ ├── 54.scm │ │ ├── 55.scm │ │ ├── 56.scm │ │ ├── 57.scm │ │ ├── 58.scm │ │ ├── 59.scm │ │ ├── 60.scm │ │ ├── 61.scm │ │ ├── 62.scm │ │ ├── 63.scm │ │ ├── 64.scm │ │ ├── 65.scm │ │ ├── 66.scm │ │ ├── 67.scm │ │ ├── 68.scm │ │ ├── 69.scm │ │ ├── 70.scm │ │ ├── 71.scm │ │ ├── 72.scm │ │ ├── 73.scm │ │ ├── 74.scm │ │ ├── 75.scm │ │ ├── 76.scm │ │ ├── 77.scm │ │ ├── 78.scm │ │ ├── 79.scm │ │ ├── 80.scm │ │ ├── 81.scm │ │ ├── 82.scm │ │ ├── 83.scm │ │ ├── 84.scm │ │ ├── 85.scm │ │ ├── 86.scm │ │ ├── 87.scm │ │ ├── 88.scm │ │ ├── 89.scm │ │ ├── 90.scm │ │ ├── 91.scm │ │ ├── 92.scm │ │ ├── 93.scm │ │ ├── 94.scm │ │ ├── 95.scm │ │ ├── 96.scm │ │ ├── 97.scm │ │ ├── showcase/ │ │ │ └── picturelang/ │ │ │ └── main.scm │ │ └── tests/ │ │ ├── 01-tests.scm │ │ ├── 02-tests.scm │ │ ├── 03-tests.scm │ │ ├── 05-tests.scm │ │ ├── 06-tests.scm │ │ ├── 07-tests.scm │ │ ├── 08-tests.scm │ │ ├── 10-tests.scm │ │ ├── 11-tests.scm │ │ ├── 12-tests.scm │ │ ├── 17-tests.scm │ │ ├── 18-tests.scm │ │ ├── 19-tests.scm │ │ ├── 20-tests.scm │ │ ├── 21-tests.scm │ │ ├── 25-tests.scm │ │ ├── 27-tests.scm │ │ ├── 28-tests.scm │ │ ├── 29-tests.scm │ │ ├── 30-tests.scm │ │ ├── 31-tests.scm │ │ ├── 32-tests.scm │ │ ├── 33-tests.scm │ │ ├── 34-tests.scm │ │ ├── 35-tests.scm │ │ ├── 36-tests.scm │ │ ├── 37-tests.scm │ │ ├── 39-tests.scm │ │ ├── 40-tests.scm │ │ ├── 41-tests.scm │ │ ├── 42-tests.scm │ │ ├── 44-tests.scm │ │ ├── 45-tests.scm │ │ ├── 46-tests.scm │ │ ├── 47-tests.scm │ │ ├── 48-tests.scm │ │ ├── 54-tests.scm │ │ ├── 56-tests.scm │ │ ├── 57-tests.scm │ │ ├── 58-tests.scm │ │ ├── 59-tests.scm │ │ ├── 60-tests.scm │ │ ├── 61-tests.scm │ │ ├── 62-tests.scm │ │ ├── 65-tests.scm │ │ ├── 66-tests.scm │ │ ├── 67-tests.scm │ │ ├── 68-tests.scm │ │ ├── 69-tests.scm │ │ ├── 73-tests.scm │ │ ├── 74-tests.scm │ │ ├── 75-tests.scm │ │ ├── 78-tests.scm │ │ ├── 79-tests.scm │ │ ├── 80-tests.scm │ │ ├── 82-tests.scm │ │ ├── 83-tests.scm │ │ ├── 84-tests.scm │ │ ├── 85-tests.scm │ │ ├── 86-tests.scm │ │ ├── 87-tests.scm │ │ ├── 88-tests.scm │ │ ├── 89-tests.scm │ │ ├── 90-tests.scm │ │ ├── 91-tests.scm │ │ ├── 92-tests.scm │ │ ├── 93-tests.scm │ │ ├── 94-tests.scm │ │ ├── 96-tests.scm │ │ └── 97-tests.scm │ ├── 03/ │ │ ├── 01.scm │ │ ├── 02.scm │ │ ├── 03.scm │ │ ├── 04.scm │ │ ├── 05.scm │ │ ├── 06.scm │ │ ├── 07.scm │ │ ├── 08.scm │ │ ├── 09.scm │ │ ├── 10.scm │ │ ├── 11.scm │ │ ├── 12.scm │ │ ├── 13.scm │ │ ├── 14.scm │ │ ├── 15.scm │ │ ├── 16.scm │ │ ├── 17.scm │ │ ├── 18.scm │ │ ├── 19.scm │ │ ├── 20.scm │ │ ├── 21.scm │ │ ├── 22.scm │ │ ├── 23.scm │ │ ├── 24.scm │ │ ├── 25.scm │ │ ├── 26.scm │ │ ├── 27.scm │ │ ├── 28.scm │ │ ├── 29.scm │ │ ├── 30.scm │ │ ├── 31.scm │ │ ├── 32.scm │ │ ├── 33.scm │ │ ├── 34.scm │ │ ├── 35.scm │ │ ├── 36.scm │ │ ├── 37.scm │ │ ├── 38.scm │ │ ├── 39.scm │ │ ├── 40.scm │ │ ├── 41.scm │ │ ├── 42.scm │ │ ├── 43.scm │ │ ├── 44.scm │ │ ├── 45.scm │ │ ├── 46.scm │ │ ├── 47.scm │ │ ├── 48.scm │ │ ├── 49.scm │ │ ├── 50.scm │ │ ├── 51.scm │ │ ├── 52.scm │ │ ├── 53.scm │ │ ├── 54.scm │ │ ├── 55.scm │ │ ├── 56.scm │ │ ├── 57.scm │ │ ├── 58.scm │ │ ├── 59.scm │ │ ├── 60.scm │ │ ├── 61.scm │ │ ├── 62.scm │ │ ├── 63.scm │ │ ├── 64.scm │ │ ├── 65.scm │ │ ├── 66.scm │ │ ├── 67.scm │ │ ├── 68.scm │ │ ├── 69.scm │ │ ├── 70.scm │ │ ├── 71.scm │ │ ├── 72.scm │ │ ├── 73.scm │ │ ├── 74.scm │ │ ├── 75.scm │ │ ├── 76.scm │ │ ├── 77.scm │ │ ├── 78.scm │ │ ├── 79.scm │ │ ├── 80.scm │ │ ├── 81.scm │ │ ├── 82.scm │ │ └── tests/ │ │ ├── 01-tests.scm │ │ ├── 02-tests.scm │ │ ├── 03-tests.scm │ │ ├── 04-tests.scm │ │ ├── 05-tests.scm │ │ ├── 07-tests.scm │ │ ├── 16-tests.scm │ │ ├── 17-tests.scm │ │ ├── 18-tests.scm │ │ ├── 19-tests.scm │ │ ├── 21-tests.scm │ │ ├── 22-tests.scm │ │ ├── 23-tests.scm │ │ ├── 24-tests.scm │ │ ├── 25-tests.scm │ │ ├── 28-tests.scm │ │ ├── 29-tests.scm │ │ ├── 30-tests.scm │ │ ├── 33-tests.scm │ │ ├── 35-tests.scm │ │ ├── 37-tests.scm │ │ ├── 50-tests.scm │ │ ├── 54-tests.scm │ │ ├── 55-tests.scm │ │ ├── 56-tests.scm │ │ ├── 59-tests.scm │ │ ├── 60-tests.scm │ │ ├── 61-tests.scm │ │ ├── 62-tests.scm │ │ ├── 64-tests.scm │ │ ├── 66-tests.scm │ │ ├── 69-tests.scm │ │ ├── 70-tests.scm │ │ ├── 71-tests.scm │ │ ├── 72-tests.scm │ │ ├── 73-tests.scm │ │ ├── 74-tests.scm │ │ ├── 76-tests.scm │ │ ├── 80-tests.scm │ │ ├── 81-tests.scm │ │ └── 82-tests.scm │ ├── 04/ │ │ ├── 01.scm │ │ ├── 02.scm │ │ ├── 03.scm │ │ ├── 04.scm │ │ ├── 05.scm │ │ ├── 06.scm │ │ ├── 07.scm │ │ ├── 08.scm │ │ ├── 09.scm │ │ ├── 10.scm │ │ ├── 11.scm │ │ ├── 12.scm │ │ ├── 13.scm │ │ ├── 14.scm │ │ ├── 15.scm │ │ ├── 16.scm │ │ ├── 17.scm │ │ ├── 18.scm │ │ ├── 19.scm │ │ ├── 20.scm │ │ ├── 21.scm │ │ ├── 22.scm │ │ ├── 23.scm │ │ ├── 24.scm │ │ ├── 25.scm │ │ ├── 26.scm │ │ ├── 27.scm │ │ ├── 28.scm │ │ ├── 29.scm │ │ ├── 30.scm │ │ ├── 31.scm │ │ ├── 32.scm │ │ ├── 33.scm │ │ ├── 34.scm │ │ ├── 35.scm │ │ ├── 36.scm │ │ ├── 37.scm │ │ ├── 38.scm │ │ ├── 39.scm │ │ ├── 40.scm │ │ ├── 41.scm │ │ ├── 42.scm │ │ ├── 43.scm │ │ ├── 44.scm │ │ ├── 45.scm │ │ ├── 46.scm │ │ ├── 47.scm │ │ ├── 48.scm │ │ ├── 49.scm │ │ ├── 50.scm │ │ ├── 51.scm │ │ ├── 52.scm │ │ ├── 53.scm │ │ ├── 54.scm │ │ ├── 55.scm │ │ ├── 56.scm │ │ ├── 57.scm │ │ ├── 58.scm │ │ ├── 59.scm │ │ ├── 60.scm │ │ ├── 61.scm │ │ ├── 62.scm │ │ ├── 63.scm │ │ ├── 64.scm │ │ ├── 65.scm │ │ ├── 66.scm │ │ ├── 67.scm │ │ ├── 68.scm │ │ ├── 69.scm │ │ ├── 70.scm │ │ ├── 71.scm │ │ ├── 72.scm │ │ ├── 73.scm │ │ ├── 74.scm │ │ ├── 75.scm │ │ ├── 76.scm │ │ ├── 77.scm │ │ ├── 78.scm │ │ ├── 79.scm │ │ ├── showcase/ │ │ │ ├── amb/ │ │ │ │ ├── evaluator.scm │ │ │ │ ├── main.scm │ │ │ │ └── tests.scm │ │ │ ├── analyzing/ │ │ │ │ ├── evaluator.scm │ │ │ │ ├── main.scm │ │ │ │ └── tests.scm │ │ │ ├── evaluator/ │ │ │ │ ├── evaluator.scm │ │ │ │ ├── main.scm │ │ │ │ └── tests.scm │ │ │ ├── lazy/ │ │ │ │ ├── evaluator.scm │ │ │ │ ├── main.scm │ │ │ │ └── tests.scm │ │ │ └── query/ │ │ │ ├── database.scm │ │ │ ├── evaluator.scm │ │ │ ├── main.scm │ │ │ ├── test-helpers.scm │ │ │ └── tests.scm │ │ └── tests/ │ │ ├── 01-tests.scm │ │ ├── 02-tests.scm │ │ ├── 03-tests.scm │ │ ├── 04-tests.scm │ │ ├── 05-tests.scm │ │ ├── 06-tests.scm │ │ ├── 07-tests.scm │ │ ├── 08-tests.scm │ │ ├── 09-tests.scm │ │ ├── 10-tests.scm │ │ ├── 11-tests.scm │ │ ├── 12-tests.scm │ │ ├── 13-tests.scm │ │ ├── 16-tests.scm │ │ ├── 20-tests.scm │ │ ├── 21-tests.scm │ │ ├── 22-tests.scm │ │ ├── 31-tests.scm │ │ ├── 33-tests.scm │ │ ├── 34-tests.scm │ │ ├── 35-tests.scm │ │ ├── 36-tests.scm │ │ ├── 38-tests.scm │ │ ├── 41-tests.scm │ │ ├── 42-tests.scm │ │ ├── 43-tests.scm │ │ ├── 44-tests.scm │ │ ├── 45-tests.scm │ │ ├── 48-tests.scm │ │ ├── 49-tests.scm │ │ ├── 51-tests.scm │ │ ├── 52-tests.scm │ │ ├── 53-tests.scm │ │ ├── 54-tests.scm │ │ ├── 55-tests.scm │ │ ├── 56-tests.scm │ │ ├── 57-tests.scm │ │ ├── 58-tests.scm │ │ ├── 59-tests.scm │ │ ├── 60-tests.scm │ │ ├── 61-tests.scm │ │ ├── 62-tests.scm │ │ ├── 63-tests.scm │ │ ├── 67-tests.scm │ │ ├── 68-tests.scm │ │ ├── 69-tests.scm │ │ ├── 75-tests.scm │ │ ├── 76-tests.scm │ │ ├── 77-tests.scm │ │ ├── 78-tests.scm │ │ ├── 79-tests.scm │ │ └── helpers/ │ │ └── query.scm │ ├── 05/ │ │ ├── 01.scm │ │ ├── 02.scm │ │ ├── 03.scm │ │ ├── 04.scm │ │ ├── 05.scm │ │ ├── 06.scm │ │ ├── 07.scm │ │ ├── 08.scm │ │ ├── 09.scm │ │ ├── 10.scm │ │ ├── 11.scm │ │ ├── 12.scm │ │ ├── 13.scm │ │ ├── 14.scm │ │ ├── 15.scm │ │ ├── 16.scm │ │ ├── 17.scm │ │ ├── 18.scm │ │ ├── 19.scm │ │ ├── 20.scm │ │ ├── 21.scm │ │ ├── 22.scm │ │ ├── 23.scm │ │ ├── 24.scm │ │ ├── 25.scm │ │ ├── 26.scm │ │ ├── 27.scm │ │ ├── 28.scm │ │ ├── 29.scm │ │ ├── 30.scm │ │ ├── 31.scm │ │ ├── 32.scm │ │ ├── 33.scm │ │ ├── 34.scm │ │ ├── 35.scm │ │ ├── 36.scm │ │ ├── 37.scm │ │ ├── 38.scm │ │ ├── 39.scm │ │ ├── 40.scm │ │ ├── 41.scm │ │ ├── 42.scm │ │ ├── 43.scm │ │ ├── 44.scm │ │ ├── 45.scm │ │ ├── 46.scm │ │ ├── 47.scm │ │ ├── 48.scm │ │ ├── 49.scm │ │ ├── 50.scm │ │ ├── 51.scm │ │ ├── 52.scm │ │ ├── showcase/ │ │ │ ├── compiler/ │ │ │ │ ├── compiler.scm │ │ │ │ ├── explicit-evaluator-text.scm │ │ │ │ ├── helpers.scm │ │ │ │ ├── main.scm │ │ │ │ ├── operations.scm │ │ │ │ ├── syntax.scm │ │ │ │ └── tests.scm │ │ │ ├── explicit/ │ │ │ │ ├── controller-text.scm │ │ │ │ ├── evaluator.scm │ │ │ │ ├── main.scm │ │ │ │ ├── operations.scm │ │ │ │ └── tests.scm │ │ │ └── simulator/ │ │ │ ├── sample-machines.scm │ │ │ ├── simulator.scm │ │ │ └── tests.scm │ │ ├── support/ │ │ │ ├── 51/ │ │ │ │ ├── evaluator.c │ │ │ │ └── tests.scm │ │ │ ├── 52/ │ │ │ │ ├── build.scm │ │ │ │ ├── compiler.scm │ │ │ │ ├── metacircular-evaluator.scm │ │ │ │ ├── runtime.c │ │ │ │ ├── syntax.scm │ │ │ │ └── tests.scm │ │ │ └── bin/ │ │ │ └── .gitignore │ │ └── tests/ │ │ ├── 02-tests.scm │ │ ├── 03-tests.scm │ │ ├── 04-tests.scm │ │ ├── 06-tests.scm │ │ ├── 08-tests.scm │ │ ├── 09-tests.scm │ │ ├── 10-tests.scm │ │ ├── 11-tests.scm │ │ ├── 12-tests.scm │ │ ├── 13-tests.scm │ │ ├── 15-tests.scm │ │ ├── 16-tests.scm │ │ ├── 17-tests.scm │ │ ├── 18-tests.scm │ │ ├── 19-tests.scm │ │ ├── 21-tests.scm │ │ ├── 22-tests.scm │ │ ├── 23-tests.scm │ │ ├── 24-tests.scm │ │ ├── 25-tests.scm │ │ ├── 30-tests.scm │ │ ├── 32-tests.scm │ │ ├── 36-tests.scm │ │ ├── 38-tests.scm │ │ ├── 39-tests.scm │ │ ├── 40-tests.scm │ │ ├── 41-tests.scm │ │ ├── 42-tests.scm │ │ ├── 43-tests.scm │ │ ├── 44-tests.scm │ │ ├── 47-tests.scm │ │ ├── 50-tests.scm │ │ ├── 51-tests.scm │ │ ├── 52-tests.scm │ │ └── helpers/ │ │ ├── compiler.scm │ │ ├── evaluator.scm │ │ ├── memory.scm │ │ ├── monitored-stack.scm │ │ ├── sample-machines.scm │ │ └── simulator.scm │ ├── README.markdown │ ├── Rakefile │ ├── notes/ │ │ ├── week-01.markdown │ │ ├── week-02.markdown │ │ ├── week-03.markdown │ │ ├── week-04.markdown │ │ ├── week-05.markdown │ │ ├── week-06.markdown │ │ ├── week-07.markdown │ │ ├── week-08.markdown │ │ ├── week-09.markdown │ │ ├── week-10.markdown │ │ ├── week-11.markdown │ │ ├── week-12.markdown │ │ ├── week-13.markdown │ │ ├── week-14.markdown │ │ ├── week-15.markdown │ │ ├── week-16.markdown │ │ ├── week-17.markdown │ │ ├── week-18.markdown │ │ └── week-19.markdown │ └── tests.watchr └── textmate/ └── PLT Scheme.tmbundle/ ├── README ├── Syntaxes/ │ └── Scheme.tmLanguage └── info.plist ================================================ FILE CONTENTS ================================================ ================================================ FILE: .git-hooks/install-hooks ================================================ #!/usr/bin/env zsh emulate -R zsh cd ${0%/*} hooks_dir="$(git rev-parse --git-dir)/hooks" for hook in *; do if [[ $hook = ${0:t} ]]; then continue fi target="$hooks_dir/$hook" if [[ ! -f $target ]]; then print "Linking $hook..." ln -fs ${hook:a} $target elif [[ -h $target ]]; then print "$hook already linked." else print "[ERROR] $hook already exists!" return 1 fi done ================================================ FILE: .git-hooks/prepare-commit-msg ================================================ #!/usr/bin/env zsh emulate -LR zsh setopt extendedglob files=("${(@f)$(git diff --cached --name-only)}") case $files[1] in (#b)other/clrs/([0-9][0-9])/([0-9][0-9]|problems)/([0-9][0-9]).*) prefix=${files[1]%%.*} # The filenames are sorted. If the first and the last have the same prefix, # then every element in the file has this prefix. if [[ $files[-1] != $prefix.* ]]; then return 0 fi # Don't do anything if a commit message is already present if [[ -n $(head -n 1 $1) ]]; then return 0 fi chapter=${match[1]#0} section=${match[2]#0} exercise=${match[3]#0} if [[ $section = 'problems' ]]; then title=$(head -n 1 $prefix.markdown) message="clrs; problem $chapter.$exercise - ${(L)title##\#\# }" else message="clrs; exercise $chapter.$section.$exercise - " fi sed -i -e "1i\\ $message\\ " $1 ;; (#b)scheme/eopl/([0-9][0-9])/([0-9][0-9]).scm) chapter=${match[1]} exercise=${match[2]} # Abort if files are not for the same exercise for file in $files; do [[ $file != scheme/eopl/$chapter(/$exercise|/tests/${exercise}-tests).scm ]] && return 0 done # Abort if commit message already enetered [[ -n $(head -n 1 $1) ]] && return 0 sed -i -e "1i\\ eopl; exercise ${chapter#0}.$exercise - \\ " $1 ;; *) ;; esac ================================================ FILE: .gitignore ================================================ java/**/bin/** java/*/.classpath java/*/.project java/*/.settings/ ================================================ FILE: README ================================================ You should probably not care about this project. It contains various code I decided to keep for various reason, none of them actually worth sharing. ================================================ FILE: Rakefile ================================================ desc 'Install git hooks' task :hooks do Dir['git-hooks/*'].each do |file| name = file.split('/').last sh "ln -s ../../#{file} .git/hooks/#{name}" end end ================================================ FILE: advent-of-code/2020/01.1.pl ================================================ use strict; use v5.32; open INPUT, '<', 'inputs/1.1'; my @numbers; while () { chomp $_; push @numbers, $_; } for my $a (@numbers) { for my $b (@numbers) { if ($a + $b == 2020) { say "$a + $b = 2020; a * b = @{[$a * $b]}"; } } } ================================================ FILE: advent-of-code/2020/01.2.pl ================================================ use strict; use v5.32; open INPUT, '<', 'inputs/1.1'; my @numbers; while () { chomp $_; push @numbers, $_; } for my $a (@numbers) { for my $b (@numbers) { for my $c (@numbers) { if ($a + $b + $c == 2020) { say "$a + $b + $c = 2020; a * b = @{[$a * $b * $c]}"; } } } } ================================================ FILE: advent-of-code/2020/02.1.pl ================================================ use v5.32; use warnings; open INPUT, '<', 'inputs/2' or die; my $valid = 0; while () { /^(\d+)-(\d+) (\w): (.*)$/ or die("Unmatched input: $_"); my ($low, $high, $char, $password) = ($1, $2, $3, $4); my $count = () = ($password =~ /$char/g); $valid++ if ($low <= $count && $count <= $high); } say $valid; ================================================ FILE: advent-of-code/2020/02.2.pl ================================================ use v5.32; use warnings; open INPUT, '<', 'inputs/2' or die; my $valid = 0; my $count = 0; while () { $count++; /^(\d+)-(\d+) (\w): (.*)$/ or die("Unmatched input: $_"); my ($first, $second, $char, $password) = ($1, $2, $3, $4); $valid++ if substr($password, $first - 1, 1) eq $char xor substr($password, $second - 1, 1) eq $char; } say $valid; ================================================ FILE: advent-of-code/2020/03.1.pl ================================================ use v5.32; use warnings; open INPUT, '<', 'inputs/3' or die; my $input = [map { chomp; $_ } ]; my $width = length($input->[0]); my $height = @$input; my @directions = (3, 1); my ($x, $y) = (0, 0); my $trees = 0; while ($y < $height) { $trees++ if substr($input->[$y], $x, 1) eq '#'; $y += $directions[1]; $x += $directions[0]; $x %= $width; } say $trees; ================================================ FILE: advent-of-code/2020/03.2.pl ================================================ use v5.32; use warnings; use List::Util qw( reduce ); open INPUT, '<', 'inputs/3' or die; sub collisions { my ( $input, $directions ) = @_; my $width = length($input->[0]); my $height = @$input; my ($x, $y) = (0, 0); my $trees = 0; while ( $y < $height ) { $trees++ if substr( $input->[$y], $x, 1 ) eq '#'; $y += $directions->[1]; $x += $directions->[0]; $x %= $width; } $trees; } my $input = [map { chomp; $_ } ]; my $directions = [ [1, 1], [3, 1], [5, 1], [7, 1], [1, 2], ]; my @numbers; for my $direction (@$directions) { my $trees = collisions( $input, $direction ); say "right $direction->[0], left $direction->[1] = $trees"; push @numbers, $trees; } say "product = " . reduce { $a * $b } @numbers; ================================================ FILE: advent-of-code/2020/04.1.pl ================================================ use v5.32; use warnings; use Set::Scalar; open INPUT, '<', 'inputs/4'; my $required = Set::Scalar->new(qw(byr iyr eyr hgt hcl ecl pid)); my $count; local $/ = "\n\n"; while () { chomp; my $record = $_; my %fields; $fields{$1} = $2 while $record =~ /(\S+):(\S+)/g; my $keys = Set::Scalar->new(keys(%fields)); $count++ if $required->difference($keys)->is_empty; } say $count; ================================================ FILE: advent-of-code/2020/04.2.pl ================================================ use v5.32; use warnings; use Set::Scalar; use Data::Dump qw(dump); open INPUT, '<', 'inputs/4'; my $required = Set::Scalar->new(qw(byr iyr eyr hgt hcl ecl pid)); my $count; local $/ = "\n\n"; while ( ) { chomp; my $record = $_; my %fields; $fields{$1} = $2 while $record =~ /(\S+):(\S+)/g; my $keys = Set::Scalar->new( keys( %fields ) ); next unless $required->difference( $keys )->is_empty; my ( $height, $unit ) = ( $fields{hgt} =~ /(\d+)(cm|in)/ ); next unless 1920 <= $fields{byr} and $fields{byr} <= 2002; next unless 2010 <= $fields{iyr} and $fields{iyr} <= 2020; next unless 2020 <= $fields{eyr} and $fields{eyr} <= 2030; next unless defined $unit; next unless ( $unit eq 'cm' and 150 <= $height and $height <= 193 ) or ( $unit eq 'in' and 59 <= $height and $height <= 76); next unless $fields{hcl} =~ /^#[0-9a-f]{6}$/; next unless $fields{ecl} =~ /^(amb|blu|brn|gry|grn|hzl|oth)$/; next unless $fields{pid} =~ /^\d{9}$/; $count++; } say $count; ================================================ FILE: advent-of-code/2020/05.1.pl ================================================ use v5.32; use warnings; use List::Util qw(max); my $line = 'BFFFBBFRRR'; open INPUT, '<', 'inputs/5'; sub seat { $_ = shift; s/[BR]/1/g; s/[FL]/0/g; my ( $row, $column ) = (m/(\d{7})(\d{3})/); $row = oct( "0b$row" ); $column = oct( "0b$column" ); [ $row, $column ]; } sub seat_id { my ($row, $column) = seat($_[0])->@*; return $row * 8 + $column; } my @ids; push @ids, seat_id($_) while ; say max(@ids); ================================================ FILE: advent-of-code/2020/05.2.pl ================================================ use v5.32; use warnings; use Array::Utils qw(array_minus); use List::Util qw(min max); my $line = 'BFFFBBFRRR'; open INPUT, '<', 'inputs/5'; sub seat { $_ = shift; s/[BR]/1/g; s/[FL]/0/g; my ( $row, $column ) = (m/(\d{7})(\d{3})/); $row = oct( "0b$row" ); $column = oct( "0b$column" ); [ $row, $column ]; } sub seat_id { my ( $row, $column ) = seat( $_[0] )->@*; return $row * 8 + $column; } my @ids; push @ids, seat_id($_) while ; my @range = ( min(@ids) .. max(@ids) ); say array_minus(@range, @ids); ================================================ FILE: advent-of-code/2020/06.1.pl ================================================ use v5.32; use warnings; use Data::Dump qw( dump ); use List::Util qw( reduce ); use List::MoreUtils qw( uniq ); open INPUT, '<', 'inputs/6' or die; $_ = do { local $/; }; my @chunks = split /\n\n/; chomp @chunks; s/\n//g for @chunks; dump reduce { $a + $b } map { scalar uniq split '' } @chunks; ================================================ FILE: advent-of-code/2020/06.2.pl ================================================ use v5.32; use warnings; use Data::Dump qw( dump ); use List::Util qw( reduce ); use List::MoreUtils qw( uniq ); use Set::Scalar; open INPUT, '<', 'inputs/6' or die; $_ = do { local $/; }; my @chunks = split /\n\n/; chomp @chunks; dump reduce { $a + $b } map { scalar $_->elements } map { reduce { $a->intersection($b) } map { Set::Scalar->new(split '') } split "\n" } @chunks; ================================================ FILE: advent-of-code/2020/07.1.pl ================================================ use v5.32; use warnings; use Data::Dump qw(dump); my %bags; open INPUT, '<', 'inputs/7' or die; while () { /^(.*)? bags contain (.*)\.$/ or die; my $color = $1; if ( $2 eq 'no other bags' ) { $bags{ $color } = []; next; } my @options = split ', ', $2; for ( @options ) { /^(\d+) (.*?) bags?$/ or die; my ( $count, $inner_color ) = ( $1, $2 ); push @{ $bags{$color} }, $inner_color; } } sub can_contain { my ( $outer, $inner ) = @_; my @stack = ( $outer ); while ( @stack ) { my $key = shift @stack; return 1 if ( $key eq $inner ); push @stack, $bags{$key}->@*; } 0; } my $count; for ( keys %bags ) { next if $_ eq 'shiny gold'; $count++ if can_contain( $_, 'shiny gold' ); } say $count; ================================================ FILE: advent-of-code/2020/07.2.pl ================================================ use v5.32; use warnings; use List::Util qw( reduce ); use Data::Dump qw(dump); my %bags; open INPUT, '<', 'inputs/7' or die; while () { /^(.*)? bags contain (.*)\.$/ or die; my $color = $1; if ( $2 eq 'no other bags' ) { $bags{ $color } = []; next; } my @options = split ', ', $2; for ( @options ) { /^(\d+) (.*?) bags?$/ or die; my ( $count, $inner_color ) = ( $1, $2 ); push @{ $bags{$color} }, { count => $count, color => $inner_color }; } } sub number_of_bags { my ( $color ) = @_; return 0 unless $bags{ $color }->@*; reduce { $a + $b } map { $_->{count} + $_->{count} * number_of_bags($_->{color}) } $bags{ $color }->@*; } say number_of_bags( 'shiny gold' ); ================================================ FILE: advent-of-code/2020/08.1.pl ================================================ use v5.32; use warnings; use experimental qw( switch ); my @instructions; open INPUT, '<', 'inputs/8'; while ( ) { my ( $op, $arg ) = split ' '; push @instructions, { op => $op, arg => $arg }; } my @executed; my $ip = 0; my $reg = 0; while (1) { my ( $op, $arg ) = $instructions[$ip]->@{'op', 'arg'}; last if $executed[$ip]; $executed[$ip] = 1; $ip++; given ( $op ) { when('nop') { } when('jmp') { $ip += $arg - 1 } when('acc') { $reg += $arg } } } say $reg; ================================================ FILE: advent-of-code/2020/08.2.pl ================================================ use v5.32; use warnings; use experimental qw( switch ); use Storable qw( dclone ); my @instructions; open INPUT, '<', 'inputs/8'; while ( ) { my ( $op, $arg ) = split ' '; push @instructions, { op => $op, arg => $arg }; } use Data::Dump qw(dump); sub evaluate { my ( $instructions ) = @_; my @executed; my $infinite = 0; my $ip = 0; my $reg = 0; while ( $ip <= $#instructions ) { my ( $op, $arg ) = $instructions->[$ip]->@{'op', 'arg'}; if ( $executed[$ip] ) { $infinite = 1; last; } $executed[$ip] = 1; $ip++; given ( $op ) { when('nop') { } when('jmp') { $ip += $arg - 1 } when('acc') { $reg += $arg } } } return { reg => $reg, infinite => $infinite }; } use Data::Dump qw(dump); for my $i (0..$#instructions) { my $modified = dclone( \@instructions ); if ( $modified->[$i]{op} eq 'nop' ) { $modified->[$i]{op} = 'jmp'; } elsif ( $modified->[$i]{op} eq 'jmp' ) { $modified->[$i]{op} = 'nop'; } else { next } my $result = evaluate( $modified ); if ( ! $result->{infinite} ) { say $result->{reg}; } } __DATA__ nop +0 acc +1 jmp +4 acc +3 jmp -3 acc -99 acc +1 jmp -4 acc +6 ================================================ FILE: advent-of-code/2020/09.1.pl ================================================ use v5.32; use warnings; use Data::Dump qw(dump); open INPUT, '<', 'inputs/9'; my $preamble = 25; my $consume = $preamble; my @window; my %counts; sub is_sum_of_two { my ( $number, $counts ) = @_; for my $key ( %$counts ) { next unless $counts->{$key}; my $difference = $number - $key; return 1 if $counts->{$difference} and ($difference != $key or $counts->{$difference} >= 2); } 0 } while () { chomp; if ( $consume ) { push @window, $_; $counts{$_}++; $consume--; next; } unless (is_sum_of_two( $_, \%counts )) { say "invalid: $_"; last; } my $removed = shift @window; $counts{$removed}--; push @window, $_; $counts{$_}++; } ================================================ FILE: advent-of-code/2020/09.2.pl ================================================ use v5.32; use warnings; use List::Util qw( min max ); use Data::Dump qw(dump); open INPUT, '<', 'inputs/9'; my $preamble = 25; sub is_sum_of_two { my ( $number, $counts ) = @_; for my $key ( %$counts ) { next unless $counts->{$key}; my $difference = $number - $key; return 1 if $counts->{$difference} and ($difference != $key or $counts->{$difference} >= 2); } 0 } sub weakness { my ( $number, $numbers ) = @_; for my $i ( 0 .. $#$numbers ) { my $sum = 0; my $j; for ( $j = $i; $j <= $#$numbers; $j++ ) { $sum += $numbers->[$j]; last if $sum >= $number; } next unless $sum == $number; my @subrange = @{$numbers}[ $i .. $j ]; my $min = min @subrange; my $max = max @subrange; my $weakness = $min + $max; return $weakness; } } my $consume = $preamble; my @numbers; my @window; my %counts; while () { chomp; push @numbers, $_; if ( $consume ) { push @window, $_; $counts{$_}++; $consume--; next; } unless ( is_sum_of_two( $_, \%counts ) ) { pop @numbers; my $weakness = weakness( $_, \@numbers ); say "invalid: $_"; say "weakness: $weakness"; last; } my $removed = shift @window; $counts{$removed}--; push @window, $_; $counts{$_}++; } ================================================ FILE: advent-of-code/2020/10.1.pl ================================================ use v5.32; use warnings; use List::Util qw( max ); open INPUT, '<', 'inputs/10'; my @numbers = ( 0 ); while () { chomp; push @numbers, $_; } @numbers = sort { $a <=> $b } @numbers; push @numbers, max( @numbers ) + 3; my %diffs; for my $i ( 0 .. $#numbers - 1 ) { my $diff = $numbers[$i + 1] - $numbers[$i]; $diffs{$diff}++ } say $diffs{1} * $diffs{3} ================================================ FILE: advent-of-code/2020/10.2.pl ================================================ use v5.32; use warnings; use List::Util qw( max reduce ); open INPUT, '<', 'inputs/10'; my @numbers; while () { chomp; push @numbers, $_; } @numbers = sort { $a <=> $b } @numbers; push @numbers, max( @numbers ) + 3; my %diffs; for my $i ( 0 .. $#numbers - 1 ) { my $diff = $numbers[$i + 1] - $numbers[$i]; $diffs{$diff}++ } my @count = (1); for my $i ( @numbers ) { my $possible = reduce { ($a // 0) + ($b // 0) } @count[max($i - 3, 0) .. $i - 1]; $count[$i] = $possible; } say $count[max(@numbers)]; ================================================ FILE: advent-of-code/2020/11.1.pl ================================================ use v5.32; use warnings; open INPUT, '<', 'inputs/11'; my $plan; while ( ) { chomp; push @$plan, [ split '' ]; } sub neighbours { my ( $x, $y, $h, $w ) = @_; my @result; for my $a ( $x - 1 .. $x + 1 ) { for my $b ( $y - 1 .. $y + 1 ) { push @result, [ $a, $b ] if ( 0 <= $a and $a < $h and 0 <= $b and $b < $w and ( $a != $x or $b != $y ) ); } } @result; } sub iterate { my $plan = shift; my $height = @$plan; my $width = @{$plan->[0]}; my $result = []; for my $i ( 0 .. $height - 1 ) { for my $j ( 0 .. $width - 1 ) { my @neighbours = neighbours( $i, $j, $height, $width ); my $seat = $plan->[ $i ][ $j ]; my $taken = 0; for ( @neighbours ) { $taken++ if $plan->[ $_->[0] ][ $_->[1] ] eq '#'; } if ( $seat eq 'L' and $taken == 0 ) { $seat = '#'; } elsif ( $seat eq '#' and $taken >= 4 ) { $seat = 'L'; } $result->[ $i ][ $j ] = $seat; } } $result; } for ( 0 .. 100000 ) { my $before = join "\n", map { join '', @$_ } @$plan; $plan = iterate( $plan ); my $after = join "\n", map { join '', @$_ } @$plan; if ( $before eq $after ) { my $count = () = $after =~ /#/g; say $count; last; } } ================================================ FILE: advent-of-code/2020/11.2.pl ================================================ use v5.32; use warnings; open INPUT, '<', 'inputs/11'; my $plan; while ( ) { chomp; push @$plan, [ split '' ]; } sub neighbours { my ( $x, $y, $h, $w ) = @_; my @result; for my $a ( $x - 1 .. $x + 1 ) { for my $b ( $y - 1 .. $y + 1 ) { push @result, [ $a, $b ] if ( 0 <= $a and $a < $h and 0 <= $b and $b < $w and ( $a != $x or $b != $y ) ); } } @result; } sub iterate { my $plan = shift; my $height = @$plan; my $width = @{$plan->[0]}; my $result = []; for my $i ( 0 .. $height - 1 ) { for my $j ( 0 .. $width - 1 ) { my $seat = $plan->[ $i ][ $j ]; my $taken = visible_occupied( $plan, $i, $j ); if ( $seat eq 'L' and $taken == 0 ) { $seat = '#'; } elsif ( $seat eq '#' and $taken >= 5 ) { $seat = 'L'; } $result->[ $i ][ $j ] = $seat; } } $result; } sub first_in_direction { my ( $plan, $x, $y, $direction ) = @_; my $height = @$plan; my $width = @{$plan->[0]}; $x += $direction->[0]; $y += $direction->[1]; while ( 0 <= $x and $x < $height and 0 <= $y and $y < $width ) { my $seat = $plan->[ $x ][ $y ]; if ( $seat ne '.' ) { return $seat; } $x += $direction->[0]; $y += $direction->[1]; } return '.'; } sub visible_occupied { my ( $plan, $x, $y ) = @_; my @directions = ( [0, 1], [0, -1], [1, 0], [-1, 0], [1, 1], [-1, 1], [1, -1], [-1, -1] ); my @seen = map { first_in_direction( $plan, $x, $y, $_ ) } @directions; my $count = 0; for ( @seen ) { $count++ if $_ eq '#'; } $count; } for ( 0 .. 100000 ) { my $before = join "\n", map { join '', @$_ } @$plan; $plan = iterate( $plan ); my $after = join "\n", map { join '', @$_ } @$plan; if ( $before eq $after ) { my $count = () = $after =~ /#/g; say $count; last; } } ================================================ FILE: advent-of-code/2020/12.1.pl ================================================ use v5.32; use warnings; use experimental qw(smartmatch switch); open INPUT, '<', 'inputs/12'; my @pos = ( 0, 0 ); my @dir = ( 0, 1 ); sub rotate { my ( $deg, $a, $b ) = @_; my @dir = $deg > 0 ? ( 1, -1 ) : ( -1, 1 ); my $steps = abs($deg) / 90; for ( 1..$steps ) { ( $a, $b ) = ( $b * $dir[0], $a * $dir[1] ); } ( $a, $b ); } while () { /^([NSEWLRF])(\d+)$/; my ( $cmd, $d ) = ( $1, $2 ); my ( $x, $y, $a, $b ) = ( @pos, @dir ); given ( $cmd ) { when('F') { @pos = ( $x + $a * $d, $y + $b * $d ) } when('L') { @dir = rotate(-$d, $a, $b) } when('R') { @dir = rotate($d, $a, $b) } when('N') { @pos = ( $x - $d, $y ) } when('S') { @pos = ( $x + $d, $y ) } when('W') { @pos = ( $x, $y - $d ) } when('E') { @pos = ( $x, $y + $d ) } } } say abs($pos[0]) + abs($pos[1]); __END__ F10 N3 F7 R90 F11 ================================================ FILE: advent-of-code/2020/12.2.pl ================================================ use v5.32; use warnings; use experimental qw(smartmatch switch); open INPUT, '<', 'inputs/12'; my @pos = ( 0, 0 ); my @wp = ( -1, 10 ); sub rotate { my ( $deg, $a, $b ) = @_; my @dir = $deg > 0 ? ( 1, -1 ) : ( -1, 1 ); my $steps = abs($deg) / 90; for ( 1..$steps ) { ( $a, $b ) = ( $b * $dir[0], $a * $dir[1] ); } ( $a, $b ); } while () { chomp; /^([NSEWLRF])(\d+)$/; my ( $cmd, $d ) = ( $1, $2 ); my ( $x, $y, $a, $b ) = ( @pos, @wp ); say "$_: [$x, $y] // [$a, $b]"; given ( $cmd ) { when('F') { @pos = ( $x + $a * $d, $y + $b * $d ) } when('L') { @wp = rotate(-$d, $a, $b) } when('R') { @wp = rotate($d, $a, $b) } when('N') { @wp = ( $a - $d, $b ) } when('S') { @wp = ( $a + $d, $b ) } when('W') { @wp = ( $a, $b - $d ) } when('E') { @wp = ( $a, $b + $d ) } } } say abs($pos[0]) + abs($pos[1]); ================================================ FILE: advent-of-code/2020/13.1.pl ================================================ use v5.32; use warnings; open INPUT, '<', 'inputs/13'; my $contents = do { local $/; }; my ( $time, $schedule ) = split "\n", $contents; my @ids = grep { $_ ne 'x' } split ',', $schedule; my $min = 10_000_000_000; my $answer = 0; for my $id ( @ids ) { my $wait = ($id - $time % $id); if ( $wait < $min ) { $min = $wait; $answer = $wait * $id; } } say $answer; __END__ 939 7,13,x,x,59,x,31,19 ================================================ FILE: advent-of-code/2020/13.2.pl ================================================ use v5.32; use warnings; use Math::Utils qw( gcd ); open INPUT, '<', 'inputs/13'; my $contents = do { local $/; }; my ( $time, $schedule ) = split "\n", $contents; my @ids = split ',', $schedule; my $start = shift @ids; my $offset = 0; my $step = $start; for my $id ( @ids ) { $offset += 1; next if $id eq 'x'; $start += $step until ( $start + $offset ) % $id == 0 and $start >= $id ; $step = ($step * $id) / gcd( $step, $id ); } say $start; ================================================ FILE: advent-of-code/2020/14.1.pl ================================================ use v5.32; use warnings; use experimental "switch"; use bigint; use List::Util qw( sum ); open INPUT, '<', 'inputs/14'; sub bin { oct "0b$_[0]" } sub mask { my ( $mask, $num ) = @_; ( $num & bin( $mask =~ s/X/1/rg ) ) | bin( $mask =~ s/X/0/rg ); } my $mask; my %mem; while () { given ($_) { when(/^mask = ([X01]+)$/) { $mask = $1; } when(/^mem\[(\d+)\] = (\d+)$/) { $mem{$1} = mask( $mask, $2 ); } default { say "OH NON NON ON ON O" } } } say sum values(%mem); ================================================ FILE: advent-of-code/2020/14.2.pl ================================================ use v5.32; use warnings; use experimental "switch"; use bigint; use List::Util qw( sum ); use List::MoreUtils qw( uniq zip6 ); open INPUT, '<', 'inputs/14'; sub bin { oct "0b$_[0]" } sub mask { my ( $mask, $addr ) = @_; my @mask = split '', $mask; my @addr = split '', sprintf( "%036b", $addr ); variants( join "", map { $_->[0] == 1 ? '1' : $_->[0] eq 'X' ? 'X' : $_->[1] } zip6( @mask, @addr ) ); } sub variants { my ( $mask ) = @_; my @result; return ( $mask ) unless $mask =~ m/^([01]*)(?:(X)(.*))$/; my ( $prefix, $suffix ) = ( $1, $3 ); map { ( "${prefix}0$_", "${prefix}1$_" ) } variants( $suffix ); } my $mask; my %mem; while () { given ($_) { when(/^mask = ([X01]+)$/) { $mask = $1; } when(/^mem\[(\d+)\] = (\d+)$/) { my ( $x, $y ) = ( $1, $2 ); my @addrs = mask( $mask, $1 ); $mem{$_} = $y for ( @addrs ); } default { say "OH NON NON ON ON O" } } } say sum values(%mem); ================================================ FILE: advent-of-code/2020/15.1.pl ================================================ use v5.32; use warnings; my @numbers = ( 15, 12, 0, 14, 3, 1 ); my %spoken; my $next = shift @numbers; my $turn = 1; for my $number ( @numbers ) { $spoken{$next} = $turn++; $next = $number; } while ( $turn < 2020 ) { my $said; if ( $spoken{$next} ) { $said = $turn - $spoken{$next}; } else { $said = 0; } $spoken{$next} = $turn; $turn++; $next = $said; } say $next; ================================================ FILE: advent-of-code/2020/15.2.pl ================================================ use v5.32; use warnings; my @numbers = ( 15, 12, 0, 14, 3, 1 ); my %spoken; my $next = shift @numbers; my $turn = 1; for my $number ( @numbers ) { $spoken{$next} = $turn++; $next = $number; } while ( $turn < 30000000 ) { my $said; if ( $spoken{$next} ) { $said = $turn - $spoken{$next}; } else { $said = 0; } $spoken{$next} = $turn; $turn++; $next = $said; } say $next; ================================================ FILE: advent-of-code/2020/16.1.pl ================================================ use v5.32; use warnings; use List::Util qw( none ); open INPUT, '<', 'inputs/16'; my $contents = do { local $/; }; my @parts = split "\n\n", $contents; my %rules; my @ticket; my @nearby; for ( split "\n", $parts[0] ) { /^([^:]+): (\d+)-(\d+) or (\d+)-(\d+)$/ or die $_; my ( $name, $a, $b, $c, $d ) = ( $1, $2, $3, $4, $5 ); $rules{$name} = sub { my $x = $_[0]; $a <= $x and $x <= $b or $c <= $x and $x <= $d }; } @ticket = ( split ",", ( split("\n", $parts[1]) )[1] ); $parts[2] =~ s/^nearby tickets:\n//sg; for ( split "\n", $parts[2] ) { push @nearby, [ split "," ]; } my $sum; for my $ticket ( @nearby ) { for my $number ( @$ticket ) { $sum += $number if none { $_->($number) } (values %rules); } } say $sum; ================================================ FILE: advent-of-code/2020/16.2.pl ================================================ use v5.32; use warnings; use List::Util qw( none ); use Set::Scalar; open INPUT, '<', 'inputs/16'; my $contents = do { local $/; }; my @parts = split "\n\n", $contents; my %rules; my @ticket; my @nearby; for ( split "\n", $parts[0] ) { /^([^:]+): (\d+)-(\d+) or (\d+)-(\d+)$/ or die $_; my ( $name, $a, $b, $c, $d ) = ( $1, $2, $3, $4, $5 ); $rules{$name} = sub { my $x = $_[0]; $a <= $x and $x <= $b or $c <= $x and $x <= $d }; } @ticket = ( split ",", ( split("\n", $parts[1]) )[1] ); $parts[2] =~ s/^nearby tickets:\n//sg; for ( split "\n", $parts[2] ) { push @nearby, [ split "," ]; } sub is_valid { my $ticket = shift; for my $number ( @$ticket ) { return 0 if none { $_->($number) } (values %rules); } 1; } my @valid = grep { is_valid($_) } @nearby; my @possible = map { Set::Scalar->new( keys(%rules) ) } ( 1 .. %rules ); for my $ticket ( @valid ) { my @numbers = @$ticket; for my $i ( 0 .. $#numbers ) { while ( my ( $name, $fn ) = each %rules ) { if ( ! $fn->( $numbers[$i] ) ) { $possible[$i]->delete( $name ); } } } } for ( 0 .. $#possible ) { my $remove = Set::Scalar->new( map { $_->elements } grep { $_->size == 1 } @possible ); for my $set ( @possible ) { $set -= $remove if ( $set->size > 1 ); } } my %positions; for ( 0 .. $#possible ) { my $set = $possible[$_]; die "collision" if $set->size != 1; $positions{ ($set->members)[0] } = $_; } my $result = 1; while ( my ( $name, $pos ) = each %positions ) { next unless $name =~ /^departure /; $result *= $ticket[$pos]; } say $result; ================================================ FILE: advent-of-code/2020/17.1.pl ================================================ use v5.32; use warnings; use Hash::MultiKey; use List::Util qw( sum uniq ); my %game; tie %game, 'Hash::MultiKey'; my $x = 0; open INPUT, '<', 'inputs/17'; while () { my @chars = split ''; for my $y ( 0 .. $#chars ) { if ( $chars[$y] eq '#' ) { $game{ [ $x, $y, 0] } = 1; } } $x++; } sub neighbours { my ( $x, $y, $z ) = $_[0]->@*; my @result; for my $dx ( -1 .. 1 ) { for my $dy ( -1 .. 1 ) { for my $dz ( -1 .. 1 ) { next unless $dx || $dy || $dz; push @result, [ $x + $dx, $y + $dy, $z + $dz ]; } } } @result; } for ( 1 .. 6 ) { my %next; tie %next, 'Hash::MultiKey'; my @space; while ( my ( $cube, $alive ) = each %game ) { next unless $alive; for my $neighbour ( neighbours( $cube ) ) { push @space, join(',', @$neighbour); } } @space = map { [ split ',' ] } uniq @space; for my $cube ( @space ) { my $count = sum( grep { defined $_ } @game{ neighbours( $cube ) } ); my $alive = $game{ $cube } // 0; $next{ $cube } = 1 if $count == 3 || ( $alive && $count == 2 ) ; } %game = %next; } say sum values( %game ); ================================================ FILE: advent-of-code/2020/17.2.pl ================================================ use v5.32; use warnings; use Hash::MultiKey; use List::Util qw( sum uniq ); my %game; tie %game, 'Hash::MultiKey'; my $x = 0; open INPUT, '<', 'inputs/17'; while () { my @chars = split ''; for my $y ( 0 .. $#chars ) { if ( $chars[$y] eq '#' ) { $game{ [ $x, $y, 0, 0 ] } = 1; } } $x++; } sub neighbours { my ( $x, $y, $z, $w ) = $_[0]->@*; my @result; for my $dx ( -1 .. 1 ) { for my $dy ( -1 .. 1 ) { for my $dz ( -1 .. 1 ) { for my $dw ( -1 .. 1 ) { next unless $dx || $dy || $dz || $dw; push @result, [ $x + $dx, $y + $dy, $z + $dz, $w + $dw ]; } } } } @result; } for ( 1 .. 6 ) { my %next; tie %next, 'Hash::MultiKey'; my @space; while ( my ( $cube, $alive ) = each %game ) { next unless $alive; for my $neighbour ( neighbours( $cube ) ) { push @space, join(',', @$neighbour); } } @space = map { [ split ',' ] } uniq @space; for my $cube ( @space ) { my $count = sum( grep { defined $_ } @game{ neighbours( $cube ) } ) // 0; my $alive = $game{ $cube } // 0; $next{ $cube } = 1 if $count == 3 || ( $alive && $count == 2 ) ; } %game = %next; } say sum values( %game ); ================================================ FILE: advent-of-code/2020/18.1.pl ================================================ use v5.32; use warnings; use experimental 'switch'; open INPUT, '<', 'inputs/18'; sub evaluate { my $tokens = shift; my $op = sub { $_[1] }; my $result = 0; while (my $next = shift( @$tokens )) { given ( $next ) { when( /(\d)/ ) { $result = $op->( $result, $1 ) } when( '+' ) { $op = sub { $_[0] + $_[1] } } when( '*' ) { $op = sub { $_[0] * $_[1] } } when( '(' ) { $result = $op->( $result, evaluate( $tokens ) ) } when( ')' ) { return $result } default { die "unexpected token: $next"; } } } $result; } sub parse { $_ = shift; s/ //g; chomp; my @tokens = split ''; evaluate( \@tokens ); } my $result = 0; while () { $result += parse( $_ ); } say $result; __DATA__ 1 + (2 * 3) + (4 * (5 + 6)) 2 * 3 + (4 * 5) 5 + (8 * 3 + 9 + 3 * 4 * 3) 5 * 9 * (7 * 3 * 3 + 9 * 3 + (8 + 6 * 4)) ((2 + 4 * 9) * (6 + 9 * 8 + 6) + 6) + 2 + 4 * 2 ================================================ FILE: advent-of-code/2020/18.2.pl ================================================ use v5.32; use warnings; my $parse = qr{ (?&MULT) (?{ $_ = $^R->[1] }) (?(DEFINE) (? ( \d ) (?{ [$^R, eval $^N] }) ) (? ( (?&NUMBER) | \( (?&MULT) \) ) ) (? (?&ADD) (?{ [ $^R->[0], $^R->[1] ] }) (?: \* (?&ADD) (?{ [ $^R->[0][0], $^R->[0][1] * $^R->[1] ] }) )* ) (? (?&ATOM) (?{ [ $^R->[0], $^R->[1] ] }) (?: \+ (?&ATOM) (?{ [ $^R->[0][0], $^R->[0][1] + $^R->[1] ] }) )* ) ) }xms; sub parse { local $_ = shift; local $^R; s/ //g; eval { m{\A$parse\z} } and return $_; die $@; } open INPUT, '<', 'inputs/18'; my $result; $result += parse($_) while (); say $result; ================================================ FILE: advent-of-code/2020/19.1.pl ================================================ use v5.32; use warnings; use experimental 'switch'; open INPUT, '<', 'inputs/19'; my $contents = do { local $/; }; my @parts = split "\n\n", $contents; my %definitions; for ( split "\n", $parts[0] ) { m/^(\d+): (.*)$/; $definitions{ $1 } = $2; } my %compiled; sub compile { my $n = shift; return $compiled{ $n } if exists $compiled{ $n }; my $compiled; given ( $definitions{ $n } ) { when(/^ " (\w) " $/x) { $compiled = $1 } when(/^ (\d+) ( \s+ ( \d+ | \| ) )* $/x) { $compiled = '(' . ( join '|', map { s/(\d+)\s*/compile( $1 )/eg; $_ } split /\s*\|\s*/ ) . ')'; } default { die "can't compile: $_", } } $compiled{ $n } = $compiled; } my $pattern = compile( 0 ); my $regex = qr/^$pattern$/; my $count = 0; for ( split "\n", $parts[1] ) { $count++ if $_ =~ $regex; } say $count; ================================================ FILE: advent-of-code/2020/19.2.pl ================================================ use v5.32; use warnings; open STDIN, '<', 'inputs/19'; $/ x= 2; $_ = <>; s/^8: .*$/8: 42 | 42 8/m; s/^11: .*$/11: 42 31 | 42 11 31/m; s/^(\d+): (.*)$/"(? (" . ( $2 =~ s#(\d+)#(?&g$1)#gr ) . ") )"/gem; s/\("(\w)"\)/$1/g; my $pattern = qr/^(?&g0) (?(DEFINE) $_)$/x; say scalar grep { m/$pattern/ } split "\n", <>; ================================================ FILE: advent-of-code/2020/20.1.pl ================================================ use v5.32; use warnings; use List::Util qw( first min max reduce ); open STDIN, '<', 'inputs/20'; my @tiles; sub bin { $_ = shift; s/\./0/g; s/#/1/g; oct "0b$_"; } sub rotate { my ( $t, $r, $b, $l ) = @_; return ( scalar reverse( $l ), $t, scalar reverse( $r ), $b ); } sub hpose { my ( $t, $r, $b, $l ) = @_; return ( $b, scalar reverse( $r ), $t, scalar reverse( $l ) ); } $/ x= 2; while (<>) { m/Tile (\d+):/ or die $_; my $id = $1; my ( $first , @lines ) = split "\n"; my ( $top, $bottom ) = ( $lines[0], $lines[-1] ); my $left = join '', map { substr $_, 0, 1 } @lines; my $right = join '', map { substr $_, -1, 1 } @lines; my @row = ( $top, $right, $bottom, $left ); my @variants; push @variants, [ @row ], [ hpose( @row ) ]; @row = rotate( @row ); push @variants, [ @row ], [ hpose( @row ) ]; @row = rotate( @row ); push @variants, [ @row ], [ hpose( @row ) ]; @row = rotate( @row ); push @variants, [ @row ], [ hpose( @row ) ]; push @tiles, { id => $id, lines => [ @lines ], left => $left, right => $right, top => $top, bottom => $bottom, variants => [ map { [ map { bin( $_ ) } @$_ ] } @variants ] }; } $tiles[0]{pos} = [0, 0]; $tiles[0]{rotation} = $tiles[0]{variants}[0]; my @unchecked = ( $tiles[0] ); while ( @unchecked ) { my $tile = shift @unchecked; my ( $top, $right, $bottom, $left ) = $tile->{rotation}->@*; my ( $x, $y ) = $tile->{pos}->@*; for my $other ( @tiles ) { next if exists $other->{pos}; for my $variant ( $other->{variants}->@* ) { if ( $top == $variant->[2] ) { $other->{pos} = [ $x - 1, $y ]; $other->{rotation} = $variant; push @unchecked, $other; } elsif ( $right == $variant->[3] ) { $other->{pos} = [ $x, $y + 1 ]; $other->{rotation} = $variant; push @unchecked, $other; } elsif ( $bottom == $variant->[0] ) { $other->{pos} = [ $x + 1, $y ]; $other->{rotation} = $variant; push @unchecked, $other; } elsif ( $left == $variant->[1] ) { $other->{pos} = [ $x, $y - 1 ]; $other->{rotation} = $variant; push @unchecked, $other; } } } } my $top = min map { $_->{pos}[0] } @tiles; my $bottom = max map { $_->{pos}[0] } @tiles; my $left = min map { $_->{pos}[1] } @tiles; my $right = max map { $_->{pos}[1] } @tiles; my @corners = ( (first { $_->{pos}[0] == $top && $_->{pos}[1] == $left } @tiles)->{id}, (first { $_->{pos}[0] == $top && $_->{pos}[1] == $right } @tiles)->{id}, (first { $_->{pos}[0] == $bottom && $_->{pos}[1] == $left } @tiles)->{id}, (first { $_->{pos}[0] == $bottom && $_->{pos}[1] == $right } @tiles)->{id}, ); say reduce { $a * $b } @corners; ================================================ FILE: advent-of-code/2020/20.2.pl ================================================ use v5.32; use warnings; use List::Util qw( first min max reduce ); use List::MoreUtils qw( all ); use Hash::MultiKey; use experimental 'switch'; open STDIN, '>&', DATA; open STDIN, '<', 'inputs/20'; my @tiles; sub bin { $_ = shift; s/\./0/g; s/#/1/g; oct "0b$_"; } sub rotate { my ( $t, $r, $b, $l ) = @_; return ( scalar reverse( $l ), $t, scalar reverse( $r ), $b ); } sub hpose { my ( $t, $r, $b, $l ) = @_; return ( $b, scalar reverse( $r ), $t, scalar reverse( $l ) ); } $/ x= 2; while (<>) { m/Tile (\d+):/ or die $_; my $id = $1; my ( $first , @lines ) = split "\n"; my ( $top, $bottom ) = ( $lines[0], $lines[-1] ); my $left = join '', map { substr $_, 0, 1 } @lines; my $right = join '', map { substr $_, -1, 1 } @lines; my @row = ( $top, $right, $bottom, $left ); my @images; push @images, [ @row ], [ hpose( @row ) ]; @row = rotate( @row ); push @images, [ @row ], [ hpose( @row ) ]; @row = rotate( @row ); push @images, [ @row ], [ hpose( @row ) ]; @row = rotate( @row ); push @images, [ @row ], [ hpose( @row ) ]; push @tiles, { id => $id, image => [ map { [split ''] } @lines ], left => $left, right => $right, top => $top, bottom => $bottom, variants => [ map { [ map { bin( $_ ) } @$_ ] } @images ] }; } $tiles[0]{pos} = [0, 0]; $tiles[0]{rotation} = $tiles[0]{variants}[0]; $tiles[0]{orientation} = 0; my @unchecked = ( $tiles[0] ); sub orient { my ( $image, $index ) = @_; my $s = $#{$image->[0]}; my $pick; given ($index) { when(0) { $pick = sub { my ( $a, $b ) = @_; $image->[$a][$b] } } when(1) { $pick = sub { my ( $a, $b ) = @_; $image->[$s - $a][$b] } } when(2) { $pick = sub { my ( $a, $b ) = @_; $image->[$s - $b][$a] } } when(3) { $pick = sub { my ( $a, $b ) = @_; $image->[$s - $b][$s - $a] } } when(4) { $pick = sub { my ( $a, $b ) = @_; $image->[$s - $a][$s - $b] } } when(5) { $pick = sub { my ( $a, $b ) = @_; $image->[$a][$s - $b] } } when(6) { $pick = sub { my ( $a, $b ) = @_; $image->[$b][$s - $a] } } when(7) { $pick = sub { my ( $a, $b ) = @_; $image->[$b][$a] } } } my @result; for my $x ( 0 .. $s ) { my @line; for my $y ( 0 .. $s ) { push @line, $pick->( $x, $y ); } push @result, [ @line ]; } \@result; } while ( @unchecked ) { my $tile = shift @unchecked; my ( $top, $right, $bottom, $left ) = $tile->{rotation}->@*; my ( $x, $y ) = $tile->{pos}->@*; for my $other ( @tiles ) { next if exists $other->{pos}; for my $i ( 0..$#{$other->{variants}} ) { my $variant = $other->{variants}[$i]; use Data::Dump qw(dump); if ( $top == $variant->[2] ) { $other->{pos} = [ $x - 1, $y ]; $other->{rotation} = $variant; $other->{orientation} = $i; push @unchecked, $other; } elsif ( $right == $variant->[3] ) { $other->{pos} = [ $x, $y + 1 ]; $other->{rotation} = $variant; $other->{orientation} = $i; push @unchecked, $other; } elsif ( $bottom == $variant->[0] ) { $other->{pos} = [ $x + 1, $y ]; $other->{rotation} = $variant; $other->{orientation} = $i; push @unchecked, $other; } elsif ( $left == $variant->[1] ) { $other->{pos} = [ $x, $y - 1 ]; $other->{rotation} = $variant; $other->{orientation} = $i; push @unchecked, $other; } } } } my $top = min map { $_->{pos}[0] } @tiles; my $bottom = max map { $_->{pos}[0] } @tiles; my $left = min map { $_->{pos}[1] } @tiles; my $right = max map { $_->{pos}[1] } @tiles; my %positions; tie %positions, 'Hash::MultiKey'; for my $tile ( @tiles ) { $positions{ $tile->{pos} } = $tile; } my @complete; for my $x ( $top .. $bottom ) { my @images; for my $y ( $left .. $right ) { my $tile = $positions{ [$x, $y] }; my $image = orient( $tile->{image}, $tile->{orientation} ); push @images, $image; } for my $i ( 1 .. 8 ) { my @line; for my $image ( @images ) { push @line, @{$image->[$i]}[1..8]; } push @complete, [ @line ]; } } my $pattern = <[0] } @dots; my $w = max map { $_->[1] } @dots; my $image = orient( \@complete, $orientation ); my $found = 0; for my $x ( 0 .. $size - $h ) { for my $y ( 0 .. $size - $w ) { if ( all { $image->[$x + $_->[0]][$y + $_->[1]] eq '#' } @dots ) { $found = 1; for ( @dots ) { $image->[$x + $_->[0]][$y + $_->[1]] = '.'; } } } } if ( $found ) { say scalar grep { $_ eq '#' } map { @$_ } @$image; last; } } ================================================ FILE: advent-of-code/2020/21.1.pl ================================================ use v5.32; use warnings; use Set::Scalar; use List::Util qw( uniq ); use Array::Utils qw( array_diff ); open STDIN, '<', 'inputs/21'; my %possible; my @foods; while (<>) { m/^(.*) \(contains (.*)\)$/; my @ingredients = split ' ', $1; my @allergens = split ', ', $2; my $set = Set::Scalar->new( @ingredients ); push @foods, { ingredients => [ @ingredients ], allergens => [ @allergens ] }; for ( @allergens ) { $possible{ $_ } ||= $set; $possible{ $_ } = $possible{ $_ }->intersection( $set ); } } for ( 0 .. scalar keys %possible ) { my @sets = values %possible; my $remove = Set::Scalar->new( map { $_->elements } grep { $_->size == 1 } @sets ); for ( keys %possible ) { $possible{ $_ } -= $remove if ( $possible{ $_ }->size > 1 ); } } my @all = uniq map { $_->{ingredients}->@* } @foods; my @allergens = uniq map { $_->elements } values %possible; my $safe = Set::Scalar->new( array_diff @all, @allergens ); my $count = 0; for ( @foods ) { for ( $_->{ingredients}->@* ) { $count++ if ( $safe->has( $_ ) ); } } say $count; ================================================ FILE: advent-of-code/2020/21.2.pl ================================================ use v5.32; use warnings; use Set::Scalar; use List::Util qw( uniq ); use Array::Utils qw( array_diff ); open STDIN, '<', 'inputs/21'; my %possible; my @foods; while (<>) { m/^(.*) \(contains (.*)\)$/; my @ingredients = split ' ', $1; my @allergens = split ', ', $2; my $set = Set::Scalar->new( @ingredients ); push @foods, { ingredients => [ @ingredients ], allergens => [ @allergens ] }; for ( @allergens ) { $possible{ $_ } ||= $set; $possible{ $_ } = $possible{ $_ }->intersection( $set ); } } for ( 0 .. scalar keys %possible ) { my @sets = values %possible; my $remove = Set::Scalar->new( map { $_->elements } grep { $_->size == 1 } @sets ); for ( keys %possible ) { $possible{ $_ } -= $remove if ( $possible{ $_ }->size > 1 ); } } my %allergens; for ( keys %possible ) { my $name = ( $possible{ $_ }->elements )[0]; $allergens{ $name } = $_; } my @all = uniq map { $_->{ingredients}->@* } @foods; my @allergens = uniq map { $_->elements } values %possible; my $safe = Set::Scalar->new( array_diff @all, @allergens ); my $count = 0; for ( @foods ) { for ( $_->{ingredients}->@* ) { $count++ if ( $safe->has( $_ ) ); } } say join ',', sort { $allergens{ $a } cmp $allergens{ $b } } @allergens; ================================================ FILE: advent-of-code/2020/22.1.pl ================================================ use v5.32; use warnings; use List::MoreUtils qw( zip ); open STDIN, '<', 'inputs/22'; $_ = do { local $/; <> }; m/^Player 1:\n(.*)\n\nPlayer 2:\n(.*)\n$/sm; my @a = split "\n", $1; my @b = split "\n", $2; while ( @a and @b ) { my ( $a, $b ) = ( shift @a, shift @b ); if ( $a > $b ) { push @a, $a, $b; } else { push @b, $b, $a; } } my $i = @a + @b; my $sum = 0; $sum += $_ * $i-- for ( @a, @b ); say $sum; ================================================ FILE: advent-of-code/2020/22.2.pl ================================================ use v5.32; use warnings; use List::MoreUtils qw( zip ); open STDIN, '<', 'inputs/22'; $_ = do { local $/; <> }; m/^Player 1:\n(.*)\n\nPlayer 2:\n(.*)\n$/sm; my @a = split "\n", $1; my @b = split "\n", $2; sub round { my @a = $_[0]->@*; my @b = $_[1]->@*; my %seen; while ( @a and @b ) { my $signature = join( ' ', @a ) . ' | ' . join( ' ', @b ); return { winner => 1, a => \@a, b => \@b } if $seen{ $signature }; $seen{ $signature } = 1; my ( $a, $b ) = ( shift @a, shift @b ); my $a_wins; if ( $a <= @a and $b <= @b ) { my $result = round( [ @a[ 0 .. $a - 1] ], [ @b[ 0 .. $b - 1 ] ] ); $a_wins = ($result->{winner} == 1); } elsif ( $a > $b ) { $a_wins = 1; } else { $a_wins = 0; } if ( $a_wins ) { push @a, $a, $b; } else { push @b, $b, $a; } } return { winner => ( @a ) ? 1 : 2, a => [ @a ], b => [ @b ], } } my $result = round( [ @a ], [ @b ] ); my $i = $result->{a}->@* + $result->{b}->@*; my $sum = 0; $sum += $_ * $i-- for ( $result->{a}->@*,$result->{b}->@* ); say $sum; ================================================ FILE: advent-of-code/2020/23.1.pl ================================================ use v5.32; use warnings; use List::Util qw( any ); use constant INPUT => '784235916'; package Ring { use List::MoreUtils qw( firstidx ); sub new { my ( $package, $pointer, @elements ) = @_; bless { pointer => $pointer, elements => [ @elements ] }, $package; } sub show { my $self = shift; use Data::Dump qw(dump); warn dump $self->{elements}; } sub pick_three { my $self = shift; my $ring = $self->normalize; my @three = splice $ring->{elements}->@*, 1, 3; ( $ring, @three ); } sub normalize { my $self = shift; my @elements = $self->{elements}->@*; my @prefix = splice @elements, 0, $self->{pointer}; Ring->new( 0, @elements, @prefix ); } sub current { my $self = shift; $self->{elements}[ $self->{pointer} ]; } sub insert_after { my ( $self, $destination, @items ) = @_; my @elements = ( $self->{elements}->@* ); my $i = firstidx { $_ == $destination } @{$self->{elements}}; splice @elements, $i + 1, 0, @items; Ring->new( $self->{pointer}, @elements ); } sub select_next { my $self = shift; my ( $pointer, @elements ) = ( $self->{pointer}, $self->{elements}->@* ); $pointer = $pointer + 1 % scalar( @elements ); Ring->new( $pointer, @elements ); } sub cannonical { my $self = shift; my $i = firstidx { $_ == 1 } $self->{elements}->@*; my $ring = Ring->new( $i, $self->{elements}->@* )->normalize; join '', $ring->{elements}->@[1..8]; } } sub destination { my @numbers = @_; my $n = $numbers[0]; while ( any { $_ == $n } @numbers ) { $n--; $n = 9 if $n == 0; } $n; } my $ring = Ring->new( 0, split( '', INPUT ) ); for ( 1 .. 100 ) { say "-- move $_ --"; say "cups: " . join( ' ', $ring->{elements}->@* ); ( $ring, my @pick ) = $ring->pick_three; say "pick up: " . join( ' ', @pick ); my $destination = destination $ring->current, @pick; say "destination: " . $destination; $ring = $ring->insert_after( $destination, @pick ); $ring = $ring->select_next; say ""; } say $ring->cannonical; ================================================ FILE: advent-of-code/2020/23.2.pl ================================================ use v5.32; use warnings; use List::Util qw( any ); use constant INPUT => '784235918'; use constant LIMIT => 1_000_000; use constant MOVES => 10_000_000; my ( $n, @numbers ) = split '', INPUT; my @index; my $first = { number => $n, next => undef }; @index[ $n ] = $first; my $current = $first; for ( @numbers ) { my $next = { number => $_, next => undef }; @index[$_] = $next; $current->{next} = $next; $current = $next; } for ( my $i = 10; $i <= LIMIT; $i++ ) { my $next = { number => $i, next => undef }; push @index, $next; $current->{next} = $next; $current = $next; } $current->{next} = $first; $current = $first; sub take { my $n = shift; my $first = $current->{next}; my $last = $first; my @result; while ( $n-- ) { push @result, $last; $last = $last->{next}; } $current->{next} = $last; $result[-1]->{next} = undef; @result; } sub destination { my @numbers = @_; my $n = $numbers[0]; while ( any { $_ == $n } @numbers ) { $n--; $n = LIMIT if $n == 0; } $n; } sub insert { my ( $destination, @elements ) = @_; my $after = $destination->{next}; $destination->{next} = $elements[0]; $elements[-1]->{next} = $after; } for ( my $c = 1; $c <= MOVES; $c++ ) { my @pick = take 3; my $destination = destination $current->{number}, map { $_->{number} } @pick; insert $index[ $destination ], @pick; $current = $current->{next}; } say $index[1]->{next}{number} * $index[1]->{next}{next}{number}; ================================================ FILE: advent-of-code/2020/24.1.pl ================================================ use v5.32; use warnings; use experimental 'switch'; use Hash::MultiKey; open STDIN, '<', 'inputs/24'; sub coordinates { my ( $x, $y ) = 0, 0; while ( $_[0] =~ /([ns])?([we])/g ) { given ( ($1 // '') . $2 ) { when('e') { $y += 1 } when('w') { $y -= 1 } when('ne') { $x -= 1; $y += ( $x + 1 ) % 2 } when('nw') { $x -= 1; $y -= $x % 2 } when('se') { $x += 1; $y += ( $x + 1 ) % 2 } when('sw') { $x += 1; $y -= $x % 2 } default { die "unknown $_" } } } ( $x, $y ) } my %grid; tie %grid, 'Hash::MultiKey'; while (<>) { chomp; my $c = [ coordinates( $_ ) ]; $grid{ $c } = ! ( $grid{ $c } // 0 ); } say scalar grep { $_ } values( %grid ); ================================================ FILE: advent-of-code/2020/24.2.pl ================================================ use v5.32; use warnings; use experimental 'switch'; use List::Util qw( uniq ); use Hash::MultiKey; open STDIN, '<', 'inputs/24'; sub coordinates { my ( $x, $y ) = 0, 0; while ( $_[0] =~ /([ns])?([we])/g ) { given ( ($1 // '') . $2 ) { when('e') { $y += 1 } when('w') { $y -= 1 } when('ne') { $x -= 1; $y += ( $x + 1 ) % 2 } when('nw') { $x -= 1; $y -= $x % 2 } when('se') { $x += 1; $y += ( $x + 1 ) % 2 } when('sw') { $x += 1; $y -= $x % 2 } default { die "unknown $_" } } } ( $x, $y ) } sub neighbours { my ( $x, $y ) = $_[0]->@*; my $offset = $x % 2 || -1; ( [ $x - 1, $y ], [ $x - 1, $y + $offset ], [ $x, $y - 1 ], [ $x, $y + 1 ], [ $x + 1, $y ], [ $x + 1, $y + $offset ], ) } my %grid; tie %grid, 'Hash::MultiKey'; while (<>) { chomp; my $c = [ coordinates( $_ ) ]; $grid{ $c } = ! ( $grid{ $c } // 0 ); } for ( 1 .. 100 ) { my %new; tie %new, 'Hash::MultiKey'; my @check = map { [ split ',' ] } uniq map { join ',', @$_ } map { ( $_, neighbours( $_ ) ) } grep { $grid{ $_ } } keys %grid; for ( @check ) { my $black = $grid{ $_ }; my $count = scalar grep { $grid{ $_ } } neighbours $_; $new{ $_ } = 1 if $count == 2 or $black and $count == 1; } %grid = %new; } say scalar grep { $_ } values( %grid ); ================================================ FILE: advent-of-code/2020/25.1.pl ================================================ use v5.32; use warnings; use constant MOD => 20201227; sub transform { my ( $loop, $subject ) = @_; my $result = 1; for ( 1 .. $loop ) { $result *= $subject; $result %= MOD; } $result; } sub find_loop_size { my ( $key, $subject ) = @_; my $n = 1; my $i = 0; while (1) { $i++; $n *= $subject; $n %= MOD; return $i if $n == $key; } return undef; } sub hack { transform( find_loop_size( $_[0], 7 ), $_[1] ) ; } #say hack 5764801, 17807724; say hack 2069194, 16426071; ================================================ FILE: advent-of-code/2020/25.2.pl ================================================ ================================================ FILE: advent-of-code/2020/inputs/1.1 ================================================ 1028 1987 1938 1136 1503 1456 1107 1535 1946 1986 855 1587 1632 1548 1384 1894 1092 1876 1914 1974 1662 1608 2004 1464 1557 1485 1267 1582 1307 1903 1102 1578 1421 1184 1290 1786 1295 1930 1131 1802 1685 1735 1498 1052 1688 990 1805 1768 1922 1781 1897 1545 1591 1393 1186 149 1619 1813 1708 1119 1214 1705 1942 1684 1460 1123 1439 1672 1980 1337 1731 1203 1481 2009 1110 1116 1443 1957 1891 1595 1951 1883 1733 1697 1321 1689 1103 1300 1262 1190 1667 1843 1544 1877 1718 1866 1929 1169 1693 1518 1375 1477 1222 1791 1612 1373 1253 1087 1959 1970 1112 1778 1412 1127 1767 1091 1653 1609 1810 1912 1917 935 1499 1878 1452 1935 1937 968 1905 1077 1701 1789 1506 1451 1125 1686 1117 1991 1215 1776 1976 846 1923 1945 1888 1193 1146 1583 1315 1372 1963 1491 1777 1799 1363 1579 1367 1863 1983 1679 1944 1654 1953 1297 530 1502 1738 1934 1185 1998 1764 1856 1207 1181 1494 1676 1900 1057 339 1994 2006 1536 2007 644 1173 1692 1493 1756 1916 1890 1908 1887 1241 1447 1997 1967 1098 1287 1392 1932 ================================================ FILE: advent-of-code/2020/inputs/10 ================================================ 84 60 10 23 126 2 128 63 59 69 127 73 140 55 154 133 36 139 4 70 110 97 153 105 41 106 79 145 35 134 146 148 13 77 49 107 46 138 88 152 83 120 52 114 159 158 53 76 16 28 89 25 42 66 119 3 17 67 94 99 7 56 85 122 18 20 43 160 54 113 29 130 19 135 30 80 116 91 161 115 141 102 37 157 129 34 147 142 151 68 78 24 90 121 123 33 98 1 40 ================================================ FILE: advent-of-code/2020/inputs/11 ================================================ LLLLLLL.LLLLLLLLLLLL.LL.L.LLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLLLLLLLL LLLLLLL.LLLLLLLLLLLL.LLL..LLLLLLLLLLLLLLLLLLLLLLL..LLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLLLLLLL.LLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLLLLLLLLLLLLLLLL LLLLLLLLLLLLLL.LLLLL.LLLLLLLLLLLLLLLLLL.LLLL.LLLLLLLLLLL.LLLLLLLLLLLLLLLL.LLLLL.LLLLLLLL.LLLL LLLLLLL.LLLLLL.LLLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLL.L.LLLLLLLL.L.LLLLLL.LLLLLL.LL.LLLLL.LLLLLLLLLLLLLLLLL.LLLL.LLLLL.LLLLLLLLLLLLL .L.....L...L.....LL..L...LLL.L.LL..LLL..LL.LLL...LLLL..L......L..........L...L..LL..LLL.L...L LLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLL.LLLLLLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLL.LLLLL.L.LLLLLLLLLLL.LLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLLLLL.LL.LLLLLLLLLLLLL LLLL.LL.LLLLLL.LLLL.LLLLL.LLLLL.LLLLLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LL.LLLLL.LLLLLLLLL.LLLL. LLLLLLL.LLLLLL.LLLLL..LLL.LLLLLL.L.LLLLLLLLL.LLLL..LLLLLLL.L.L.LLLLL.LLLLLLLLLL.LLLLLLLLLLLLL LLL.LLL.LLLLLLLLLL.L.LLLL..LLLLLLLLLL.LL.LL.LLLLLL.LLLLL.LLLLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLL.L.LLLLL.LLLLLLL.LL.LLLLLLLLLLL.LLLLL.LLLLLLLLLLLL. LLLLLLL.LLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLL L...L..LLL.....L.LL..L.LLLL....LLLL.....L.L.LLL..L.L...LL.LL....L..LLLL..L..L.LL...L.L.....L. LLLLLLL.LLLLLLLLLLLLLLLLL.LLLLLLLL.LLLLLLLLL.LLL.L.LLLLLLLLLLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLL.LLLLL.LLLL.LLLLLLLL.LLLLLLLLL.LLLLLLLLLLLLLLLLLLL.LLL.LLLLLLL.LLLLLLLLLL.LLLLL LLLLLLL.LLLLLLLLLLLL.LLLL.LLLL.LLL.LLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL.L.LL.LLLLL.LLLLLLLLLLLLL LLLLLLL..LLLLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLLLLLLL.LLLLL.LLLLLLLLLLLLL .........LL..LL..LL..LL.....L..L..LL.............L...L....LLLL...LL...LLL..L...LLL.....L....L LLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLL.LLLLL..LLLLLL.L.LLL LLLLLLLLLLLLLL.LLLLLLLLLL.LLLLLLLL.LLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL LLLLLLL.LL.LLL.LLLLL.LLLL.LLLLLLLL.LLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLL.LLLLLLLLL.LLL.LLLLLLLLLL LLLLLLL.LLLLLLLLLLL.LLLLLLLLLLLLLL.LLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLL.LL.LL..LLLLLLLLLLLL LLLLLLL.LLLLLLLLLLLL.LLLL.LLLLLLLLLL.LLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLLLLLL.L.LLLLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLL ...L.L..L.L.L....L....L.LLL.L.L.L..L..L...L....L......L.......L..L.L.L..L..LL...L....L....LL. LLLLLLL.LLLLLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.L.LL.LL.LL.LLLLLLLLLLLLL LLLLLLL.LLLLLL.LLLLL.LLLL.LLLLLLLL.LLLLLLL.L.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLL..LLL..LLLL.LLLL.LL.LLLLL LLLLLLLLLLLLLLLLLLLL.LLLLLLL.LLLLL.LLLLLLLLL.LLLLL.L.LLLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLLLLLLL.LLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLLLLLLLLLL..LLLL LLLLLLL.LLLLLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LL.LLLLLLLLLL.LLLLLLLLL.LLLLLLLLLL.LLLLLLL.LLLLL ..LLLLL...LL...L..L.....L.LL.L....L.L..LL.L......L.L.L..L...L.L..L..L..L.LL..L.L.L..L.....L.. LLLLLLL.LLLLLL.LLL.L.LLLL.LLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLL.LL.LLLLL.LLLL.LLLLLLLL.LLLLLL.LL.LLLL..LLLLLL.LLLLLLLLLL.LLLL..LLLL.LLLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLLLLLLLL.LLLLLLL.LLLLL .LLLLLL.LLLLLL.LLLLL.LLLLLLLLL.LLL.LLLLLLL.L.LLLLLLLLLLLLLLLL.LLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLL.LLLLLLLLLL.LLLLLLLL.LLLLLLLLL.LLLL.LLLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLLLLLLLL LLLLLLL.LLL.LL.LLLLLLLLLL.LLLLLLLL.LLLLLLLLL.LLLLL.LLLL.LL.LL.LLLLLLLLLLLLLL.LL.LLLL.LL.LLLL. LLLLLLL.LLLLLL.LLLLLLLLLL.L..LLLLLLLLLLLLLLL.LLLLLLLLLLLL.LLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLL LL......LLL...L.LL...LL..LLLL.L..L.........L..L.....L..L......L..L...LLL.....LL.......LL..... LLLLLLL.LLLLLL.LLLLL.L.LL.LLLLLLLL.LLLL.LLLLL.L.LLLLLLLLLL.LLLLLLLLL.LLLLLLLLL..LLLLLLLLLLLLL LLLLLLL.L.LLLL.LLLLL.LLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLL.LLLL.LL.LL.LLLLLLLLLLLLL LLLLLLL.LLLLLL.LLLLLLLLLL..LLLLLLLLLLLLLLLLLLLLLLL.L.LLLLL.LLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLL LLLLLLL.LLLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.L.LLLLLLLLLLL LLLLLLL.LLLLLL.LLLLL.LLLL.LLL.LLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL LLLLLLL.LLLLLL.LLLLL.LLLL.LLLLLLLLL.LLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLL.LLL.LLLLLLLLLLLLLLLLLLLL LLLLLLL.LLLLLL.LLL.L.LLLL.LLLLLLLL.LLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLLLLLLLL L....L.L..L.L....L..L.L...L.....L..LL...L.L.L.L.LL..L....LL..LL....L.L.......LLL..LLL...LL..L LLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLL.LLLLLLL.LLLLLLLLLLLLLL..LLLLLLLLL.LLLL..LLLL.LLLLLLLLLLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLLL.LLLLLLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLL..LLLLL.LLLLLLLLLLLLL.LLLLLL.LL..LLLLLLLLLLLLLLLLLLLLLL.LLLL.LLLLL.LLLLLLLLL.LLL L.L.LLLLLLLLLL.LLLLL.LLLL.LLLLL.LL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLL.LLL.LLLL.LLLLLLLLLLLLLLLLLLL LLLLLLL.LLLLLL.LLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLL.LLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLLLLLLLL.LLLL.LLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLLLLLLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.L.LLLLLLLLLL.LLLLL.LLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLL.LLLL.LLLL.LLLLLLLLLLLLLLLLLL. LL.L.LLLLLLLLL.LLLLLLLLLL.LLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLLLLLLLLLL.LLLLL ...L..L..L..L....LLL..L.LL....L........L.......L.L.LL.L........L...LLLL....LL.......L.LL..L.L LLLLLLLLLLLLLL.LLLLLLLLLL.LLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLL LLLLLLL.LLLLLL.LL.LL.LLLLLLLLLL.LL.LLLLLLLLL.LLLLL.LLL..LLLLLLLLLLLL.LLLL..LL.L.LLLLLLL.LLLLL LLLLLLL.LLLLLLLLLLLL.LLLL.LLLLLLLL.LLLLLLL.L.LL.LL.LLLLLLL.LLLLLLLLLL.LLL.LLLLL.LLLLLLL.LLLLL LLLLLLLLLLL.LL.L.LLL.LLLL.LLLLLLL..LLLLLLLLL.LLLLLL.LLLLLLLLLLLLLLLL.LLLL..LLLLLLLLLLLL.LLLLL LLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLLLLLLLLLLLLL.LLLLL.L.LLLLL LLLLLLL.LLLLLL.LLLLLLLLLL.LLLLLLLL.L.LLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLLLLLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLL.LLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLL.LLLL.L.LLL.LLLLLLL..LLLL LLLLLLL.LLLLLL.LLLLL.LLLL.LLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLL.L.LL.L.LLL.LLLLLLL.LLLL. ....LLLL.L..L....LL..L.....LL..........LL.....L.L..LL.LL......L.L.L.L....L.LL.L.L..L......L.. LLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLL.LLLLLLL LLLLLLLLLLL.LLLLLLLL.LLLL.LLLLLLLL.LLL.LLLLL.LLLL..LLLLLLLLLLLLLLLLL.LLLL.LLLLL..LLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLLLLLLLLL.LL.LLLLL.LLLLLLLLLLLLLLLLLLLLLL.LLLLL.LLLLLLL.LL.LL LLLLLLL.LLLLLL.LLLLL.LLLL.LLLLLLLL.LLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLLLL.LLLLLLLLLL. LLLLLLLLLLLLLL.LLLLLLLLLL.LLLLLLLL..LLLLLL.LLLLLLL.LL.LLLLLLLLLLLLLLLLLLLLLLLLL.L.LLLLL..LLLL LLL.LLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLL.LL.LLLLLLL.LLLLLLL.L.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLLLLLLLLL.LLLLL.LLLL.LLLLLLLL.LLLL.LLLL.LLLLL.LLLL.LLLLLLLLLLLL.LLLLLLLLLL.LLLLLLL.LLLLL LLLLLL..LLLLLLLLLL.L.LLLL.LLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLL.LLLLLLLLL.LLLLLLLLLL.LLLLLLL.L.LLL LLLLLLLLLL.LLLLLLLLL.LL.L.LLLLLLLL.LLLLLLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLL.LLL.LLLLL L.L...L....LL.L....LL..L...L...LL.L.............LLLLL..LL........LLL.L....L.L...L.L...LLL.LL. LLLLLLL.LLLLLL.LLLLLLLLLL.LLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLLL.LLLLLL.LLLLL LL.LLLL.LLLLLLLLLLLL.LLLLLLLLLLLLLLLLLL.LLLL.LLLLL.LLLLLLL.L.LLL.LLLLLLLLLLLLLLLLLLLLLLLLLLLL LLLLLLL.LLLLLL.LLLLL.LLLLLLLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLLLLLLLLLLLL.LLLL.LLLLL.LLLLLLLLLLLLL LLLLLLL.LLLLLL.LLLLLLLLLL.LLLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLL.LLLL.LLL.LLLLLLLLLLL.LLL .LLL..LL.L.LL.L...L.L..L...L....L.L................L....L.......L..L.....L...LLL....L....LL.. LLLLL.LLLLLLLL.LLLLL.L.LL.LLLLLLLL.LLLLLLLLL..LLLLLLLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLLLLL.LLLLL LLLLLLL.LLLLLL.LLLLLLLLLL.LL.L.LLL.LLLLLL.LL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLL.LLLLLLLLL.LLLLL LLLLLLL.LLLLLL.LLLLL.LLLL.LLLLLLLLLL.L.LLLLL.LLLLLLLLLLLLLLLLLLLLLLL.LLLLLLLLLLLLLLLLLL.LLLLL LLLLLL..LLLLLLLLLLLLLLLLL.LLLLLLLL.L.LLL.LLL.LLLLL.LLLLLLLLLLLLLLLLL.LLLLLLLLLL.LLLLLLLLLLLLL LLLLLLL.LLLL.L.LLL.LLLLLLLLLLLLLLL.LLLLLLLLL.LLLLL.LLLLLLL.LLLLLLLLL.LLLL.LLLLL.LLLL.LLLLLLLL LLLLLLL.LLLLLLLLLLLL..LLL.LLLLLLLL..LLLLLLLLLLLLLL.LLLLLLLLLLL.LLLLLLL.LLLLLLLL.LLLLLLL.LLLLL ================================================ FILE: advent-of-code/2020/inputs/12 ================================================ F29 E5 L90 W1 R90 E1 R90 W5 F32 E2 S3 R270 F61 R180 R180 E2 F13 R180 F18 L180 F15 N2 S2 R270 N2 F81 W4 N2 E1 N5 F5 N3 R90 W5 S1 F20 L90 S2 R90 F81 S2 E1 F59 N1 L180 W3 R90 E5 F2 R90 F28 R90 F70 L180 S4 L90 F97 W2 R180 S5 F12 N4 L90 F47 R90 F20 W3 S2 E2 F29 S2 L90 S1 L180 F92 L90 S4 W3 L90 W5 F56 N3 L90 S4 F83 S2 F82 W4 F34 R90 N5 F85 R90 F17 R90 F15 W1 L90 F55 S3 F38 W1 F38 S3 W1 N1 F77 R180 S5 F89 L90 F62 N4 R90 E3 L180 E2 F44 S4 R90 W2 L180 S4 R90 N5 F30 S5 R90 F88 R90 F10 L90 N5 F45 E5 F51 W5 N3 E3 F93 E5 F85 N5 L90 F6 W4 N3 F25 L90 E2 S4 W1 R180 E4 S3 E2 F26 N3 E3 F32 N3 L90 F25 L180 E3 F46 F12 N3 W4 L90 S2 L90 F31 W4 F75 L180 E3 F79 R90 N5 L270 W5 L180 S5 F19 N2 F90 L180 W3 S4 E2 F85 N1 F62 W4 F77 L180 W1 N2 L90 F86 R90 W5 F34 E1 F72 R90 E3 F5 N2 R90 S2 R270 W4 F58 F19 R180 R90 W4 F60 N1 E1 R90 F27 W4 L90 F35 E1 F11 E4 R90 W5 F68 L90 S2 W3 F2 L90 F24 W4 N4 R90 F32 L90 L90 F22 F91 R90 W1 F23 W2 S1 W3 S2 F97 W4 L90 W1 F16 S4 L180 W4 F48 E5 F21 N3 F2 E2 F75 N5 E2 L90 E3 F76 L90 N1 L90 N5 E1 L90 E2 R90 F40 L90 S5 E1 F8 S1 L90 E4 N3 F10 L180 F68 R90 F89 R90 W1 L180 E2 F48 S2 L90 F61 N3 L90 L180 W2 N2 F32 R90 E2 F74 W4 N5 F78 N2 F62 S1 R180 S2 E1 L90 N4 F85 R90 W4 R90 E1 R180 W3 S5 E1 R270 N4 F89 N4 R90 N1 E2 N3 F89 N5 E1 F17 R270 F58 E1 L90 F38 W4 S1 E2 R90 E2 W2 L90 W5 L90 E2 F1 E1 F34 S4 F16 W5 L180 F31 L90 E2 F46 L180 N5 F64 R90 F58 L90 F15 L90 S4 E3 F74 F26 S2 W2 S4 F81 S4 L180 E1 F21 F53 E5 F55 L270 W2 S2 E1 S2 E3 N2 F24 L180 N1 E5 F60 S1 F54 N1 F9 N3 L90 E3 L90 E3 L90 N1 F28 N4 R180 N5 F44 N2 E3 R90 W4 R180 F69 W3 S2 R180 E3 R270 S4 W2 R90 F69 E3 F44 L90 F87 E4 F21 E1 S2 R90 E5 L90 W5 R90 E1 F66 W4 F51 S3 S4 W3 L90 E1 R90 W1 R180 W1 N1 L180 N3 L180 E2 F14 N2 E5 F95 L270 N4 R90 N1 R90 N1 E4 F90 N3 F35 N5 F74 R90 N3 F64 N1 F28 N2 W2 F7 W4 N2 F37 E3 F100 R90 F36 L90 F41 E1 L90 L90 W1 N3 W2 W3 L90 W5 F100 R90 N2 L180 F7 W2 E2 F77 L180 N2 R180 F60 L90 N5 L90 F72 L270 W1 L180 N5 R90 F54 S3 F70 N1 F72 E4 N5 R90 S1 W1 N3 R90 F45 E4 F32 W5 F78 W3 R90 W4 F58 R90 E5 L90 F3 R90 N1 R90 W1 N4 E1 W3 N5 R90 W5 S3 F25 W4 N3 F55 W2 R90 N1 F98 L90 W3 L270 E1 N3 N2 R90 S1 F39 L90 W2 L90 N3 E3 F80 W1 N1 W4 F25 R90 E3 L180 F21 S4 F75 L90 F76 W5 N4 E2 R90 F44 E3 N1 W3 F49 N2 L180 S4 L90 F55 S4 R90 F14 R90 W5 L90 F85 N2 L90 L90 E3 R90 N3 E4 S5 F75 L90 F60 N2 R180 E2 L90 E2 L180 F27 E4 N4 L90 N2 L180 F91 N4 F47 W2 N2 F63 F63 W4 F28 L90 N1 F57 S1 E2 L90 E5 L180 N3 E4 F70 R90 W5 L90 W1 E3 F18 E3 F15 N1 E4 L90 W1 F49 E3 R90 F61 N3 E2 F69 E1 F7 L90 S1 F73 R90 S5 E2 L90 N1 S4 R180 F8 S1 E5 F44 N1 F39 L90 S1 F83 L90 E4 F59 N4 W2 S3 W2 R90 L270 E4 R90 N5 E4 F22 E1 S3 R90 W5 R270 N1 S4 F39 N4 F78 N4 W3 F34 E5 F31 L90 N3 R180 F75 S2 E1 R180 F89 E5 R180 S1 W3 F97 R180 F54 W2 F6 W5 N3 F58 R90 N2 L180 F2 W3 E3 N3 R180 W1 E3 S3 E2 F87 W5 E3 R90 F63 F30 R90 S3 F69 E2 F87 N1 F95 S4 L90 F52 ================================================ FILE: advent-of-code/2020/inputs/13 ================================================ 1006726 23,x,x,x,x,x,x,x,x,x,x,x,x,41,x,x,x,x,x,x,x,x,x,647,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,13,19,x,x,x,x,x,x,x,x,x,29,x,557,x,x,x,x,x,37,x,x,x,x,x,x,x,x,x,x,17 ================================================ FILE: advent-of-code/2020/inputs/14 ================================================ mask = 11110100010101111011001X0100XX00100X mem[17610] = 1035852 mem[55284] = 229776690 mem[16166] = 12685380 mem[8340] = 16011 mask = 0X1X0X010101011X10X101000X0001110100 mem[968] = 15992 mem[32758] = 7076 mem[30704] = 1701 mem[33719] = 58012 mem[20818] = 25927237 mem[16718] = 46485 mask = 111001111X0X0X101X111X1X001XX0011010 mem[2115] = 14848 mem[42753] = 617 mem[56076] = 9933868 mem[19106] = 43503 mem[10073] = 32909 mem[40830] = 1959686 mask = X11X00000XX1011X10000X01110000X0001X mem[41605] = 13245557 mem[6571] = 7973763 mem[46231] = 28527162 mem[44901] = 163334644 mask = 0101XXX1X10XX1101011110000000010010X mem[53492] = 357272 mem[32816] = 35015 mem[6965] = 11280352 mem[27745] = 160101 mem[26728] = 1260 mask = 1XXX0100XX1X0X10101100011101101X0111 mem[22010] = 28123044 mem[42154] = 82539 mem[54914] = 22078 mem[7185] = 436 mem[58583] = 25334197 mask = 11110010X001011010X1XX010XX0110001XX mem[62397] = 9570559 mem[49595] = 15491062 mem[21644] = 9478776 mem[19853] = 31023 mask = 001110000101011X1111100XX1111000X111 mem[62345] = 1200300 mem[34309] = 115943357 mem[23144] = 873 mem[36010] = 954 mem[6857] = 645222 mask = 0011X101110X10101111000X010X00100000 mem[12284] = 570 mem[44849] = 48293 mem[48549] = 489763617 mem[51371] = 1151 mask = 01X0X10101000XXX10111010011010XX0X10 mem[17699] = 14190020 mem[32796] = 84255743 mem[62003] = 1426 mem[18906] = 353 mem[38218] = 615297 mask = 0X0101010111XXX01011010111XX01100010 mem[26389] = 62531634 mem[12404] = 1034263 mem[49398] = 1006 mem[22929] = 313056 mem[16164] = 1694664 mem[19077] = 53452 mask = 0X1XXX0X010101101X1110XX101010X01010 mem[38381] = 18385 mem[2319] = 552 mem[60857] = 1931 mem[41219] = 19301038 mem[9073] = 85077 mask = 00010000010XX1X01000110101100X000111 mem[10385] = 227941 mem[31042] = 151514106 mem[22360] = 168649336 mask = 0110010X0100XX10001X11X1X11100XX0X11 mem[40411] = 8140928 mem[3859] = 2742 mem[45449] = 4317450 mem[17740] = 1337381 mem[19338] = 6605990 mem[22407] = 53051 mem[42292] = 550664 mask = X1110XX00X0101101011XX0X101110001111 mem[59509] = 304929 mem[43817] = 14977 mem[39410] = 439 mem[38730] = 34567670 mem[31862] = 8027039 mem[60857] = 5209 mask = X11X0000X1X101X010110XX011111011X011 mem[28472] = 14882 mem[50099] = 1135 mem[58921] = 980796 mem[50737] = 36974 mem[54167] = 22140347 mem[2139] = 22934 mem[13202] = 136157 mask = X1X001X1010001X0X0111100101110X0X101 mem[911] = 8925 mem[652] = 183714641 mem[58633] = 5186611 mem[41763] = 29030 mask = 011X01010010001110110X0X1100000000X1 mem[47324] = 8124 mem[31660] = 355290 mem[19624] = 1760 mem[32635] = 27873924 mem[45190] = 439446159 mem[1090] = 428 mask = XX10000X00011X1X1011010X0001110X0101 mem[40622] = 1839170 mem[45103] = 108379641 mem[29222] = 187252 mem[42753] = 2592089 mem[46615] = 4466791 mem[22416] = 6619543 mask = X0X101X10X000010XXX10110111011011101 mem[42154] = 3271203 mem[10355] = 89584861 mem[14447] = 383415 mask = 1X000X001X100X10X0X1X01X1101X0110101 mem[40691] = 1490354 mem[6162] = 601597339 mem[62819] = 15727 mem[48596] = 8589566 mem[46732] = 56337 mem[35437] = 1568988 mask = 00X0X10X01010110X0111X0XX01100001111 mem[43285] = 75734 mem[41605] = 46442 mem[7672] = 667983 mem[29222] = 9835 mem[34949] = 3945167 mask = 01X00101X101001010X1100X0X11X110X101 mem[8617] = 182201 mem[33667] = 11585659 mem[57414] = 235257 mask = 0111010001010XX01X11XX1011XX101X1011 mem[19633] = 3970 mem[10580] = 6454804 mem[22445] = 12328278 mem[22131] = 70709 mem[31438] = 870851666 mem[46279] = 638924631 mem[20402] = 311245 mask = 0110000101X1X11010111X001111X1000111 mem[2405] = 733626 mem[27649] = 150996 mem[45000] = 13156617 mask = 01X10X0X01X10110101101X1X1X00100011X mem[44304] = 5130 mem[25804] = 264101480 mem[896] = 1445 mem[20949] = 386031115 mem[24951] = 9889 mem[51040] = 3708234 mask = 00100X01010101101111100010XX0100X1XX mem[31907] = 15551 mem[1218] = 1034 mem[17073] = 359232 mask = 010100010101X1101X11011X010001XXXXX0 mem[11137] = 1499158 mem[59509] = 262392 mem[6988] = 14863 mem[28213] = 554 mem[7044] = 68 mask = 01100101X1XX0X10X01110X1001X00X00X11 mem[22674] = 3230 mem[35891] = 3585 mem[3551] = 15928515 mem[36206] = 104461320 mem[22167] = 1161073 mask = 01X1X00X01010X1010111X010XX00011X101 mem[17360] = 494 mem[34415] = 3766044 mem[8898] = 846638 mem[48368] = 500781 mask = 011001010X0X001X0X101X010X100101100X mem[60679] = 10414 mem[34463] = 11 mask = 01100100010XX11X1X0X0000001111010011 mem[40952] = 1659 mem[27502] = 2916485 mem[7436] = 211741 mem[58641] = 944726 mem[58633] = 46218913 mask = 010110000101011X101101X0111110X00X11 mem[3042] = 13844 mem[49701] = 56163826 mask = 011001X00101011010X1100010X11X011X11 mem[38067] = 7299191 mem[31130] = 116061 mem[2139] = 63458254 mem[4521] = 1237 mask = 0111X000X1010110101X011100100100011X mem[21329] = 642 mem[41123] = 28058 mem[29555] = 4111 mem[15009] = 3801745 mem[49595] = 317 mem[56642] = 126724425 mem[29388] = 19214321 mask = 1101X1X0X11X101011X01X11X0111X001X01 mem[20118] = 21164480 mem[39432] = 508 mem[39859] = 958 mem[36851] = 196470 mem[26907] = 97849565 mask = XX10000011110X001011XX0010X110100001 mem[34234] = 17652327 mem[16028] = 80890944 mem[54559] = 64040 mem[25194] = 41593756 mask = 001110000101X1101XX1000X10110000110X mem[33667] = 916652067 mem[2405] = 1244 mem[63718] = 292918 mem[29526] = 711465 mem[24951] = 1884 mem[22360] = 167190303 mask = 1100000000111X11101X0110X00010X00100 mem[6620] = 2734891 mem[64584] = 215747822 mask = 01X00X000100101000X11000X01110100X01 mem[56211] = 3278176 mem[40364] = 340370 mem[23555] = 27655 mem[42471] = 227213 mask = 1X10X1111101X110X011X000X0X0X10011X0 mem[6829] = 110833304 mem[15624] = 23686 mem[59705] = 5391933 mem[10724] = 32064 mem[14827] = 6939 mask = X1X1100001010X111011101X00110X000010 mem[50595] = 719945 mem[1480] = 39227195 mem[52615] = 124668762 mask = 01100XX1110X011XX01100001011X1X10X10 mem[58924] = 3492 mem[16850] = 584 mem[61283] = 289490093 mem[20396] = 55247 mem[12216] = 9844180 mem[12216] = 14974951 mask = 00X00101010101X010111000101XX0100001 mem[4778] = 4486654 mem[24826] = 1334889 mem[30412] = 685 mem[424] = 40892660 mem[19019] = 87071 mem[58641] = 13743890 mask = 011100XXX10101101X0X00010001011100X0 mem[10355] = 392450 mem[20082] = 23264 mem[25220] = 1800190 mem[59108] = 141835 mem[58233] = 543 mem[48973] = 863 mem[54167] = 28960 mask = 1110X0000001X11010110000X1011XXX1010 mem[52783] = 2071776 mem[60857] = 108259027 mem[37356] = 2641268 mem[21950] = 47481758 mem[52557] = 7700825 mask = 0X11010XX10X001011110010111000101001 mem[58111] = 244589936 mem[41399] = 42658 mem[27306] = 237040 mem[4122] = 1592 mask = X1X00X0111110110101XX1001001X0010X10 mem[6801] = 34789897 mem[59447] = 10675177 mem[28987] = 666686 mask = X110000X000110X11011111000X11100010X mem[424] = 2927 mem[30920] = 894899 mem[1670] = 305032596 mask = 0111X01000X1X1101011001X111000011010 mem[29811] = 632621 mem[40046] = 51323 mem[55593] = 6182 mask = 01100011100XX11X00X110X011110XX10101 mem[58803] = 484311 mem[49237] = 12281 mem[46823] = 1332 mem[24356] = 1277234 mem[42561] = 1938 mem[14991] = 8909 mask = 0111X00000X101101X11101010111X001111 mem[8482] = 2735 mem[36657] = 64651206 mem[3842] = 157 mem[60137] = 483271 mem[5610] = 709 mask = XX1X00X00X01X11010111X001101110X1111 mem[22416] = 27971815 mem[19192] = 7861 mem[51678] = 25016 mask = 011XX1111101XX101111001X001110010000 mem[64535] = 155 mem[38057] = 669 mem[8482] = 29767095 mask = 00100X000X010X10X111100X11100110X101 mem[38067] = 10211 mem[37762] = 11637 mem[34706] = 44902 mask = 0X11001100110XXX1011011X10X10X01100X mem[26809] = 2100865 mem[60446] = 25094 mem[43745] = 461971 mem[24321] = 28927 mem[7984] = 355769146 mem[9488] = 1910 mask = 0X1001X1X10X0X1010111X10X011X01X1111 mem[51678] = 2889 mem[46700] = 214866595 mem[40992] = 4945733 mem[25409] = 172376952 mask = 0110011111X100101X11000XX110X0001X0X mem[11587] = 9651 mem[41265] = 61660 mem[1822] = 6155 mem[29303] = 250909900 mem[59145] = 51920318 mask = 01X1X0X0X1010110101100101111100X0001 mem[33719] = 2071728 mem[24951] = 108 mem[12284] = 369552742 mem[55012] = 53272268 mem[31862] = 3576 mem[5950] = 460151 mem[55978] = 53697916 mask = XX1100000X01011010X1100011X01000X110 mem[61606] = 1036 mem[6477] = 81209 mem[2187] = 6526467 mask = 111000X011110100X011X0XXX11X10110X01 mem[25194] = 7338343 mem[16563] = 225968 mem[51983] = 30985431 mask = 0X000100010101101X11100X00011X111011 mem[34309] = 434429 mem[16850] = 476433401 mem[63015] = 181118 mask = X110001011X1010X1011010X1011X01100X0 mem[19081] = 237103716 mem[24300] = 10640 mem[23963] = 430607 mask = 0111XXXX001101101011000011XX00X01XX1 mem[26941] = 27590 mem[31862] = 20472 mem[4020] = 3134353 mem[55543] = 1761762 mem[45048] = 1024489921 mask = 11100111X10X111XX0X1000010111110101X mem[48596] = 3587524 mem[2018] = 451398 mem[54298] = 121634159 mem[26371] = 5517119 mem[57585] = 1825 mask = 0111X00X0011X11010X10X100100X1100000 mem[44281] = 1515553 mem[36633] = 1289 mem[30077] = 12046281 mem[55362] = 226809 mem[48993] = 794317 mem[58968] = 241 mask = X110010101100X10101110100011000XX001 mem[22929] = 2072990 mem[22931] = 336 mem[31880] = 119168961 mem[3859] = 49656496 mem[45103] = 296484159 mask = XX11000001011110100101100X0X01100101 mem[41219] = 826 mem[38539] = 22527609 mem[40238] = 29540 mem[34813] = 4305171 mem[51640] = 4302332 mem[44070] = 1373134 mask = 011X0000X101011010011111X01X10101011 mem[40884] = 256867181 mem[56234] = 2181222 mem[5950] = 68826 mem[1760] = 88028804 mem[50704] = 5302105 mem[24366] = 442 mem[10147] = 127227597 mask = 0110X1100101X1101011X111100X0X0XX010 mem[21956] = 121736133 mem[25007] = 3174 mem[42616] = 925004 mem[1670] = 3018 mem[46932] = 2981988 mask = X1110011001XXXX01011011X1X1100011X01 mem[61283] = 521975 mem[27640] = 322 mem[62514] = 153670214 mem[23951] = 14226595 mem[9549] = 2336533 mem[11888] = 827772 mask = 1101X100XXX1X010111000XX0001000X10X1 mem[16797] = 22808 mem[48021] = 2258240 mem[12370] = 185157105 mask = 01110X0X00XX0X1X10110100X10X01000010 mem[4594] = 93 mem[57388] = 665641765 mem[1345] = 361710791 mem[37543] = 1730 mem[57136] = 388716965 mem[42524] = 553 mem[13403] = 637623155 mask = 0110X1X0X101011X10110110100101011110 mem[16512] = 3631 mem[11337] = 203803846 mem[2504] = 336583240 mem[12269] = 4069068 mask = 01XX001111001110101100001X01000100X0 mem[33661] = 6490 mem[30704] = 128919282 mem[41797] = 22490 mem[8134] = 38294563 mem[63208] = 12103 mask = 11X00X0000X1XX1X101100010000010011XX mem[24951] = 3275742 mem[23998] = 1551 mem[19972] = 5727596 mem[17337] = 205937438 mem[41952] = 53261 mem[64651] = 26734 mask = X11001111101XX101X110X001011100X0X1X mem[57388] = 441426 mem[11337] = 336 mem[8515] = 381065399 mem[49625] = 1066556272 mem[54274] = 7650 mem[8575] = 15426 mem[18302] = 216253866 mask = 1X0X00X000X11X1110110100110111X1X101 mem[6256] = 17076091 mem[7973] = 5554062 mem[39859] = 1429203 mask = 0X110001011101101X1111101001XX000110 mem[38807] = 351 mem[28213] = 22387 mem[26591] = 76518875 mem[15712] = 12048675 mask = 01X1XX00010101101011X111XX1010XX1011 mem[9073] = 789 mem[39859] = 919291385 mem[18302] = 347 mem[41224] = 4579691 mem[41167] = 19132842 mem[424] = 158741911 mask = X110010X0100X010X0100X00XX111001X011 mem[28822] = 66019 mem[46209] = 2719 mem[35264] = 1826 mem[60137] = 389000 mask = 01010001X101X11010110X111111X1000001 mem[16591] = 62860121 mem[10737] = 1180 mem[31130] = 16000 mem[34880] = 584 mem[6800] = 39 mask = 0111X000X1XX11101001010X00110010011X mem[5501] = 31780835 mem[31862] = 6009 mem[49129] = 91037 mem[7935] = 15099 mem[44839] = 31518815 mask = 0101000101011110X1110111000001XXX000 mem[14827] = 1206371 mem[62398] = 1062 mem[50952] = 1253562 mem[32584] = 22533969 mem[9662] = 2590 mask = 01100X111X0X1110XX111X000X1101000001 mem[40142] = 107915 mem[10580] = 4884244 mem[2187] = 1020 mask = 11X100XX1001X1X0101X01X1001X11111100 mem[19551] = 54829 mem[18208] = 627039 mem[18032] = 3423 mem[24162] = 301557348 mem[35891] = 1206 mask = 01100111110100X0XX1X1011XXX100101000 mem[9695] = 368318059 mem[9916] = 30083984 mem[9903] = 866066456 mem[3360] = 434642 mem[3609] = 2437 mask = 0XX1X000010XX1X0100X1010X10100X00111 mem[64662] = 5845 mem[20000] = 2302117 mem[21056] = 11248 mem[641] = 200833516 mem[46678] = 3506929 mask = 0X100111111100101111110X01110X00010X mem[59199] = 1984963 mem[43784] = 7811709 mem[49701] = 3967 mem[11888] = 790487 mask = 111X00000101111010010X10001101XX11X0 mem[51082] = 222096294 mem[50595] = 121297 mem[27424] = 268132 mem[9473] = 200971 mem[42941] = 1604 mask = 0X11010X1X00X01011110010111XX010X00X mem[44304] = 31572 mem[14907] = 1066531 mem[34745] = 91393 mem[1617] = 124090 mem[25898] = 49692 mask = X11X01000X010X111X1X10100000010X10X0 mem[12953] = 62465686 mem[24718] = 15597133 mem[20124] = 4930329 mask = 0X11010000X10X1010110111XX00X1XX101X mem[12426] = 694 mem[2226] = 70693 mem[6332] = 3693756 mask = 0111100000110XX010X11000X1X111011010 mem[42447] = 86599788 mem[62694] = 50365 mem[59239] = 4355782 mem[12523] = 14292673 mem[52756] = 2685769 mem[54978] = 207845 mem[17699] = 366567692 mask = 011001011111X0XX101100000X10X0X01011 mem[8186] = 1183 mem[6181] = 8087 mem[61605] = 3505 mem[46678] = 85544 mem[40046] = 5212041 mem[28835] = 3272650 mask = 011100000101X11010X1011X10X1XX00X011 mem[55012] = 105058 mem[52202] = 26295 mem[59657] = 2809 mask = X1X10100X101XXX0X110001110001XX01001 mem[45682] = 323588 mem[49237] = 58065 mem[41032] = 27927 mem[35647] = 280 mem[47892] = 252817 mem[29350] = 15075 mask = X11100X0010X01X010111101001100000010 mem[34234] = 10472 mem[14531] = 102821 mem[49081] = 3626197 mem[62940] = 630043 mem[4115] = 453716952 mask = 0111010001XX0110111X0101100X1X10101X mem[911] = 198069 mem[5550] = 42378 mem[27566] = 13692 mem[13890] = 46764242 mem[11669] = 66225421 mem[54529] = 652599152 mask = X11X01X00X01011X10110110X00X100X10X0 mem[7236] = 3301 mem[10580] = 971 mem[51284] = 232016 mem[13784] = 33278200 ================================================ FILE: advent-of-code/2020/inputs/16 ================================================ departure location: 26-724 or 743-964 departure station: 33-845 or 864-954 departure platform: 26-472 or 482-967 departure track: 27-140 or 158-956 departure date: 25-884 or 894-952 departure time: 37-924 or 941-949 arrival location: 48-311 or 335-972 arrival station: 39-703 or 724-950 arrival platform: 40-108 or 114-950 arrival track: 30-101 or 108-967 class: 33-386 or 399-949 duration: 44-444 or 452-956 price: 27-220 or 234-974 route: 42-774 or 790-959 row: 48-900 or 918-956 seat: 42-165 or 178-949 train: 45-831 or 842-965 type: 49-522 or 548-974 wagon: 32-565 or 588-964 zone: 27-608 or 617-953 your ticket: 101,71,193,97,131,179,73,53,79,67,181,89,191,137,163,83,139,127,59,61 nearby tickets: 818,269,901,814,631,821,607,127,247,636,755,762,559,670,189,249,499,273,565,463 470,472,597,259,345,370,827,520,595,92,204,52,104,248,688,500,99,694,659,803 432,251,666,518,217,469,791,304,139,724,516,522,702,496,804,142,408,518,82,823 333,471,429,58,129,754,304,879,459,288,268,386,217,138,284,554,762,370,769,161 242,255,344,634,710,124,813,241,697,342,600,637,202,421,75,195,496,470,806,554 464,948,755,334,662,493,251,948,286,472,562,400,774,790,385,263,100,689,681,83 511,796,756,593,637,647,377,277,178,642,588,695,591,495,678,682,346,318,417,84 762,238,803,343,290,80,558,216,806,157,821,359,654,661,870,552,503,604,200,754 613,290,370,761,595,899,743,868,289,162,303,653,810,311,95,468,588,456,772,342 352,332,559,813,443,243,881,75,522,245,190,61,488,755,341,489,219,671,642,875 884,60,949,97,626,597,472,371,273,464,942,254,497,443,50,555,692,286,557,445 159,512,555,651,88,237,71,259,76,639,727,356,519,93,696,644,872,117,160,655 897,767,193,255,485,702,370,160,597,651,918,444,831,160,67,107,768,140,163,282 523,415,900,125,409,75,335,512,807,507,769,73,108,427,269,826,817,434,946,80 114,60,239,55,73,122,619,799,754,795,497,792,835,311,594,767,821,267,812,597 795,291,757,746,626,752,220,649,269,918,75,895,895,369,310,794,638,900,712,619 740,295,117,790,364,344,900,921,884,896,809,382,189,944,165,92,878,791,827,212 256,293,876,370,159,678,669,512,755,185,430,489,515,457,467,312,384,219,380,830 186,130,560,633,920,457,59,766,305,835,642,813,68,453,656,429,427,256,364,296 281,488,117,820,159,444,923,325,805,801,91,698,631,343,131,287,560,831,495,661 132,875,622,812,308,880,160,830,668,238,445,454,410,685,64,413,428,799,55,656 261,772,752,829,367,947,71,194,66,254,102,812,280,455,90,744,823,460,205,406 656,347,472,489,419,355,693,250,221,75,302,492,83,617,691,556,687,99,773,520 208,365,163,0,181,820,403,844,343,347,557,124,945,599,699,439,75,800,745,115 278,228,294,803,372,759,239,384,80,243,99,456,378,367,668,703,762,288,758,689 89,198,186,409,123,279,100,367,275,399,470,163,752,215,659,342,69,916,467,875 624,551,663,437,441,753,807,638,373,881,108,377,229,367,769,691,79,254,409,456 661,553,822,674,435,55,800,139,749,800,158,368,402,521,321,842,285,439,673,417 218,363,786,191,694,117,130,95,701,284,159,308,802,400,826,284,158,462,405,234 887,763,452,724,336,882,818,377,400,681,674,814,511,470,260,433,97,653,62,744 690,606,756,361,283,670,501,621,519,325,764,239,137,501,62,454,241,237,368,507 61,283,521,131,751,521,696,181,214,766,762,503,190,336,311,345,74,600,617,789 297,375,215,56,675,695,825,125,277,84,656,181,563,790,828,694,343,710,744,298 412,359,842,243,520,876,696,555,620,190,668,487,274,238,599,54,633,297,727,637 690,556,264,384,369,18,190,808,344,603,767,90,695,219,63,896,484,255,483,799 122,877,512,905,254,495,692,751,369,675,625,640,355,879,604,627,457,70,878,78 942,121,807,564,919,431,768,675,65,619,461,336,247,623,527,493,133,283,237,404 84,384,876,444,880,403,675,114,632,255,21,205,339,253,62,372,404,683,292,88 185,348,472,400,63,444,80,883,373,336,426,563,675,561,305,516,449,456,514,872 648,82,604,650,697,825,462,813,306,94,814,597,879,795,461,294,213,511,331,487 488,761,215,264,421,492,695,191,205,753,918,639,162,317,769,212,123,202,591,795 842,127,163,78,765,180,236,87,235,462,60,800,871,364,217,614,924,597,247,409 807,423,611,589,759,629,192,471,456,118,77,760,94,82,882,429,60,462,499,898 772,503,822,287,342,458,918,633,624,216,280,75,328,125,352,685,520,769,508,655 212,386,347,829,752,482,690,521,136,687,991,899,244,798,562,424,354,554,654,61 558,252,63,674,882,420,693,273,604,269,812,621,266,338,697,479,58,295,659,204 351,426,373,683,869,621,815,263,685,244,804,435,446,461,353,764,762,815,403,760 590,469,920,421,125,382,650,844,694,602,493,746,372,874,243,990,198,486,745,100 249,668,621,369,630,216,242,752,588,10,125,216,675,162,162,352,462,242,296,771 161,81,595,194,61,359,300,379,339,696,58,485,282,696,11,265,302,621,678,439 256,944,238,602,599,184,410,229,244,899,509,289,119,488,159,75,79,269,607,809 992,802,308,271,58,520,201,64,164,748,551,123,371,122,602,403,361,205,820,443 662,601,606,596,57,757,160,687,139,215,783,72,444,440,365,298,511,654,56,237 460,302,355,632,824,664,760,210,924,673,692,688,763,358,488,419,709,275,663,206 595,420,202,434,454,550,274,745,453,195,314,374,682,372,695,249,65,245,57,680 247,877,682,187,743,288,884,509,281,341,355,499,296,178,310,289,651,659,231,250 601,421,558,658,641,884,104,483,865,647,255,945,439,286,821,697,693,820,700,115 608,944,870,617,414,271,440,404,378,426,714,295,791,89,792,280,654,243,193,273 639,183,837,439,161,696,494,653,86,215,58,550,67,758,355,435,507,214,251,403 757,216,644,124,775,382,159,84,599,381,202,946,672,744,443,426,219,490,246,360 406,214,643,589,107,521,819,124,425,774,339,74,608,654,399,444,624,623,943,250 696,291,829,514,696,472,235,751,602,823,259,416,160,24,250,439,743,164,949,762 807,652,337,772,876,685,899,190,459,358,429,831,125,206,834,655,53,422,453,208 837,881,335,774,884,690,588,441,302,864,53,607,81,140,897,470,258,693,355,507 450,471,55,235,307,383,623,488,662,208,302,844,344,622,137,492,604,633,685,745 244,140,457,495,381,558,264,509,69,703,337,756,774,593,824,361,627,513,899,110 588,675,747,751,348,687,310,212,88,711,433,665,947,247,493,941,182,564,242,803 131,809,52,243,229,244,265,212,282,248,441,246,210,701,506,348,812,52,354,791 195,800,417,404,746,683,488,558,53,625,520,774,201,377,143,73,417,457,556,820 879,365,346,239,821,924,843,844,662,648,828,251,374,78,17,768,453,108,245,265 217,286,600,281,408,676,265,5,311,433,236,134,67,463,380,684,123,292,420,690 753,453,500,898,487,556,185,839,361,521,282,674,617,399,946,100,647,941,874,297 509,403,121,483,371,672,768,181,894,109,486,765,308,55,94,196,400,947,551,665 284,628,619,764,673,117,140,649,275,279,347,696,949,668,479,234,186,125,807,658 159,179,808,697,270,948,744,702,588,878,178,600,466,502,189,513,313,219,844,813 794,89,798,897,762,943,632,181,753,637,113,358,236,882,280,680,67,466,299,873 687,211,824,97,459,945,159,521,517,201,252,355,359,303,635,429,643,135,824,738 366,522,355,949,490,500,425,119,517,212,75,301,636,658,188,635,660,115,838,308 67,693,297,257,461,604,287,92,75,601,773,240,193,292,881,916,694,128,603,594 684,486,773,235,386,773,896,401,894,766,551,632,87,196,462,763,103,417,299,867 601,369,703,467,497,74,420,516,235,450,197,198,820,806,370,942,161,813,943,303 565,669,213,604,349,499,203,553,549,690,590,379,89,649,513,517,420,345,366,317 250,514,752,810,520,254,276,692,90,865,458,657,694,4,117,89,519,158,643,248 809,868,194,665,315,99,504,826,211,335,410,512,701,131,879,797,593,204,509,419 89,666,249,808,190,195,991,186,812,353,188,774,65,700,700,457,498,273,745,879 192,299,357,829,601,455,263,123,245,807,594,139,130,98,103,453,645,400,163,919 757,291,511,756,659,640,878,749,408,452,621,598,128,262,365,805,726,252,159,639 998,361,517,654,745,73,799,64,261,243,618,265,806,416,945,84,686,430,452,702 193,686,757,225,206,358,509,552,522,606,592,748,372,375,507,871,501,99,693,373 800,433,423,244,75,399,822,357,866,613,489,598,405,218,772,100,421,374,812,428 232,658,918,309,335,250,271,237,756,115,514,74,254,220,242,130,120,260,691,429 516,135,63,608,68,366,260,827,599,687,433,381,192,464,75,640,890,132,590,592 293,790,666,369,497,824,195,882,100,63,894,386,872,703,511,679,684,639,82,477 112,54,444,68,946,797,370,343,685,588,759,791,499,249,241,941,374,434,239,443 347,666,104,948,623,826,680,277,341,57,411,624,443,455,51,548,290,668,693,502 465,270,252,463,253,434,128,595,774,256,598,64,67,307,348,213,478,348,809,262 278,381,798,768,516,825,831,426,114,181,74,274,772,187,750,799,374,161,3,60 489,340,296,553,96,805,239,648,791,309,484,88,484,797,363,829,128,120,868,977 275,902,677,688,488,867,751,98,874,443,236,379,203,486,200,895,431,241,251,617 187,511,602,442,301,631,876,793,510,623,75,56,101,407,805,164,772,302,608,910 341,194,268,818,450,467,82,262,260,874,185,92,943,436,164,287,644,672,190,949 521,644,922,869,471,467,134,209,878,249,805,259,640,140,820,868,680,867,797,888 696,92,208,819,197,486,240,70,114,697,768,922,52,182,227,414,659,216,745,921 360,764,235,823,822,195,498,290,677,989,811,666,876,872,666,418,484,310,268,206 806,773,119,191,642,746,417,125,946,770,68,386,639,484,847,819,91,452,264,67 894,420,617,399,594,921,811,679,869,642,403,350,816,671,703,279,612,745,271,766 452,724,361,759,428,754,626,410,190,210,217,306,879,51,829,936,603,165,80,279 135,93,678,283,624,488,326,755,240,384,56,641,502,50,790,99,756,816,57,899 468,89,447,490,129,650,796,802,617,403,75,598,827,470,136,826,924,599,510,69 11,519,284,210,795,452,503,701,666,878,300,865,689,632,132,456,269,341,640,289 274,299,214,499,693,677,430,499,427,280,415,554,304,126,509,740,724,823,287,498 702,401,94,647,999,340,100,682,210,412,348,762,625,864,64,661,403,97,697,384 697,695,226,292,556,658,771,802,515,309,797,588,652,509,379,508,115,365,285,452 184,672,373,894,697,699,489,630,269,455,749,352,208,412,512,648,231,295,517,648 116,341,746,199,120,372,89,782,656,620,417,199,379,820,94,668,873,385,818,482 71,437,428,588,87,129,797,604,308,942,148,127,455,252,180,335,343,373,121,774 743,193,820,873,595,357,819,305,409,747,228,763,872,506,84,562,180,809,670,661 943,442,899,309,767,137,199,407,679,944,304,357,792,979,190,198,278,419,214,798 460,413,257,872,134,666,943,446,644,160,549,359,129,684,344,341,633,335,517,662 122,277,89,487,684,358,550,722,97,643,72,361,495,370,919,124,651,651,900,697 817,802,682,797,412,649,506,495,644,897,51,821,471,683,696,384,160,52,112,828 899,483,853,804,384,607,82,91,656,815,624,687,554,820,125,188,78,289,183,656 713,408,672,270,350,123,159,879,746,654,53,506,249,804,259,132,374,128,384,84 51,746,949,761,697,518,884,649,426,99,124,924,631,255,293,633,701,798,21,376 483,294,192,212,455,359,337,814,949,495,164,766,281,799,729,211,515,96,257,754 820,368,756,16,657,651,797,422,601,674,187,234,443,765,883,52,644,262,399,277 374,182,140,695,504,620,617,675,363,52,615,380,878,268,441,756,672,72,352,195 302,201,406,506,483,499,198,120,689,560,411,57,506,622,931,698,188,865,282,597 149,813,402,366,896,264,499,99,68,502,804,923,798,866,882,161,646,193,666,688 773,827,126,773,948,553,808,482,336,990,165,384,821,831,870,62,750,118,814,55 402,669,320,258,631,271,876,201,129,311,373,98,486,666,596,806,949,114,638,252 511,878,125,191,340,868,349,813,100,444,517,303,746,288,670,623,59,664,86,835 58,652,898,548,501,122,644,561,591,379,660,513,751,367,893,750,826,560,867,826 760,799,874,623,304,759,880,946,211,947,180,617,671,215,654,343,161,383,267,148 554,649,296,248,807,69,335,703,371,943,139,456,944,763,772,845,465,549,638,106 382,339,199,347,351,96,864,165,125,65,464,650,820,87,827,199,110,287,922,307 854,408,123,371,134,798,756,278,923,283,492,864,385,563,565,190,252,486,482,630 383,592,2,484,65,922,644,345,793,386,423,679,348,817,471,281,880,415,179,623 306,452,549,877,132,81,454,553,179,343,94,502,72,204,139,678,289,9,413,804 629,424,490,307,695,433,64,95,949,693,378,191,296,72,198,434,485,445,256,89 755,809,606,499,74,259,94,649,315,667,297,88,254,425,241,52,255,352,685,657 768,828,654,691,254,461,241,108,63,661,817,617,17,602,771,753,180,307,635,441 490,699,275,651,456,681,432,335,552,377,279,124,594,869,53,872,788,98,63,769 297,625,382,211,694,408,897,510,196,195,455,339,351,807,760,802,910,71,649,828 483,555,88,691,442,868,289,643,74,403,260,633,561,437,665,460,419,277,154,549 520,411,599,807,278,486,555,165,900,218,500,752,828,250,68,791,200,103,124,188 506,841,843,244,375,303,158,487,134,759,235,763,558,597,805,257,469,274,877,50 628,192,375,975,517,138,180,677,305,60,276,134,817,691,551,214,284,794,51,67 352,642,494,845,634,746,71,619,402,227,808,360,819,920,617,753,643,491,812,492 381,296,293,139,455,643,140,294,245,505,921,201,378,443,800,369,976,879,92,267 918,268,63,181,372,78,264,63,638,236,837,266,644,399,702,257,946,824,869,138 509,206,617,373,55,321,662,376,664,692,458,218,211,560,399,459,163,421,289,483 104,724,435,627,120,348,123,272,304,199,423,190,865,749,234,204,942,894,770,493 180,764,752,135,212,630,554,427,607,621,811,212,362,347,239,777,634,900,455,877 644,946,151,844,220,288,608,385,159,278,370,491,362,949,680,281,871,179,75,386 878,820,458,92,289,195,66,814,362,137,461,127,770,412,916,453,98,797,668,370 385,770,241,744,555,809,268,443,119,132,470,377,74,184,253,122,141,746,197,201 384,667,617,103,869,871,799,257,792,488,127,384,269,680,551,505,280,431,269,254 482,702,159,489,830,123,215,204,872,56,514,260,456,108,368,229,242,191,53,799 602,558,864,268,802,434,160,644,102,592,945,411,607,360,493,796,468,384,386,404 164,371,220,434,628,418,82,588,190,560,608,131,916,694,884,198,765,703,358,82 491,490,263,825,565,509,53,670,416,703,877,126,161,944,76,486,747,784,288,266 679,419,626,341,588,364,758,594,671,51,913,795,261,827,651,633,386,115,626,648 264,621,203,521,366,96,881,431,818,557,356,590,236,383,344,941,655,628,382,227 901,499,378,762,488,671,350,255,876,239,406,556,683,521,158,421,829,373,158,72 624,900,869,467,444,820,247,280,291,234,896,747,899,654,184,471,622,13,871,471 799,683,279,131,663,678,225,676,430,65,345,98,138,193,188,267,505,257,689,588 766,305,865,416,60,516,771,462,165,105,483,555,883,761,498,665,660,696,617,506 469,431,658,439,267,163,505,194,698,681,494,258,408,107,669,294,809,136,549,288 417,440,178,259,816,193,502,90,945,991,307,465,343,564,488,118,139,798,441,824 946,683,592,182,813,74,864,872,408,640,460,948,77,263,692,467,402,202,11,108 607,214,949,219,466,431,486,280,635,342,254,405,793,374,256,94,692,552,615,261 497,681,195,924,877,92,198,186,308,403,250,372,484,301,111,187,56,201,401,193 549,608,490,811,549,284,335,648,2,684,920,165,277,866,749,400,604,278,461,202 122,826,658,844,270,817,896,340,656,784,876,340,306,383,589,647,797,296,220,605 671,804,653,297,61,340,239,772,373,688,291,755,92,240,371,65,21,604,607,642 994,381,193,868,76,495,943,403,415,84,423,626,99,675,214,344,805,588,115,410 646,276,478,845,116,947,564,462,407,689,91,284,257,59,64,596,287,292,214,286 250,668,109,239,701,646,347,278,440,210,108,185,670,238,556,884,180,415,405,310 56,159,267,821,744,435,762,658,657,262,827,196,870,352,713,873,682,73,71,724 677,494,594,700,597,551,767,138,749,430,124,560,339,386,278,200,896,94,139,712 938,73,489,383,346,635,638,747,821,345,408,758,800,431,765,183,842,263,186,745 5,125,769,508,404,250,747,818,458,757,54,875,651,803,896,250,797,589,293,636 642,342,361,132,598,83,629,443,336,213,77,829,208,295,811,379,269,192,449,235 303,794,376,117,198,874,88,284,241,565,632,425,240,57,768,398,606,685,516,212 291,819,947,878,829,423,410,880,7,101,379,761,595,867,384,559,64,896,92,664 263,654,441,635,564,661,914,640,668,268,290,344,286,757,490,588,818,765,421,305 655,622,797,562,414,85,179,375,867,801,418,460,69,276,158,109,140,302,212,381 466,217,763,790,486,202,57,124,878,122,239,520,774,628,502,749,357,604,862,92 479,549,68,134,238,687,796,368,817,209,252,301,495,918,682,161,409,247,897,81 254,451,894,681,618,437,509,791,592,454,349,258,456,282,793,254,793,56,820,158 800,185,138,434,291,19,134,140,759,765,288,178,268,621,218,439,291,502,496,52 373,810,255,509,189,84,756,746,498,364,216,824,774,656,392,765,370,199,771,304 650,443,845,605,900,340,189,124,259,820,608,810,761,370,242,555,834,800,752,507 441,757,425,831,636,139,448,746,98,249,895,184,454,442,756,685,432,553,120,634 115,563,74,562,841,823,501,945,671,354,680,279,604,772,279,194,286,257,258,272 414,455,515,162,53,505,165,554,441,422,369,367,297,220,755,516,849,554,191,132 620,139,813,95,354,241,493,880,652,901,408,98,431,866,695,66,119,664,80,202 589,373,596,461,340,335,286,695,766,423,695,626,470,550,882,367,897,838,382,943 374,339,518,555,212,409,511,109,687,592,338,77,831,588,897,164,163,508,603,416 634,767,376,844,749,803,383,53,752,274,96,116,628,549,126,450,465,179,865,554 115,821,821,383,605,275,619,654,564,819,799,644,651,431,430,114,804,165,907,482 649,452,253,493,680,366,761,677,794,501,207,806,822,92,683,811,618,229,881,435 421,489,178,459,402,436,216,103,272,498,675,341,811,369,875,758,418,702,246,344 429,805,100,604,420,436,465,304,342,818,126,517,65,552,899,858,67,270,634,483 186,98,22,429,795,453,774,58,924,431,753,266,827,65,627,667,797,140,805,116 645,692,67,515,189,455,820,195,872,54,750,63,442,806,614,71,818,134,697,265 644,209,487,486,751,68,243,494,744,810,351,431,72,621,61,584,266,411,470,99 824,790,625,384,96,629,195,749,440,557,633,83,211,983,354,655,178,195,646,73 309,342,684,275,288,621,430,347,135,84,549,203,631,428,755,472,588,386,786,472 805,455,309,139,845,992,702,353,621,307,123,68,694,404,516,755,699,122,620,192 814,880,192,466,68,645,119,509,337,671,238,813,134,894,896,298,469,263,254,858 197,634,618,115,559,180,632,831,772,497,234,342,92,517,130,562,935,499,347,899 253,104,423,752,278,341,339,108,459,193,829,671,670,603,752,374,751,497,430,793 273,80,79,101,69,442,381,472,117,118,747,76,633,108,446,634,554,291,306,400 86,245,132,135,101,420,262,664,442,765,551,703,820,293,703,890,460,899,434,264 789,748,257,799,680,696,350,604,92,362,679,260,336,842,468,924,490,262,191,131 208,941,258,823,87,11,746,419,364,492,440,66,405,245,211,182,376,257,287,829 842,807,739,773,633,411,471,595,659,50,464,276,867,266,122,767,290,866,494,406 519,696,438,924,430,287,444,265,245,608,415,120,77,642,878,99,60,309,104,125 81,62,295,220,284,286,590,414,651,16,240,873,279,629,270,78,698,560,754,796 501,378,589,256,724,206,698,873,383,404,443,628,633,245,652,838,829,628,651,192 101,943,695,519,359,865,132,246,206,767,871,922,85,288,645,533,629,462,133,601 755,632,54,459,801,69,24,63,367,81,770,680,235,688,414,210,747,409,761,632 18,434,493,136,114,368,452,503,379,687,671,80,640,422,256,641,299,560,666,135 129,347,747,259,435,436,64,100,403,416,453,415,92,468,194,120,486,111,218,628 374,381,708,99,404,372,502,99,648,945,624,919,461,792,81,469,116,744,60,690 208,131,218,115,658,695,756,184,599,159,820,138,472,667,779,137,276,680,196,506 594,761,703,487,67,218,84,67,790,470,130,750,383,687,380,900,199,610,242,594 364,501,597,753,130,619,220,69,520,404,945,415,556,439,552,716,811,756,62,459 595,179,510,773,606,647,518,55,998,256,830,617,413,433,688,127,139,805,186,845 243,472,648,340,911,201,415,460,432,516,793,416,884,799,800,83,949,62,758,50 118,89,942,439,340,278,137,908,135,699,453,383,287,194,403,501,829,242,54,879 462,461,655,114,504,463,256,362,340,414,463,416,769,808,864,127,565,373,662,615 266,706,116,219,246,69,620,75,600,50,553,831,440,342,919,99,271,76,680,215 899,344,676,979,372,270,274,201,84,161,409,593,250,194,514,206,380,309,352,399 ================================================ FILE: advent-of-code/2020/inputs/17 ================================================ #####..# #..###.# ###..... .#.#.#.. ##.#..#. ######.. .##..### ###.#### ================================================ FILE: advent-of-code/2020/inputs/18 ================================================ 2 * 9 + 5 + ((8 + 6 + 5) * (2 + 3 * 9 + 3) + 5) * (7 + 9 + 7 + 3 * 7) * 5 7 + (2 + 8 * 8 * 2 + (4 * 3 * 9 + 4 * 4)) + 4 * 3 6 + 9 * 2 * 2 + (2 + (7 * 6 * 6) + 4 * (7 * 8 * 2 + 4) * 7) + 7 2 + ((3 * 6 * 5 * 4 + 7 * 7) + 5 * 4 * 5 * (8 * 7 + 9) + 8) * (4 + 6 * 5) (7 * 6 * 3 + 4 * 3 * 9) + (6 * 6 * (4 + 6 + 4) + 7 + 2 + (9 * 8 * 9 + 9 * 7 * 4)) + (3 * 4 + 3 + 2) * 8 (3 + (7 * 7 + 9 * 9 * 6)) * 3 * 5 + 4 * 8 8 + 9 * (2 + 2 * 5 + 9 * 2) * 2 + ((6 + 4) * 4 + (4 * 7 + 3 * 3 + 7) * (4 * 5 + 8 + 8 + 7 * 6) + (6 + 2) + 5) (2 + 2 * 9 * 7) * ((9 + 8) * 3 * 6 + 6 + (5 * 4 * 4 * 3)) + 9 + (3 + 2) 2 + 7 * 3 + ((7 + 7 * 3) * 6 + 8) 2 + 7 + 6 + (4 + 7 * 7) + 9 * 2 (9 * 2 * 4 * 4) + 4 8 + (8 + 8 + 7) * (5 * 4 + 4 + 5 * 5) * 9 + 8 (6 * (4 * 2 + 4 + 7 + 4) + 4 * 7 + (7 + 5 + 3 + 3 * 7) * 6) * 6 + 3 + 6 + 5 5 + ((7 * 3 * 2) + 9 * (9 + 2) * 6) (3 * (2 * 2 * 3 * 7 * 2) * 8) * 8 ((3 + 2) + 5 + 7 + 3 * (8 + 4 + 5 * 8 * 9)) + 7 * 3 * 6 7 * 6 + 8 * 4 + ((7 + 5 + 2 + 4 * 9 + 9) * 7 + 5) 6 * (6 * (4 + 8 + 6) * 6) 4 + 3 + (6 * (2 * 8)) (2 * 8 * (3 + 8 + 3 + 2) * (8 * 4 + 2 + 8) * 9 + 7) * 8 4 * (3 + 9) + 9 + 4 + 8 + 4 ((6 + 3 + 5 + 6 + 6) * 9 * (2 + 7 * 4 * 9 + 3 * 7) + 6) * (3 * 9 + 2 + 7 * 3) * 6 8 * (5 + 4 * 3) + 3 * 7 + 6 * 4 4 + 6 + 6 + (4 + 9 + 3 + 3 + 3) + (2 + 6 * 2 + 3 + 4) * (2 * 4 + 9 + 3) 7 + (3 + 2 * 4 + 4 * 9 + 2) * 2 * ((8 * 6 + 6 * 2 + 7 + 7) + (2 + 8 * 7 + 6 * 9) + 7 * 6) * 7 + 8 3 * (8 * 7 * (5 + 2 + 8 * 9)) 6 * 9 + 2 + 8 + (4 * 3 * 4 + 6) (2 * 6) + 7 * 9 + (3 * 9 + 8 * 4 * 3 * 5) * (9 * 7) 5 * 2 + (3 + 5 * (5 + 7 + 7 + 4) * 2) 9 + 4 * (8 + 3 * 2 + 9 * 6 * 4) * 9 * 6 6 + (6 * (2 * 5 * 4 * 7 * 3) * 9 + 4 + 6 * 3) + 4 * 8 (6 + (4 * 7) + 6 * 5) + 4 + 7 + 2 3 + 4 * 9 + 9 * 8 + (3 * 4 + (9 * 6 * 9 * 2) * 5 + 8) 8 + (3 + (9 * 3) + (6 * 4) + 8 * 6 + 8) + 5 (7 + 6 * 3) * 2 + 5 6 + 6 + ((6 + 7) * 9 + 5) * 2 (3 * 3 * 2 * 5) + 9 * 9 + 3 (8 * (6 + 2) + 4) * 9 (4 * 6 * 6 * 3) * 9 * 4 + 4 * 4 * 9 5 * 5 + ((8 * 9 * 2 + 5) + (3 + 7 * 5 + 2) + 2 + 8 + 5) 9 + 8 * (6 + 2 * 2) + 7 + 4 * 9 7 * 8 + (9 + (9 + 4 + 6 * 6 * 9 * 6)) * 8 * 5 9 * 7 + 8 + 7 * (4 * 2 + (6 + 3 * 4 + 6 * 6 + 6) * 2) + 9 8 + 2 + (4 * 3) + (2 + 8) * 5 * 7 2 * 7 * 7 * 8 + (3 * 4 * (7 * 4) + 5 * 8) 2 * ((6 + 7 + 6 + 2) * 4 + (9 + 4 * 5) + 8 + 6 * 7) (6 + 4 * 4 + 9 * (4 + 9 * 5 + 9 + 9 * 9) + 7) * 2 8 + 9 * (4 + (6 + 4 * 3 * 6 * 6) + 7 + (6 * 2 * 8) + (9 + 5 * 3 + 3 * 3) * 9) * 9 * 4 (8 + 8 * 9 + 9 + (7 + 8 * 3)) * (6 + 4 * 7) 2 + (6 * 3 * 5 * 5) + 4 + 9 + (4 + 9 + 9) + 4 8 + 3 + 8 + (4 + 6 * 6 * 2 * 5) + 5 * 5 2 * 4 + (7 + 6 + 9 + 5 + 9 + 2) (5 * 5 + (5 + 7 + 4 + 3 + 7) * 4) + ((6 * 4) + 2 * (8 + 8 + 4 * 4) * (7 * 7 * 2 + 3) + (8 + 6 + 8 * 2 * 8 + 8)) * 7 3 * 4 * (7 + 6 * 4 + 6 * 3) * 4 + 4 + ((8 * 6 + 2 + 5 + 7 + 6) + 6) 9 + (9 * 7 + 2 * 9) + 8 + 6 4 + 6 + 7 + 6 * 3 5 * ((4 + 4) + 4 + 7 * 9) * 6 9 * 6 + 6 + (4 + (5 + 9 + 2 + 9 * 5 + 8) * 4 * 8 * (3 * 4 + 7 * 6 * 3) + 7) * (4 + 4 * (6 + 7 * 6 * 7 * 9)) * 5 6 + (2 + 4 + 6 + 6 + (8 * 7 * 2 + 6)) + 5 + 9 + 2 + (8 * 7 * (9 + 8 * 6 * 6 * 7 * 3)) 6 + 9 + 7 + 8 + (8 * 6 * (5 + 5 * 7 + 3) * 8 * (4 + 8 * 2 + 9)) (9 + 3 + 8 + 4 + 8 + 4) * 6 * 3 * 6 5 * ((5 + 7 + 2 * 3 + 4 + 3) + 3) + 6 + 4 2 * (8 * 4 + (9 * 3) * (7 + 2 + 3 * 4) * 7) * (6 + 9 + 7) + 5 + 4 + 7 9 * (9 * (8 * 9 + 5 * 3 * 2) + (9 + 7 + 8 * 8) * (9 * 7 + 6)) * 3 * 3 + 8 * 6 5 * ((2 + 5) * (8 + 2 * 6 + 6 + 3) + 9 + 3 + 9) * (7 * 4) + (3 * 7 + 8 + 5 + 2 + (7 * 7 + 6)) + 4 * 7 (2 + 8 + 6 + 6 + 8 + 3) + 5 + (5 + 7 * 8 * 5 + 5 * (2 * 4 * 2 + 2 + 6)) 5 + 6 + (9 * 7 * (6 * 8 * 4 + 7 * 2 * 4) + 3 * 5) + 4 + (2 * 4 * 6 * (9 + 6 + 7)) 5 + 6 * (7 + 5 * (4 * 3 * 9)) 6 * 8 + 4 + (2 + 8 * 6 * 2 + (5 + 9) * 3) + 6 (7 + 5) * 7 + 5 * (6 + 4 * 9 + 6 * 2) 9 * (9 + (5 + 9 * 7 + 7 * 2 + 2) * 9 + 8 + 5 * 6) + (5 + 5 * (2 + 4 + 7 + 9 + 6) + 2) * 9 * (3 + 5 + (8 + 2 * 2 + 7 * 7 * 6)) 7 * (7 + 3 * 8 * 9 * 9 + (5 * 2)) + 5 9 * 9 * (8 + 3 + (2 + 9 + 6 + 6)) * 4 + 2 + (2 + 9 + 6) ((9 * 4 * 9 * 3 + 2 * 5) + (7 + 2 * 4 * 3 * 6 * 8) * 7) * 3 * 9 (3 + (8 + 6 * 6 * 5) + (3 * 5 + 8 * 5) + 7 * (2 + 3 * 7)) + (8 * (6 * 8 * 5 + 8 * 2)) + 8 4 * 4 + 5 * 8 * (2 * 2 + 8) * 8 7 * 8 + (5 * 4) * 7 + 2 + 9 ((4 * 9) * 4 * 8 * (4 * 6 * 5 * 2) * 5 + 9) + 7 * 2 + 8 ((4 * 3 * 9 + 7 * 7) * (7 + 3 + 7) + 9 + 6 + 8 + (3 + 2 * 6 * 2 * 9)) * 2 + (7 + (9 * 9) + 6) * 3 + 6 8 + (9 * 8 + (2 + 3 * 3) + 4 + 4 + 4) + 4 * (5 * 4 + 4 * 6) * 7 + 8 9 + 8 * ((2 * 5 + 7 * 2) + 3 * 4 * 3 * 8 * (2 * 6 + 6 + 3 * 5 + 6)) + (8 + 9 * 8 * 2 * 3 * 9) 8 + (9 * (8 * 5)) (5 * 4 * 9 * 3) + 7 + (3 + 7) 3 * (2 * 8 + 2 * (8 * 3 * 8 + 8)) * 7 + (6 + 7) 3 + 4 2 * 8 + ((8 + 9 + 6 * 7 * 4 + 5) + 2 + (5 * 2 + 8)) * 4 + 2 2 + 5 * 7 * 4 * (3 + 9 * (4 + 5 * 7) + 4) + 5 5 + 7 * (6 * 9 + 9 + 5 * 3) + 8 4 + (8 + 6 + 5 + 5 * (2 + 6) * 5) 5 * 4 + 3 + ((4 * 5 * 7 * 6) + (7 * 7 + 6 + 8 * 9 + 4) + 5 + 2 * 7 * 5) 9 * (8 + (4 + 9 * 8 + 7 * 3) + 3 * 9) + (7 * 7 + 5 * (5 + 7 + 3 * 9)) 4 * 6 + (2 + 6) 6 + 2 * 2 + 4 4 + 9 * 7 * (2 + 5 * 4) * 9 (2 + 4 * (2 * 9 * 4 * 8 + 5 + 4)) + 4 + (8 * 7) + 7 + (3 + 5 * 7) 9 * 8 * 8 * (6 + 6 * 2 + 5 * 7 + 3) + 6 + 8 (3 + 9 + (7 * 2 + 2 + 3 + 2)) + (4 * 6) ((6 + 3) + 3 * 8 + 7 * 7 + 8) + (9 + (8 * 6 + 7) + 2 + 5 * 4) + 5 + 3 8 * ((5 + 2 * 9 + 2 + 7) * 7 * 7 + 7) * 4 + 8 + (4 * (3 * 9 + 3) + (2 * 9 * 4 * 9 * 7 + 6) + 6) * (8 + (2 + 5 * 3 + 8) + 4 + 8) 5 + 4 + 7 * (4 + (5 * 5 + 3 * 3 + 8 + 7) + 3 + 8 * 6) ((9 + 5 * 5 * 6 + 4) + (2 + 2) * 2) * (9 * 9 + 7 * 7 * 6) + 9 + 6 + 2 + (9 * (5 * 9) + 3 * 5 * (5 * 2 * 4 * 7)) 2 * (9 * (5 + 9 * 2 * 9) * 9 + 6) * (2 * 6) * 5 + (3 + 9 + 4 + 6 + (4 * 5 * 7 + 6) + (6 + 7)) * 7 3 * 8 * 8 * 9 * 2 + 3 6 * 8 * 6 + (2 + 7) + 5 (6 * (3 * 4 + 6 + 9) * (2 + 8 + 3 * 8 + 3 * 2)) * 7 * 9 * 7 8 + (4 + 9 + 2 + 9 * 2 + 9) 5 + 7 + 6 + ((2 * 2 + 7 + 3 + 9) + 2 + 8) * 7 (3 * 2) * 2 * 7 * 5 9 + ((4 * 3 + 3 * 6 * 2 * 9) * 5 * 7 * 3) * 4 * 7 * 2 (2 * 2 + 9 + 7) + (6 + 4 * 9 * 5) + 6 * 8 * 3 + 8 8 * 8 + (7 * 9 + 6 * 7 * (2 * 2) * (4 + 2 + 8 * 2 * 3)) + 4 (3 * (7 * 9 * 6) + 2 + (2 * 6)) * (4 * 3 * 7) 2 + (2 * (6 + 9 + 9 * 6)) * (7 + 7 * 3 + 8) + 7 + 3 9 + (5 * 2 + (8 * 4) * 7 * 5) + 9 + 4 2 + 4 * 4 + 8 * 3 + 5 8 * 2 * (8 * (7 * 3 * 5 + 7) * 5 + 6 * 4 + 9) * 8 * 2 * 8 ((7 + 4) + 7 * 3 + 6 * (3 + 6 + 8) * (5 + 4)) * 2 * (7 + (2 + 3 * 5) * 5 + 3 + 6) * ((6 + 3 + 4 + 2 + 3) + 4 * (3 * 7 + 2)) (2 + (3 * 8 * 2)) + 2 * ((3 + 6 + 3 + 7) * 5 * (9 * 2 + 6 + 7 + 3)) (6 + (7 * 2 + 4 * 9 + 5 * 2) + 4 + 8 * (4 * 8 * 5 + 7) + 9) * 7 + 2 * 9 2 + (6 + 4 * 2 + (7 * 2)) * (8 * 6 + 6 * 4 + 5 * (5 * 4 + 9)) (6 * 3 + (5 * 8 * 4 + 7)) + 7 * 7 + 9 + 9 + 7 (2 * 9 * 7 * 5 * 7 + 5) * 8 + (8 * (9 + 9 * 8) * 7) * 4 + 5 6 + (3 + 8 + 4 + 9 * 7) 4 * 8 + 2 ((8 * 8 + 4 + 9) + 9 * 7 + 8) * 8 * (5 + 7 * 5) * 2 + ((3 * 2 + 6 + 6 * 3) * 8 + 9 * 9 * (9 * 6)) + (4 * 8 * (5 + 8 * 5 * 8) * 6 * 9 + 8) (3 * 6 * 7) * (4 + 8) + 9 6 * ((9 * 3 * 4 + 9 * 2) + 7 + 2 * 6) 6 + (7 + 8 + 2 * 5 * 2) * 7 + (5 + 3) * 7 7 + ((6 * 8 * 6 * 3) * 9 * 3) + 9 + ((3 + 4 * 2 * 6) * 4 * 3) + 5 + 3 (4 + 3 * (5 * 2 * 2)) + 5 4 * 3 * (6 * (4 + 3 + 9 * 3)) + (4 * 2 * 5 + (9 * 2) * (6 + 8 + 9 + 6 * 8 + 8) + 2) + 6 + 8 7 * 5 * 9 + 7 + (5 * (9 + 8 + 3 * 6 * 3)) * ((3 + 5) * (7 + 9 + 3 + 6 * 2) * 3 + 9) ((3 + 3 * 9 + 4 * 8 * 2) + 6) + 2 * (5 * (2 * 5 * 7 + 8 + 6) * 2 + 8 + 3 + 6) + (4 + 6 + 4) (2 * 8 + 8 + 4 + 3 + 5) + 7 6 + (6 * 5 * 9 * 6) 8 + 2 + 6 + 3 + (9 + 6 + (7 * 3) + 5 + 4 + 8) 6 + 7 * (3 * 7 * 5 + (9 + 6 + 6) * 7) * (3 + 4 + 7 * 4 + 6) * 4 * 4 9 * 9 * (4 * 4 * (3 * 2 * 2 + 4 + 7 * 3) * 7 * 5 + (7 * 4)) + 5 9 * ((6 + 3 * 6 + 2) + 4 * (9 * 8 + 8)) + 5 * 6 * 4 + 4 (8 * 9 + (8 + 5 + 8 + 5 + 3)) + 3 + 6 * 4 * 2 * 4 8 + (3 * 6 * 7) * 4 * 4 * 3 (6 * 8 + (2 * 2 + 3 * 8) + 6 * (4 * 9)) * 6 * (2 * 8 + 7 * (8 + 9 + 6 * 9 + 3 + 3)) 3 + 8 * 2 + (8 * 3) 4 + 3 * 2 * (5 + 3 + 5 + (6 * 5 * 3 * 6 * 6)) + 9 + 7 (3 + 5 + (3 + 9 + 9 + 7) * 7 * 6) + 7 * 5 * (5 + 3) 2 + ((7 + 2 + 9 + 2 + 6) * 3 * 2 * 5 * 5 + 2) + 2 6 * 8 * (2 + 4 * 9 * 5) + 9 + 3 4 * (6 + 9) 5 * 2 + 3 * 2 * (5 * 3 * 9 * 7 + (6 + 4 * 5 + 6) * (6 * 2 * 2)) * (9 + 6 + 9 + (8 + 9 + 9)) 5 + (4 * 4 * 5 * (4 * 2 * 4 * 2) * 7) * 2 3 * 2 + ((4 * 6 * 8) + 9 * (3 * 9 * 8 * 2)) (3 * 5 + 6 * 8) + 5 + ((2 + 9) + (3 + 4 * 2 * 5 * 3) + 4 + (3 * 7)) * 6 6 + 3 + 2 + 4 + (6 * 2 + 6 + 4) * 2 (5 + (5 + 6 + 7 * 2) + 7 + 4 * 5) + 5 * 6 * 9 4 * 7 * (3 * 2) + 4 (5 + 4 + (8 + 3 + 7 * 2)) * (6 + (5 + 7 + 3 * 8 + 4) * 5 + 6 * 6 * 5) + 7 2 * 5 + (5 + 4 + 3) + (9 * 3 + (7 * 6 * 9 * 4 * 3 * 2)) * 3 + 2 (8 * 2 + 3) + 5 * 2 * 9 + 9 + (3 + 4) 9 + 6 * ((4 * 7 * 9 * 5 * 4 * 5) + 8 * 8 * 7) * 7 5 * 4 + ((3 + 2 * 5 * 6 + 7) + 7) + 2 3 * 9 + 4 * 9 9 + 7 + (7 + 5 + 3 * (5 + 7 * 8 * 7 + 5 + 7)) + (7 * 6 + 5 * 8) + (8 + (2 + 3 * 3 + 4) + (6 * 9 * 9) * 8) * 6 8 * (2 * 7 * 3 * 4) + 9 * 3 + 7 6 + (8 + (7 + 5 * 8 * 5) + 5 * 6 + (8 * 6) + 6) * 3 7 + 3 * 4 * 6 + 9 8 + 8 + ((8 * 9 + 6 + 3 * 9) + 3 + 4 * 8) 9 + 4 + 6 + 3 + 2 + (2 * 6 + 8 + 3) (5 * 2) + 4 + 7 * 9 + (5 + 5 + 3 * 5) 5 * 5 * 2 * 5 + (9 + 7 + 5) (2 * 5) + 7 5 + 7 * 9 + 3 * 5 (8 * 7 + 9 * 5) + 3 * (6 * 5 + (2 * 7 * 2 * 7 + 7 * 2) + 4) + 3 (6 + 6 + 6 + 9) + 9 + (3 * 5 + 4 + (6 * 3) * 4) * 3 + (8 + 7 * 5 * (3 * 3) + 6) * 3 ((2 * 8 * 3 + 2 * 6 * 5) * 5 + (7 * 3 + 5 + 6 * 9 * 4) * (5 * 6 + 8 + 4 * 7 * 5)) + 6 + (9 * (9 + 7 * 8 * 3) + 7 * (5 * 9 + 6 + 5 + 4 + 8) * 8 + 8) * 5 2 * (5 + 2 * 2 * 3 + (4 + 3)) * (6 + 6 + 2 * 9 + 9 * 3) * 8 * 8 9 * (9 + 3 + 8 + 5) * (2 * 5 * (6 + 8) * 9) * (4 + 3 * 8 * 9 * 4 + 4) * (3 * 9 * 8 + (6 * 6 + 9 + 5) + 2 * (8 + 2 * 7)) 2 * 5 * 9 * 8 * ((7 * 2 * 3) + 3) 2 * (6 * 7 * 2 * 4 + (5 * 4 + 7 + 3 + 7) + 5) * (7 + (6 + 3) * (8 + 8) * 3 * (5 + 2)) * 3 * 8 * 7 2 * 5 * (4 * 9 + 2 + 5 * 2) + 6 * 5 + (6 * 6 * 4 * 8 * 4) 4 + 8 * 4 + 4 * 3 + (7 + 2 * 2 * 5 * 2 + 8) (8 * (4 + 5 + 9 * 9 + 8) * 4 + (8 + 7 + 9 * 4 * 4 + 3)) * 7 * 8 * 3 8 * 9 + ((2 + 5 + 8 * 9 + 5) + 2) * 7 * 4 + 5 3 + (5 * 8 * 6 * (7 + 4 * 2 + 2 * 4 * 2) + (9 + 6) * 9) + 4 9 * 7 + 4 + (7 + 9 + (9 * 9 + 8 * 4 * 5 * 8) + 5) + 3 2 * 2 + 6 + (3 * 9 + 6 + (4 * 4 * 6 + 2 * 5)) * 5 6 * 3 * (3 + 8 * 7) + 9 7 * 2 * 6 * (3 * 3 * 8 * (2 + 7 * 9 + 8)) 9 * 7 + 6 * (7 * (3 + 6 + 7) + 3) + (9 * 6 + (2 + 9 * 3) + (7 * 8 * 8 + 6 * 3 * 5) * 9) 3 * 4 * 4 * 6 + 2 + (6 * 3) 4 * (5 + 7) + 8 5 * 3 * 9 + 9 + 9 * 2 8 + (8 * 9) * 7 + 6 * 9 9 + 9 * (3 * 8) * 3 + 2 6 + (8 + 6 + 2) * (9 * 9 * 8) 5 + 4 * 3 + (2 * 2 * (2 + 3 + 4 + 7 * 3) + 5 + 3) + 6 9 * 2 + 3 * 8 * 9 5 * 2 * 7 * ((5 + 6 * 4 + 6 + 3 + 5) * 7 + 9 + 4) * (7 + 3 * 7) 2 + ((5 + 3 * 4 + 2) * 2 * 6 + (8 * 8 + 8) * 3 * (3 * 8 * 5 * 6 + 5)) 5 + (6 + 9 + 4 + (3 * 7)) * (4 + 6 * 5 * (7 + 8 * 3 + 3 * 9) + (9 + 8 + 3)) 4 * 2 + 9 + (9 * 6 * 9 * (9 * 4 + 3 * 2 * 6 + 8) + 7 + 9) * (5 + 7 * 9 * 5) + (8 + 9 + 4 * 5 * 8) 7 + 8 * 3 + (5 + 2 * 2 + 6 * 8) + 7 8 + ((9 * 7 + 5 * 8 + 3 + 6) * 4) + 6 * 4 + 4 + 3 (6 + 2 + 4 + 7) * (2 + 6 * 7 * (4 * 3 + 9 + 5 * 5) + 5 + (2 + 3 * 5 * 5 * 6)) * 2 (6 + 9) + 4 * 9 4 * (4 * 5 + 9 * (9 + 5 * 7 * 6 * 7 + 9)) 2 * 5 + ((7 + 3 * 3 * 9 + 8 + 4) * 4 * 6) + 3 + 6 + (4 + (2 * 7) + 5) (7 + (4 * 5 + 2 + 2 * 2 + 8)) * 5 + 5 + (3 + 8 + 6 * 6) * 9 5 + 4 + 4 + 7 * (2 + 6 + (3 + 6 + 7) + 6 * 9) * (2 + 8) 8 + ((4 * 3 * 2) + 4) + 5 * 7 * 3 * 5 4 * 4 + 9 + (8 + (6 * 5 * 2 + 8 * 3 + 8) + 4 * (2 + 6 * 2 + 4 + 3 + 2) * (4 + 5)) (9 + 8 * 8 + (5 * 8 * 7 * 8 + 9 * 6)) * 9 + 5 * 2 7 + 8 * (2 + (5 + 7 + 3 + 9 * 8 + 8) * (2 * 9 * 7) + 3 + 4) * 8 + 5 + 2 5 + 2 * (5 * 7 * 6 * 4 * 2 + (7 + 2 + 7 + 9 + 4)) 6 * 8 * 7 * 8 * 9 + 9 5 + 8 + 7 * 5 * (8 * 8 * 5 + 7 + 9) + 6 9 + 2 * 3 * 5 8 * 5 + (2 + (4 + 9 + 5 * 6 + 8) + 9 * (4 + 4 * 5 * 3) * (5 * 7 * 8 + 3 * 3 + 3) + 5) 7 + 3 + (2 * 2 + 5 * 8 + 3) + (8 + 3 + (6 * 5 + 4 * 5)) 6 * ((2 * 6 + 6 * 2 + 5 + 4) * 8 + 8 * 9) * (5 * 2 + 4 + 6 * 3) + ((6 + 8 + 8 + 6 + 7 * 6) + 8 * 9 * 2 * 2 * (8 + 3 + 7 * 5 * 3)) * ((5 + 9) * 4) + 4 (3 * 8 * 5) + 8 + (3 + 7 + 2 * 3 * 8) * 5 7 + 3 * 9 + (2 * (2 + 9 + 9 + 8 + 9) * (8 * 6)) * 4 * 9 7 + 9 + (3 + 7 + 2 + 6) 4 * (6 + (3 + 6 + 3) * (9 * 7 * 4 + 3 + 4) + 8 * 7 + 4) ((9 + 6) * 3 + 2 * 5) + (6 * 5 + 4 + 3) 3 + (4 * (2 + 4 + 4 + 2)) * 4 * 7 + 5 + 5 (5 * 9 * 2 * (7 * 9 * 8) + 2) + 6 + 2 + 8 + 9 5 + 4 * 4 + (2 * 3 + 8 + 8) * 6 * (9 * 8 + (8 * 9 * 5) + 9) 3 * 5 * (8 + 3 + 7) + 4 + 6 6 + 7 * (9 + (2 + 7 + 2 * 2)) * 3 (9 * (4 * 3)) + 9 * 4 + (9 * 5 + 5 * (6 * 2 + 8 * 8) + 2) + 9 + 8 6 * 7 + 7 7 + (9 * 6 * 8 + 9 * 2) * 4 * (9 * 4 * 6 + (8 * 5 * 8)) * 7 8 + 5 + ((8 + 2 * 6) + (9 * 3 * 8)) + 7 4 * 8 * (6 + (4 + 5) + 5 * 3) (3 * 2 + 6) + 3 + 3 + 8 * 6 * 7 9 * 3 * 3 + (4 * (6 + 3) * 4) + 2 * 9 5 + 9 + 7 + 4 * (9 * 3) ((8 * 9) + (7 + 5 + 6) + 3 * (5 + 7 + 6)) + 5 + (3 * 8 * 3) * 2 9 + 6 * 5 * ((4 * 4) + 7 * 3) + (3 * 6) 7 + (8 + 7) + 4 * (3 + 3) * 7 * 9 ((6 + 7 + 4 + 7) * 7 + 9 + (9 * 7 + 5 + 7 + 7) + 9 + (7 + 3 + 2 * 6 + 9)) + 2 + (4 * 7 + 9 * 3 * 2 * (5 + 9 + 3)) * 5 9 * (3 + (9 * 9)) + 9 * 8 + 4 * 2 (8 * 8 + 6 + 9 + 8 + 2) + 6 * 5 + 5 * 4 3 + 3 + 4 * (6 * 6) + 2 * 8 (5 * 9) * (8 * (2 + 6 * 9) * 7 + 7) 8 * 5 + (8 + 8 + 8 * 4) + 3 * 8 * (8 + 6 * 3 + 4) 4 * 9 + (5 * (8 * 3) + 4) * 5 + (3 * 3) (2 + 2 * 4 * 3) + 8 * ((2 * 6 + 5 + 6 * 2) * 3) + 2 ((5 * 4 + 2 + 7 * 6) + (7 * 5 + 4) + 9 + 7 + 7) + 3 2 + 3 + 9 * 9 + (9 * (2 + 8 + 7) * 3) 3 * 7 (4 + 2 * 5) + 2 5 * 5 * (5 + (8 + 8 + 8) + 3 * 2 * 4) * 9 * 2 + 8 4 + 5 * 3 * 5 + (4 + (3 + 8 + 4) + 7) + 7 (4 + 7 + 6 + 2 * 7) + 7 4 * 2 * 4 (4 * 4 + (6 * 6 * 7 * 2) * 4 * 6 * 7) * ((9 + 5 + 9) + 8) * (5 + 8 + 2 + (9 + 8 * 2 + 9 * 8) * 8 + 3) * 6 5 + 8 * 9 + ((7 * 9 * 3 * 7) * 2 + (2 + 2 + 3 * 6 + 6) + 5 + 4) 3 * 8 + 2 + (7 + 8 + (8 + 7 + 7 * 6 + 2) + (3 + 2) + 5) 4 + 4 * 6 * 5 4 * 9 * ((9 + 2) + 4 + 2 * 5) * ((6 * 9 * 5 + 8) * (7 + 7)) * (8 * 7 + 9 + 7 * (2 + 9 + 9 + 4 + 8) + 9) * 6 (8 * (2 + 3 + 7 * 3 + 2) * 2 * 4 + 7) + 4 + 3 * 2 (6 + (2 * 5 + 3 * 2 * 4 * 7)) * 6 + 4 + 6 + 9 + 9 (8 + 8 * 6 * (4 + 3 + 4 + 8 * 2 * 4) + 7) + 2 8 + 9 8 + 8 * 4 + 4 * ((9 * 2) + 2) (3 + 3 + 9 * 9 + 5 * 2) + 5 + 7 2 + (7 * 5 * 2) 8 + (5 + 3 + 8 * (3 + 2) * 6) + 9 * 9 * 8 * 9 8 + (2 * 5 + (9 * 7 * 4 * 2) * (7 * 4) * 4 * 6) * 9 + 3 4 * 7 + 4 * 4 * (2 + (2 * 8 + 2 * 5 + 2) * 7) 8 * 5 + 8 + (6 * 9 * 8 * 2 + 5 + (4 * 5 + 4 + 3 + 3)) + 4 9 + 9 * 2 * 9 + (5 + 2 + 6 + 3 * (5 * 2 + 8 * 9 + 6 + 7)) 4 * 9 + 2 4 + 4 * (3 + (4 + 9 * 8 * 7 * 3 * 3) * 2 + 9) + (2 * 7) + 8 ((5 + 8 + 5 * 2 * 5 * 3) * 5 * 6 + 2) + (5 * 9 * 6 + 2 * (4 + 8 + 9 * 9 * 8 * 3) * 2) + (8 * 6 + 2) 3 + 7 + (9 * (2 * 6 + 3) + 4) * (3 + 4 * 8) ((2 * 2 + 5 * 6 + 7 * 2) * 5 + 9 + 6) * 5 (8 * 6 * (3 + 8) + 9 + 7 * 5) * 3 * 2 * 3 * 5 * 5 ((2 + 9 * 4 + 8) * (5 + 5 + 6) * 6 + 9 * 8 + (6 + 9)) * (9 + 8) * 6 * 6 + 9 + 7 (6 * 5 * 6 * 5 * 3) * 6 * 9 * 9 (5 * 4 * (5 * 3 * 3) * (5 + 6 + 2 + 2 * 9 * 3)) + (3 + 6 * 3 * 3 + 3 * (8 * 5 + 3)) * (9 + 3 * 9) + (7 + 4 + 3 * 8 * 8) (4 + (9 + 2 * 3 + 9 + 6) + 2) + 2 * 7 * 5 9 + 8 + (3 + (7 * 7 + 2 * 8 + 6 * 2) * 8 * 6 * (9 + 7 + 4)) (7 + 3) * 7 * (4 + 4 * (2 + 3 + 4 + 6) + 7) + 6 + 2 (8 * (5 * 9 * 6) * 3 * (7 * 5)) + 5 + 3 (2 * 6 + (7 + 5) * 7 + 3) * 5 + 3 * 2 ((9 + 4) * 6 * 2 * 3 + 6) * ((2 + 6 + 4 * 7 + 4 * 7) * (7 + 9 + 2) * 2) + 7 * 2 3 * (9 + 9 + 5 + (9 + 7 * 7 + 8 + 2 + 6) + (9 * 8 + 8 * 8 * 7) * 3) + (7 + 9 * 4 + (6 + 4) + 2) + 9 9 + (2 * 5 + 9) + 9 + 7 3 * 9 + ((2 + 4 * 4) * 3 + 5 * 3 * 5 + (4 + 8 * 3 * 4)) + 6 * 5 3 + (7 * 2 + (4 + 6 * 6)) * 2 + (4 * 5 + 2 + 6 + (7 * 6 + 6 + 7)) * 6 + 9 6 + 5 * (3 + 5 + 2 + (9 + 6 * 3) + 3 + 7) * 3 4 * ((4 + 4 * 8 + 7 + 2 + 4) * (4 + 4 + 8 * 4 + 4 + 3) + 9 * (6 * 4 * 9 * 9) * 2 * (6 + 6 * 9 * 3 + 4)) + 7 9 + 8 7 + (9 + (5 * 6 * 5 * 3 * 3)) 7 * 9 + 4 + 6 + ((9 * 2 + 9) * 7 * 9) + 6 ((8 + 7 * 8 * 6 * 9 + 2) + 4 + 6 * 9 * (5 * 6 * 9 * 8) * 7) * 5 + 5 2 + 2 * (4 + 3 + 6 + 4 + 5) * (7 * 5 * 5 * 6 + 4 + (6 * 8 * 4 + 7)) (3 + (9 + 2 * 3)) + 2 * 7 (5 + 8 * 5 * (9 * 6 + 4 * 6 + 5)) + 5 * ((3 * 9 + 7) + 9 + (2 * 6 * 4 * 3 + 4 * 4) + 7 + (5 * 4 * 9 + 9 * 7) * 5) ((7 + 2 * 5 * 3) + 4) * 8 6 * (3 + 7 * (2 + 6) + 6 + (9 * 8 * 7) * (5 * 4 + 7 + 8 * 8)) + 6 * 6 (6 + 9 * (2 + 2 * 2 * 3 * 7 + 8) * 3 * 5 * 4) + 2 5 + 2 + (9 + 4 * 7 + 3 + 8) * (4 + 8 * (3 + 2 * 7 * 4)) + 8 + (4 + 5) (8 * 9 + 9 + 4 * 5) + 2 * 2 * 9 + (3 + 9) + 5 4 * 7 + ((5 + 7) * 3) * 9 * 9 6 + 6 * 4 * ((8 + 9 * 7 * 3 + 9 * 8) + 4) * 3 * 4 4 * (6 * (9 * 9 + 4 * 2 * 3) * 2) + 8 * 5 * 3 7 + 4 * (8 * 2 * 2 * 3 * 8 * 8) * 7 + 2 + 5 8 * ((2 * 3 * 5 * 9 * 2 + 6) * 4 * (7 + 3 * 4 + 7 * 5 + 5) * 3) * 7 + ((9 + 8 + 5) * 8 * (5 * 8 * 9 + 3 + 9) * 5) 5 * (7 + 2 + 9) + 9 * (5 + 8) + 3 * 6 6 * ((9 * 5 + 7) * (8 + 9 + 9 * 7 + 3 + 4)) ((7 + 2 * 6 * 5) * 7 + 2) * 8 * 7 9 + ((7 + 8 * 9 * 4 * 4 + 6) + 8) * (9 + (7 + 2 + 6 * 3)) (3 + 6 * (6 * 9 * 4)) + 6 + 5 * 9 + (4 * 6 * 8) * ((7 + 2 * 9 * 4 + 4) + 9 + (6 + 2) + 5) 2 + 4 + 6 + 2 * ((8 * 3 * 2 + 7 * 6 + 3) + 4 + 5 + 5 * 5) 6 + ((6 * 5 * 3 + 9) + (7 + 7 * 8 + 9 * 7 + 6)) (9 + 3 * 3 + (6 * 4 * 2 * 9 + 7 + 4) * 2) * 9 * 2 4 * ((8 + 4) * 2) * (7 + 6 + 3) 9 * 2 + (9 + (7 * 4) * 9 + 8 + (4 + 4) + 7) + (6 * 6 * 3 * 3) * ((9 * 4) * 5 * (6 + 3 + 8) + 5 * 7) + 2 5 + ((9 + 3 + 4 + 2) + (5 + 3) + (4 * 2)) * 7 (8 * 7) + 9 + 6 + 7 * 9 * ((5 + 8 + 5 * 5 + 7 + 2) * 2 + 6) (9 * 3 * 6) * 4 + 5 * 4 * 3 5 * ((7 + 4 * 5 + 8) + 2) * 9 + 3 2 * 2 + ((2 * 2) * (7 * 5 * 6 + 9)) * 2 4 + ((5 * 5 + 2 + 2) * 3 * 6 + (4 * 3 * 3 + 4 + 7)) * 3 + 3 + (4 + (6 + 9) + 4 + 6 * (2 * 3) * (5 + 8 * 2 * 8)) + 9 2 * 9 + 5 2 + ((6 + 7 + 9) * 9 + 9) + 9 * 5 2 + 7 * (9 * 7 + (6 + 5 + 2)) + 8 + 5 3 * (7 * 4 + 8 * 8 * 6 * 8) + 5 + 2 8 + (5 * 2 * 3 + 5 + 8 * 3) * 3 * (9 * (2 + 8) * (7 + 3 + 5 + 4 * 9) * 6 + 5 + (8 + 9)) + 4 + 3 4 + 7 * ((8 * 5 * 2) + 3) + 2 4 + 6 (5 * (7 * 6 + 3 + 4) + 9 + (8 + 9) + (5 * 6) * 4) * 8 6 + ((7 + 5 + 7 * 3 + 8 + 3) * 5 * 2 * 4 + 5 + 4) 5 + 4 + ((6 + 6 + 5 + 7 * 8) * (2 + 4 * 3 * 8 + 3) + (4 + 3) + 2) + 9 7 * 3 + 6 + 6 * 4 * 6 (4 * 9 + 2 + 4 + 9) * 6 + 6 * (4 * 9 * (6 * 9 * 3 * 6 * 2 * 7) + 5 + 3 * 3) + 3 * 8 (5 + (4 * 8) + (5 * 5)) + (2 + 5 * 8) 9 + 3 * 3 * 8 + (3 + 4 * 2 + (6 * 7 * 2 + 4 + 6 * 9) * 4) * 3 3 * 6 + 2 + (8 * 6 * 6 + 8 + 8) * ((7 + 3 * 4 * 5) * 4 + 9 * (7 + 4 + 5 * 9 + 8 + 3) * (7 * 8 * 5 + 5 + 7 + 6)) + 4 6 + 4 + (5 + 7 * 6) 5 + 3 * 8 + 6 + 3 6 + 2 + 9 + 8 + (7 + (8 + 2 * 8 + 3 + 8) * 8) * (8 * 8 * (7 + 9 * 2 + 7 * 4) * 4 + (7 + 6 + 7 * 4 + 5)) 3 + 8 + 4 + (8 + 7) * ((7 + 5) + 8 + 4 + (9 * 7 * 8 * 6) + (7 + 6 + 8 * 3)) + 5 4 + 2 + 6 * (8 + 2 * 2 * 7) * 2 * 8 2 + 6 * 4 + 6 + (8 + 4 + 6 * 8 + (6 + 4 * 9 * 8 * 3 + 6) * (3 * 5 * 2 + 2 + 7 * 2)) * 3 6 + 6 * 4 + ((9 * 8 * 5) * 4 * 9 * (2 + 9 * 4 + 8 * 8) * 7) 3 * 3 + (2 + 9 * 6 + 3) * ((3 + 2 * 2 + 8 * 8 * 3) + 8 * 9) * 4 + 9 (2 * 7 + 2 * 2) * 8 + 6 5 + (3 + 9 + 3 + 9 * 4 + 6) + 3 * 7 * 5 * 5 ((9 + 7 * 4 * 5 + 6 * 8) + 5 * 3 * (2 * 7 + 3 + 5 * 4 + 9)) * 5 * 8 7 + 2 + (5 + (8 + 2 * 2 * 9 + 6) * 4 + 2 * 5) * 3 + 5 7 + (8 + 6 * (9 + 6 * 3 * 9 * 8 + 7)) 7 + 2 + 7 * (9 + 4 + 3 * 3 + 9) 7 + ((5 + 7 * 4 * 3) + 4 * (9 * 5 + 2 * 5 * 6 + 2)) * 3 * ((3 + 3 + 4 + 8) * (4 * 5 * 7 * 4 + 9) + 8 + 3) * 7 (3 * 9 * 8 + 8 + (5 * 3 + 6 * 3 + 2) + (8 + 9 + 3)) * 5 * 4 * 4 * 3 9 * 6 + (9 * 6 + 3 * (7 * 4 * 2 + 9) + 3) (3 + 6 * (6 * 5 * 8 * 9) + (7 + 5 * 5 + 5 + 8 * 8)) * 6 + (9 + 8 + 7 * 5 + (8 + 3 * 4 + 8 * 9) * 7) * 8 + 6 (9 * 7 + (4 * 8 + 9 + 6) * 3 * 7 * (9 * 7)) + (5 * 9 * (3 * 4 * 7 + 6) * (8 * 9 + 5 + 2 + 9)) 5 * (8 * 3) + 9 * ((8 * 3 * 4) * (6 * 2) * 3 + 6 * 6 * 8) * ((2 * 3 * 6 + 4 * 2 + 5) * 8 * 6 * 2) 3 + (4 * (6 + 5 * 3 + 9 + 3) * 2 * (8 + 7 * 8 * 7 + 5) * (8 + 8)) + (8 * 5 + 8 + 6 * 9 * 4) + 8 * 4 + 3 (3 * 6 * 7 * (3 + 7 * 4) * 8 * 8) * 5 + 6 * 6 + (4 * (9 + 5 * 8 * 9 * 6 * 6) * 3) + ((7 * 8 * 6 + 2 + 5 * 6) * 2 + 3 + 5 * (3 * 8) + 6) (2 + 4 * 9) + (7 + 2 + 7 * 7 * (3 + 8 * 4 + 2) * (7 + 5)) * 9 * 7 4 + (8 + 2 + 5 + 2 + 9 + 4) + 7 + 6 * 4 3 * 8 + (8 + 5) * (7 + 5 + 6) 5 + (5 + (7 + 5)) * 8 * 6 * ((9 + 3 * 2 * 5 + 2 + 9) * 2 + 5 + 3 * 6) * ((2 + 2 * 9) * 6 * 8 * 7 * (4 * 5) * 6) 7 + 3 * 6 + ((5 + 2 + 6 + 5 + 5 * 4) * 4 * 9) 5 * 4 + 8 * 3 (8 + 6 * 6 + 5) + 9 + (6 + 3) + 7 + 6 ================================================ FILE: advent-of-code/2020/inputs/19 ================================================ 2: 12 16 | 41 26 55: 92 16 | 84 26 107: 48 26 | 29 16 91: 16 86 | 26 120 56: 19 16 | 30 26 33: 69 16 | 127 26 65: 112 16 | 76 26 23: 16 16 | 44 26 102: 16 116 | 26 132 39: 16 26 | 26 26 40: 23 26 | 76 16 108: 16 53 | 26 51 22: 110 26 | 55 16 42: 1 16 | 47 26 14: 112 26 | 46 16 117: 115 26 | 76 16 120: 26 6 | 16 59 72: 26 130 | 16 66 131: 102 26 | 20 16 93: 16 16 | 26 16 58: 97 26 | 104 16 69: 26 88 | 16 46 54: 76 16 | 116 26 1: 26 64 | 16 28 48: 13 26 | 61 16 92: 85 26 | 117 16 49: 124 26 | 98 16 6: 44 44 24: 112 26 17: 112 16 | 116 26 115: 44 16 | 16 26 113: 16 128 | 26 89 106: 26 132 | 16 6 16: "b" 67: 44 16 | 26 26 104: 44 88 41: 26 132 | 16 76 38: 16 59 | 26 46 89: 16 24 | 26 62 80: 18 26 | 35 16 98: 46 26 101: 16 132 | 26 46 85: 16 59 126: 16 67 | 26 59 9: 26 49 | 16 80 10: 26 67 | 16 59 34: 26 93 | 16 23 4: 70 26 | 107 16 100: 123 26 | 63 16 109: 118 16 | 54 26 77: 16 50 | 26 99 88: 26 26 | 16 16 81: 67 26 18: 16 115 | 26 88 123: 57 16 | 103 26 60: 26 18 | 16 43 94: 26 23 | 16 59 0: 8 11 57: 46 16 | 125 26 110: 26 58 | 16 60 20: 44 76 15: 56 26 | 33 16 114: 26 132 | 16 23 7: 16 6 | 26 115 28: 16 3 | 26 25 51: 112 16 | 23 26 43: 88 16 | 116 26 111: 26 6 | 16 93 62: 26 132 | 16 112 76: 16 26 | 26 16 27: 96 26 | 45 16 50: 26 93 | 16 76 132: 16 26 35: 16 115 | 26 132 53: 16 46 | 26 116 75: 104 26 | 81 16 82: 26 9 | 16 100 78: 26 116 | 16 125 19: 16 39 | 26 132 37: 26 41 | 16 127 45: 91 16 | 108 26 59: 26 26 | 26 16 116: 26 16 84: 7 16 | 94 26 86: 16 6 | 26 88 63: 94 26 | 17 16 103: 115 26 | 59 16 130: 16 34 | 26 20 99: 39 26 | 6 16 26: "a" 64: 16 15 | 26 21 97: 67 16 | 23 26 83: 105 26 | 27 16 21: 75 16 | 52 26 30: 26 125 | 16 112 3: 16 121 | 26 74 105: 26 73 | 16 113 125: 16 16 13: 16 88 | 26 39 32: 72 26 | 122 16 122: 16 77 | 26 2 90: 4 26 | 32 16 12: 26 6 | 16 39 29: 68 26 | 101 16 79: 106 26 | 111 16 61: 132 16 | 46 26 31: 83 26 | 90 16 96: 16 87 | 26 5 118: 26 93 | 16 116 44: 26 | 16 25: 37 16 | 71 26 52: 10 26 | 7 16 124: 125 16 | 6 26 66: 26 36 | 16 14 127: 16 116 | 26 39 68: 26 46 | 16 6 70: 79 26 | 109 16 128: 126 16 | 40 26 8: 42 71: 26 114 | 16 78 73: 129 16 | 131 26 5: 16 65 | 26 118 11: 42 31 119: 16 112 | 26 6 95: 16 88 | 26 59 87: 119 16 | 14 26 121: 35 26 | 95 16 47: 22 26 | 82 16 46: 16 16 | 16 26 129: 12 16 | 17 26 112: 26 26 36: 67 26 | 125 16 74: 16 10 | 26 38 aaaaaababbaaababaaaabbbb aabbabbabbbbbaaaababbbbbaaabbaabababbaaabababbab baabaabaaabbaaaaaaabaabb aabaaababababbbaabababaaaaaaabba babbaabaaaabbabbabbaabba aabbabbbaaaaaaabaabaabaa aaabaabbaaabaabbaaaaababaabaabbabbabaaababaabaabbaabaabbaabaaaabbabababa abbabaabbbaabbbbaabaababaabbaabbbabbbabbaabbabbaabaabbbbbaaabaababbabbba abaaabaababaaabbbaaabbbb baabbabbaaababbbabaabaab abababbabbabbbaabaaaaaab bbabbaababbbbbbbbaababba abaaaaaaabbaaaaabbaabbba abbbbaabbabbbaabbabbbbbbaaababbaabaaaababaaabbbabaaaaabbbababaabbbaababb aabaaabbaaabbbaababbbaaaaabbaaababbbababbbabaabbabbaabbbbbabbbbbaaaababbabbabaaa aaabbbababbbabababbaabba babbbbabbbaabaabbbbaabba ababbbbbbbbaaabababbaaaabbaabaaabbbabbab bbabaaaaabababaababaabaaabababbb bbabbabbabbaaaabbbaababbbaaaabaabbaaaaaa baaaabaabbabbabbabbbbbbaabbbbbbbbbaababbbbabbaabaabababb babbaaaabaababaabaababab bbbababaababaabbbabaabbb baaababbbbbbbababbabbabaaaaabbaa baababaababbabbbabbababaabbaaabababbaaab bbbaaabbbabbbaaaaaabaabaabbbbaabbaaabbba aabbabaaaaaabaabababaabbbbbaabbaaababbbb aaababbbaabaabbababaababbbaaabbabaaaabab bbbbbbbbabbbaaaabbbbaaaa abbbbaaaaabaababbbbaabba abbbbaaaaabbbabbbbbaabbbaaabbabbabbababaababbaaa bababbabaaabbaaaaabaabaababababa aabaabbabbabaabaaaabbaaabbbbbbbabbbbbabbabbbbabb abbaaabaaaaaaaaabaaabbbaabbbaaabbaaaaabaaaabbbbaaaabbaab aabaaababbaaabbbaabbbaaabaabbbbabbbaaabaabbaababababaaba aaaaaabaabbaaaababbaabba aaaaaaaabaaabbaabaabaaabbbababaaabbabbab bbabbabaaabbababaabababb aabbbbabbaaabbbabaababaaaaabbbba baaaaaaabbbababbabbaaabaaabababbaababaaaababaaabaababaaa bbbaabbbabaaaabaaaabbbaa baaaabaabbababaabaabaaaa bbbbbaabbaaaaaaabbaaabaa aabbbbabbbbaaabbabbbbaab babaababbabbabbabbababbbaaabbbbb babbbbabbbaabaaabbbaabaa abbbbaaaabbaaaaabbabbbaaabbbaababaababbbaaaababbaaabbbbbaabaaaaa baabbbbabbbbbaabbbaabbba aabbabbbaaabaaaabbaabbbb babaabaabaaaabbaabababbb aabbabbbbabbaababbaaaaaa bbaababbababbbbbbbbbaaab bbbbbbabaaabbabbabaababbbbbbbbaa baabbaaabbabaabbbbbababb abbbbbbaaabaaabbaababbbb bababbbabbabaabbbabbaabaaabbbabaababbababbababab aababbababbbbbaabaababab babbbaaaaaaaaaabbbabaaba abbbaaabbaaaabaaababaabbaabaaaaaabbaabbaabaabababbabaaaa aababaabaabbaaaabababaab babababbaaaaaabaabababababbbabbbbbababaabaababba bbbbbabbbbaababaabaabbbbbababababaabbaba baabbbbabbabaabbbaababbb abbbbbabbababbbbbbaaabbabababbabaabbaabbabaaabbaaaaabababaabbaababbbabbaaaabaaaa aababababaaaabbbaaaabbbaaaaabbbb ababbaabbbaaaabaaaabaaab abbbbbbaaababaabbabbabbababbbaaabbaababa bbaabaabbbbaabbbbbaaabbbabbababbbbbbaabb abbababbabababbbaabaaaaa abbbaaaaaaaaabaabababbab bbaababbabababbaababaabbabbbbbabbbabbbbb babbabbabaabbaabaababbbb bbbbbaaaaabbabbabbaaaaab aaababababbbabaababbabab baababbbaaabbaababaaaabbabbaabbb aababaabaabaaaabbbbabaabbbbbbbabaabbbbaa aaaaaaaabbbbaabbbbbababaabbaabbbaaababba bbbababbbbaabbabbbababbaabababababbaaabaababaaab baababaaaabbbabbabbbabbababbababbabbaaab baabbbbaaabbbababbaaaabb bbababbbabbbbaaaabbabbab babbabbbabbbabaabaabbbbb aabaabbabbababaabbbbaaaa aabbbabbbbababaabaaaaaab aaabaaaabbbabaabaabbabaabbbabbbb aababaabbbbbabaaaaaaabba babaabbabbababbbbaabbbaabbbbbaababbbbabbbbabbbab abaaabbbbbababbbbabbbbba abbbbaaaaabbbabaaababbaa ababbbaaabbbabbbbabbaabb aaaaaaabaaaaabaababbbbabbabbbbababaabbaa aaaabbabbaaababbbbbabababbabaabaaabbbabbbbbbbabbaaabbbbbbabbabab bbbaaabbbbbbaabbaaabbbba bbbaaababbabbabbbaabaabb abbbbbbbaababbbbbbbbabbaabaabbaababbbaba aaaaaabbbbbbbababbaababbbaabbbba baaaabaaabbababaabaabaaaababbbbbbababaaabbbbbabb bbabbbaabbbaabbbbabaaabbbabaaabaabbbbbbbaaaaabba aaaaaabaabababbabbbbabba ababbaababababbaaaaabbba aabaababbabbbbabbbbaabbbabaaaaaaaabaaababaabbbbb baabbabbbbaaabbabababbaaaaaababb aaabbaabababbabaababaaab abbaaaabaaaaaabbaaabbbaa ababbababbabbabababbaaaababbabbabbbabaabbababaabbbabbbbaabbbbabbabbabbbb baaaaaaabbababbababaabbabaaaabbaaabababaabaaaaabaabbbbaa aabbaaaabbaaababbbaaabbaabbbababababaaaa aaaaabbbaaabababbaabbaabbaaaaaba bbababaabaaabaabbbbbabbb aababaabaaaaabbbabaaabaaabababbb bbbabababbaaaabbabaaabbabbabaaba bababbaaabaaaaaababbaabb aaaaaabbaaabaaaabaababab baaabaabbabaababaabbbbabaabaabbbbbbabbbabbaabbaa aaaaabaaaaabbabbbbbbbabb babbabaaaaabaaaaabbbbabb bbbbbaababbbbbbabbbaaabbabbbabbbbabbaabbbababbbb aaabababbbabbabbaaaabaababbaabbbaabababb bbaaababaaaaabaabaabbbbabbabbabbbabbbbbabaaabbba aabaaabbababbbbbbbbbaaaa aababbabbbaabaaabbabbaabaabbababbabbbbbb bababaaabbbbbaabbbbabaabbaabaaba aaaabaaaaaaaaababbaaaaabbbbababbbabbbaab aabaaaabbaaabaabaababbaa aabaababbbbabaabbaaabbba bbbbababbbabaaabbabbaabbababaaabbbbbabba aabbaaaaabbaaaababbbaabb aaabaaaaaaaaaaaabaaababaabbbabbbaababaabbaabaabbbbaabbabbbbabbaa abaaaaaaabbbabbbababbbaabaabaabb abbaaaaaaabbaaaababbbaab bbabaabbaaaaaabbabaabbba bbabaabbabbbabaababbbbba baabbbbaaaabaabaaabaabaa bbabbbbbbbaabbbaaabbaabbbbaabbabbabbbabbbbabbbab aaabababbbabbaababababababbbbabaabababaaaaaaabba aabbbaaaaababbabbbaaabbabbaaaabaabbbbaaaabbaabba ababaabbaabbbabaabaaaabbbbabbbbbbaaabbbb baababbbabbbabbbaababaaa bbbbbaaaabababababbabaab bbbbbaabbbabbaabbaaaaaba abaaabbbbabaababbabaaababbaababa aabbbbabbabaaabbbbababaaabaaaabbbabaabaa babbabbbababbbbbbaabbbbaabbabbab abababababbaaaaaaaabbbba aabbbabbbbabaaabbabbbbabaabaaaabbbbabaaaaaabbbba aabbbabbbbaababbbbbbbaab bbaaaababbbababaaaabbbbaabbbaaabbababbbb abbabbaabaaaabababaabababaaabbaaababbbbaababbabbaaabbabaababbaab aaabababaaaabaabaaaaaaabbbababbababbabbababbaaab babaabbabaabbabbbbbaabaa babbabbbbbaabaaabbbbbabaabbbabbabbaaaabbabbbabaabbbaaaaa bbbababaaabaaabbabababaabaaababbbabaaaaaabbaabba baabbabbababbbaaaaaabbaa aabaabababbbbbaabaababba ababbbaaababbbaaaaabbbaa abbabbbabbaababbaababbbb aababaababaabaaabbabaaababaabababbabbbab aaaabaaaaabbbbabaabbbabbbbaababbbbbbaaab bbbbababbbbbababaaaabbaa abbbaaaabbbaaabaabbbaaab bbabaaabbbbbabaababbaaaabbbaaabbbaaaaabaabbbabbbbbabbbbbbaaaaabbaaabbbabbbbaabababaaabaa aaabbaabaabbababaaaaabba bbabaaaaabbbaabaaabbabaaaabbabbbaaabaabbbbaabbab bbaabaaaaabbbaaababaabaaabbabaab bbbbababababaabbbaaababa baabaaaaabbababaaababaabaabbbabaabbabababbababbaabaaaabaabbbbaaaabaabbbbbaabbbbb bbababaaababababbababaaabbbabbbaaaaababa bbaabaaaabbbbbbbaaaabbbb aabaabbaababbbbbbaaababb abbbaaaaaabbabbababaaabaabbabaabababaaaabababbbb abbbbbaaaaaabbabbbabaaabbaaaaaaabbbabbab bbabbabbbbabbabbaabbaabb aabbabbababbaababbbabbba abababbabaababaababbbbaababbabab bbababbabbaabbbbbbbaaaaabababaabaaaaabba abaaaabbbaabbaabbaabaabb ababbaababbabbbaabaababa abaaaabaaabbbabbbaabbaaaababaaaabbbabbbabbaaaaaa aabbababbbabbbaaabaabbba abbabbbaaaaaabbbaabbabaabbaaabbbababbabbabaaabba aabbbabaaaabbbabbabbbbbabbabaabbabaababa babaabbaabaabaaababbabbaababababaabababa abbaaaaaaaabbbabbbaaabbbbaaaaaba bbaaabbbbbaaabbabababbab aabbababbbbaabbbaababbba abaaabbaaabaabbbbaaaabab babbaabaaabbbbabbaaabbaabbaaaabb bbabbabbababbbaabbaababa babbbababbabbbbabbbaabbbbbaaaabaabbbababaabbabbabbabbaaababbbbaaaabaaaabbbaabaabaaabbabb bbabbabbbbbbbbabbabbbbbb bbbaaabbabaaabaaabbababbbabababbbbabaaabaaaababb babaaababbaababbababbababbbabaabbbbbbabbabbaaababbabaabaaababbaa aabbbbabbaaaabbaaabaabbabaabbabbabbbaaabaaaababa abbaaaaaabbababbbbbbbabb baabbbaaabbaababbbbabbaa ababbabababbbaabbbaabbbb abababbabaabbbabbaababaaababaabbbbbabbaabbaabbababbabbababbbbabbaabbbaaaaabbaababaabbaba aabaababababbbaabbaabbab babaabbabbbbaabbaababbaa baabbaabbbbbbababaabbaaaabababaabaabbbabbbbbabaa abbabababbaabaabbbaababa baababbbaabaaabaabaaabbbaabababa bbabaabbbbbbbaabbabaabbb babaabbaabaabbbaaabaabbbbabbabaababbabbb babaababbbaababbbbaabaaaabbbbabaabbabbbbaaaabbba ababaabaababbbbaaaaabbba aabbbabbaabbbbabaabbabbbabbbaababaaaaaaaabbabbbb aaabaaaaaabaabbaaabaaaaa abbababbabbbaababbbaabba abababbababbbbabbaaaaaab aaaabaabaaabbbabbbaabbab abbbbbbbbaababbbbabbabab ababaabbbbbbbbababbbbaab aaaaaaabaabbabababaaaaaaaaabababbabbbbaa bbaabaaaaabbbabbbaaabbba baabbaaababbabaabbbbaaba bbbaabbbabbabbbabaaaaaab aaaaababbbbabbaababbabababaabbab aaabbbababbbabbaabaabbbb abababaaabababababbaabba ababbbaaabbaabaaabbabbbb bbabaabbbaabbbbabaaabaaa ababbaabaaaabaabbbbbbbab baabaaabbbaabaaaaabaaaabbaabbbabbbbabbbbaabababb abbaabbbabaababaabaabaaaabbbaaaababbaabbbabaabaa aababbabbababaaaababbbba bbabbabaabaaaaaaabaaaaaabbaababbaaaabbaababbbbaabbabbbbaaabbabaa aaaaaaabbbaababbababbbaabbabbabaaababbaabbabbbbbaabababa aaabaaaabaaabaababaabbab baaaaaaabaabaaababaaaabaaabbaabb bbaabaabaabaaaabbbbbaaab abaabbbaaaabaaaaabbbababaaabaaaaaaaabaaaababbbabbbababbaaabbabbb abaaabbbabbbbbabbabaaaaa ababbababbbabaababbbbabb babaababaaaaaaaaaaabbbabaaaababa aabaaabbaaaaabbbaaabbaba baaabbaaaabaaababaababaaaabaaabaaaabaaaaabbbaaba aaaaabbbbabbaabaaaabbaabbbbbbabb aabbbbababbbaaaabbaaaaab bbbabaabaabaaaabbabaaaaa abbbbaaaabbbaabaabaabbbb abbaaaaababbaaaaabbbabbabaaaaaba abbbaabaabbbaababbababab bbbaaabbbaabaababaaabbab aabaabababbbaaaabbbbaaba baababbbbaababbbbabbbbabbbbababbabbbbaab bbbbababaababaabbbbbbaaabbaaaabaabbbbaaabbbabbba baaabbaabaabbbabaaaaabaaaabbaabb aabaaababbbabababbbabbbb aabbaababaabbbbabaaaaaba aaaabbababbaababbabbbabb ababababaaaabbababaaabab aaabaabababbbbababbabbbbaabbaaabaabaaabbbbbababbabbabbabaaabbbba aabaaabbaabaaabbbbbaaabbbbbabaaa bbbaabbbbabaaababbbbbbabababbbbbaaabbabbabbabbaa abbaaaabbaabaababbbaaaab baaaabaaabaaaabbbbabbbab bbabbababbbbbbbbbabaabbb babaaabaaabbabbabbababab bbabbabaabbbababbbbabbba abaaaabababbbaaabbabbabaaabaaabb aaaabbabaaaaaaabbabbbaba abaaaaaabaabbaaababbbbabaabbabbabbbaaaaaaaabbbba ababbabaabbbbbaaaabaabaa abbbaababaaababbaabaaaaa bbbabaabbbaabbbbbaaabaaa bbabbabbbaaabbaabaaabbba babbabaabbabbaababaabbba abbababaababababaabbbbaa baabbbabaaaaabbbbabbbbbb aabbabaaaabbabbaabbbaaab abbbbbaaaabaaaabbbbabbbb bbbaabbbbbbbabaaababaaaa ababbaabbbaababbbbaaababbaaabaabbbaababbbbbbbbaa bbbabbababbbbbaaaabbbabbbbbaabbabbaaaaabbaabbaaaabbbbabaaababaaa aababaaababbbaababaabbbaaababbbabbbbbbaa babbabbbaaaabbabaaabaaab aabbbaaaaaabaabaababaaab babaaabaaabbbaaaabaabbba aabaaaababbbabbaabaababa bbbbbbaaabbabbaaabaabaabaaabbabaaaababbbabbbabbb aababaababbaaaabbabbaabb abbbaaaabaaabbaabbabababbaabaabb aaaaaabbabbaaaaababababa bbbbabaabbbaaabaaababbbb babaabababbbabbabbbabaaa bbbaaabbbaabbbbaaaabbbaa abbabbbababbbaaabaabbabbababbabbababbbbaaaabbabababbbbabaabbaaba abababbabbbaaababaabbaba aabbababaaabbbbbbbaaaabbbbbbbbababbbabaabbabbbbb abaabaaabbababbbbaaaabababaabbaaaaaabbbbbbbbaaaabbbbbbaabbaababa aabbabbaababbbbbbbbbaaaa aaaaaabbaabbababbbaaaaaa bbbaaababbbbbbabaaabbaabbbbaabba bbabbabbabbbabbabbabbbab bbaabaaabbaabbbbabbbaabb babbbaaaaababaabbbbbbabb abaaabaaabaaaabaaabbbbbb bbababaaabbbabbaabbbabbbbabbbbbaababaaba abababaabbabaabbbbaaabbabaabbbababbaabbb babbaabaabbbabbaabaabbbb baabbbbabbababbabaababba bbaaabbbaabbaaaabaaababbbabbabaabaabbbbb aaaabbabbbbbbbbbaaaabbabbaaaabbb bbbbabaaabbaababbbaabbab baaaabbaabaaaaaababbabaabaaababa aabaabbabbaaaababababbaababbabab abaaaaaabaaababbabbaaabb abbbabbabbbbabaabbbbaaba babababbbbabbbaaaabbbabbaaaaaabbbabbabbbaabaaaabababaaaa aaaabaababbbbbbaabaabbaa ababbbaaababababababbaaa ababbbaabababaaabbbbbabb abbababbaabaaabbbbbaabab babaababbababbbabbbbabbb abbbbabbabbbaabbabaaaaabbaaabbbbbabbaaababaababa baabbbbaaaabbabbbbbababb aaaaabaaabbabbbababbbbaabaaabbaabbbabbba baabaaabaabbbaaaabaaabba aabaabbabbbbbababaababbb aabbbabaabaaaaaaabaabbaa abaabababaabaababbbbbbaabbabaabbaabaabbb aabaaabbbbabbabaabaaaababbaababaaabbbaab abaaaaaabababbbaabbbaabb bbabaabbaaabaaaababbbabaabbaabba bbbbabababbbabababaababb babbaaabababbabaabbabababaaababbbbabbbbbbbabbabbbaaaabaaabbbbbba abbbbbbbbbbbabababbabbaaabbaaaababbbbabaaabbaaaaaababbbbbbaababbbbaabaabababaabbababaabbbbbbbbba bbbaaababaaaabbabaaababbababbaabbbbbbbba babbabbaaaabbbabababbabb ababaabbabbabbbabbabbbba aaabbaabababbbaaababaaab ababbbabaababbaaababbaaa baaaabaaaabbaaaaabaababa baaababbababababbbabbaaa ababbabababaabababaabaabaaaabbbbbbaaaaababaabbaabbaaaabb abbbbbaaaaaaabbbabbabaab aaaaaaabbbaaababbbbaaababaababaaababbaaa aaabbbabbabaabaaaabbbaab abbbabbabbababaaaaabbbbb abbbbabaaaaabbbaabbabaab bbabaabbaabbbaaabaabbbbb ababbaababbabbbabbabbaabbbaaaaabbbbbbbba aabaaabababbbbaabaabaabb aabbbaaabaabaaabbbbabbaa babbbaaababbaabaabbbabbbababbaabababaaba aababaabbabbabbababbbbabaabbbbabbbbbaaaaaabaabaa aabaaaabbbaabbbabaabaaababaaabababbbabbbabbaaababbaabaababbabbbbabbabaaa abbbabbbbabbbbaaaabbbabbaabaaabaabaababbbbbabaaa babababbaababbababbabaaa aaaaabbbabbbabbabbbaabba bbaabaaaabaabbabababaaab babbabaaaaaaaababaaababbbaabbbaaabaabaab abbbbbbbabbaabaabbbbbbaa aabaaaaabaaaaaabaaaaabbaaabababa abababbabbabbabbaabaabbb aabbbaaaabababbaabbaaaabbbababab baababaababbabaaaabaaabaaabbbababbbbabbabbabbaaababbbbba bbababaabaaaabbaababbababbabaaaaabbabbab abbbbbbbabbbbbaaaaaabbba bababbbabbbaaabaaabbbabbabaaabaaaabbabbbababbbbbababbbab abababaaaaaaaababbbaabaa babbabbbaabbabbbaababaaa abbaabaababaaaabbbbbabbaaaabbabbbbbababaabbbbbabbaaaaabbbbaaaabaaabbaaab aaababababbaaaabbaaaabbb aaaaaabaaaaabaabaaaabbaa bbaaabbbabbbbbbaaabbaaaaababbabbbaaabbba bbbaabbbbbabbbaaabbbbbab aabbaabaabbbababbaaabbbb bbabbbabbbaabbaaabbbbbbababaaabaabbababbaabbaabbbaabaaaabaababbb aaaabaaaabbbabaababbbbaabaaaaaba abbbabbaabaaabbbabbababaaaaabbabbaabbaaaababbbab baaabaabaabbaaaabbababbbabbaaaababbbbbab bbbbbbababaaabaabbaaaaaa baaabbaaaabaaabaaaabaaab bbbaaabaaabbabbaabbabaab babaabababbbbbbaaaaabbba aaabbbabaaaaaaaabababbab bbbbababaabbabbababbbbbb aaaaabaaaaaaaababaaaaabb aaaaaaaababbbbababbbabbaabababbb abbbbbbaaababaababbbbaab aaaaaabababaababaaaaabba aabbaaaabababbabaabaababbbaabbbbabbbaaaaaabbabaaabaabbbb ababbbbaabbabbbabbbbbaaababababbaababaaabaaaaaab bbabbabbbabaaabaaabbbbaa baaaabbaaabbbabaabaabaaabbabbababbbbbbbbaaabaaaababbbbbabaaabbabbabbbbbaaaababaa abbababaaaabababbbabbaaa babaabbabbbaabbbaaaabbaa abbbbbaaaabaabbaaabbabbaabbabaaaabbabaaa abababbababaaabaabbababaaaaabbababaaaaaaabababbaabaabbbabbaaaabb bbbaabbbababaabbabaaaaab aabaabaaabbabaabbbaaabaa abababaabaabbaababbabbbb babaabbaaaaaaaabaaaaabba bbaabbbaababaaaaaaaababa bbabaaaaabaaaaaaaaabaaaabbbabababaabbbababaaabba abaaabaaabaaaabbbaaaabab aabbabaaaaaaabbbababbbba abababaabbbbaabbaabbaaabbbbbaaaabababababababaaaabbbbaaaaaaaabbbbabbbaaa abbbabbabababbaaabaabbaa aaabaaaaaabbaaaabbaabbba aabaabbababbabbaaabbabbbababbaab bbbbbaabaaabaaabaabbaabbbbaababa ================================================ FILE: advent-of-code/2020/inputs/2 ================================================ 1-4 m: mrfmmbjxr 5-16 b: bbbbhbbbbpbxbbbcb 7-8 x: qxrxmxccxxx 9-11 k: kkkkkkktmkhk 8-12 g: sgwvdxzhkvndv 6-9 v: zvmvvmvvvd 8-19 f: ffffsplmfflffhtfrfj 5-16 p: pppppppppspppjpcp 2-3 w: wwmw 7-19 j: jjjjjjjjjjjjjjjjjjvj 5-9 q: wqzqqqqqq 14-15 g: gggggggggglggfgg 4-6 p: tppzkppdt 11-14 p: vppgpktpppppptpppqp 5-9 f: bfflffrfgf 7-9 p: ppppptbzn 1-3 l: lllvn 2-4 g: qvcdg 1-3 m: wsmdv 1-5 v: vvvvvvvv 10-14 l: lckqlgjllltlwbl 3-4 t: bsttftltjhbqbgtm 15-17 j: jjzjjjjjhjjjjjjpzjj 2-3 t: thtt 6-17 f: ffwkwzjtjktvsfmfhvsf 3-5 b: rqxbb 4-7 m: nbcmcwmmxrxqvtjfmm 1-2 v: gzvvvv 1-3 w: hkwhv 7-8 p: pppppppp 3-4 h: hhnwh 2-4 t: ttrtjtththkr 3-4 w: wwww 4-6 s: xsntgrftmpx 4-7 s: ssskssmsbs 10-15 m: bmmrbmmmmlmmmmmm 12-13 w: wqpwdmwllnjwx 5-14 n: nnnnlnnnnnnnnmnn 5-6 k: kktkfczk 5-7 r: nrdrtrvr 4-6 c: ccqchcc 2-9 l: fnldtfnbxjlvnlsnjhml 1-13 d: dlchvkccnwrcc 5-7 j: jjjjjjj 3-5 z: zzzzz 6-12 f: ffffflvmfhfx 8-10 w: wwwwwwwwww 3-4 r: rrbtr 3-11 b: bbbrbbvphbxbqk 16-17 n: nqhknnnnsnnnnnnnnnb 18-20 k: kkkkkkkkkkkkkkkkkhtj 3-15 r: ktvzqbmbrvczprfcw 9-11 q: qnqqdqqqgrrqsqq 3-5 p: pvppp 7-11 m: mfcdmmxmmmp 7-8 t: ttttktnt 5-6 b: bbpbbbv 14-16 z: zzzzzzzzzrzzblzw 11-12 j: jkjjjkjjjjjjgj 7-9 q: qqqqqqqqqq 10-11 f: cfffffffffff 4-6 c: nccccc 7-8 r: gmdlqfpwmrr 6-8 v: nvvpdnjx 8-12 x: xxlxxbbxxxxx 8-10 s: ssxssssssss 5-12 z: zhzdfzgdzzhzlz 11-12 k: qbkhvqjpqzfq 2-11 w: wwmlttwjflwdjcpclww 2-16 w: twkkmcrxmvjtwxlwsksf 6-8 s: sssfxbskvs 5-6 s: ssnsxsbs 10-19 l: ndzmdxqlnllxsbbwvsl 2-4 g: gggg 5-10 x: zxxxsxxxxxxxsxx 7-15 f: ffbrbdtzvdffktxfm 7-8 m: xmkmmmmmtmm 9-13 s: hksrdhzlsdmps 15-17 b: bbbbbbbrbbbbbbbrbb 3-5 x: xxxxxxx 2-6 t: wtltztnct 3-15 v: vvwvvvvvhvvvbwwvmdvr 12-14 p: ppphsppppppbphp 8-9 t: ttttvttttttt 2-3 c: cchvj 8-9 z: vzzzzzzgl 11-12 q: qqmqqqqqqqsnqqqqqqq 12-13 d: dddddddddddmd 8-9 t: wttttttqt 7-8 p: ppppvvcw 4-5 g: gncgj 12-13 s: sssssssssssmw 7-9 f: pswpnjftf 11-16 p: ppppnpkpkzppcpzbppp 1-12 q: ksqrqpqnqmqxqb 2-10 l: lllllllllll 17-18 z: zzzzzzzzzzzxzzzzzz 11-12 g: qggbjgggggssgggrk 3-4 s: bpss 6-8 v: vwvvvrvvv 3-4 t: tglktt 4-12 l: kvrnzqslwrdkfll 12-16 b: fbbbbbnbbvbbbbbcbbb 5-6 t: ttttzz 5-8 w: sqwhwwxw 8-9 z: zzzvztzrzzzz 3-6 l: llvdlt 7-8 r: mrcvnrrr 10-11 k: kkkkkkkkkmc 1-3 n: nnnmn 4-16 c: dqlcbclcrxkkszvcv 9-10 g: fxssmlmgbh 5-6 p: nwpfpp 3-7 w: cwhgrfshdwhwwll 14-16 l: llllllllllllllpll 3-4 f: ffff 4-9 d: dcdddxzvmrd 4-11 w: jwwnwwwwwvx 3-4 t: ttvc 4-17 r: rrsrrrrrrrrrbtrrrr 8-9 x: wqxxxcfdx 6-8 d: qgddwddtdddlc 12-13 v: vvjvvvvvzvvtvv 3-4 g: sghxg 3-4 b: ckbbmprfbbmzgqtkbw 5-6 x: xxxxxv 10-13 f: zpfffbfchxfffffjff 5-6 f: ffffwf 12-19 l: mlllllplllldllnsllql 4-5 v: vvvvp 5-8 w: vjwvghggwww 1-3 n: lnnn 16-18 p: ppppppvpppppwppppppp 15-18 z: zzzzzzzzzzzzzzjzzg 4-6 b: bbmbbb 5-7 z: wzlwzmzzzzzzzzzzzwz 8-12 p: gppmpppvppkzpcnpb 16-19 h: hhbhhhhhhhhhhhlnhhw 2-3 n: nnnn 3-10 m: mmntfkdjftmtmmbm 3-5 j: jjjjw 4-6 z: zjnzzzdzz 1-7 s: zsvsssf 6-7 v: vtvvvcg 3-12 f: qsrtmnxkvlcmt 5-11 q: mqgqqqqqrpch 5-9 g: msxkggnggg 3-8 v: vvvvhvjvdvxtr 4-6 k: jcklxdhkwhsqhq 6-7 x: vppxbhcjzxdqx 2-3 n: ntrg 7-8 g: gggwgjdhg 1-3 d: dddd 14-18 l: llllllllwlllxllllllz 8-19 g: ggggghggkhgrtzcgrrk 7-14 q: phzxvmbxxfsfwr 8-14 r: hbjmdrhnpxnwgz 15-17 d: dddddpddddldddtdgddd 6-7 k: kkkkkgkkq 2-12 w: wwzwwwwwwwwww 5-8 q: qqqqqqqzqqwqqzqcq 5-6 z: czzzrz 14-15 b: bbbrzhbbbbnxbgbb 12-13 d: dgddddddddtvddddvbz 3-5 v: vvvvv 13-16 q: qqqqqvzwqqqqqqqq 2-3 n: jpznnwfpchs 7-10 w: jwwpwkwwwpw 6-7 b: bbcnbcjxbbb 14-17 w: wqtwwwwwnwcwwbsww 3-14 w: gwwwwwwwhwwnxwwwww 4-9 w: mwllcfjfwwwjp 9-12 n: nnnnnnnhnwjnn 2-4 j: jjjjj 3-6 t: mrmttccttqt 16-17 p: ppmjpgptzgbppphfbp 12-17 v: vvvvvvvvvvvvvfvvvv 13-15 x: xxxxxxxxxxxxxxgx 2-4 d: dddddddd 2-5 t: ttmvt 13-14 j: jjjjjjjjjjjjtj 3-5 r: ggmrdf 7-8 f: ffdfflszfsfffqff 10-11 t: ttpttttttrgtt 8-12 j: jjjjqdhzjhjdj 19-20 z: zbzzzzzzzzzzzzzzzzrq 7-11 b: bbbbbhbbbxbbb 4-9 p: gzmkkbtpkzpgthklpq 2-5 b: bbbbxgb 4-13 k: kkkkkkzktckkkwkjkk 10-12 q: vrxznfqqnqgq 15-16 m: mmmmkmmmmmmmmmmmm 15-18 h: hlhhvhchthhhhtphhh 2-3 m: mftzmc 6-11 s: ksssssssssszs 5-6 q: qqqpqkq 7-8 n: nnfnnnnpn 6-8 c: chfcllrvxcnnjhtc 6-8 k: kkkkkxlk 2-4 s: tsspb 9-12 q: qqqqqqqqqqqqqq 17-20 h: hhhhhhhhhhhhhhhhhhhh 6-13 r: rrrrrgrrrrrrn 4-8 f: fffrfffz 13-14 n: nbnnnngnnnnnnpz 8-11 f: fvffsfqftcffff 3-5 w: vwhxz 8-10 x: nmxxknlptx 3-4 p: pppt 17-18 v: vvvvvvhkvvvvvnvvjlvv 10-15 z: twnsdkmgpvzfmzg 3-5 n: njnjnkghp 10-12 q: qvqqqqqqqqqq 6-7 r: rrrrrrrr 3-4 t: qltt 2-16 f: gffflcvtpfkfcjfrjvfs 3-5 s: swssp 11-13 l: lrpllllllvtslwllllld 1-3 n: nnnn 3-5 g: jjggnvg 4-5 b: bvbbb 13-15 l: llvllllllllllnll 5-6 j: hjjjjfsj 3-4 b: bkfbnb 5-8 z: zdzzzzzzzrzzz 3-4 r: rrrx 2-12 c: mczhvchkmjdrjh 12-16 x: sjxbcgdqtpfxflsxx 2-4 c: tcxf 4-5 w: kwjww 1-2 r: rrrwzc 4-7 d: ddddddkdd 5-6 q: qqqqqp 13-16 l: flljlllvnzlllllclldl 3-6 j: jjjpjj 3-4 g: gxgg 10-11 n: nnnnnnnnnnn 2-5 j: ztchj 4-6 j: pjzzrmjvhcxn 4-11 c: jchcccgccckc 11-12 d: dddddddddddd 6-7 n: nznnnnnntnnnnzpjfjnn 8-9 k: kbkkkkkkk 13-18 x: xbxxmxqxxxmxkxsxxxx 7-16 r: rrrrrrzrrrrrrrjmrrr 3-5 h: hhqhd 1-2 b: bbmb 2-3 n: rlnntn 2-8 q: qnfqnqhx 2-5 b: bjbbh 5-11 t: twtjnpttqtvtttptt 16-17 w: wtmwwhxtgwrrswwfblll 8-16 g: ggggghshggdggggcpwg 1-3 l: lsllzl 11-13 n: nnnvncnnmvnqnnnnn 6-7 s: ssqssss 10-18 t: tttnmjxttjttttttdzt 4-10 n: nkvncgtdpz 16-18 p: cphtrgffcpphfspxppgp 2-6 k: kkhgkskkm 6-20 r: fhrwtrzwrddfrndnrlgr 2-8 w: lkwnccgw 6-10 x: lxxxxxxgxwxxxrxqxx 4-9 q: tqtpgqjzdmqfq 9-12 k: kkkkkqbkkckkkjkql 5-9 r: rrrrrrrhcr 17-20 h: hhshshhhhhhhshhhbhhq 7-9 s: dngddfsss 12-13 q: qqqqqqqqqqqcq 2-6 v: vqtvvvv 8-10 c: cccfcncccccc 14-15 m: mmmmmmmmmmmmmmdm 7-14 s: ssslssfdssflvvsj 2-5 z: wcllj 2-11 n: cvnrlftcjct 8-16 k: krzkfbkkqkhnsjkjgkk 2-7 q: mvhvqnzdjw 5-8 l: lgbnlnclkllll 4-12 l: llllmllrlgllrklnlrbt 7-10 j: jjjjjjnjjcjsj 1-2 k: dgwmgsn 2-5 z: zjmxc 6-7 c: ccccccccc 14-17 k: bkkkkkkkkkkkndkkkk 2-4 x: xxjxtxbq 7-9 w: drjcfwzwwwfwwfzxww 4-5 p: pppwc 4-5 r: rrrvm 1-8 r: qrrrmrrrrr 16-18 l: llllllllldllltlklk 1-11 p: pwcpppbppppppp 5-19 w: wwwwwwwwwwwwwwwcwww 17-18 k: kkkkkwkkkkkkkkkkkxk 12-15 f: fsffffffflfqgfx 6-13 d: zddpdvddrvrdxq 1-10 f: ffffffrfkb 13-14 x: xxxxxxxxxxxxxxx 16-20 j: jjjjjjjdwjjfjjjjjjdj 8-11 r: rrrrrrrrrrrr 15-16 x: dxjxxxdxxxxxxxxxwxx 3-9 m: mjhqdgkmzmsmtdmhfn 2-7 k: kkkhwgtxlkmkqkk 11-15 m: mmgmmmmnsjmmlmmm 1-2 v: wvvk 8-14 s: zssssssssssssts 3-4 z: ztbzzr 4-10 x: xxkmqxxxxx 3-5 p: pkppppppppzpp 3-15 q: qpqmkqfqqlqqdfqtkqq 16-17 d: ddddddzbxcdddcddq 4-5 s: nqssf 4-5 s: sssbks 4-5 s: tsjlhsbsmt 1-5 z: zzzbztzf 1-4 l: pvsgtvt 3-6 b: bbbjbb 2-4 d: wkdvd 16-18 w: wwwwwwwrwwwwwwwzwkw 15-17 t: tqttjttttttttvtttt 5-9 q: qcqqqqdtqq 8-11 s: sssssssfssssssssssss 5-6 x: xxxvcpbxr 13-15 d: ddwdtctnjdcdpch 5-6 z: zzzwzzzq 3-7 v: bsphcnvwvtvphdp 3-4 q: vhcprqqgdmlfpwqqw 11-18 b: bfbbbfbbbbvhwbbbzlb 12-15 c: cccccccccccccqfcc 4-10 j: jjjjjjjjjjjw 8-14 s: ssssssspmssssssssms 6-15 b: jxnbdvxbbbcbrsbxrs 10-12 s: ssssjsssssfs 8-12 f: ffffdfkqflfpf 8-9 w: wwwwwwwwz 7-10 z: fzzlzzbtmthzzzz 2-3 k: kqzzb 11-12 s: ssssssssssls 16-17 r: rrrrhrrrrrrrrrrnr 3-11 b: czpbpbzswgcddm 4-8 z: cnzztzgzqz 18-19 m: mjmmmmmmmmmmmmmmmpk 10-13 q: gqqqqqqsxqqqqdtqkq 10-11 x: nxmbxxxrgpmxxxfnxxxz 2-5 x: xbxzrxd 9-14 l: llllpljlllfllwv 1-2 m: mmmmmm 1-3 b: fblbbfbbbbbtbbgbbb 3-4 g: gnnccg 8-9 f: fffffffkffff 5-6 r: rrrrhf 7-8 l: lwlwllllllctl 5-7 j: jrjjwgjvkkncnjbqc 3-4 b: bbsbb 4-13 c: jmcczvkbxccdf 4-5 g: wgrgg 7-8 d: dgddddzh 3-8 h: hhbhhhhhhhh 15-16 l: llldllllllldlllllll 11-15 r: rrgrrrrrrrnrrgxr 10-11 l: lllllllllll 4-5 x: xfdbjsmbbcxdphvlfkxr 9-12 m: rqmnmrmhcmmms 3-8 b: tzsnnndnbwgbskbb 4-10 v: vvkvvdrvwvc 9-11 j: jjjdjjjjjsj 6-11 b: hbbmbbbbbbjbtrbbbz 13-16 v: vvpvvvbvcvvvvvvvv 11-14 j: jjjjjjljjjtjjmj 7-11 v: cvdglnvjxkvvgptxvp 1-6 t: ttjqtttzt 7-10 f: ffwpzfxjfgffzf 4-7 d: dddgddp 4-19 n: mjbdzqxhtfbnbfxrpgnh 6-13 d: ddddddddddddd 2-4 t: rhkd 5-9 c: ccrcxzjdzccx 3-4 j: fwjj 15-19 q: qqqtxqqqqqqqqqqqqqqq 1-11 c: gcccccmccctcc 3-5 d: dxhhdr 8-12 k: pkvrkkkvkkmbkcxjwktk 9-11 p: ppnpppppxppp 11-12 p: dppcsppppppqppp 7-8 b: bbbbbbmbqp 7-8 c: cbccccccc 8-9 b: bbbbbbbcrbb 2-6 z: gzlnpzpkhjwwqtswcrz 5-6 d: dddsdkd 1-5 w: dxwkgwwwwwwmwwwww 4-7 q: qqqnwqlqrqdcqpq 6-9 m: lmmmdmmvmmmm 7-8 h: hhhghhxh 2-3 j: jjjj 1-4 r: rrrw 4-7 m: mmjmmrm 4-5 j: vljjrj 19-20 j: jjjjjtjjjjjjjjjjjjgx 2-6 h: xhltfh 5-11 s: ssssjsssssss 3-4 b: bbbb 1-5 g: chgmtgnn 6-7 j: jjjjjjz 3-8 c: cccccrccccc 3-17 s: sslstssssssssspsgs 17-18 x: bxxxxxxxqxxxxxxxkwxx 9-10 q: qfqqzqqqsddqqqqqqq 6-10 k: kmkkkxvqkrk 5-9 f: kffffffffcdfffffplf 5-6 r: rrrrrz 2-5 d: hdgzt 7-10 k: zkrllwkkkjrkqfkkk 9-11 b: bbrkbbbbcbqqb 8-12 g: gfgkgggggggggggggg 12-14 s: sssjsspstlvlsrsssss 4-8 g: pqgzcgvgflgntlp 13-14 j: jjjjjjjjjjjjjx 4-6 k: kkkmqpk 3-5 j: sjjbjlvjjvjr 2-9 c: ckccjxzcrcctbfn 10-12 n: hvnnnnxnntnlnn 11-15 m: mmrmmmdmmmlmmmjqm 6-8 p: qpzrrpcpbxg 5-8 w: xwdzcgclxwsvfwtwbxnw 3-8 q: qzqzhlzc 2-3 v: hvvvvltft 5-12 s: tgvsswttkwfssnsqjsxk 5-17 b: bbbbbbbbbbbrbcbbbhb 3-6 p: ppjpzw 3-5 k: kkxvkswk 4-8 v: vbvrvxvgrvvwwvvm 3-12 v: njvvgvdcjvvtvvcnvg 4-5 n: bnnnrn 8-9 l: jlvxdlpll 12-14 w: fkwwwwwwcwwjwmwc 1-4 q: wmqrzpqhj 4-7 t: tctsttlt 13-14 h: hhhhhhhhhhhhhf 2-3 j: jmjjjjj 5-6 v: vvvvlv 5-13 v: fnxvvvvvnvqvvvvvws 16-17 l: gllllllllllgwqlll 1-2 s: pnpfsqw 6-13 g: ntzqggvbnwxrgskg 5-12 k: krxmbxqbkhxlnvdxdkkq 14-18 d: ddddddddjdddbdddddd 4-7 z: zzzzxzzs 15-18 d: dddddddddbddddpddh 8-11 x: slxxxxxjkxxxrsdx 4-6 n: nnnfzzn 1-4 h: gslcmnhhfhvz 1-4 d: tddqds 2-3 c: fccp 2-5 k: mkqrknj 9-16 g: gpggdggwgwgwglggg 2-5 h: hhjds 4-5 b: zbnvld 6-14 m: mfqmnmqtdmmzmm 7-8 j: thvcsgjn 1-5 x: xwjdxdqjtc 4-17 r: fqbrqrnpslndrmjdhpjp 4-5 c: ccccw 5-6 v: vvvvdm 5-12 n: nnqzjntfnnnd 3-4 c: nccqlccq 1-10 p: nrvvzpppqpn 9-16 v: jvvrpvvvvvzvhhvvgz 12-13 s: sjsslsssfxxkrssstkss 1-3 t: vtwbh 5-16 q: sxxfrqhqtvzbzqwg 5-9 z: dnzlhzzzsdzz 15-16 d: pdddddjddpkdddtdddd 3-4 p: pplqppp 7-9 s: scsslshsqssw 2-3 v: vxvxv 8-9 w: wqwwwwwgshww 8-9 k: kkkkkkkkc 9-10 v: vhfvvnvvtvvb 1-12 z: zzzbzzzzzzzdzzzz 6-7 b: bbbbbwhb 12-13 z: zzzsvtlzzzzzz 1-3 s: pssssssxw 8-9 w: xwwwwwwdzw 1-4 x: xxkxxx 10-12 f: fffffffpffvffff 18-19 w: wwspwwzwwqcrwwhwwww 6-8 s: ssssstsks 5-6 j: jjcjgm 2-5 p: wprwpxbdkrfpmppqpd 8-18 n: nnnnnnnnnnnnnnnnnn 4-11 c: txncpqclrlc 2-10 f: ffcffftfffxrxf 1-4 t: ttttttt 4-9 f: zdpjffffbfbl 6-7 f: kfsffffffm 1-4 b: bbdn 6-12 k: kkhkkkkdqkbkjkkkl 3-4 n: kmnn 4-11 l: kllcllldllclll 7-19 w: pfwdwdnkblwzgkfnfmh 3-9 z: zzphzdnhqwlzzwzz 15-16 h: hhhhhhhnhhhhhhhd 1-4 l: vllll 2-13 l: hdhvgdrlltlmjptzq 1-3 p: njvpltppbkxpfpppp 1-2 j: kkjv 10-11 c: ccccccmcccjcc 5-8 v: tqvmvtwvzfczvvvvw 6-9 x: xxmxxxfxxxxx 1-10 z: zgzzztmdtkzzpxztbgpp 10-12 g: ggwzjgdsgbnggl 5-6 j: jvxjvjj 4-7 x: xnxxmgxxtjxxkj 13-14 d: ddddmddddddddd 12-15 c: cccccccccccnccc 16-17 n: nnnnnnnntnnnnngnmn 1-12 m: bzckgvmmbdcxtgtmb 4-7 l: ljllllljl 5-11 w: wzvzwwrkmtwh 11-13 l: lmtpwxlllhlgllwvqnp 6-10 f: fvgkffqvcfffdbfff 3-5 j: kbfjjj 1-2 h: hhztdpbttnc 8-10 b: bbbbjbbqkbbbd 1-13 c: hccvcxtcclpckzd 6-10 w: wwwwwtwwzrwwf 2-3 j: fjnnj 2-4 j: njtjjjxrjv 4-5 w: fwwzw 7-9 k: qbnkghdbqlz 2-9 s: dsdftlzsszlf 4-5 v: vvvvd 1-2 w: fbfwwb 4-7 t: tttttmt 3-10 h: hhhhnhhhskhh 3-8 w: qwswwswfl 1-3 p: pmpgpp 2-7 n: nmmgnssmtn 2-3 j: djvjgjp 6-13 x: jxxbxxgnxvbxx 6-10 v: vrvvvvvvdz 2-3 b: bbbbjrkwnc 1-2 h: fshnf 1-5 n: htsknrzqnntknfnjx 5-9 d: kkgtwrdjmxkzc 12-13 x: xxxxxxxxxxxxx 2-10 m: wmmmmmdpmmmmh 2-12 n: xttqcmfkvnlkzskjhmzn 6-9 m: mmmmmxmkp 10-16 m: gmmdqmjmflmmmmmcmmm 13-14 p: pprprppppspxfgnptppp 1-16 b: gcnbbnbbmsjxnbppcb 10-11 d: dkdddddfjmpvdddd 1-9 f: zlfwstnzp 14-15 n: nnnnnndnnnnnrnnvcndn 2-6 l: lvvldlzdzgdf 6-10 z: zzzzztzzzhzz 13-14 n: nnnnnnnnnnnngln 8-9 z: zjqztzztqzzbxzz 2-3 v: dwcv 4-6 m: kmmmkmm 5-9 g: wtgfgdmxkx 3-5 b: vbzbf 10-11 w: wwwwwwwvwwz 2-8 s: sztstsnssq 2-6 l: lldzcslxdwghmn 1-2 n: vmznndnnnbrhknjwzkzx 3-4 k: kknp 1-5 h: hhhhhhh 12-13 z: zzzzzlszzzzzxz 1-12 m: mtbspfpdgpznrsmvgq 11-13 q: qqqqkqnqhqrqrq 14-18 d: dtdrdddddddddxfddddd 1-6 q: bqqqqqgqqqq 1-7 c: dlmvcsztzpx 4-6 g: gmgggg 5-6 s: ssswsssgdghv 8-9 k: kkkkkkkgn 1-17 s: ssssssssssksssssss 4-5 b: qqtlsh 5-6 g: gggggg 2-11 r: drkpvrrlrtrvrjhpd 3-7 k: fkkhmddh 6-7 h: hhhwhnfph 3-4 p: ptppmwpnps 3-6 w: hwcshlrm 7-8 d: dtddqddzn 1-6 s: sslsbssbsg 12-15 n: tbnnjknnkwnnnnsnnnz 8-9 z: zzzzzzzzz 2-5 w: kjnwn 4-7 m: mmmtdjmmmmtl 4-7 h: dqfhzrqhfhntzhkhhdvb 3-5 g: zvflgg 5-12 s: lvsvqnvssgcx 11-19 p: pcppvppplpwppppjlps 5-19 p: gkpmfxlmppczdnhbqcw 5-17 b: mdzljsdvxdmbbbbddvrw 1-5 s: shpdss 2-5 t: btggtltvw 1-6 b: sbbbbbb 3-6 w: wwpsfkwnrrr 13-18 f: ffffwfffsfffwffffn 4-5 m: mpmmmxmmggvnb 5-6 z: pwsqhcztlf 8-11 d: ddddddddddlf 1-2 t: xttt 6-8 m: mmmpmvmmm 16-17 h: hhhhhhhhhhhhhhhrw 1-5 g: gpgpgg 3-7 p: gplrpzp 11-18 t: ftqnxttzttxtgttntrtt 10-11 z: zzzzzzdzzlgzzz 3-10 z: lzfzzzzszbzzztj 2-10 l: khdbddnxltnk 4-8 b: tbbcjsnbrbhfb 3-6 x: xgsxmn 9-13 t: ttttttttmtttt 7-11 l: fllllllzllmdshrll 18-19 g: hffqfwssgqpcnmddkcw 3-4 m: mmhvmc 1-3 w: vwnw 5-6 r: rrrrrb 2-4 j: rjqj 5-7 b: kgblcbbdrb 3-5 g: jgggggg 1-11 v: vvrvvhxvrvvnrvvv 3-14 w: ncwphcwvjwhdpwqkg 6-7 x: xxxfqmkvxx 13-14 v: vvvvvvvvvvvvkt 2-12 x: xzcvvxhhwwxxc 6-14 m: mdtnmjmhmnmmmmm 15-16 z: zzzzzzzzzznzzzzzzz 4-6 s: mcssdssjshscvcl 11-12 b: bnbbbmbjsbxbbbbbj 7-13 c: cccfhccczccwcccsc 3-4 m: cgtmmm 5-10 l: hxhbggrllmtgn 6-8 d: sdfdddlv 4-9 x: xxxxxvxxcx 11-12 c: rcmqkzjccccrdccmc 1-3 g: jgng 4-5 l: lvlll 9-16 n: rnnnqjnvqnnnlnnwdnnn 4-10 x: crdxgxrfjhr 1-5 f: tgdffffffqf 15-16 q: qqqqqqqqvqbfqknqqqqq 9-11 s: sssnffssksq 3-4 v: vqvvv 5-19 z: jthjzpgmwjbftzvmnpzk 3-10 w: mpxhrrnqdvncwssqwlxz 14-15 b: bzbbbbbsbbbbbbbbbbb 3-5 j: jpjvjjrjtmjj 3-6 w: wwmwwzw 1-6 c: ccccvzcccm 10-11 m: mmvwgmjmmmrqjmmmglm 2-3 f: fffw 6-12 m: bmbzmmrshmmz 5-6 n: nnnnnn 4-5 k: kmsgkwvkk 6-8 t: tttttbttt 4-5 j: vtmvsqjl 5-6 q: qshzdqqk 1-3 w: dwgw 8-9 q: qbqqqqqwq 5-10 m: lmmmkgmmwb 6-9 n: nnnlnnnnn 4-5 t: tntct 6-8 g: hgngghgw 6-9 t: gttwtgvpgtlt 6-7 l: lllllll 4-5 j: jhjkjjm 13-15 h: hhhhhhhhhhhhxnh 1-4 m: mmmmm 4-6 q: cqrtqsdqqzrknf 9-13 f: fffffffffzfvff 2-16 p: prxdxjpkppgpxsjwpppp 3-4 r: rrzh 1-2 g: cglblsnkg 1-3 f: xqnfwjmmwqffd 13-14 q: qqqqqqqqqqqqvjqq 18-19 g: dggggggggggggggggvgg 5-6 s: dsssssss 4-6 z: szdzzb 9-12 t: xtltpgftttmtt 10-16 m: mqmmmmmmmcmmmmqx 3-7 c: cpccngcvccm 2-16 s: jsdfsjsjtswhkvmsskj 2-3 c: kccc 4-16 k: qhndnqmrvjcczfkpds 4-6 n: nnnrkxl 9-10 s: ssssssssds 2-3 z: hfzcz 2-3 s: sssz 8-10 b: qbbbjbbbbw 7-16 k: gcvskkjkkkkwkzkz 7-9 n: nnnnnnhnnnn 1-10 q: qjxqmqxcgg 9-11 l: jdhjbbcnlzll 7-14 l: llrlxlllllltlnl 3-6 f: wfdqfbrf 3-8 t: ttzttmtvttzpl 10-12 v: vfvvvvvvvsvv 5-6 v: vvvvvm 11-13 t: ttttxtttttptttctttt 3-4 k: kkdm 4-6 n: nnnlnt 13-15 m: mmmmmbmmmbmmmmmm 5-6 l: klllnl 2-3 f: flzff 3-4 r: frrs 1-5 d: cqwkvsdqdvb 9-15 l: jvtfqczlnlwdpclxwp 12-14 t: ttttttlqtpttnt 11-12 m: mmmmmmmmmmmm 4-5 j: jjjkbjjjjj 9-12 w: wwwwwwwwkwxkwcb 6-12 q: tcqrqqqqxjqqqqmqhq 5-6 m: mmmsmmmm 2-5 t: mttbttprttddtv 10-13 t: tttttttttttztt 10-11 f: kmqfxttfkfd 5-7 v: vrlzpvjtvv 6-7 l: nlllllj 1-5 q: szdbqqkqqtkmssq 3-4 q: kcmlwqzczwms 13-16 b: bsbbbbbbbbrbsbbpzbb 9-11 d: dddsdbddkdkdd 2-15 j: xkjnntffvvxfnntcv 4-6 v: hvvvcvqvrwv 9-12 j: qjjjjdjgqhrjjfjrdj 8-10 v: vvvvvvvnvnvv 4-9 t: ttttthttt 8-16 g: ggggklggcggggxgg 1-3 z: wpqz 4-5 g: wgdnmxccgj 8-11 r: rrrrrrrxrrmd 1-9 f: ffffsfgdbsqfffzf 7-8 q: qzqqqqrrq 12-13 n: nnnnnnnnnnnnnn 8-12 j: jpjjjmjjjjjzj 1-4 j: nvjw 7-13 z: zzzzsnzxzznzrzgzzzz 14-16 z: zzzzzzzzzzzzzzzm 1-4 x: xxxxnxh 8-15 k: gnrkktkpcmklkksnkk 2-4 h: klph 11-16 c: ccckzdccgckpcccsc 15-16 l: dlllllllllllllll 2-3 s: dsxss 1-4 v: jvvv 2-8 t: ktkdtxkt 1-3 t: ftftttttt 4-5 k: kkkbkk 4-6 g: llqcggg 4-14 r: fmdvrrwlstlbjr 2-16 p: rpdfhpbqfwxlxhhc 6-8 j: jjjjjjjjj 1-7 f: fnnffblbqffkrff 1-3 k: rfqwlnnkzdq 15-16 s: ssssswssssssskssss 11-13 z: zzzzngfzzzzzz 5-7 h: hhbhhcnhfghhhv 2-7 j: zjrmjgmjdkp 5-8 z: bzzzpzzrzzzz 12-16 j: jtjnjjjjgjjjjjjsj 5-9 s: ssssssssms 2-3 s: ssss 13-14 d: ddddddddddddkt 12-13 r: wfdtrknrhvrrc 6-8 p: vpxphxngzhnkppppfp 2-3 j: jtjx 3-6 k: tkkvjkb 2-6 t: tvftftvbfx 5-7 z: zzzqzzz 14-15 h: whdhxhhhhhhhfxzhhh 3-4 g: ngjgg 9-10 z: zzzzztzztq 2-7 f: fffffqfszchff 4-6 f: lfqjnzccffjslsdf 5-6 z: lpzzzzsz 11-13 t: tttttwtttttttttttt 2-6 z: zzzzzz 9-10 m: mmmmmmmmjm 5-6 w: xwggfcwvwlx 1-4 j: jjjjjljjjjjjj 8-10 t: ttttttwttt 5-12 x: zxxxxxxpxxxn 3-4 v: vvlrv 3-6 h: hhhwhlxhlrhl 2-5 p: cptsjktp 4-11 j: bmjjjjjjnwwdk 15-17 p: ppppppppppfpppvpp 7-11 m: wnnmmwmtmmxmm 9-19 k: kkkkkjkkhwkcvkkkmknw 11-15 s: sspssbshssscssssss 1-8 s: sssssmssssssssssss 4-8 x: xxxxdxxx 9-10 n: nnnrnlnnnnnnnnnnnnnn 10-11 d: ddddddddddn 5-9 z: tzzzqzbmzzzqzjkzlr 9-20 f: fffffnfffffffsfnffff 5-6 g: gvggggg 13-14 x: xxxxxxxxxxxxxxx 6-7 v: vvvzvvvv 5-10 l: kbcvlfvlszndtlldjlh 4-9 s: vkcsdvszthkwmmmxs 3-4 b: jbmb 2-4 w: nmwm 5-10 z: tztzzfzgdzzszq 2-8 k: kzkkkkzwf 16-17 d: vxvzdgzwssqdcgbdb 4-5 b: bbbbb 7-9 w: wwfwwwjwln 5-12 k: ljkkkqfvqtkkxsd 5-7 q: qqqqhqqq 8-9 n: vnnnnnnpstnn 5-10 m: mmgzmmmmmm 3-14 q: qgbvqjxqnqqqqqqq 2-4 c: cccc 3-7 b: szbbkbdbmbbzbqs 1-5 m: mhmmc 3-6 n: nnlvnnvnq 2-3 c: mccc 11-12 m: ddmmmmxmmmmwfmmm 8-10 n: nnnnnrnnnn 1-12 g: sgbggglnggddgggsngrx 7-9 p: phppppppp 4-5 q: qxqqqq 3-7 v: vwsvvrvxvvvvvvwvvdlv 8-18 j: jmjcjjltjmjwjzrllgcj 2-14 r: rdrrrrrrrrrrrp 2-4 r: cxcbkmr 6-9 r: vtlnnvbcndqhrxkkjp 2-3 s: hxssnsswzc 10-16 r: csrsrxrrrrrrfrfdrr 7-9 w: wwbwmvrwdxww 12-14 p: pppbpppppppgpt 2-7 n: nnnnnnnn 3-12 f: mhjxfxgbbvffpclfffg 10-14 l: lllskllljllllll 11-16 l: lwlklllglzllllllll 13-14 h: hhhhhhhhhhhhhdhhhh 1-2 t: tttb 1-6 z: zzzrrzzbf 1-6 v: jrvzvvrs 3-6 g: jggbnl 17-18 x: xxxxxxxxxxxxxxxxrx 8-17 f: xnmffffbwfdcfrdfw 3-9 k: jmkdvkdnk 7-9 m: mmmmmmdml 9-11 c: cdmshccckqmcccccckp 16-17 g: gggggngggggggggggdg 7-8 n: nnknnnnnnn 3-13 n: fjhgrspsnkmnf 14-17 z: zzzzzzzzzzzzzqzzzzzt 13-14 r: rrrtrrfsvrzngw 7-8 k: kvkvkpvc 1-2 b: bbpbb 1-7 n: tchnrtbtldnmnnvvnn 3-4 s: sssssjv 1-9 l: cllllztmlllrzfl 9-10 x: qjxxxxxxdhxxxxxh 6-7 p: ppppfppv 3-8 q: mkqzqqbqzjrqbq 6-8 x: xxxxxxxx 1-7 f: ffffffff 5-16 b: jbbbbbqcbbbbbbfb 9-11 c: ccccccccccq 1-2 x: fqkx 4-12 z: znzzzzzzzzzzzzz 3-4 l: lglll 9-11 m: mmmmmmmmmms 14-17 x: xrxpxgkxxzdrxxxxckxv 3-5 t: gxjbbfcpmkbkxbtwbt 5-6 j: jmjjjj 14-15 g: ggggggggggggggx 6-7 l: lllllbl 2-14 q: qqtsqkqvqqqpxzqqcqq 2-4 w: fwhw 4-5 m: mzmtkm 2-4 g: ghghgp 5-6 r: rrrrnl 1-4 h: chghhw 7-12 r: rrrzglvrrrrsrr 1-7 x: xxcxdwxjmx 5-12 r: rrgrrffwtrrnrrqrrjnr 2-5 r: srdqrlxrkrrdkr 3-4 t: ttdg 11-12 s: bfjrkqqgdtlwrskmfrp 3-5 n: nnrnfzsnm 10-15 z: zzzzhzzqqczxwzqztv 2-7 f: ffgdfgff 7-10 d: ddtbdddddjtdqfdddfq 2-9 k: gkrkkkkkkkkhkqkx 13-14 n: nngnlnnnhnnnnnnnn 6-9 r: qrxrxzrff 7-9 m: mmmmmtmqqmml 11-12 p: pppppppppppp 10-13 j: jjjjjjjjjznvbjj 1-2 c: ccvc 7-8 m: mmmmtdmckkpmcbkjmm 5-8 j: sjptjjbjjjjj 6-8 d: jchdwrhd 5-6 z: lqzzzzkrzzvzwbbzktp 6-8 l: ztbltlll 2-3 z: zkrxzp 7-18 g: phgpgggqgzgnmwlpkwd 8-9 f: hffffffqf 17-19 p: pppppphpppppppppzpp 2-3 z: zzzfg 1-2 v: bfvj 4-8 b: bcbbbbbb 15-16 s: ppsnsssssssnssss 2-3 m: mnsm 2-4 h: hwfshh 9-15 h: hhwhhhhxhhhhhhh 17-18 n: nnnnnnnnnnnnnnnnnn 7-11 n: nnnnnqpnlbgqnqnshn 15-16 j: cdjmbcwdppvvjqvv 6-11 p: ppplppppxpt 4-5 r: rrrrrr 10-11 w: wwwwwwwwwww 3-7 p: pzppzspppmkxbldwpnwf 2-12 w: zwdljlzwgxfwvtdm 2-10 f: mzfjqfspgfrfhst 14-15 m: mzmmmvhwmdmmdpz 1-12 r: vrxrrtrxgvrd 4-5 n: nnnnnnpn 6-12 x: xkbwfsxxxxxkxxxxk 4-6 n: mncnxn 9-10 f: ffffpfqftbf 3-5 b: bzwbk 4-7 c: ncdcccc 11-12 t: dgdkrjgsgtlf 8-11 z: rqzdjqznrpkzmblbt 1-3 z: zfzx 2-4 z: kzgzkp 6-10 v: jvvvvvvvvs 2-9 v: vrvvvvvvvc 5-6 q: qqqqqqc 6-10 p: ppdknlgpqkp 10-13 z: zzzzzzzzzzzzvz 19-20 g: dtckblrmggknmxwnrjgg 4-18 p: ppcjpqfpcxtphlppmhcx 6-7 n: nnsnnknthn 10-11 f: fffffffffff 2-4 f: ffccltsfgk 6-11 d: dsqddtddddjcnssrcd 7-13 x: xxxxxqlxxxxfw 12-13 r: rrrdrrrrrmrrrr 15-17 p: pqppppppppppvppppppp 7-8 j: jjjjjrdp 4-6 v: vvvvvt 1-4 t: tltftjtjhz 9-15 j: jjjjjjhjjjjjjjkjj 6-7 c: ccccccccz 8-9 x: xxjxxxxxsx 4-5 h: hhrhh 2-3 g: cgnm 8-10 l: llqlgllzlvrllg 12-13 c: cvnbccpzzxcccfh 3-8 z: zbzrwzzzwrzbqnr 6-7 n: nnnnnnn 8-11 j: tjqjrjggjxxjggjj 7-12 l: bsvxdhljlcsj 3-6 j: jjfjjjjb 2-3 z: dzztwhmzqdx 9-12 v: vvvvvvmvzvvcv 13-14 v: vvvzvvvvvvvvvk 6-7 g: fgggghgng 13-14 h: wcghlwdbjhpdphkcv 1-2 t: nncsg 6-7 w: kwjwwxlwz 4-5 z: zzztvz 3-4 n: nvbvngnw 15-17 z: zzzzzzzzzzzzzzzzzzp 8-10 r: rrrstrgxrhrr 8-10 g: cggggggvgcg 1-4 m: mmvbz 3-14 j: bdbhbjnjnrldhwlbrkrj 1-4 r: rrkrnnd 2-3 f: fvwc 4-13 c: ccccvcgwbhwrcqf 3-9 c: jcghltcfkjchxmccccbs 3-5 h: hhhshm 5-9 h: hhhsjhhhhgthfgldw 4-12 h: mcwvwwphwwbc 6-11 g: gqgggvggggh 9-15 x: xxxxxxxxxxxxxxsx 16-18 t: rmqqtbtvttsdtjvbttl 9-20 f: cllnvlfkfrwzpqxwqgnn 9-18 v: vvvvvvvvzvvvvvvzvxvv 4-5 f: fzffbfvfff 1-5 p: pppppp 1-7 z: zjvchwzqjrtxzgz 4-9 v: vvvvvvvvvv 5-8 w: cwwwzwwb 7-8 r: rrrrxrrr 8-9 f: sgdcqfhfcfsflb 3-7 g: gdgtnfggq ================================================ FILE: advent-of-code/2020/inputs/20 ================================================ Tile 2011: .##...#..# .#.#.#...# .......### .....##.#. #...#..... ##...#...# #.#.#....# ##..##.... .....#.#.. ##.#...... Tile 3407: #..#..#.#. #..##....# ..#....... ......#... ......##.# ..#.#..#.. .#.#....## ##...#...# #.#.##.... #.##..#... Tile 3733: ##..###.#. ##.#.#..#. .....###.. ......#... .##...##.. ..##...... #.#.#.#..# .#..##...# ....###### .#...#.#.# Tile 2267: ..##.#..## ..#....#.. #..#...#.. .....##..# ##..##.### #.#.....## #.#...##.. #.......## ..#.....## ###.###.## Tile 3853: .####..#.# .........# ......#..# ..#...#... ...#.....# .......... ....####.# #........# #....###.. .#..##...# Tile 1531: #.#..#.... .#..#.##.. .....#..#. #....##... #.#...#... .#...###.. ##.....#.. ..##..#.#. ##....##.. ###..###.# Tile 3907: #..##.##.# ##.##.##.. ........#. ......##.# #.##..#..# #....#..#. .##.##.... #.#.##.... .#..#..... #.###...## Tile 3329: #.##..#### ##....#..# ...#..#.#. #..#..#..# ###..#...# ##.#.##..# .#.##..... ##.#..#### .....#.#.# #..#..#.## Tile 3449: ...#.#..## ......#.## #......##. ..##..#..# ...##..... ##.....##. ##..#..... #...##...# #.##...#.# ..#.#...## Tile 1187: #.#....... ...#.##.## #.#.##...# ##..#....# #..#..#..# #.#.##...# .....####. ..#...#... .....#.... #.##...##. Tile 1543: .##.####.# .##..#..#. #..#.....# ###..#.#.# .#.##.#.## #...##.#.. #..#.##### #...#.#..# #..##...#. ..#..##..# Tile 3631: #..###...# .#.##....# #......### #......#.. #.#......# ##..##...# ###.#..##. ...#..#..# ...#...... ####.##..# Tile 3917: ##.####### .....##..# ..#..#...# #......#.. ##.#..###. #....#.#.. .......##. #....#..#. .##....#.. #########. Tile 1373: ####....#. #......##. .....#.... .##......# #........# #..##..#.. ##..#..... #......#.. .#..#.#..# ##...####. Tile 2663: ..#.##.... .#..##..#. .......#.# ##..#..#.# ..##.##.#. ....#.#..# ##.#.....# #..#....## ###.#..### ...#.#.... Tile 3529: ...#.####. .#.##....# ...#.##.## #..#...#.# #.#..#.#.. ........#. ##........ ....##...# #..#....## .###....## Tile 2297: ...##....# #...##...# #......#.. ##.......# .#...#..## .#....#.#. #....##..# #....###.# ##.......# ###..#..#. Tile 2789: ..#.##.##. #.#..#.... #......#.# #......#.# ..#..#.... #...#..... ...#....#. #......#.# .....#...# ...#....#. Tile 3461: ..###.#### ##....#### #.###.#... ##......## #.#......# ##......## #..#...#.. .........# ......#.#. #.#..#.### Tile 2939: ##.####... .......#.# ###.##..#. .####....# #.#....### #.....#..# ##.....#.. ..#....##. #.#....... .......#.. Tile 2903: ##.#.#.#.# ##.##..#.. .........# #......##. ....#..### ###.#.#... ...#.....# #.....#..# ##..#..... ....#.#.#. Tile 1993: .##..##### ....#....# .#..#...## ...#...... ...#..#... #...#.##.# #....#...# #..#....#. ..#..#..#. .###.##### Tile 1669: .##.##...# ###.###..# ###...##.# ##.#...### #.#.#.#### .##....### .####.#.#. #.#.##...# #.#..###.. ....#.##.# Tile 3823: ##.......# ###...##.. ##.....##. ...##.##.# ..#......# .##...#.## .##.#..#.. ###.#..... ......#... .##.#....# Tile 3929: #....###.# .......... .........# #.###....# ...#.##... .#.#.###.. #...##.... #..#.#..## #......### ..####.#.. Tile 2521: ....##..#. ...###.#.# .#....###. #.#...#.#. ##....#... #....##... #...##.#.# ....##.... #.....#### #.#.##.... Tile 3361: ....##..#. #.##.#...# ..##..#.## #..#.#.... ...##...#. ..#...###. .#####...# #.#####... #.#..#..## #.#####.## Tile 1259: ..##....## ..#...#... #.#.#..#.# #........# .##......# ##..##...# ###..###.. ##....#..# ..###.#.#. ....#....# Tile 2729: .##..####. #.##.#.... .....#.#.# ..#......# #.#....#.# ..#..#..#. ##...####. #...##.... .#.......# ..#..##.## Tile 3511: #...##.### #...#.##.# ......##.# #......... #.##..#.#. ....#....# ...#.##... ##.##.###. ..#......# #...##.#.# Tile 3119: .....##.## #.....#### ..#..#.#.. .#..##.#.# .##.....#. ...#...#.# ..#.#.#..# #......... #.......#. ########.# Tile 1427: ###..#.#.. #.#.....#. .####...## .#..#..... ..#....... .#...#.#.. ..#..##... ..##...... ###..#.#.. ...##..... Tile 3307: ...#...#.. .###....#. ..#.#..#.. #......#.# ##.####... #.##.#.##. .##..###.# ...#...... ....#.#.## .#.####.## Tile 2081: .....####. ...#....## #.#..#..## #...#...#. .#..##.### ...#.##.#. #.......#. ##...#.... ....#..#.. #.#...#.#. Tile 1741: ##.##....# #..##.##.# .#..#..##. .#.#..##.# .###...... #.####.... ..#..#.##. ####.#.... ##....#... #.#..#.#.. Tile 1481: #.#...#... #.#.##.### #.......#. #.#.#..... .####...## ####....#. #.#..#.... ...#.#...# ........#. #....####. Tile 3719: .###..#... ..#..##... #..#...#.# .##.#.#.## ..####.#.. #...###.## .#..###... ...#.....# #..#..#.## .##.#.#.## Tile 2797: ..##.#.#.. ....#....# ..###...## .......... .......#.# .........# #.#....... ####.####. #.#..##.#. .#.#...#.# Tile 1319: ..####.### .#.##.#.#. ##.##.#.## #.##..##.. #..##..##. .##.#..#.. #.#..#...# ..#.#...## #..#..###. #.###..### Tile 2053: .##....### ##..#..... #.#...#.#. .........# .#.#..##.. ..#..##.## #.##.#.#.. ......#..# #.#.###..# #...###.## Tile 1867: .#.###..#. #...#..#.. #.....##.. #....#..#. #.......## #...#....# .#..####.# ###......# .##.##.##. .##.##.... Tile 2131: ##.##..#.# ##..####.# ...####... #....##..# ..##....## ##....#... ..#..##..# .###..##.. ..#..#...# ....#..### Tile 1777: ###..##... #.#.#...## #..##....# .........# #..#..#..# #...#.#..# #..#...... .#..#.#..# ##....#..# ....##.#.# Tile 3037: ##..#..#.. ##......#. ...###...# .####....# #..#...... #...#.#... ..#####.#. #..##..... ......#... ..##.#.### Tile 2749: ..###.##.. ####.....# #..####.#. #...#....# #......... #.......## .####..##. ..##..###. #.##....#. #.#...#... Tile 3919: #.#....##. .#....#.## ......##.. .#....##.. #.......#. #..#...#.. #.#..###.. ##...##..# ..#..##.#. .####.#... Tile 1231: .#.#.##### ........#. ##...#..## ....#....# .......#.# .#.......# ...#..#.#. .........# ...##.#.#. ####.#.### Tile 2441: ##.......# ##.....##. .#......## #.###...## #.......#. ....#...#. #.#...##.. ##.....#.. .#.#.#.### #########. Tile 3659: ....#.#... ##.#####.# ...#....## .#.##..#.# #.##.....# #.#...#... #.....#... ......#... #.......#. ###...#### Tile 2411: .##...#.#. #..#.##..# #....##... #...#..... #......#.# #........# .#.##..... #...#..#.. ...#.##.#. ##.#...#.# Tile 1999: ...###.... .##....... .#...##.#. ..#......# #.......## ###...#### .#......## .###....## ..##..##.. ##..#.#.## Tile 3623: ###....#.. ....##.#.. ..#...#... .#......## #..#..#... #.#####... ....##...# .#..#..... #..#.#.#.# #....#...# Tile 2851: #.##.##.## ##..###... ...#.##.#. .....#.... ##....#..# #.##....## ##.#.####. #..#..#... ...##....# ...##..#.# Tile 3673: .#####.#.. #.....#.## .#........ ..#..#.... .##..#.... #......... #.##..##.. ......#..# #.......#. ###..##..# Tile 2399: ##..#....# #.######.. .#.#.##### ##.#..#... .#....#..# ###..###.# #..#..#.## #..##....# .##....#.. #.#....##. Tile 3727: #..##.#... ###....#.# .##..##.## .#...#..#. ..#.....#. .#.#.....# ####.....# ..#..#.... ..##..#..# ###.###..# Tile 2311: #..#...#.. ..#.....## ....#.#..# ..#....##. .....#.#.# #........# ..#...##.# #.#.#...## ##.#.#..#. ..#...#... Tile 1009: .#.###.##. ....#...#. #....#.... #.##...##. #....#.#.# #.###..... .##..#.##. .#..#.##.# ##..#....# .###.##.## Tile 3313: ##.#..#### .#...#..## ..#....#.. ...#...#.# ######.... ...#...... .......... .#...#.##. ...#.#.... ###.#.#.## Tile 1733: .#.#.###.. .##...##.# ###..#.#.# #.#...##.. #.....##.# ##........ ##.##.#..# .#....#.#. ####.#.##. ####....#. Tile 3947: .####...## .....#.... #.#....... .....#...# ..#....#.. #...#..#.. ...#...... ##.#....#. ..##..#... ..#.#.#.## Tile 1583: #..###.... ....#.#..# ...##.#..# .##....##. .......### #.......## ...#.##..# ##.....#.# ###..#..#. #...##.... Tile 3911: .###...### .#.......# ###.#....# .###...... ..#.#.#... ....#.#... #..#...#.. #...#..#.# .#.#..#..# .#.#....#. Tile 2833: .#####...# ..##....## #####..... .#..##..## #.#..#.#.. #..###.#.. #.#.##...# ...#..#..# ...#..##.. #.#....... Tile 1117: ...#####.# .##...#... .........# ##......#. ....#..#.# .###..#.## ###..##... ..##.#...# #..#.##..# .#..###... Tile 2693: ...#.#...# ##..#...## .#.....##. ...#.#.... .###.....# ...#...... ##.......# #........# ....#..... ..#..###.. Tile 3527: ..##.##... .#.#...... ##..#...## #..##.#... #...#...#. #.#.#....# #..##..##. ........#. ......##.# .#####...# Tile 2417: .###.#...# ....#....# ###....### .......... .#...###.. .#####.##. #.#.....## .....#...# ..#..#.#.# ###.##.#.# Tile 1723: ..#####.## #..##..#.. #..##...#. ..#.....## ..#...#... ....#...## ....#..... #...#....# ...#..###. .##.##.... Tile 2251: .....##### ..#......# #....#..#. .#.##.#..# .....#..## ........## .......... .#...#...# .#..#..#.. #.#..##.#. Tile 3761: #.#.#...#. #.#.#.#.#. #..#....#. #......... ##.##..#.# ...#...... ##..#..... #...###.#. ..###....# ..##.##... Tile 1697: .#...#.... ..##..#... #........# ##..#...## ......##.# ...##...#. ..##...#.. .####....# ..#......# ##.#.#.#.# Tile 1879: ..#...#.#. #.#.....## ..#..#..## .......#.# #...#...#. ........## ##.#.....# ..###...#. .....#.#.. #....#..## Tile 1901: ##.#.#.### .....#.... ##.#.....# #.#.#.#... .#........ ####.#...# #.#...##.# .##.##.##. ..##...##. #.#...##.. Tile 1063: ..#######. .....#.##. ...#...... #........# #........# #.#..##... ...#...#.# ###...#..# #.#.....#. .###..#.## Tile 2389: .###.###.# ...#...#.. ..#.....#. ...#..#... .#...#.... #...##..#. #...##.#.. #.#.#..... ##...#..#. ##.#.#..#. Tile 2393: ..#..#.#.. ..#..##... ....#.#... #..#.....# ##........ #.##...#.. ....##...# ...##....# ...##.#.## #.#.#.#### Tile 3067: .....##..# .#........ #..##..#.. #.#...#.## #..###.#.# #...#...## #.##.#..## ...##...#. .##...#.## #.....#... Tile 1747: .#######.# #...##.... ....###..# ##...#.#.. #..#.#..#. #..#.#.#.# ..###.##.. #.#.##..## .......... ###.#####. Tile 3797: ..#######. #.#.#..... .......... #..##.##.. ##..##.#.. #.#.#...#. .###.#..#. ##...##.#. #..##.##.# .##.#.##.# Tile 1811: ##..###... .......##. ......#..# ..##....#. ##..###### #...#...#. ####...... #..#.##... #..##....# ###.#...## Tile 1087: .##.##..#. .#.##...## .#......## .#.....##. ...#.#.##. ###.#..### ###.#...## ####..#... ##...#...# ...#.#...# Tile 1181: ...##...## ....#..##. .#...#..## ##.#...#.# ..#.#.#.## ##.......# #...#.###. #.#.....#. .#......## ..#.#.#..# Tile 3821: .#...#.#.. ..#....### ..##.#..#. #...#.#..# #.###...#. ..##..##.. #.#.#..#.# ....####.# #......... ..#.#..... Tile 3457: #..#....## #........# #.#..#.#.# ##.....#.. .....###.# .#.##....# #.....#..# ##...#...# .#.....#.# ##.##...## Tile 1657: ###..#.### ....#..### ..#...#..# ...###..#. .....####. #......#.. .##...#.#. .#.#.#.##. ....#...#. ...#.##.#. Tile 2503: .#....##.. #.#...#... ##..####.. .#.#.....# #.#..##... ...###...# ...##....# .....#...# .....##... ..#...#### Tile 2843: ....#####. #.......## #...#.##.. .#.#.#...# ..#.##...# ..#..#.### .......#.. ....#..### ......#.#. #.####.##. Tile 2273: #....##..# ##.#....#. #.###...#. #......... ...#...... ####...... #.##.....# #..##..#.. #.......## .#..#..### Tile 2953: .#.#.###.. #...##.#.. .#........ ....#....# ...##..##. #.....#... #.....#... #...#.##.. .#......#. ###..#..## Tile 1021: ##.#.###.# ##....##.. #......#.. ...#...#.# #.##.....# ......#... #..#...... .##...#... #...#...## .##...#..# Tile 3643: #...#..... ...#...#.. ......#.## .....###.. .....#.### .....#.#.. .......##. ##..#.#... #......#.. ..#.####.. Tile 1609: ##.#.#..## .......... #.#..#.#.. ####...### .#...#..#. ##....##.. #.#.##..## #...##.... ##....#.#. ###..#.#.. Tile 1949: #.#.#.##.. #.#....... #.#......# ###.#....# ...#.##... #...#..... .#...#.... ...##.#... .#..#....# .##..###.# Tile 1153: .##.##..#. ..#......# #.#.....#. ##.##..##. #.#......# ....#....# .#.##....# #.#..#...# ..#...#.## #.#.##..## Tile 1367: .###.##### .........# #.##....## ....##..## .#.#.....# ####..##.. ..#.###..# .#..##.#.# ..#.....## #...##.### Tile 1061: ..####.... .......#.# #.....#... #..#.##..# #.##....#. .#...#.#.# ###.....## ..#...#... ...#.##.## .#....#... Tile 1193: ...#....## ...###..## #..##....# #....#.... #...#..#.# ..##.##..# .#.###...# ##....#..# #...#..##. ####.#.... Tile 3617: #..#.#..#. #.#.#.##.. #.##.#..## #.#.#..... ###......# ##....#..# .....##.#. #......### ...###..## .##.#..#.# Tile 1093: #..##...#. .#.#.#...# #........# .#...##..# ....#.#.## #.....#.## #........# ...#..#... #.##..##.. .#...#..## Tile 1549: ##..#.###. ..#......# #.#..#..#. ........## ....#..#.# #.#.#.#... ...##..#.. ######...# #....##..# .####..#.# Tile 2281: ###.###### .#.#...... #.#..##... .#.#...### ..#...#..# ..##.....# .......#.. #....##..# ....#..#.. ..####..## Tile 3049: .....##... #..#...... #....##... #...#.#... ###...##.# ##....#... ##...##..# #...#..... .#.#.##... ######...# Tile 1523: ##..###.#. .......#.. ##..####.. .#...#...# .....#..#. .##.#.#..# ##.#.....# ###..#..#. ...##..... ##.##..... Tile 3671: .#.#.###.# .........# ...#..#... ...#.#.... .#...#.### ###.#.#.## ..#......# .......... #..##.###. #.##.####. Tile 3221: ...##.##.# #....#...# ##..###... #...##.#.. ##........ ##.....#.. ###....... .......#.# #.#..###.# #..#.#...# Tile 1861: .....##..# ##...#.#.# #...#....# ....##...# #..##..#.# ...#.#...# ##........ #.#.#.#... #......... ##......#. Tile 2111: #....##.## ..#....#.# ......##.# #..#..#... ..#..##.#. ##..###.#. .#..#.#..# .#.#...#.. #.##.#...# #.#..##..# Tile 1049: ..#.###### .#......#. .........# ....##..#. .#....#..# ....##..## ..#......# #..#.#...# ##........ .#.##..##. Tile 1871: .##.##.#.# #...#..... #..#.#..## .###..#.## .....#.... #....#.#.# #..##....# .#.##....# .#...##.## .##.#.#### Tile 3389: ...###..#. .#...#..#. ###....... .#...#.#.# .#.#.#.#.# #..##.###. ..###..##. #...#..... #.#...#... ##.##.#.## Tile 2699: .#..#.#### #...#.#.#. ##.....#.# #....#...# ..#...#... ...###..## #.#.##..#. ...###.##. #....##.#. #..#..#.#. Tile 3181: #.##.#..## #......##. ........#. ##.###.... ##.......# #......... ##...#...# #.#.#....# ...#.....# #..###.... Tile 3469: ..##...#.# ...##..#.# ##.##.#.## .#####.### ..#......# .#......## ..#..####. ##.#.#..#. .#......## #..##.#... Tile 1249: ##.###...# .#........ ....#..#.# #.....#..# #.###..#.. .#.......# .....#.#.. ##....#... .#...##..# .#..###.## Tile 1907: .####.#### #....###.# ...#.#..#. ..#..#..## #..##...## #.#....... #...##...# #..#...#.. .#...###.. ...###.##. Tile 2539: ...#.##.#. ##.....#.# #..##..... #####..... #..#.#..#. ###..#.... ....#..#.# .......#.# #.#.....#. #..#####.# Tile 1217: .#.###.### .........# #.....#... ##..#.#... ..#.#..... ......##.# .#.......# #.#.#.#... ...###.#.. ..####...# Tile 2377: .#...##..# ..#...#..# ........## .........# .#....#... .###.....# #....#.... .#...###.# ...#..#..# ###.#..### Tile 2767: .####..#.. ##....#..# #..#....#. #..#.##### ###....#.. ..#..#.### #...#..... #.#......# .#...#..#. #.#.#.#### Tile 2879: #.....#..# .#..#..#.# ##....##.. .......... #...#...#. ##.......# #.###.#..# .......##. ....####.. ..##...##. Tile 2683: .##..##... .#........ #..#.##..# .#.#..##.# ........## #.#......# ....#.##.# #.##.#..#. #.#.#...#. #...##.#.# Tile 2003: .#.#.###.# #..##.#... ##...##... .#...##..# .#..##.##. #...##...# #...#.#... .#...#.##. .......... ######.... Tile 1511: #..#.#..## ......#... #.#.#..#.# ##..#....# ##......#. #......... .....#.#.. ..##...... ...##...## ..##...### Tile 3967: .##..###.# ....#....# #.##...#.# #......#.# #.....#### ..##....#. #.#.#....# ....#..... ##.#.....# #.###.###. Tile 3343: ##.#.#.... .......#.# ..#......# ..##.#..#. ##....##.# .#.#...... ...#..#.## #..#.##..# .#.#.#.#.. ..##..#..# Tile 2269: ##........ #........# .........# ...##..### .###.##.## #....##..# .#..#.##.# ##.#...#.. ##....#.## ..#.#....# Tile 2063: #...#.##.# ##.......# .#..#..... .##...###. .#.....#.. ..#.....#. ..#####.#. #####...## ##.#...##. .#.....##. Tile 2857: ...##.#### ##......## #.#.#.#... .#.###.... ......#... .........# .#......## .#.#.....# #.#.#..... ..##.#.#.. Tile 3167: .....#.... ...###.... ...##..... .....#..## ..#.###..# #..#....#. ..####.... .......#.. #...##..## #...###... Tile 2551: .#.###.... #.##..#.#. ..###.#.#. #..####.## .......##. ..##.#.... .#..#....# ####....#. #.##..###. #....#.### Tile 2707: ..###..#.# .....#.### #....#...# ##....##.# ...#..#.## .##.#..##. #...#.#.#. #.....#..# ..##.##.#. ######.#.# Tile 3607: ...#..#.#. #.#..#..## ..##...#.# ##.#.....# ##...##... #.#..#.... #........# .#..##..## ####...### ##.#..#### Tile 2113: ....#..... .....#...# ...#..#..# ##..#.#... ...##..... #.##..#..# .....#..## #..#.#.... #.#.###... .#.####..# Tile 2371: ##.##...## #.#......# ##.#...... #......#.# ....#....# ##...#.#.# #...#...## #....#...# ..#..#...# ......#..# Tile 2741: ###..##### #..#..##.# ##...##... ##........ ...##...#. .##.....#. .#..#.#.#. #.#......# ..##....## .###...... Tile 3779: ..#.....#. ##.......# ..#.#.##.# .###.#.##. .#..####.. #####.#..# ...#.....# #...#..... .........# .##...#.#. Tile 1483: ##.#..##.. #.#....#.# .......... ....#.#..# #...#....# #....#...# ..##.#..#. #..###.### ..##.#.... ..#.##.... Tile 2927: ####.##### .###...... #..##..#.# ##...#.... ##.#..#... .##.#..... .#........ .......... #........# .##....#.. Tile 2153: #.#..##### #..#...#.. #.......## ##..#.#### ....##.#.# #.#.##.... .#..##.#.. ..#.##..#. #.#####..# ...#.##.## Tile 1453: .....###.. ...#...... .#.#..#..# .#..#...## .####..#.. ...#..##.. ....#.#.## .##....##. ##......#. .##.#...## Tile 2423: #..##.###. ##...##..# #......... .#...#..## #......... .....##... #...#..... .......#.. #....#.... ..##...### Tile 1933: #.##.###.# ##....#... #..##...#. .......#.. ##....#..# ....#..##. #..#...... .#........ ..#.#..... ##....###. Tile 3191: .#####.#.# ##.#.....# ....#...#. ##.#...... ...#...##. ..#..#...# #..#..#... #..#...... ..#.###### .###..#..# ================================================ FILE: advent-of-code/2020/inputs/21 ================================================ vzkbf lxrsn mnj bjqfl brqg kcddk nkjc bgblpf xxhp cfb pzqgtb cggl cjhv vplz dlhfnjb jtfmtpd ccmvjbn jgrrd dvjxl tdrxvd vlqz pfbz txvctk kqvhbt qcmgxlj kgf znvmcx ldkt lshjmc nrlf rjf mcvc tzkfgq fpgmtjg srvfk nhhbtd mdtrqk hqxp bgxpfm ncx sckjj vqn npxrdnd xvsxb bcvlvk tflkk sjdmzj zmkx jpvvt vvlbp fqpt lmcqt khmm gfgbq plgvrz klnrvd xmcdn hrrt (contains dairy) dvjxl sjpkc xdqx cfb jnmsr jzvjxf czcfdv zmvpzp srvfk tsch qqq qdhk pxf ttlvf jtfmtpd ndqk mrqgvd fqpt ctbvdq bgxpfm znvmcx sgczbl jpvvt zkjh kskbk mjzpgzs jxvc qvkdgn tdrxvd fzdltb csxkh mnj vbvbbh ldkt bcxxjq fpgmtjg nvxk hcrgt mqvf kqvhbt hnpd tmckpp lmcqt pzqgtb npxrdnd fdhfpn nbhhmfx dntsjl zbfqrn cmtvkq xmcdn xjsgl hrhzg zfrkt bxgzl zkfsg xzn zmmrgdf fkpjn dhz (contains shellfish, fish, nuts) rxjq qdhk hlzkpt tsch xl tcff vmhhjm xjsgl pfbz xhxkf ftqpg ctnb zhvhng zmvpzp djmbx dptsqvq fkpjn pzqgtb lg kcddk ngrcb tflkk fsbll svvjknm khmm mjzpgzs jpvvt lkvdg mcvc gmsnc lmcqt npxrdnd xtnsbgc xkzsk vlqz cfgc dvzz qtpvndc qlrrrgb zkfsg mzlzxcc ltrhm mk zmmrgdf pfhsdp hqtzllj ldkt dqntj mqvf vtrchx slkjz hrhzg tmckpp lbdlb mdqdgf pnpg dscxjl sgczbl gscxfbd nfkzd mnj cjhv zmkx rrtkdz njjvq rjf xxhp bcxxjq lfvdf sqg dvjxl fqpt vjpnd gkkcjs flrjj bnfhd mmlq tsrqc nbhhmfx bgblpf ctbvdq xbrtdm srvfk cfb (contains nuts, peanuts) kskbk qdhk cxbkg xpmx xskgz dvzz xdqx tsdcm pgcxql fkpjn rxjq bcxxjq mdh ngrcb sqg zmkx mdtrqk nfqkt tzkfgq dntsjl jzvjxf dmtcj dscxjl plgvrz npxrdnd jgrrd ftqpg hrrt zkjh dgbndg lmcqt fqpt kqvhbt hrhzg cfb qvkdgn flrjj tsch mcvc xvsxb blnsd pxf zhvhng ldkt jtfmtpd sckjj zmmrgdf xkgpch vzkbf cmtvkq mzlzxcc sfmbms mk (contains soy, shellfish) xvsbr cbdl lmcqt kqvhbt pxf ldkt kskbk zhvhng jzvjxf nfkzd mk fsjcf srvfk bqrsxn lkvdg cshq npxrdnd zfrkt vmhhjm znvmcx zpzzt slkjz ndqk fqpt qvkdgn ftqpg jnmsr cfb tsch lshjmc mnj xlqp hrrt mqqzg sqg kcddk mqvf xzn hqxp cmtvkq (contains peanuts, nuts) lkvdg xhxkf fpgmtjg szfxqq lshjmc cggl jxvc xmcdn tdrxvd jgrrd vvlbp hrhzg lxrsn xtnsbgc mzlzxcc ftqpg kcddk jmvt dgbndg cvd tsch pgcxql fqpt plgvrz tmckpp mmlq jpvvt xxhp dntsjl bxgzl mmhmx cfb svvjknm fsjcf rzc jtfmtpd xzn pzqgtb vjpnd hndcnf xskgz qdhk mdqdgf npxrdnd flrjj zkfsg mqvf lmcqt ctbvdq znvmcx khmm nhhbtd zpzzt hrrt tzkfgq slkjz xl mk pgct mrqgvd njjvq zhvhng kskbk blnsd gxmk vtrchx hjkqqr qtpvndc klnrvd xqbtls bgxpfm (contains fish, dairy) lmcqt vrl hmnln rjf ttlvf cfb cggl rxjq qpdd plgvrz mdh pfhsdp xpmx zhvhng dscxjl mrqgvd bxgzl mk lxrsn nrlf vvlbp fpgmtjg tsrqc dhz ccmvjbn npxrdnd ltrhm xvsxb sjpkc hcrgt cshq hlzkpt jpvvt xdqx xjsgl pzqgtb xhxkf tdrxvd hjkqqr fqpt tfnsz bcxxjq hclf ctbvdq mzlzxcc kgf gfgbq sckjj tflkk bgxpfm zkfsg vmhhjm qlrrrgb jnmsr qcmgxlj bcvlvk srvfk hrhzg jtfmtpd ngrcb jbmxr flrjj szfxqq csqrvk bggz ldkt mdtrqk sqg zfrkt slkjz tsch (contains sesame, soy) cxbkg fsjcf vqn xzn sjdmzj qcmgxlj cfb mrqgvd bcvlvk bggz hrrt npxrdnd dntsjl lfvdf tsch cmtvkq xjsgl pxf kcddk vdqtgt dgbndg ldkt xhxkf dptsqvq gscxfbd tmckpp bxgzl znvmcx mmlq flrjj xpmx kgf mmhmx tdrxvd dvjxl fqpt plgvrz zmvpzp zmkx xskgz ltrhm lmcqt csxkh (contains eggs, soy) srvfk tsch szfxqq lmcqt xjsgl mqvf mrqgvd dhz kcddk mmhmx fqpt vvlbp gscxfbd jfl cjhv zbfqrn cfb vplz pgct jxvc mdtrqk sgczbl pbkr nfkzd lxrsn gmsnc blnsd fpgmtjg mjzpgzs fsbll rzc xvsxb mnj lkvdg kqvhbt hjkqqr njjvq klnrvd bgxpfm kskbk nsdk tsdcm bnfhd lfvdf hndcnf fkpjn jzvjxf bqrsxn txvctk xmcdn ldkt tsrqc zkjh slkjz dptsqvq lbdlb jtfmtpd jnmsr bjqfl zpqh csqrvk dscxjl cbdl dqntj sqg rbkr mzlzxcc bvzs nvxk hrrt vlqz fdhfpn pfbz mxfgnv pzqgtb hqtzllj (contains shellfish, sesame, dairy) xl hjkqqr fsbll mmhmx kcddk xkzsk kqvhbt jtfmtpd xlqp bgxpfm zmkx fpgmtjg fdhfpn zhvhng gxmk mjzpgzs tcff szfxqq mxfgnv rzc zmvpzp svvjknm sqg bcvlvk dqntj lfvdf jbmxr lmcqt pgt xjsgl tsdcm hnpd mnj vbvbbh plgvrz rxjq mdh mdtrqk tsch ldkt fqpt qpdd mqqzg vdqtgt jvxqc ccmvjbn hclf cfb ttlvf cxbkg vjpnd dmtcj vtrchx qqq nbh jmvt xskgz (contains sesame, peanuts) fqpt pfhsdp fkpjn tsch dscxjl tdrxvd klnrvd mnj czcfdv kqvhbt mzlzxcc mxfgnv dvjxl rrtkdz cggl nfkzd pgct bnfhd bxgzl djmbx lkvdg bjqfl xlqp xhxkf nkjc csxkh sjpkc lmcqt vbvbbh cshq npxrdnd mk plgvrz ldkt rzc qqq dlhfnjb hrrt xqbtls mjzpgzs cfb bqrsxn jvxqc fpgmtjg dptsqvq rbkr mcvc lshjmc cxbkg bcxxjq nrlf pnpg zpqh vzkbf zkfsg mmlq ndqk nbhhmfx zkjh kcddk vmhhjm fzdltb ccmvjbn bvzs (contains dairy) zmmrgdf zpzzt cmtvkq sgczbl jtfmtpd xskgz znvmcx hjkqqr vqn jpvvt mmlq hclf svvjknm pnpg lxrsn dmtcj vtrchx tmckpp lmcqt hmnln xdqx nhhbtd xqbtls gmsnc npxrdnd fqpt zkfsg brqg cxbkg mjzpgzs rbkr pfbz dptsqvq mnj vdqtgt kgf ldkt jxvc ftqpg zkjh hrhzg ttlvf kcddk jmvt cfb vbvbbh khmm xmcdn tcff mdtrqk fdhfpn srvfk (contains sesame) qpdd vrl sgczbl qdhk cfb cxbkg bgblpf kcddk tsch hnpd bxgzl jzvjxf svvjknm rbkr xzn lshjmc zkjh xjsgl ftqpg fdhfpn hqtzllj sjdmzj ldkt cggl xskgz jxvc bcxxjq tflkk vqn jvxqc blnsd xdqx lg tsdcm ngrcb vzkbf jmvt jtfmtpd gfgbq xl fqpt csqrvk zmkx nsdk xlqp rjf mnj mzlzxcc plgvrz cvd jbmxr sqg cfgc bqrsxn mqqzg cjhv zpzzt vdqtgt jfl mmlq vlqz pgt xtnsbgc vjpnd gxmk dscxjl lmcqt lxrsn (contains dairy) pnpg lmcqt nbh zpzzt dptsqvq tdrxvd mdqdgf ncx gmsnc sckjj klnrvd dscxjl znvmcx dvjxl bgxpfm vdqtgt hmnln jvxqc gxmk tsch ngrcb csxkh slkjz jmvt xkzsk prnjsm hqtzllj jtfmtpd fdhfpn cshq xjsgl jzvjxf kcddk jbmxr xdqx jpvvt cmtvkq fqpt cfb npxrdnd (contains nuts, sesame, soy) flrjj zhvhng tsdcm xkzsk jtfmtpd mqqzg dntsjl npxrdnd tdrxvd znvmcx mzlzxcc vbvbbh gfgbq lbdlb mxfgnv khmm bcvlvk bjqfl zkfsg jzvjxf xvsbr hrhzg xkgpch czcfdv tsch pxf nhhbtd lmcqt rxjq njjvq kqvhbt cfb bgblpf tfnsz bggz csxkh kcddk fsbll gxmk zfrkt xxhp slkjz mmlq vtrchx ldkt dlhfnjb ftqpg (contains peanuts, fish, nuts) tsrqc lmcqt czcfdv pfhsdp xl zpqh qdhk jtfmtpd vtrchx csqrvk xmcdn nfkzd tfnsz blnsd fsjcf bgxpfm klnrvd srvfk mnj jbmxr sckjj xjsgl mqvf mxfgnv mdtrqk nbh gkkcjs bjqfl mjzpgzs zfrkt svvjknm lg pnpg pzqgtb kcddk mdh gscxfbd xvsxb nhhbtd qcmgxlj tsch mzlzxcc cjhv xqbtls spkl cmtvkq qpdd xkgpch rzc xpmx bgblpf vvlbp gfgbq dscxjl tmckpp fqpt vplz vlqz cfb vmhhjm npxrdnd fpgmtjg vbvbbh gmsnc zkjh cxbkg cfgc ctnb znvmcx mcvc pgt txvctk (contains nuts, shellfish) mrqgvd xvsbr cggl zmvpzp xxhp xbrtdm qqq bgxpfm cfb cfgc tsrqc kcddk mdqdgf bqrsxn bcvlvk bxgzl ldkt pgt lfvdf qlrrrgb jtfmtpd nvxk fqpt jxvc mmlq sjdmzj ngrcb zmmrgdf jbmxr pgct lg hnpd dscxjl npxrdnd jpvvt ndqk gkkcjs zfrkt bggz ncx bnfhd xskgz mnj dptsqvq hcrgt zkfsg sjpkc bjqfl pxf tflkk dvzz srvfk xmcdn fdhfpn mmhmx dlhfnjb ctnb vplz rzc nsdk xqbtls cvd jgrrd cbdl mdtrqk czcfdv mcvc bgblpf vqn pbkr lmcqt xhxkf (contains fish) vzkbf dvjxl nrlf cbdl xskgz sfmbms mdqdgf cjhv szfxqq ldkt mmhmx mzlzxcc qvkdgn fqpt gmsnc mmlq kskbk tzkfgq djmbx pgcxql kgf sjdmzj xkzsk vjpnd slkjz pgct kcddk pnpg nfqkt sckjj xlqp xvsxb qlrrrgb vtrchx bjqfl tsch cmtvkq dgbndg spkl cfb vvlbp lmcqt bgxpfm dntsjl jpvvt ctbvdq nbhhmfx mxfgnv xqbtls xjsgl bqrsxn prnjsm cxbkg fsjcf jtfmtpd ccmvjbn xtnsbgc (contains sesame) khmm xxhp prnjsm vvlbp tdrxvd mdh jvxqc jgrrd jnmsr bnfhd bqrsxn ldkt xpmx cfb jbmxr vlqz zpzzt npxrdnd mnj pgct tfnsz dqntj hjkqqr hrrt nsdk gfgbq dlhfnjb qlrrrgb jpvvt tsch mrqgvd kskbk rrtkdz qdhk fzdltb nfqkt hndcnf dptsqvq xvsbr fqpt xl lfvdf lmcqt jtfmtpd (contains shellfish, soy, dairy) qpdd ldkt jfl vtrchx pbkr srvfk hmnln gkkcjs jtfmtpd djmbx fqpt cfb dhz vdqtgt hlzkpt zmvpzp tsch lg blnsd pgct qtpvndc ctbvdq mqvf flrjj vqn jzvjxf gxmk ccmvjbn jnmsr mdqdgf hclf cbdl vlqz hndcnf mxfgnv fsbll csxkh mmlq sqg dvjxl fzdltb gscxfbd npxrdnd lshjmc sckjj klnrvd nfqkt mqqzg dptsqvq nkjc xskgz tsdcm nvxk mjzpgzs lmcqt pxf dlhfnjb qvkdgn vplz szfxqq cshq kgf jbmxr mzlzxcc tmckpp zpqh (contains soy) zhvhng xmcdn gscxfbd xxhp jnmsr svvjknm ctbvdq dptsqvq ldkt hcrgt rzc cggl hnpd djmbx lmcqt xl nfkzd jpvvt kcddk dntsjl xlqp fqpt mzlzxcc qcmgxlj pzqgtb sgczbl vmhhjm nvxk tsdcm dmtcj vqn zkjh srvfk xtnsbgc jgrrd pxf vjpnd tsch sckjj ncx fkpjn cfgc lfvdf plgvrz kskbk cfb pfbz cshq ndqk bcvlvk khmm brqg sjpkc ccmvjbn cbdl lbdlb vplz nhhbtd jtfmtpd sqg (contains soy) hrhzg xvsbr rjf pfhsdp dvzz fsjcf klnrvd slkjz mxfgnv tsch rrtkdz rzc cfb srvfk pxf vvlbp pnpg mdqdgf lbdlb tcff hqtzllj jtfmtpd brqg mmhmx fqpt sfmbms xkzsk dptsqvq nrlf ldkt pgcxql vzkbf vjpnd znvmcx pbkr npxrdnd nkjc ltrhm cxbkg vplz lmcqt jvxqc prnjsm tmckpp pzqgtb jnmsr bgblpf vtrchx mqqzg pgct zfrkt svvjknm nvxk cbdl dgbndg ctbvdq rxjq mdtrqk nsdk hclf szfxqq nbh xlqp fkpjn dhz gxmk hjkqqr hndcnf tfnsz xkgpch mnj zmvpzp sqg zhvhng (contains soy) fkpjn ttlvf vlqz dscxjl dvzz vjpnd sqg srvfk qdhk gscxfbd xzn njjvq ldkt vmhhjm xskgz svvjknm xkgpch brqg hjkqqr mdtrqk sgczbl gfgbq pfbz nbh qqq xvsxb hclf lmcqt kqvhbt npxrdnd zbfqrn fqpt dqntj qcmgxlj pgct zmkx fdhfpn szfxqq ltrhm lg hqtzllj vdqtgt jvxqc hcrgt sckjj jtfmtpd zpqh kcddk fsbll zpzzt djmbx vplz cfb pnpg (contains nuts) hqxp lshjmc rrtkdz nvxk pfhsdp tcff jmvt mqqzg qdhk vdqtgt bqrsxn bxgzl mqvf kskbk qcmgxlj jvxqc nfqkt gmsnc hjkqqr qpdd ttlvf mdtrqk mmhmx ctbvdq vvlbp bggz hmnln xpmx lmcqt npxrdnd cggl prnjsm fqpt nkjc pgcxql qvkdgn xhxkf ftqpg gkkcjs mmlq sqg rjf cxbkg dqntj cvd zmvpzp slkjz pxf dscxjl tsch xtnsbgc jtfmtpd cbdl kqvhbt zfrkt fzdltb klnrvd bvzs sjpkc kcddk ldkt hcrgt zpqh sjdmzj nbh qlrrrgb dvzz vmhhjm txvctk tdrxvd vbvbbh vzkbf zhvhng zpzzt vqn fsjcf svvjknm xvsbr qtpvndc xl lkvdg nfkzd bgxpfm bcxxjq znvmcx (contains sesame) jtfmtpd blnsd mmlq fkpjn pgt ldkt xzn tsch mcvc jzvjxf jfl cxbkg tzkfgq vqn klnrvd nhhbtd xdqx fqpt jvxqc sckjj vrl bggz xvsbr hlzkpt vlqz jbmxr bgblpf bcvlvk rbkr jgrrd bjqfl jnmsr ctnb nvxk vvlbp lmcqt cfb djmbx lkvdg zmkx sqg qcmgxlj mqvf svvjknm xqbtls hmnln nrlf lxrsn dhz zhvhng pfbz rrtkdz npxrdnd znvmcx qpdd txvctk jmvt gfgbq tsrqc bgxpfm bqrsxn ftqpg ccmvjbn gscxfbd dptsqvq xkgpch pbkr cvd xtnsbgc xlqp (contains shellfish, soy, peanuts) mcvc dgbndg vzkbf dptsqvq gscxfbd jzvjxf vtrchx lfvdf vplz ltrhm pbkr jtfmtpd sgczbl spkl khmm dntsjl mxfgnv njjvq lkvdg cshq qcmgxlj ldkt vjpnd qlrrrgb jmvt dscxjl bnfhd tsch sjdmzj csxkh hndcnf nbh ccmvjbn kcddk djmbx nfqkt bgxpfm mqvf cfb mjzpgzs txvctk dlhfnjb mdtrqk cxbkg lmcqt mk bggz hqtzllj fqpt dqntj qvkdgn nfkzd cmtvkq hjkqqr mmlq rxjq (contains sesame, peanuts) lg pxf jpvvt ndqk pzqgtb mmlq zmmrgdf sqg xlqp xvsbr lbdlb qcmgxlj gmsnc xpmx mqvf jtfmtpd pgt dvzz vvlbp sgczbl spkl lshjmc hrrt zkfsg szfxqq hclf qdhk bvzs npxrdnd dqntj bjqfl fqpt tcff ttlvf lmcqt hqtzllj xdqx nsdk ldkt ccmvjbn tsch ftqpg tzkfgq kcddk hrhzg rbkr (contains soy, eggs, dairy) tfnsz bcvlvk mjzpgzs prnjsm tsch xkzsk vzkbf lmcqt mqvf dvzz cxbkg zhvhng npxrdnd vqn fsbll ttlvf hclf vmhhjm bcxxjq fpgmtjg tcff mmlq plgvrz hrrt qcmgxlj kcddk vplz ctnb pgct mk mxfgnv pxf qpdd nrlf jnmsr rbkr dptsqvq rrtkdz jtfmtpd ldkt srvfk xpmx lfvdf bxgzl ctbvdq xjsgl gfgbq slkjz xskgz mqqzg cmtvkq nhhbtd nsdk mdtrqk cfb sfmbms hjkqqr jzvjxf pgt qlrrrgb xlqp ftqpg tdrxvd hqtzllj (contains dairy, shellfish) mrqgvd rxjq cmtvkq xzn fqpt mjzpgzs mqqzg xdqx kqvhbt pfbz tdrxvd lmcqt mcvc ftqpg mdh szfxqq tsch nrlf npxrdnd ndqk slkjz jtfmtpd cfb hlzkpt prnjsm cjhv vtrchx lbdlb sckjj sjdmzj gxmk nbhhmfx dgbndg gkkcjs lxrsn dscxjl dntsjl bnfhd zpqh ldkt pgt cbdl (contains fish) jvxqc nbhhmfx jbmxr hclf nfqkt ctbvdq gxmk ctnb brqg fzdltb bnfhd dscxjl blnsd jtfmtpd flrjj bcxxjq bgblpf csxkh gfgbq fpgmtjg fdhfpn mcvc rjf zpzzt nbh vjpnd ldkt fqpt rbkr mnj pbkr vvlbp tmckpp xzn zkfsg cfb tsrqc lmcqt kcddk xvsbr ndqk sckjj djmbx vlqz lfvdf lxrsn tsch (contains dairy, soy) jfl qvkdgn nkjc mcvc ltrhm nhhbtd cjhv nfqkt znvmcx zmvpzp fdhfpn dlhfnjb hndcnf dvjxl pxf bnfhd vbvbbh mjzpgzs xbrtdm cfb lbdlb plgvrz hclf lfvdf pgt hrhzg hjkqqr dscxjl jxvc tcff lmcqt mzlzxcc slkjz rxjq dntsjl bggz fzdltb svvjknm xtnsbgc vqn szfxqq pzqgtb rjf zmkx xlqp khmm tsch ngrcb nbhhmfx zkjh mmhmx blnsd lxrsn jtfmtpd kcddk zkfsg tzkfgq sfmbms mdqdgf ldkt czcfdv kqvhbt nvxk fsbll pnpg hqxp fqpt rbkr vlqz (contains nuts, dairy) tfnsz mjzpgzs zbfqrn mxfgnv nrlf ncx ccmvjbn qqq rbkr prnjsm xskgz jtfmtpd kqvhbt fqpt zhvhng zpqh pgct lmcqt ltrhm hrrt pgcxql hcrgt nfkzd qdhk ndqk mrqgvd xvsbr xjsgl ldkt tmckpp fkpjn npxrdnd xxhp cggl jzvjxf qvkdgn cvd vjpnd qtpvndc xdqx mdtrqk kcddk dptsqvq fsjcf cfb gxmk xbrtdm flrjj dntsjl (contains fish, shellfish, nuts) sfmbms mjzpgzs mcvc hcrgt xxhp kcddk zmkx ldkt mdh npxrdnd cfb tdrxvd tzkfgq nbhhmfx vvlbp vtrchx jfl xzn rrtkdz zkjh dntsjl hmnln fsjcf rbkr tmckpp qlrrrgb xjsgl mdqdgf lfvdf jgrrd mmhmx hrhzg gkkcjs jxvc pzqgtb vjpnd lg dlhfnjb fkpjn pgcxql mrqgvd tsch vbvbbh bcvlvk tsrqc vmhhjm lmcqt jtfmtpd flrjj sckjj kgf zfrkt nhhbtd kqvhbt (contains eggs) zhvhng xskgz vlqz qcmgxlj npxrdnd cxbkg xvsbr bcvlvk xkzsk jmvt ftqpg jfl nrlf fkpjn sqg cshq lxrsn dptsqvq rrtkdz lg bjqfl mnj dqntj xzn jtfmtpd bvzs gmsnc cvd svvjknm fdhfpn cbdl bggz ndqk lshjmc dntsjl nhhbtd sjdmzj pfhsdp tsch xmcdn zmkx cfb xkgpch mrqgvd szfxqq lmcqt fqpt kgf qdhk kcddk jpvvt pnpg jgrrd dscxjl jvxqc nkjc vtrchx pzqgtb fzdltb jzvjxf (contains soy, dairy, sesame) bjqfl jmvt vrl blnsd jxvc bgxpfm sjpkc tflkk mjzpgzs fsbll vjpnd czcfdv lfvdf ncx mmhmx ctbvdq vdqtgt jpvvt hjkqqr txvctk lg ccmvjbn rzc mk dvzz xbrtdm tzkfgq vvlbp flrjj nfqkt ldkt jnmsr kcddk zpzzt lkvdg xl mqvf hrhzg vtrchx cfgc pgt xlqp xskgz dvjxl nkjc mxfgnv mcvc hqxp xpmx tmckpp pxf nfkzd cggl kqvhbt kgf fdhfpn plgvrz zhvhng jbmxr qcmgxlj fqpt bcxxjq jtfmtpd lmcqt csqrvk fsjcf tsch brqg mdqdgf fkpjn nbh srvfk hndcnf cfb mnj lbdlb mzlzxcc xmcdn qpdd hnpd hclf xzn svvjknm dptsqvq (contains soy, nuts, peanuts) nrlf zfrkt pfbz dhz bcxxjq bxgzl dgbndg vplz jtfmtpd cggl spkl ftqpg ncx cjhv npxrdnd hrrt khmm sqg djmbx sjdmzj cshq lmcqt lshjmc fzdltb hjkqqr njjvq lbdlb nbhhmfx ttlvf zpqh tfnsz fqpt qqq kcddk gxmk qlrrrgb prnjsm xmcdn tzkfgq dmtcj txvctk mdh rzc pgct ldkt ctbvdq kskbk hnpd zbfqrn vlqz tdrxvd cfb (contains peanuts, eggs) sjdmzj dgbndg cfb tdrxvd hnpd dntsjl xskgz pfbz fpgmtjg mmhmx tzkfgq lmcqt ngrcb xvsxb npxrdnd khmm mdtrqk sgczbl hcrgt tsrqc sfmbms fdhfpn xjsgl kcddk nbhhmfx ccmvjbn hjkqqr xmcdn pbkr szfxqq mnj hqxp rzc zpqh hrrt xqbtls jtfmtpd gscxfbd fkpjn mzlzxcc dqntj ldkt mk fqpt pzqgtb gfgbq xkgpch qvkdgn rjf nfqkt bvzs hclf dhz dptsqvq (contains eggs, fish, peanuts) xmcdn kcddk lg zbfqrn tzkfgq pxf qtpvndc ldkt rxjq fqpt flrjj jfl sjdmzj rzc nvxk lxrsn vvlbp zmvpzp tsch zhvhng ngrcb cfb blnsd bqrsxn djmbx jnmsr cfgc hqxp mmhmx mk mxfgnv njjvq jxvc xkgpch ncx tsdcm fsjcf fpgmtjg cvd klnrvd jpvvt nkjc xvsxb tmckpp pfbz dvjxl ctnb nhhbtd rrtkdz mdtrqk prnjsm zmkx nbh tcff czcfdv tdrxvd xxhp lmcqt vtrchx cxbkg zfrkt slkjz xl mjzpgzs dvzz cmtvkq jtfmtpd xpmx xdqx vzkbf (contains shellfish, soy, nuts) hrrt dlhfnjb dntsjl xjsgl hclf rzc rxjq djmbx mzlzxcc jnmsr mjzpgzs xvsbr xvsxb ttlvf zbfqrn mmhmx fdhfpn lmcqt tflkk rbkr npxrdnd jgrrd fpgmtjg mdtrqk vplz sfmbms hmnln bgblpf qvkdgn lbdlb bqrsxn cfb lfvdf cxbkg hcrgt hnpd ngrcb cggl ndqk kcddk xkgpch jbmxr dgbndg fkpjn nbhhmfx tmckpp bcvlvk hndcnf qdhk cjhv slkjz tsch zhvhng qtpvndc blnsd ccmvjbn xskgz nrlf hlzkpt dqntj fqpt ldkt bnfhd vrl sjpkc pbkr (contains sesame, peanuts, dairy) ================================================ FILE: advent-of-code/2020/inputs/22 ================================================ Player 1: 6 25 8 24 30 46 42 32 27 48 5 2 14 28 37 17 9 22 40 33 3 50 47 19 41 Player 2: 1 18 31 39 16 10 35 29 26 44 21 7 45 4 20 38 15 11 34 36 49 13 23 43 12 ================================================ FILE: advent-of-code/2020/inputs/24 ================================================ neswsewswseswseenwseneswseswswswseswse nwnenwwnwnwneswnenweswnwnwnwnenwswnese wnewwwwwwwwswwwsewnwwswnee wseeeeeeesesenesenweseseeseesw nenenenwneenwnenenwnwswnenwseswsenwenw sesenwsesesenweseeseseesesesesenwsesesw sesesewseswsewesenwneseswswwsesesesenese ewnenenenenewwneeneneneneseneenew eswswswwseswswsesese ewnwnwnwnwnwnwwswwwnwnwew swswswswswesewswswsweeswswswneswwsww nwwwesesewnwwwnewwwwwwenwsew wnesenwneeneneswnesenewnenwnesenwnenw swseswweseswswswswswseewse nenewnwsenwnwnenwnwnwnwnwnwnwnw neneneswnwnwnenenwwsenenenenenenenwsenenw eeseeeeneneseenwseeweseeeeswe seneswesesesesewsw swswwsweswseneswswswseswnweswsesenwwswsw swnwnwsenwwnwnwnwwenwnwwnwwwnwnenw sesewseseseseseesesenwse neneneneenenenwneswneenene swswswewswnwsewswswseswseswswseswswswne nenwnwnewneeenenwswneneneseneswneesw neswwseswnwswswsesewesenwnwswsenewe neeneneenesenwneswnenenwnwwnwnenesenesw seseswswswneswswswswnwswneswsewseseesw wnwwseswnwenewenwnweewswswswsenw eswwenweseewesenw swsewneenewnwseseweeswneeseneew eeeeeseenweeee eseswenwwseseseese sesesesenesesesesewseesewseneeweesese wwnwnwnwnwesenwnwwnwwsw eeswnwnweesweeenwsewswswenewnesw swswswswswswnweswswswsweswnwswswswneswsw wwnwwnwnwwnwnwenwsenwsewwnwswnwnenw seseeseseseseswneswsenwsenwsesesesesw enwnwwnwnwsweneseswsenwwenwnwnwenw seeenenwewweseseseswseewenesesee weswswwswwswwswwswwnwswseneswwwnw eeeeneseeneeeswneenweneneeewnesw nwwswswnweswswwwesewswswswwsw seeseneswneswswnwenwenwnwwneseswneee neneneseneneswneenenenenwnenene enenenewneswenesenwneneseneenenewne senwseseseesweseesenwnesesesesesenesesew seesesesewsewnweseeeeneeseseeese wneseswenwswnenwnwwswseseswneesenew nesenwswwnwwseewnewwwsewwnwwsw seseeswswneswneesewnwnwenesewse wswnwswswwwweswswswwsw eeeeweeseeneee swnwswnwseeeswenwnweswnwswswsewswswswne nenesenwnweenwneeneswneneeneeneeswnesw senenenwwnweneswnwnwwnwnwnwenwnwnenenwne swewseeneswneweneeneeeswnwneneeee nenwwwswwnesweewwseswswswswewwew sesesewnwseneseswsenesesesenesewesesesese nwnenenwwnwwswsewswewswnwseeeew nwwweeseneeesweeeeeewew wwnwwwewwwwnwsewwwsew neewnwnwnwswswnwnwnwswnwnwnwnwnwnenwnw eeeeenweeseeswseeeseesweneew wwwseswswswnewwwswwseneswswswsww nenesweneweeswswwnewnwnenweenee nwwwswwwwsenwwwnwwwwwenwsenww nwnwnwewnwnwwseenwnwseneenwwnwnwnwse wnwnwsewnwnwsenenw wwesewnwswenwswseenwneswswseswnwwww nwnwsewwwwwswwenwnwwnewsewwewnw wnewsenwsewseneseseeseseseseseneesee neneneneneeneswneswswnenenenenenenenwnw enwnwnwsenewnenenwnwnwnwewnwnwwnenw wwwseneseswseeneesenesenewseswenwsw newneeneneneswnenwneneeseneneenenee neeswnwswswnewwnwewwswnwseewseswe seseesesewsesenwweweswesese wsewnwswswswswswswswnwseswswseeneneswwsw senewneseswseseswswenesenwswswswswswswsesw wswneswwwswswwwwswswneswseewwe newwwwswwwwwwnwsewewwww sesewsenewseneswwnewswswswseswnenene nwneneneewnwswnenwnenwneseneenwneneswsenw eweeesweseseneneseeeeeenwsee wswenwenwswswseswsw sweenweeseneenweeeene nenwseneeeeseswnweeeeeswwneenee wewnweswwwwswwsewswnewwwswwswsw swseneeswwswwswwwswswswseswswswswne wneneneneneswnwwneeenwneneneenwnenw swnwnenwnwnwenwnenwnenwnwswnenwswnwenwnenw nenwnenwwnwnwweswneseneseneneneswnwnwsw weenwswnwnwwwnwnenwsenwnenw seseseeneeswseseeseesewswswsewsenwnwne nwwswwswwswwseswnewweseseswswwne newwenwewnwnwnwswnwswwenwnwsewnwnw seswneswswswwswswswnwswswesweeswswswnwsw swswswseswswseneewsewwwneswwswneseswne eenwseeeeneeeeeseewswseewe wwwwwwwwwnesww senwewenwseseeeeseswseseseeesee neswnwnwnwwenwnwwwsewnenwnesesewswne ewesweseneneeeseesewsewewsenwnenw newwswwweswsweswwwswwwwwwwe nweeenesweseneweenesewene enenweseseneneswwneswewseswseeew seneswsenwnenwseseswsenwseseseswsesesew seswnenwwnwswnweeeweseswnwnweesw wwnwwwwenwenwwnwwewnwnwnwnwnwsw swswnwswnewswswswswwwswsweeswswnwswswsw nenenenenenewenenenenenenesene swseeseswneseswneswswseswswswwswnwneswsw sewseneseseeeeseneew nwenenwsweeswwnwnweenwswswswenwnww eeeseseswsenwwweeswnesenwswswneww nwnenenenenenenenenwneseneneswneneenwsene seneseesweeeesee eneswseeeseseswseeeewnweesewenee wwsewswswswneswswswnew neseeswneneswneneneenwnenwnew eseseewsewewneseeenwenwesesese nenenenenenewneneeneneenee sewewsesenwwwseeneneswnenesesesenw nenenwneswneswwneseswneenwnwneeswnwnwe seeeenwseeseeseeeswneeneweewsee nwenwswnwnwenwswnenwnwnwswnenwnewneenw eswwnwneswswsenwwenenwseswseseesene eesewswseseeenwwnweseewwnese neneseneneswneneenewnwneneneswnwneneene esesenwswesesewwnesenwewswswsenwswse sesewnwnwwnenewnwwwswsewne wnenwnwnwneenwnweswwnwswsenweswsesene wnwneneseeesewsesenwnesw esesenwnwswsewswnwseneeseseseesesenwse swnwnweseeeeeeeeesenwsewnwsese nwswnwswsweswseseseseswswswswswwneseeswsw wneenwseewsenwsesesewneswsesweesee wnewswwsenenwnwsewnwnwnwnenwnwsww swewswnewwneswwnweeenweenenesene sewneswseneseseswswswseseseseswneseswse eeeenweeeneeseseewneeesweese wnwneswswnwnwnenwsenenwsenwnenwnwnenesw weneswnweneeneeesesweeneenenww seswneseseseswsesesesese neeeneneswneneweenenwnenwswneesene swswswsewnwnwseseeswswswnwswswsweswnene seseswseswwnenesese nwneswwseneneneeewwseneneenwesww wnwnenenenwsenwnwe nwwenenwenwswsenwwwsewswwnenwnwesw nwnesenwnwswsenwnwwnwwnenwwnewnwww sweeenweeeeenwsweeeeeeswneee eeseseswnwnweeeeneeseeesewnwee seswsesewweneswseswnweswneswsewneswsw wwwwsenewnwwwwwnesewswwneww swwnwnwseseswewsenwswswewnw wenwwnenwsweswnewsewswwsewnwweesw seeseeneeeeswwenwseeeswseeeee nenwneswnewseswnenenwsenewnenenenwsene neneneneswenenenwwneeswneenenenenenene enwnwnwnenwwsenenewnwnene nenenwneswnwseeswnenwneseeneneeswnene nenenesenwnewnwnwnesenwnenwnwnwwnwnene wwwseseeneswseswnwsewswswseneeene wwwseesesenwwwwwnwwnewwswsw wwswswwnwnwesewseswwnweswnwseeww neswnwswnwswenesewnew wewsewnwnwnwnwnwnenwnwwnwnwnw swsesweswneswnwneneeswswwwswswswsesenw wwweswwwswwwswswwswnw seseswseswsweswnwseswswsweseswseseswnw eswwneswswswneeswseswwwswswewene swsewnwneswnwswswseeswsewnwseswnwseese neweswswswswswsweseswnwnwnesenwswneswsew nenenenenewneneneneneeneswnwwnenenee newnwwsesenwseeseseseeeesweneseee eneeeeeseeeeeswee wswweneneseseswswseseneswswseswswwsw ewnenwneeseneeneneneseeneneweneee swwwswwenwnewswseneswswswswwwwsw eeneesweenweeeeeneweeeesew nwwsenwnwnenweseeweewsewsenewswnesw nwwnwnwnwnwnwnwwenwnwnwnwnwnewswsenw nwnenwnenwnenenweswnwnenwnwne sesenenwenwnenweseneneeneneseenenew seseeeeseeswenwse seseseeenwseseeeewsweseesenwee seseseseeseswnwsesweneseswsenwsesesesese swwseswswseswswwwneswswwwswnesw nwnwswwneeswnwnwwnwnwwsewnwwnwew newneswseswwwswwwwnewwsenwwswswswse nwwnwnwswenwnwwwnwnweswnwwewnwswnw wwsewwwwwneewwwwswswnwweww nwnwnwswnwnwnwnwnenwnwnwnwnwnw nwnwnwnwwnwswswwewwnewwne swwneeswwnwnenenenenenenenenenenenwnese eeneeneeeweeeewnesenweeeesw eseewwswwwnewwwnewwsewwwew eswwsenenwsenewesesesewesesesenenwse swswswswswswwwnwswseswsw eeseenewswwnesewweneeeenweseese wneseswswneswnwnewnewsenewnesewwsww swsenwseneswneswswswswnwswseswwwswswwsw nwnwnwsenwnwnwnwnwnwnwnwnwnwnwseswswnene nwsweseeseseswsenwenwseenwsw seswseneseswseswnwnwsewswe swsweeenwnweneswe enwwnwwnenwnwwewnwwwswsewnwnww nwewwsweewswsweswnwewneswnw wnenenwnenwnwwseneneneeneswnenesenene enwwswesewesene nenenwneneswnewenwnenenwswseenwwnwwsesw senwnwseswswswswswseseswswsenwwswswswseee eeeseeseeeewee neeswnweenweeswnwswwenenwneswneeene neseenenwseeeenwesweswwwswenenene nwnwwnwnwswseneneswwnenwsenwnwnwewnwswne sesesenwseseseseesenwseseswsesenwsesese nwesewseswsesesese wwswseswnwswwswnwsenesewsenwwwnene swnwwnenenwnwnwnenwnwnenwnwsenwnwne nenesenesenenenwneenenenwsesenwnesewnw senwwwswwnwwnwwnwwnwwnewsewsew eswnwswswwswswswwswsww wneneseneewnenene sewesweeeeeeseneweseseseneese eeeseenwesweweewseenweee sesesenesenwsesewseswsesweseswsenenwsw eenwnwwswswneewswnwnwswwswenewne senwnwenenewwnwnwwwesenwnwnwnwnwew seewwseneswenweeeseseseseeeseenw swwswswsenwswswwswneswwswwenwswnesesw esenenwseeneenenenwenenewneeewnene wwswseswsenwwwswnwswenewnewswsw neeeeeeswenwseeneeneseeeenew nwswswnwnwswsesewswswswneswnweseseseese swseseewseseneeseseseeseneswsesenwe swwswwnwneseneeswswseswswwnwswnenwew seswsewseneneseseswwsesewseswseesenesw swseswswseswswnweswswswesewwswswenw wswnwnwsweneswenwnwsenewsenwwswnew swewwwnwnwwwwwnwww seeseseenesewseeeeeenesewneswesw sewseseswseswswseswsesesesweswwne nwnwwnwesewseswneswnwnwswnewwwneww nenenewneenenenenenenewenenene eeeesewswneeeseeeeeswwenwnene esweenweeeeenee swesesewswsenewsesese seseswseswseswswseswswwnenweswseswswsw swswswseswwswswneswswnweswswewwwww sweeeeswneeeeeenweee swnenwnwenwnenwnwneswnwswnwneneenenwe sweseswswnwswseswwswswswswswswswswnww wwswswwswwneneswwwwwwnewseww seseesenweseswnwseseseswswseenwesese nenenenenenenwnewneseenenenenenene neeswnenwnwnewnwsweneeswnwnenwnwnenwnw eewneeeeeeeneeenenwneneeswswne wseswswesesesenwsenewseseeseswswsesese nwewnwwwseswnwnenewswneseseneenwswsww newwwnwnwwnenwwwwwsenenwwnwsesese newwwwenwnwnwwwwwwewwwwsw wneseneswenwswneswneswwnesewswswswew esenwswsewsesesewsenesewseeneesese nwswwnwnwwnwewnwwwwnwwewwse eeswnwnwnwnenwneneseswseswewsewseseswsw eseenenwseeswswseseweneswswnewenene nenewsenwnenenenwneneswnweeeseneneswsw nweswswnwesewnewsewwwwwnwwnenwnww neeseenweneneneneeneesenewswwnee swesenwseneeesesesesesewsewsenwese wnwnewwwneewwwwwwwswwwwse nwwnwnwnwnwswnwnwnwnwenwnwnwseesewnwnw eneswswenwneneseswwseneeenwewnenw neswnenwneneenenwnenenenwswneswnesesew sesesesesesenwswnwseseswsewseseswsesene wseswnwswseseenwnwswe wsenwsenwnwnwneewwwswenewnwwnwsw nwnwneswnenewnweswnwsenewneenwnwsene newneewewnewneswwseeenewnwsesesew eeseeswneseseswnwseswesenwswwenenwne esenwswswsweswswseneseseswsewsenwsese eswneneneswnenenenwswnesweeeneenenw sweseseenwsewswseseseeseenesenwseesee ewnwwwwwwswsewwwswswnewwnesw neeweenwnesweeswneeswneneenenee wsewwnwswwnwwseesewwswnenewwwe sweswenwswnwwnenwnwnwneswnwenwnw swnenewenwswsesewswnwwswwswwwww senenwewsesesenwsesewnewnesw wnenwseneswwnenenwswnwnenenesesenewneene swnenwewswswswwwswseswneswswswwswswsw wneeswnewwsewnwwwnwsenwwwwsenwnw seseneenewwnenwenwnwsewwswsenewsene eeeswseseseewneseesenwewswsenenesw nesenenenewnwnwnenwnenw neswewnwsewwewswsewwwwnwwwwne nwnenenenenenesewneneneneneswne swseswsesenwnenewnwwwwswswwwnenesesesw swseseesesewsenwswseswsenwesenewwnew seseneenweenwseeneenweneeeewnene wneenwseseeenewnweneneesewsenewee eewesenweeewneeeeeseeeeee seswneseenwsesesenwsesesesesesesewswswse seswnweswnwseswswswseswswseeenwswswswsese eneswenenenewnenenenenwneneswneneswnwse wsenewwwsewnwwwwwswneseswwww nenenwswenwsenwswneweweswnewsenewe esweeneeeswneneenenwneseneenwe neseseswesewswsenwswseneswseswswswseswsesw nwnenwseneneeneseenee nenewneeeneeswewswwsenenenweenesw nwnwseswnenwnwenwwseeneswwwnwnwwswse seswswswseseseswnenwsesesesesenwswsweswsw ewneswwwswnwwnwnwswwwesewenww nwsenwnwnwnwwnenenenenenwnwne wnwsenwnwwnwenwsesenenewnewwnwwnw wsenwnwswsenwnwsewsenwnwwnenwenwsenw esewsewenweswenesesenweseeseseswese nwenwseenenwneneneewneneswnwnewnwwne neenenwswneswneenenenenwnenwswwnenenenw esenesweneesweswwenwneswnweswnene ewwwwewswwnewwwwnwwwsw esenesenwnewneseneneneenenenenwweene swneeswseswwsewwwwewenenwswwnwe sesesenweeseenwseswsesesewene wswsenwseseswseeseseswnwwswsesenesesese enweeeeeeeeeewsweenweswe swswseswswneswnewswswswswneswswseswsesw eseswenweneeseswswnwwweneeeee sweswswswwswneswswswswswnesewswwswsw swnenwnwnwnenwneenenenwnwnweswnenwnwnesw eseweneneenenwnewswnwnenwswswswenw newnenesenwneenenenew ewswswswneenwnenenenenwnwnenenenenwsw neneneswswenwenenenenenesenewnenesenenene wnwwwsenwwwwwwwwnesewnwwsewnw neeneeenwewneenweeswswesenene seseneswswsenesesesenwswseswsesesesesewse nwnenwswseeeswnenwnwnwnwwnwnwnesenwne seswswswsweneswseswswswswswseswnwsw swwnwnwwnwnwnwnwnwnwsesenwnwnwnwenwnww enwnwnwneswnenwnwnwswnwnwnwenenwnwnwnwsesw nwswswswswswseswneswswswswseswswswswsenw wnweswneeeneeswswneeneewseneenee seneesenwnwnesewnwwnwnwnenw nwenwnenenwnwswnwnwnwnenenwswsenwnwenw nenwnwnwnenwnwnesweseneneswnenenwnwswswne wnwwwwnwwnwsenwnese nwwswwwnwwwnwwswenenwwwsenwww eswswnenenenwswenewneeesweeenenene sweseneesesewsewweneeeeseewsew eeneeeneeeeeeweseeeneeswsw senwnwswnwenwnwwnwswnwenwnwnwnwnwnwwnw eeswnenenweswneswwnwenwneeenwswsw eeswswweeenweeeenweeneeee nenwnwnwnwnwnwnwneswnenenenenw seeseeenenweseeewsweewesesee sweseswseseswneswswswnwsenwnwswsweswesese nwwesewwwwwnwwnwwwwnenwswwnw wseswwswwwwneswswwweewwswswwe sewnwnwweseswnwswewswwswwnewsww swwwwswwswnwswswwwswe nwewneneswnwswswneswsewseeseewswse swswnwswswseswswswsenwnwsweneneneseswwsw eenenenwseeewseneenwseneneneenee swswswseswswwneswnwswwswsweswswswswnew sewnesweewnenewneneneseswneweneese senwsewnwsenwnenwenwsenwnwnwnwnwwnwnwnw senwneswnenwnwnwwnwnwsewnwnwsewwnwnw swneneeneenwneeneeee swwswwswnwswswswswwswswswsesw nenwswnwnenwnwnwnenwenwnesweeswnenenene sweeenwnewenwsenwneeeneswneneeseee swenwenwsweswnweeeee nwwnwnwnwwenwnwnwnwnwnwseswnwnwnwwneenw nwnewnenwnwnwnwnwnwnwsenenwsenwnwnwnwnwse swseweswswswesewnwwwnwwwseewnew senwswnewnwnesenwwsewesesewnwseneswnw eneeneeneneeenwneesweenwesewsee sweenwswwwwwwwswswswswnw eeseeseneweesewseseeneseswnwnew wswnwseewnwwsenwwnewwwwsweseswne nenwnwswnwnwneneneneenenenewnwnwsenene wwswseswseswseswsewneswseseeswneswseswse nwnwswwnwenwnwsweenwewswnwswnwnwne senenenwwnenenenenenwsenewneneneswenwne eeeseeneweneweenweneeeeesee swneswswseswswwswswswswsenewswswswswwne swneswswnwnwnwnenwenesweesewneenwswnenw wwnenwnewsenwsesesenwwnwneswwewne newenwwnwsewseneewseneeeneeneesw enesewwnwnwnwswneenwnwswnwwwwnwwe senwwwwwswwnewsweswww nwswswwnewwswwwwwswwwsesew nesweneewenwsweneseeneeenwnesww seseswwseseswseseseswsesewneseswswnese wseswnenwnewnwswneewnwwseenwenwene nwnwwwwweseswwwnwwwwsenwnwneew nwnwswnwnwnwswenenwnenwnenwnwnwne seeeeeswwsewewnwwwenwwsenwne neswnenwnwwwnenwenwnwnwneseneenwnenwnene swseswseseswenwneenwswswswsewewswsw nenwnwnenenwswnwnwnwnwnenwnw seneneseswseswsesesesesesesenwwseseswsese swwewewsewwswnwwneswswwwswwwsw neeewseseeswesesenwnweewnwseswsesesw ewsweneesenwnesewneseeneeneenee nwnwnwnwnenwnwnenewnwenenwnw ================================================ FILE: advent-of-code/2020/inputs/3 ================================================ .#..........#...#...#..#....... .###...#.#.##..###..#...#...#.. #.....#................#...#.#. #.....#..###.............#....# ......#.....#....#...##.....### ....#........#.#......##....#.# ..#.......##..#.#.#............ #.............#..#...#.#...#... .#...........#.#....#..##...... ......#..##..#....#....#...##.. ....#.##.#####..#.##..........# ..#.#......#.#.#....#.....#.... ...###.##......#..#.#...#...#.. ...#..#.#..#..#.......#........ ...#....#..#...........#.#..... ....#.........###.#....#...#... ....#..##.....#.##....##.#..... ........#.#.#.....#........#... ..#..#.....#.#...#.#...#.#..... ....#..........#....#....#...## .##...#..#...##....#..#.#....#. .#....##..#...#................ ..#.###.........#.###.....#.... ....#..#.......###.#........... #...#...#.#...........#.#...... .#..#.......##.....##...#...... ....####.#..#.#.#...........#.. .##...#..#..#.#....##.....#..## ...#......##....#...#.#.###.... ##.#...........#.........#...#. ...........#...#...........##.. .....#....#...........#........ ...#..#.........#...#....#.##.. .....##.........#...#........## ....#....#..#.#...#...##.#..... ...#.#..#...#...........#..#... .....#.#.....#....#...#....#... .#.............#..##..........# ..........#......#..##.....###. ..#....#........#.#.....##...#. #..#......#.#.##......#.#.##... .....#..#.........#...#.#.#.#.# #.#...#.......#.#..##.##.....## .....#......##......#.......#.. #.....#...##.#.#........#...... #..........#.#...#.......#..... ..#..#........#........#....... ...#....#....#..####.#....#...# #.............#.....##....#..#. ##....#.....###..##....#......# #.....#...#.#.............#.... .#.#..##..##.#..#....#.#.#...#. .#...#..#.....#..#.#.#..#...##. ..#.#.#.#.#.#....##...#........ .......##.....#..........#...#. ...#..#...#...........#....#... .....#..#....#..#.##...#....... ..##..#.......#.#..#....#...... ...#...............#.#..#...... ....#........#...#....#...#.#.. ...#...#..........##....##.#... ..###.#.##.............#..#.#.# ##.......##.#..#.#.#.....#.#.#. ..#####...#......##...#........ ...#.##...#................#..# ..#......#...#....#.#..##..#... #.#.........#............#..... ##.............#.#.....#......# ....#.......#..#..##....#.#.... ...#...##....#.........#..#.... ...####.....#...........#....#. #.#........##....#..#..#...#... ....#.#.###..........#........# #.#......#.....#.##....#.#...#. #....##.#..##..#.#............. .#.....##..#..................# ...#.#........#...#.#........#. ..#....#......#.....##........# ....#...#....#...#.....#.##.... ...#........#.......##......... .#.##......#......#....##...... .#...#...###.#............#..#. .#...........#.#.#....#...#..#. .#.....#....#.....#...#........ .#..#.....#............#.#.##.# ...###.#.............#..##..... ...#.#.##.#..#..........#..#... .#.#.#....#..#...............## .......#.#..#...#.#.#........#. ....#.#...#..##....#........#.# ..........#...#.......#..#....# ...###.....#.#....#.....##..... #......#..#..#........#.#...#.. #......#....#..#.#............. ...#....#........#...#..#...... ...#..###........#.#.........## #......#.#..###..#........###.. .#.#......#.#..#.#.#.#.....#..# #....#.....#..##.....#......... ....#......#...#..#..#.#.##.#.. ........#.#...#...#..#...#.#..# .....##........#...#....#...#.. ....#...##..#........#....##.#. ...............#.....#......##. ..##.....#.....#.#............. .....#.#...........##.#.....#.. .#..##..#.##.#...##.#....#....# .##.....#.##......#....#..#..#. .......#.##......#....#...#.#.. .#........#......#...##.#....#. .........#..........#.......### #.#.........#..#..#....#...#... .......#.........#......#.#.#.. .......#...........#....#....#. .###...##.#.#..........#...#..# ....#.....#...#..#............. .......##........#..#.......#.. ....##..#.#....#....#..#...#..# ..#.####.....#.........#.#....# ..............#.#..#.....#...#. .....#.............#..........# ..##.#...#.....#....#.#....##.. .#...#.......#..####..#..#...#. #..........#................##. ......##.....#................. ..##...#.#..........##.#...#... ....#.#.#.#...##...#...#...#### .............##..#.###...#..... #.#....#.#..#..##........#..##. .....#.#...............#....... ...#..##......#..##...........# #..#....#...........##..#...... .##....#.#....###.......#..#... .....#..#.#....##...#......#... .#.........#####......#...#...# .......#.#.....#.....#.......#. #....#.......###.......#..#.... #......##.###...#.......#...... .......#...#......#....#..#.... .#.####.......#...#.##......... ................##.#......#.... ......##....#.#......#......#.. ....##...##....#.........#..... ......#.#..............##.#...# ....#.#......#.#.............#. .#.#..####...#................# ....#.#.#.#......##...##......# .....#.#..#......#....#......#. ..........#.#.....#.......#...# ..##......##.#...##.#......#..# ...#............#..#...###..... .#.#..###..#.......##...#.....# .#....#.#.......#.....##....#.. #.............###...##.#.#...#. #........#.#........#.#...#.#.# ##..#.................#....#... ...#.#...#..#.#..##....#...#... #.....#.......#..............#. .......###...##..#.....#....... #.#.........#..#.#.........#... .#.#............#.....##.....#. ........#....#....#.......#.... ...#.#....#..#.##....#.#......# .#.....#.#..#...........#.#.#.. #......#..#......##.#.#.#.#..#. .......#.#..#......#.#.#..#.#.# ..........#...#..........#.##.. .#.#..####.......#..........#.. ......#.#.....#..#..#..#.....#. .....##..#.#.#..#..#...#.....## ............#.#....#.#....#.... ..............#..#...#...#..... .....#......#.......#.....#.... ..##....#..#...........#..##... ###...#.##..#.#...####....###.. ..#.#.....#.........#....#..### ##...........##.............#.. ....##..............#.........# ...#...##....#.#..#...##.....#. ..#..##...#.......#..#..#.....# ...#...#....####........##.#... ....#........#..#.#.........#.. .#..........#...#..#.#.#......# ....#.#.....#.........#....#... ...#....#...##.......#...#..... ....#..#.......#.##.##.##...#.. ##....##........#........##.... .#.#..#...........#.....#...#.. ...#.##...##..#...#...##....... .....#..###................#.#. ...#........##.#....##.....#.## ...#...#..##...#...#.#...#..... .#......#...#..#.##.......#...# .....#.......###.##...#........ #.....#..#........##.##.#.##..# ....#..............##.##...#... #..........#..................# ..##.......#..........#..#..##. .#....###.#..#.........###....# .#....#.##..............#.##.## .#.##.#....#.......#.#......#.. .#............#.#.....#........ ..#......#.......#............. #.#...#........##...#.#......#. ....#.........#........##..#... ..........##.....#.#......#.... .##.#..#....#.......#...#...##. .#................#...#.##..... ....###.......#..#..#.........# .#.....#..##...###......#.....# .#.##..........#..#..#........# .......#.##..............#...## #...#.#.#.......#..#......#.##. .#....#.#......#...#..........# .....#........##....#.##.....#. .#....................#..#.#.#. .....#.........#....#.......#.# .....#.#..##..#.....#..#....... ...#..#..#...#.....#....#....#. #.....#.#.#..........#..#.#.#.. .....##..##.....#.#..#......... #.#..##....##......##...#.##..# ..##..#.....#..#..........##... ......#.#...#..#.......##.....# ..#.#.......#.#......#......... .....#........##..#.....####.#. .#.....#........#.......#..##.. ......#...#....#.##...#.......# ..##..................#..#..... .....###.#..##...#............. ...##...##...#......#....#....# #........#.#..........##..#.... #........#....#..........#...#. ...##.#.##..#...##......#...... #........##....#.#..##.....#..# ...####......#..#......#.#..... .#......#...#...#.#.....##....# .....###..##..#...#..........## ##.##....#...#................. ...##.#.......#.###......#..#.. .....#.#.#.......#.......#..#.# #...#...#.##..#....###.......#. .#.#..##.....#....#...##....... .....#..........#....#...#.##.. ..........#....#...#........... .#....#..#...#...#.......#....# #..#..............#.....####.## .......#....###....#....#.#.#.. ###.#........##.#.......#...... #..#...#..#......#............. #...###..#...#..#..##.#.###.#.. ..#..#...##......##............ .#..#.......#..###..##...#..... ....#..#..##.#.#.....##...#.#.# ....#....#.....#..#....#....... ..##..#....#.#...##..#......... .....#....#...........#.#...... ...#........#.#..#..#......#..# .#...##....#....#.#.##......#.# ..#...........#..###.##.....#.. .#.######.#..##.......#..#..... .....#..#......##.#.#...#...... ....#....#..#.....#.......#.#.# .....#........##.....#.....#.## ........#....#...#...#.#.#...#. ...#.#.....#...........#.....#. #.#.#...###......#.....#.....#. .#..........#.....#.......##... #................#.#.....#.#### .#......#......#.#..##.#.##.... ..........#....#...........###. .##....#..####..#####.......... ##.......##............#.....#. ...#.....#...#....#.......#.... .#....##......#.#...#....#..... ....#............##..........#. .#....#....#.....#.#........... .............##.#.##...#.#.#... ..#............#.#..##.#....##. #.....#...##..........#.#.#...# ......#............#..........# ..##..#.....#........#.##..#..# #..#.#..##.#.....##.#.......... #..#...#.#..#......##.......##. .##......#...........##.....#.. ...#.....#.....#..#....#....... .....#...............#........# .......#.....##..#..##..#.#.#.. #.#.....#..#..........##...#... #..#......#.................#.# .##...#....#...#...#.......#... .#........##........#.......... ........#..........#.........#. .....#.##..#.......#........#.. ..##..#..#...##..#.#....#...... ......#........#.##.....#.#.... .#...#.#.........#..#.#.#.#..#. .#..#.#...#............#.#..#.. ....#.................#...#..## .........##.....#.#.#......#### ...............#....##.#.#..... ....##..#....#......#....#..... ....##.#...#....#.#..#...#..#.. ..##......#.#..#........#.#.#.. .........#.#................##. ##.....#.....##..##.#........#. ###....#..#..#..#..#.##..##.#.. .....##..#...........##..#.#... ....#..#..#..#....#...#.#....#. #....#............#..#....###.. ....#..#.............#....##.#. ...#.................#...#..... .##...#....#..#..#........#.... ...#.#..#...#.#......#....#.... ...#.......##..........#...#.#. ...##..#.......#........#...#.. .....#.#.#....#..##......##...# ....##......#........##....##.. ..#..........#.#.##.....#...... ..................#..#..#..###. .#..............#.#..#.#..#.### ..#....#....#......#..##..#...# #.........#..#..#...........#.. ================================================ FILE: advent-of-code/2020/inputs/3.sample ================================================ ..##....... #...#...#.. .#....#..#. ..#.#...#.# .#...##..#. ..#.##..... .#.#.#....# .#........# #.##...#... #...##....# .#..#...#.# ================================================ FILE: advent-of-code/2020/inputs/4 ================================================ iyr:2015 cid:189 ecl:oth byr:1947 hcl:#6c4ab1 eyr:2026 hgt:174cm pid:526744288 pid:688706448 iyr:2017 hgt:162cm cid:174 ecl:grn byr:1943 hcl:#808e9e eyr:2025 ecl:oth hcl:#733820 cid:124 pid:111220591 iyr:2019 eyr:2001 byr:1933 hgt:159in pid:812929897 hgt:159cm hcl:#fffffd byr:1942 iyr:2026 cid:291 ecl:oth eyr:2024 cid:83 pid:524032739 iyr:2013 ecl:amb byr:1974 hgt:191cm hcl:#ceb3a1 eyr:2028 ecl:gry hcl:eefed5 pid:88405792 hgt:183cm cid:221 byr:1963 eyr:2029 pid:777881168 ecl:grn hgt:181cm byr:1923 eyr:2021 iyr:2018 hcl:#18171d byr:1941 eyr:2027 ecl:gry iyr:2016 pid:062495008 hcl:#a5e1b5 hgt:178cm cid:56 byr:1971 hcl:#efcc98 pid:649868696 iyr:2011 eyr:2025 hgt:164cm ecl:blu pid:117915262 eyr:2023 byr:1925 iyr:2020 hcl:#888785 hgt:188cm iyr:2012 cid:174 eyr:2024 pid:143293382 ecl:brn byr:1946 hgt:193cm eyr:2021 iyr:2011 hgt:192cm pid:251564680 byr:1976 ecl:blu hcl:#602927 byr:1973 ecl:blu hgt:164cm eyr:2022 pid:695538656 iyr:2010 cid:244 hcl:#b6652a iyr:2014 eyr:2027 pid:358398181 ecl:hzl hgt:74in byr:1949 cid:329 hcl:#ceb3a1 cid:211 byr:1954 eyr:2023 hgt:172cm ecl:blu iyr:2019 hcl:#623a2f pid:657051725 pid:562699115 eyr:2026 byr:2000 hgt:162cm hcl:#602927 ecl:amb iyr:2018 ecl:brn iyr:2013 pid:835184859 byr:1981 hgt:157cm eyr:2027 hcl:#b6652a pid:763432667 byr:1981 hcl:#cfa07d ecl:brn iyr:2010 hgt:63in cid:107 eyr:2027 byr:2009 hgt:177cm cid:314 hcl:f55bf8 eyr:2025 pid:632519974 iyr:2015 ecl:amb eyr:2024 pid:614239656 hgt:169cm iyr:2014 ecl:hzl byr:1992 hcl:#602927 ecl:blu eyr:2026 hcl:#efcc98 byr:1980 iyr:2013 hgt:161cm pid:065413599 hgt:182cm eyr:2025 iyr:2013 pid:939088351 hcl:#b6652a byr:1994 ecl:amb hgt:65in cid:220 ecl:amb hcl:#ceb3a1 iyr:2013 eyr:2025 pid:167894964 byr:1976 hgt:185cm cid:88 ecl:blu iyr:2020 eyr:2020 hcl:#888785 pid:582683387 byr:1981 hcl:#866857 eyr:2020 byr:1948 pid:358943355 ecl:amb hgt:164cm iyr:2019 pid:127467714 hcl:#ceb3a1 byr:1991 hgt:163cm eyr:2020 iyr:2017 ecl:blu cid:229 cid:156 byr:1942 eyr:2024 hcl:#cfa07d ecl:blu pid:843747591 iyr:2014 hgt:173cm hcl:#a97842 hgt:165cm iyr:2013 ecl:#781088 byr:1952 pid:516882944 eyr:2026 hgt:179cm byr:1969 pid:408297435 iyr:2020 ecl:oth hcl:#cfa07d eyr:2020 ecl:amb iyr:2013 hcl:#b6652a eyr:2023 cid:88 pid:324081998 hgt:66in byr:1945 iyr:2012 eyr:2024 hcl:#18171d pid:756726480 byr:1947 ecl:oth hgt:164cm ecl:blu hcl:#fffffd byr:1951 iyr:2019 pid:544645775 hgt:153cm eyr:2027 pid:655906238 ecl:brn eyr:2028 byr:1959 hgt:63in cid:338 iyr:2020 eyr:2020 hcl:#602927 hgt:72in iyr:2014 pid:305025767 cid:297 byr:1957 ecl:gry hgt:155cm byr:1942 hcl:#a97842 iyr:2014 ecl:gry pid:593995708 eyr:2022 pid:219206471 byr:1955 eyr:2030 hcl:#a97842 ecl:oth iyr:2015 cid:134 hgt:170cm iyr:2013 cid:268 eyr:2020 hcl:#a97842 ecl:grn pid:235279200 hgt:178cm byr:1952 iyr:2013 pid:016384352 eyr:2027 hcl:#866857 ecl:grn hgt:161cm byr:1943 ecl:amb hgt:169cm pid:149540593 iyr:2012 eyr:2040 hcl:#a97842 byr:1954 byr:1938 ecl:brn hcl:#b6652a eyr:2026 hgt:184cm iyr:2018 pid:832531235 byr:1945 iyr:2015 hgt:171cm eyr:2028 pid:998746896 ecl:hzl hcl:#866857 hgt:73in ecl:hzl eyr:2023 cid:343 pid:458004221 iyr:2017 byr:1962 hcl:#efcc98 byr:1970 hgt:159cm pid:925022199 iyr:2013 eyr:2028 hcl:#888785 ecl:hzl eyr:2027 iyr:2016 ecl:gry hcl:#cfa07d pid:006246552 byr:1939 cid:124 hgt:177cm byr:1982 iyr:2016 hgt:159cm cid:102 hcl:#fffffd eyr:2029 ecl:grn pid:619798285 iyr:2018 hgt:189cm hcl:#efcc98 byr:1937 eyr:2023 pid:727551553 ecl:oth iyr:2014 byr:1976 eyr:2020 hcl:#7d3b0c pid:125102070 ecl:amb hgt:186cm hgt:187cm byr:1949 pid:027653233 eyr:2021 hcl:#341e13 ecl:hzl iyr:2020 iyr:2016 byr:1954 pid:545631256 hcl:#602927 eyr:2023 hgt:191cm ecl:amb pid:509762954 hgt:190cm ecl:hzl byr:1991 eyr:2022 iyr:2019 cid:187 hcl:#c0946f eyr:2024 hgt:152cm cid:277 iyr:2015 pid:872373191 byr:1988 pid:544267207 cid:113 iyr:2015 hgt:181cm hcl:#6b5442 ecl:gry byr:1971 ecl:gry hgt:161cm iyr:2012 byr:1965 pid:574527322 hcl:#fffffd iyr:2018 byr:1976 hcl:#b6652a pid:024582079 hgt:169cm ecl:oth eyr:2021 pid:020478204 byr:1945 hcl:#7d3b0c cid:239 eyr:2025 hgt:188cm ecl:grn iyr:2012 eyr:2026 pid:202653345 byr:1988 hcl:#2cdc09 hgt:185cm iyr:2010 ecl:hzl hgt:183cm iyr:2017 hcl:#18171d byr:1977 eyr:2029 pid:804559436 ecl:grn hcl:#602927 pid:812072269 hgt:170cm eyr:2026 byr:1955 iyr:2020 ecl:gry eyr:2023 iyr:2010 hcl:#cfa07d pid:592419048 byr:1943 ecl:brn hgt:172cm ecl:brn iyr:2013 pid:558179058 hcl:#fffffd eyr:2022 byr:1922 cid:331 hgt:64in ecl:xry hcl:ade850 eyr:1995 pid:976028541 iyr:2030 hgt:179cm byr:2030 ecl:#2872b1 pid:158cm eyr:1927 hcl:ee8e92 iyr:2014 hgt:190cm byr:2025 hgt:155cm cid:283 eyr:2020 ecl:blu pid:755165290 byr:1936 hcl:#733820 iyr:2012 eyr:2030 byr:1943 cid:323 pid:906418061 hgt:157cm ecl:amb iyr:2010 hcl:#7d3b0c hcl:#fffffd pid:873200829 hgt:192cm eyr:2022 ecl:blu iyr:2016 byr:1920 cid:200 eyr:2021 byr:1963 hcl:#a97842 pid:585551405 iyr:2019 cid:91 ecl:brn hgt:60cm byr:1946 pid:520273609 hcl:#341e13 cid:66 iyr:2020 hgt:154cm eyr:2024 ecl:brn ecl:brn hcl:#d64d7b eyr:2020 byr:1957 hgt:181cm iyr:2019 pid:378496967 cid:135 pid:002446580 eyr:2027 byr:1939 hcl:#888785 iyr:2011 cid:168 ecl:oth hgt:160cm iyr:2019 hgt:70in hcl:#7d3b0c byr:1983 eyr:2024 pid:369493064 cid:54 ecl:oth iyr:1979 pid:170cm hgt:65cm eyr:1933 hcl:z ecl:zzz pid:193cm hcl:z eyr:2020 byr:2013 iyr:2016 hgt:177in iyr:2010 hgt:187cm byr:1932 hcl:z ecl:oth pid:665967850 eyr:2030 eyr:2029 iyr:2013 hcl:#b6652a ecl:amb byr:1936 pid:516025566 hgt:181cm hcl:#c0946f pid:238825672 byr:2000 iyr:2013 eyr:2028 ecl:amb hgt:183cm eyr:2021 hcl:#866857 cid:77 iyr:2017 hgt:156cm pid:271118829 ecl:amb iyr:2014 hcl:#fffffd cid:321 hgt:159cm ecl:gry pid:691381062 eyr:2022 byr:1991 pid:111506492 hcl:#c1d296 iyr:2011 byr:1934 hgt:176cm cid:263 eyr:2028 ecl:amb iyr:2014 hgt:64in eyr:2024 cid:193 hcl:#b6652a byr:1967 ecl:oth pid:138677174 hgt:168cm iyr:2020 eyr:2030 hcl:#6b5442 ecl:brn pid:975843892 byr:1927 byr:1957 ecl:amb iyr:2012 pid:177266671 eyr:2026 hcl:#866857 hgt:162cm eyr:2029 hcl:#341e13 hgt:175cm pid:465809700 ecl:amb byr:1974 iyr:2010 hcl:#a97842 iyr:2010 hgt:176cm eyr:2029 byr:1931 ecl:grt pid:161604244 eyr:2024 iyr:2018 hgt:170in byr:1959 ecl:gmt hcl:#888785 pid:94163132 iyr:2011 hgt:186cm pid:998471478 byr:1956 ecl:amb eyr:2029 hcl:#efcc98 cid:76 ecl:brn byr:2001 pid:378527883 iyr:2013 hcl:#83bdc5 eyr:2020 hgt:181cm iyr:2017 ecl:grn hgt:172cm hcl:#888785 cid:100 eyr:2022 byr:2030 pid:311562177 pid:097558436 cid:141 hgt:152cm iyr:2019 ecl:brn eyr:2023 byr:1940 hcl:#6b5442 iyr:2016 eyr:2023 byr:1992 hgt:174cm ecl:amb pid:691291640 cid:190 hcl:#fffffd hcl:#623a2f ecl:brn eyr:2028 cid:227 iyr:2012 hgt:74in pid:964273950 byr:1965 hcl:#ceb3a1 eyr:2028 iyr:2013 pid:175294029 hgt:150cm ecl:grn byr:1936 cid:143 byr:1935 hcl:#a97842 ecl:oth hgt:180cm iyr:2019 pid:857891916 eyr:2026 pid:084518249 ecl:hzl eyr:2027 hcl:#c0946f hgt:192cm cid:315 byr:1961 iyr:2010 hgt:67cm pid:37925169 eyr:2022 hcl:z iyr:2012 cid:315 byr:2028 ecl:dne hcl:#c0946f byr:1924 hgt:176cm cid:87 pid:682212551 iyr:2011 eyr:2026 ecl:gry hgt:181cm byr:1935 iyr:2018 pid:644964785 eyr:2026 ecl:amb pid:789810179 ecl:gry eyr:2021 cid:159 hgt:185cm iyr:2020 hcl:#602927 byr:1965 pid:672386364 iyr:2013 eyr:2021 byr:1951 hcl:#341e13 ecl:gry hgt:173cm hcl:#18171d eyr:2030 pid:957722245 iyr:2012 byr:1955 ecl:grn hgt:154cm byr:1955 ecl:oth hcl:#cfa07d eyr:2030 iyr:2013 pid:361945273 hgt:154cm iyr:2012 eyr:2027 ecl:grn hcl:#16d373 hgt:192cm pid:275525273 byr:1986 iyr:2017 eyr:2022 ecl:grn hgt:75in hcl:#919cc0 eyr:2029 cid:84 hcl:#cfa07d iyr:2013 hgt:78 ecl:brn byr:1925 pid:281331549 eyr:2027 cid:219 iyr:2016 byr:1971 hcl:#7d3b0c hgt:179cm ecl:grn pid:301296222 eyr:2030 iyr:2010 pid:995982765 byr:1926 ecl:amb hcl:#888785 hgt:186cm byr:1955 iyr:2015 hgt:165cm cid:101 eyr:2027 ecl:amb hcl:#602927 pid:168654790 hcl:#7d3b0c byr:1956 eyr:2029 hgt:155cm ecl:grn pid:816685992 iyr:2016 ecl:grn hcl:#cfa07d cid:71 pid:914724136 iyr:2012 eyr:2024 hgt:184cm byr:1938 ecl:gry eyr:2029 hcl:#602927 pid:255062643 iyr:2015 hgt:175cm hcl:#341e13 iyr:2017 eyr:2028 pid:459704815 byr:1922 cid:312 ecl:brn hgt:152cm ecl:dne eyr:1981 pid:8356519470 hgt:176 iyr:1941 byr:2006 hcl:z ecl:amb pid:753377589 hcl:#a97842 eyr:2022 hgt:187cm cid:130 iyr:2013 byr:1961 pid:952444443 hcl:#bde835 byr:1963 iyr:2020 eyr:2025 ecl:amb hgt:162cm eyr:2027 iyr:2018 hcl:#ceb3a1 hgt:152cm pid:882429463 ecl:blu byr:1969 cid:134 eyr:2021 hcl:#a97842 hgt:63in ecl:grn byr:1975 iyr:2019 pid:154078695 byr:1956 eyr:2027 pid:396230480 hcl:#b6652a hgt:175cm iyr:2020 ecl:oth ecl:grn cid:263 hcl:#506937 byr:1924 eyr:2030 pid:705511368 hgt:159cm iyr:2011 eyr:2020 hgt:178cm ecl:grn byr:1947 hcl:#888785 pid:177476829 iyr:2019 ecl:hzl cid:211 iyr:2016 hgt:176cm pid:405182470 byr:1952 hcl:#866857 eyr:2028 eyr:2032 cid:152 ecl:gmt hgt:150in pid:75969209 byr:2019 hcl:z iyr:1940 hcl:#fffffd hgt:193cm pid:607407479 cid:300 byr:1944 iyr:2017 ecl:oth eyr:2026 hcl:z cid:125 eyr:2040 ecl:dne byr:2015 pid:733096171 hgt:63cm iyr:1922 pid:575721428 hgt:152cm cid:275 hcl:#cfa07d eyr:2028 byr:1935 ecl:hzl iyr:2016 iyr:2012 ecl:grn eyr:2027 hcl:#623a2f pid:029106453 byr:1984 hgt:168cm ecl:blu cid:140 eyr:2028 iyr:2018 hcl:#c0946f hgt:163cm byr:1944 pid:709288293 byr:1936 hgt:172cm eyr:1997 hcl:#8b8c88 cid:50 iyr:2016 pid:205477922 ecl:grn hgt:170cm pid:872750582 eyr:2027 byr:1985 iyr:2017 hcl:#d6976a ecl:blu hgt:163cm pid:189634089 cid:116 byr:1975 eyr:2030 hcl:#efcc98 ecl:brn iyr:2020 ecl:amb byr:1953 hcl:#6b5442 pid:418787965 iyr:2018 hgt:193cm eyr:2026 ecl:#3ec898 cid:339 hcl:#866857 eyr:2025 hgt:179cm pid:591430028 iyr:1936 byr:1995 pid:285371937 hgt:159cm byr:1922 iyr:2013 eyr:2023 hcl:#6b5442 ecl:amb pid:545260883 ecl:oth hgt:163cm iyr:2015 eyr:2021 byr:1975 hcl:#866857 ecl:hzl hgt:182cm pid:053762098 eyr:2023 cid:174 hcl:#6daac4 iyr:2017 byr:1937 hgt:178cm iyr:2015 byr:1956 pid:815359103 ecl:blu hcl:#cfa07d eyr:2030 hcl:#7d3b0c pid:438108851 hgt:162cm byr:1930 iyr:2014 eyr:2024 ecl:amb eyr:2027 iyr:2019 hcl:#90eb1c hgt:178cm pid:314810594 cid:278 ecl:amb byr:2001 byr:1949 iyr:1942 hcl:#888785 ecl:hzl hgt:184cm eyr:2027 pid:899137640 hgt:153cm eyr:2022 iyr:2011 byr:1975 hcl:#602927 ecl:amb pid:178cm hcl:#6b5442 ecl:amb iyr:2018 eyr:2025 pid:418735327 byr:1922 hgt:74in ecl:gmt hcl:z iyr:2024 eyr:1988 hgt:75cm cid:125 pid:690872200 byr:1928 eyr:2024 hgt:184cm pid:4634589837 ecl:zzz iyr:2022 byr:2000 hcl:89c187 iyr:2017 byr:1966 hcl:#efcc98 ecl:brn pid:473085232 eyr:2021 hgt:174cm hgt:67in eyr:2030 iyr:2014 byr:1943 hcl:#602927 cid:344 ecl:oth pid:210476779 byr:1955 ecl:oth hgt:193cm iyr:2012 hcl:#623a2f pid:818289829 eyr:2021 byr:2018 ecl:#872a51 iyr:2024 hcl:97783d pid:155cm hgt:174cm eyr:1964 hcl:#6b5442 hgt:157cm byr:1932 ecl:brn pid:4275535874 eyr:2024 iyr:2015 pid:959861097 hgt:151cm cid:140 byr:1935 eyr:2029 iyr:2018 ecl:hzl hcl:#623a2f hgt:181cm pid:911791767 eyr:2027 iyr:2016 byr:1962 ecl:grn hcl:#866857 eyr:2021 byr:1994 hgt:162cm hcl:#866857 ecl:oth iyr:2014 pid:712345689 hcl:#7d3b0c hgt:170cm pid:600132416 eyr:2025 iyr:2016 byr:1978 ecl:brn hcl:#0a9307 cid:287 byr:1940 pid:786271493 eyr:2028 hgt:186cm iyr:2019 ecl:oth eyr:2025 hgt:190cm ecl:hzl cid:228 iyr:2019 byr:1932 hcl:#623a2f pid:648307551 pid:304587325 iyr:2019 byr:1923 hcl:#7d3b0c hgt:190cm ecl:gry eyr:2030 hgt:188cm eyr:2027 byr:1958 pid:572934921 hcl:#888785 ecl:hzl iyr:2010 iyr:2019 hgt:178cm ecl:grn hcl:#7d3b0c pid:007601227 byr:1975 eyr:2023 pid:808872803 byr:1929 ecl:grn eyr:2022 iyr:2019 hgt:74in hcl:#602927 iyr:2019 cid:67 hcl:#602927 pid:292601338 ecl:hzl byr:2001 eyr:2023 hgt:171cm byr:1962 eyr:2022 hcl:#b6652a hgt:193cm ecl:oth iyr:2010 hgt:70in iyr:2014 hcl:#a97842 cid:169 eyr:2020 ecl:amb pid:329751670 byr:1959 byr:1920 ecl:oth hgt:172cm cid:57 pid:515139276 eyr:2030 hcl:#18171d iyr:2013 iyr:2012 hcl:#a97842 pid:946040810 hgt:65in byr:1936 ecl:amb eyr:2020 byr:1948 hcl:#18171d iyr:2019 ecl:hzl cid:185 eyr:2023 pid:583625200 hgt:191cm hgt:154cm eyr:2022 pid:460137392 iyr:2010 ecl:grn hcl:#ceb3a1 eyr:2024 iyr:2016 pid:890698391 hgt:172cm hcl:#a97842 cid:271 ecl:oth byr:1926 hgt:162cm pid:340904964 hcl:#b6652a byr:1966 iyr:2010 cid:260 eyr:2028 ecl:amb byr:1933 eyr:2029 pid:642043350 iyr:2016 hcl:#b6652a ecl:grn pid:602218620 eyr:2023 ecl:blu hcl:#623a2f byr:1950 hgt:168cm iyr:2015 ecl:gry pid:490792384 byr:1974 hcl:#a97842 iyr:2016 hgt:170cm iyr:2020 ecl:gry byr:2002 eyr:2029 hcl:#9f45c4 hgt:155cm pid:604239618 hgt:190cm pid:560653271 iyr:2020 cid:349 eyr:2024 ecl:blu hcl:#efcc98 byr:1936 eyr:2021 byr:1964 hcl:#efcc98 ecl:grn iyr:2018 hgt:165cm pid:218376636 pid:186217101 iyr:2019 hgt:155cm byr:2017 eyr:2022 ecl:grn cid:349 hcl:ece72e iyr:2015 eyr:2026 pid:802832833 hcl:#888785 hgt:190cm ecl:brn byr:1952 cid:202 cid:151 iyr:2017 hgt:152cm hcl:#a97842 eyr:2020 ecl:hzl pid:554959609 byr:1941 cid:116 iyr:2019 hgt:159cm byr:1992 pid:662111811 hcl:#18171d ecl:oth eyr:2024 ecl:grn byr:1966 iyr:1950 pid:585351486 eyr:2038 hgt:178in hcl:a27d2b iyr:2014 cid:238 hgt:187cm pid:523401750 ecl:amb hcl:#18171d eyr:2023 byr:1984 eyr:2021 byr:1957 pid:340752324 iyr:2015 hgt:157cm hcl:#602927 cid:70 ecl:oth pid:458479816 ecl:hzl eyr:2022 hcl:z hgt:60cm byr:2012 iyr:2005 cid:57 hgt:154cm pid:446142864 hcl:#341e13 byr:1968 eyr:2030 iyr:2019 ecl:brn eyr:2028 pid:243811429 byr:1977 iyr:2011 hcl:#18171d hgt:185cm ecl:oth cid:205 byr:1976 eyr:2029 pid:649877471 hcl:#cfa07d hgt:152cm ecl:blu iyr:2013 iyr:2009 pid:559014976 ecl:oth hgt:189cm byr:1936 eyr:2037 hcl:#efcc98 pid:134378987 byr:1983 iyr:2013 hgt:173cm ecl:oth hcl:#ceb3a1 cid:80 eyr:2020 hgt:151cm byr:1964 ecl:grn iyr:2010 hcl:#b6652a pid:939492531 eyr:2028 byr:1961 iyr:2014 hcl:#733820 hgt:179cm eyr:2026 ecl:gry pid:732892920 iyr:2018 byr:1996 pid:944007809 ecl:hzl hcl:#866857 eyr:2021 hgt:155cm pid:374875696 hcl:#7d3b0c ecl:oth hgt:193cm byr:1948 cid:238 iyr:2020 pid:305782299 hcl:#b6652a ecl:brn hgt:172cm iyr:2018 byr:1927 pid:945869114 cid:95 byr:1989 hgt:173cm eyr:2025 hcl:#b6652a iyr:2012 ecl:amb pid:55484149 eyr:1958 iyr:1956 ecl:grn cid:95 byr:2028 hcl:c2af7e hgt:176cm ecl:amb hcl:#a97842 eyr:2029 pid:937928270 cid:251 byr:1978 iyr:2018 hgt:154cm cid:213 pid:767329807 ecl:hzl iyr:2013 hcl:#888785 eyr:2026 byr:1998 cid:158 hcl:#b6652a hgt:155cm iyr:2010 eyr:2025 byr:1980 pid:338567803 ecl:amb hcl:#efcc98 byr:1940 hgt:62in ecl:oth pid:537307591 eyr:2030 iyr:2017 cid:179 byr:1965 eyr:2027 pid:691913618 hgt:75in hcl:#6b5442 ecl:gry iyr:2012 hgt:163cm byr:1964 eyr:2025 iyr:2010 hcl:#ceb3a1 ecl:oth pid:936536544 pid:712946803 cid:343 hgt:187cm ecl:oth iyr:2020 byr:1983 eyr:2030 hcl:#7873b3 ecl:blu iyr:2010 hcl:#fffffd eyr:2030 hgt:175cm pid:047567505 byr:1963 ecl:gry byr:1946 eyr:2026 hcl:#602927 hgt:164cm iyr:2010 pid:223378458 iyr:2014 cid:151 ecl:hzl hgt:171cm eyr:2020 hcl:#341e13 byr:1964 ecl:brn byr:1948 hcl:#866857 hgt:193cm eyr:2024 iyr:2013 cid:277 hcl:#623a2f byr:1943 iyr:2011 ecl:oth hgt:184cm pid:371604584 eyr:2024 cid:176 hcl:#efcc98 eyr:2025 pid:241834382 hgt:178cm byr:1985 iyr:2017 hcl:#c0946f byr:1996 pid:701366586 eyr:2026 hgt:163cm iyr:2015 ecl:oth hgt:65cm hcl:#18171d eyr:2024 ecl:brn pid:172cm iyr:2010 byr:1990 hcl:#fffffd pid:68659204 hgt:161cm iyr:2025 ecl:#94b8aa byr:2021 eyr:2032 ecl:blu iyr:2018 byr:1993 cid:184 hgt:177cm pid:289871693 hcl:#733820 eyr:2026 cid:138 ecl:gry hgt:174cm eyr:2024 byr:1988 iyr:2014 hcl:#341e13 pid:864852584 cid:321 eyr:2028 pid:93285596 hgt:173cm iyr:2013 ecl:gry hcl:#623a2f byr:1927 pid:431242259 eyr:2022 ecl:hzl byr:1960 hgt:151cm hcl:#efcc98 iyr:2020 hcl:#866857 eyr:2029 iyr:2016 ecl:grn pid:526060780 byr:1929 cid:310 hgt:162cm ecl:blu hgt:183cm cid:168 iyr:2015 eyr:2021 byr:1951 hcl:#6b5442 pid:594960553 hcl:#ceb3a1 iyr:2020 byr:1951 hgt:186cm eyr:2022 ecl:amb pid:317661479 iyr:2016 hgt:163in hcl:#accfa0 ecl:brn pid:307377995 byr:2000 eyr:2028 pid:933380459 byr:1938 cid:291 hcl:#c0946f ecl:oth iyr:2018 eyr:2026 hgt:170cm byr:1974 pid:262927116 eyr:2027 ecl:gry hcl:#341e13 iyr:2014 cid:232 hgt:161cm hcl:#602927 byr:2001 iyr:2011 hgt:177cm eyr:2028 pid:165733929 ecl:amb byr:1922 cid:144 pid:333716867 hgt:183cm iyr:2015 hcl:#c25ea9 eyr:2022 ecl:blu eyr:2021 cid:147 byr:1978 iyr:2020 pid:938828535 hcl:#7d3b0c ecl:amb hgt:159cm hgt:153cm ecl:hzl cid:232 byr:1953 hcl:#a97842 iyr:2016 pid:356632792 eyr:2029 pid:745727684 ecl:gry iyr:2020 hcl:#a97842 eyr:2025 cid:275 hgt:65in byr:1957 hcl:#733820 ecl:grn iyr:2019 byr:1943 eyr:2024 hgt:70in pid:953607814 ecl:gry eyr:2028 hcl:#cfa07d hgt:163cm byr:1942 iyr:2019 pid:310104177 hgt:190cm eyr:2027 iyr:2010 byr:1978 ecl:gry hcl:#964ba7 cid:320 eyr:2022 hgt:169cm ecl:blu hcl:#a97842 iyr:2015 pid:669007078 byr:1986 iyr:2019 pid:901370677 hcl:7f2398 cid:305 ecl:amb eyr:2011 hgt:190cm byr:1991 ecl:brn cid:256 byr:1987 iyr:2017 eyr:2026 hcl:#623a2f pid:875646528 hgt:160cm byr:1955 pid:120131971 hcl:#18171d hgt:156cm ecl:blu iyr:2011 eyr:2028 iyr:2020 ecl:brn cid:188 hgt:157cm eyr:2026 pid:504067323 hcl:#733820 byr:1982 cid:102 hgt:177cm hcl:#733820 ecl:hzl byr:1984 pid:542750146 eyr:2028 iyr:2020 pid:419639528 iyr:2013 hgt:175cm ecl:blu eyr:2026 byr:1999 hcl:#733820 byr:1963 eyr:2020 pid:683641152 ecl:gry cid:207 hgt:180cm hcl:#cfa07d iyr:2020 hgt:192cm pid:156436859 iyr:2020 hcl:#cfa07d ecl:blu byr:1963 eyr:2025 cid:147 eyr:2002 hcl:z iyr:2011 pid:6830168962 hgt:156in cid:288 byr:2029 eyr:2021 pid:277739802 byr:1992 ecl:hzl iyr:2020 hcl:#7c5fe8 hgt:184cm byr:1989 pid:066973099 iyr:2017 eyr:2022 ecl:hzl hcl:#888785 hgt:76in hcl:#866857 iyr:2016 cid:306 ecl:hzl pid:453816800 byr:1971 hgt:71in eyr:2030 pid:248573931 hcl:#cfa07d iyr:2014 eyr:2024 hgt:186cm byr:1970 cid:128 ecl:blu pid:172567579 ecl:brn iyr:2014 byr:1948 cid:309 hgt:151cm hcl:#888785 eyr:2024 hgt:153cm eyr:2026 byr:1929 ecl:hzl pid:684760742 hcl:#c45e93 iyr:2018 pid:#d50a43 iyr:1940 ecl:#7880a9 byr:2018 hcl:dc2fa7 hgt:185in eyr:1978 hcl:#602927 cid:71 eyr:2020 pid:620634584 hgt:157cm byr:1991 iyr:2020 ecl:amb eyr:2023 byr:1959 iyr:1947 hgt:152cm ecl:#503286 pid:63978523 hcl:57dd0d hgt:190cm byr:1955 ecl:blu pid:507892696 hcl:#9bd1f0 eyr:2029 iyr:2010 pid:365539813 eyr:2022 hcl:#623a2f iyr:2020 hgt:184cm ecl:oth byr:1920 cid:213 cid:50 ecl:oth pid:774859218 hgt:193cm iyr:2017 byr:1925 hcl:#866857 eyr:2021 hgt:189cm iyr:2019 byr:1937 hcl:#a97842 eyr:2025 ecl:oth pid:787390180 iyr:2019 eyr:2027 hgt:183cm ecl:hzl pid:549757712 byr:1956 hcl:#866857 pid:755580715 hcl:#602927 hgt:187cm iyr:2017 byr:1925 eyr:2020 ecl:blu iyr:2019 hgt:69in ecl:amb hcl:#602927 eyr:2026 pid:951019647 byr:1974 byr:1943 eyr:2034 hgt:150 pid:#36aedf ecl:oth hcl:z eyr:2024 ecl:hzl pid:824745692 iyr:2012 hcl:06ab6e byr:1944 hgt:159cm cid:183 hgt:169cm ecl:blu eyr:2030 iyr:2013 byr:1945 pid:791359040 hcl:#7d3b0c iyr:2018 ecl:hzl hgt:152cm hcl:#18171d eyr:2026 byr:1924 pid:534667048 eyr:2029 pid:933295825 iyr:2011 hcl:#cfa07d byr:1981 hgt:164cm ecl:grn ecl:amb byr:1964 iyr:2018 pid:014457573 cid:152 eyr:2028 hgt:171cm hcl:#866857 hgt:167cm byr:1974 iyr:2012 ecl:amb pid:512315114 cid:278 eyr:2028 hcl:#623a2f hgt:153cm ecl:oth iyr:2012 eyr:2027 hcl:#888785 byr:1999 pid:416990697 eyr:2025 ecl:blu byr:1991 hcl:#866857 hgt:189cm pid:546461828 iyr:2016 byr:1988 hgt:160cm eyr:2025 ecl:amb hcl:#602927 pid:562766105 ecl:oth byr:1942 hcl:#341e13 pid:564975864 cid:158 hgt:159cm eyr:2028 iyr:2018 pid:406209763 hgt:170cm cid:331 iyr:2018 eyr:2026 byr:1981 hcl:#733820 ecl:gry pid:279164109 ecl:oth cid:197 hcl:#7d3b0c eyr:2024 hgt:185cm iyr:2020 byr:1925 hcl:#efcc98 ecl:hzl cid:92 hgt:190cm pid:724466265 iyr:2020 eyr:2025 byr:1996 byr:1996 cid:55 pid:906572505 ecl:grn eyr:2022 hcl:#602927 hgt:160cm iyr:2014 eyr:2028 hcl:#b6652a ecl:hzl hgt:186cm iyr:2016 pid:132872161 byr:1932 hcl:#fffffd iyr:2019 eyr:2020 hgt:188cm byr:1951 ecl:brn pid:842126902 hcl:#602927 hgt:158cm eyr:2023 iyr:2010 pid:681061896 byr:1977 ecl:gry iyr:2018 hgt:192cm byr:1970 cid:200 ecl:grn eyr:2027 pid:164408694 hcl:#888785 eyr:2029 pid:447061655 iyr:2010 hcl:#341e13 ecl:oth cid:187 hgt:185cm byr:1943 byr:1925 iyr:2012 eyr:2025 hgt:190cm hcl:#18171d pid:017534154 ecl:brn hgt:172cm byr:1923 eyr:2026 iyr:2015 pid:580812884 hcl:#c0946f ecl:hzl hcl:#888785 eyr:2028 byr:1952 ecl:brn pid:818889983 iyr:2010 hgt:180cm eyr:2026 ecl:gry byr:1982 hgt:188cm hcl:#c0946f pid:610689703 iyr:2011 eyr:2028 iyr:2018 pid:921660781 ecl:amb hcl:#cfa07d hgt:178cm byr:1975 byr:1977 pid:667631009 iyr:2010 cid:86 eyr:2022 hgt:189cm hcl:#7d3b0c ecl:oth pid:214679440 hgt:190cm ecl:blu iyr:2017 eyr:2025 cid:292 ecl:amb iyr:2017 hcl:531ad3 hgt:163 pid:689027667 byr:2006 eyr:2033 hgt:68in byr:1928 iyr:2010 cid:227 eyr:2023 ecl:hzl pid:#87bab9 hcl:#fffffd ecl:grn byr:1940 cid:294 hgt:152cm pid:310277488 iyr:2015 hcl:#18171d eyr:2030 byr:1965 pid:240720987 eyr:2030 ecl:oth hgt:192cm hcl:#733820 iyr:2016 pid:830487275 ecl:blu byr:1930 hcl:#b6652a iyr:2013 hgt:188cm eyr:2025 hgt:177cm byr:1955 eyr:2030 ecl:amb pid:476675886 iyr:2016 hcl:#c0946f pid:152702068 iyr:2016 hcl:#b6652a cid:82 ecl:blu eyr:2029 byr:1975 hgt:161cm pid:136852264 eyr:2024 cid:339 ecl:oth byr:1949 iyr:2011 iyr:2020 pid:772739059 eyr:2025 hgt:157cm byr:1945 ecl:brn hcl:#6b5442 hcl:#18171d eyr:2022 iyr:2018 ecl:grn byr:1933 pid:053763751 pid:214212776 hcl:#18171d eyr:2030 iyr:2020 byr:1988 cid:122 hgt:170cm ecl:oth pid:883116919 iyr:2018 ecl:brn byr:1938 hgt:187cm eyr:2020 iyr:2020 hcl:#a97842 cid:329 eyr:2025 byr:1946 pid:636649774 ecl:grn hgt:158cm eyr:2023 ecl:blu hgt:161cm hcl:#341e13 byr:1951 iyr:2020 pid:461889565 cid:97 hgt:168cm pid:492241189 eyr:2029 iyr:2013 cid:150 byr:1980 hcl:#cfa07d ecl:hzl byr:1998 ecl:gry hgt:150cm eyr:2024 pid:401735295 cid:153 hcl:#733820 iyr:2016 ecl:hzl hgt:184cm iyr:2018 byr:2001 pid:453480077 eyr:2025 hcl:#a97842 ================================================ FILE: advent-of-code/2020/inputs/4.sample ================================================ ecl:gry pid:860033327 eyr:2020 hcl:#fffffd byr:1937 iyr:2017 cid:147 hgt:183cm iyr:2013 ecl:amb cid:350 eyr:2023 pid:028048884 hcl:#cfa07d byr:1929 hcl:#ae17e1 iyr:2013 eyr:2024 ecl:brn pid:760753108 byr:1931 hgt:179cm hcl:#cfa07d eyr:2025 pid:166559648 iyr:2011 ecl:brn hgt:59in ================================================ FILE: advent-of-code/2020/inputs/5 ================================================ FBBFFBBLLL FFBFFFBRLL FFBBBBFRRL FBFBBBBRLL BFBBBBFLLR FFFBBBBLRR BFFFFFBLLL BBFFFBFRRL FFBFFFFLLR BFFFBBBRRL FBFBFFFLRL FFFBBFBLRR FBFBFBFLRR FBBBBFBRRL BFFBFFBRRR FBBBFBBRLL FBFFBFBRLR BBFBFFFLRL FFBFFFFRLR FFBBFBFRRR BFBBBFBLRR FFBBFFFLRL FBBBBFFRLR FBBBBBBRLR FFBFBFBLLL BBFBFBBLLL FFFFFBBRRL FBFFBFBRRR FFFBFFFRLL BFBFBFFLLL BFBFFBFLLL FFFFBFFRRL FBFFFFFRLR FBBFFBBLLR BFFFFFBLRL BFBFFFBLLR FBBBBBBLLL BBFBFBFLLL FFBFFBFLRR BBFFFBBRLL FFBFFFFLLL FBBFFBFLLL FFFBBBFRRR BFBBFBFRLL FBBFBFFRRL FBFBBFBLRR FFBBBBBRLR FFBFBFFLLL FBFFFBFRRL BFFBBFFRLL BFFBBFFLLR BBFFBFFRRL FBFBFBFLLR BBFFBFBLRL BFBFBFBLRR FFBBFBBRRL BFBBBFBRLR FBFFFFBLLR BFBFFBBLRR BBFBFBFRRR FFBFBBBRRL BFBFBBFRLR FBFBBBBRLR BFFFFBBRRR BBFFFBFLLR FBFFFFBRRL BBFFBFBLLL BFFFBBBLLL FFBFFFBLRR BFBFBBBRRR FBFFBFFRRR BFFBFFBLLL BFBBFFFLRL BBFBFFBRLR FBBFFFFLLL FBFFFFBLLL BBFFFFBRLR BBFBFFBRRL FBBFBFBRRR FBFFBFFLRR FFBBBFBLLR FFFFFBFRRR BFBBBBBLLR BBFBFFFRLL BFFBFBBLRR BFFBBFBRLL FBFFBFFRLR FBFBBFFLLR FFFFFBFRRL FFBFFBFRLR FBFBBBFLLL FFBFBBFLLR FBFFBBBRLR FFFBFBFLLR BFBBFBBLRL BFFFFBFLLL BFBFFBFLRL BBFFBFBLLR BFFFBFBRRL BBFBFFBLLR FFBBFFFRLL FFFFFBBRLR FFBFBFBRLL FBBBBFBLRR FFFBFFFRRL FFFFBFFLRL FFFFBFFRLR BFFFFFFRRR BBFFBFBRRL BBFBFFFLRR FFBBBFFLLR FBFBFBBRLR FBBFBBBLRR BFFBBBFRLL BFBBFBBLLL FBFFFBBLLR FBBBBFFRRL BFBBFFFLLR BFBBBFFLRL FFBFFBBRLL FBFBFFBRRR FBBFBBBLRL BFFFBFFLRL BFFBFFBLRR BFBFBBFLRL FBFBBFFRLL BFFFFBBRRL FFBBBBBLRL FBBFFBFRRL BBFFBFBRLL FBFFFFFLRL FFFBFBFRLR FFBBBBFLLR FFFBBBFRLR FFBBFFBRRR FFFBFFBLRL FBFBFBBLLL BFFFFBBLRR BBFFBBFLLR FFFFFFBRLL FBBBBBBLRR FFFFBFBLLR BBFFBBFRRL BFBBBBBLRR BFBBFBBLRR BBFFFFBRRR BFBBBFBLLR BBFFBBBRRR FBBFBFBRLL FFFFFBBLRR BBFBFBBLLR FBFFFBFRLR BBFFBFFLLR BBFBFFFRLR FFFFBFBLRL FFBBBBBLRR FBBBFFBLRR FBBFBBFRLL FBBFBFBRLR FFBFBBBLRL FBFFBBBLLL FFFBBBBRRR FFBFFBFLRL BFFFBBFRLL BFFFFBBLLR BFFFFFBRRL BFFBFBBRRL FFBFFFBRRL BFFBFFFLRL BFFBBBFLLL FFBBFFFLRR FBBBFFBRLL FFBBFFFRLR BFBFBFFRLL FFFFBBFRRR BFBFBBFRRL FBFBBBFLRL FFFBFBBRLL FFBBBFFLLL BBFFFBBLRL FBBBFFBRRR BFBFBFBLLL FFBFFBBRLR FFBFBBBRLR FFFFFFBRLR BFFBBFFLRL FFBFFBFRRR FFBFBFFRLL FBFBFFBLLR FBFBFBBRRR FFFBBFBRRR FBBBBFBLLR FFFFBFBRLR FFFBBBFRLL FBFFBFBLLL FBFBFFFLRR FFFBBFFLLL BFBFFFFLLL BBFFFBFLLL FFFFBFBRRL FFBBBFBRRL BFBFFBBRLR FFFBBFFLRL FFFBFBBLLR FFBBBFFRLR FBBBBFBLRL BFFFBBFLLL BFFBFBFLLR FBFFBBFLRR BFFBBBBLLR FBBBFFFRRR FBFFBFBLRL BFFFFFFRLR FBBBBFBRRR FFBBBBFLRL BBFBFFBLRL BFBFBBBLRR FFFFFBFLLR FBBFFBFLLR BFFFFBBRLL FFBFBBBLRR FFFFBFFLLR BBFFFFFRLR FBBBBFFRLL BFFFBFBLRR FBFBBBBLLR BFFBFFBRLL BFBFBFFLRR BFFFFBFLRR FBBFFBFLRR BFFBBFBLLR FBBFFFBLRL FBFBFBBRRL FBFFBFFRRL BFBBFBFLLR FFFFBFFLRR BFBFFFBLRL BFFBBBBRRR FFFFBBBLRR FFFBBFBLLL FFBBFBFLLR BFBBFBFLLL FBBFBFFLLR FFFBBFFRRR FFBBBBBRRR FFFBFFFRLR BFFBFBFLRR FBFFBFBRLL FFFFBFFLLL FFBBBFFRLL FBFBFFBLLL FBFBBBFLLR BFBBBFFRLL BFBBBBBRRL FFFFFFBRRL FBBFBBFLRL BFFBFBBRLL FFFFFBFLRL BFBFFFBLRR BBFFFBFLRR BFBFBBBLRL FBFFFFBRLR BFBFBBBLLL BFFFFFFRRL FBBFFFBRRR FBBFBFFLRL BBFFFFFLRL BFFFFBBLRL FBFBBFFRRR FBBFFFFLRR FFFBFFFLRR FBFBBFFRRL BFFBFFBRRL BFFBFBFRRL FFBBFBBLLR FBFFBFFRLL BFBFFBBLLL FFBBFFBLLL BBFFFBBRRL BFFFFFFLLL FFBBBBFRLL BFBBBBFRRR BFFBBBBRLR FBFFBBFRLL BBFBFFBLRR FBFFBBBLRR BBFBFFFRRL BFBFFFFLRR BFBFFBBRRR FBBFFFBLLL BFFBBBFRLR BFFFFBFRLL FBFBBBBRRL BBFFBBFLRL FBBBBFFLLR BFBBFFBRRR FBBFFBBLRR FBBBBBBRRL BBFFFBBLLR BFBBBBFLRL BFFBFFFRLR FFFFBFBRRR FFFFBFBRLL BFFFFFFRLL BFFFBBBRLL FFFFFBBLLL FBFFFBFLRR FBFBFBFLLL BFBBFFBRLL BFFFBBFRLR BFBBFFFRLL FFFBBFBLRL BBFFFFFLRR BBFFFBFRLR BFBBBBFLRR FBFFFBBLLL BBFFBFBRRR FBFBFBBLRR FBBFBFFRLR FBFBBBBLLL FFFBBFBLLR FFFFBBBRRL FFBBBBFRLR FFFBFFBRRL BFBBFBBLLR FFBFFFFLRL BFFBFBFRLR FFBBFBBLLL BFFBBBFLRL FFFFFBFRLL BFFBFFBRLR BFFFBFFRRL BFBFBBBRLL BFFFFFBLRR FBBFFBBRLL FFFFBBBLRL BBFFFFBLRR BFBFBBBLLR BFFFBFFRLR BFBBFBFRRR BFFBBBFLRR FFBFBBFRRR FBBBFBFRLR BFBFFBBRLL BBFFBFFRLL BFFFBFBLLR FBFBBFFLRL BFFFFBBLLL BFBBFBBRRL BFFFBFFLLL BFBBBFBLLL FFBBFBFLRR FFBBFBFRLR BFBBBFFRRR BBFBFFFLLL BFFFFFBRLL FBBFBBFRRR BFFFBBFLRR BFFBBBFRRL FFBFFFFRRL FBFFBFBLRR FFBFBFBRLR BBFFBFFLRR BFFBBFFLLL FFBBBFBRRR BBFFBFFRRR FBBFFFFRRR FBBBBFFLRR FBBFBBBRRR FFBFBFBLRL FBBFFFBLRR FBFFBFFLRL BFBBFFFRRR FBFBBBFRLR BFFFFFBRRR FBFBFFFRRR BBFFFBFLRL FFBFBFBLLR FBFFFBBRRL FBBBFFBLLL BFBFBFFRRR FBFFBBBRLL FFBFFBBLLR FFBBFBBRLL BFBFBBFRLL BFBBFFBLLL BFFBBBFRRR BFBFBFBRRL BFFFFFFLLR BFFFBBBRRR FBBBFBFRRR FFFBFFBRLL BFFFFBFLRL FBFBBFFRLR FBBBBBFLRL FFFBBBFRRL BFBFFFFLLR FBFFFBBLRR FBBFBBBRRL FFFBBBFLRR BFBFFBFRRL BFFFBBFRRL FBBBFFBLLR FFBBFBBLRL BBFBFBFRLR FFBFFBFLLL FFFFBFBLLL BBFFFFBRLL FBFFFBBRLR FFBBBFFRRR FFFBFFFRRR FFBFBBBLLR FFBFFFBRLR FFBBBFBLRR BFFBBBBLRL BFFFFBFRRR BBFBFBFRLL FBFBBBFLRR FFFFFBFLLL BFBBBFFLLR BFFBFBFRRR BFBBFFBLRR BBFFFBBRLR FBBBBBBLRL BFFBBBBRRL FFBFBFFRLR BFFFFFBLLR BBFFFFBRRL FFFBBFFLRR BFFFFBFRRL BBFFBFFLRL BBFBFBFLRR FBFBBBBLRR BFFBBFBRRR FFFBBBBRLL FBFBBBFRRL FFFFFFBRRR BFFFFFFLRL FFBBFFFLLR FBBFBFBLLL FBBFBBFRLR BFFBFFBLLR FBFBBFBRLL FBFBFBFLRL FFBFFFBLLR FBBFFBBLRL FFFBBBBLLR BFFBBBBLRR BFFBFBBLLR FFBBFFBRLR FBBBBFFLLL BFFFFFBRLR BFBBBBFRLL FFFBBFFRLR BFFFBFBLLL BBFFFFFRRL FBFFFFBRLL BFBFBFBLRL FBBFBBFLRR FFBFBBFLRR FFBFBFFLRR FFBFFFFRLL BFBFBFBRRR FBBBBFFLRL FFBFFFBLLL BFBBBFFRLR FBFBFFBRLL FBBBBBFRRL FBFFBFFLLL BBFFBBBLLR BFFFBFFRRR BBFFBBBRLL BBFFFBBLRR FBBFBBBRLR BFBFBBFRRR FBFFBBFLRL FFFFBBFLRR BFFFBFBRLL BBFFFFFRLL FFFBFBFRRR BFBBBBFLLL FFBBBFBRLR FFFFBBBRRR BFBFFBFRLR FBFFBBFLLL FFBFFBBLRR FBFBFFBLRR FFBFFBBRRL FFFBBBBRRL BFFBFBBLRL BBFFBBBLRR FFFBBFBRLL FFFBFBBLRL BFBFFFBRRL FBBFFFFLLR BBFBFFBLLL BFBFBBFLLR BFFBFBBRRR FBFFFFFLLR FFBBBFFLRL FBFFBBFRLR BFFFBFBLRL FBFBBBFRRR FFBFFBFRRL FBFBBFBRLR BFBFBFFRLR FBFFBBBRRR BBFBFFFLLR FBBFBBBLLL FFBBBFBLLL FFBFFFFRRR BFFBFBFLLL BFFBBBFLLR FBBBBBBRLL FBBFFBFRLL FFFBFFBLLR FFBBFFBLRL BFBBFBFLRR BFBFFFBLLL FBFFFBBRRR FFBFBFFLLR FBFFBBBRRL FBBBBFBLLL FFFFFBBLLR FBBFBFBLRL BFBBFBBRLL FFFFBFBLRR BBFFBBFLLL FBBBFBFRLL FBFBBFBLLL BBFBFBFLLR BFBFBFBRLR FFFFFBFRLR FFFFFBBRLL FBFBFBFRRR FBBBFBFLRL BBFFBBBLRL FFBBBBBRLL FBBBFBBRRR BFFFBBBLLR BFBBBBBRLL FFFFFBBLRL BBFFBFFRLR BFBFBFBRLL FFFFBBFLLL BFBFBFFRRL FFBBFFBLLR BFBBFFFLLL BFBBFFBRLR FBFBFFBRLR FBFFFBFRLL FBBFBFFLRR FBBFFBFRRR BFBFFFFRLL BFFFBBBLRL FBFBBBBRRR BBFFBBFLRR FBBBBFBRLL BBFFBBBRRL BFBBBFFLLL FBFFFFBLRL FBFFFFFRRL BFBBBFFLRR FBBFBFBLRR FBFBFBBLRL FFBFBFFRRL BFFBBFBRLR FFBFFBBLLL FBBBFBBLLL FBBBFBBRRL FBBBFBBLLR FBFFFBFLLL FBBBFFBRLR FBBFBBBRLL FBBFFFBLLR FFFBFBBRRR FBBFFFFLRL BFFFFBFRLR FBBBFFFLLL FFBBFBFLLL BBFFFFFRRR BBFFFBFRRR FFBFFBBLRL FBBBFFBLRL FFBBFBFRRL FBFFFBFLRL FBBBFFFLRL FFFFBBBRLR FFBBFBBRLR FBFBFFBRRL BFBFFBFRRR BFBFBFFLRL BFFBFFFLLL FBBFBFBRRL FFBBBFBLRL BFFFFBFLLR FBBBFBFLLL FBFFFBBLRL FBBFFFBRRL FBBBBBFLLR FBBBFBFRRL FFFBBFBRRL FBBBFFBRRL FBFBFBBRLL BFBBBBBLLL FBFBFFFLLR FFFBFFBRLR BBFFBFBLRR BFFFBFFLLR FBBFBBFRRL FFBBBBBLLL FBBFBFFRLL FFFBBBFLRL FFBBBBFLRR FBFFFFFRLL BBFFFFBLLR FFFFBBFRRL FFBBBBFRRR FBBBFBBLRL BFFBBFBLRL BFBBFFFRLR FFFBFBBRRL BBFBFBFRRL FFFBBBFLLR BFFFFBBRLR BFFBFFFLLR BBFBFFFRRR FFFFBBFRLR BFBBBFBRRR FBFBBBBLRL FFFFBBFLLR FBFBBBFRLL BFBBFBBRLR FFBBFFFRRR FFBBBFBRLL FBBFFBFLRL BFBFFFBRRR BFFFBBBRLR FFFFBFFRRR FFBBFFBLRR FBBFBFBLLR FFFBBBFLLL FBBBBBFLLL FFFFBBBLLL FFFBFFBLLL BFBBBBBRLR BFBFBBFLRR FBFBBFBRRR BFBBFFFLRR FFBBFFFLLL BFFFBBFLLR FFBBFBFRLL FBBBFFFRLL FFFBBFBRLR BFBFFBFLRR FBFBBFBLLR FBFFFFBRRR FFFBFBBLLL FBFBFFFRRL FFFBFBFLRR FFBBBBBRRL FFFBFFFLLR BFFFBFFRLL BFBBBBBLRL FBBBFBFLRR FFFFBBBLLR BFFFBFFLRR FBBBBBFLRR FBBBBBFRLR BFFBFFFRRR FFBFBBFLRL FFBFBBFRRL FFBFFBBRRR FFFFBBFRLL BBFBFBFLRL FBFBBFFLLL BBFFFFBLLL FBBBBFFRRR BFFBFBFRLL BFBBFBFRRL FFBFBBFLLL FBFFFBFRRR FFBFFBFLLR BFBBFFBRRL FBBFFBBRRR FFBFBBBRLL FBBBBBBLLR FBFBBFBRRL BFFBFFFRLL BBFFBBFRRR FBBBBBFRLL FBBFFFFRLR FBBFFBBRLR BFBFBFBLLR FBFFBFBRRL FFFBBFFRRL FFBFBBFRLR BFFBFBBRLR BFFFBFBRRR BFBBBFFRRL FBBBFBBLRR FFFBFBFRLL FFBBFFBRLL FFFBBBBRLR FBBBFBFLLR BFBFBBBRRL FBBBFFFRLR FBFFFFFLRR FFBFBFFRRR FFFBFBBLRR FBBFBFFLLL FFBFFBFRLL FFBBBFFLRR FFBFBFBRRR FFFBBBBLRL FFBFBFFLRL FBFBBFBLRL FFFBFBFLRL BFBFFBFLLR BBFFFBFRLL FFBBBBBLLR BBFFFBBLLL BBFBFFBRRR BFBFFFBRLL FFFBFBFRRL FFBFFFFLRR BBFFFFFLLL FBBBFFFLRR BFFFBBFRRR FBBFBBBLLR BFBFFFFRRL FFBBFFBRRL BFBFFBBLRL BBFFFBBRRR FFFBBFFRLL BFFBBFBRRL BFFFFFFLRR BFBBBBFRLR FBBFFBFRLR BFFBBFFRRL BFFBFFFRRL FFFFBBBRLL FBFBFFFRLR BBFFBBFRLR BBFFBBFRLL BFFFBBFLRL FBFFBFFLLR BFBBFBFLRL FBFBFBFRLL BFBFBBBRLR BFBFFBBLLR FBBBBFBRLR FBFFFFBLRR FBFFBBFRRR BBFFBFFLLL FFFBFBFLLL BFFBBFFRRR FBBFBFFRRR BBFFBBBRLR FFFBFFBLRR FBFBFBFRLR BFBBBBBRRR BFFBFBFLRL BBFFBBBLLL BBFFFFFLLR BFBFFBFRLL BFBBBBFRRL BFBBFFBLRL BFFBBFBLLL BFFBBBBLLL BFBFBBFLLL FBFBFFFRLL FBFBFBFRRL BFFBFBBLLL FFBBFBBRRR FFFBFFBRRR FBFFFBFLLR FBFFFFFRRR FBBFBBFLLL FFFBFBBRLR FBFFFFFLLL FBBFFFFRRL BFBBFFBLLR BBFBFBBLRL FBBFBBFLLR BFBFFFFLRL FFBBFBBLRR BFBBBFBLRL BFFBBFFRLR FFFFBFFRLL BFFBBFFLRR FBBBFBBRLR FBFBFFFLLL FFBBBFFRRL BFBBFBFRLR FBFFFBBRLL FFFBFFFLRL BFBBBFBRRL FBBFFFBRLR FFBBBBFLLL FBBBFFFLLR FBFFBBFLLR FFBFBBFRLL BBFFBFBRLR FBFFBBBLLR FFBFBFBRRL BFFBFFBLRL FBFFBFBLLR FFBFBFBLRR FFBBFBFLRL FFBBFFFRRL BFBFBFFLLR FBBBBBBRRR BFBFFFFRLR BFFBBBBRLL FFFFFBBRRR FFBFFFBRRR FFFBFFFLLL BFBFFFFRRR FBBBBBFRRR FBBBFFFRRL FBBFFFFRLL FFFFFBFLRR FFBFBBBLLL BFBFFBBRRL FFFFBBFLRL BFBBBFBRLL FFBFFFBLRL FBBFFFBRLL BFFBBFBLRR FFFBBFFLLR FBBFFBBRRL FFBFBBBRRR FBFBFFBLRL BFBBFBBRRR BBFFFFBLRL FBFBFBBLLR BFFFBBBLRR BFBFFFBRLR FFFBBBBLLL BFFBFFFLRR BFBBFFFRRL FBFFBBBLRL FBFBBFFLRR FBFFBBFRRL BBFBFFBRLL ================================================ FILE: advent-of-code/2020/inputs/6 ================================================ bapocnysdr lpandcmb bplndca rgi ci i iv xdgwtsc gtcxswd sdcxtwg g j k drcmwzh aostudi qziunh hgkaslmyz fovlpdhurzqsway zvciokytxbaf y y yp y y gqouslwfihtxvke bapdmyncjzr ywirnpmozqle jhapfdzuvgc ce evn yzsem phdcuxgtosjier jfixnurtyopdh mxjs mxkjis jxsm xvmbsj sxjcmh sgrbtmqxpwkacnzd brncqxtskawgpzdm mxqjtcpzbswgrnka fxijprlkbhte herpxfbikmtlj ltuyidqkcrevanw whbqavirludxtye vfirqwmsaopyzld q q q faxhswigtprou xhlusnijytkrwza xaqsburiftwh rtahxwcsiu cuplrimdtxke letpjuimzrvkcyx cpleiuxdktmar wrfgkubeoqxsihpntmc zpbjimulvrdwxsog hfmspnuokbxe ctm ctm mct tvkocqebls qcnbktsveo fnvkbscqyeot mbcsoevkthqj tyjgd tydjg tgdyj dtgyj xgiybeuhtkfdonq diuqvfycrokhgxbt igfdbhpqklxuyntjo zxqkymfohstuiwdgb kgoutiyhfxqcbd wzfiaexksp fizxyskw azsqntcghjmio mgksdwpcitvxqjr ctwzu jwctuzes bpymqfisrvtuheljwadx iejsubvxhdmwpqgfrltya jbxmfshuvyegwqlpridta vpxbwlqumetdrijhfnays w i i i i fctbvjmnroypuxhlakzw cbpnmyzrtjuavfohkxlw znoptxwakjfucmhrlvy nkmlrhygxcazowtpquvjf ibanduczjfmpt gqimbtadcuoszjfprl mtaizxcdjpbfu mjfaiubcdzpt kdxav maxvudr adxv qxavdi uajvepgoxhwsqkym hwesxqvpuzgb lp pl pl lp tawk suwtc stw ixltp wto phrawmes bscrhki xhwurk hwea bhwe tuhvebm bemtuhv prziuqhcye qipyrhezcu ueqzyprhci yurseihcqpz mnfotvpzdxbaglye nbjlomxzacfqgey glxhuwoskyrabi tohbrluismcagnypqdv duqbhylatcvosnprimg qtpbduycrlosngivhma nvgucpayidlhsomrbqt grslqxjdytzficnuo klarqjpxfscgyouzi qozstka pjnruvic fchup yjautz ajue vlufjx ujy inythxv bhxvytin htlnxviy mhcqvt sqtvchm htqmvc vswymdnahrq hrnqvysawmd ndsmqvwyrah mraywhsvndq jtxayp atjxp jpraxgt jatpx adbwpjltx vbni ivgfn avyqtmsikn nhwivrf fkygvtsbpazdjwxrmqoi btyfwsvpdiarjqoxmg wvqyiaprsmftgxdojb a a an pynvsfcbherzqiwumjaod dsivqjmurcfnzebyhopaw mqsvnueoihczyrfdwpbja gjqsaiwdczpvublmnokfryeh drawsthnfvzylebo jmkzqhbgicxsu pg hdob nq gdbxpwmtvhoaely omvdgatwbxlpyeh gtbyxrvwmhladpeo ugowlqebtcpdxz wzobutlqgdxep tulbvxwfadjpogqze qubdxgztpknolwe epztwlbxqgodu rsvebtycq becltsrnvw tgsljhz zhltjs hsjltxz daguc fbpudxyg glidjuo goadus udjgaz qkpwetasjfbdvh glixc pufekjh xegpq poewviyn enlbvp tpesm zqfiwx zqfriw wfzxil zwxu dznwktpb kcaomdbszyi ildpzaqsbx xsdqirazb mqebolfk peqmgf deqfmw grcqpi dvpmqte ohlwfujxkanbsyz txnhgzuwaicrfl qtnwizslxuahocgr mcxhglnibardwtkuz cvjbyrewa wczb zbwc wcb psvotmiaqyuhdnrekw aovnrqwsiyjmdutpehx gaephqunbrwdsmyiltov rmftshdpcznwiyuoaveq pyatoimwhxeusnvrqd wsjvydieaurhqxofzlgpmbk kemhzfusnpajxirywlo ypiz ipz jwiz iz pxoedfk pxogkd tkjsdocpex lsoz zxc z wkz zpw frmcndwyeix qritwfuymc mzrwyfixc mfczprywi ygvtslukaeoinhwd vnepzqmcwyjlufrdobk bi itb bi wy qomwberkixc gw hswg lpw krifxwcusnjmle cnijrwxkmspf cnrfiegmqswkxjh skiyrmwxcdzjnf ifwqlzhrudsmn fzblomnwspjvk vnjsxdiobeuhcgfw dhwienfjsobgcvux wsinxchtegujbdvof cioehdxvnjgwbusf gdcsfeobjrunhxwviy lpzntyhsxruiqjckwv ixyprghzqfvjsuotlw ayltehsxubqpmwrdjivz r lmb n n n k lfsxwgkeioztnuydmqbc wkosmqcxtdnluebigyfz olekfdcyxgqtsbumzwin kwqzfedxblcitgmnuoys ibdetugcmfzoknwlxsyq c c c c nmrohgpcwsjadkyqzl mgjhdwcpoknsqyazr chnajzmwopkgdyrqs bdcnhgamkjqysropfzw yqtid ujgkz rmas jk og f crj cyo neqhmb f uwxc wpcu bkhpcqyeljvftxnz kpvxqcjin eqjzkctynvo qyovecnjgkt xjckqenybvhpto jnkmezvyctqo lon w vwh h zrosv oblzfats cuozbmak dpyegwhnjz oztiqx bvlwgjrixaskqpuzyonth hatusdrovjgwcyipeqkmzln vhneajldr apnvjderl lynrjcae qodczyfijam fkdxpgrcnmio oai iao oia oai ioa nhgewpbozmjascrk vsocxumhryfnbqwkaj jxrls sycjpwr bdcrqenuhtsz sravkif bymwecxqrloj lhofkz vzldo klof oulk lfxobdwcji odbpnilxjcw pbcr rcpb msp esm sm psm dcsm clkiabts hskec sckgf kfncs sekc dyckmholpqbtaunf lacdqknfhuymtopb kntfqadpjlbcyhumo qoflmbpdhauykctn dphmolaynqcfbtku whkzitxfqem ftixzqmrwek mitabqyxkzjwfpne qzwekxtmfi iztmkfwxeqd wxktrn txr tapvryqbecdklwsjzxug mwjgatucpvydsnqbklxr tw wt wt irsehx ehsxri rhxise ekwyuzsvpfjg lcspakbhnmiod qifdbzapc rwpvkbd f f f f f yskpcdmber bnpdelmcryksu eqcbzdpkgyrmsixj ibt iez cz b xvls d d d d dq ubfpqyrkhceo yfhqckubre zyhnmseuivlbxgfk nviufhobsyelxzkm agbdzfsqetclpw wctbfaqeszpgdl csbtraldqepvgzfiw dmatzvowqcklbgirf ldiczavboqgwmfktr gkaditvmclqrwfboz dvrfntlcijagmzobuqkw iwzrtblvdoamqkfcg xhjydaekowcgsmruftbpqvln wzryxjmfdloqvskubanh skglcvahyx xyp yx tvsguaxobzkd txoguzsmkbv soegkitjbxyuzv kvobgsztux gtxvcspoukqfhznb osca osai sjv sjv vusofja vjs sjv ipwxnmkbzhscarlejtdoufqyg ujlxyqzkgtpfrdnihwaomscbe dyslimrkjqxnftcpbewzuohga gyphacbxnqdriweumloszjktf czbroamputiwjdnqhleyksgxf dygktjflepbcqm zfwsneviuo usz usez usz zscu jkbies ejikm ejphkoi kmjseiz jike qwjvbzmypcif hveligmbpatow aumeftxligdy tylfgicdx wlditgfyx tcxdgrilfsy wi iw iw iw wi zsd cbmoz ouwbaq ghexrpyf asmz ax w wrd vqclmnjfob sy aumz azs hvoecbdfgq p p p po p sydzgpwourlbqfcj mnzcjkeubaprofg kiatxsph iphktsa waplhikjt thapik cpv pcve vpc lmtcv eyghlrunfctbqzos nsryfzuqtmecol zayxpivkctudsmgrhqfl ynfsuctxhakdpjglmovq fdvgeskyaublpmhctrwqx egymspiuwoarnlj poidtzjyglwume tmlv motv mvthn vh vh vh vh vh vthobzjux ojutxvhbz vxhojbzut zhtvbxouj k k e k bkwvlpt xormzn aforqletdymv eyorqmflvdta ytvaqoejmdlrf rqakhn khrqusmaj rkhqa bmyztkxldgiosnw tsoyzwixdmlbnkg btimzdlywknsgxo mqifeszchaoxjygvdrklubwn zjdhxnboagfrc cgarozjxdnbfph xbnrhcjzfgaod fzdhrxtancjobg gzdvh gztvmch zgdhv ghzv yjldgioabsr musahntecwl fujnlstvgcbwio clgkwmijsupqzbo cqi iqga qza elgyxq dujqtkprvf dzrawsxvhgtflnjeikoubqypm pryqevnbkiusghjlofadztxw eawipgrutyohqvsbcknjzfxld bavdzsphqugykftnjeorilxw q vxoln feq y s s l gfdp pgd aep pdfsb watcn tawn l nly loy gwsvl l ehfqltbkvizcmpaxn vzqkecthbmnfxliap l lrx l el mznoqpxfvedutclhar gsibywkj gft dqs rm rbe dnsrh dgwncrbfo uboewdjnagxcr ogrcdbnyw bwgrdnoc orwbcgnd xlnyqidbvfuopwsmetkaz axsnipqkotbydfvuzle zsyaohudvqweikfpljxnbt aezfhxqipvkdtbnoyuwsl qsneybxfzidcagokulptv phnrogdiuwlqtmfvjcb sdmufyklricxpg ifdxpmkruealgzc xdiushclzbkvnfw bjmzunysickrfvxd xciutvyksbldfzn xfqpzabiuecnogsvkd olv ovl lov ovl jirywmg jnxmg jfbgm mjhg sjfvbhimpyauqctgx xasifmnuqtyvgwojclp jxyqabfuismptgcv spgmtcvwlxyfaq gpnqlctymxw xthqemkfpyls pqhtsymrgzoef yskhmtfpqe xcsqaokhpt hcopsqtxak pqoaxstchk oqexlariumftkcg xceqoumklaiwnhtf xekitmlufoqcag zkjmutfxryowbnv euomntlvzxiqydrgwspa whcyrmvozxktun hxqncgbjrsl bnlxcjrqhs cjqngsblxhr ihpsnrblcxqj rjtlufdmxiqkn afmrkuindxljt uktrmjilxnfd ypxqris hpgk budwp oqulm u u iu kahocwxnueyri rzesvkxyltmbpqg pkxjboidfvymngzrts rsizgmydxkpfvbtnjo bopgismxvrzntydfjk ovgfdztnspyxibkrmj oecxdvmgrfkzbnypijts ruvmcpojzsqtayw rqotdwzmpjcuys ptnscirkowujyzqfm ocszmjwrtyqpu nzxqdbwvpkioaj bqijkzpxwonadv kivqoujwxdzpntab inxabjvzpqdkow ochlv covl covyl qsoypnvewrhjkdgtb jpgwdknqeytbhsovr bdpwyrjuhoqgevtsnk rkoeypwbvgjnhsqdt qgtnyodrepsvkbwjh u i o o rx ecikgqxbyjhupozvdnrstawfm cnuiyopkzwmsbtadgeqrfxvj omkbnwrszvaetclqdpxfiygju wimrdtexbnjspgokuvzaqcyf veacgjpzmnioqksfwybxurdt egfkhxi gkshf shiayxrwutmzf isyatmhuzf tfgmicrqnpxz jeurkptlyh kvtphwr tyqrx hotsrdyqz yptqr tyqr ryxtq lxtdzqwcakvm xdkqrlzv ipujabzkmldhfrwg bjmpkavhlgqrwfdiz ofhizbrtdcagljwmp bfgvdaesjpwrlzumhi s s s s hs nobqduvlcjtw dyrbtpzwng iohlwxgfs zokfn uawlqejvnfkzhor rqhkanfvexlwzoju avqekulojnfrzwh kljwrhonqfzauev ln nl nl ln ln qyxi fmxbo qxo pkvnutje tjsz zjr gydfxcjliq ufa dohwy f kau ezjqncv jqvzenc pnhlasjrztw rlswpatnjz hpntrjslazw zjnrwtlapcs i i i i i aovitgfucj bowihz iol iweoz iyo bdgmouhjvyxr inpshdz nhdfia htdl pnzawmosg zganost emrakn glveamkr rkgames akfqmper imudroeak tibgokrjpxmy iydtpmjkx dkcjpxseiymt imfnqegj mcp nwgkhmbrpjac szovdtxl qnosfwmzpiubkxdhctg msutibqnakhgczfopxw xtnowmgicfqsuzbhkp pwbkcqiutxfshzngmo jgaqubtpokrn jpqgotluzna siblotrefupcmyajdwxhvn tdxpnfrbuivjchlsawoeym gvbfkphuqwsrdoejlt ixpkoqzldfncbahwt rdlfmyaejnswgopv ysjfvmazeilonurbpwx jayvlrwcmpefnos yowvefjknltqamscprh r d d d d iry gi lri kzopchbqgf phcifmsbgz canbyhlvdfpg ljmtd stlxdvmkjqy otcljbfehmd zgkiqsjrm rmqosfenz zqdmrsig jaegcxl delcpxa lktzbxcea pdclajxe gdrfnb dngbqriyh ojnbgrzd fdnrbg ixnhlufgkqojyrcdwms uvfmspygeizlkhxcawrbdotq cfzy zfcy czfy kfbqdvgacxnluszhejiowmytr durgtzlkjpwnechqibxfamvoys njcgoslbyutihpqxwe wrbgpdquiykhnofvecztl cozxyqbvugrmkdwlh rxcdwuylztbvgmqhk urmhkcdlxvgyqzbw okzsvutdehimnc mednkuhxgqwvizots sogfalbukwvchqmjdtypzix pyfazktchbmvsqguojwxild imsgakcotjpdhuwbfyzxlqv yzpafqijdchrvosxkt tqvsdrxzojhipfkyc tsfqokvphixzdcryj pjfqzhtxocrdkvyis ysmndq qdsnm rskilmn q q q q fygruq fxckylwohur fspaznjvbmdt ztqa a nma a a erml ejrm rem emr qkmpeuatxdbrcghnjlo xnlmcohutkdbeaqvpfrj rboxcdpaujeqhknmtl bpmiwjrs tyr ry jkyolgr dv anwid idzv z xzpnb z z hz mwxibru dxrwzobi wixqvrb sbrxwi baixrw yzcdlgujxrpmbs iadjzpcnyrm nq qn sbwtamevgyicuhxrlfz uzxkpmitwvlfqhcgjn xvhbkanc bozyjftqrl vpcougdijwlxtsmznarqfy qyroagjdmsicwlftvxunpz nylpitxuqdwrszamfgjcvo amogspxyvrdniztqfuwlcj fuoiwmpvtlxdszqncrjayg ocmqey yqoce mvulfyk fxyuivlmk afvulokym xufvjmykl wjz owpfqnsrgt ewycah webhjid bwi ucxqaszovj xacvqjskizuo auxsjhkiq zcymv qyljukpbitdx pxqjlduitkyb utbpqxjyklid yjkdqxptbluir puliqbtkdjxy ljurghymqktvpenzsbofwdxc ofyrjptgnczlwebdxvqmkuhs blopcvezhdsjnxgyktqfmrwu dwmqkuhtjsofnzgbrvelxcpy zn ndz tzn nkdz nzvk vmyrlzxcwkjp mkqlvyrcp xduvzyfarpkewscjqlmh fzcyvxkmhwqreapds nt cs c jxraviqybmgutesdwkfohlp hnkfweosqvbijpymuxdtalrg fcjz mnwvo mfqnkiaj nakqfimj arikjubnmqf zfqikanjxm pjetdfwsxohlz wpkzntbfsdcai zoifjgyxkluhbrtq yjolrgquihbnxktfz zoibyqghrjxtkufl iuklgxbyrtmjfqhovz r r r ytqzlvcwseb bcvqntlswyez cvqbtewyszl hfyj jsbrzyhiwknfg vfyajhd djfhlym fohyjux dzcjlgutfoipaexkmn koetcadiuznpmljf ctnilkamodfpzjue cofuezanjlpktdim nvtjmurwhfzex thxnrwmvuejaz jexztumwrhnv r r r a enoclavqmypruwkb tzspyhlawuimvrq yxcbvjpsgt crxgvitlzjbop gukcdbjtwvexp bgjcmqspztoxv w w w w w qmocdhri qpwioderm dvmocjruiq nvghcjxd nbcvdp nvhcd djcvn yfzukw kuywf kwsyu adjzmqebokxhtuspwgiynf fmshwkpoguljtyrziabqn anyofkgzsbvpuiqthwmj qfbhkytzgnwoicjsapmu tlmn nlti tyehjn s r s s s n u u tie jet et achjyurqb jpcbrhutqy rbjyuhcqp ybfucqjhrw qujrhbcy o o i migypa pyimag pmgiya agypim yaimgp kdzafylcnst aznrtshxgylcb cstzyaln anetplcsyzq hilubmsyznrtvqxpjo yqbirxnpzslojvtumh tyxlnibhzmsovrjqup zloiuyekfpx aqtxzmig wsgxinqbzj bavthrdxsiz acwdny ghrxysndq ovdncy p glxy ksnzbjyxgwtvm nbwzvtkjysgxemro bvnykztsxjwcmg qyzbmxjhtakgnwfdvs xzjmbsevgwytnklo uolyhfmwcpnk ykuchfolpnwm lnckhofpyumw ylnfuowmrcphk oumqj ulzybvfsp um u zh gh zh hns hg xlvaqwncsizrbopukyegdmh lxmsgzqyothupikvrbn lhqdviu qafnemdvlzbrpk qlvyxdw sdluoqygv v v v v v blqcsyup clmpubs noumlji nouji wkvj d ghy x k ohbjykuena jbyahkpez jyafhevbk yeajhkb auqjksywpcthxf zchkqmanpd kvaephqcn ygrvwtleidhapqcoxjzkbm uvmtjkcxphybegzqrawiold dpckejybntqgvhzaomwixlr wuvknho wunhkv awhuixnkv xtsglwhpkozumein tiwzoklpxheumsgn kdicmfpsejygzlraqh rgpqkamdfecyiljzs fgjrczaedymqliksp adlgcpfieqrmsyjzk mfwincakdjelorbygqszp jhtufzbolnrpgiv rymwi bcdfkrgujzqwheptivls wlzfyvtimksqcdujngorb eruyigjwb wojeybiulrg ygujbwvzei fizsg jnue yalxikzg iagxkz xizkga zikaxg ikxzag pjzlhqwixksnovbtygr ljnvgzykoswbtrhm rjtnogykswczhlbv ychwztvrgsonebaljk wcmyzldhtfrposgnj fcrmtyphngjlzs gpalbicyvfnmjxekrz ysmpe yemps stype meruv mbrse ryvmsei laremdjq bremck jaeutopnmdhvfklscirqgx selpyhdginkxfouq difgepshqlukonx oyz yoz yoz yoz kohdfzpsj rjkphfdzog jopfsukhbdz cpvr cvy xavdpsto bweoysidhp rndplvsukoca odgusp ofzgbwqdnkjp vcbnlqwofisg enbrymdqpogjwf ukrdtiphflv fvdlnuirtkh s s s ms s smodvglcpenzbtw vgwcmfdnlobi dobmzclwvng convbglwdim wrcojghvdblnmx euy iey hrkyowpesz qeuyn ylfe jd ygd d d ifxlcevjr muqybvdntl hpjdqw wjcmqdp pkojqud djpqm fz z z auzlgh zf oadfixtrspzymgkjvhc kureodwxjzvqcagmflt umdbplaejicognthw mldwpqitgubajnecho gdrhabsmketcwpolunij utpjbioagl pujgaobsti wzqkmfigsenp btdpmnrhaix g h fmy qfdshywubmn asnjyumvhfepqwbd tko k ki k kvj ajrftpclemziyx tyfcpmzxjrael rlymxejactzpf xpfzalrmjteyc lngatvoimxerfs xvsyefntoli ixvdqstzlonbefk dytmarichvj tvhdurymj mefohydrtjpvx yajumrtvhd mjrvthdy mdizkcbhuqxfpew lciqkhpdzwumfxbe dmwbhzqpojuexikcf av a a a a buwiq wbqi bqviw wbjifuq szyogteivkjmubnl gnmeioyhdjzkutvwqb vetwlrjnzuxfamsydoqbhpcigk lhagxseotdcqbyrwnpfkizmjvu ikt sxuik rigbk ixzofbapunser umbfxasovni oansfubxi xsoauibnfk ebzhanm rsywcgfuaoqxjvz dygrvauxpemhosqkwtfji pxafqktysdjvgriwuehom ikurtagpdqswmfjvhyxeo mhqlyugsravkxoptdwzfjei wejrsutgikxqpfvydhaom ynam ny nys exwzkcjqnvp ekpzvqxjwacn wqnjveazxpkc zjvbqkwcrnepx ecnvywqzjsxkp qmfe qmep dlwymbrsvgxefi gxeyfiqmr mjgkdnbqzcrtfvue ujgvnrtedqkzfobmc nerkmbcuztivgfdpjqy bktnacmqvjredfuzg jgdecrktqnbvmufz desyfjcwkgpabomrxluq uecwxsrgybalkpqofjm gmlaojpwqxsebufrcyk sxfoakcyjlmrghqepwub gmwouepvzjsirxaylfqbkc lugbrcezj ekzuhpxtl bzurvkdm gkzbdvmuwq vihtwalesoqmgzrfub dqogrhlvueimaszbtw lmbiwygzaenursotvhq fagwlnujrsv ujhnvmcrpsqwl dsoq odzqs oxehvgqunspa smoqd dsroq lw qnlwbze zcs dpalw oqevmritxf hw wh mhz h xwpkgiureobdvamtlcs sumvltgxoerdpwbacki faozilpxetcbvwnsrkugdm dioulrkpawstcbxgevm cfziqrvtghejx zahecstbvjrqy gcqrzvjnteolfhd jronwks kjwrso xtfp aqwzv gjvrecbxaqns koficxqpjsvnalzb vcjbqxtunsa bvjxnqcas n n k if hnzquyjxadotim ctrmnlvfugjkoziqy ubnfoyqctmzpij gyqzvjwimunot nzmoluqikjywt wykxduqrzl drklx xdr xrd sdrbokn rsnbdkio qespuyziargjdlwnkbv iaorexbukcmtnwhf gti dit itb tzmwbguraxjcieodnf gmitqzdsnekjoxaf kdeziwsnf lgzkiwen fbvikdpshltegu kpfvidlguehtsb gdysepktuihlvfb jzegrfyducaospkltvwq crzgkleptvuwsfyoqjda rogqtajuweylsdfkzcpv zwacrlsptgqfoveydukj ufokdrzglqjcewtaypvs hsqnofzvt ahvpn umaznoshrwf hzosundfr ushfnzor w ie byandqklvw wadvyxbqikn xspcwfvnkuoydagthjmzbq ahnprtxeojdmgfqvwzuikscyb txpwbvjacrzifgshyluo hgytapvojfsbrxwilcuz wpvxzshcrabfjtygliou bvourjgzfytpiwchlaxs ufesbdavpn siunvefpdab nspafhdvbue vednpusafb sufvpbande lnzxudorwykfqs vckufbqxhwjmtga twz twz twz tzw zwt nuaeqphyvo ovaqetnphu wvhulnpsxroqi ntvqephou hyvuqpon szky kz kz kz kz uekpcxjqrbzy ewiyrkobtl rghuyp ntyzexi yjnq sy eysao yohactxlqbvsfe yacfqtxlsvbeho qxtaesbfhlovyc ybotxfqschvela tsxbqlcyvfohea crvkbef efbvkc erfvbkc fvbikec ecvfkb eziafud odfeiz feizd rmeflzidc zeifdo uh u u u slzwuvhqnbpogia bhviznawou ufazbvinhwo ariwbuvzhon vawnobztduhif lyi syi imy igx qfz yugfqtepvxwdocijlzmhka ymdleizpjgxcvtfhoakuwq utenhymdcgjqzlorxfvakiwp zwlvymtgfxeqcopuahjkdi auzpqtcifejhomdklyvwgx xfvdiwqpktjlaborgez mlcubagjpwzynxekqfiotd fadoezjwqxtpgbkli osldxpzbqeifajtkgw mfxjtn pqesvmxf xmbojhft xbmafc acbfxhm bsua uasb dtmpiwjkuahzryfvqgx iavzqyhgmrxwtdukjp thzkaxwjpydqmviurg uabgmyoidlekzcqnfvxsrw kcybroagdmufqxiseznvl eroscxuqvglanbikzyfdm gfmdeibnkvuaqryzloxcs wtmds cxm wqdrmz voahgpkfml qmougypvzh yoqsgdpnmhuz gauxyzpkoqmjbwfl qguzoivyrdmpt uyerotgj wqszinpyv rosx ors ors osr dtcuiwlse bgaosqntxuwfpvrc uymskctjwz cshbnzoduxlpfrayj hcasypofnrxblduj pjyuoxrfbsaldhnc uharfpoxcdysbnlj bsklgcdmpxio ojbpdlcmtugskx exdkmpboclgy aipogmwxdkrclb dilmqcpkxnwbgo xsajoug pxujgatso guxojsa mbxuwzjosga pxjsugoa tgfw xemdgvyfu jfga lfg khvg kghv vghk ghkv vgkh xfogcwnvkey kvxwomyfeqc woxycvafkbe yovafwxcke ekvfyxnwco ezpfkoxycuwgimqvabdtjnsrh nmpoxgwdyruecazsfjbhqktiv qtjzmaycsgnibdxeuwrfkhvop yfaqredhbxinsvucogwtkmpzjl mhlnsrfadjpekczwquvo vsdneluworhbqjfztamcp smthfdwjznvqpclogaure cevkfuzqxjmwrlasphnod ijrnwqpvudzalfoesmch icmdtnrpq tmdqnirp mdintrqp rtpmniqd clspvk xclpsw rmdoajtxvc vurmjotdsa mdrovatj nadvmrjlot drjotavm kl hfjkblv cklr lrsk glk xpoawenkc yrkpnzjocxue pskncodex b b bq bh b kngbuqcyijvxeh kbcmngjshaxiyve enybjkvqtucgixh zhrevfodplyxnwikjgbc vizojfmup mfzhjqpuoiv uvtmfzipjgol ysobmzkthjdw qlncxwamrtujevfpzgbhkdo gz gd ickxr brenfplc rzpvwumik rjctp hfwcruyoa ihyduxfw zlumthynfkjixo kgxnbhztfyojmli kifzxhtlymngoj rqpdbzgjsowakvt gdzoyhjetcfbqkl nbjgqftozkud zxbogjqktd writbe etri dtfkern ctwyqdi j me nkgzau sxkare qlwakzuxsnfjc ufzkhmwax njuysxmhdzivfgqb uamlqxdhnyvgjibfz eigl lige elig geli legi vrmhebiqupxoclfatdkg ytaoiknwcgrsdzevxj rhac dcajbr oxizsuykfvlwn a na a nka zdua zedtlhmj yqoxn wyqhegrp wypqhegdr unrypgwqhez hypqrgbwe yrgpeqhw mxjkhbqgwuniftedzvcl jciqfnbeumlkhgtvzxwd njwquxidvbhctzmklefg hqfwtcmkuxvbjdelgzni lsigyrmjndapwtehux mtwpirehgfxuasdjnoly hpdlgjnimeusbtyawxr agywjlsmktzihxuceprdn njwhigapyexmdlutvrsb wiaejbsdzncytol cjelwafyindtbzos zalobneisywctdj jbsipuwdcyth thbauysdcgpiw bw b o lr ojkmnthfzlvg vhpzmgtonw yjovmnfwthz fnzhtmoav zcosivnmhdetx hdkofir kanxoflugziyd kodfcrwi qxpmckuelwtarij spxmvqwjrileckuat tuiqrajpwlmekxc taeupwljxricqmk dn dn nd pnd fvyxadu fwxmny vsxgc vscxg scgvx wovudbian dyeosauvinbw auvdwinbyo uaxoqnwirbvzc aosvcdn osna sano shqt sqth ktlracvqpeju tukcwearql trealcukq rsezcvdbal zebvamcdrp cbedrvafxzn vxnibedzrac dbirvczae gbpzy ubglkzp pbgz jtxhnfge xgfhevjtwn tjhngfxe pvodec goedfvamlx eyovd evdorpn vedot lsyqpjuviohbz luzjybidopvx yiplobzvj zobwtpjlvnyi bzoilvpjyu cevybwgdmuahsqzp ucpnimw owunkcpm pmwoucf uqchtxvoaze ehocxtvza cetazvhxo ztvxcaeoh cgsonqxtdfwhzymv qbkncfmuxapdwl mfxjztcwryqdne zbkyrc ckrzb crkzb zkbrc mca cam mca cafm z z z z zytoupbkxdhmgcsflweai smpikvyzcxlawobhefudgjnt dolpihwzxqckmaufytgbse ktsr ktfs itsxvkb n i aklsuty wkgtem mewgtk gkemwt emwgtokb mbuxkiycz fhronqjexplgwa hu emlw vkuwrqnj hys mzet fmclnjvsaexpkg zjwpxevkmacsglf xsamjlvkcenfgp vapjkcmglxefs legmbjuqsdkihtv dlsqkegihbcjtvm hqgdmvljsrktebi ehlbvgidqtjkms btmshvdikljgqe k kr lfi obmup ubm azqdrvjimbfnoyp zbejcqxfkotplndv pbojdfsnzvuwq gjpounhvqdfsbrz minxopwrsbvqegyuajcdth oahnukmgepbtdriscxwvyj xmbtcwgrasnozhdjiupeyv jitgzlokacv vzkushynclojtxgep ntj ntj tjn jtn jnt gdzxykoialsqurtj kigupewoxqjaztcdy zugyaqksiojtxd hyjqxgzdauktio kygqutaszdbxjoi orsfkumexiq rsbjepxmi smrxqgeik arnsetyiomxv mwighaxsdrce mcuzkqvsdpltxe pklvsuexmgqwizd zdqxseckmtyvlwgrp dvslkezanoqxmpb tcbqprkjgnihzs ivgmxyzaernhwcqdjlt otqhfjgcunsrzpi omqbwvktlsxjcfzaphyeid zijtkyxhqvowpulmbgenrdca igrz irzg rzgi kefw kewa akew xtekw ewkf lvxahjydcer sobnzgkp musqfg orijnpvwm obqzv ulvo ozuvt zcbolkqv ouzpgsxejbmqkat btiuxyojspgzqalrek ekbqupzaxfotjgvs t tb t ksyegbpm slmpgdetzbk gbseumpyxk ekvphnbcjgms wgqrmispobkefa gwexf wfxeg xwfeg gfewhxb oephijmkngbxw kxobwjhiegpm wehixbgkjmop rmvtujdxhki lkunxhme mafxsbhuogkypw rpimb prbi ipbr brpi ribp hvjdeyw jhecqpbyvsdw wvhdjye wvjedhy uodmbcpvr wvhk j j j j crzngwqm zqgrwnc rcgnwqz xstoyzgvaefqclbuhi ywbmiguzthefkvqo pcuezdviyoqfbjght ubigqfztyohve zovpgfueibjtqsyh qatefihbypn xwvskd ================================================ FILE: advent-of-code/2020/inputs/7 ================================================ dim silver bags contain 3 posh fuchsia bags. wavy olive bags contain 1 striped olive bag, 1 dull cyan bag. dull coral bags contain 1 dim olive bag, 5 muted violet bags, 2 dark gray bags. bright olive bags contain 3 light indigo bags, 3 dark coral bags. clear lavender bags contain 1 dark olive bag. dim lime bags contain 3 dotted red bags. drab indigo bags contain 5 striped coral bags, 2 muted bronze bags. striped orange bags contain 5 wavy fuchsia bags, 5 clear red bags, 3 plaid red bags. dotted indigo bags contain 2 plaid white bags, 1 wavy gold bag, 1 plaid silver bag. posh crimson bags contain 3 clear crimson bags, 5 dotted silver bags, 3 dull crimson bags, 5 wavy violet bags. mirrored tan bags contain 1 plaid white bag, 3 vibrant beige bags, 3 drab silver bags, 1 pale blue bag. dull turquoise bags contain 5 plaid magenta bags, 3 bright aqua bags, 1 dim purple bag, 1 wavy orange bag. dark tomato bags contain 1 plaid gray bag. shiny red bags contain 4 vibrant maroon bags, 5 faded bronze bags. clear tan bags contain 4 pale lime bags, 4 faded plum bags. mirrored plum bags contain 1 wavy silver bag, 4 dim purple bags, 3 dim coral bags. dotted orange bags contain 4 pale aqua bags, 3 dotted aqua bags, 4 clear beige bags. wavy lime bags contain 5 dim salmon bags, 4 dark violet bags, 4 clear turquoise bags. faded gray bags contain 2 dotted lime bags, 5 plaid tomato bags. pale orange bags contain 5 faded maroon bags. shiny lime bags contain 3 striped olive bags, 5 light fuchsia bags, 1 pale crimson bag, 1 pale salmon bag. drab red bags contain 5 muted chartreuse bags, 4 clear purple bags, 4 drab silver bags, 3 posh green bags. plaid plum bags contain 2 dim blue bags, 1 dim coral bag. clear red bags contain 3 plaid teal bags, 4 vibrant orange bags, 1 pale red bag. dark yellow bags contain 5 mirrored lavender bags, 5 dull bronze bags, 4 pale salmon bags, 5 wavy crimson bags. clear violet bags contain 5 clear turquoise bags, 3 clear beige bags, 4 dim plum bags. plaid cyan bags contain no other bags. light salmon bags contain 3 dull yellow bags, 2 vibrant violet bags, 2 dark orange bags, 1 light magenta bag. dim indigo bags contain 2 vibrant orange bags, 3 drab teal bags, 4 plaid indigo bags. shiny magenta bags contain 1 dark salmon bag, 4 shiny gray bags, 2 mirrored purple bags. drab coral bags contain 5 pale crimson bags, 1 mirrored aqua bag, 4 light red bags. muted blue bags contain 1 dark green bag, 5 muted salmon bags, 4 posh beige bags, 4 pale salmon bags. plaid salmon bags contain 5 striped white bags, 4 posh fuchsia bags, 5 faded turquoise bags. vibrant bronze bags contain 1 bright orange bag, 2 bright plum bags. dull salmon bags contain 2 pale crimson bags, 3 dark tan bags, 5 light plum bags. striped magenta bags contain 4 wavy yellow bags, 3 bright chartreuse bags, 5 plaid cyan bags. light olive bags contain 5 vibrant beige bags, 3 faded tomato bags, 1 dark indigo bag. faded turquoise bags contain 2 shiny salmon bags, 3 wavy crimson bags, 5 dim yellow bags, 1 posh salmon bag. pale fuchsia bags contain 2 posh blue bags, 4 mirrored blue bags, 3 wavy silver bags, 2 wavy crimson bags. dotted tomato bags contain 2 dotted lime bags, 1 wavy teal bag, 1 mirrored black bag, 3 dull gold bags. shiny maroon bags contain 5 striped salmon bags. vibrant gray bags contain 5 clear tan bags, 5 plaid crimson bags, 3 striped cyan bags, 1 dark gold bag. muted tomato bags contain 1 dull salmon bag. striped salmon bags contain 4 plaid white bags, 5 dim salmon bags, 4 vibrant lime bags. light tan bags contain 2 posh lavender bags, 5 shiny aqua bags. wavy brown bags contain 2 posh lavender bags. drab beige bags contain 5 plaid coral bags, 3 bright turquoise bags, 5 dark purple bags, 3 mirrored black bags. bright tomato bags contain 1 bright teal bag, 2 bright tan bags, 2 dotted salmon bags. dim tan bags contain 2 striped cyan bags, 5 wavy green bags, 3 drab beige bags. light plum bags contain 4 clear silver bags, 1 vibrant chartreuse bag. light black bags contain 1 muted tan bag, 2 dim yellow bags. clear orange bags contain 5 mirrored violet bags, 1 wavy salmon bag, 3 dim plum bags. bright gray bags contain 5 dim blue bags, 1 dotted red bag, 5 mirrored aqua bags. striped cyan bags contain 4 striped teal bags, 1 dark tan bag, 1 dim green bag. shiny olive bags contain 1 dark aqua bag, 2 muted lime bags. clear brown bags contain 5 dark salmon bags. dotted tan bags contain 2 plaid brown bags. light green bags contain 5 plaid silver bags, 5 posh aqua bags, 3 dull green bags, 5 faded red bags. posh coral bags contain 1 muted teal bag. drab green bags contain 1 dotted blue bag. dark fuchsia bags contain 2 wavy tomato bags, 3 faded plum bags. vibrant purple bags contain 3 posh tomato bags, 4 dim purple bags, 5 plaid brown bags, 4 dotted red bags. vibrant tomato bags contain 5 wavy orange bags, 1 striped teal bag. faded coral bags contain 5 dotted maroon bags, 2 light tan bags, 1 plaid black bag, 4 dark indigo bags. posh gold bags contain 4 mirrored plum bags. muted beige bags contain 2 pale brown bags, 4 dull black bags, 4 vibrant blue bags. dull green bags contain 3 drab silver bags, 5 dotted red bags, 3 mirrored violet bags, 3 bright black bags. dark lime bags contain 5 light chartreuse bags, 3 pale magenta bags, 1 dull indigo bag. dark orange bags contain 1 dark crimson bag, 2 clear turquoise bags, 2 dotted silver bags. muted yellow bags contain 2 pale salmon bags, 3 bright plum bags, 3 shiny aqua bags, 5 plaid cyan bags. vibrant white bags contain 5 dim coral bags, 5 dim bronze bags. posh white bags contain 2 wavy blue bags, 3 clear chartreuse bags, 1 wavy coral bag, 5 drab turquoise bags. faded violet bags contain 4 dim bronze bags. bright yellow bags contain 5 pale violet bags, 2 striped fuchsia bags. dim blue bags contain 2 posh salmon bags, 4 posh red bags, 5 clear turquoise bags, 4 muted lavender bags. plaid olive bags contain no other bags. posh plum bags contain 2 drab turquoise bags, 4 bright fuchsia bags, 4 drab indigo bags. posh violet bags contain 3 plaid olive bags, 2 posh teal bags, 1 posh purple bag. pale beige bags contain 4 wavy crimson bags, 5 shiny gold bags. shiny turquoise bags contain 5 dark gray bags, 4 clear brown bags. clear bronze bags contain 1 dull coral bag, 1 mirrored cyan bag, 2 dotted orange bags, 1 plaid magenta bag. dark magenta bags contain 3 vibrant orange bags, 1 dull lime bag, 1 dim plum bag. light silver bags contain 2 posh coral bags. drab gold bags contain 5 mirrored gold bags, 1 bright blue bag. dull fuchsia bags contain 3 pale blue bags. muted brown bags contain 4 drab fuchsia bags, 4 plaid bronze bags. bright coral bags contain 2 dull crimson bags. clear black bags contain 5 striped brown bags. mirrored coral bags contain 2 striped brown bags, 4 clear coral bags. dull purple bags contain 1 plaid green bag, 5 shiny gold bags. drab brown bags contain 4 striped coral bags, 1 muted magenta bag, 4 faded red bags. faded plum bags contain 5 shiny orange bags. vibrant violet bags contain 1 drab gold bag, 1 light violet bag. clear salmon bags contain 5 posh orange bags, 1 wavy fuchsia bag, 5 mirrored yellow bags. dull yellow bags contain 5 light orange bags, 4 striped purple bags. striped olive bags contain 1 plaid beige bag, 1 shiny turquoise bag, 2 drab gold bags, 1 pale lime bag. clear beige bags contain no other bags. mirrored fuchsia bags contain 1 clear olive bag, 3 pale aqua bags. posh turquoise bags contain 5 pale crimson bags, 3 dull cyan bags. dull lime bags contain 3 plaid chartreuse bags. wavy black bags contain 3 dull salmon bags, 5 plaid teal bags. dim lavender bags contain 1 dark gray bag, 2 muted indigo bags. wavy yellow bags contain 2 striped turquoise bags. striped gray bags contain 3 drab white bags. dotted magenta bags contain 3 plaid white bags, 4 clear beige bags, 1 faded maroon bag, 3 muted lavender bags. vibrant coral bags contain 5 shiny olive bags, 2 pale brown bags. dim aqua bags contain 5 striped crimson bags, 3 bright lavender bags. pale lavender bags contain 3 vibrant tan bags. bright fuchsia bags contain 2 dotted fuchsia bags. dark black bags contain 5 drab purple bags, 3 striped yellow bags, 2 posh tan bags. dark teal bags contain 3 plaid white bags, 5 bright cyan bags, 1 posh blue bag, 4 mirrored magenta bags. plaid brown bags contain 3 bright plum bags, 1 muted magenta bag, 4 clear gray bags, 2 clear crimson bags. mirrored magenta bags contain no other bags. light brown bags contain 4 wavy red bags, 2 faded white bags. dotted purple bags contain 2 pale lime bags. clear teal bags contain 3 plaid red bags, 3 striped coral bags, 4 mirrored black bags, 2 posh red bags. striped gold bags contain 3 bright plum bags, 2 mirrored gold bags. dotted black bags contain 2 clear crimson bags, 1 dark violet bag, 2 clear teal bags, 3 mirrored purple bags. dim gray bags contain 1 dotted salmon bag, 2 dim silver bags, 5 wavy black bags, 2 dotted green bags. shiny black bags contain 3 plaid bronze bags, 5 dim plum bags, 3 muted teal bags, 5 muted magenta bags. plaid orange bags contain 5 plaid crimson bags, 4 muted white bags, 4 dark lime bags, 5 plaid cyan bags. striped fuchsia bags contain 1 dull bronze bag, 1 wavy aqua bag, 1 plaid salmon bag, 2 faded cyan bags. wavy white bags contain 4 posh beige bags. dull teal bags contain 1 vibrant blue bag, 1 light red bag, 3 striped brown bags. vibrant chartreuse bags contain 1 shiny aqua bag, 4 clear crimson bags, 1 faded red bag, 1 dull crimson bag. wavy cyan bags contain 5 striped red bags, 1 shiny magenta bag. vibrant olive bags contain 3 light fuchsia bags, 5 pale tan bags, 5 light tomato bags. dotted fuchsia bags contain 5 clear silver bags, 5 light aqua bags, 5 posh beige bags. wavy tomato bags contain 2 wavy tan bags, 3 muted lavender bags, 2 pale salmon bags. posh lime bags contain 4 drab lime bags, 4 dull lavender bags. shiny white bags contain 1 plaid olive bag, 2 faded white bags, 2 dull salmon bags. bright plum bags contain 1 dotted salmon bag, 4 plaid red bags, 1 mirrored purple bag, 3 shiny aqua bags. dotted lavender bags contain 1 light green bag, 3 light magenta bags. bright gold bags contain 4 dim blue bags, 5 dark salmon bags, 2 posh crimson bags. striped violet bags contain 4 posh plum bags, 1 drab crimson bag, 2 faded orange bags, 3 dotted green bags. dull plum bags contain 1 dark maroon bag. striped tomato bags contain 5 striped maroon bags, 1 plaid turquoise bag. muted bronze bags contain 1 plaid red bag. dull lavender bags contain 2 plaid white bags. dark bronze bags contain 1 clear turquoise bag, 5 dim purple bags, 2 bright turquoise bags, 2 striped coral bags. muted green bags contain 3 plaid white bags, 5 pale blue bags, 3 plaid tan bags, 2 clear turquoise bags. mirrored bronze bags contain 2 faded white bags, 3 bright teal bags, 2 clear red bags, 2 clear crimson bags. clear silver bags contain 5 dim yellow bags, 2 striped brown bags, 1 muted magenta bag. dark indigo bags contain 3 faded maroon bags, 3 mirrored purple bags. posh silver bags contain 3 dotted maroon bags, 1 striped indigo bag, 1 faded red bag. light teal bags contain 1 vibrant beige bag, 1 striped plum bag, 4 dim salmon bags. dull orange bags contain 2 shiny teal bags, 5 muted teal bags, 1 dark fuchsia bag, 4 bright magenta bags. muted red bags contain 2 mirrored magenta bags. dotted gray bags contain 3 dull maroon bags, 4 mirrored blue bags, 3 mirrored red bags. light lime bags contain 5 plaid fuchsia bags, 4 posh plum bags. pale coral bags contain 3 shiny gray bags, 2 plaid beige bags. dim brown bags contain 1 faded gray bag. drab tan bags contain 5 dotted crimson bags. clear chartreuse bags contain 4 faded maroon bags, 5 plaid white bags. posh maroon bags contain 1 clear beige bag, 5 light black bags. mirrored blue bags contain 4 faded gray bags, 5 mirrored olive bags, 1 pale lime bag. clear coral bags contain 1 plaid fuchsia bag, 4 drab yellow bags, 4 light bronze bags. mirrored orange bags contain 4 mirrored lavender bags, 3 faded orange bags, 4 mirrored gold bags, 3 dim silver bags. pale bronze bags contain 4 plaid orange bags, 3 wavy chartreuse bags, 2 clear red bags. faded yellow bags contain 2 posh green bags. light magenta bags contain 3 clear silver bags, 3 pale magenta bags. clear aqua bags contain 2 dark tan bags. clear yellow bags contain 5 dim violet bags, 5 drab bronze bags. plaid yellow bags contain 4 dotted salmon bags. pale salmon bags contain 2 plaid olive bags, 5 clear beige bags. bright magenta bags contain 2 shiny maroon bags, 1 bright maroon bag, 5 shiny white bags. dull brown bags contain 4 posh fuchsia bags, 2 dotted tan bags. muted magenta bags contain no other bags. muted lavender bags contain 5 light aqua bags, 1 faded maroon bag, 4 plaid lavender bags. dotted violet bags contain 2 pale red bags, 3 mirrored magenta bags. wavy gray bags contain 5 dark indigo bags, 3 dim yellow bags, 3 posh lime bags, 1 wavy yellow bag. posh beige bags contain 4 mirrored magenta bags, 1 striped brown bag, 1 mirrored aqua bag, 5 dotted silver bags. drab crimson bags contain 2 faded coral bags, 4 light indigo bags, 4 dark indigo bags. wavy magenta bags contain 5 clear gold bags, 4 dim purple bags, 3 pale green bags. dim fuchsia bags contain 2 drab teal bags, 4 plaid brown bags, 5 faded orange bags. faded indigo bags contain 2 faded orange bags, 4 striped turquoise bags, 4 pale salmon bags, 4 bright cyan bags. posh yellow bags contain 2 pale gold bags, 3 posh coral bags, 1 dotted tan bag. muted chartreuse bags contain 5 plaid brown bags, 3 dull green bags. dotted plum bags contain 4 mirrored purple bags, 1 drab tan bag, 3 striped white bags. clear plum bags contain 3 posh green bags. striped red bags contain 1 striped tomato bag, 1 wavy fuchsia bag, 3 clear yellow bags. striped aqua bags contain 4 posh teal bags, 2 bright beige bags. dim gold bags contain 5 dull salmon bags, 3 mirrored red bags, 1 mirrored black bag. mirrored brown bags contain 1 mirrored salmon bag. wavy plum bags contain 3 shiny yellow bags, 5 light crimson bags, 5 dotted silver bags. striped coral bags contain no other bags. dark gray bags contain 4 dotted salmon bags, 2 clear brown bags, 2 posh crimson bags, 5 mirrored plum bags. posh chartreuse bags contain 2 wavy fuchsia bags, 4 mirrored beige bags. dotted gold bags contain 1 dark lavender bag, 1 striped black bag. posh green bags contain 3 dotted salmon bags, 4 pale salmon bags, 3 posh red bags, 4 dim green bags. plaid blue bags contain 2 posh green bags, 3 dim cyan bags, 5 dull bronze bags. light lavender bags contain 5 muted green bags, 1 light violet bag, 5 muted plum bags. pale plum bags contain 5 muted lavender bags, 5 light bronze bags, 4 plaid crimson bags. mirrored indigo bags contain 4 dark violet bags, 2 wavy purple bags, 5 plaid tan bags. dim violet bags contain 4 mirrored black bags, 4 dull lime bags, 3 posh crimson bags, 1 pale brown bag. shiny coral bags contain 1 light aqua bag, 5 plaid olive bags, 4 bright turquoise bags. dotted cyan bags contain 4 shiny olive bags, 4 light bronze bags, 2 dim plum bags. mirrored teal bags contain 5 dim violet bags. shiny purple bags contain 4 dim magenta bags, 2 clear white bags, 3 posh silver bags, 1 shiny turquoise bag. shiny gray bags contain 5 pale lavender bags, 3 vibrant turquoise bags, 1 faded maroon bag, 1 bright cyan bag. mirrored chartreuse bags contain 2 clear white bags. light beige bags contain 5 mirrored turquoise bags, 5 plaid maroon bags, 3 light silver bags. dull tomato bags contain 1 shiny gold bag, 4 pale blue bags. plaid teal bags contain 1 dim purple bag, 3 striped turquoise bags, 3 light indigo bags, 2 faded red bags. vibrant aqua bags contain 3 mirrored turquoise bags, 1 light plum bag, 5 clear teal bags, 1 dull blue bag. dotted turquoise bags contain 5 bright fuchsia bags, 5 dim blue bags, 3 posh green bags, 3 wavy red bags. dark lavender bags contain 1 mirrored lime bag, 2 plaid red bags, 2 striped white bags, 1 plaid tomato bag. plaid tan bags contain 5 plaid white bags. pale olive bags contain 1 clear salmon bag. wavy indigo bags contain 1 plaid black bag, 1 wavy teal bag, 3 mirrored salmon bags. drab chartreuse bags contain 2 light lime bags, 3 drab yellow bags. drab blue bags contain 3 vibrant brown bags. muted purple bags contain 2 shiny yellow bags. muted aqua bags contain 4 striped white bags. mirrored violet bags contain 3 wavy violet bags, 4 mirrored aqua bags. bright cyan bags contain 3 wavy fuchsia bags, 2 dark coral bags, 1 shiny orange bag. posh teal bags contain 5 bright gray bags, 4 faded gray bags, 2 plaid turquoise bags. muted lime bags contain 2 striped coral bags, 1 dark tan bag, 4 plaid cyan bags. mirrored crimson bags contain 4 faded violet bags, 1 posh purple bag. light blue bags contain 2 dotted blue bags, 2 dark gold bags, 5 bright cyan bags, 1 light crimson bag. dull beige bags contain 2 dark turquoise bags, 5 mirrored violet bags, 1 muted crimson bag. dark cyan bags contain 5 muted blue bags. dim turquoise bags contain 3 shiny silver bags, 1 pale yellow bag, 3 plaid chartreuse bags, 1 posh bronze bag. faded brown bags contain 3 dim silver bags, 2 mirrored bronze bags. wavy bronze bags contain 3 shiny tomato bags, 3 dim salmon bags. pale brown bags contain 3 pale tan bags, 2 plaid olive bags, 2 posh lavender bags, 1 shiny aqua bag. dull white bags contain 1 dull red bag, 5 dark gold bags, 3 striped magenta bags, 2 muted green bags. plaid crimson bags contain 5 drab bronze bags, 2 pale blue bags. bright lavender bags contain 1 dark bronze bag. plaid red bags contain 3 striped turquoise bags, 4 dull crimson bags, 1 striped brown bag, 2 clear crimson bags. muted gold bags contain 5 dotted black bags, 1 striped salmon bag, 3 drab purple bags, 5 bright red bags. striped silver bags contain 3 posh black bags. bright aqua bags contain 4 light orange bags, 3 wavy blue bags, 3 dull lime bags. plaid fuchsia bags contain 2 shiny orange bags. bright violet bags contain 1 drab turquoise bag, 1 dim cyan bag, 4 pale blue bags, 3 wavy blue bags. dim white bags contain 1 plaid black bag, 5 plaid violet bags, 2 light gray bags. bright tan bags contain 5 bright gold bags, 3 shiny salmon bags, 2 muted magenta bags, 1 dotted black bag. shiny bronze bags contain 3 light aqua bags, 4 clear crimson bags, 1 light beige bag, 4 clear blue bags. muted silver bags contain 4 striped lavender bags. dull red bags contain 1 dim coral bag, 1 faded plum bag, 4 plaid red bags. wavy aqua bags contain 2 dotted fuchsia bags, 2 mirrored tomato bags. dark olive bags contain 4 muted yellow bags, 2 shiny gold bags, 2 posh crimson bags. dark crimson bags contain 3 shiny aqua bags, 1 wavy black bag. dark brown bags contain 2 drab lavender bags, 5 posh green bags, 4 pale turquoise bags. pale blue bags contain 2 striped coral bags, 2 shiny gold bags. vibrant blue bags contain 1 mirrored lavender bag, 4 dark aqua bags, 5 wavy coral bags. posh cyan bags contain 1 dull lavender bag, 3 striped gray bags, 1 vibrant orange bag. faded red bags contain 1 posh crimson bag, 1 wavy coral bag, 5 clear beige bags, 3 dotted silver bags. vibrant gold bags contain 3 drab lavender bags, 5 dim magenta bags, 2 bright tomato bags, 4 light magenta bags. shiny chartreuse bags contain 5 vibrant turquoise bags. clear gray bags contain 4 wavy coral bags, 2 dark salmon bags, 3 dark indigo bags. pale maroon bags contain 4 posh tomato bags, 5 bright tan bags. light turquoise bags contain 3 drab fuchsia bags, 4 bright silver bags, 5 light green bags. muted crimson bags contain 1 dim yellow bag, 4 wavy fuchsia bags, 2 mirrored magenta bags, 2 clear beige bags. dull gray bags contain 2 posh green bags. light fuchsia bags contain 5 dark gold bags, 3 plaid black bags, 2 bright lavender bags. striped green bags contain 2 striped fuchsia bags, 5 dull tomato bags, 2 posh crimson bags. mirrored purple bags contain 2 posh crimson bags, 2 mirrored magenta bags, 3 wavy violet bags, 1 striped coral bag. vibrant black bags contain 3 clear magenta bags, 4 muted salmon bags, 5 posh blue bags. plaid beige bags contain 2 dark black bags, 5 plaid yellow bags, 2 bright violet bags. pale teal bags contain 3 pale crimson bags. striped turquoise bags contain no other bags. dim purple bags contain 2 dull crimson bags, 5 bright red bags. faded cyan bags contain 5 posh aqua bags, 4 dull green bags, 3 dark olive bags. mirrored cyan bags contain 5 plaid salmon bags, 4 dim salmon bags, 4 posh tomato bags. striped purple bags contain 2 faded salmon bags, 2 bright tan bags, 4 drab white bags. bright blue bags contain 3 light purple bags, 1 pale yellow bag. faded bronze bags contain 1 light indigo bag, 3 plaid green bags, 5 posh orange bags. striped white bags contain 4 drab indigo bags, 5 wavy tomato bags, 5 dotted fuchsia bags, 2 dim silver bags. clear lime bags contain 2 dotted magenta bags, 5 striped magenta bags, 3 bright coral bags, 3 mirrored silver bags. bright white bags contain 3 dim lavender bags. dim crimson bags contain 1 posh black bag, 1 mirrored silver bag. clear olive bags contain 4 vibrant purple bags, 3 drab lavender bags, 2 pale violet bags. light coral bags contain 2 dotted green bags, 2 wavy aqua bags, 4 dark salmon bags, 3 light gold bags. muted plum bags contain 5 plaid tan bags, 1 mirrored silver bag, 3 vibrant turquoise bags. dim plum bags contain 4 bright plum bags. drab bronze bags contain 1 light indigo bag, 3 striped brown bags, 3 clear gold bags, 3 clear gray bags. plaid maroon bags contain 1 dotted orange bag, 5 light magenta bags, 4 faded salmon bags, 3 pale yellow bags. wavy violet bags contain 2 dotted silver bags, 3 dull crimson bags, 5 mirrored aqua bags, 4 striped brown bags. pale crimson bags contain 3 bright chartreuse bags, 4 light turquoise bags, 1 bright gray bag, 1 muted bronze bag. mirrored aqua bags contain no other bags. clear crimson bags contain 2 pale salmon bags, 4 mirrored magenta bags, 1 striped coral bag, 5 plaid olive bags. dark tan bags contain 4 wavy silver bags, 4 dark aqua bags. wavy maroon bags contain 3 clear gray bags. light crimson bags contain 3 clear silver bags. vibrant green bags contain 1 clear magenta bag, 1 dim white bag, 4 plaid black bags. bright bronze bags contain 2 light brown bags. light maroon bags contain 5 bright red bags, 2 bright tan bags, 5 dim silver bags, 4 pale salmon bags. dark coral bags contain 2 light crimson bags. pale silver bags contain 2 mirrored magenta bags, 3 posh red bags, 1 muted yellow bag, 5 dark salmon bags. dotted crimson bags contain 4 faded salmon bags, 4 vibrant beige bags, 5 dim beige bags. dull silver bags contain 1 striped brown bag, 2 shiny magenta bags. striped beige bags contain 4 clear crimson bags. faded orange bags contain 2 drab white bags, 3 striped salmon bags, 5 bright chartreuse bags. drab olive bags contain 4 clear purple bags. dull maroon bags contain 3 dotted magenta bags. vibrant lavender bags contain 2 light tomato bags, 1 shiny teal bag. dotted chartreuse bags contain 4 faded white bags, 2 light brown bags. drab cyan bags contain 2 pale coral bags, 3 light purple bags, 2 drab bronze bags, 1 dim beige bag. bright teal bags contain 2 vibrant plum bags, 2 dull tan bags, 1 dim tomato bag, 5 dark violet bags. wavy fuchsia bags contain 1 dim green bag, 2 wavy violet bags. drab black bags contain 3 striped tomato bags, 4 light salmon bags, 4 dim yellow bags, 3 shiny black bags. dark green bags contain 5 dark tan bags. clear tomato bags contain 4 mirrored gold bags, 4 dark gold bags. plaid aqua bags contain 5 dotted coral bags, 1 muted white bag. plaid white bags contain 3 clear crimson bags, 3 wavy gold bags, 3 pale lime bags, 2 striped brown bags. muted black bags contain 1 wavy tan bag, 4 mirrored turquoise bags. faded aqua bags contain 5 dull turquoise bags, 1 vibrant tan bag. vibrant brown bags contain 5 pale silver bags, 3 drab orange bags, 1 clear olive bag. pale cyan bags contain 2 faded cyan bags, 1 mirrored tan bag, 3 vibrant aqua bags, 3 light gold bags. shiny salmon bags contain 5 posh red bags, 5 light chartreuse bags, 2 striped brown bags. plaid lime bags contain 4 dim gold bags, 1 clear magenta bag. drab tomato bags contain 5 clear orange bags. faded beige bags contain 3 dark crimson bags, 2 mirrored tan bags. vibrant crimson bags contain 4 wavy blue bags, 5 clear gray bags. dotted maroon bags contain 5 dotted red bags, 4 wavy silver bags, 1 drab brown bag, 3 dark black bags. striped indigo bags contain 3 striped orange bags. dim orange bags contain 1 wavy lavender bag, 5 drab brown bags, 1 dull salmon bag. posh olive bags contain 3 faded indigo bags, 1 plaid white bag. striped lavender bags contain 1 bright red bag. muted violet bags contain 3 bright tan bags, 5 striped coral bags, 1 drab bronze bag. wavy tan bags contain 1 striped brown bag, 3 dim salmon bags, 1 posh fuchsia bag, 4 mirrored violet bags. dull magenta bags contain 1 clear red bag, 4 dull green bags, 2 posh lime bags, 5 mirrored gold bags. dotted red bags contain 1 mirrored black bag, 3 dull bronze bags, 2 dim salmon bags. drab turquoise bags contain 5 muted yellow bags, 1 light indigo bag, 5 dotted black bags. faded purple bags contain 5 dim orange bags, 3 dark red bags. faded teal bags contain 1 bright fuchsia bag. plaid gray bags contain 5 pale aqua bags. bright black bags contain 4 wavy violet bags. dim green bags contain 3 mirrored aqua bags, 1 light chartreuse bag, 1 light indigo bag. dark gold bags contain 2 mirrored red bags, 2 bright lavender bags, 3 pale crimson bags. dark plum bags contain 2 pale salmon bags. wavy orange bags contain 2 light tan bags, 1 pale yellow bag, 2 shiny aqua bags, 4 vibrant orange bags. bright chartreuse bags contain 5 dark salmon bags, 1 plaid olive bag. wavy purple bags contain 4 faded coral bags, 2 vibrant orange bags. shiny violet bags contain 3 plaid chartreuse bags, 2 plaid brown bags. posh indigo bags contain 1 posh salmon bag. clear indigo bags contain 3 light violet bags. plaid purple bags contain 1 clear blue bag, 2 muted gold bags, 1 dull brown bag. posh lavender bags contain 1 plaid black bag, 3 shiny orange bags, 3 posh red bags, 4 plaid cyan bags. wavy silver bags contain 3 plaid cyan bags, 1 plaid olive bag. posh salmon bags contain 3 clear gray bags, 5 dotted silver bags, 4 shiny aqua bags. faded lavender bags contain 4 drab chartreuse bags, 4 plaid magenta bags, 1 vibrant tomato bag. pale red bags contain 4 bright red bags, 4 pale lime bags, 3 striped turquoise bags. bright purple bags contain 3 muted lavender bags. dim magenta bags contain 1 plaid teal bag, 3 posh lavender bags. posh magenta bags contain 3 pale teal bags, 5 mirrored tomato bags, 2 striped gold bags, 2 bright tomato bags. bright brown bags contain 1 dark fuchsia bag, 4 pale yellow bags, 5 shiny crimson bags. light red bags contain 1 wavy teal bag. pale turquoise bags contain 3 mirrored yellow bags. vibrant magenta bags contain 4 dark gold bags. dotted salmon bags contain 3 wavy violet bags, 4 shiny aqua bags, 4 dull bronze bags. mirrored gray bags contain 3 dark plum bags, 3 striped gray bags, 4 plaid violet bags. dim yellow bags contain 3 striped turquoise bags, 2 pale salmon bags, 4 mirrored magenta bags, 5 striped brown bags. drab lavender bags contain 2 faded maroon bags, 2 shiny orange bags. muted maroon bags contain 1 wavy tomato bag, 2 drab red bags. clear gold bags contain 3 mirrored olive bags, 3 striped turquoise bags. light bronze bags contain 1 muted lavender bag. dotted bronze bags contain 2 dotted turquoise bags. pale tomato bags contain 3 shiny beige bags, 1 mirrored tomato bag, 2 dotted maroon bags, 2 wavy teal bags. pale chartreuse bags contain 5 plaid silver bags. drab magenta bags contain 5 wavy tomato bags, 1 drab brown bag, 2 posh maroon bags, 5 mirrored teal bags. posh blue bags contain 3 muted lime bags, 1 mirrored tomato bag, 5 shiny aqua bags. posh purple bags contain 5 dull maroon bags. posh bronze bags contain 2 mirrored orange bags, 2 pale violet bags, 2 plaid gray bags. pale gold bags contain 4 striped brown bags, 2 muted green bags. faded crimson bags contain 5 drab salmon bags, 2 posh crimson bags, 3 light purple bags, 5 clear red bags. vibrant fuchsia bags contain 2 posh beige bags, 4 dotted indigo bags, 5 pale silver bags, 4 clear black bags. faded lime bags contain 3 posh plum bags, 3 shiny aqua bags, 4 dull chartreuse bags. shiny fuchsia bags contain 4 shiny salmon bags, 3 pale chartreuse bags. wavy lavender bags contain 2 dark blue bags, 5 muted salmon bags. pale indigo bags contain 1 wavy gold bag, 1 clear silver bag, 3 dim blue bags. drab violet bags contain 4 muted yellow bags. shiny plum bags contain 3 bright black bags, 5 pale teal bags, 5 light red bags, 2 plaid magenta bags. shiny gold bags contain 1 vibrant chartreuse bag. wavy gold bags contain 5 posh beige bags, 1 mirrored aqua bag. dark salmon bags contain 3 light aqua bags, 3 posh red bags, 2 mirrored black bags, 1 posh crimson bag. pale tan bags contain 4 wavy coral bags. dull tan bags contain 4 bright cyan bags. clear maroon bags contain 4 dim magenta bags, 2 shiny lavender bags. light white bags contain 3 dark brown bags, 4 bright fuchsia bags. wavy red bags contain 4 dim red bags. dotted aqua bags contain 4 striped teal bags. bright beige bags contain 5 shiny tomato bags. plaid indigo bags contain 1 muted bronze bag. light yellow bags contain 2 striped black bags, 2 muted gold bags, 3 dotted tan bags, 5 dark coral bags. vibrant silver bags contain 2 dim blue bags. posh tomato bags contain 5 bright red bags, 3 posh red bags, 3 plaid olive bags, 4 clear crimson bags. pale magenta bags contain 3 mirrored blue bags, 5 dull maroon bags, 5 dark violet bags. light indigo bags contain 2 plaid olive bags, 1 plaid black bag, 3 dark indigo bags. shiny green bags contain 1 vibrant chartreuse bag, 4 bright lavender bags, 3 wavy crimson bags, 4 dull red bags. striped maroon bags contain 2 posh coral bags, 2 striped gray bags, 3 clear plum bags. posh fuchsia bags contain 2 wavy gold bags, 2 posh beige bags. dim coral bags contain 4 wavy gold bags, 4 muted lavender bags. faded maroon bags contain 5 dim purple bags, 4 bright red bags, 5 wavy violet bags, 1 mirrored aqua bag. striped black bags contain 4 plaid fuchsia bags, 5 bright lavender bags, 4 dull black bags. mirrored gold bags contain 3 dotted silver bags. light tomato bags contain 5 pale brown bags, 3 wavy coral bags. dark white bags contain 2 mirrored tomato bags, 1 striped orange bag, 1 dim olive bag, 2 dotted blue bags. dotted green bags contain 3 clear plum bags. dotted brown bags contain 1 clear magenta bag. muted orange bags contain 3 muted olive bags, 2 faded yellow bags, 2 faded turquoise bags, 3 muted violet bags. dull olive bags contain 2 dotted teal bags. mirrored lime bags contain 4 dark violet bags, 4 muted yellow bags. wavy green bags contain 5 bright lime bags. drab purple bags contain 2 striped turquoise bags, 4 clear silver bags, 1 muted lime bag. clear cyan bags contain 5 light lavender bags. dim black bags contain 3 dull black bags. posh gray bags contain 4 mirrored magenta bags. dotted yellow bags contain 4 light maroon bags, 1 clear blue bag, 5 dark maroon bags. mirrored olive bags contain 2 dark violet bags, 2 dull crimson bags, 5 dim salmon bags, 5 bright tan bags. dark blue bags contain 3 dull aqua bags, 1 dim teal bag. dull bronze bags contain 4 striped coral bags. drab maroon bags contain 2 dark bronze bags, 1 wavy blue bag. mirrored lavender bags contain 4 clear black bags. dim beige bags contain 3 shiny silver bags, 2 dark purple bags, 3 dull green bags. light violet bags contain 1 muted gray bag, 5 wavy tomato bags. striped chartreuse bags contain 3 dull tan bags, 1 dim salmon bag. posh red bags contain 2 clear crimson bags, 2 striped coral bags, 2 bright red bags. wavy beige bags contain 5 muted silver bags, 5 pale teal bags. light gray bags contain 5 drab indigo bags, 3 posh crimson bags, 1 dark tan bag, 2 pale red bags. muted white bags contain 3 wavy fuchsia bags. pale violet bags contain 4 wavy tan bags, 2 plaid yellow bags. drab fuchsia bags contain 1 plaid lavender bag, 2 pale lime bags. clear green bags contain 4 light indigo bags. vibrant turquoise bags contain 2 vibrant tan bags, 3 clear silver bags. faded green bags contain 5 striped orange bags, 4 bright fuchsia bags. striped tan bags contain 4 wavy silver bags. clear white bags contain 3 vibrant fuchsia bags, 2 pale silver bags, 1 vibrant indigo bag, 3 shiny silver bags. dim cyan bags contain 2 mirrored black bags, 2 plaid chartreuse bags, 4 bright gold bags. muted gray bags contain 3 mirrored violet bags, 4 dim yellow bags. mirrored maroon bags contain 5 clear crimson bags, 2 clear gray bags, 1 dotted salmon bag. dim bronze bags contain 2 striped plum bags, 2 bright orange bags. shiny tomato bags contain 4 dim yellow bags, 2 faded bronze bags, 1 drab maroon bag, 3 dim gold bags. muted olive bags contain 2 mirrored yellow bags, 4 bright olive bags. shiny brown bags contain 3 bright coral bags. clear blue bags contain 2 pale green bags, 2 light violet bags, 4 plaid crimson bags. faded tan bags contain 4 dim crimson bags, 3 mirrored turquoise bags, 3 drab gold bags. muted cyan bags contain 2 drab silver bags. mirrored red bags contain 1 bright gold bag. faded salmon bags contain 5 posh red bags, 4 dull crimson bags, 3 dotted salmon bags, 5 shiny olive bags. dark purple bags contain 5 dim magenta bags. dotted lime bags contain 4 posh fuchsia bags, 3 wavy tan bags, 2 mirrored aqua bags, 1 shiny aqua bag. posh tan bags contain 3 plaid tan bags, 2 drab fuchsia bags. dotted teal bags contain 4 dull crimson bags, 2 bright lavender bags, 2 wavy tan bags, 4 muted crimson bags. clear purple bags contain 4 shiny aqua bags, 1 dim cyan bag, 3 dotted black bags, 4 dull gray bags. light gold bags contain 2 dotted magenta bags, 5 dark olive bags, 3 dim cyan bags, 2 dark indigo bags. mirrored silver bags contain 2 plaid black bags, 3 vibrant beige bags, 3 mirrored purple bags, 3 dotted lime bags. posh black bags contain 4 wavy violet bags, 3 plaid teal bags. faded silver bags contain 2 vibrant purple bags, 5 shiny olive bags. drab teal bags contain 2 dotted salmon bags, 4 posh beige bags, 4 mirrored tan bags, 1 muted green bag. dark maroon bags contain 2 dark tan bags, 5 mirrored gold bags, 2 dim plum bags. striped plum bags contain 3 striped coral bags, 5 clear brown bags, 1 striped brown bag. striped bronze bags contain 4 drab yellow bags, 4 striped chartreuse bags, 5 posh plum bags, 3 clear blue bags. drab plum bags contain 1 shiny gold bag, 5 vibrant tan bags, 3 light gold bags. clear fuchsia bags contain 1 vibrant red bag. dark silver bags contain 5 clear salmon bags, 1 faded yellow bag, 1 shiny lavender bag, 3 wavy fuchsia bags. striped lime bags contain 2 dim tomato bags, 3 light fuchsia bags, 1 light lime bag. wavy salmon bags contain 1 shiny tomato bag, 1 light tomato bag. dim maroon bags contain 4 faded beige bags, 2 bright turquoise bags, 4 dull purple bags, 4 vibrant olive bags. faded chartreuse bags contain 4 mirrored blue bags, 5 posh white bags, 2 wavy magenta bags. clear magenta bags contain 2 muted bronze bags, 5 dim yellow bags, 2 dotted lime bags. bright silver bags contain 2 bright gold bags, 4 wavy yellow bags. dull violet bags contain 3 faded beige bags, 1 mirrored orange bag, 1 mirrored aqua bag. vibrant cyan bags contain 2 clear aqua bags, 2 dark maroon bags, 5 pale tan bags. light chartreuse bags contain 1 wavy gold bag, 2 posh tomato bags, 2 clear silver bags. dotted olive bags contain 5 wavy crimson bags, 1 drab tomato bag. posh aqua bags contain 3 striped brown bags. posh orange bags contain 2 wavy coral bags. dull cyan bags contain 1 dark tan bag, 5 dull gray bags, 3 drab turquoise bags, 4 shiny aqua bags. muted teal bags contain 4 dull blue bags. bright turquoise bags contain 5 dull bronze bags, 1 plaid lavender bag. plaid tomato bags contain 2 muted lime bags, 1 light indigo bag, 5 posh tomato bags. dim salmon bags contain 1 dark indigo bag, 5 plaid brown bags, 3 clear crimson bags, 4 clear silver bags. posh brown bags contain 3 clear silver bags, 5 faded cyan bags, 4 posh crimson bags. dark turquoise bags contain 1 drab crimson bag, 5 striped coral bags. dull crimson bags contain no other bags. striped teal bags contain 5 plaid lavender bags, 4 faded red bags. dotted blue bags contain 5 muted beige bags. vibrant plum bags contain 1 pale lime bag, 1 posh red bag, 1 dull bronze bag, 3 drab silver bags. wavy coral bags contain 4 mirrored magenta bags, 5 dim yellow bags, 4 bright red bags, 2 posh crimson bags. dark chartreuse bags contain 5 dotted fuchsia bags, 3 mirrored silver bags, 5 mirrored aqua bags, 4 dim cyan bags. vibrant teal bags contain 3 vibrant silver bags. shiny beige bags contain 5 posh teal bags. dim olive bags contain 3 clear gray bags, 4 wavy gold bags. drab yellow bags contain 4 light chartreuse bags, 3 striped crimson bags, 2 faded gray bags. dull chartreuse bags contain 1 light lavender bag. dotted silver bags contain no other bags. shiny blue bags contain 5 dull brown bags, 2 dark coral bags, 4 shiny crimson bags. mirrored black bags contain 5 mirrored magenta bags, 1 striped turquoise bag, 2 plaid cyan bags. dull black bags contain 4 dim purple bags, 4 dark salmon bags, 2 mirrored gold bags. mirrored beige bags contain 4 striped fuchsia bags, 4 plaid black bags, 5 dim red bags, 5 light green bags. dim chartreuse bags contain 4 shiny yellow bags. shiny teal bags contain 1 vibrant maroon bag. dim tomato bags contain 5 plaid tomato bags, 5 mirrored violet bags, 2 mirrored orange bags. vibrant beige bags contain 1 plaid black bag, 3 dotted salmon bags, 2 posh fuchsia bags. dull aqua bags contain 5 wavy tan bags, 3 bright olive bags. pale lime bags contain 5 bright turquoise bags, 5 dim yellow bags, 3 shiny orange bags. bright orange bags contain 4 muted gold bags, 1 clear white bag. drab salmon bags contain 2 dark fuchsia bags, 2 dull gray bags. mirrored salmon bags contain 3 posh plum bags, 1 dotted silver bag, 1 clear plum bag, 5 dull black bags. shiny silver bags contain 4 drab lavender bags, 2 dim violet bags, 5 dark aqua bags, 2 vibrant chartreuse bags. plaid coral bags contain 4 dim blue bags, 1 vibrant lime bag. mirrored white bags contain 2 pale gold bags, 3 shiny green bags, 5 striped white bags. pale gray bags contain 5 mirrored gold bags, 1 wavy silver bag, 5 posh green bags, 1 mirrored red bag. pale white bags contain 4 shiny turquoise bags, 4 bright plum bags, 5 dotted bronze bags. muted fuchsia bags contain 5 plaid turquoise bags, 2 dark aqua bags, 4 pale brown bags, 4 striped plum bags. striped yellow bags contain 5 posh red bags, 1 plaid black bag. plaid silver bags contain 2 dark indigo bags, 3 clear teal bags, 3 dotted black bags. plaid black bags contain 3 dull crimson bags. vibrant lime bags contain 1 dotted fuchsia bag, 4 dull bronze bags, 4 dark aqua bags, 1 dark salmon bag. dotted white bags contain 5 dim red bags. light aqua bags contain 5 mirrored aqua bags, 2 striped brown bags, 4 posh crimson bags. striped brown bags contain 1 dotted silver bag, 5 clear beige bags. vibrant red bags contain 3 bright olive bags, 3 plaid chartreuse bags, 3 light olive bags, 4 dim violet bags. dim teal bags contain 3 clear violet bags. bright lime bags contain 2 dull lavender bags, 4 pale turquoise bags. striped crimson bags contain 5 bright gray bags, 4 dark green bags, 4 posh plum bags, 5 shiny coral bags. mirrored tomato bags contain 1 wavy tan bag. dull blue bags contain 5 bright turquoise bags, 2 striped brown bags. mirrored yellow bags contain 4 vibrant purple bags, 4 faded bronze bags, 2 dull lavender bags, 3 light plum bags. plaid gold bags contain 5 striped olive bags, 5 dotted chartreuse bags. dotted coral bags contain 2 bright teal bags. wavy crimson bags contain 5 dotted salmon bags, 1 dull crimson bag. dark aqua bags contain 3 dull crimson bags, 5 light aqua bags, 3 mirrored purple bags, 1 striped brown bag. vibrant yellow bags contain 1 faded beige bag, 3 dark brown bags, 1 wavy bronze bag. wavy teal bags contain 5 dotted magenta bags. drab white bags contain 3 pale blue bags. muted salmon bags contain 4 posh salmon bags, 1 bright chartreuse bag. light purple bags contain 5 dark maroon bags. faded black bags contain 4 dull gold bags. muted turquoise bags contain 1 wavy silver bag, 4 clear purple bags. plaid chartreuse bags contain 1 posh crimson bag, 5 striped brown bags. vibrant tan bags contain 2 dull blue bags, 1 posh black bag, 1 faded red bag, 5 plaid magenta bags. shiny orange bags contain 5 vibrant chartreuse bags, 3 shiny gold bags. shiny lavender bags contain 2 posh teal bags. pale black bags contain 5 dark brown bags. shiny cyan bags contain 5 wavy tomato bags, 3 bright bronze bags, 3 faded crimson bags. faded olive bags contain 3 clear aqua bags. dark violet bags contain 4 faded red bags. light orange bags contain 1 posh aqua bag, 2 light crimson bags, 2 dark maroon bags. drab silver bags contain 1 pale blue bag. plaid bronze bags contain 5 mirrored orange bags, 4 plaid cyan bags, 1 dotted black bag. plaid violet bags contain 1 plaid fuchsia bag, 5 clear teal bags. clear turquoise bags contain 4 dim yellow bags, 5 plaid teal bags, 3 plaid red bags, 1 dotted salmon bag. plaid lavender bags contain 3 clear silver bags, 4 dull bronze bags. mirrored green bags contain 3 striped lavender bags. faded white bags contain 2 light chartreuse bags. bright crimson bags contain 2 mirrored purple bags. dotted beige bags contain 1 pale salmon bag, 5 dotted teal bags, 5 light lavender bags, 3 wavy violet bags. pale green bags contain 2 dark gold bags, 4 clear gray bags. dull indigo bags contain 2 striped brown bags, 3 plaid plum bags. shiny yellow bags contain 3 striped silver bags, 2 mirrored plum bags, 1 muted red bag, 5 clear gold bags. bright maroon bags contain 2 muted crimson bags, 2 plaid chartreuse bags, 1 dim violet bag, 1 plaid blue bag. vibrant orange bags contain 5 posh plum bags, 4 shiny gold bags. faded fuchsia bags contain 2 dotted aqua bags. bright indigo bags contain 3 shiny coral bags, 1 muted salmon bag, 2 clear white bags, 1 vibrant maroon bag. shiny indigo bags contain 4 dark red bags, 2 pale lime bags. light cyan bags contain 2 clear black bags, 2 mirrored aqua bags, 1 faded beige bag, 2 faded salmon bags. faded gold bags contain 5 muted lime bags, 3 plaid fuchsia bags. muted coral bags contain 2 faded indigo bags, 1 dim beige bag, 5 dotted orange bags, 4 posh black bags. drab gray bags contain 5 clear magenta bags, 5 bright tomato bags, 1 dull gold bag. vibrant salmon bags contain 4 bright gold bags. dark red bags contain 5 posh black bags, 4 faded teal bags. wavy blue bags contain 3 dim green bags, 4 dull green bags, 2 posh aqua bags. mirrored turquoise bags contain 5 dull lime bags, 4 dark gray bags, 1 striped cyan bag, 4 muted gold bags. wavy chartreuse bags contain 1 pale brown bag, 4 shiny chartreuse bags, 4 wavy fuchsia bags. dim red bags contain 1 bright blue bag, 3 clear purple bags, 2 wavy crimson bags, 5 shiny black bags. dull gold bags contain 4 wavy blue bags. faded blue bags contain 1 plaid turquoise bag, 2 vibrant indigo bags. shiny aqua bags contain 4 plaid cyan bags, 4 posh crimson bags. bright salmon bags contain 1 posh red bag, 1 shiny orange bag, 1 vibrant crimson bag. pale yellow bags contain 4 plaid cyan bags. plaid magenta bags contain 3 plaid brown bags, 5 pale yellow bags, 5 drab fuchsia bags, 1 clear black bag. vibrant maroon bags contain 4 dull tomato bags, 1 dotted indigo bag, 2 plaid teal bags, 2 shiny gold bags. drab orange bags contain 3 wavy coral bags. pale aqua bags contain 5 wavy lime bags, 5 drab turquoise bags. shiny crimson bags contain 3 posh black bags, 5 drab fuchsia bags, 1 plaid fuchsia bag, 4 posh plum bags. pale purple bags contain 2 clear green bags, 2 striped crimson bags, 4 drab indigo bags. faded magenta bags contain 5 light red bags. shiny tan bags contain 5 plaid silver bags, 3 light lavender bags, 4 wavy purple bags. vibrant indigo bags contain 5 plaid beige bags. wavy turquoise bags contain 4 dark teal bags, 2 dark cyan bags, 4 mirrored olive bags, 5 bright red bags. striped blue bags contain 1 vibrant lime bag, 3 vibrant indigo bags, 1 pale maroon bag, 2 dark white bags. faded tomato bags contain 3 plaid tan bags, 4 pale tan bags, 5 wavy violet bags, 3 pale lime bags. bright green bags contain 1 bright purple bag, 5 posh magenta bags. dark beige bags contain 4 light green bags, 4 light magenta bags, 5 dotted lime bags, 4 plaid salmon bags. plaid green bags contain 2 pale salmon bags. bright red bags contain 2 dotted silver bags. drab lime bags contain 3 dotted bronze bags. muted indigo bags contain 4 posh gray bags, 2 dark lavender bags, 2 plaid chartreuse bags, 2 pale red bags. muted tan bags contain 2 muted brown bags, 3 dull maroon bags. plaid turquoise bags contain 3 clear teal bags, 2 dull tomato bags, 5 dotted purple bags, 1 posh salmon bag. drab aqua bags contain 3 bright lime bags, 5 posh red bags. ================================================ FILE: advent-of-code/2020/inputs/8 ================================================ acc +13 jmp +412 nop +137 nop +144 acc +33 acc -11 jmp +445 nop +327 acc -10 jmp +1 jmp +578 jmp +1 jmp +415 acc +25 acc +21 jmp +58 jmp +180 jmp +96 nop +190 acc +20 jmp +167 jmp +194 acc +24 acc +9 acc +14 jmp +1 jmp +443 jmp +1 acc +18 jmp +465 jmp +245 jmp +219 nop +280 acc +13 acc +23 jmp +133 jmp +300 acc +35 acc +50 acc +24 acc +32 jmp +458 acc +36 acc +14 jmp +103 nop +262 jmp +233 acc +14 nop +313 jmp +30 acc +7 jmp +324 acc +12 jmp +1 acc +12 jmp +326 acc +14 nop +151 acc +2 jmp -14 jmp +1 nop +18 jmp +288 acc +24 acc +7 acc +0 jmp +268 jmp +267 acc +3 acc +4 acc +35 jmp +25 jmp -16 acc +14 acc +38 acc +41 jmp +3 acc -16 jmp +546 acc +42 acc -6 acc +38 acc +18 jmp +391 acc +45 jmp +464 jmp +144 acc +33 acc -18 acc +36 jmp +313 jmp +286 acc +34 nop -72 acc -17 jmp +430 acc +35 acc -18 acc -1 jmp +75 acc +48 acc -2 jmp -76 acc -13 nop +453 acc +0 nop +48 jmp +40 acc +40 acc -5 acc +14 acc +1 jmp +323 acc +16 acc +17 nop +408 acc +22 jmp +126 acc +2 jmp +404 acc +22 nop +373 acc -15 jmp +134 nop +242 jmp +1 acc +19 jmp +372 acc +18 acc +33 acc +31 acc -12 jmp +417 acc +27 acc -4 jmp +84 nop -86 jmp -87 jmp +174 acc -19 acc +17 nop +353 jmp +301 acc +14 acc -16 acc +2 jmp -109 acc +24 jmp +366 acc -8 acc -14 acc +20 acc +38 jmp -62 acc +4 jmp +1 nop +423 jmp +33 acc -19 acc +50 jmp -128 acc +10 acc +2 jmp +371 acc +31 acc +12 acc +12 jmp +337 acc +42 acc -19 jmp +64 jmp +1 nop -52 jmp -19 acc +34 jmp +287 acc -6 jmp +130 acc +22 acc +22 acc +46 acc -18 jmp +190 acc +13 acc -18 acc +26 jmp +283 acc +15 jmp +193 jmp -168 nop +165 acc -3 acc +26 jmp -54 acc -4 jmp -174 jmp +96 acc +44 acc -18 acc +8 acc +23 jmp -164 acc -11 acc -13 acc +30 jmp +114 acc -9 jmp +386 acc -15 jmp +98 nop -74 acc +31 acc -4 acc +15 jmp +113 acc -3 acc +36 jmp +362 jmp +225 jmp +131 acc +14 acc +48 acc -16 nop +302 jmp +383 acc -14 jmp +97 acc +5 acc -6 jmp -4 acc +27 jmp +165 acc +49 jmp +36 nop -213 acc +30 acc +18 jmp +1 jmp +54 nop +73 nop +185 acc -4 jmp -156 acc +17 jmp +1 acc +30 jmp +357 nop +60 jmp +1 jmp -186 acc -17 acc +26 acc +45 jmp +74 acc +27 acc +1 jmp -109 acc +49 acc +4 jmp +298 acc +12 jmp -42 acc -16 jmp -195 acc +19 acc -13 acc +31 acc +31 jmp +201 jmp +274 jmp +1 acc +27 acc +41 acc +35 jmp +9 nop +32 jmp -190 acc +2 jmp +1 jmp +172 acc +10 acc -13 jmp -95 acc -10 acc -12 acc -4 jmp +290 nop -91 nop +288 acc +45 acc +40 jmp +322 acc +9 jmp +314 acc -10 acc +3 nop -62 acc +46 jmp +186 acc +14 acc +40 acc +49 acc +29 jmp -175 acc +37 acc -8 jmp +254 jmp +48 acc +30 acc +40 jmp +1 jmp -172 acc -9 acc +42 nop -269 jmp -154 nop +109 acc +0 jmp -68 acc +40 jmp +310 acc +4 jmp +266 jmp +80 acc +15 acc -14 jmp -206 acc +17 jmp +156 acc -19 acc +25 nop +82 acc +13 jmp +243 jmp +259 jmp +258 acc +29 acc +9 jmp -76 acc +5 acc +41 acc +49 acc +17 jmp +161 acc +29 nop +215 jmp +179 acc +45 acc +23 jmp +208 acc +3 acc +30 jmp +38 nop +204 jmp -62 jmp +1 acc +10 jmp +78 acc +32 acc +29 jmp -269 acc +20 acc +24 jmp +1 jmp -114 jmp +160 acc -19 jmp +137 nop -312 acc +8 acc +3 jmp -181 jmp +122 acc +9 jmp -166 jmp -106 jmp +98 jmp -152 acc -7 acc +19 jmp +180 jmp +195 acc -17 acc +19 acc +8 acc +21 jmp +193 jmp +226 acc +5 jmp +14 jmp +228 acc +44 nop +112 acc +0 acc +12 jmp +223 acc +21 nop +87 acc +32 acc +42 jmp -264 acc +31 jmp +49 acc -3 acc +16 nop -277 acc +45 jmp +50 acc +0 acc +7 nop -223 acc +11 jmp +113 acc +32 acc +20 jmp +108 acc -7 acc +30 jmp +66 acc -12 acc +34 acc -9 acc +39 jmp +126 jmp -351 jmp -89 jmp -45 acc +4 acc +7 acc -1 acc +41 jmp -229 acc -9 acc +29 jmp -115 acc +27 acc -11 jmp +187 acc -10 acc +11 acc +29 acc +46 jmp -115 nop -116 acc +31 jmp -202 acc +12 jmp +1 acc +16 acc +15 jmp -25 acc -7 jmp -439 acc +10 acc +26 acc +13 jmp -75 nop -214 acc +2 nop -202 jmp +105 jmp -65 acc -15 acc +6 jmp +1 jmp -182 acc +13 acc -19 jmp +26 acc +20 acc -16 acc +14 jmp -59 jmp -204 acc +27 acc +44 nop -33 acc +36 jmp -300 acc +48 acc +28 acc +29 acc +39 jmp -249 acc +33 acc +31 jmp +1 acc +33 jmp -269 acc +8 acc +31 acc +10 acc +5 jmp -194 jmp -477 nop -196 acc +50 acc -13 jmp -47 nop +77 acc +45 jmp -293 acc +39 jmp -19 nop -391 acc +28 acc +50 acc +16 jmp -209 acc -1 acc +39 acc -17 nop -233 jmp -283 acc +19 acc +0 acc +22 acc +22 jmp -488 acc +39 nop -286 acc +33 jmp -23 jmp -173 jmp -274 acc +5 acc +45 acc +0 acc -14 jmp -342 acc +16 acc +28 nop -155 jmp -488 acc +12 acc +28 nop -181 acc +17 jmp -447 acc +40 acc +40 acc +13 jmp -38 acc -12 nop -494 acc +43 jmp -533 acc +30 jmp -518 acc +39 acc +4 nop -179 jmp -127 acc +31 acc +42 acc +17 jmp -82 nop -520 jmp -521 jmp -193 acc -8 jmp -142 jmp +1 acc +39 jmp -532 acc +30 acc +3 acc +22 nop -84 jmp +2 jmp -402 jmp -468 acc +0 acc -4 acc -19 jmp -379 jmp -357 acc +0 jmp -159 acc +13 acc +24 acc -3 acc +0 jmp -387 acc +31 acc +20 acc +27 jmp -308 jmp -161 acc -6 nop -163 acc -3 jmp -585 nop -586 nop -6 acc +10 acc +42 jmp -590 acc +0 acc +34 acc +16 acc +9 jmp -175 acc +29 jmp -217 acc +0 jmp -234 jmp -47 acc +28 acc +0 acc +25 acc -5 jmp -556 nop -144 jmp +1 acc +27 jmp -117 jmp -10 acc +24 acc -17 acc +9 acc +18 jmp -310 jmp -455 nop -437 jmp -593 acc +15 acc +50 acc -3 jmp -50 acc -13 acc +14 acc +34 acc -16 jmp +1 ================================================ FILE: advent-of-code/2020/inputs/9 ================================================ 30 20 2 19 18 15 49 50 23 39 16 31 41 36 22 35 40 38 33 8 13 43 48 24 42 69 44 10 29 60 21 54 18 26 28 34 37 39 23 30 31 32 83 36 79 33 38 40 59 41 42 43 44 46 53 85 56 48 49 63 81 55 54 74 84 64 65 80 76 78 71 79 82 90 87 92 89 93 147 119 97 102 136 103 118 109 120 206 129 143 175 141 150 180 212 160 161 169 176 325 182 186 190 205 199 200 249 221 223 227 259 270 272 311 399 329 531 336 373 343 584 448 345 358 368 376 411 459 581 811 472 444 680 450 486 643 542 583 640 960 701 679 779 688 824 703 713 721 744 1153 945 992 1255 1165 894 1362 1265 1364 1286 1028 1331 2520 1693 1319 1367 1503 1382 1391 1401 1434 1416 1457 1465 1909 1839 1886 1922 2392 2059 2314 3793 2293 2347 2359 2395 3343 2686 3615 2701 2749 2773 2798 2792 2817 3351 2873 2922 5317 4610 4198 5085 5215 4352 5081 4607 6152 6969 6044 4754 5387 8950 7405 5518 5450 5522 8952 5590 5609 5690 5795 7071 9361 8962 9413 9106 9567 9688 10272 9994 14374 10141 10204 10549 11040 10837 16139 10968 10972 19960 11212 30164 11280 11299 15936 15999 18519 18068 18956 18673 25105 21034 26133 20135 20690 20345 30486 21041 26976 21809 21805 36970 21940 41944 22579 22492 41041 27216 27235 36071 36587 36741 37024 37629 58392 40480 40825 42924 54211 41035 61380 42846 64786 43614 58550 58910 62972 44432 45071 59166 86538 73700 77504 63306 81515 74216 144821 74653 152157 81305 140749 81860 83881 86106 84649 87278 86460 107404 88046 89503 103342 119085 103598 108377 271242 137959 189264 137522 171927 148869 155958 248153 190237 211002 163165 205191 237818 169987 171109 172695 173738 177549 222683 191388 192845 206940 409201 341914 245899 275481 397022 328910 293480 304827 312034 501605 333152 336903 334274 335860 343725 341096 508012 363954 346433 351287 368937 384233 580173 486325 557933 521380 598307 539379 568961 605514 616861 655759 676877 646308 854445 905613 670134 675370 1163771 715370 697720 872667 710387 867813 720224 753170 923612 1007705 1025704 1060759 1266681 1358684 1544690 1174475 1222375 2226497 1366532 1316442 1578200 1367854 1345504 1385504 1390740 1463557 1473394 1408107 1430611 3572001 1620983 1780983 2069612 2342146 2033409 2086463 2235234 3611609 3452995 2396850 2541007 2538817 2661946 2682974 3051594 2713358 2731008 2736244 2776244 2798847 4608429 4186752 3690595 5444366 4321990 3401966 5724004 4103021 4430259 4119872 4321697 4632084 4935667 4937857 5133094 5449602 5200763 7793616 5396332 7977007 7384673 5467252 8266099 6178210 7092561 7504987 8643687 8012585 10136430 7521838 7723663 9499353 9257364 8441569 11311304 8953781 9567751 12293324 15745961 10333857 14190795 10597095 11574542 14040019 12559813 17021191 11645462 13270771 20087031 14597548 17838844 15245501 15534423 22838522 16475619 19287638 25462760 17395350 20879055 19901608 20164846 36682988 25564095 32640851 20930952 22171637 22242557 42959445 24205275 33870969 24916233 49116470 27868319 29843049 33373267 34314463 30779924 42144165 35763257 38647256 37296958 37560196 38326302 58227910 40066454 56113526 43102589 43173509 44414194 45136227 46376912 52085606 49121508 52073594 52784552 58289500 70970908 57711368 60622973 64153191 74380917 69106226 73060215 95259115 77626650 74857154 75886498 78392756 108898078 83169043 86276098 89550421 104870158 90791106 91513139 95498420 104159200 147332709 104858146 113407525 116000868 137213406 118334341 146732876 133259417 185107094 164604646 147917369 150743652 152483804 179727312 154279254 161561799 172719464 180341527 175826519 181063560 308294675 285222760 187011559 199657620 284546115 246666942 223192487 229408393 461049279 251593758 265067217 347574989 465564287 298661021 327644681 300401173 303227456 342625359 484880380 315841053 348545983 353060991 356168046 368075119 476075335 386669179 410204046 579238439 451251378 785281553 808646832 545249446 481002151 852955499 516660975 592711898 616242226 599062194 601888477 659395502 837920557 619068509 658466412 926865021 664387036 701606974 989442485 724243165 754744298 796873225 1330530999 861455424 967912353 1053139855 997663126 1026251597 1061910421 1215304420 1109372873 1115723169 1191774092 2392441420 1200950671 1220956986 1653829521 1277534921 1322853448 1656129538 1713685650 1365994010 1425850139 1478987463 2162867235 2225096042 1658328649 1923365845 1398413738 3650946181 2023914723 2059573547 2088162018 2253684513 2301146965 3581694494 2307497261 2392724763 2421907657 3630350709 3591090052 3402353308 2600388369 4768347318 2764407748 2791844149 2824263877 4646409276 3871712226 3056742387 3321779583 3947280568 4224512810 3422328461 4331411984 5641268041 4147735565 4341846531 4554831478 5882841459 6194197457 4814632420 7379095355 5022296026 5364796117 5392232518 6226617185 5424652246 5616108026 5556251897 13020363396 5881006264 10071061522 6378521970 8236960881 6744108044 9038436487 7753740445 15435857639 8479147549 10933353448 10905137485 8896678009 9369463898 9836928446 10179428537 11558740464 10387092143 10414528544 10757028635 19971789935 11497114290 16792176932 21320445591 17311875418 12259528234 12625114308 19236176184 13122630014 14497848489 15223255593 16232887994 17375825558 17848611447 18266141907 18733606455 19311206553 27730002284 26647416538 20251456990 21171557179 32763990396 20801620687 21911642834 22254142925 28872939848 29345725737 36028353116 47606546303 30498455572 31388771921 27620478503 50517282916 28345885607 29721104082 31456143587 33608713552 45469089950 36114753354 37577348460 38985063445 39562663543 41053077677 41423014169 41973177866 42713263521 63735231857 64107169124 44165785759 61954599159 55966364110 56966204240 57341582585 86632036270 62844915508 58066989689 59076622090 59802029194 92566019590 61177247669 65064857139 69723466906 73692101814 75677416897 76562411905 78547726988 80615741220 82476091846 83396192035 84686441387 114033353799 100132149869 118878651284 138442455956 137739659574 173181760810 114307786825 116418204675 117869018883 124866886333 117143611779 120253869759 120979276863 126242104808 136854664566 134788324045 158153508743 152239828802 154225143885 155110138893 159163468208 163091833066 165872283881 168082633422 184818591256 318201971959 214439936694 255042193804 230725991500 231451398604 232176805708 280960851949 242735905216 235012630662 320097427766 237397481538 241233146622 247221381671 495400788643 322255301274 292941832788 478630628160 306464972687 401446525556 314273607101 400396614830 380312220575 333954917303 352901224678 399258527950 445165928194 557494909304 462177390104 466464029266 482234012333 467189436370 472410112200 476245777284 484618863209 530339314326 488454528293 773654409057 626896750091 599406805475 1400551159148 607215439889 620738579788 640419889990 686856141981 667174831779 714267137878 820090661048 733213445253 837520087887 1327276031971 1099306862291 949423448703 928641419370 948655889484 939599548570 1419497466523 957028975409 1128874418283 1643885117390 1018793842619 1313752892072 1206622245364 1528048224845 1220145385263 1227954019677 1606774380349 1261158469778 1307594721769 1420069587234 1447480583131 1534357798926 2264623697178 1570733533140 1777119636457 1868240967940 2813396625713 1877297308854 2456689644215 1888255438054 1896628523979 3096194987617 2533898277335 2147668260902 2426767630627 2948117812079 2489112489455 3149413907832 2448099404940 2708639052909 3297366896088 2568753191547 2681228057012 2727664309003 2867550170365 3018214116271 3745538276794 4430526801314 3347853169597 3924787897359 5184353953218 4336354842994 6763122473621 4624292832982 3784883962033 4044296784881 4681566538237 4595767665842 4574435891529 4874867035567 4937211894395 5249981248559 9256002429766 5129327461952 5277392244456 6075517478600 9851828135985 5408892366015 8427104815031 7132737131630 6366067285868 7093391446391 8261142740353 8969237915251 10313681415170 8380651627875 7829180746914 8359319853562 8409176795015 13013534700132 8618732676410 9170203557371 17587970591661 9449302927096 9812078929962 13636712098018 10379308710511 13670035106368 10406719706408 11352909723056 14984799962278 13789543993890 13818069161030 13459458732259 14961917878544 26650246798150 14922572193305 16090323487267 16188500600476 16447913423324 16209832374789 28940880314717 16768496648577 17027909471425 22078191408669 17788936233781 23267372088126 38229289966670 19261381857058 25368637584952 20786028416919 34575572410809 49917618886276 21759629429464 24812368455315 27249002726149 27607613154920 31607005394811 28382030925564 36876351904186 31111072793781 33216410071901 32278824087743 47299573394257 44276912197574 37554525065496 39106100880094 68665597859277 49008632155613 69340362760451 37050318090839 40047410273977 41021011286522 42545657846383 46571997884779 45598396872234 50141660355028 54038453517207 70153271001303 74954028810343 95059464803729 78850821972522 61598440997465 70266728162740 83358070426929 63389896881524 117452844395560 69329142178582 74604843156335 76156418970933 77097728364816 94085863791184 88144054718617 153624798589669 78071329377361 205596899114177 81068421560499 100610451401986 ================================================ FILE: advent-of-code/2021/.gitignore ================================================ Cargo.lock target/ ================================================ FILE: advent-of-code/2021/day01/Cargo.toml ================================================ [package] name = "day01" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day01/src/main.rs ================================================ use std::fs; fn main() { println!("first = {:?}", first()); println!("second = {:?}", second()); } fn numbers() -> Vec { fs::read_to_string("../inputs/01") .unwrap() .lines() .map(|line| line.parse::().unwrap()) .collect::>() } fn first() -> usize { numbers().windows(2).filter(|a| a[1] > a[0]).count() } fn second() -> usize { numbers() .windows(3) .map(|a| a[0] + a[1] + a[2]) .collect::>() .windows(2) .filter(|a| a[1] > a[0]) .count() } ================================================ FILE: advent-of-code/2021/day02/Cargo.toml ================================================ [package] name = "day02" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day02/src/main.rs ================================================ use std::fs; enum Direction { Forward(i64), Up(i64), Down(i64), } use Direction::*; fn main() { println!("first = {:?}", first()); println!("second = {:?}", second()); } fn directions() -> Vec { fs::read_to_string("../inputs/02") .unwrap() .lines() .map(|line| { let words = line.split(" ").collect::>(); let amount = words[1].parse::().unwrap(); match words[0] { "forward" => Forward(amount), "up" => Up(amount), "down" => Down(amount), _ => panic!(), } }) .collect() } fn first() -> i64 { let mut x = 0; let mut y = 0; for direction in directions() { match direction { Forward(delta) => x += delta, Up(delta) => y -= delta, Down(delta) => y += delta, } } x * y } fn second() -> i64 { let mut x = 0; let mut y = 0; let mut aim = 0; for direction in directions() { match direction { Forward(delta) => { x += delta; y += aim * delta } Up(delta) => aim -= delta, Down(delta) => aim += delta, } } x * y } ================================================ FILE: advent-of-code/2021/day03/Cargo.toml ================================================ [package] name = "day03" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day03/src/main.rs ================================================ use std::fs; fn main() { println!("first = {:?}", first()); println!("second = {:?}", second()); } fn input() -> Vec { fs::read_to_string("../inputs/03") .unwrap() .lines() .map(|line| line.to_string()) .collect() } fn ones(numbers: &Vec) -> Vec { let length = numbers[0].len(); let mut counts: Vec = vec![0; length]; for number in numbers { for (i, _) in number.chars().enumerate().filter(|(_, b)| *b == '1') { counts[i] += 1 } } counts } fn decimal(digits: &Vec) -> usize { digits .iter() .rev() .enumerate() .fold(0, |a, (i, &b)| a + (b << i)) } fn first() -> usize { let numbers = input(); let n = numbers.len(); let counts = ones(&numbers); let most_common_bits = counts .iter() .map(|&count| if count > n / 2 { 1 } else { 0 }) .collect::>(); let least_common_bits = most_common_bits.iter().map(|&b| 1 - b).collect::>(); decimal(&most_common_bits) * decimal(&least_common_bits) } fn filter(numbers: Vec, position: usize, f: F) -> Vec where F: Fn(usize, usize) -> bool, { let count = ones(&numbers)[position]; let target = if f(count, numbers.len()) { b'1' } else { b'0' }; numbers .into_iter() .filter(|number| number.as_bytes()[position] == target) .collect() } fn iterate(numbers: &Vec, f: F) -> usize where F: Fn(usize, usize) -> bool, { let mut numbers = numbers.clone(); let w = numbers[0].len(); for i in (0..w).cycle() { if numbers.len() == 1 { return usize::from_str_radix(&numbers[0], 2).unwrap(); } else { numbers = filter(numbers, i, &f); } } panic!() } fn second() -> usize { let numbers = input(); iterate(&numbers, |count, total| count * 2 >= total) * iterate(&numbers, |count, total| count * 2 < total) } ================================================ FILE: advent-of-code/2021/day04/Cargo.toml ================================================ [package] name = "day04" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day04/src/main.rs ================================================ use std::fs; struct Cell { number: i64, marked: bool, } struct Board { rows: Vec>, score: Option, } impl Board { fn iter(&self) -> impl Iterator { self.rows.iter().flat_map(|row| row.iter()) } fn iter_mut(&mut self) -> impl Iterator { self.rows.iter_mut().flat_map(|row| row.iter_mut()) } fn mark(&mut self, number: i64) { for cell in self.iter_mut().filter(|c| c.number == number) { cell.marked = true } } fn is_winning(&self) -> bool { self.rows.iter().any(|row| row.iter().all(|c| c.marked)) || (0..4).any(|col| self.rows.iter().all(|row| row[col].marked)) } fn unmarked_sum(&self) -> i64 { self.iter().map(|c| c.number).sum() } } fn parse_input() -> (Vec, Vec) { let lines = fs::read_to_string("../inputs/04") .unwrap() .lines() .map(|x| x.to_string()) .collect::>(); let numbers = lines[0] .split(",") .map(|n| n.parse::().unwrap()) .collect(); let boards = lines[2..] .chunks(6) .map(|rows| Board { score: None, rows: rows .iter() .take(5) .map(|line| { line.split_ascii_whitespace() .map(|x| Cell { number: x.parse().unwrap(), marked: false, }) .collect() }) .collect(), }) .collect(); (numbers, boards) } fn main() { let (numbers, mut boards) = parse_input(); let mut scores: Vec = vec![]; for number in numbers { for board in boards.iter_mut().filter(|b| b.score == None) { board.mark(number); if board.is_winning() { let score = board.unmarked_sum() * number; board.score = Some(score); scores.push(score) } } } println!("first = {}", scores.first().unwrap()); println!("second = {}", scores.last().unwrap()); } ================================================ FILE: advent-of-code/2021/day05/Cargo.toml ================================================ [package] name = "day05" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day05/src/main.rs ================================================ use std::collections::HashMap; use std::fs; #[derive(Debug, PartialEq, Eq, Hash)] struct Point { x: i64, y: i64, } #[derive(Debug, Hash)] struct Line { from: Point, to: Point, } fn parse_input() -> Vec { fs::read_to_string("../inputs/05") .unwrap() .lines() .map(|line| { let parts: Vec> = line .split(" -> ") .map(|part| part.split(",").map(|d| d.parse::().unwrap()).collect()) .collect(); Line { from: Point { x: parts[0][0], y: parts[0][1], }, to: Point { x: parts[1][0], y: parts[1][1], }, } }) .collect() } fn range(a: i64, b: i64) -> Box> { if a > b { Box::new((b..=a).rev()) } else { Box::new((a..=b).into_iter()) } } impl Line { fn is_diagonal(&self) -> bool { self.from.x != self.to.x && self.from.y != self.to.y } fn points(&self) -> Vec { if self.from.x == self.to.x { range(self.from.y, self.to.y) .map(|y| Point { x: self.from.x, y }) .collect() } else if self.from.y == self.to.y { range(self.from.x, self.to.x) .map(|x| Point { x, y: self.from.y }) .collect() } else { range(self.from.x, self.to.x) .zip(range(self.from.y, self.to.y)) .map(|(x, y)| Point { x, y }) .collect() } } } fn intersections<'a>(lines: impl Iterator) -> usize { let mut counts: HashMap = HashMap::new(); for point in lines.flat_map(|line| line.points()) { let count = counts.entry(point).or_insert(0); *count += 1; } counts.values().filter(|c| **c > 1).count() } fn main() { let lines = parse_input(); println!( "first = {}", intersections(lines.iter().filter(|line| !line.is_diagonal())) ); println!("second = {}", intersections(lines.iter())); } ================================================ FILE: advent-of-code/2021/day06/Cargo.toml ================================================ [package] name = "day06" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day06/src/main.rs ================================================ use std::fs::read_to_string; fn parse_input() -> Vec { let input = read_to_string("../inputs/06").unwrap(); input[0..input.len()-1].split(",").map(|chunk| chunk.parse().unwrap()).collect() } fn iterate(numbers: &[usize; 9], iterations: usize) -> usize { let mut counts = numbers.clone(); for _ in 0..iterations { let born = counts[0]; for i in 1..=8 { counts[i - 1] = counts[i] } counts[8] = born; counts[6] += born; } counts.iter().sum() } fn main() { let numbers = parse_input(); let mut counts: [usize; 9] = [0; 9]; for number in numbers { counts[number] += 1 } println!("first = {}", iterate(&counts, 80)); println!("second = {}", iterate(&counts, 256)); } ================================================ FILE: advent-of-code/2021/day07/Cargo.toml ================================================ [package] name = "day07" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day07/src/main.rs ================================================ use std::fs::read_to_string; fn parse_input() -> Vec { let input = read_to_string("../inputs/07").unwrap(); input[0..input.len() - 1] .split(",") .map(|chunk| chunk.parse().unwrap()) .collect() } fn main() { let numbers = parse_input(); let max = *numbers.iter().max().unwrap(); let first: i64 = (0..=max) .map(|i| numbers.iter().map(|n| (n - i).abs()).sum()) .min() .unwrap(); let second: i64 = (0..=max) .map(|i| { numbers .iter() .map(|n| (n - i).abs()) .map(|n| n * (n + 1) / 2) .sum() }) .min() .unwrap(); println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day08/Cargo.toml ================================================ [package] name = "day08" version = "0.1.0" authors = ["Stefan Kanev "] edition = "2018" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day08/src/main.rs ================================================ use std::fs::read_to_string; #[derive(Debug)] struct InputLine { patterns: Vec, output: Vec, } fn parse_input() -> Vec { read_to_string("../inputs/08") .unwrap() .lines() .map(|line| { let parts = line.split(" | ").collect::>(); let patterns = parts[0].split(" ").map(|s| s.to_string()).collect(); let output = parts[1].split(" ").map(|s| s.to_string()).collect(); InputLine { patterns, output } }) .collect() } fn bits(n: u8) -> u32 { n.count_ones() } fn bitset<'a>(number: &'a str) -> u8 { number .as_bytes() .iter() .map(|c| 1 << (c - b'a')) .fold(0, |a, b| a | b) } fn consume(patterns: &mut Vec, f: F) -> u8 where F: Fn(u8) -> bool, { patterns.swap_remove(patterns.iter().position(|n| f(*n)).unwrap()) } fn decrypt(line: &InputLine) -> usize { let mut left: Vec = line.patterns.iter().map(|str| bitset(str)).collect(); let mut m = [0_u8; 10]; m[1] = consume(&mut left, |p| bits(p) == 2); m[4] = consume(&mut left, |p| bits(p) == 4); m[7] = consume(&mut left, |p| bits(p) == 3); m[8] = consume(&mut left, |p| bits(p) == 7); m[3] = consume(&mut left, |p| bits(p) == 5 && m[7] & p == m[7]); m[6] = consume(&mut left, |p| bits(p) == 6 && m[1] & p != m[1]); m[2] = consume(&mut left, |p| bits(p) == 5 && m[8] & !m[6] & p != 0); m[5] = consume(&mut left, |p| bits(p) == 5); m[9] = consume(&mut left, |p| m[8] & !p & m[4] == 0); m[0] = consume(&mut left, |_| true); line.output .iter() .map(|number| bitset(number)) .map(|target| m.iter().position(|pattern| *pattern == target).unwrap()) .fold(0, |accumulator, digit| accumulator * 10 + digit) } fn main() { let first: usize = parse_input() .iter() .flat_map(|line| &line.output) .map(|seq| seq.len()) .filter(|&n| n != 5 && n != 6) .count(); let second: usize = parse_input().iter().map(|line| decrypt(line)).sum(); println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day09/Cargo.toml ================================================ [package] name = "day09" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day09/src/main.rs ================================================ use std::{collections::VecDeque, fs}; fn parse_input() -> Vec> { let text = fs::read_to_string("../inputs/09").unwrap(); let height = text.lines().count(); let width = text.lines().next().unwrap().len(); let mut result = vec![vec![9; width + 2]; height + 2]; for (i, line) in text.lines().enumerate() { for (j, byte) in line.bytes().enumerate() { result[i + 1][j + 1] = byte - b'0'; } } result } fn low_points(map: &Vec>) -> Vec<(usize, usize)> { let height = map.len(); let width = map[0].len(); let mut result = vec![]; for i in 1..(height - 2) { for j in 1..(width - 2) { if map[i][j] < map[i - 1][j] && map[i][j] < map[i + 1][j] && map[i][j] < map[i][j - 1] && map[i][j] < map[i][j + 1] { result.push((i, j)); } } } result } fn fill(map: &mut Vec>, point: (usize, usize)) -> usize { let mut left: VecDeque<(usize, usize)> = VecDeque::new(); let mut count = 0; left.push_back(point); while left.len() > 0 { let point = left.pop_front().unwrap(); if map[point.0][point.1] == 9 { continue; } map[point.0][point.1] = 9; count += 1; left.push_back((point.0 - 1, point.1)); left.push_back((point.0 + 1, point.1)); left.push_back((point.0, point.1 - 1)); left.push_back((point.0, point.1 + 1)); } count } fn main() { let mut map = parse_input(); let lows = low_points(&map); let first: usize = lows.iter().map(|&(x, y)| (map[x][y] as usize) + 1).sum(); let mut basins: Vec = vec![]; for point in lows { basins.push(fill(&mut map, point)); } basins.sort(); let second: usize = basins[basins.len() - 3..].iter().product(); println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day10/Cargo.toml ================================================ [package] name = "day10" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day10/src/main.rs ================================================ use std::fs; fn score(input: &str) -> (usize, usize) { let mut stack: Vec = vec![]; for char in input.chars() { match char { '(' | '{' | '[' | '<' => stack.push(char), next => match (stack.last().unwrap_or(&' '), next) { ('(', ')') | ('{', '}') | ('[', ']') | ('<', '>') => { stack.pop(); } (_, ')') => return (3, 0), (_, ']') => return (57, 0), (_, '}') => return (1197, 0), (_, '>') => return (25137, 0), _ => panic!(), }, } } let score = stack.iter().rev().fold(0, |score, char| { 5 * score + " ([{<".chars().position(|c| c == *char).unwrap() }); (0, score) } fn main() { let results: Vec<(usize, usize)> = fs::read_to_string("../inputs/10") .unwrap() .lines() .map(|line| score(line)) .collect(); let first: usize = results.iter().map(|s| s.0).sum(); let mut scores: Vec = results.iter().map(|s| s.1).filter(|&c| c != 0).collect(); scores.sort(); let second = scores[scores.len() / 2]; println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day11/Cargo.toml ================================================ [package] name = "day11" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day11/src/main.rs ================================================ use std::fs; type Board = Vec>; fn advance(board: &mut Board, h: usize, w: usize) -> usize { fn increment(board: &mut Board, i: usize, j: usize, h: usize, w: usize) { board[i][j] += 1; if board[i][j] != 10 { return; } for x in i.saturating_sub(1)..(i + 2).min(h) { for y in j.saturating_sub(1)..(j + 2).min(w) { increment(board, x, y, w, h); } } } for i in 0..h { for j in 0..w { increment(board, i, j, h, w) } } let mut flashes = 0; for cell in board .iter_mut() .flat_map(|line| line.iter_mut()) .filter(|c| **c >= 10) { *cell = 0; flashes += 1; } flashes } fn first(board: &Board, h: usize, w: usize) -> usize { let mut board: Board = board.clone(); let mut flashes = 0; for _ in 0..100 { flashes += advance(&mut board, h, w); } flashes } fn second(board: &Board, h: usize, w: usize) -> usize { let mut step = 0; let mut board = board.clone(); loop { step += 1; if advance(&mut board, h, w) == h * w { break; } } step } fn main() { let board: Board = fs::read_to_string("../inputs/11") .unwrap() .lines() .map(|line| line.bytes().map(|b| (b - b'0') as usize).collect()) .collect(); let h = board.len(); let w = board[0].len(); println!("first = {}", first(&board, h, w)); println!("second = {}", second(&board, h, w)); } ================================================ FILE: advent-of-code/2021/day12/Cargo.toml ================================================ [package] name = "day12" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day12/src/main.rs ================================================ use std::{collections::HashMap, fs}; type Graph<'a> = HashMap<&'a str, Vec<&'a str>>; fn is_small(cave: &str) -> bool { cave.chars().all(|c| c.is_ascii_lowercase()) } fn parse_input(text: &str) -> Graph { let mut graph: Graph = HashMap::new(); for line in text.lines() { let mut parts = line.split("-"); let from = parts.next().unwrap(); let to = parts.next().unwrap(); graph.entry(from).or_insert(vec![]).push(to); graph.entry(to).or_insert(vec![]).push(from); } graph } fn paths(graph: &Graph) -> (usize, usize) { let mut first: usize = 0; let mut second: usize = 0; let mut sofar: Vec<&str> = vec!["start"]; fn visit<'a>( graph: &Graph<'a>, sofar: &mut Vec<&'a str>, twiced: bool, first: &mut usize, second: &mut usize, ) { for cave in &graph[sofar.last().unwrap()] { let seen = is_small(cave) && sofar.contains(cave); if *cave == "start" || seen && twiced { continue; } else if *cave == "end" { if !twiced { *first += 1; } *second += 1; } else { sofar.push(cave); visit(graph, sofar, twiced || seen, first, second); sofar.pop(); } } } visit(graph, &mut sofar, false, &mut first, &mut second); (first, second) } fn main() { let text = fs::read_to_string("../inputs/12").unwrap(); let input = parse_input(&text); let (first, second) = paths(&input); println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day13/Cargo.toml ================================================ [package] name = "day13" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day13/src/main.rs ================================================ use std::{collections::HashSet, fs}; type Point = (usize, usize); type Fold = (char, usize); fn parse_input() -> (HashSet, Vec) { let text = fs::read_to_string("../inputs/13").unwrap(); let mut input = text.split("\n\n"); let points = input .next() .unwrap() .lines() .map(|line| { let mut parts = line.split(","); let x = parts.next().unwrap().parse().unwrap(); let y = parts.next().unwrap().parse().unwrap(); (x, y) }) .collect(); let folds = input .next() .unwrap() .lines() .map(|line| { let mut parts = line.split("="); let axis = parts.next().unwrap().chars().last().unwrap(); let coordinate = parts.next().unwrap().parse().unwrap(); (axis, coordinate) }) .collect(); (points, folds) } fn fold(points: HashSet, fold: Fold) -> HashSet { let (axis, point) = fold; points .iter() .map(|&(x, y)| { ( if axis == 'x' && x > point { 2 * point - x } else { x }, if axis == 'y' && y > point { 2 * point - y } else { y }, ) }) .collect() } fn draw(points: &HashSet) { let h = points.iter().map(|(_, b)| *b).max().unwrap(); let w = points.iter().map(|(a, _)| *a).max().unwrap(); for x in 0..=h { for y in 0..=w { if points.contains(&(y, x)) { print!("#") } else { print!(" ") } } println!("") } } fn main() { let (points, folds) = parse_input(); let first = fold(points.clone(), folds[0]).len(); println!("first = {}", first); let folded = folds.iter().fold(points, |p, &f| fold(p, f)); draw(&folded); } ================================================ FILE: advent-of-code/2021/day14/Cargo.toml ================================================ [package] name = "day14" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day14/src/main.rs ================================================ use std::{collections::HashMap, fs}; type Pair = (u8, u8); type RuleSet = HashMap; type Histogram = HashMap; fn expand(pairs: Histogram, rules: &RuleSet) -> Histogram { let mut result: HashMap = HashMap::new(); for (pair, count) in pairs { let middle = rules.get(&pair).unwrap(); let first = result.entry((pair.0, *middle)).or_insert(0); *first += count; let second = result.entry((*middle, pair.1)).or_insert(0); *second += count; } result } fn parse_input() -> (String, RuleSet) { let text = fs::read_to_string("../inputs/14").unwrap(); let mut parts = text.split("\n\n"); let polymer = parts.next().unwrap().to_string(); let rules = parts .next() .unwrap() .lines() .map(|line| { let chunks: Vec<&str> = line.split(" -> ").collect(); let a = chunks[0].as_bytes()[0]; let b = chunks[0].as_bytes()[1]; let c = chunks[1].as_bytes()[0]; ((a, b), c) }) .collect(); (polymer, rules) } fn histogram(polymer: &str) -> Histogram { let mut histogram = HashMap::new(); for window in polymer.as_bytes().windows(2) { let pair = (window[0], window[1]); let count = histogram.entry(pair).or_insert(0); *count += 1; } histogram } fn solve(polymer: &str, rules: &RuleSet, iterations: usize) -> usize { let mut pairs = histogram(&polymer); for _ in 0..iterations { pairs = expand(pairs, &rules); } let mut counts: HashMap = HashMap::new(); for (pair, count) in pairs { let sofar = counts.entry(pair.0).or_insert(0); *sofar += count; } let last = counts.entry(polymer.bytes().last().unwrap()).or_insert(0); *last += 1; let min = counts.values().min().map(|s| s.to_owned()).unwrap_or(0); let max = counts.values().max().map(|s| s.to_owned()).unwrap_or(0); max - min } fn main() { let (polymer, rules) = parse_input(); println!("first = {}", solve(&polymer, &rules, 10)); println!("second = {}", solve(&polymer, &rules, 40)); } ================================================ FILE: advent-of-code/2021/day15/Cargo.toml ================================================ [package] name = "day15" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day15/src/main.rs ================================================ use std::{ cmp::Reverse, collections::BinaryHeap, fs, }; fn parse_input() -> Vec> { fs::read_to_string("../inputs/15") .unwrap() .lines() .map(|line| { line.as_bytes() .iter() .map(|b| (b - b'0') as i64) .collect() }) .collect() } fn adjancent(x: usize, y: usize, h: usize, w: usize) -> Vec<(usize, usize)> { let mut result = vec![]; if x > 0 { result.push((x - 1, y)) } if x < h - 1 { result.push((x + 1, y)) } if y > 0 { result.push((x, y - 1)) } if y < w - 1 { result.push((x, y + 1)) } result } fn five_expand(grid: &Vec>) -> Vec> { let h = grid.len(); let w = grid[0].len(); let mut result = vec![vec![i64::MAX; w * 5]; h * 5]; for i in 0..(h * 5) { for j in 0..(w * 5) { let increment = i / h + j / w; let extra = grid[i % w][j % w] + increment as i64; result[i][j] = extra % 10 + extra / 10; } } result } fn lowest_risk(grid: &Vec>) -> i64 { let h = grid.len(); let w = grid[0].len(); let mut total: Vec> = vec![vec![i64::MAX; w]; h]; let mut left: BinaryHeap> = BinaryHeap::new(); left.push(Reverse((grid[h - 1][w - 1], h - 1, w - 1))); total[h - 1][w - 1] = grid[h - 1][w - 1]; while let Some(Reverse((d, x, y))) = left.pop() { for (i, j) in adjancent(x, y, h, w) { if i == 0 && j == 0 { return d } let risk = total[x][y] + grid[i][j]; if risk < total[i][j] { total[i][j] = risk; left.push(Reverse((risk, i, j))); } } } i64::MAX } fn main() { let first = parse_input(); let second = five_expand(&first); println!("first = {}", lowest_risk(&first)); println!("second = {}", lowest_risk(&second)); } ================================================ FILE: advent-of-code/2021/day16/Cargo.toml ================================================ [package] name = "day16" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day16/src/main.rs ================================================ // This is significantly more complicated than it needs to be, but I wanted to play a bit with Rust // and do the following: // // * Parse the input while streaming it, instead of loading it all, converting it to packets and // evaluating it afterwards. // * Evaluate each packet as early as possible (e.g. before the parent subpacket has finished // parsing). // * Have a single abstraction that can both add up the version numbers and evaluate the packets // * Convert the file to a stream of bits by massively abusing iterators and without creating a // custom struct that implements Iterator (hence the Boxing and the dyns). // * Alias all the numeric types I use so they can easily be changed (e.g. bits, versions, type // ids, literal values). // * Have a parse_number() function that is generic on its return type. // // This is very unnecessary and in places uncrustacean, but I did learn a bunch of stuff while // doing it. use std::fs::File; use std::io::Read; use std::ops::{Add, Shl}; type Bit = u8; type LiteralValue = u64; type Version = u8; type TypeId = u8; type Result = i64; #[derive(Debug)] enum Packet { Literal(Version, LiteralValue), Operator(Version, TypeId, Vec), } fn bits(char: u8) -> [Bit; 4] { let num = match char { (b'0'..=b'9') => char - b'0', (b'A'..=b'F') => char - b'A' + 10, _ => panic!(), }; let mut result = [0; 4]; for i in 0..4 { if num & (1 << i) != 0 { result[3 - i] = 1 } } result } fn read_number(stream: &mut I, size: usize) -> N where N: Shl + Add + From + Default, I: Iterator, { stream .take(size) .fold(N::default(), |a, b| (a << 1) + N::from(b)) } fn read_literal(stream: &mut I) -> LiteralValue where I: Iterator, { let mut number = 0; loop { let chunk: LiteralValue = read_number(stream, 5); number <<= 4; if chunk < 16 { number += chunk; break; } else { number += chunk - 16; } } number } fn read_packet(mut stream: &mut dyn Iterator, eval: fn(Packet) -> T) -> T { let version = read_number(&mut stream, 3); let type_id = read_number(&mut stream, 3); if type_id == 4 { eval(Packet::Literal(version, read_literal(&mut stream))) } else { let length_type_id: u8 = read_number(&mut stream, 1); let mut subpackets = vec![]; if length_type_id == 0 { let length = read_number(&mut stream, 15); let mut substream = stream.take(length).peekable(); while substream.peek() != None { subpackets.push(read_packet(&mut substream, eval)); } eval(Packet::Operator(version, type_id, subpackets)) } else { for _ in 0..read_number(&mut stream, 11) { subpackets.push(read_packet(&mut stream, eval)); } eval(Packet::Operator(version, type_id, subpackets)) } } } fn eval(packet: Packet) -> Result { match packet { Packet::Literal(_, val) => val as Result, Packet::Operator(_, code, vals) => match code { 0 => vals.iter().sum(), 1 => vals.iter().product(), 2 => vals.iter().min().unwrap().clone(), 3 => vals.iter().max().unwrap().clone(), 5 => (vals[0] > vals[1]) as Result, 6 => (vals[0] < vals[1]) as Result, 7 => (vals[0] == vals[1]) as Result, _ => panic!(), }, } } fn stream_input() -> impl Iterator { File::open("../inputs/16") .unwrap() .bytes() .map(|b| b.unwrap()) .take_while(|&b| b != b'\n') .flat_map(|b| bits(b)) } fn main() { let first: u64 = read_packet(&mut stream_input(), |packet| match packet { Packet::Literal(version, _) => version as u64, Packet::Operator(version, _, subpackets) => version as u64 + subpackets.iter().sum::(), }); let second = read_packet(&mut stream_input(), eval); println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day17/Cargo.toml ================================================ [package] name = "day17" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day17/src/main.rs ================================================ use std::fs; fn parse_input() -> (i64, i64, i64, i64) { let line = fs::read_to_string("../inputs/17").unwrap(); let mut chunks = line[15..line.len() - 1].split(", y="); let mut xs = chunks.next().unwrap().split(".."); let mut ys = chunks.next().unwrap().split(".."); let left = xs.next().unwrap().parse().unwrap(); let right = xs.next().unwrap().parse().unwrap(); let bottom = ys.next().unwrap().parse().unwrap(); let top = ys.next().unwrap().parse().unwrap(); (left, right, bottom, top) } fn main() { let (left, right, bottom, top) = parse_input(); let mut max_height = i64::MIN; let mut hits = 0; let from = (((left as f64) * 8.0 + 1.0).sqrt() / 2.0 - 0.5).floor() as i64; for dx in from..=right { for mut dy in bottom..=-bottom { let mut dx = dx; let mut x = 0; let mut y = 0; let peak = dy * (dy + 1) / 2; while y >= bottom && x <= right && (dx > 0 || left <= x) { if left <= x && x <= right && bottom <= y && y <= top { max_height = max_height.max(peak); hits += 1; break; } x += dx; y += dy; dx -= dx.signum(); dy -= 1; } } } println!("first = {}", max_height); println!("second = {}", hits); } ================================================ FILE: advent-of-code/2021/day18/Cargo.toml ================================================ [package] name = "day18" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day18/src/main.rs ================================================ use std::fs; #[derive(Debug, PartialEq, Clone, Copy)] enum Part { Open, Close, Comma, Number(u8), } use Part::*; type Snailfish = Vec; fn parse_number(text: &str) -> Snailfish { text.bytes() .map(|char| match char { b'[' => Open, b']' => Close, b',' => Comma, b'0'..=b'9' => Number(char - b'0'), _ => unreachable!(), }) .collect() } fn explode(snailfish: Snailfish) -> Snailfish { let mut result = vec![]; let mut depth = 0; let mut remaining = snailfish.into_iter(); while let Some(part) = remaining.next() { match part { Open => depth += 1, Close => depth -= 1, Number(first) if depth > 4 => { assert_eq!(remaining.next(), Some(Comma)); let second: u8; match remaining.next() { Some(Number(n)) => second = n, _ => unreachable!(), } assert_eq!(remaining.next(), Some(Close)); for previous in result.iter_mut().rev() { match previous { Number(val) => { *val += first; break; } _ => {} } } assert_eq!(result.pop(), Some(Open)); result.push(Number(0)); while let Some(part) = remaining.next() { if let Number(n) = part { result.push(Number(n + second)); break; } else { result.push(part); } } while let Some(part) = remaining.next() { result.push(part) } break; } _ => (), } result.push(part.clone()) } result } fn split(snailfish: Snailfish) -> Snailfish { let mut result = vec![]; let mut done = false; for part in snailfish { match part { Number(n) if n >= 10 && !done => { let a = n / 2; let b = n - a; result.push(Open); result.push(Number(a)); result.push(Comma); result.push(Number(b)); result.push(Close); done = true; } _ => result.push(part), } } result } fn reduce(snailfish: Snailfish) -> Snailfish { let mut previous; let mut result = snailfish; loop { previous = result.len(); result = explode(result); while result.len() != previous { previous = result.len(); result = explode(result); } result = split(result); if previous == result.len() { return result; } } } fn add(mut first: Snailfish, mut second: Snailfish) -> Snailfish { let mut result = vec![]; result.push(Open); result.append(&mut first); result.push(Comma); result.append(&mut second); result.push(Close); reduce(result) } fn magnitude(snailfish: &Snailfish) -> u64 { let mut stack: Vec = vec![]; for part in snailfish { match part { Open => stack.push(3), Close => { let a = stack.pop().unwrap(); let b = stack.pop().unwrap(); let c = stack.pop().unwrap(); stack.push(a * b + c); } Comma => { let a = stack.pop().unwrap(); let b = stack.pop().unwrap(); stack.push(a * b); stack.push(2); } Number(n) => stack.push(*n as u64), } } stack.pop().unwrap() } fn parse_input() -> Vec { fs::read_to_string("../inputs/18") .unwrap() .lines() .map(|s| parse_number(s)) .collect() } fn main() { let first = parse_input().into_iter().reduce(|a, b| add(a, b)).unwrap(); let first = magnitude(&first); let mut second = 0; let numbers = parse_input(); for a in numbers.iter() { for b in numbers.iter() { if a == b { continue; } let sum = add(a.clone(), b.clone()); second = second.max(magnitude(&sum)); } } println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day19/Cargo.toml ================================================ [package] name = "day19" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day19/src/main.rs ================================================ use std::{ collections::{HashSet, VecDeque}, fs, ops::{Mul, Sub}, }; type Number = i16; #[derive(Debug, Copy, Clone, PartialEq, Eq, Hash)] #[repr(transparent)] struct Matrix([[Number; 4]; 4]); #[derive(Debug, Copy, Clone, PartialEq, Eq, Hash)] #[repr(transparent)] struct Point([Number; 4]); struct Variation { rotation: Matrix, beacons: Vec, } struct Scanner { position: Option, beacons: Vec, variations: Vec, } type Beacons = Vec; impl Sub<&Point> for &Point { type Output = Point; fn sub(self, rhs: &Point) -> Self::Output { Point([ self.0[0] - rhs.0[0], self.0[1] - rhs.0[1], self.0[2] - rhs.0[2], 1, ]) } } impl Mul<&Matrix> for &Matrix { type Output = Matrix; fn mul(self, rhs: &Matrix) -> Self::Output { let mut result = Matrix([[0; 4]; 4]); for i in 0..4 { for j in 0..4 { for k in 0..4 { result.0[i][j] += self.0[i][k] * rhs.0[k][j]; } } } result } } impl Mul<&Point> for &Matrix { type Output = Point; fn mul(self, rhs: &Point) -> Self::Output { Point([ self.0[0][0] * rhs.0[0] + self.0[0][1] * rhs.0[1] + self.0[0][2] * rhs.0[2] + self.0[0][3], self.0[1][0] * rhs.0[0] + self.0[1][1] * rhs.0[1] + self.0[1][2] * rhs.0[2] + self.0[1][3], self.0[2][0] * rhs.0[0] + self.0[2][1] * rhs.0[1] + self.0[2][2] * rhs.0[2] + self.0[2][3], 1, ]) } } static ROTATE_X: Matrix = Matrix([[1, 0, 0, 0], [0, 0, -1, 0], [0, 1, 0, 0], [0, 0, 0, 1]]); static ROTATE_Y: Matrix = Matrix([[0, 0, 1, 0], [0, 1, 0, 0], [-1, 0, 0, 0], [0, 0, 0, 1]]); static ROTATE_Z: Matrix = Matrix([[0, -1, 0, 0], [1, 0, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]); static IDENTITY: Matrix = Matrix([[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]); static ORIGIN: Point = Point([0, 0, 0, 1]); impl Matrix { fn translate(point: Point) -> Matrix { Matrix([ [1, 0, 0, point.0[0]], [0, 1, 0, point.0[1]], [0, 0, 1, point.0[2]], [0, 0, 0, 1], ]) } fn rotations() -> Vec { let mut result = vec![]; let mut matrix = IDENTITY; for i in 0..6 { if i % 2 == 0 { matrix = &matrix * &ROTATE_X; } else { matrix = &matrix * &ROTATE_Y; } for _ in 0..4 { matrix = &matrix * &ROTATE_Z; result.push(matrix.clone()); } } result } } impl Point { fn new(x: Number, y: Number, z: Number) -> Point { Point([x, y, z, 1]) } fn manhattan(&self, other: &Point) -> Number { (self - other).0.iter().map(|n| n.abs()).sum::() - 1 } } fn parse_input() -> Vec { fs::read_to_string("../inputs/19") .unwrap() .split("\n\n") .map(|scanner| { scanner .lines() .into_iter() .skip(1) .map(|line| { let parts: Vec = line.split(",").map(|p| p.parse().unwrap()).collect(); Point::new(parts[0], parts[1], parts[2]) }) .collect() }) .collect() } fn overlap_transformation(first: &Scanner, second: &Scanner) -> Option { for origin in first.beacons.iter().skip(11) { for variation in second.variations.iter() { for other in variation.beacons.iter() { let translation = Matrix::translate(origin - other); let overlapping = variation .beacons .iter() .map(|p| &translation * p) .filter(|x| first.beacons.contains(x)) .count(); if overlapping >= 12 { return Some(&first.position.unwrap() * &(&translation * &variation.rotation)); } } } } None } fn prepare_scanners() -> Vec { let mut scanners: Vec = parse_input() .into_iter() .map(|beacons| Scanner { position: None, beacons, variations: vec![], }) .collect(); let rotations = Matrix::rotations(); for scanner in scanners.iter_mut() { for rotation in rotations.iter() { let beacons = scanner .beacons .iter() .map(|beacon| rotation * beacon) .collect(); scanner.variations.push(Variation { beacons, rotation: rotation.clone(), }); } } scanners } fn merge(scanners: &mut Vec) { scanners[0].position = Some(IDENTITY.clone()); let mut known: VecDeque = VecDeque::new(); known.push_back(0); while let Some(i) = known.pop_front() { let scanner = &scanners[i]; let mut found: Vec<(usize, Matrix)> = vec![]; for (i, unknown) in scanners.iter().enumerate().filter(|s| s.1.position == None) { if let Some(matrix) = overlap_transformation(scanner, unknown) { found.push((i, matrix)); } } for (i, position) in found { known.push_back(i); scanners[i].position = Some(position) } } assert!(scanners.iter().all(|s| s.position != None)) } fn main() { let mut scanners = prepare_scanners(); merge(&mut scanners); let beacons: HashSet = scanners .iter() .flat_map(|scanner| { scanner .beacons .iter() .map(|beacon| &scanner.position.unwrap() * beacon) }) .collect(); let beacon_count = beacons.len(); let scanner_positions: Vec = scanners .iter() .map(|s| &s.position.unwrap() * &ORIGIN) .collect(); let mut max_distance = 0; for x in scanner_positions.iter() { for y in scanner_positions.iter() { max_distance = max_distance.max(x.manhattan(y)); } } println!("first = {}", beacon_count); println!("second = {}", max_distance); } ================================================ FILE: advent-of-code/2021/day20/Cargo.toml ================================================ [package] name = "day20" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day20/src/main.rs ================================================ use std::{collections::HashSet, fs}; type Number = i32; type Point = (Number, Number); fn parse_input() -> (String, HashSet) { let input = fs::read_to_string("../inputs/20").unwrap(); let mut data = input.split("\n\n"); let decoder = data.next().unwrap().to_string(); let points: HashSet = data .next() .unwrap() .lines() .enumerate() .flat_map(|(x, line)| { line.bytes() .enumerate() .filter(|(_, c)| *c == b'#') .map(move |(y, _)| (x as Number, y as Number)) }) .collect(); (decoder, points) } fn iterate(points: &HashSet, decoder: &String, mode: bool) -> HashSet { let mut result = HashSet::new(); let deltas = [ (-1, -1), (-1, 0), (-1, 1), (0, -1), (0, 0), (0, 1), (1, -1), (1, 0), (1, 1), ]; let min_x = points.iter().map(|p| p.0).min().unwrap_or(0); let max_x = points.iter().map(|p| p.0).max().unwrap_or(0); let min_y = points.iter().map(|p| p.1).min().unwrap_or(0); let max_y = points.iter().map(|p| p.1).max().unwrap_or(0); for x in (min_x - 5)..=(max_x + 5) { for y in (min_y - 5)..=(max_y + 5) { let index = deltas .iter() .map(|(dx, dy)| { if points.contains(&(x + dx, y + dy)) == mode { 1usize } else { 0usize } }) .fold(0, |a, b| (a << 1) + b); if (decoder.as_bytes()[index] == b'#') != mode { result.insert((x, y)); } } } result } fn main() { let (decoder, points) = parse_input(); let mut points = points; points = iterate(&points, &decoder, true); points = iterate(&points, &decoder, false); let first = points.len(); for i in 0..48 { points = iterate(&points, &decoder, i % 2 == 0); } let second = points.len(); println!("first = {}", first); println!("second = {}", second); } ================================================ FILE: advent-of-code/2021/day21/Cargo.toml ================================================ [package] name = "day21" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day21/src/main.rs ================================================ use std::{collections::HashMap, fs}; #[derive(Copy, Clone, PartialEq, Eq, Hash)] struct Game { positions: [u16; 2], scores: [u16; 2], turn: usize, } impl Game { fn from(positions: (u16, u16)) -> Game { Game { positions: [positions.0, positions.1], scores: [0, 0], turn: 0, } } fn is_finished(&self, winning_score: u16) -> bool { self.scores.iter().any(|score| *score >= winning_score) } fn leader(&self) -> usize { if self.scores[0] > self.scores[1] { 0 } else { 1 } } fn play(&self, roll: u16) -> Game { let new = increment_position(self.positions[self.turn], roll); let mut scores = self.scores.clone(); let mut positions = self.positions.clone(); positions[self.turn] = new; scores[self.turn] += new; Game { positions, scores, turn: 1 - self.turn, } } } fn parse_input() -> (u16, u16) { let numbers: Vec = fs::read_to_string("../inputs/21") .unwrap() .lines() .map(|line| line.split(": ").nth(1).unwrap().parse().unwrap()) .collect(); (numbers[0], numbers[1]) } fn increment_position(position: u16, count: u16) -> u16 { (position + count - 1) % 10 + 1 } fn first(positions: (u16, u16)) -> u64 { let mut game = Game::from(positions); let mut die = (1..=100).cycle().enumerate(); while !game.is_finished(1000) { let mut roll = 0; roll += die.next().unwrap().1; roll += die.next().unwrap().1; roll += die.next().unwrap().1; game = game.play(roll); } let winner = game.leader(); let rolls = die.next().unwrap().0 as u64; (game.scores[1 - winner] as u64) * rolls } fn second(positions: (u16, u16)) -> u64 { let mut unfinished: HashMap = HashMap::new(); let mut finished: HashMap = HashMap::new(); let dirac = [(3, 1), (4, 3), (5, 6), (6, 7), (7, 6), (8, 3), (9, 1)]; unfinished.insert(Game::from(positions), 1); while unfinished.len() != 0 { let mut next = HashMap::new(); for (game, count) in unfinished { for (roll, times) in dirac { let result = game.play(roll); if result.is_finished(21) { *finished.entry(result).or_insert(0) += times * count; } else { *next.entry(result).or_insert(0) += times * count; } } } unfinished = next; } let mut wins: [u64; 2] = [0, 0]; for (game, count) in finished { wins[game.leader()] += count; } wins.into_iter().max().unwrap() } fn main() { let input = parse_input(); println!("first = {}", first(input)); println!("second = {}", second(input)); } ================================================ FILE: advent-of-code/2021/day22/Cargo.toml ================================================ [package] name = "day22" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day22/src/main.rs ================================================ use std::fs; type Num = i64; #[derive(Copy, Clone)] struct Interval { from: Num, to: Num, } impl Interval { fn new(from: Num, to: Num) -> Interval { Interval { from, to: from.max(to), } } fn truncate(&self, other: &Interval) -> Interval { Interval::new(self.from.max(other.from), self.to.min(other.to)) } fn overlaps(&self, other: &Interval) -> bool { self.from < other.to && other.from < self.to } fn len(&self) -> Num { self.to - self.from } fn split(a: &Interval, b: &Interval) -> [Interval; 3] { let mut points = vec![a.from, a.to, b.from, b.to]; points.sort(); [ Interval::new(points[0], points[1]), Interval::new(points[1], points[2]), Interval::new(points[2], points[3]), ] } } #[derive(Copy, Clone)] struct Cuboid { x: Interval, y: Interval, z: Interval, } impl Cuboid { fn truncate(&self, interval: Interval) -> Cuboid { Cuboid { x: self.x.truncate(&interval), y: self.y.truncate(&interval), z: self.z.truncate(&interval), } } fn overlaps(&self, other: &Cuboid) -> bool { self.x.overlaps(&other.x) && self.y.overlaps(&other.y) && self.z.overlaps(&other.z) } fn subtract(&self, other: &Cuboid) -> Vec { if !self.overlaps(other) { return vec![self.clone()]; } let mut result = vec![]; for x in Interval::split(&self.x, &other.x) { for y in Interval::split(&self.y, &other.y) { for z in Interval::split(&self.z, &other.z) { let cuboid = Cuboid { x, y, z }; if self.overlaps(&cuboid) && !other.overlaps(&cuboid) { result.push(cuboid) } } } } result } fn volume(&self) -> Num { self.x.len() * self.y.len() * self.z.len() } } fn parse_input() -> Vec<(Cuboid, bool)> { fs::read_to_string("../inputs/22") .unwrap() .lines() .map(|line| { let chunks: Vec<&str> = line.split(" ").collect(); let on = chunks[0] == "on"; let intervals: Vec = chunks[1] .split(",") .map(|part| part.split("=").nth(1).unwrap()) .map(|range| { let numbers: Vec = range.split("..").map(|n| n.parse().unwrap()).collect(); Interval { from: numbers[0], to: numbers[1] + 1, } }) .collect(); let cuboid = Cuboid { x: intervals[0], y: intervals[1], z: intervals[2], }; (cuboid, on) }) .collect() } fn solve(input: Vec<(Cuboid, bool)>) -> Num { let mut cuboids: Vec = vec![]; for (cuboid, on) in input { cuboids = cuboids .into_iter() .flat_map(|c| c.subtract(&cuboid)) .collect(); if on { cuboids.push(cuboid) } } cuboids.into_iter().map(|c| c.volume()).sum::() } fn main() { let input = parse_input(); let first_input = input .iter() .map(|(cuboid, on)| (cuboid.truncate(Interval::new(-50, 50)), *on)) .collect::>(); println!("first = {}", solve(first_input)); println!("second = {}", solve(input)); } ================================================ FILE: advent-of-code/2021/day23/Cargo.toml ================================================ [package] name = "day23" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day23/src/main.rs ================================================ use std::cmp::Reverse; use std::collections::{BinaryHeap, HashMap}; use std::fs; type Cost = i32; type Point = (usize, usize); #[derive(Clone, PartialEq, Eq, Hash, PartialOrd, Ord)] struct Game { maze: Vec>, } fn is_amphipod(char: u8) -> bool { b'A' <= char && char <= b'D' } fn is_empty(char: u8) -> bool { char == b'.' } fn is_room(point: Point) -> bool { point.0 > 1 } fn is_hallway(point: Point) -> bool { point.0 == 1 } fn cost(from: Point, to: Point, char: u8) -> Cost { ((from.0 as Cost - to.0 as Cost).abs() + (from.1 as Cost - to.1 as Cost).abs()) * weight(char) } fn weight(char: u8) -> Cost { match char { b'A' => 1, b'B' => 10, b'C' => 100, b'D' => 1000, _ => unreachable!(), } } fn dedicated_room(char: u8) -> usize { match char { b'A' => 3, b'B' => 5, b'C' => 7, b'D' => 9, _ => unreachable!(), } } fn is_entrance(y: usize) -> bool { y == 3 || y == 5 || y == 7 || y == 9 } impl Game { fn all_moves(&self) -> Vec<(Game, Cost)> { let mut result = vec![]; for (x, line) in self.maze.iter().enumerate() { for (y, &char) in line.iter().enumerate() { let from = (x, y); if !is_amphipod(char) { continue; } for to in self.possible_moves(from) { result.push((self.walk(from, to), cost(from, to, char))); } } } result } fn possible_moves(&self, point: Point) -> Vec { let mut result = vec![]; if is_room(point) && !self.should_stay(point) && self.can_exit(point) { (1..point.1) .rev() .filter(|&y| !is_entrance(y)) .take_while(|&y| self.maze[1][y] == b'.') .for_each(|y| result.push((1, y))); (point.1..=11) .filter(|&y| !is_entrance(y)) .take_while(|&y| self.maze[1][y] == b'.') .for_each(|y| result.push((1, y))); } else if is_hallway(point) { let char = *self.at(point); let y = dedicated_room(char); if let Some(x) = self.room_slot(char) { if self.can_cross(point.1, y) { result.push((x, y)) } } } result } fn at(&self, point: Point) -> &u8 { &self.maze[point.0][point.1] } fn at_mut(&mut self, point: Point) -> &mut u8 { &mut self.maze[point.0][point.1] } fn room_slot(&self, char: u8) -> Option { let y = dedicated_room(char); if !(2..=self.depth()) .map(|x| *self.at((x, y))) .all(|c| c == b'.' || c == char) { return None; } (2..=self.depth()) .take_while(|&x| *self.at((x, y)) == b'.') .last() } fn can_cross(&self, from: usize, to: usize) -> bool { if from < to { (from + 1..=to).all(|y| is_empty(*self.at((1, y)))) } else { (to..from).all(|y| is_empty(*self.at((1, y)))) } } fn depth(&self) -> usize { self.maze.len() - 2 } fn walk(&self, from: Point, to: Point) -> Game { let mut new = Game { maze: self.maze.clone(), }; *new.at_mut(to) = *self.at(from); *new.at_mut(from) = b'.'; new } fn should_stay(&self, point: Point) -> bool { let char = *self.at(point); let y = dedicated_room(char); point.1 == y && (point.0..=self.depth()).all(|x| *self.at((x, y)) == char) } fn can_exit(&self, point: Point) -> bool { (2..point.0).all(|x| self.maze[x][point.1] == b'.') } fn is_solved(&self) -> bool { (b'A'..=b'D').all(|char| { let y = dedicated_room(char); (2..=self.depth()).all(|x| *self.at((x, y)) == char) }) } } fn parse_input() -> Game { let maze = fs::read_to_string("../inputs/23") .unwrap() .lines() .into_iter() .map(|line| line.bytes().collect()) .collect(); Game { maze } } fn solve(game: Game) -> Cost { let mut heap: BinaryHeap> = BinaryHeap::new(); let mut costs: HashMap = HashMap::new(); costs.insert(game.clone(), 0); heap.push(Reverse((0, game))); while let Some(Reverse((cost, game))) = heap.pop() { let moves = game.all_moves(); if game.is_solved() { return cost; } else { for (new, delta) in moves { let incremental = cost + delta; let previous = *costs.get(&new).unwrap_or(&Cost::MAX); if incremental < previous { costs.insert(new.clone(), incremental); heap.push(Reverse((incremental, new.clone()))); } } } } -1 } fn unfold(game: &Game) -> Game { let mut maze: Vec> = vec![]; for line in &game.maze[0..=2] { maze.push(line.clone()); } maze.push(" #D#C#B#A#".bytes().collect()); maze.push(" #D#B#A#C#".bytes().collect()); for line in &game.maze[3..=4] { maze.push(line.clone()); } Game { maze } } fn main() { let game = parse_input(); let unfolded = unfold(&game); println!("first = {}", solve(game)); println!("second = {}", solve(unfolded)); } ================================================ FILE: advent-of-code/2021/day24/Cargo.toml ================================================ [package] name = "day24" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day24/src/main.rs ================================================ use std::fs; type Num = i32; fn main() { let digits = [1, 2, 3, 4, 5, 6, 7, 8, 9]; let fns: Vec<(Num, Num, Num)> = fs::read_to_string("../inputs/24") .unwrap() .lines() .map(|line| line.split(" ").nth(2).unwrap_or("")) .collect::>() .chunks(18) .map(|block| (block[4].parse().unwrap(), block[5].parse().unwrap(), block[15].parse().unwrap())) .collect(); let mut stack: Vec<(usize, Num)> = vec![]; let mut pattern: Vec> = vec![vec![]; 14]; for (i, (a, b, c)) in fns.into_iter().enumerate() { if a == 1 { stack.push((i, c)); } else { let (dep, other) = stack.pop().unwrap(); for (x, y) in digits.iter().flat_map(|&x| digits.map(|y| (x, y))).filter(|&(x, y)| x == other + y + b) { pattern[i].push(x); pattern[dep].push(y); } } } println!("first = {}", pattern.iter().map(|p| p.iter().last().unwrap().to_string()).collect::>().join("")); println!("second = {}", pattern.iter().map(|p| p.iter().nth(0).unwrap().to_string()).collect::>().join("")); } ================================================ FILE: advent-of-code/2021/day25/Cargo.toml ================================================ [package] name = "day25" version = "0.1.0" edition = "2021" # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] ================================================ FILE: advent-of-code/2021/day25/src/main.rs ================================================ use std::fs; fn main() { let mut map: Vec> = fs::read_to_string("../inputs/25") .unwrap() .lines() .map(|line| line.bytes().collect()) .collect(); let mut steps = 0; let h = map.len(); let w = map[0].len(); loop { steps += 1; let mut horizontal = vec![]; for x in 0..h { for y in 0..w { let adjancent = (y + 1) % w; if map[x][y] == b'>' && map[x][adjancent] == b'.' { horizontal.push((x, y, adjancent)); } } } for &(x, y, a) in &horizontal { map[x][y] = b'.'; map[x][a] = b'>'; } let mut vertical = vec![]; for x in 0..h { for y in 0..w { let adjancent = (x + 1) % h; if map[x][y] == b'v' && map[adjancent][y] == b'.' { vertical.push((x, y, adjancent)); } } } for &(x, y, a) in &vertical { map[x][y] = b'.'; map[a][y] = b'v'; } if vertical.is_empty() && horizontal.is_empty() { break; } } println!("final = {}", steps); } ================================================ FILE: advent-of-code/2021/inputs/01 ================================================ 103 106 107 110 121 132 147 148 144 141 147 149 156 152 155 156 157 145 144 145 147 153 155 175 170 173 171 205 208 216 219 222 223 226 217 233 235 237 238 239 247 257 262 280 284 285 287 288 290 298 313 318 299 312 311 315 313 306 289 292 297 300 301 334 337 338 339 349 350 351 373 379 383 385 412 419 425 421 418 420 418 428 438 446 448 451 453 462 476 480 479 487 497 505 529 531 533 540 537 534 545 546 549 550 557 562 570 580 586 606 610 611 609 612 623 643 663 687 686 693 694 700 701 707 709 723 724 731 770 775 787 788 805 819 828 829 835 836 833 834 837 839 879 881 887 891 908 909 908 929 930 939 940 934 895 898 903 904 908 912 918 920 921 951 946 958 962 964 965 969 970 978 982 986 988 989 985 986 1007 1014 1012 1006 1007 1009 1029 1031 1026 1034 1053 1054 1064 1085 1092 1090 1092 1102 1106 1125 1137 1149 1148 1155 1171 1173 1152 1147 1152 1159 1163 1147 1153 1154 1176 1188 1201 1173 1177 1178 1185 1202 1209 1211 1215 1240 1212 1209 1213 1212 1222 1223 1224 1251 1271 1277 1284 1286 1287 1290 1297 1298 1292 1293 1295 1294 1302 1298 1286 1291 1292 1294 1295 1308 1309 1307 1308 1320 1349 1350 1354 1363 1352 1353 1354 1360 1361 1357 1366 1367 1368 1369 1375 1376 1383 1381 1382 1383 1384 1394 1395 1404 1405 1419 1421 1433 1450 1443 1445 1460 1474 1470 1472 1475 1485 1490 1489 1490 1491 1495 1496 1501 1536 1538 1539 1549 1576 1578 1583 1609 1612 1613 1614 1607 1608 1609 1602 1614 1616 1630 1648 1650 1653 1654 1666 1668 1676 1683 1709 1711 1712 1713 1712 1716 1717 1718 1717 1718 1720 1723 1726 1732 1722 1720 1732 1746 1758 1765 1769 1774 1790 1791 1792 1807 1815 1831 1832 1856 1857 1861 1858 1834 1817 1837 1851 1850 1861 1862 1860 1859 1873 1874 1876 1877 1887 1889 1915 1920 1922 1925 1924 1933 1934 1935 1936 1945 1946 1945 1949 1953 1960 1959 1966 1970 1977 1989 1992 2009 2028 2040 2039 2037 2040 2044 2081 2085 2082 2087 2088 2098 2119 2127 2143 2124 2125 2127 2137 2170 2172 2173 2174 2175 2179 2174 2176 2177 2178 2193 2194 2195 2198 2195 2198 2199 2191 2193 2205 2221 2222 2195 2196 2206 2211 2219 2220 2221 2224 2219 2200 2220 2225 2224 2225 2226 2237 2238 2253 2255 2268 2274 2294 2295 2298 2321 2323 2304 2315 2313 2309 2308 2310 2329 2333 2340 2337 2336 2335 2345 2346 2358 2365 2366 2365 2369 2368 2361 2362 2387 2378 2384 2393 2392 2393 2376 2404 2423 2419 2422 2425 2427 2428 2433 2438 2435 2445 2451 2459 2461 2462 2463 2458 2461 2469 2470 2505 2532 2533 2534 2537 2538 2539 2541 2532 2531 2545 2546 2554 2571 2578 2569 2585 2596 2602 2600 2601 2602 2611 2613 2615 2618 2614 2621 2623 2627 2650 2660 2665 2666 2667 2672 2687 2664 2656 2654 2656 2649 2669 2672 2676 2677 2673 2674 2680 2682 2683 2690 2691 2692 2679 2686 2687 2705 2697 2698 2708 2727 2724 2731 2737 2739 2743 2749 2728 2734 2738 2735 2746 2749 2750 2751 2754 2762 2782 2789 2797 2814 2822 2843 2844 2847 2854 2855 2864 2877 2878 2879 2883 2884 2908 2909 2941 2943 2941 2928 2929 2951 2953 2960 2964 2967 2968 2995 3004 3024 3031 3066 3067 3077 3099 3102 3103 3106 3107 3115 3122 3123 3124 3131 3135 3136 3138 3139 3140 3156 3158 3159 3162 3171 3172 3177 3178 3184 3193 3203 3212 3211 3213 3223 3240 3241 3246 3262 3261 3266 3268 3285 3286 3307 3312 3316 3322 3323 3314 3321 3328 3327 3328 3342 3360 3367 3369 3368 3374 3376 3366 3372 3378 3382 3397 3401 3404 3406 3388 3393 3396 3422 3420 3431 3432 3430 3444 3446 3465 3469 3486 3490 3487 3506 3502 3503 3509 3518 3489 3499 3500 3499 3508 3517 3524 3525 3542 3563 3565 3570 3571 3574 3584 3587 3588 3589 3574 3589 3623 3631 3638 3640 3647 3662 3663 3664 3665 3683 3703 3721 3731 3735 3738 3735 3723 3731 3732 3740 3746 3756 3758 3764 3767 3775 3777 3779 3795 3796 3794 3796 3797 3809 3794 3795 3804 3826 3828 3839 3841 3832 3869 3860 3869 3868 3883 3901 3909 3910 3919 3924 3934 3962 3968 3973 3988 4005 3989 3992 4002 4003 3994 3996 4004 4012 3992 3999 4031 4034 4043 4046 4053 4057 4061 4065 4068 4084 4087 4092 4093 4095 4103 4113 4114 4122 4120 4125 4118 4126 4131 4140 4161 4162 4163 4177 4184 4193 4194 4195 4200 4202 4200 4201 4202 4199 4223 4230 4232 4233 4234 4226 4233 4235 4236 4237 4245 4260 4268 4292 4294 4273 4275 4276 4270 4278 4279 4293 4306 4330 4337 4343 4342 4349 4355 4377 4378 4379 4380 4384 4388 4394 4395 4396 4401 4405 4410 4408 4405 4410 4411 4412 4414 4421 4425 4428 4440 4424 4428 4436 4439 4440 4441 4444 4445 4446 4447 4448 4458 4460 4461 4457 4467 4478 4471 4484 4485 4486 4490 4492 4497 4501 4515 4517 4518 4517 4522 4523 4526 4542 4543 4533 4534 4537 4536 4544 4547 4548 4557 4559 4560 4565 4567 4572 4568 4570 4575 4579 4580 4578 4602 4593 4581 4595 4601 4641 4658 4659 4661 4663 4660 4661 4665 4668 4683 4694 4710 4712 4726 4730 4732 4733 4738 4762 4769 4767 4768 4781 4783 4796 4807 4809 4819 4816 4821 4823 4830 4833 4840 4849 4851 4856 4857 4855 4857 4862 4865 4864 4877 4888 4900 4910 4928 4933 4941 4942 4953 4967 4942 4947 4946 4949 4956 4958 4974 4976 4985 4984 5001 5026 5027 5029 5030 5031 5045 5050 5051 5059 5065 5078 5079 5098 5099 5100 5104 5109 5098 5120 5146 5147 5149 5144 5161 5163 5164 5178 5195 5194 5215 5220 5224 5232 5233 5235 5240 5226 5230 5249 5251 5246 5247 5256 5265 5272 5276 5278 5277 5293 5296 5297 5300 5293 5327 5329 5364 5369 5370 5371 5380 5384 5385 5395 5403 5405 5408 5411 5415 5411 5413 5414 5415 5416 5417 5441 5439 5443 5450 5458 5459 5463 5468 5467 5501 5502 5512 5501 5502 5514 5515 5523 5525 5527 5528 5545 5546 5547 5555 5556 5563 5589 5590 5599 5612 5602 5611 5621 5622 5619 5629 5630 5639 5635 5642 5647 5633 5643 5644 5650 5651 5652 5654 5657 5687 5688 5690 5691 5697 5717 5719 5734 5741 5739 5738 5739 5764 5765 5766 5777 5779 5784 5785 5797 5791 5800 5816 5815 5808 5810 5786 5768 5784 5785 5803 5806 5795 5805 5809 5821 5835 5860 5871 5878 5879 5880 5899 5901 5900 5904 5905 5900 5902 5873 5876 5881 5882 5891 5894 5896 5898 5916 5917 5920 5926 5935 5936 5937 5938 5939 5949 5979 5982 5984 5997 6010 6012 6015 6016 6022 6024 6032 6041 6038 6046 6050 6062 6063 6092 6093 6080 6084 6093 6104 6114 6117 6115 6134 6122 6123 6126 6127 6130 6128 6130 6127 6142 6144 6150 6152 6153 6152 6154 6160 6163 6166 6156 6163 6181 6198 6202 6211 6212 6211 6220 6216 6228 6230 6233 6232 6243 6261 6257 6263 6265 6278 6259 6274 6280 6272 6262 6264 6286 6280 6292 6296 6297 6306 6307 6312 6313 6323 6324 6334 6335 6344 6345 6342 6338 6349 6357 6359 6391 6393 6396 6400 6402 6398 6400 6404 6414 6426 6447 6449 6447 6448 6453 6460 6464 6466 6471 6470 6471 6496 6512 6513 6524 6516 6519 6522 6500 6510 6512 6515 6535 6536 6537 6546 6547 6550 6556 6557 6550 6549 6531 6533 6532 6533 6532 6541 6543 6535 6545 6550 6559 6583 6584 6583 6585 6593 6596 6600 6603 6605 6614 6615 6616 6618 6639 6641 6652 6653 6681 6696 6709 6703 6706 6707 6697 6695 6706 6699 6704 6705 6721 6723 6729 6742 6744 6747 6748 6750 6751 6752 6747 6750 6752 6755 6756 6758 6760 6774 6798 6800 6802 6806 6783 6798 6800 6823 6848 6855 6858 6856 6857 6858 6872 6873 6874 6875 6879 6884 6890 6891 6889 6892 6883 6884 6893 6905 6897 6902 6904 6909 6914 6916 6905 6907 6908 6910 6894 6918 6919 6932 6946 6922 6943 6944 6943 6946 6963 6972 6977 6978 6982 6984 6992 7001 6993 7007 7001 7011 7015 7017 7018 7019 7021 7028 7029 7057 7065 7066 7065 7078 7089 7090 7092 7093 7094 7095 7098 7100 7122 7126 7130 7125 7132 7131 7132 7114 7115 7118 7119 7132 7134 7156 7161 7163 7164 7165 7172 7186 7189 7192 7193 7191 7192 7195 7203 7205 7212 7214 7217 7222 7223 7224 7225 7227 7264 7268 7289 7290 7299 7300 7305 7306 7307 7313 7328 7318 7323 7332 7335 7355 7360 7384 7387 7389 7395 7403 7405 7427 7448 7446 7448 7447 7446 7460 7464 7465 7469 7470 7477 7480 7479 7483 7488 7475 7482 7474 7475 7476 7486 7489 7487 7490 7492 7512 7515 7514 7518 7526 7535 7536 7535 7549 7551 7552 7554 7556 7541 7536 7545 7550 7559 7554 7555 7562 7568 7566 7582 7583 7584 7598 7618 7619 7628 7629 7633 7634 7636 7635 7633 7636 7635 7637 7639 7630 7631 7637 7649 7650 7651 7661 7656 7652 7654 7659 7674 7681 7679 7680 7696 7708 7709 7719 7721 7728 7729 7722 7749 7754 7757 7758 7760 7761 7764 7762 7766 7765 7766 7763 7764 7767 7786 7790 7797 7817 7816 7823 7822 7826 7843 7844 7856 7857 7858 7878 7880 7889 7890 7891 7932 7934 7949 7956 7957 7958 7962 7960 7961 7962 7964 7968 7978 7991 7997 8015 8018 8019 8029 8032 8026 8029 8030 8033 8044 8046 8044 8063 8068 8070 8073 8074 8077 8080 8081 8083 8084 8118 8116 8129 8131 8138 8128 8106 8120 8124 8155 8158 8166 8167 8168 8167 8166 8159 8162 8163 8166 8180 8159 8174 8182 8185 8183 8206 8209 8212 8213 8214 8237 8239 8240 8243 8249 8258 8259 8260 8271 8275 8277 8286 8295 8299 8304 8305 8307 8319 8292 8299 8302 8320 8321 8327 8336 8337 8355 8371 8388 8389 8394 8393 8395 8386 8403 8408 8409 8429 8437 8455 8456 8457 8481 8485 8486 8487 8489 8495 8509 8514 8518 8554 8555 8560 8561 8568 8569 8575 8578 8579 8580 8585 8586 8587 8599 8600 8610 8611 8612 8639 8640 8645 8648 8649 8658 8666 8667 8672 8674 8672 8675 8677 8682 8684 8686 8694 8696 8697 8705 8679 8680 8684 8685 8686 8692 8693 8694 8695 8715 8720 8731 8732 8735 8734 8738 8756 8768 8769 8773 8778 8780 8763 8789 8788 8800 8799 8804 8810 8814 8813 8817 8820 8823 8827 8829 8839 8840 8843 8845 8846 8865 8868 8874 8870 8875 8876 8877 8878 8904 8905 8907 8908 8909 8923 8925 8931 8932 8936 8930 8936 8937 8954 8986 8994 9011 9016 9021 9027 9035 9048 9057 9071 9072 9076 9090 9095 9096 9115 9117 9136 9138 9135 9143 9145 9146 9147 9149 9147 9148 9152 9153 9166 9175 9182 9185 9186 9190 9191 9183 9158 9161 9167 9168 9169 9177 9178 9185 9188 9190 9197 9200 9204 9205 9206 9207 9224 9225 9235 9254 9258 9259 9266 9282 9283 9284 9286 9285 9284 9281 9284 9285 9286 9288 9293 9294 9310 9321 9356 9338 9347 9370 9380 9370 9371 9372 9371 9374 9375 9382 9386 9391 9393 9394 9395 9396 9403 9404 9409 9408 9412 9413 9411 9420 9430 9435 9448 9450 9451 9455 9444 9445 9470 9472 9479 9488 9489 9482 9488 9496 9502 9503 9506 9508 9524 9519 9524 9528 9529 9531 9532 9538 9548 ================================================ FILE: advent-of-code/2021/inputs/02 ================================================ forward 8 forward 3 down 8 down 2 up 1 up 4 down 9 forward 3 forward 4 forward 5 forward 1 forward 1 up 8 forward 2 forward 9 down 2 forward 8 down 5 down 3 down 8 up 1 forward 1 down 8 up 7 down 8 down 9 down 4 down 7 forward 7 forward 9 down 2 down 5 forward 1 down 1 forward 2 up 8 down 8 forward 2 up 5 down 6 down 5 down 2 forward 5 forward 4 forward 6 down 4 up 1 down 8 down 7 down 3 down 4 down 5 forward 7 down 3 down 3 forward 3 down 2 up 8 up 8 forward 2 down 8 down 8 forward 3 forward 9 forward 3 forward 2 down 9 down 3 forward 4 forward 1 down 7 forward 5 up 2 down 6 up 4 down 2 up 5 forward 6 down 6 down 1 forward 5 forward 4 up 8 up 5 forward 2 down 5 down 4 up 1 forward 9 up 5 up 5 forward 3 down 6 forward 7 down 2 forward 1 forward 4 forward 4 down 2 down 6 down 3 down 1 forward 1 down 8 forward 2 down 1 down 2 forward 6 forward 1 forward 7 forward 2 down 2 up 6 up 2 forward 7 down 6 down 1 forward 5 forward 3 forward 1 down 3 up 1 forward 3 forward 1 down 2 down 5 up 8 down 8 forward 3 down 9 forward 8 down 8 down 5 forward 2 up 1 down 3 up 3 down 5 down 7 down 8 down 8 down 1 forward 9 up 4 up 4 down 5 forward 6 forward 1 up 6 forward 5 up 6 forward 1 forward 9 down 3 down 8 forward 6 forward 6 up 1 down 6 forward 2 down 7 down 2 forward 4 up 4 up 2 forward 8 up 6 down 8 up 3 down 5 down 3 forward 3 down 8 up 4 up 5 down 1 down 7 down 7 forward 6 up 6 down 1 forward 7 down 2 up 7 up 3 forward 9 down 3 up 4 up 1 forward 8 down 4 forward 9 forward 8 down 4 down 3 down 1 forward 8 up 7 down 3 up 5 down 3 down 9 down 9 up 9 down 9 up 4 down 5 down 5 forward 8 forward 1 up 3 down 9 down 8 forward 2 forward 1 up 6 down 3 forward 1 up 6 forward 9 forward 3 forward 3 down 2 down 7 forward 1 up 9 up 3 forward 1 forward 2 forward 7 forward 8 forward 2 forward 3 forward 1 forward 7 down 1 up 7 up 3 forward 3 forward 9 down 7 down 3 forward 2 forward 8 up 1 forward 2 forward 3 up 2 down 1 down 9 down 4 up 3 forward 3 down 6 down 1 forward 2 down 8 forward 3 forward 9 forward 1 forward 6 forward 5 down 5 forward 2 up 7 up 7 down 8 forward 9 up 1 up 5 up 8 forward 5 forward 2 down 5 up 5 down 3 forward 6 down 9 down 7 forward 2 forward 8 forward 3 down 7 down 8 forward 9 down 3 down 3 forward 1 forward 4 down 2 forward 1 forward 3 forward 5 down 9 up 3 down 5 forward 8 forward 3 down 5 forward 3 forward 7 down 3 forward 8 down 1 down 3 down 4 down 2 forward 8 down 2 forward 5 down 2 up 2 forward 8 forward 9 forward 3 forward 2 forward 3 down 2 forward 5 down 1 down 9 up 1 down 6 forward 2 up 1 forward 6 down 2 forward 2 forward 1 forward 4 forward 4 forward 9 forward 2 down 5 forward 9 forward 1 forward 7 forward 1 down 7 forward 7 down 4 down 8 down 8 down 1 forward 4 down 5 up 3 down 5 forward 6 down 6 down 4 down 9 down 4 down 5 forward 7 up 4 forward 6 down 9 down 5 down 5 up 2 forward 8 up 5 down 1 down 2 up 6 down 7 forward 7 up 5 forward 4 up 5 down 3 up 7 forward 4 down 4 down 5 down 7 down 3 down 9 up 8 down 9 forward 6 forward 2 forward 2 up 8 up 2 down 4 down 4 up 7 up 9 forward 2 forward 8 forward 4 up 8 forward 8 up 2 down 3 forward 9 down 1 down 7 forward 4 down 2 up 6 up 6 down 9 forward 6 forward 9 down 3 forward 8 up 1 down 5 forward 1 down 6 up 8 forward 2 up 7 forward 5 down 5 up 3 forward 2 forward 1 forward 4 down 6 up 9 forward 9 down 8 forward 2 down 1 down 3 forward 2 forward 9 up 1 forward 9 down 4 forward 2 forward 7 forward 1 up 2 up 2 down 9 forward 3 forward 2 down 6 up 8 down 4 forward 8 up 9 up 6 down 5 up 1 down 9 down 2 down 1 up 8 down 1 forward 3 down 7 down 7 forward 8 down 4 forward 1 forward 4 forward 5 down 8 down 2 down 9 up 5 down 8 down 8 down 3 forward 2 down 5 up 5 down 1 down 2 forward 9 down 7 down 7 down 1 down 6 up 6 up 7 down 1 down 3 down 2 down 5 down 9 down 4 down 5 forward 1 up 7 down 7 forward 6 forward 4 down 3 forward 3 forward 6 forward 7 down 3 forward 1 down 6 down 8 forward 3 up 3 forward 4 forward 3 down 6 up 7 forward 8 forward 4 down 7 down 6 down 8 forward 9 down 6 down 5 up 4 down 6 down 8 down 5 up 4 forward 2 forward 8 forward 9 down 2 forward 5 down 9 down 2 down 7 forward 2 down 2 up 7 down 2 up 5 forward 3 down 8 forward 3 forward 8 up 3 down 6 down 1 forward 2 up 7 down 8 forward 8 down 2 down 3 down 5 forward 4 forward 5 down 2 forward 2 down 5 down 9 forward 4 forward 3 forward 2 down 9 forward 2 forward 9 down 5 down 9 down 6 down 6 down 3 down 1 down 7 forward 7 forward 2 up 9 forward 4 up 7 forward 3 down 2 up 8 up 3 down 4 up 9 forward 1 down 1 forward 4 up 4 forward 4 up 8 forward 7 down 3 forward 1 up 3 up 1 up 2 down 3 forward 5 down 6 down 1 down 2 forward 2 down 3 up 1 forward 4 down 2 forward 8 forward 3 forward 7 forward 7 down 5 down 7 forward 8 up 2 down 6 forward 1 down 4 forward 5 forward 8 forward 9 forward 7 down 1 down 3 down 1 down 2 forward 3 up 3 down 7 forward 9 forward 2 up 8 up 6 up 3 down 5 forward 8 down 8 down 6 forward 4 down 2 down 8 forward 8 up 7 up 4 up 5 down 4 up 6 forward 2 forward 9 down 9 forward 6 down 5 down 7 forward 5 up 5 forward 2 up 7 up 3 down 8 forward 8 forward 3 down 2 down 5 forward 4 down 8 forward 5 forward 4 down 9 forward 1 down 4 up 5 forward 5 down 1 forward 4 down 4 forward 4 down 8 up 5 up 4 up 9 forward 2 forward 3 down 3 forward 2 down 6 down 6 down 5 forward 8 forward 3 up 1 down 9 down 4 down 1 up 4 forward 2 forward 3 down 4 up 4 forward 5 forward 2 up 2 forward 4 down 2 down 3 down 6 up 2 forward 8 forward 9 forward 1 down 1 up 7 up 4 forward 2 forward 4 forward 2 forward 8 down 9 down 5 down 1 down 1 down 6 forward 1 up 6 down 4 down 9 down 2 down 2 down 5 up 6 forward 4 forward 1 forward 2 forward 8 forward 2 down 6 forward 1 down 8 down 1 forward 2 forward 3 down 9 down 7 down 5 up 1 forward 1 down 5 down 4 forward 8 down 9 up 7 forward 6 forward 2 forward 8 down 9 down 1 up 5 down 5 down 3 forward 6 forward 5 forward 2 forward 6 up 4 forward 1 down 9 forward 5 up 1 down 5 down 6 forward 8 down 4 up 9 down 6 down 9 down 7 down 3 forward 7 down 5 up 6 forward 3 up 4 down 5 up 5 up 9 forward 9 forward 8 down 9 forward 9 down 2 forward 5 forward 5 forward 9 down 3 up 8 down 7 up 9 forward 8 forward 8 down 1 down 5 down 4 up 8 forward 4 forward 7 down 2 down 7 down 6 down 9 down 7 forward 5 forward 7 forward 5 forward 2 forward 7 up 2 down 8 down 9 down 5 down 9 forward 5 forward 8 forward 9 up 5 down 9 down 7 forward 4 down 6 up 5 up 8 down 3 down 2 up 7 forward 9 down 3 down 2 down 7 down 4 up 6 up 4 down 7 down 4 forward 5 forward 6 up 6 down 7 down 9 down 9 down 6 forward 8 forward 3 forward 5 up 1 up 8 forward 4 forward 6 down 5 down 4 forward 5 forward 9 down 4 up 3 up 8 down 7 up 8 forward 5 forward 3 up 4 up 9 forward 6 down 1 up 6 down 5 down 4 down 3 down 8 up 1 down 1 up 8 up 8 down 6 forward 4 forward 9 down 4 down 7 forward 9 forward 8 up 6 down 9 up 3 down 8 forward 4 forward 6 forward 9 up 7 down 2 forward 2 forward 1 forward 5 up 9 up 7 up 5 forward 4 forward 5 forward 4 up 5 forward 4 up 6 down 5 up 2 forward 5 forward 5 down 9 forward 7 down 9 up 4 up 9 forward 6 forward 7 down 2 forward 4 down 9 down 6 forward 1 forward 7 up 3 up 3 down 6 up 6 up 2 up 3 forward 7 up 4 forward 1 down 1 forward 2 forward 4 down 1 down 8 forward 5 forward 8 up 7 down 3 forward 3 forward 6 down 8 down 7 up 9 forward 3 up 1 down 8 forward 4 down 9 forward 3 forward 8 down 4 forward 4 forward 1 up 6 down 1 down 7 forward 8 down 9 down 8 down 7 forward 5 up 6 forward 5 up 1 down 3 down 7 down 4 forward 6 down 4 down 7 up 9 down 6 down 7 up 3 up 8 forward 3 forward 1 forward 5 down 5 forward 5 down 1 forward 9 up 5 forward 4 down 1 down 8 up 1 up 3 up 8 down 3 down 5 up 7 forward 4 down 7 forward 9 forward 7 forward 9 down 9 forward 3 forward 6 up 3 forward 4 forward 4 ================================================ FILE: advent-of-code/2021/inputs/03 ================================================ 110001010111 011011110010 110011110011 101000010111 011101100100 111001011100 011100000101 011110110011 001001111111 111000010000 001000101100 011100111010 011100111000 011100010001 100001100000 111010111110 100011000101 010111000101 100110110011 101010110011 110101110010 110111100010 000001100100 010010011010 001001001100 101000000111 100100110011 111111100011 110010001010 100010110011 111101101001 101001001101 110111011101 100100101101 111111000011 001110010110 010110110010 010011100000 110011100011 111101001011 100001101000 100101100011 010101100110 101000001001 010001011100 111001010010 000110000110 110110111111 111111010000 110111110011 110110010010 000001001111 010001000111 101101100110 110011100100 101000010100 010100010000 100011001001 011000111101 000101011101 000110111110 011000101100 110101101001 100011110011 110101010001 100010100000 110010010001 000101101011 101100111011 111110110001 011001000100 001101111000 100100100101 101111001000 011010110110 001110011111 101011001001 110000100010 011110100110 001100101100 000110000001 011111001111 011000110010 001100011111 111100010100 010011111000 000100101010 101111100101 010000001100 100100101111 100011101100 000001111000 001110000011 011101011001 000001111101 000011001011 111111000110 000001011100 011001100000 111001011101 011010000011 101010101110 010110010101 000011101101 010010011000 000010100111 001000000111 111111011100 101010010000 101001001100 000000100111 101010101100 010110100111 001010001101 111000000101 111001101100 011110010001 011001111010 010010011011 011110111000 010111110000 001110001011 010001001011 011001001010 011001001101 001101011101 100110100000 100001111110 101110100011 100010111111 001010010011 000010011001 011001111101 000100000010 100110010011 001111001000 110001011101 000100011000 111110000000 111001101000 100111000100 010000010100 011000110111 000110001101 101100110010 011111101001 000000100010 000001101000 111001111101 111100010111 110000010101 110000101100 101111010011 000100010101 100111100011 110100101111 101000001000 001000100000 100111111010 001101111101 000000101000 100111101100 100111010100 111100010110 100001010011 010010001000 111101010101 101110101010 111110001110 001010111010 100110001000 101111001111 110010011101 110001110101 011101000000 010011110110 001110101001 011110011010 110010111100 010000100001 010010000100 111111000101 010111100111 101010110010 100010010011 101011010000 000101100000 011001000011 010110000000 101011101111 001101001110 001100100110 011111110011 010000101101 000111101101 111100101101 000011001101 110011111100 011000110000 000001010010 111100111111 001010000100 000011010010 010001000001 111010111000 110001010011 000000101011 011110011011 100110111000 010010110010 000010111110 110010001001 000111001001 001000011100 111111011010 000000110101 111011111011 100001110111 010001110000 010101100100 011010100001 111000101101 001100110110 010001111110 100000101011 011111111001 111000001100 011111100011 110110110000 011000101010 101000000011 101111110100 011000101101 001000011010 101001100111 101100001101 100100101100 001101011001 001111100111 011100101001 110010000000 010100111000 000011010111 000000100110 101001000000 000110100100 110001110011 001011001101 100000111100 101011011111 000010110110 010101110100 111100111001 111010101101 101100001001 011111000111 010001101000 100000001111 011111101100 011111100111 111101111110 110110100101 011110001011 100111100001 000001101101 100110101110 100000010011 110000000001 001001101001 000001111111 111001001010 101011100101 100100000000 110001101011 011111001011 010010001011 000101010011 110010110100 101010101011 100100001100 000001100011 101010000010 111101100100 001011010111 000001010001 001010001011 100110000011 000010101010 110111011100 001100111000 111011010111 100100110000 000010111010 000011010001 100001111111 111111000100 010111111000 100101010010 001111111010 001111011100 111101100111 111011011011 111000100110 011101001011 010100101010 010100001111 010000001111 000000000010 010011010111 001101001011 101011001011 011001101101 100000000111 100110011010 000101000110 101100010011 101011011100 001101010100 110101110111 001100001000 001001100100 111101011010 001100100100 100000100010 001110111001 101101001110 001101110111 010101100101 000011111110 001000111101 110011101011 110101011000 000000100101 100110100001 111111101101 010100101111 110101011010 011010011100 101101010001 101001010011 011111001100 101001010111 011100100011 101011110000 010111001010 111011000111 100111001101 001110111010 100001111000 111011010011 110000101010 011010000000 110001111010 100101000100 010000110100 101000101010 011010101110 010000111100 101011100100 101101111010 111011111110 000101010111 000010111000 011101101010 101110100110 010000011010 101100100000 010011010101 101100011100 011010101010 010111101010 111011100111 111111110010 101101100100 111001010100 011000001110 110110001110 111110100110 001011011100 101000010010 100000101010 010000011110 001001110111 001001001011 110010011110 001111001100 110110100010 111100000111 010101101011 001111111001 101011000000 011100011000 000001000000 100101001100 110010011001 111100111110 010000110110 110000111000 110111100001 000100100010 100010001110 010000111101 111100011000 110000000101 000000000001 010011111100 011011111101 111001111010 001001001001 010101011010 011010011111 001111000011 101111111111 000111101000 011000111110 001100101101 101000000110 000100001010 111110010101 000011101000 011010101000 100111100000 111001111111 010101000111 011000100101 001001110001 101101011011 001000001100 111110111010 011110111010 111101100001 011111101000 110100010100 010001110011 000011010011 010000110010 000011111011 101111011000 010101111110 100100101011 001000011011 011000100000 100100111101 001010110011 000000000000 000110111011 001001011001 011101010010 000111000011 010001000100 011110011111 010010111011 100000000011 001100111101 000001000110 000010000010 101111001010 000111000001 100101011100 111001110100 100111001111 011110111111 010101011110 101010011011 101000010101 101001101000 001001011101 010110101100 101110111100 000111011110 010111001101 001101100010 011101001111 100111111111 000110101110 011110001110 110011100111 010011100101 100101000011 100101010011 111000110110 110111011111 000100011110 100000000001 010111111111 100000100011 110010011111 111101110110 001000001001 001100011001 111100110001 100110100101 010111101000 000000000110 000011011001 100100001111 001111100100 001011010011 001000110011 110100010010 011100110111 011010110010 011001110110 011011100010 001110101011 101101100111 101101111100 000110000101 000001110010 001101110010 101011000100 000110000000 001001011111 100101101011 001010100001 110000111110 011111101111 110110111100 001000010110 000101111110 111001000001 000100110011 110110000101 101100101011 101110000010 011101100001 010011000001 010111000011 010111011101 101010100001 000111011011 101110010000 110000000010 101100011101 011000011000 001111101101 101000001010 101011010001 011111100001 101001011110 100101011000 011110001100 111100011110 010011101110 001001110000 001001000011 100001010000 000110010000 110111010111 000100110101 001110101000 101011000011 001011100000 111111111111 111111011110 110001100001 001000001111 101000100100 001011001001 110110001101 000100000000 011100001101 110011001000 001111011101 010000111111 010110011110 011110111011 101111011101 001100011000 001011111001 000110001011 011011010100 111110001011 010000110111 001100011101 011110111001 000010101001 001110000001 011111010101 000010010100 000101011001 100100000001 001111101011 111110010011 000111111011 001101010110 001100111001 000100011101 111010010111 000100000001 001011101111 101001110011 001011110101 011000001101 110011001011 011110111100 110110101000 011010001101 110111001000 110010010101 011010001011 000011100111 011000110001 001100001111 110010011010 101100101100 001100000110 010101001111 000011000100 110001000111 001001011000 001001001000 000010111101 100101001010 011100111100 101000011011 101011010111 111001000011 100100100110 011001011011 000011110011 001101000111 011010010100 101010101000 100010110000 100001011110 100000110110 001011101001 000110100011 111000101010 111001011001 101111010010 011100101010 100010111000 010100101110 011001110000 000010001101 101110000111 011011001111 011110001000 010010100011 110001100010 001101011011 110100000101 101110100111 001110111011 000110100101 100100100001 101000111100 100011101110 110010000101 101100011001 100000010111 011100100101 000010011011 001011001100 011001000000 000101000101 100001001100 000001101010 110111101100 111001101010 110000110111 000110010001 011100000000 010000111010 000101000000 010000101010 010011110001 101011010101 100000110111 101001110010 100011011100 010011100011 100000100111 110100110000 000100001011 101101011000 010110011001 010110111111 101110010101 011110001101 110001001000 001001101100 100111010011 001100010011 110101111001 100010101011 111010001110 110001100111 111000010010 001000001011 111001000010 100100100100 110010101001 111101101010 111111100101 100010010001 001010010110 111101011000 001010111100 001001111110 100010100110 100001110100 001111001101 101100100111 101101100101 100101110111 000111110111 000111001000 010101000010 011000111100 001001001110 111101010001 001011010101 100011000111 100000001001 011100011110 010111011011 011000010011 101101011110 000000100011 111110010010 111010011101 001000100100 110101100001 100101101000 001110111111 010001000101 111110000101 101000001101 110101010000 111110101110 011111011000 001001001111 000101010110 001100110000 001111101000 101000100101 010000000010 110011000010 000000001100 010000101011 010101011011 101011010100 010001011011 111100011001 100000111110 110001101010 100111101001 100110001110 110001010101 101100001000 100001000010 000110100001 001010000000 011111100000 111110101111 000001101001 000000111110 101111101001 001010000010 011110010010 101111000111 111110101010 000100001000 000111000000 110010010110 000001111110 010110101010 001010100011 001111011001 111001001111 100100010111 101100001011 100111000110 111010111101 010001011110 101110000011 010111000010 110110001011 111010100011 111100011101 101101101001 110100001000 110001011001 110010100001 111110010110 010100100011 001000011101 001011001010 011100111011 001111100110 001101100110 001011000001 010100100110 100100100111 010100011011 000101110001 010110011111 000001011101 110101011001 001101101010 011111111010 111001100011 100001000111 110110011111 100101010001 011100100010 100100011000 101111001011 111001011000 110000101110 010100100101 110011101000 001101000011 111101100101 011010011011 100110001101 111001111100 001000100010 000101111101 101110011000 001011111010 111100101001 011000101001 001111010111 001100110010 011000011011 110111011000 100100000110 011010110000 110111101111 111000111101 111111100110 000101010010 010101001010 110100110101 011011100101 110110111011 100010111110 100110111010 100011001010 100100100000 101000110110 001010101010 011001101111 001110110000 010001100100 011000100100 001011001011 110111100110 010110010111 001011011010 111100001010 000010001100 011010001111 100100001101 100010011100 000010001000 101001010000 110101001101 010110111100 101001100100 100000111010 010000010001 011101011101 100011110010 100100011111 100011100101 001010010010 000110011111 010000000111 111001101101 010011000010 000001111010 010010001111 101011100001 101100111100 100001000000 110111110010 100110000111 100000111011 111010011110 011011011011 101011000110 011100011001 000101011100 010000101111 100010100001 111000100101 011010010001 110110100011 100000011100 101110101101 000010110100 101011111110 001000100111 101001001010 001111110101 001001000010 001100101110 111000001000 000000100000 000100111110 111111110100 110101001100 001100000010 100011011001 000110000010 100010101101 111110101011 110100000000 000100111001 001111001011 110111011011 001111100010 101111011010 111010011011 100111101010 011011011001 010100000011 001111010001 101010101101 110000011111 001111111111 000110000100 101111101010 101011011101 010001011010 001001011011 101011010010 111010000010 011100101000 101001011010 000111110101 110011011101 101010010011 101100001111 111001010001 100100010110 010100100001 011110110101 110100000111 110101001000 101000010000 110000000011 011111110110 100001010100 011111000101 010010101001 000111100100 001010000110 100100110110 110010101101 010001111101 101100000000 001100000000 011111111110 110001100101 000111001100 011101111110 000100110000 111111111000 101110010001 100111000010 100111011110 000100111010 110101011011 001000111110 101101110110 110110010011 011010100101 001010101111 100110111001 010001111100 010110101000 011000000000 010001011111 010101101111 111001010110 100001001011 110000100111 011100000001 110101100000 110010110010 111010111001 011010111000 101100000110 010100011111 001010111000 101100101101 011000111010 000001001100 001111010010 011010100000 110100110111 101101000100 001110001101 111001101111 ================================================ FILE: advent-of-code/2021/inputs/04 ================================================ 99,56,7,15,81,26,75,40,87,59,62,24,58,34,78,86,44,65,18,94,20,17,98,29,57,92,14,32,46,79,85,84,35,68,55,22,41,61,90,11,69,96,23,47,43,80,72,50,97,33,53,25,28,51,49,64,12,63,21,48,27,19,67,88,66,45,3,71,16,70,76,13,60,77,73,1,8,10,52,38,36,74,83,2,37,6,31,91,89,54,42,30,5,82,9,95,93,4,0,39 57 19 40 54 64 22 69 15 88 8 79 60 48 95 85 34 97 33 1 55 72 82 29 90 84 19 17 62 78 27 61 13 30 75 25 14 66 72 37 79 49 91 97 0 23 12 52 41 92 18 52 17 62 49 76 8 78 93 37 12 9 40 59 75 94 45 2 81 44 63 73 18 48 11 90 59 75 55 74 43 1 17 89 36 91 87 52 45 83 22 9 3 15 11 53 94 72 68 29 20 71 97 74 32 17 31 5 43 83 38 85 27 37 14 65 23 0 61 33 82 41 63 70 60 6 58 24 28 42 73 80 52 97 68 53 30 40 45 18 13 94 12 7 77 98 72 14 34 21 23 97 93 21 99 35 31 8 73 15 74 67 60 44 1 18 68 61 64 82 86 76 47 22 63 78 49 6 93 20 95 96 50 57 71 70 90 42 7 2 27 38 78 56 21 82 55 98 72 40 66 43 5 11 46 24 30 45 91 50 72 27 53 0 10 7 15 35 73 96 9 2 67 1 17 32 48 45 91 41 65 72 63 33 49 8 10 39 96 61 14 26 58 16 74 34 79 60 40 30 35 71 0 52 48 32 92 85 38 20 84 68 24 13 74 2 42 60 96 16 17 59 67 69 8 65 11 79 91 16 87 82 39 77 24 32 67 45 22 86 31 84 56 54 55 75 5 41 3 70 40 55 15 20 43 96 63 47 13 18 91 28 66 14 21 52 59 9 12 97 58 83 81 8 36 44 7 75 86 59 2 47 14 87 19 49 64 3 52 91 40 11 43 35 1 44 78 29 56 5 36 46 32 44 4 30 77 6 63 13 74 71 23 53 56 27 84 93 19 83 81 16 97 99 34 92 6 87 56 63 39 93 51 71 92 40 81 14 9 26 24 80 66 88 89 44 18 1 29 7 8 74 61 9 83 18 57 95 79 35 47 81 72 80 12 37 1 8 71 54 86 40 2 97 19 17 80 12 74 16 92 99 26 49 79 28 39 31 83 64 54 14 90 42 96 81 27 11 33 36 35 80 26 21 49 9 79 47 74 75 77 78 16 89 55 43 27 28 95 71 57 81 36 0 87 66 16 65 29 94 9 71 56 39 30 23 74 49 2 63 13 54 45 48 66 64 70 21 44 57 0 16 72 74 15 79 66 12 45 70 18 44 51 98 11 26 64 68 28 49 27 48 69 52 7 2 72 54 71 43 92 83 95 58 36 1 96 35 62 46 18 16 29 30 28 21 99 87 6 64 11 61 34 54 25 91 90 33 44 22 10 58 37 59 3 28 20 18 98 38 2 95 99 69 50 14 71 72 25 17 4 70 37 92 85 51 78 28 82 48 89 12 52 7 13 21 74 73 44 46 36 21 99 48 77 34 51 67 14 83 89 7 91 22 63 97 4 82 42 11 23 2 27 45 13 94 83 23 72 22 24 13 27 70 20 15 0 56 41 1 19 62 68 75 21 67 90 12 77 98 14 56 63 78 71 51 22 18 33 92 65 89 12 45 82 73 13 34 37 48 97 42 85 54 4 53 74 70 52 96 41 93 36 73 81 4 63 71 0 3 57 51 54 94 25 24 88 80 22 17 16 0 70 60 17 3 66 80 73 84 99 34 69 22 90 72 15 41 6 39 76 94 9 98 91 75 17 20 4 19 79 30 42 0 11 2 37 28 95 14 71 61 81 39 12 82 33 44 69 29 26 87 98 74 96 15 2 61 1 52 23 49 81 0 99 69 47 35 55 60 36 94 19 29 63 53 84 95 22 54 93 98 94 7 5 30 4 46 28 68 90 15 29 71 73 66 42 44 45 82 10 28 66 41 39 92 61 63 27 40 38 42 73 53 52 81 62 78 96 82 51 59 68 64 93 16 48 49 51 85 12 90 81 18 73 30 67 46 38 60 17 10 86 62 66 84 98 36 99 8 45 11 53 78 32 83 94 0 80 67 37 76 7 34 20 1 12 25 73 71 28 48 14 29 40 23 35 98 14 33 11 19 66 96 77 44 32 50 15 49 70 75 59 90 43 58 23 45 78 18 95 35 49 20 72 56 12 70 3 5 58 83 60 61 73 63 45 78 98 95 19 80 11 92 82 13 69 0 37 63 41 75 70 34 64 54 10 1 59 9 65 90 78 87 71 66 74 35 29 58 20 60 39 66 68 28 90 64 36 93 2 37 57 69 91 20 73 96 50 86 77 87 14 63 38 98 43 89 14 74 12 65 94 71 2 93 76 37 96 47 92 55 25 90 83 88 79 11 59 50 81 62 85 98 67 19 79 17 71 53 93 13 50 88 28 58 36 20 52 66 27 89 48 24 12 77 73 13 3 97 16 40 14 4 47 88 12 79 56 80 60 27 6 94 1 75 72 22 44 62 24 29 77 70 61 95 63 57 41 12 7 22 99 58 31 81 15 3 48 20 36 8 76 87 23 91 61 79 53 73 59 67 34 37 54 15 29 50 64 56 44 93 51 0 18 17 27 35 89 3 60 79 23 31 48 12 37 96 74 63 4 98 18 69 6 0 47 54 34 82 46 5 86 64 60 99 44 70 50 53 62 15 61 45 74 52 35 48 99 12 49 91 26 47 78 0 58 82 94 73 7 2 64 81 48 83 66 85 91 26 47 50 95 70 54 13 39 89 44 67 6 22 0 40 21 1 86 63 21 73 61 91 33 68 66 36 77 53 16 51 85 11 57 12 22 80 99 40 8 30 81 27 35 60 28 95 44 34 8 73 81 11 26 90 32 10 0 49 98 7 18 55 42 86 72 77 16 15 65 86 88 21 98 74 93 3 18 7 5 35 73 62 84 42 60 81 48 34 39 57 99 45 60 95 62 18 82 86 99 39 77 48 54 97 16 25 40 56 23 47 37 83 68 51 90 13 80 72 81 78 69 74 76 33 51 91 54 86 60 35 17 70 61 43 97 49 21 26 28 85 57 19 45 43 59 10 46 20 44 67 94 70 53 96 78 76 17 18 54 39 38 66 40 33 71 83 0 42 60 99 41 14 96 75 93 74 11 90 62 37 38 29 64 27 53 85 94 28 31 32 24 14 19 83 98 53 24 78 25 85 37 39 2 41 4 32 45 79 26 36 96 64 80 73 13 28 77 1 9 26 10 37 60 69 72 81 16 35 61 75 29 42 53 82 67 36 98 89 21 87 15 45 73 88 75 46 83 59 20 37 26 62 42 9 78 17 60 84 32 90 64 40 99 61 80 48 13 59 79 20 91 64 65 21 82 44 98 62 33 96 48 46 37 40 8 70 28 90 27 45 68 48 94 58 96 81 33 75 73 52 64 23 36 67 27 54 80 68 87 37 2 34 47 6 30 60 44 52 99 65 58 77 78 68 48 94 84 81 53 20 79 14 7 3 46 42 24 19 8 16 27 42 89 86 46 83 43 11 25 56 59 69 82 65 55 34 22 93 73 74 3 26 30 60 29 45 9 43 72 89 42 39 24 25 28 69 8 51 59 7 13 64 94 30 99 65 2 56 55 38 15 54 83 69 44 27 52 25 17 20 28 59 6 79 13 21 34 14 61 84 67 71 26 80 41 18 96 33 72 16 93 35 18 99 67 68 47 27 32 94 12 10 45 20 91 11 66 52 15 2 13 43 80 4 79 17 89 66 20 82 3 37 12 76 90 35 52 77 63 48 44 58 6 39 71 95 68 56 49 17 61 59 39 34 70 6 75 13 4 26 41 54 29 2 92 24 65 31 60 90 72 74 71 21 86 18 63 30 53 73 48 36 55 87 96 79 32 89 49 81 83 45 26 28 22 62 59 47 97 77 75 25 78 24 66 95 63 16 93 22 32 88 61 76 40 45 18 28 51 55 20 39 23 29 57 49 22 6 74 71 25 80 27 65 69 64 41 21 12 58 95 5 43 11 4 36 97 34 31 96 67 86 24 30 6 69 16 79 12 56 93 18 35 58 90 11 29 81 85 98 23 16 40 59 19 87 42 88 30 32 82 17 93 1 50 56 18 13 78 38 80 51 14 73 8 22 83 15 88 81 7 99 51 13 92 31 24 39 0 10 3 95 72 33 73 44 19 34 37 47 42 67 3 65 91 32 63 82 45 96 11 33 78 66 43 83 49 60 62 51 47 34 48 26 27 54 1 0 53 40 28 21 30 50 74 63 48 49 6 55 57 66 23 45 98 39 95 54 86 38 90 29 80 13 87 76 75 10 43 95 83 61 20 48 54 18 21 37 63 68 2 14 73 27 31 25 17 70 57 33 22 66 48 53 46 75 74 73 84 63 14 71 72 59 3 92 43 30 94 8 69 76 44 40 87 46 13 83 0 6 17 47 81 77 86 60 38 23 55 89 82 73 42 54 35 52 13 1 45 96 89 57 65 28 27 32 22 26 46 86 10 20 52 76 94 37 92 0 64 55 16 28 11 26 64 78 15 7 75 96 61 35 83 18 8 53 57 1 13 66 79 84 47 6 43 80 25 80 70 2 59 44 36 98 85 76 87 7 42 83 94 62 40 81 33 52 10 65 14 60 26 19 83 26 87 91 23 57 40 36 15 1 54 8 49 31 64 5 59 88 45 69 18 58 11 62 92 65 73 33 12 13 30 18 66 11 55 51 97 99 26 57 31 71 49 41 6 95 19 35 25 64 9 77 92 43 88 80 75 58 32 33 97 53 27 23 85 14 35 42 45 44 95 89 61 40 22 68 27 75 76 95 45 80 10 14 24 19 71 11 50 74 41 88 8 0 99 42 13 90 77 83 59 56 8 58 30 73 67 82 1 51 84 44 33 57 76 16 4 13 87 6 95 72 27 38 60 14 37 78 73 80 40 58 30 64 77 92 81 1 45 79 26 11 12 51 25 56 68 67 61 5 20 59 4 96 6 78 60 73 50 88 7 48 2 35 30 87 10 81 40 1 84 83 22 75 20 91 9 21 59 30 69 60 55 37 63 57 77 12 45 28 64 56 95 22 33 84 92 48 86 75 62 83 32 91 93 44 22 84 76 74 34 90 59 33 78 54 71 12 25 10 95 14 43 28 48 36 10 85 5 40 69 91 72 63 37 22 55 94 93 16 26 21 38 35 31 2 52 20 1 28 85 3 4 27 77 18 26 50 62 78 86 52 79 59 58 48 54 64 41 25 2 57 44 10 15 35 22 41 26 2 39 88 69 84 45 44 33 99 11 91 20 85 32 46 83 66 61 30 89 14 0 97 1 7 49 15 85 93 35 73 90 61 8 6 52 17 16 67 39 91 84 25 24 66 68 3 15 90 51 59 62 11 61 83 97 84 94 55 20 71 8 1 70 73 88 43 89 57 4 61 30 53 8 70 47 25 2 41 43 99 65 96 68 66 90 78 57 64 52 42 95 48 40 86 44 27 1 25 62 92 81 5 11 40 24 33 34 37 3 47 28 94 58 26 72 80 71 57 7 54 55 73 99 9 26 88 48 75 12 65 84 71 85 96 72 87 28 66 35 89 63 15 44 69 92 36 31 72 85 33 93 69 65 84 74 77 11 59 52 6 12 34 10 45 63 30 55 46 15 1 59 15 45 75 25 31 70 78 11 36 12 34 8 79 99 57 20 95 72 23 50 19 73 22 38 66 51 93 39 12 96 99 36 97 40 21 95 10 94 3 22 18 26 49 91 61 73 70 47 ================================================ FILE: advent-of-code/2021/inputs/05 ================================================ 194,556 -> 739,556 818,920 -> 818,524 340,734 -> 774,300 223,511 -> 146,434 841,47 -> 122,766 323,858 -> 859,322 277,205 -> 85,205 782,901 -> 782,186 969,96 -> 969,648 504,971 -> 989,971 926,151 -> 926,480 722,895 -> 722,488 15,14 -> 987,986 378,486 -> 267,597 732,418 -> 157,418 252,515 -> 257,520 61,828 -> 659,230 116,652 -> 893,652 827,196 -> 827,564 677,515 -> 677,257 380,897 -> 132,897 812,959 -> 812,23 989,382 -> 294,382 973,89 -> 81,981 292,920 -> 987,225 441,394 -> 441,469 502,662 -> 502,213 609,570 -> 609,58 559,47 -> 208,47 77,192 -> 277,192 229,588 -> 66,588 705,363 -> 705,161 944,51 -> 78,917 699,889 -> 699,354 90,48 -> 955,913 166,491 -> 24,633 154,482 -> 113,441 989,989 -> 10,10 421,414 -> 791,44 360,272 -> 966,272 264,631 -> 630,631 541,50 -> 541,911 17,475 -> 289,203 226,772 -> 697,301 163,625 -> 163,513 642,971 -> 642,754 975,329 -> 793,329 793,878 -> 793,938 10,95 -> 175,95 352,903 -> 352,176 914,92 -> 91,915 649,768 -> 649,136 347,492 -> 347,977 372,839 -> 372,741 587,534 -> 526,534 563,936 -> 102,475 126,708 -> 362,708 326,869 -> 326,640 358,959 -> 358,408 221,99 -> 221,659 572,405 -> 906,71 592,664 -> 687,759 618,457 -> 388,687 712,850 -> 245,383 981,22 -> 45,958 107,884 -> 340,651 17,896 -> 642,896 488,135 -> 851,135 54,76 -> 184,76 290,596 -> 290,478 468,427 -> 468,316 412,434 -> 412,581 899,681 -> 238,20 647,231 -> 542,231 54,374 -> 302,622 586,555 -> 13,555 875,930 -> 26,81 875,115 -> 127,863 863,42 -> 45,860 708,862 -> 100,862 190,490 -> 26,654 347,944 -> 711,580 259,533 -> 259,516 833,790 -> 891,848 556,583 -> 921,948 745,929 -> 745,569 111,100 -> 499,100 638,903 -> 525,903 726,388 -> 973,388 335,504 -> 638,504 628,29 -> 159,29 375,406 -> 200,406 12,819 -> 945,819 660,330 -> 318,672 436,477 -> 436,988 925,41 -> 464,41 868,485 -> 868,109 130,859 -> 979,10 895,50 -> 895,568 582,943 -> 582,904 589,616 -> 589,590 773,359 -> 441,691 396,22 -> 396,730 862,947 -> 30,115 573,543 -> 40,10 726,743 -> 726,934 360,170 -> 360,187 597,287 -> 982,287 537,112 -> 838,112 702,683 -> 151,683 770,792 -> 752,792 964,60 -> 896,60 53,642 -> 278,642 414,871 -> 798,487 96,950 -> 96,983 251,65 -> 289,65 797,666 -> 797,200 582,157 -> 582,538 107,398 -> 594,885 96,66 -> 806,776 124,911 -> 347,911 974,538 -> 974,318 45,966 -> 226,785 39,960 -> 827,172 163,939 -> 709,939 351,540 -> 351,954 656,894 -> 220,458 278,314 -> 278,146 637,784 -> 637,283 83,690 -> 899,690 16,48 -> 884,916 681,865 -> 310,494 333,631 -> 333,832 527,652 -> 527,836 352,343 -> 352,623 256,316 -> 479,93 450,86 -> 489,86 814,834 -> 814,494 406,947 -> 783,947 811,643 -> 318,643 240,651 -> 366,651 902,618 -> 303,19 843,939 -> 729,939 901,149 -> 131,919 365,459 -> 222,459 909,218 -> 426,701 746,415 -> 746,199 249,327 -> 807,885 760,923 -> 860,923 506,259 -> 506,357 933,892 -> 143,892 88,589 -> 88,77 597,554 -> 810,554 505,574 -> 505,812 211,786 -> 906,91 387,238 -> 480,238 394,729 -> 422,757 526,436 -> 526,12 660,397 -> 660,290 856,469 -> 176,469 653,731 -> 370,731 542,241 -> 542,32 471,734 -> 471,384 975,468 -> 783,468 25,578 -> 580,578 52,632 -> 551,133 150,791 -> 672,791 643,348 -> 643,869 893,514 -> 893,422 400,463 -> 335,463 564,917 -> 676,917 166,433 -> 166,246 798,36 -> 69,765 118,977 -> 882,977 718,415 -> 75,415 690,807 -> 690,659 163,809 -> 269,809 715,238 -> 715,314 970,924 -> 104,58 683,762 -> 683,467 554,375 -> 980,801 361,130 -> 361,66 879,491 -> 879,843 515,700 -> 515,454 465,432 -> 465,444 250,239 -> 216,273 894,818 -> 163,818 190,790 -> 190,616 384,263 -> 384,84 63,875 -> 851,87 154,293 -> 278,417 21,592 -> 883,592 372,286 -> 588,70 972,447 -> 972,639 838,60 -> 681,60 38,366 -> 38,907 746,65 -> 459,65 138,640 -> 66,640 536,309 -> 536,109 772,634 -> 772,566 43,949 -> 945,47 914,85 -> 395,85 25,12 -> 977,964 679,455 -> 679,439 420,492 -> 614,492 823,658 -> 823,634 45,332 -> 45,943 807,344 -> 807,756 634,974 -> 634,892 26,26 -> 988,988 628,772 -> 15,772 829,614 -> 550,614 513,649 -> 513,369 607,923 -> 607,801 809,340 -> 450,699 550,193 -> 666,193 175,961 -> 902,234 467,146 -> 500,146 543,510 -> 543,626 667,52 -> 667,161 635,299 -> 375,299 278,807 -> 904,807 269,290 -> 644,290 630,268 -> 630,440 241,929 -> 882,288 864,907 -> 360,907 455,894 -> 455,265 257,43 -> 257,519 414,83 -> 360,83 237,64 -> 237,612 260,541 -> 260,927 323,909 -> 323,583 929,354 -> 929,695 912,914 -> 40,42 579,401 -> 392,401 389,222 -> 895,728 831,696 -> 831,707 871,304 -> 212,304 207,333 -> 621,333 225,897 -> 355,767 883,68 -> 84,867 115,397 -> 115,208 889,217 -> 985,217 793,402 -> 250,402 555,367 -> 61,861 732,954 -> 466,688 39,564 -> 39,481 283,816 -> 346,816 383,506 -> 276,506 394,661 -> 394,143 988,983 -> 66,61 652,638 -> 652,569 185,64 -> 487,64 354,935 -> 251,935 201,460 -> 201,552 836,285 -> 836,666 878,312 -> 359,831 443,684 -> 887,240 221,49 -> 948,776 243,959 -> 22,959 573,323 -> 834,323 745,734 -> 456,734 594,244 -> 908,244 583,360 -> 578,355 288,38 -> 288,364 565,339 -> 251,653 215,196 -> 215,476 270,705 -> 586,705 749,477 -> 749,658 917,838 -> 511,432 935,187 -> 935,381 181,190 -> 323,48 399,491 -> 399,779 861,798 -> 91,28 160,115 -> 58,115 940,68 -> 940,590 806,958 -> 35,187 184,538 -> 438,284 283,904 -> 283,114 344,935 -> 222,935 435,962 -> 367,962 837,768 -> 837,583 100,423 -> 826,423 299,172 -> 465,172 130,136 -> 181,187 969,759 -> 55,759 936,711 -> 521,711 268,619 -> 349,619 946,119 -> 108,957 940,25 -> 10,955 867,494 -> 652,279 535,202 -> 321,202 876,14 -> 24,866 887,208 -> 887,265 129,12 -> 42,12 514,800 -> 940,374 722,306 -> 722,418 24,928 -> 935,17 798,279 -> 798,293 384,701 -> 193,701 100,644 -> 593,644 818,48 -> 216,48 51,984 -> 949,86 843,494 -> 843,723 809,156 -> 129,836 500,38 -> 656,38 311,705 -> 311,101 21,850 -> 21,316 530,628 -> 511,628 106,366 -> 415,675 542,882 -> 325,665 987,937 -> 987,793 926,260 -> 264,922 768,149 -> 914,149 548,71 -> 548,812 51,946 -> 812,946 430,439 -> 954,963 529,301 -> 133,301 282,890 -> 720,890 876,231 -> 336,771 489,471 -> 934,471 585,174 -> 100,174 284,489 -> 163,489 989,983 -> 33,27 31,213 -> 662,213 133,832 -> 559,406 730,345 -> 730,194 860,288 -> 736,412 110,351 -> 581,351 417,151 -> 77,491 674,671 -> 674,711 514,867 -> 514,100 885,595 -> 885,680 44,31 -> 928,915 969,347 -> 69,347 597,227 -> 357,227 347,443 -> 347,216 781,736 -> 781,93 968,559 -> 968,81 35,93 -> 232,93 273,837 -> 97,837 949,833 -> 748,632 712,773 -> 221,773 194,884 -> 978,100 217,816 -> 217,861 651,122 -> 71,122 166,551 -> 166,892 285,193 -> 883,193 858,934 -> 125,201 180,190 -> 577,190 491,685 -> 690,486 666,598 -> 337,269 455,571 -> 753,571 11,769 -> 11,507 391,663 -> 323,595 70,740 -> 70,928 205,525 -> 534,854 890,851 -> 151,851 382,662 -> 849,195 201,870 -> 201,506 549,549 -> 549,528 343,172 -> 601,172 22,732 -> 750,732 221,689 -> 881,29 628,559 -> 747,559 668,879 -> 437,879 712,139 -> 38,139 547,322 -> 905,322 872,304 -> 719,304 469,604 -> 389,524 256,91 -> 746,91 881,548 -> 641,548 683,417 -> 683,800 811,917 -> 646,917 578,556 -> 207,185 732,343 -> 260,343 86,869 -> 882,73 370,587 -> 765,192 649,621 -> 649,165 298,339 -> 298,523 131,771 -> 803,99 934,791 -> 934,29 782,13 -> 782,741 852,808 -> 852,594 390,217 -> 153,217 858,980 -> 94,216 832,467 -> 783,418 188,49 -> 981,842 438,467 -> 76,829 47,911 -> 164,911 670,414 -> 533,414 58,61 -> 740,743 264,686 -> 264,799 506,300 -> 64,300 509,717 -> 509,952 81,819 -> 81,694 512,543 -> 427,543 235,78 -> 788,78 952,133 -> 644,133 188,302 -> 695,302 272,868 -> 845,295 288,413 -> 704,413 774,671 -> 774,24 296,932 -> 296,16 99,789 -> 300,789 630,560 -> 630,896 328,289 -> 280,289 786,772 -> 294,280 437,747 -> 437,110 537,709 -> 42,709 655,924 -> 655,117 185,65 -> 963,843 70,87 -> 274,87 516,727 -> 183,394 322,128 -> 781,587 147,278 -> 482,278 188,793 -> 761,793 702,441 -> 702,27 686,18 -> 686,275 510,254 -> 510,862 666,204 -> 12,204 677,63 -> 677,78 868,950 -> 868,110 42,845 -> 739,148 343,279 -> 758,279 182,792 -> 727,792 346,238 -> 493,238 467,493 -> 467,273 823,68 -> 823,886 686,302 -> 39,302 984,345 -> 984,936 11,480 -> 11,675 989,478 -> 695,772 568,235 -> 535,235 203,41 -> 93,41 463,569 -> 304,569 909,629 -> 207,629 792,678 -> 792,909 486,924 -> 486,948 611,79 -> 611,303 762,136 -> 139,759 808,872 -> 726,872 22,403 -> 22,401 774,134 -> 369,134 131,282 -> 131,849 912,245 -> 912,385 338,396 -> 768,396 944,978 -> 20,54 623,897 -> 623,10 103,402 -> 207,298 39,50 -> 971,50 770,423 -> 882,423 195,873 -> 195,40 119,659 -> 119,374 678,962 -> 698,962 946,64 -> 946,202 790,780 -> 790,66 565,21 -> 614,21 617,20 -> 640,20 697,773 -> 697,915 467,167 -> 208,167 567,713 -> 567,873 120,98 -> 557,98 103,395 -> 103,159 148,734 -> 723,159 730,949 -> 730,33 322,628 -> 322,272 649,57 -> 44,57 261,513 -> 624,513 550,414 -> 738,226 774,183 -> 471,486 146,659 -> 146,581 599,751 -> 599,320 936,225 -> 226,935 378,31 -> 222,187 871,691 -> 502,691 195,963 -> 335,963 513,465 -> 382,334 620,801 -> 673,801 187,428 -> 318,428 572,836 -> 441,836 305,398 -> 305,951 978,703 -> 927,703 99,219 -> 846,966 952,971 -> 26,45 859,775 -> 859,663 144,777 -> 144,390 792,859 -> 441,859 513,672 -> 982,203 613,342 -> 671,400 802,498 -> 811,498 197,240 -> 197,216 45,908 -> 881,72 860,573 -> 12,573 817,145 -> 755,83 565,562 -> 660,467 918,952 -> 918,111 936,174 -> 936,97 630,759 -> 630,89 329,762 -> 608,762 ================================================ FILE: advent-of-code/2021/inputs/06 ================================================ 5,1,2,1,5,3,1,1,1,1,1,2,5,4,1,1,1,1,2,1,2,1,1,1,1,1,2,1,5,1,1,1,3,1,1,1,3,1,1,3,1,1,4,3,1,1,4,1,1,1,1,2,1,1,1,5,1,1,5,1,1,1,4,4,2,5,1,1,5,1,1,2,2,1,2,1,1,5,3,1,2,1,1,3,1,4,3,3,1,1,3,1,5,1,1,3,1,1,4,4,1,1,1,5,1,1,1,4,4,1,3,1,4,1,1,4,5,1,1,1,4,3,1,4,1,1,4,4,3,5,1,2,2,1,2,2,1,1,1,2,1,1,1,4,1,1,3,1,1,2,1,4,1,1,1,1,1,1,1,1,2,2,1,1,5,5,1,1,1,5,1,1,1,1,5,1,3,2,1,1,5,2,3,1,2,2,2,5,1,1,3,1,1,1,5,1,4,1,1,1,3,2,1,3,3,1,3,1,1,1,1,1,1,1,2,3,1,5,1,4,1,3,5,1,1,1,2,2,1,1,1,1,5,4,1,1,3,1,2,4,2,1,1,3,5,1,1,1,3,1,1,1,5,1,1,1,1,1,3,1,1,1,4,1,1,1,1,2,2,1,1,1,1,5,3,1,2,3,4,1,1,5,1,2,4,2,1,1,1,2,1,1,1,1,1,1,1,4,1,5 ================================================ FILE: advent-of-code/2021/inputs/07 ================================================ 1101,1,29,67,1102,0,1,65,1008,65,35,66,1005,66,28,1,67,65,20,4,0,1001,65,1,65,1106,0,8,99,35,67,101,99,105,32,110,39,101,115,116,32,112,97,115,32,117,110,101,32,105,110,116,99,111,100,101,32,112,114,111,103,114,97,109,10,161,185,311,752,668,728,210,741,636,381,1222,509,282,156,806,624,31,300,711,128,146,368,306,239,7,519,441,368,179,155,704,274,237,710,164,55,217,1007,0,701,812,713,127,536,320,163,454,310,726,433,426,102,1350,736,408,951,307,15,333,462,755,797,265,540,680,357,914,195,468,1034,583,413,1293,450,88,2,208,1006,336,98,17,164,95,455,511,113,710,636,308,330,479,62,197,591,390,148,933,1060,10,564,137,422,1756,494,1205,79,13,1257,205,738,245,462,313,249,1580,929,914,512,370,152,413,6,223,197,777,885,1387,52,824,1308,422,728,298,123,922,234,33,109,747,231,916,1452,432,397,222,857,113,119,437,1474,129,1214,69,595,347,293,885,363,72,315,77,1131,55,1541,1244,37,724,553,65,327,341,619,800,547,104,33,272,1557,1316,141,476,510,505,188,1734,175,52,222,1392,732,303,959,75,432,224,293,112,99,923,396,1069,241,246,1146,823,961,593,367,394,324,390,20,63,403,602,571,125,649,60,327,190,1661,140,486,420,833,1464,218,80,74,345,366,191,119,109,399,1596,431,445,1179,1195,144,136,51,215,19,106,998,664,89,49,1041,101,814,995,279,810,702,738,471,315,217,60,24,272,490,7,1294,322,594,804,165,130,125,18,1422,208,0,148,544,901,1530,50,207,364,904,197,585,153,536,1014,571,1086,782,727,125,1174,453,1773,0,106,790,634,385,39,91,599,48,98,128,562,595,901,1269,108,219,583,162,101,182,645,371,17,872,73,156,313,243,678,75,727,566,282,193,28,75,576,394,176,132,172,27,758,496,57,32,73,1791,208,1660,429,38,1518,419,1748,52,1193,353,175,198,186,105,195,75,867,380,417,341,574,628,1076,116,1441,1353,528,530,205,0,1434,827,556,493,884,172,187,441,182,227,954,1016,3,336,786,947,155,373,52,26,969,686,837,477,8,31,288,952,574,159,511,351,440,774,948,213,45,773,294,75,742,300,686,395,315,1658,264,119,28,993,392,99,759,384,317,1105,562,324,416,375,938,329,988,1334,439,1284,557,28,225,438,216,501,358,743,206,1150,378,30,850,1149,296,279,132,387,64,895,157,528,138,12,688,1045,153,42,54,1281,535,427,297,1037,253,68,424,428,205,138,93,82,383,93,1061,1116,287,888,204,777,35,548,784,268,897,1167,201,532,151,198,388,3,306,1689,555,207,852,723,173,655,535,963,46,54,1705,490,244,67,299,543,333,185,196,361,147,891,370,797,195,386,371,1111,156,1587,641,1252,430,40,715,930,1560,774,227,122,179,45,72,744,27,6,1479,1178,969,108,395,37,31,426,1131,495,246,36,63,121,286,594,856,2,1773,1724,5,421,51,344,1312,382,24,15,246,921,562,20,818,493,44,239,1047,368,37,245,245,851,35,2,442,792,235,516,450,282,812,510,161,731,788,93,475,205,222,1005,1002,358,860,875,1330,354,724,114,207,956,597,234,206,55,637,7,48,751,123,241,858,255,508,200,1064,79,169,85,768,255,21,708,340,145,385,1130,281,39,1072,100,285,1355,360,283,560,153,488,689,319,929,309,1013,95,88,843,208,126,146,3,328,75,251,18,1053,782,556,94,743,299,66,311,18,789,1323,45,777,281,75,676,741,340,1055,870,1935,203,80,93,1372,747,6,79,560,33,67,1,197,193,1245,40,466,1144,557,16,664,144,984,590,1105,165,131,41,455,77,33,572,477,854,18,157,48,453,487,25,423,181,800,615,25,374,183,380,262,219,81,466,691,119,754,122,918,920,410,1102,156,1355,101,395,1837,89,40,341,264,393,547,564,480,13,24,259,1054,19,390,1199,664,205,645,274,43,115,354,329,473,812,1302,771,308,94,838,593,942,1107,153,394,596,194,119,719,1392,1094,26,252,1276,162,310,23,1681,106,160,1206,509,684,432,1659,129,172,99,630,417,151,69,211,874,310,1109,740,589,496,508,742,407,1156,1920,209,218,375,468,971,705,68,1603,158,236,121,63,1615,822,198,322,946,368,128,231,125,125,41,278,574,359,28,20,322,785,382,990,266,1586,324,710,159,727,28,11,15,211,620,762,73,1,75,33,239,327,1105,228,4,1256,1578,729,1164,44,222,1177,186,1593,605,43,239,1353,877,300,75,54,324,1487,1655,715,597,540,202,266,1030,576,251,14,669,833,66,1285,170,109,433,1760,60,948,542,129,5,165,173,659,743 ================================================ FILE: advent-of-code/2021/inputs/08 ================================================ febca cfagb ecbafd efdcbg cbegdfa fg bgafec gfae acgdb gfc | cgf facdeb ecgfdb afcbge acbed dcagb cfbega ecgdab be deafc bfgdca abe edafgbc debg | dceab dgbca gedabc fecabgd decfb bgadec dgefa bcgfade cae adecf ca eacfdb bcaf dfgbec | bfca fdacbge cedfb dfebac egd agdcfe gedbfa gbcfae ed dafgebc bdcgf gdbfe fgabe dbae | cefbga egfcba dbfeg ed bfeca beadgc gdfeacb aebcfd eg aefg cgefab ebgfc gbdfc beg | bedacf eg dabegc bfeac fcd fd fgdceba edgac cegdbf gcafdb agdfc cafbg beagfc dfab | dacbfg gfacb fcd fd cfbgeda gdfae abdfg dfceg edagfb geba bfcaed fcdbag ae aef | dcbefa dagfb dcefg abgdef edafbg ebg gbdea cdbefga bfgcea ge egdf aedcb gfadb gbcfda | degbaf dbgafe ecdab dagbf adecfb aebdc ab efbagd cfbed cagde baecgfd egdbfc bad bcaf | cbaf beadfgc febcd gaecd gfdacb bgdace gb cdfbg fcbde fdgeac bgfa dgb acfgd bdcefag | bg dbegac fbdegac agfb bfdace bdcfa ebcag egcdbfa dbg dg fbegdc bcgda fgabdc gfad | cadgb abcdg eagbc dagf bed faegcb fedcba dgbcea feabc cdefb bd bcdfgea edgcf afdb | dgcfe adfebgc ebgcad cfebd cfead dc dagef gfdc cgdefa acdbeg cad egfabcd bgeafd aecfb | dafge fdgeba faecd cbaef afgbde gebca ecbdaf caedb faceg abgcedf cdbeag cbdg bg agb | bg bcaed aecgb cgbae dfab dfgae bcafge cbefagd fdbeg fa fea fcbdge aegcd bdeagf | gfaedb af acbgfe faecgb decafg cadef fadecb dfeba aecbgd gefbd aeb ba ebfgdca abfc | gbfaedc bdefg acbf gcafde efgbd efdacg cd gefcd becagf dgc edca egdbafc cegfa fgdbca | eacgf bgafcd bfaegc dc gabed gdacfe egabcdf cdaf fdg acgfe fgdea gafbce degbcf df | fcaeg cefag bfegdc dfg gd badgcf cdg gbdcae cbdea dgfceba bfadec gdbe geadc acefg | gdc ebdg dg aegcf gbae fedcag bg ecgbda bfecd dcage fecgbda bgdce acfdgb gbd | cbgafd edcfb dbg bedcg abcgdf cfgae cebag gedbafc dcgbae abg decfbg gcebd ab dabe | gdbeac ab ab dcfbga gab efgbd gbcfad edgfac ba gaced dgcbae edbag fcgedab aecb | gfdace adebg ba cgbdfa acebg aedbfg deca ad dcaebg cgfbd abd cdabg dbecgfa agfceb | ad fadegb dcae cbfgd fdagcbe ebgdac ecfgbd fbc fc cbged fbegc cdef cfdgba agbfe | bfgce begcf cdfe cbf cbd fadgb dceag cb gfadeb begfcd cafb cgfdba gbadc cegdbaf | bdc bc adcbfeg dgace bgdefca cbgadf ebacf dfbac gedcfa cef fe gcbae fbed fcdbae | fe cadbfe ebfgacd cdbafg acfde cgeabd cag gfcb adgfc fdgbae fbdag cgefabd dgbacf cg | fgadc dcbgae ebdagf gbacfed ebdcg cfdbage cefbag cb ecb dabc cagdeb gbefd afdcge adegc | dgbafec dcfgea dgbef aecdg acd bfcged aedgfcb afdbce efcdb cfdae cbae cdafgb gdefa ac | aceb ecbgfad bdaefc efbcd cebd aefdgcb bafecg bfagd adfecg dcgab gcd cd ebcadg cebag | cdg cdg gcdba dafgec aecgbf bgfae gbcfeda fba abce gebfcd ab gcebf gcdfab gdafe | begcf baf baf fbgcae acdgfb bgedfa cbadfe degf gbeac gd adg dbgcaef abged febda | dg dg ebdfca fgacbd cfb fbdgac gcdaefb dabec fbcda fagbd cf cdgf bacfge ebfagd | bcdae bgdeafc acegbdf cf caegdb acgbf abdcgf fgebd afcd cd ecafgbd gcbdf dgc fbgace | acfbg efacdbg bcfgd fbcgad eab fecbdg dcfab fdcgaeb gdebc cegadb bcaed bfgace ea aegd | ea bfadc bcgdae becfag cg fdbeg eafcb bcefda cabfdeg cbfgae bfecg bagc gec dfgaec | bagc ecg cg abcg ceafg dgeab ecd fcbedg edcgfa agdbfce dafc bcfage agcde cd | ecdga gecad cdaegf dafc gedcf bcad abcfgd bd dcfbg bfgac fecgab bfd efgdcba faedbg | bd bd dacb cfgbd dcgfab fabed decbf gebcdf da efbag deca acfbegd dba fadcbe | ad abgef efdba debfc gadcfe gefdbc faced cfa geac afcgbd efbacgd ac cgdfe baedf | ca afc fcegd gedfca gefca ecdagb bg ebadf dbfg eagbf fbegdca cefbda beg fbedga | gb fabge gaebf ecbdag abd gdecbf da ecfbd afgbde ceda abdcf dfbcgae dbacef facbg | dafcb bda dgaebf gfabc afbegc cdgea aedfbg cgdb bgcaed egcdbfa cfeda cg dagbe gec | agedfb fabdge fegbda ecg ac acdbge dgbefa abc dbecfa cabgefd fegbc fbace eadfb fdac | ecbaf ca cgebadf afcd fdgcb cebf dcfbge cbdag gdbef acgdfe adgbecf fgc badfeg fc | ebcdgf cfg bgdac gfdeab gefc ecadgb efcabdg fca ecgad fc ceadgf bdfacg afebd cdaef | fca bgdeca efbad cf gcbfd ecdbf cfdgab gacfb dg gbda efcgba gfd egdcaf ebcadfg | gd gbacf facgb fcbed ecfa edfgcb bgdae abcdef ac debfc cad acbed febdgca bfcgad | edabc ca acd eadbc dbceaf cbagfe bdcgae bdc cdag debgf abcge bdgcaef dc cdebg | bdface gadc bgaec cebgaf ecf dfbae aecbf gabcf bfgdca cbegfd ec gcea cebfag cedabfg | afdeb efbca dbfea afbcdg bdagcfe gd debgca dgfc gbaef adbfce fcdbga gad dabcf fbagd | gdbeca dga cdbafg deabfc egabfc fdeb dcbae cfdea aeb be dabgc abcdef cagedf fegbacd | bdfe cedfag edbf gaefcd decfgba efgdc befdc dcabf ebc gbacdf acgbfe abedfc be deba | fdebc bec eabd fdagceb efbag gdae dgcbaef cdfbge gbfed gdcabf fedgba bag ag acebf | gbedf bafdcg cabdfg dgcfaeb dcfb agcdb aedfcg gfbdae fbgad dac cbeag dfbecag dc fdacgb | cagbe gadfbe dcfbga bgcad gefcb edcfg bega befdac bagfec cadbegf bce bcfag dcgafb eb | gbceaf bgcfa acefgb abfcg bgfce agbfc fga dabceg bdagfec afdcgb gcdba adfc fa baefgd | gfacbd fa agf gacbde gbfa bef bgeda cbeadg begdf gfcdaeb egcdf dfcaeb bdfage fb | fb dfbeca gfecd abgf dbfeac ecbfg ec dceg afbdcg gefbcd dbcfg geafb ecb bdegfac | fagdebc cadgbf gbdfc ec fgdbe beadfgc dfeab gbaf gf gdefca degcb aefbdg facbed gfd | fdcgae dgfbe fgd bfdae baecfd aeb cfae ae dgbaefc facdbg fbgead gbced bfdca bdeac | afce caef ecbda ea aedgb agf abefgcd fabgd afgebc faed dgfaeb bgfcd edbcag af | af adefgb adfe abdgec gdaecb gbcad gbcae cgfabd ebgfc ea bagcfed gae dbfage cdea | abdcg gadbc eacd adbegc fcdbe febacg gcfd egf ebgdf fecgdba cfdeba gf agbde fbcdge | gfe abged efg cdfg gb gdceafb bceaf cebgfa aedbcf fgb acgfb fcdag eagb cfbdge | efagbcd agdcbfe fbdegc abge ebfac cbeafg df dcbag acfdbe cfdbeg dfb gecfadb feda fdbac | gdcba gedfbc gedabcf cagbd cbfdg gbacf gdab bcdfeag dbf fgdec cfdabe dgbfac fgaceb bd | dcefba fgdce edfcg bafcg ec dacfeg aebc dfaegb eagdb gefcabd aedgcb dbcfg dec egbdc | fbadecg dfecag efgcdba dfbaeg gafbdc cbafde cfgebd gabcd cebag ad cad cafdebg bcgdf dgaf | fagd efcdbg acd bfdceg cde afebcdg bagcd ce fagedb dcfgea afbced efcg cgeda gfdae | acedbgf cabfed cefg dce cabg geabf gfbeca dfgea gfbeacd dgfceb gbe dcbeaf befac gb | agdfe dcfeab adefg eafgd debgacf edgab agedcb fdega ab cadfbg bad cbea bgecd dfbcge | adbge dabegc fagde abd bdefac afgbc abcef ce bdefga dfbea cef bgdfaec ecdb agfced | dcbe caebfd dgafec acbgf aecfbg gdaefc becgadf bdgfa cg efbcad decaf fcg acgfd edgc | cfbdgea cg cefdga cfg fd dgfcaeb fedg dcgbe bdgecf bfcde abcfdg dbf becaf bgeadc | cdgbea df egdcfab cdbfe aedcfb bdecg bcdefg cd fbadcge edc gdcf gbdef bfagde begac | befadc bfeadg fgdbe dc de cgadf gde gecfb egfbac bfde dcabeg ecbdgf efdacgb dcgfe | defb bgefc ged cbagfe egdfba cdafbge gfa dfgab cbdaf becgad bcgafe gfde bagde fg | bfcedga bacgde geabd cfbda bacgfd gec cbfeadg gdeaf afceg ec dagecb gacbf egafbc cefb | abgfcd fdabcge egc abcgfe edbgac fecbg adcgef fdbgc cbaeg feab bceafdg cgbfea fe efg | abfe fdbgc aebf cgadfe afbdcg dacbf cdbgf acdfe ebafcg ab beadfcg cfgbed cab dbag | becfgd abcdf bdcfaeg egbadcf dafceb gebfad cebg gbdfeac dfcga dgbac acedb gbd ebgcda bg | deabcg bcgade egcabd bdcafe gfa agcfe fbcae cedbaf cdfge ga gcfaedb afbedg cgba bgaefc | bagcfe ga fbace fceba eg cbaefgd dagfb adcbeg aeg cefabd bgec dgeafc abdce dbaeg | fcagde bdcage gabfd acdegb dfeagcb ebf eagfc gbefac cgdfea dbfag eb dcbafe gecb egfab | eb dgafb faecg eafdgc befdc gfbceda ecdgba bfdacg cde gecfb deaf bedafc ed cbdaf | becfd bdacgef eacgdfb gbdace agdb cdafegb cfabd cedbgf cdafeb fbgac bgc gb adcgbf faegc | cbgadf dabg fgeca cbgfa cfeabg cfeab fbge gcdae fgc aefdbgc gf gaefc dcgfba ebdfca | abefc cgf fbdaecg bafce cbfgda ebfdcg dgbfa bd fgdca abecgdf dgb cegfda bgfae cbda | gdcaf fdgab cbfaedg cgaefdb ef cbfgae abcdf adecfbg gacbe abecf agdbec ebgf dfceag cef | efc ecf dcbaf cbaeg dgcaf bgfd aebcd ebacgf cdafb fdabecg bdafgc adecfg bf fcb | afcdb fcadg fcadg adgefc afcgeb fdgc bcaefdg egacf ged gd faebdg cdaeg badce cfaged | cedba egcbaf dfbagce eagfc edgaf aegdfc dgcfba befdag cd cafdbeg cged facde eafcb fdc | gebfad gefda fcd agdfe debfa dcgbefa gdcbae cdfbae ab bdcegf cebfd bea cfba agedf | fgecdb bcaedg feagcdb fecbd abfecg fdegca dag cead dbfge gaedf da afcge cdgfba gbdcafe | gfedb bgfdac dag agdfe acedgb dagcebf abgcf acgbd fbgd afb cgadfb ebfcda fgcae bf | agcfe fgeac ebfdac bdcafe adecfg cbda ecabf egcbdaf fgaedb gcbef cfbaed bfa ab efdca | fbcae fcaeb dbac cfadeb aecgdf bgcea dbc facdgeb efdb db edgcb cdgfe cgdfba gcdfbe | fdgec bd gcdabf dbecg cbgdfe gbdfa dbe bfgdeca cgbdae cbefag becag ed aedc agebd | ecgab fgbdce aecd dace cfbed gfcbea abdefc gbfcd eabd dce de geadfc cbgdaef febac | ed egcafd cde edc fgcde fcbad fdegca ae fdcea dcegbf geaf eac badecg aecgbfd | egdcfa dbfac gafe ae bgadcf acgdf afgedc bdgeacf bfd cbaed fcgb agfdeb fb adbcf | fdbgca fdbcag acdegf cagfde gacbfde ebgdcf eabcfd fae fa bfead cabf cbefd gfcaed gaedb | fa fcdeb fecagdb bfac adecf cafbd bcdagf gbadc bf dbf gdebca edfagbc bfga dgcebf | fadbc dgcfbe dfb feacd dfgae fgcedba ge bcfade caedfg dfbga fdcea gaedcb gea gefc | cfeda fbagd gea eag dafceg dfba cdeabf da bedgafc adecb gecab fdecb febdgc cad | caebg cbfde abdf ecgab daebg cebg bcdae gb bdg cdfgba bfcagde dbaceg fdecba fdega | geadf dabge gebda ecabgd afedbg feb bf acfb dbeca bfegcad cdefg ecfdba dcfbe bedgca | facbedg cfegd cfba ecfdg bd abgcf cfgebd cfgdae abde dafceb fdb daecfgb fcdab cdaef | bd cbfda cabgf daeb ge cdfga edga caedfbg edbgfc dagfcb efcga cfagde feg faebc | gef eadg fcbagde efgbcd cabegd bec eafbd bagc dfcaegb dcgae cb ecdba bdgfec egfcda | cegdfb dgcae decfgb bcdea fcbgead af cdbga fabegc cbafd fead cefbd fbcdae gdebfc baf | cadbf cfdab efbdc baedcf edfbag bgc cfba ebgcaf cegdfab gfbae eadcgb fecgb fedgc cb | bdgeca cb cb dfgce bfadecg fad baedfc cabef gacfbe agecdf cgdfb aedb da acfdb | acebfgd aecfb efbca agbfdce defbca ebcdgaf fgbe gdcfa degcba decbgf fe defcg ecf bdegc | eadbgc fgbe gedfc dcegb bagecf bga gbde gb dacbf gefacdb edcagb cfgeda gdace cadgb | dgacb bg bdeg acdeg bdc dgbafe cabdeg bfgde befac defbc cd fcdg afgecbd gbfced | cbadeg cdfebg gaebcd gefdb afgce dc fabged gbafd fgcda gecdbf badc fdcebga cdf adcfgb | cfbdge dabc dcagbf dgfabe cdafeb egf afbeg dagbef cfbgead edag cgebdf gbcfa daefb eg | dabfe fbacg efg eagbf edbf afcbedg eacbgf fd efadc fagbdc abfcde daf becaf acdeg | cgfdba efabc adf fgcbda gcabe bcadeg dag dgafcbe agdcb faegcb dcbaf afebdg egcd dg | gdfeab cagbd bfceadg gda gafcd cbgafd gbafec fcgade bcfgeda cdea bedfg ea fae eagdf | acgdfe deacgf efgdb fdgac fecagb ae cgfbe gdafb fecdbg faegb gbcefda aefc aeg gecbda | gae ebgfc edgcfb adbegc fgced gcdfbae fec edcb ce bgdfe dfagbe acgdf cbaefg gbcdef | cdafg gaefcb becd cef begdc bacegfd cadfeg afbgc cbdagf egbcf feg bgacfe feba fe | fcbeg gbcaf egf fe bed eagdb fagdb efadbc aefbgc ecgd ed gbcdea cadgefb bgaec | bde de ed ecdg edbgfc ebfacg cdgef ga daegcf gfa bfacd aegd fgadc befgcad | cdbfa cfedabg dagcf gfbaecd gdacb bcdgfa egacdb facb cf cfd cgdefa gbfde egcafbd bcgdf | cfd aegcdb fdc cbfa fdca cagfb ac gcdbef bcfgade ebafg bdgcea abc cgfabd cgdbf | fgcbd febdagc bdgaec gbedfca ca dgcfb fgead gca edcgfa fagcd gecfba aedc dfeagb acegdbf | ac cga cade ca def gfbdc ebdgaf cbde gdcfe eabcdgf ecgfbd dbfgca gfcea de | dbec fecga dfbgc dcfeg dacfb bed gcbaefd fbcdag afdecb befc edfab agefd dabecg eb | dbe bdgfac abedcf cdbgfa abf cbadf cfagdb acgf fa fdbcg bfagde befcdg dcegabf cabde | agcf fa bdaec cfagbde edbcag aebcf afgb fcgbde beagcf bea cgefb ba edgfacb faced | aeb gbcdae ecbfa decbgf ad adgfcb afgdc ebafcg eadgfcb facgb ecgfd acdb gda gdeabf | fcegd cdgfa abefcg dcafg cfebd gfdec feadg gec gfabed cefdga cg gdca gebcfda aecbfg | cbfeag dcag gc cabdfeg eafdc fac af ebdcf bagcfd gfae eagdc bcfegad gebdca gcdefa | fcbgda dfebcga gdbace defcb dagcf aecdgbf bedfgc bafedg adcbg gdcbea cgb dabge cb ebac | fgdebc edfabg fdcag ebac bgdaf cbdgef bdcag ac abgedc afgceb cdegb acde ecgbfad cga | adec gbcda dbcge edac gbafe gabecf gaed edbgf ed abedgf bdgcf baefdc def cbgefad | febga agde fed gfdcb gefcba fgb gf eabdf gcabd edfacbg bcfadg dgfc dfgab gdeacb | fgadb gcdabf fg gfb gbadce cbdafeg ce egcdfa agdeb fbdac ecgb ebgdaf ced acedb | bcafd ecbg bcadf gedbacf ag fbcgead baefcg cfbgd feadc adge fgacd dcagfe dcafeb fga | gaed abdfce ag ecfbga efbgdc cbagf gcdabef fegcda gcdaf daeg gd deacf fgd acedfb | fadgc fgabc befdac dg ed gcefa dcefga fcdbgae dcgea efbdac acgfbe dbacg aed gfde | ed efcgba adgce de afceb adbfge beafg bga bedfgc ag bcadgef dgbfe gdaf geabdc | ebgcdf gfcbde ga edbfg gafcde agcfeb fdcge ebdfc gebfcda gef gf fgda eagcdb edcag | fabceg bgcfea fagd ebcdf ecadbf bedfg da dgfbcea bacfge ebfad bcaef deagbc adfc ead | dae fadc fdgceba debgf adb fbcae ad acfebd gefcbad cefgab bcdaf gdfcb ebagfd eacd | dbfca fdegbca abfecd cdbfg fbdcga ebfcd fbadc ca fabgdec bca bagfd bcgeda agfc bgefad | gafbcd cbedf afbdg afbdgc ecfdba cd facegb gbacde gcbed dce cegba bcdegfa befgd cgad | ced cd fcagebd dce ebdca fcabge dceagbf dgef fbedc ef feb cdfgb cdbfge cgafbd | bcade gfbcae cfgdeb efb eda egabfd egfacb da fdbegac gdecb adfc dacegf acdeg feacg | dcage cgbde faceg gcefa efcgda fgec dafebg agfcd aefgdcb gf ecadbg cgead fga adfbc | fegcda afdebg dbafc fag gbdaec gaecfd cbdag acfbd cfegabd fd fcd cgfadb fdbg fbcea | fd ecbagd fdgbeca ebdcfag dbgacf efgad abcf dcebagf ebgacd cfbdg dgcefb ab dfbga abd | dbgeacf cfdgba gbdecf gbfad abegfd cdafb bdfag ecagdf ag acegfdb ebdfg fag cdbfge bgea | fga dcegfa dgfeb fceagbd cd acbefg cdfge dfaceb gcaefbd cfd fcaeg egdbf dacg daegfc | egcfba cadg cd dcf gebdfca cdbefg afcg gecbf ag debacg dbaef fabge aeg gbcfea | cgbeda gfecdb ga cgebad cgdfeb dfacbg ecd cadfg cadbgfe aegdb fedgca acef cadeg ec | cgdae agbde dfcebg cgfdeba fg bdcagf ebacfg gbacd cgfd gfa dgbfa adcbeg edbfa dfabegc | aefbcg agbdc fdcg agcdfeb ba cbgefd fgace bae cadb edbfc abfedg caefdb caebf gaebcfd | bae cadgefb efdbc ba edcfb cdabe gacdeb dabfecg gefacd aedgbf dac bgac ca edbag | facedg dfeagc daegcb gdabce afbdce gfc fecagdb egdaf gfbaec bdcfe bcdegf efgdc cg bcgd | gbcfea dfgebc cdefb cg cgdaeb dfbacge cgdbe acb gcdfeb dfcga ba fcadbe gbae bcdag | fadbec cadgf ba ba cgdeb ebfcag gbdafc bgfde gecdba ec abgdc bce dgecafb cade | cdgafb dcea gdabfc bcagdf fadbec gecfbd deg ge afdgce bdfec agbcd ebfg cbedg fbedcag | bgef abcdef cgbde cbefgd aegdb befgcd gec ecgba aecd cfbag bdefga ce gacdeb dgecabf | eadc gbfced bgcae dgaeb cfabd fbedac cadfgb eb bce cdegf decgab eafcgdb cfbde afeb | fdbec fbacd be ebcadfg bdecga gdac cdbefg dc bcd baecg bdeac efabd fgceab dbacfeg | bedac faebd baced egbdca cg cafgdb bacfde gfaeb cfadb bagfc fcg ecbagfd fdcega dbcg | febag fcg bgcfad gadbcf fbde fgd df bagef gacdebf cefabg agdec gdafe gaebdf bcdgaf | efdb abfeg febd debafg aebcgd abcdfe bdfeg eaf dagecf cgaf bfacdeg fa gdeaf gedca | cedag gedfb agbecd afcg fedbcag cgfabd gba faegd eadbgc gceb bgeda bdcea gb aedbcf | beacd ecbg bdaec adgbec cfge gc gebfcda fbadc fdbcg degfb gebdac gdeafb dcg fcegdb | dcbgea debgf cdbaf bgcfd ceafb fegbdc bcfed ecd daefbg dfgecab cgfd dc aedgbc begdf | edbfg efcab cdfg bdgef ecag fegcba bfgac cdbfg efabc befdca afg gcbaedf abefgd ag | fedcba fgcbd ga acge badgf cgaeb ebdga afcbde ebdgaf fged acfgdbe de ebd fdbacg | gfdbea badefg dgeba beagc beagcd cga cafgedb ac febga fgcba cgfbd dgfcab gcefdb cfda | ac fcda agc ac dabefc abgfdce decfb gf gfed cbdgf bdegfc gfc gafcbe cagbd | cfg dcfeb bcefd edfcb gedab acd ceba agdcb bagdce fcgdb ca dgaebfc dfgbea fecagd | adc acd adegfc cda dg eafdg gcbeaf dcfaegb acgebd fadgbe dgbf daecf fgabe deg | gdfae bgfae fgbdea becdag decgfb bcgfdae agcbd afcdb fb ebaf fbd cedabf ecdfa ecfdga | dfeac fbae fb degabcf feabgdc gfdbe bgcad cf geacfd dafbcg cbgaed fabc cfg cdgbf | dbcag cf cebagdf gfdbe gdbef ecdgb efcd cdgba fabdeg fdcbeg faegcb ecg fdegcab ce | bgefcd gcdba bgdef egc gfebd abd cdfbga gcdea edcbfg abfe ba gebda dbeacgf eafdbg | beagd egdba ebdfg fdageb gafbcd bc bac fgeba fbdega agbec febc egadc bcfgaed beacfg | agbfe cfbeag gceda adegbf cdbg gfcead db gcbfde bdefc gefdc bdf fcdbega fecba dagbfe | dcabgef fegcd bgdc cgfbead bagcde efbcgd adgef fgaecdb bfeacg eabfg cebfg eab ab cfab | eafgb bacf ab eba ed dcfbeag dfcga cedb cbfae fgdabe dbcefa fbagce dfe dacef | afbgec de cadfg de dgc abfedg bdgea cbfde dfcgab ecag gbcdae cg gdfbcae gcbde | afbdeg dgabec begad gdc befcd dg bgacf fbcegad dgb gcad gbcdf fagdbe bfcage gfdcab | gdabef fdecb gcda agcd cb bgdcfe bgacefd fdgbe edcgb cegad cbagfd dbefag bdc efbc | cgade gbfaecd bcd cbdge adfcge afgd acfeb efcda da gdefc cegfbd bcegad fdbcage cad | defgbc aebgdc dgfa cadfeg gacdf bdg aegbdc bg debaf bfeg gadfbce gfbdea cfbeda gdfba | bg fgdca bg gb adbecg dfa fd gafbe gefda cefgda ecdag efdc abdfcg egbcdaf | fegba gfadec fadeg efcd ecfgad gbae ecdag ba agbdec bac fdabgc edabc cdgeabf cbfed | dcfeag cbegad cefadg gdebca fgbca cge gcefb gadebcf eabcfg gcadbf feag eg fecbd egdabc | ge afgdbc fgdbac egc eadg eadbc gfbcda badefc gdc fcgbe dcbge acfgbde dacgbe dg | cgd egbcd gcdfba agdbce ga befgac fcgedba fabced agfce edgfc gbea aebcf acg cagfdb | gecdf afebcd bgdfac cga ================================================ FILE: advent-of-code/2021/inputs/09 ================================================ 9987675345698765453987654321234589999899878923493212345678999998656782467898999899878301234578998787 9876543234789765322398743210123567898789767899986101239899789876543101567897898798763212355989987656 3987784014897654310987654331235679965697644998765232345997654989765212799956999679854343466799976545 2199875323998765421298776542346789434595433498754345456789543499876353489549876542975858977899876439 1012965439899896432359987667457896546789322349987656987898932445987454578932987621986767898943989598 2125976598798989943467898876589999858899910959898767898976101234598966689431298320987898999432399987 3234987987656579894578989987679998769999899898769879999965422345679298995420139434598999896543459875 4346799876545456789679877898789769878989798799656989899876563496799109989591298548999689789656598764 5956998765434345698989765679895456989678679678943496789988689989898997979989987657987565698787989543 6899898764321234567999876989954345696534598789432134679999799976987656765778998769766464989999865432 7987679653210155789999997899875456789323999899521012345899899765698943254667999898954353578999654321 9696598654323234589788998998986567898919894958933423456789999753459892123458998987893212467898765432 8543498765434545679567899987987679987898743147894934567898989432398789334767987876789101298989876543 7656789878545656789338989876598789986797654235679895678997878941987678975879896545698914345678987654 9868998989656877892129678965439899975498754346998796789986867932954569986798765434567895458989998765 8979987798787898921012567894321999874329985459876589899985457899873458987987654323469986567899869876 7899876549898959999923456789432398765909876567987678999875322987654567898998773212378997698998754987 6534997831999943987894567897543999899899987878998789789964201298765678919679654323456789799987632399 5424598942689899876789678987659899988788999989019895699865362349986989103498795434567899899996549989 4212349653498789765699989798798789877697898999999924789976457899798993212379986747698946999897998878 5334569878989678934998995679987678954545987899789935689987567987649898763467897858789235798789887867 6446878989876569976897893459876567893239876797689898789397679893234789654598998979999546999698785458 7557989199987457898956789998984348994124965323486789895498798789123569875989109989898969898598654345 8998994398796346899545699876543236789549876412345678979569987679023456989878992398767898767469643234 9999689987654235695434689987652125678956987954456789768979876568994568999867989987659999955398759345 7887578976543123489545679698983234789768998765677993457899765456789878997654878998767899843229898956 6543469998768245678956789529865445899879999896798912349998987347899989989653467899879998732019987897 7672398999875456989767895439876556789989989999899102356987798456789899878932356789989987643498976789 8954987899986567899878976546989667993498979978976212469996549567895798969991245699899998754987685698 9769876989987898901989997656898789101997768769895433498765439878934987656789346789788999869876564567 9898765778998979312397899767999893249876753656789656569976524989423976546789498997697986998765473456 3987654569789765434456976978999974756965432345678987678987734694319887635689989998456894219874321567 2198733477678978645797895989989865669876543766799998789599848789998765212678979999367975323985432378 3989821234568999756898934599878976798998754567898999897679959899899874323599867895459876434596543458 9876432347679549887969423498969987897989865698997899979898767998798765435679756899567987546987654567 9876543489789832998953210987658998996579878789876588965939989987659987546789645688979987657898785678 3987654579898721239998723976547899987467989999995477894321098765545698687895436577898998898999896789 2398766789989654359899644597656999876345697679654356965434197543434989798954323456987899939998987893 1239887894678965498788987698987999765234789598765467896545976532129879899996534567896789123976798912 0945998923567896997687898999298987653123696439876588987679876549098765945987965778945693239875459901 9896789434678999876575999899399199762064594321987678998789989698987654326599878989238789459954345899 6797898645789998767434598798989349872165689410198989769899898997898543212367989994345678998986254678 5789949756894987654323497687878959989278796521239797653998767876799654302456999965456899987432123689 4569439887893998799934598576967898995478897432345698992989545665698775212567899876697899876543234567 5678921998969899987899974475459997898567998945456789989878932124569854323498976989989965987654345678 6799990199656789876798863212349976987678999896897899879767893234698765434578965699878974598785458789 9899989989543298765987652101267895999799998789998998968456789345999879545679854598767943459987569893 3998979678932129894598543323458934889934987698999987654345895469876997656789765987659894567998678942 1987667569892099989679656445667895679899876597896596543256896567989998789899876798547689978999789531 9876553456789989878998767986898996798788995456789987752125789678998999897999987899534567899989898940 8765432345679878967999899597959789987576789347899876543234589789987899975689999987656789929876967891 8764321234698766556899995329345678987455678956789989684348678999876798764567898998769893212975456932 9863210123459654345688989910258789876323589969894398765457789998765679923459987869878999109864349894 9854525234598743234567979891345897995474567898989239878767899997654567895678996555989998919753239789 9765434545987655455679865789457896986567678967878946989878959876543456789789789434599987898954398679 9896565656898766767999954567978965497678989656567898998989245988652346799894698765679876767895976532 9987879768999879879878323489989654398789893432349899987690159899721278967923989876798965456987987699 8998989879988989998965412397898765219899762101234789996521998798754367899999878987987654347898998987 7659395989876897987654323456789898323998753242345678989439887699865456899989769999876543236789019986 8543214598765456798987654589896987536789894355456989879598754589876967999877658999997655345678998965 7654323679876578969999865678945698545678976566567898769987653479989898998766546898998786457799987654 8795498793997989657899976789234987657799987677678965657898794567998789987653234567899898568899998723 9989989932398996546789989890123498968989998788789654346789887679899678996442123458901987678999899812 9878879993989875237899999989254989979878999899898766869895998997676567894321015667892398789999798923 7767767989878943123978999878969978998967899922939878998953219876565456976534124578943469999988697654 6553459876767894234568986767898767987656789210125989987994101985432389997645234567894590129876598785 5432345985458995679799875456989659876545456991234899876789919996676569987656545678965989239988439986 4321359894346789789987654345678943965434345789546799765679898987787878998787656989879879998895321298 5430198765497899894298763234567899876521234899987987654598787999898989109898767899998967897654210129 6541679876989945999987654345678989987752345678999999766987656579999793212999878999987656789775323234 6432589989877899998998765476989978998843459789998939878996545468989654329989999998798787894989876545 7543458998965778987679976687898767898754678999987923989876432345678976498978989987659898943497987676 8654567987854567896563987798998656899865789019876894599987321238789098987967878998743989932346798888 9766779876543488997432398899987745679877892198765789998765450139989129876754568999974567895459999999 9877898765632356789543459921096434567988943989654567899986521234678998765323467899865679976598897912 9988987654521237989699567899987558978999659876543457899987634656899986544212456789877889987987656893 9999996543210357678987998998998667989431968997652346998998785667901997432101348995998994398996545789 8932987987631234589476789987689978999599878994321345997899996778929899546712467894239987469997434679 7891098876546349679345678965578899998989989989935459876979897889298778994324578943190296599989323567 6989129989865478993234567893456799987878998776896567965468789990199656989435678954989987989978934569 5678949999976569310123689932345689876569899565789778984345688999987645678945789769979999878767897698 4567898999987679453294594321017992985498765434698999993234567898765434899656899998768999765457898987 7698987898799789564989695532399891996309899323456789832125678919876325999797999887657987654346789876 8999876789654998679879989649989799876212987437899898761012348901985476789898998765431298743235689985 9899965689543249998765679998767678965429876556945987652125667899876787899979459963210139852123798954 8788754799932129879654587789656567896578987987899876543234799998989898998764349854321298764234567893 7656543458794298965443445678932456789789598998901997654345678997693939789943298765432359879876899952 6543252345679987654352237899751577899895459789212398897656889986542124599892109887545456989987896541 8432101489989999875210128932967698998901345699924569998767994987431023999789213998676569995699965430 7654312678999998996321239999878789767892396989895678989879993976545129897678954598789678934567976521 8976433589998767987542356789999891557789989978789789467998989897685398789569899989899789325679897432 9987544567899655698653468999987910345679878765678992345987878799896987667348798976949895434599789545 9999655778999543219766567899876621234598765454567891249876567689929876543237667895435976565987679656 8798789989988959309877678999765432545699654323479910134995456578912997632123456789523498878996598977 6549891299876898912988989789876547686987543212567891239984323469329876321014567898654569989985456799 1234932997764667893499995678987658798998654403459932398765012478998765432125678979866789699876345678 0356799876543456994567894567898967899019873212378993987654139989219876843336789565977896579843234589 1235789987532345789978943456899878978929764323456789398543248892101998765459895434598965498765445678 2356897698421234567899432346789989767899875435668891239654356789432789887567976323699654329876786789 3567896543210246788987541457892499848921986546879910129767568996545699998678988434789543210989897899 ================================================ FILE: advent-of-code/2021/inputs/10 ================================================ [[<[<{[<{{<[{(()[])[[]()]}[((){})<[]{}>]}<<{[]{}}<(){}>><([]<>)>>>[[[<<>>[<><>]][<<>>(<><>)]][{ ((<[(<<(<{<((<()<>>{()()}){<<>><()[]>})([{<>{}}(()[])]{(<><>>})>(<((()())<[][]>)>([(<>{})({}())][< <<<(<<[[((({<([]<>)[[]]>{<{}>{(){}}}}{[<[][]><<>[]>]({<><>}{()<>})})[<<({}())(()<>)>[([]{})<[]()>]>({[[] <(<<<[((([{({((){})<<>{}>}[<(){}>[<>()]])[[<{}[]>({}{}]](<<>[]><[]<>>)]}](<[({[][]}<()<>>)<[ {<<<{[({{(<<(<<>[]><[]()>){<[][]>{<>{}}}>((({}())([]<>))[<{}{}>({}())])>(<<<()[]>><<<>{}>(()< {<{<<[[(<<[{<<{}[]>>([<>()]{{}{}})}]<(<{<>()}{{}()}>{({}[])<<>()>})>>>){[{[{<[[]{}][<><>]>}{(<{}( (((([(({((<[<(<>{})[{}{}]>](<[()<>]{<><>}>)><<[<[]{}>((){})]<[()[]]>>{[{<>()}((){})]({()[]}(()[]))}>))}( <<[(({({(<{{((<>[])[[]<>])([<>]{()()})}<<{<>[]}><<{}()>>>}>)(<(<{<()[]><(){}>}{{(){}}[{}<>]}>{ (([[{<[<<{[<{<()[]>{<>[]}}{<{}{}>{[]<>}}>[{<{}{}>(<>[])}]]{<<({}[])>(<[]<>>[{}])>({{<>()}(< (<{{(<<{[([<<{()[]}>{({}<>){<>[]}]>((<[]{}><{}{}>))]([{(()<>)(<>[])}]<<((){})<<>{}>>[(()[]) {{[[<<{<{{{([{()[]}[{}()]]{(<>{}){<><>}}){<[[][]][()[]]>}}<{{<[][]>[{}[]]>(<<>{}><{}{}>)}>}}<<{[{([]( {[<({{{[<{<{[([][])]{({}())<[][]>}}((<(){}>{()<>})<<<>{}>>)>}(((<{<>{}}<{}()>>)[((()()))[<<>{}>( {{{[{{[(([{{[[{}<>]([]<>)]([(){}][[]()])}[{{[]<>}[{}()]}(<<><>>]]}][[([[[]<>]<<>{}>][{[]{} <<{{{[{{[<({<<[]<>><{}<>>>}[[{()<>}{[]<>}]({(){}}{{}()})])[[(<<>[]>[[]])[{{}{}}[[]()]]]<(( ({{[{{{{<[[({[{}{}]{[]<>}}<<()<>>(()<>)>)<{{(){}]<()()>}{{(){}}[<><>]}>]<<({{}{}}<(){}>)([{} {([[[<<([[{{[<()<>>(()<>))({<>[]}(<>{}))}{(<{}()>{()[]})}}([[{{}[]}<[]>]<([]<>){<>}>])]<{[[([]{})]{(<><>)[[]< ([<<([<[[({((({}[]){[]{}}){({}[])({}<>)})>)[(<{{{}{}}[(){}]}(([][])<{}<>>)><[[<><>]{<>{}}]{{{}[]}{[][]}}>)<[[ {[<<{[<{[<{[[({}[])({}<>)]<<{}{}>{{}()}}]{[[<>{}]<[]{}>]}}(([(<><>){[][]}]([<>()]<()[]>))<[<()<>>(<><>) (<[<[(({{<{<<[{}()]>(([]())<<>[]>)>}[{<[[]{}]([]<>)><{<><>}[()<>]>}{{{(){}}{[]{}}}}]>}}){{<{([<([]())({}()) <<{({{<[<[{([{{}<>}{<><>}]([(){}](()[]))){[{()[]}<<>()>]({()()}({}()))}}]<[<<(())(()[])>>{(<{}<>>{ {{{(<<[(<[([[[()<>]<()[]>]]{[[[]{}]{<>{}}]((<><>)({}{}))})]([(<{<>()}{[]{}}><<{}{}><<>[]>>)[<<()[]>((){ [{(<<{[<<([{[<[][]>][{()()}({}())]}]([{([]{})<{}<>>}(<()>[{}])]{<([]<>)<{}{}>>(({}<>)<<><>>)}))>([[((<<>{} [[(<({{(({{(<[{}<>]([]{})>{[<>[]]([][])})[(<[]<>><{}()>)[<{}()>(())]]}<[<[[]{}]<{}{}>>{<()()>({}<>)}]< ([(<({(<{{(((<[]<>>{<>()})<{[]{}>([]{})>)[<[()<>]({}[])>[(<>{})(<>[])]]){<((<>{}){()[]})><{<[]<>><<><>> ({{<({(<<({[[{<><>}]<<<><>>({}[])>]([<[]<>>[{}()]]{{<>{}}({}[])}}}<{({[]<>}({}{}))[(<>())(<>())]}((([]{}){[][ (((({[(<([<[(<<>>[[][]])<{<><>}[{}<>]>]{({<>()}(<><>))(({}<>))}>])<([[<<()<>>{[][]}>]<[[[][ [<<(([({((<<{({}())}[(()()){[]<>}]>>){({<[{}{}]<<>()>>{<{}()>}})})})])[[<((<[{([<>()][{}[]])((()[]) {{{<{[[(<[{{<<{}()>[{}<>]>{({}{})<()>}}(<[(){}]>(<(){}>[[]]))}(<<[[]{}}({})><[<>[]]{<><>}>><[<[]<>>{<><>}]((( {<[[<[{{<((<[<<>()><[]{}>][<{}()><{}{}>]>)[[[[[][]]<()[]}][([]{})(()())]]])>[[((<{[]<>}<()>><[{}[]](<><>)> <{([{[{[{([({<{}[]>([]<>)}[[[][]]<()()>])[<[{}()]>{<<><>>(()<>)}]]){({(<[]<>>([]<>))[(<>){ [{{<(({<{[{<{({})(<>[])}({<><>}{[]()})>(({[]<>}(<>{}))[{()()}{{}<>}])}{<{{<>()}<[]{})}(<()><( {(<[{[[{{<(([{{}{}}<()[]>]<[<><>]>)([(<><>)])){<<{[]{}}[[][]]>{[[]<>]{<>{}}}>[<<[][]><<>()>><<{}<>>[<>()>>]}> <[{{(<<{{{[[{<[]<>>(()<>)}<{()<>}{<>[]}>]<[<()()>]{<<>>([]())}>]{([<<>{}>({}<>)])[({{}}{[]<>})[ <<[[<<[(<{{{[{()[]}([]())][[[]]((){})]}}(([{[][]}[()()]]<<()>[{}[]]>))}>)<{({{<[[][]]{()()}><<{}{} {[<(([([{({([({}()){<><>}][((){})([]())])[<<()<>>(<>())>{[[]()}(()[])}]}<{{<(){}>{()[]}}((<><>){{}<>})}(( {(({([[{{((([<()()>([][])]<<{}[]>[<>]>)(<{<><>}[{}{}]>[[<>{}]]))[{<<[][]>[()]><[{}{}]>}{<([]<>)([]<>)>}] (({[[<<<{[{([(<>[])<()[]>])(<([])({}{})>)}[{(<<>{}>({}<>))}<<[<>[]>[(){}]>(<{}{}>)>]]{([[<<>()> [{[[{([({[{(({()[]}[[]<>])<[[]<>]([])>)([{{}{}}[{}[]]]<{{}<>}>)][<(<<>[]>{<><>})<(()<>){[][]}>>[[{[]{}}([]()) ([[{({([({<<(<[]<>>)[{()[]}<<>()>]><<{<>()}<<>[]>>[[<>{}]<<><>>]>)<<<<<>[]><<><>>>[[[]]]>[{ [{{([(<[[<{((([]{})[()()])[<[]{}>[<>()]])<[{()()}(<>{})]({[]}[<>{}])>}((<{[]()}>)({<{}{}>[ [[[{{[[[<<(<(({}())[<>{}])<{{}<>}(()())>>[[((){})][[[]{}]{()}]])>>{[(<([{}{}]({}<>))([{}()]<<>[]])>({< {<{({(({{{[{<(<>{})>{<{}<>>(<><>)}}<(<[]()>[[][]])<[{}()]>>]<{{<()[]>{{}()}}{<{}[]>{{}{}}}}{{<()<>><<> [{[<{[<<({(<{{<>()}({}<>)}<(<>[])[()()]>>{{{<>()}{()[]}}})<{<({}()){<>{}}>({<>[]}({}())]}>}( [[{<([((({([{{()[]}<[]{}>}({<>[]}[<><>])]{{<[]<>>[<><>]}[{()()}[<>[]]]})}[{[<{()()}(<>))<({}){()<>}>]([ (<(<{[{<({[{{{[]()}({}{})}{<{}[]><<>{}>}}]})>}<{[[(<[<[]{}>([]())](<{}>[()()])>)][(([{[]<> <<<<{<{<<[<({<[]>({}<>)})<[{[][]}[[]()]][[{}<>]<{}[]>])>([(([][])[[]()])<[{}[]]{[]{}}>](<[{}()]{{}()} ({[[([([<{[[({()[]}[<>[]])[<[][]><<>{}>>][(({}{})(<>[])){(<>[])}]]<{{{{}()}[<>[]]}<[[]<>]([]())>}>}{<{({ ((<{<{{[((<<<(()<>)<[]{}>>[<[][]>[(){}]]>>)){([[[[<>]({}<>)]{{{}<>}([]{})}]<[<<>()>(()())][{[]{}}{[]<>}]>] {<<{{[({[<{{(<{}[]><<>[]>)([[]()])}<[{{}{}}{<><>}]<({})<{}()>>>}<[([{}<>][<>{}])](<<{}[]><< {[{[[<<[(({[(((){}){<>[]})]([[<>[]]][<<>{}>[<><>]])})({<[({}[])<{}[]>]>}<(<(()<>)[[]{}]][[()()][<>< ((<<[({<{[[({<[]()>([]())}[<[]{}>(()<>)])]<<{[{}[]][<>()]}><<{<>[]}[()<>]>[<[]{}>{[]()}]>>][(({[<> {{<[{<([({{([<<><>>{{}()}][<[][]>{[]()}])[<[[]]{[]<>}>]}(({<()[]>[{}()]}<[[]<>]{<>()}>))})])<{[{<[<[{}{}] [(({({[[<{(<{{<>[]}[()<>]}((<>{})<<>[]>)>{[<(){}>{{}<>}]])[<{(<>[]){{}[]}}([()()][<>[]])>((({}()) {(([<{([[{([<<{}()><[][]>>[(<>()){()[]}]]<[<()()>[{}]]([{}<>][{}[]])>){<{[[]<>]<<>{}>}{([]{})}>[([ <{[{({([(<<{<[()<>]<(){}>>(<()>{[][]})})>{[([<{}{}>[<>()]])[{([]()){<>{}}}<<{}<>>>]]})])([<(([{<(){}>[{ <<<(([<[{[[<{({}()>{[]()}}>]]([<[[()][{}[]]]<[()()]{(){}}>><<({}[])(()<>)>{(()[])}>]{[(<[]()>)[{[]{}} (({(([[<{(<{[(<>[]]]}<(({}{}))([[][]]([][]))>><[{(()())[()<>]}<{(){}}>]>)((<{{()[]}{<>()}}<([ [[[{<[{<[<[[{(<>{})<[]()>}{(()[])[<>()]}][<({}()>[<><>]>{<[]{}><[][]>}]]><<{[{(){}}{{}{}}][<<>< ((([<<((<[{(([<>[]]([]{}))([<>]{<>()})}([[(){}][[]()]][(<><>){{}()}])}{[<[()<>]({}<>)>[<{}{}>]][<(<>())<[] {<<{([(((([{<[()]{(){}}>{{{}[]}}}[{(()[]){()<>}}{<<>>[<>{}]}]]<[{(<>())(()[])}]>){[[<({}{})[()[]]>{[{}( ([{(({([([(<<{<>[]}<{}<>>>[[[]{}]<[]{}>]>((([]<>)<<>[]>)[[(){}]]))[<{{<>{}}}[(<>}{()()}]><{<<>{}>< {(<[<{({([{{([[][]]>({()()}[[][]])}[<(()())([]())><(<><>)([]{})>]}[(({{}{}}{{}<>})([<><>]<()[]>))] ((<(<<{{{{<{{(()<>)({}{})}{{<>[]}<()[]>}}<<<[][]>(()[])>[[()[]][[]()]]>>[[{{[]{}}[[][]]}][<[()[]]{[]<>}> (((<(<<<{{<{<{{}{}}(()<>)>[((){})[()[]]]}{[[<>[]]{{}()}][{()[]}({}{})]}>}}>{[{<<{[{}()]}<[[]()] ({(([[<{[{<(([[]()](<><>))[<{}[]){{}()}])(<[()[]]<[]()>>[<{}<>>[()<>]])>[<[[()()]<<>[]>][([]())([]{})]>{{<<>( [[(([((([<[[<{{}<>}({}[])>[([]<>)[()[]]]]<[(()())({}<>)](([]<>)<[]()>)>]>[{{{(()<>)}<{[]()} (<(({[<<{((<[[[]()]{{}<>}]<<{}()>({}[])>>)<{{({}){()()}}<{[][]}>}>){[(<<[]<>>[{}{}]>{{(){}}{[ {<(<(<<{<(<{{[{}[]]([]{})}([{}[]](<>))}[([<>()]{[]{}})<({}<>){<><>}>]>[{<[[][]]>}[<[<><>](()())>(([ {(<(<{<(<<{{{<(){}>}({[][]}{{}{}})}}<(<<<>()>[(){}]>(<{}()>{{}}))>>[{{[{[]{}}(()[])]}[((<>())<< ([((([[{([{<<((){})>{{<>}{[]()}}>{[((){})<()[]>]<{[]{}}[(){}]>}}{((<{}()><{}>)){{<{}[]>[[] {{{(<<{((([[{(<>{})({}())}[<[]()>({}{})]]<<[{}]>{[[]()]{()[]}}>]{({<()[]>((){})})<{<[]<>>{{}{} (<<[[([{{(<<({{}}[{}{}])<([]{}){<>()}>>>(({<()()>({}[])}<<{}()>[(){}]>)))[{([{<>[]}([]())]([()()][<>{}])){ <(<(<<<([[[(<{{}[]}{{}[]}>[[<>()]{()[]}])]<{({{}()}{{}<>})<({}[])([]<>)>}{(({}[])(<>{}))((()<>)<[]()>)}>](< <<{(([<([[[[<{<>()}({}[])>{((){})[{}()]}]}[<{<<>[]><[]<>>}<[{}<>]{{}()}>>{{(()())[()[]]}{<()<> (({<<[{([{<(([{}[]][(){}])[<[]()>(()<>)]}>}<[(<{{}()}{{}<>}><[[]()][[]()]>)]<(<(<>())>({<>[]})){[{(){}}<{}{}> ({[[{[{{<(([[[{}{}]<(){}>]((()[])(()[]))]({([]<>)({}{})}{<<>{}>{<>}}))<{(<[]{}>(()()))[[()[]](<><>) ([{[{{<{{(<[((<>){[]()})(({}())[<><>])]>({[(<><>}{{}[]}]{(()[])[()]}}{([[]{}](<><>))<<{}[]>(<>())>})) <[(([[[<{[[(({()[]}<<>[]>){{<><>}<(){}>})<([()]{<>[]}){{<>{}}}>]]<[{{([]())({}{}>}<{[][]}<<>{}> ({(<{<([[<{[<{[]()}[{}<>>>[[(){}][[]{}]]][{[()<>][<><>]}{<()()>}]}<({{(){}}<()()>}{[<><>](<>())})[( ([({<[<[{({<<[<>{})[<><>]>{{[]{}}}>[[{()<>}([]{})](({}<>)<<>>)]}<{<<<>>{()[]}>}<{<[]()>}>>)(<<<{ ({<{[[({[([{[{[]{}}{[]<>}](((){})({}()))}]([<{<>{}}{()<>}>{({}{})(()())}])}]<{({{<()[]>{()}} ({[[{[((<[[[{<<>[]>(<>[])}]]{<({{}[]}){[{}{}]<<>()>}>[([<>()]{{}()})(<()()><<>[]>)]}]>(<([{<[]{}>(()())}<{[ [<<<{<({({{<{[<><>]{{}<>}}{<(){}>}>}})})[<<[{[{({}{})<<>>}[{[]}(()())]]{{([]())([]())}{({}[])[<> <<<[[((<{{<(((<>[])(()))<<<>()><<>{}>>)<[{<>[]}{(){}}]{[{}]({}())}>>}}[[((({()}{[][]}){<{}[]>} (<[<({[[{[<<[(<>[])]([[]<>]<[]{}>)>({(<>[])([]())}<[{}<>)<<>{}>>)>[{<[[][]]><[{}<>]<[]()>>}<<[ {[({<<<<(<([{{[][]}}]{<{<>()}<<>()>>[({}())<[]{}>]})>)>>><<<{{((([{}[]]<<><>>)[[[][]]({}[])])<{<{}{}>( [[[({((({<([({[][]}{[]})<({}[]}[{}{}]>][([[]()]([]()))<<()<>>>])<[<<()[]><()[]>>]>>([<<{[]()}{[][]}>< [{{<<<({<({(<<<><>>>{(<>[])[<><>]})<(<<>{}>(()()))[{{}()}{(){}}]}}[(<{[]()}<[]<>>>({<>{}}[{} ([<<{<[{([<[<{<>{}}<[]{}>><([][]>>][{([][])[()()]}<<[]<>>>]>][{<({<>()}<[][]>)[[[]<>]{()<>} ({<<[<(<<<(<((()<>)<{}<>>)>)<<([<>{}][<>[]])<<()()>({}[])>>([(()())(()<>)]{{{}<>}<[]{}>})>>>>[ <{[{<[[<[(<{({<><>}{[]<>}){<[]{}><()>}}({({})[[]{}]})>{(<{[]<>}{<><>}>([{}[]]{<><>}))(<<{}()>[ <{{<[[({{{<({<[]()>[{}[]]}<{<><>}{()<>}>)[<<[]{}>{{}<>}>[<<>[]>((){})]]>}}(<[[(([][])[{}<>]){(()<>)[()[]]}](( [{[{<[(({{({<{{}{}}<()()>>(<[]<>>{<>[]})}(<<()[]>{()<>}>))<<<[{}{}]<<>[]>>>[[{[]{}}]((()<>){<> {[[<{({[<(<((<{}[]>){[{}[]]})[{[{}{}]({}())}]>(<{{()<>}(<><>)}[(<><>)<[]{}]]><{<()[]>([][]) ================================================ FILE: advent-of-code/2021/inputs/11 ================================================ 4836484555 4663841772 3512484556 1481547572 7741183422 8683222882 4215244233 1544712171 5725855786 1717382281 ================================================ FILE: advent-of-code/2021/inputs/12 ================================================ BC-gt gt-zf end-KH end-BC so-NL so-ly start-BC NL-zf end-LK LK-so ly-KH NL-bt gt-NL start-zf so-zf ly-BC BC-zf zf-ly ly-NL ly-LK IA-bt bt-so ui-KH gt-start KH-so ================================================ FILE: advent-of-code/2021/inputs/13 ================================================ 792,394 1124,850 1208,850 721,173 1057,252 1119,182 1017,402 485,58 773,880 1171,197 661,546 218,628 574,693 673,316 393,157 1071,822 898,826 152,574 1114,791 107,777 669,264 1292,54 1092,628 415,31 387,733 234,576 652,742 599,40 308,327 147,640 219,635 831,310 246,604 725,49 103,761 756,0 562,352 47,17 725,364 70,310 218,180 68,453 1310,100 1134,175 738,340 586,5 902,610 1064,540 900,803 1002,392 151,282 1174,357 464,406 560,385 656,732 585,754 805,189 813,197 669,581 816,322 191,712 396,495 643,394 956,462 341,182 591,372 654,856 174,571 955,352 678,268 162,754 92,318 231,544 681,425 683,640 698,271 756,217 69,306 1054,544 591,820 1168,632 293,868 70,584 796,44 607,60 639,494 47,381 984,431 248,864 915,432 151,476 84,628 924,77 1305,703 246,156 1161,252 1250,686 177,301 351,731 1228,773 743,290 928,266 1258,749 771,633 701,218 386,525 315,534 557,176 1230,610 846,14 671,481 561,546 97,88 629,148 1017,625 684,749 1133,700 244,803 1241,754 678,593 956,432 749,58 895,415 969,805 156,93 738,380 518,537 989,546 815,138 190,425 354,432 1213,168 8,627 175,870 792,842 812,530 982,431 1218,679 852,567 607,821 244,106 15,323 738,513 658,742 711,696 490,243 674,105 1295,123 1230,121 812,205 512,607 1053,770 166,124 18,54 354,462 130,852 1089,260 949,868 102,436 514,850 969,294 515,249 894,166 321,796 1228,65 0,319 831,472 567,256 259,14 1208,44 1087,285 572,737 494,180 346,327 574,816 739,14 1054,360 159,586 1289,784 1227,14 313,294 830,324 224,281 731,722 1084,252 1047,225 1049,280 1241,724 833,252 97,168 810,674 0,78 798,607 1039,422 1079,817 1191,411 1178,456 69,276 955,800 503,724 995,534 1230,773 641,40 995,170 783,397 52,145 1120,425 218,266 341,406 989,572 1046,588 798,847 308,565 468,850 689,44 353,298 1302,575 1241,276 184,849 654,879 874,189 242,236 798,728 348,38 314,362 185,222 189,329 639,379 933,777 97,768 1006,828 1203,777 756,677 909,700 308,329 75,172 703,60 1205,186 1235,274 328,185 1283,248 0,812 574,793 524,791 190,388 119,483 20,856 771,261 12,847 1099,274 637,871 661,309 753,768 1213,840 557,54 55,441 895,31 1255,483 905,868 100,448 1001,578 425,54 585,364 492,306 490,94 684,145 567,514 759,313 107,35 982,157 498,364 82,592 775,483 960,716 716,830 1031,610 591,746 716,840 815,756 1006,77 874,628 927,259 720,408 820,778 1213,768 1241,618 1231,882 629,597 1136,324 422,161 835,494 58,390 949,381 656,856 420,766 1111,397 162,530 579,172 989,479 1235,172 875,323 736,688 1247,148 144,567 239,72 341,145 525,599 1299,394 267,385 68,47 15,571 950,7 304,828 970,850 569,868 1029,852 889,388 263,673 584,103 479,472 715,609 144,327 502,403 107,117 164,116 49,777 244,66 560,161 668,47 656,879 222,436 244,408 1120,388 410,829 1292,567 341,600 92,576 753,270 1266,511 803,133 846,388 594,840 465,329 1121,565 1235,620 606,826 1154,801 479,310 560,509 219,873 1252,390 321,770 668,831 913,618 813,479 407,432 888,733 721,273 391,221 436,33 1283,808 1302,627 497,124 1151,586 326,463 1033,777 0,100 719,746 1158,570 1123,197 1081,54 421,388 184,837 539,485 551,133 72,715 141,248 980,70 1066,408 1131,761 894,728 479,24 1235,243 970,44 271,472 835,718 825,164 731,875 166,180 224,165 1213,880 142,632 293,298 157,645 263,221 1047,359 962,38 818,588 950,887 579,203 377,117 833,28 798,632 13,761 721,721 586,441 1148,82 654,364 955,542 1160,735 1037,658 47,205 574,649 1150,124 1300,768 504,607 1042,212 1039,472 644,403 324,852 848,530 463,182 584,758 1057,194 1092,413 375,732 1068,236 813,322 400,491 13,133 82,554 1148,100 328,431 410,106 458,119 571,880 45,478 848,476 656,127 585,845 1133,301 507,472 242,864 239,516 673,871 436,180 813,170 1178,438 1171,25 386,56 426,38 436,628 999,805 142,680 549,708 1052,889 1168,831 1297,294 711,521 743,828 42,271 788,8 1181,564 1295,323 187,697 982,610 579,143 895,863 264,588 1134,607 1285,746 875,635 477,28 833,866 749,721 667,276 750,665 433,858 621,492 1169,646 999,89 1266,831 572,65 726,794 43,187 550,593 557,768 0,261 989,25 805,705 321,255 1168,383 1279,147 639,413 386,838 1240,346 960,178 45,676 462,530 812,364 141,646 1176,754 1223,72 293,65 753,840 151,394 572,380 383,787 1159,758 585,140 570,628 673,764 566,504 661,863 792,264 273,684 748,679 1150,322 1156,743 102,44 1043,285 1146,116 914,495 785,599 726,100 1284,460 326,157 79,208 1208,14 465,777 134,413 656,767 1263,513 127,3 464,506 253,194 413,250 711,5 490,564 689,850 1238,43 383,259 175,724 335,143 734,42 915,686 157,724 1223,378 410,381 724,889 808,491 989,869 704,68 676,568 1006,716 890,548 60,830 170,577 1159,418 268,369 169,282 877,858 1077,500 807,700 65,721 847,182 1245,88 590,856 494,770 1168,680 855,137 915,208 1255,889 621,596 1115,523 1088,514 360,7 127,845 266,830 1159,164 218,842 151,730 792,182 1154,241 82,302 681,148 1293,871 520,140 877,708 388,837 80,793 1203,117 590,38 253,700 572,554 1305,31 1205,708 647,255 388,178 807,724 1056,403 10,768 0,816 458,775 1228,605 1202,413 1043,161 1261,777 406,30 68,889 711,373 361,868 1071,68 816,770 147,400 574,773 184,57 1242,47 79,882 654,486 1057,700 939,259 561,58 1210,448 293,401 293,268 1285,148 151,500 1042,682 1216,217 1265,478 923,733 626,537 431,733 1053,796 599,889 537,880 890,766 505,257 87,290 909,642 333,137 177,28 835,133 435,635 134,637 1163,494 1277,492 518,52 654,38 495,756 628,14 1176,413 75,243 914,5 522,886 28,749 1044,126 1263,821 522,438 60,208 1059,722 989,255 629,425 681,597 75,620 315,360 373,404 398,437 621,850 494,124 924,212 1146,800 321,415 42,623 927,787 455,3 25,746 1017,401 555,785 231,817 816,180 2,600 1088,436 1285,597 232,161 97,880 753,176 271,295 26,460 0,651 654,767 401,252 55,779 1049,614 44,383 937,490 1305,863 498,812 841,222 903,432 684,537 795,645 924,525 562,215 634,568 989,757 105,186 527,891 488,572 835,581 720,856 1071,516 758,880 93,642 328,463 790,413 1088,458 875,123 321,25 1255,779 190,889 830,570 261,280 1250,830 1148,794 490,116 1302,267 920,588 1163,400 721,621 340,44 1124,551 1052,271 1002,567 561,721 355,103 689,420 664,319 0,162 592,329 80,773 428,194 1176,140 1044,840 576,42 927,821 69,124 1165,316 663,255 1071,72 1076,410 1265,218 1145,514 93,194 982,289 397,618 326,737 129,564 797,248 433,708 520,418 898,266 350,178 436,861 179,761 977,869 1217,642 812,812 1154,93 1277,599 552,880 790,476 156,129 676,326 186,850 20,38 626,145 261,621 1225,868 0,530 957,298 222,514 725,845 375,162 682,686 935,162 408,380 85,868 475,581 902,514 435,21 557,278 271,422 803,176 888,161 1126,849 514,467 139,249 1124,343 477,642 527,845 551,581 820,330 176,175 1245,806 256,534 142,383 140,663 539,633 512,632 390,588 232,677 1039,73 403,751 584,584 567,520 900,856 498,530 996,810 594,656 954,649 1240,310 763,329 621,44 6,129 1217,252 738,604 1263,60 1290,326 682,432 673,130 25,148 152,324 65,544 1171,249 17,316 199,399 654,548 393,737 fold along x=655 fold along y=447 fold along x=327 fold along y=223 fold along x=163 fold along y=111 fold along x=81 fold along y=55 fold along x=40 fold along y=27 fold along y=13 fold along y=6 ================================================ FILE: advent-of-code/2021/inputs/14 ================================================ SNVVKOBFKOPBFFFCPBSF HH -> P CH -> P HK -> N OS -> N HV -> S VC -> C VO -> K OC -> C FB -> S NP -> S OK -> H OO -> N PP -> B VK -> B BV -> N PN -> K HC -> C NS -> K BO -> C BN -> O SP -> H FK -> K KF -> N VP -> H NO -> N OH -> N CC -> O PK -> P BF -> K CP -> N SH -> V VS -> P BH -> B KS -> H HB -> K BK -> S KV -> C SF -> B BB -> O PC -> S HN -> S FP -> S PH -> C OB -> O FH -> K CS -> P OF -> N FF -> V PV -> B PF -> C FC -> S KC -> O PS -> V CO -> F CK -> O KH -> H OP -> O SK -> S VB -> P FN -> H FS -> P FV -> N HP -> O SB -> N VN -> V KK -> P KO -> V BC -> B FO -> H OV -> H CF -> H HF -> K SS -> V SC -> N CB -> B SV -> C SN -> P PB -> B KP -> S PO -> B CN -> F ON -> B CV -> S HO -> O NF -> F VH -> P NN -> S HS -> S NV -> V NH -> C NB -> B SO -> K NC -> C VF -> B BS -> V VV -> N BP -> P KN -> C NK -> O KB -> F ================================================ FILE: advent-of-code/2021/inputs/15 ================================================ 1124751783612228519483416186391693192764152281421133194141163183224351733212394799536339411529842112 1299938854391228215712461147511117912185733411491416388811646391912138661213722223824151532652174491 3339197559983134739317425934547716331696227221882122961476799987711635499267472178182145359213635923 3275111279884782539314241187762113814171394161491634629424134127254634143155261122133724143114517171 3719252118791433135122231855197812222238914994648147192141951214948299478914959275216261881654181459 1611117951314292139456114142392662772939225937136486428161234281216234329234315111776511563151948482 2568826483341639224876553822412669632282339258375519267395999314194775717338955473111882125281113119 3211535497996954958315977618271374429983722314139733843419727946959246752499319415154271225547899217 9182381814515842193317619241122295417132515941811977373112934221316141138111911121121111793678163186 3844189817214722127981149242928145957137126937131386516329118218111198674162815191994371914762733967 2341991198198671797918854491942998311516141218456591158159195192211227471918835699934872448189793938 4914562622368117861639397331397217328431182986624263992197435816915439591962133158497224891382954532 7626651214813838216185911429272999894518636231382989678893369367388711391734813452975811156327428911 6619547343521975253174481211413831293662121339851815212317311237391545399111182897667911821424149598 9973191187241313192815214227191649743296915314888729322114168515823743777711899119191553298115729119 1139287494922611751257731929722771498336139611251121442114394245137973342111145499332316959261235284 2957197428427162517942347211164151149912112158641321995248419171621811597221619949431227171998811472 3942647388316719894411111531921126183713231811198382654685441319271454138942281133619242611612293827 7937119217256311112391437861121498616811956123353462521891125694135126297129995285155114368995531781 3451961913122271833382989211151286596622992323752134162138122516383189222433812253226845819142198221 2778119153629891339923532321818124533756116181684147179833125112111826952511175359231299984985971323 3111241849191534385261731569341927433476113958471723118832747854529179328115274125434719722218912131 3142339531392581988128137411211196234548128214999949588185228836196627923352221497911291281534111199 2247331434479875142918842833898559624238445292211715118881294135283574749565172271411631413491566199 5942278576394177315387294721122691617961774138211922471397191215938266718124567292193989959261637132 3165937631221963265792414421441393495719931248192344794567976762321141859115829128661211272472736862 6245216271127518123199222191484234611151315582117171596574729739922992724612599562343116361844622764 8113544322656226212151951279235114941989556194198115559251582213981835589429635885493383187341531965 9167334539972119189967382996641594933763662148772253141953186111414742999511119411388291132416516449 3613823811913288411123382135529243111267199921121439155729919326116169791514491996989971122517181152 8673611192477161631212112481894911858892968239143914865319658975331149334747126743512225484277694151 1573562476555619452428261559215411721579288335558515411134313992163812836653437129992833619198146362 1985275213511588337218921661953495211191671194622531866114745941231929893241192939732541431596251229 1265136118282217612545222191931962743537199362634214512441818421145212152171522295123221817416511192 8297798221482948311881157477219864767525628534952929138168821168196211119111519681828383199111919196 2534111997313111473186996839118152776719511994169115192212165984228917912783244345623614586619121326 5841498181267192895193154811932281737529524821838531213993721717189699211939288511893237393416182963 4291365191619323711913413926441339411267931111249294286234263722174939997111633217333235111582923441 1287162672582123747413148471918114922719181577167138269131143162782619895168443398922587114315692159 1265925622411611266789112299971891313715613359912627191225939742625214121139321211686759611131173819 2138953588999163543822384688714958315246965691333881631171314291246656696539111996811849918124146199 1246641611311144149732152211911939355725818779248359199268117115556131393567479697235189376137881341 2899323821125691382122622121279464139996512843263627599964991689326381239953514685697311811566519319 2736949532739218813892326217621918912123391961114292438971239114718244292915281445924621121161621333 3284227711481113791259114169152546556372395121491214478676766673451539272714243257528999117191132191 1491645992221246232691159831148693751711539199173418148515113374123227919399121713163369423119344294 9132112419279766149552388219119879126631964411873291514292382629182256527396923261916197289667422219 4435263531452645499818123111966429163563711994892138163281911392712947829833494132517185151159797235 3377999473376535692397871161267942211991447319627223732643859136911321291147933161219919912554143594 3949323991733462336411199416212721417161994737197381813716349241925143828318311249159179991229329171 1762136928289612837322111798838212828232194159395467913129898285979511558911359718111211715278482292 1118257643855683112121972927223668654922187717441698273158822189761169916992651219511457913769191141 1658133214212128183392871646163111119424394424612113962259435119311183885137744192432918197134375132 3591713174418138371811543613511348758114531127679321532212958111147949196891591688991927112311822659 1236514266615278952886111333113128112861958723136379141934411821192618183131222512832888648251713999 8123213361595969218132551112914729944243931512311795497816271296492513311341682399128274945195119112 2462825227696446183996491353919233459561152451155132169141431681617413626542619881461141223688519198 9621989515111471113381577698758628164221411666452251895517161458991756482464135232192737151721333241 1845633941916891433521922233371928968912324239271162428588753196413672815131973146761647212761387593 1213191632931181293214711139975148754136566435292974252811697693911887328591189183554433169371667213 4519131126388191338914531223891121466796183273431621945951424794146112514299112124121572531131372111 1331344969619935133794416261913442341424183712193444133541852317113515211181326734947129151289182833 1355758512615534971555911998128211268588155773916181718217932133414645114253821929111112911181223396 1921812718591189155234925136611421141621741789512111114849236968196293982164297416554297277314296498 2925818269222199331695127966441449818292484293218699694191219141796929886179788888289778893154112915 7349332956191336793938825411116431794116518627151175184126599498959181846349128914531693382871224114 2975711544499872811921879322745419629143299769241363453113298718372441111116129736331374245812629681 2419398835867978148157517197312837563211153716146118174293922233694112229384117648726494771916746336 2322473321962284111112435812293374144731592114895311931296931978723998962913118278111921783414789472 7421933294181593157278951313456166911311561151111468883991937345182554571275781533927232981213941792 1668835358177241114335636733193482471442299199859434499861711136613117473328576171139593142184617345 5339642815719926226879311379167325793396941892597215179614941121636812111539912741116971188971946499 7581333191573246312732795518731212368211299298495989164122116531125184283943222911391615243311251361 9492966914243222969499792183412424152773224381646928911135496174621299924524112331962952547214129323 2729194232211462151119459711313211822621531163797412446181172721913949189555142143791213834886518948 2754215791553781642269915399358262512494443343121198134218639979927842122994421127962456193396136699 8271611911227341219949383285981988595252121593129637541475392137413899839912239225135459931743267972 1332131171959982211855642861212718138325111114239233279171544919563891942832117949581464743292494391 5144166291493181763279457131141327146537961189933599395341461291371919123151359118199368625742376117 1636191619675379923419873222911119821251129276117414194193998142948136713325351617571519395951914216 6863238911796142259595658671251783127926389189168272138182549591741951937121824471372228139189226966 1398611275788896954682838421735924943417195641181143853286733633811931911189111341679192676374118319 7425912442414194918974222966129621141925526265112323617731363617133673511925955331462169117293471296 8311915233126172592295451734596934578641991127992454954549337724839691119685881916643781992923996572 7168461267393883112656311283191232322499117185912521188899182419918914911212513325386275539329721472 4418929132119621184239621272934448319225211997924183117861911136919317465941177911127948161449124731 9271153581452542386794695144559617972331134217961265186239771199325391879412411821372724989746391111 3752522113112162859371199119415298331514424128999524132149996846199915924629121214916277199845231181 8461129155427192357991128752552628161188794894374724397322312139214838121389889613819783991892292158 4999141138619713275215481369646529918918936887478711111135124192624311852137911719581517593373711112 9228956819912994881488113276489314945969876898139152128325918347915249723837311238669717631918756448 1272313111232619631582529173782417217912411245971957172218911853664936489571219898133821585115925152 1324983253974657485632276593196749111921819449973115611494598217724911344731933114417612111528118291 8521515271325847484517496514692991413334913117194153459926716822674627611191634943962214123151399931 1141639315518932691635973515217951611118329247113938399181114133617465682162932426295992195929458883 8229351197214731215324515139273121165384915712119675514893281751526119183679227515364941156137548174 6116894132781317191382191142114151317798773795981911112434921641114411589131331717998932176521898319 5362677393912312215419378899211815319464811111851912257961211293814411559971191515896993251933358962 6926527339383986515331739126963132928923957918814875739969162479336291216879152811764569629328261149 7598541186247351172883789213137911264491891391569216562276119911413437411237411934123311912324427449 ================================================ FILE: advent-of-code/2021/inputs/16 ================================================ 40541D900AEDC01A88002191FE2F45D1006A2FC2388D278D4653E3910020F2E2F3E24C007ECD7ABA6A200E6E8017F92C934CFA0E5290B569CE0F4BA5180213D963C00DC40010A87905A0900021B0D624C34600906725FFCF597491C6008C01B0004223342488A200F4378C9198401B87311A0C0803E600FC4887F14CC01C8AF16A2010021D1260DC7530042C012957193779F96AD9B36100907A00980021513E3943600043225C1A8EB2C3040043CC3B1802B400D3CA4B8D3292E37C30600B325A541D979606E384B524C06008E802515A638A73A226009CDA5D8026200D473851150401E8BF16E2ACDFB7DCD4F5C02897A5288D299D89CA6AA672AD5118804F592FC5BE8037000042217C64876000874728550D4C0149F29D00524ACCD2566795A0D880432BEAC79995C86483A6F3B9F6833397DEA03E401004F28CD894B9C48A34BC371CF7AA840155E002012E21260923DC4C248035299ECEB0AC4DFC0179B864865CF8802F9A005E264C25372ABAC8DEA706009F005C32B7FCF1BF91CADFF3C6FE4B3FB073005A6F93B633B12E0054A124BEE9C570004B245126F6E11E5C0199BDEDCE589275C10027E97BE7EF330F126DF3817354FFC82671BB5402510C803788DFA009CAFB14ECDFE57D8A766F0001A74F924AC99678864725F253FD134400F9B5D3004A46489A00A4BEAD8F7F1F7497C39A0020F357618C71648032BB004E4BBC4292EF1167274F1AA0078902262B0D4718229C8608A5226528F86008CFA6E802F275E2248C65F3610066274CEA9A86794E58AA5E5BDE73F34945E2008D27D2278EE30C489B3D20336D00C2F002DF480AC820287D8096F700288082C001DE1400C50035005AA2013E5400B10028C009600A74001EF2004F8400C92B172801F0F4C0139B8E19A8017D96A510A7E698800EAC9294A6E985783A400AE4A2945E9170 ================================================ FILE: advent-of-code/2021/inputs/17 ================================================ target area: x=153..199, y=-114..-75 ================================================ FILE: advent-of-code/2021/inputs/18 ================================================ [[[[2,5],4],[[1,0],[8,3]]],[[2,[2,4]],[1,[3,3]]]] [[[2,2],[[4,3],3]],[[[8,6],3],[3,7]]] [[[9,[4,1]],[9,0]],[6,[6,0]]] [[[3,9],[[4,4],[2,5]]],[[9,[8,4]],8]] [[[[0,0],9],[[9,3],[8,2]]],[2,[1,3]]] [[[8,4],6],[[5,1],[3,6]]] [[[6,[7,6]],[[2,6],5]],[[6,4],2]] [[1,[9,7]],[[[5,9],[9,5]],[[7,0],1]]] [[[[5,8],[9,4]],[[9,3],[7,8]]],8] [[[0,9],[[6,0],7]],[[[7,7],6],[[9,7],[0,4]]]] [[[[4,3],[9,5]],[7,[7,3]]],[[[2,8],9],4]] [[7,5],[8,1]] [[4,6],[[[0,6],6],[7,4]]] [[[1,8],[[1,4],[1,6]]],[3,4]] [[[6,5],[4,[7,3]]],[[[0,1],[8,4]],[4,8]]] [[5,1],[9,[9,[3,3]]]] [[[[7,0],[2,5]],1],[9,[[2,7],[4,4]]]] [[[[5,8],8],0],[8,[1,[2,5]]]] [8,[[5,4],7]] [[[9,8],[6,7]],[[2,[2,6]],[9,6]]] [[[[2,3],7],6],[[8,6],3]] [[[8,[7,2]],3],[[[3,9],4],[6,8]]] [9,[[[6,7],[6,0]],[[3,9],8]]] [[[7,7],[4,7]],[[[9,8],9],[9,[2,4]]]] [[[[5,0],1],[4,[4,8]]],[9,[6,7]]] [[[[9,2],5],[1,[5,8]]],[[9,[0,1]],[3,8]]] [[[5,[2,5]],8],[2,[0,[9,3]]]] [[7,[[8,4],[8,4]]],4] [[[[3,3],4],[[0,0],[5,5]]],[4,5]] [[[[9,3],[9,3]],2],[5,3]] [[[9,5],[1,4]],[[7,1],[3,[6,5]]]] [8,[[[1,1],[0,1]],[9,[3,6]]]] [[[[4,4],7],[0,3]],[1,5]] [[[3,[0,8]],8],[5,[7,5]]] [[[[9,6],2],7],[[5,[3,7]],0]] [4,9] [[[5,[1,3]],[[9,5],6]],[[[7,9],5],3]] [[[[3,9],[7,2]],[5,[8,8]]],[1,9]] [[[[7,8],8],[[9,0],[5,1]]],[6,[[1,0],[3,3]]]] [[[[5,8],1],[[8,6],[2,9]]],[[5,1],6]] [[1,7],[[5,[3,2]],4]] [[[[3,1],2],[0,8]],[3,[4,6]]] [[9,6],[0,[[5,2],[1,1]]]] [[[[1,8],8],[[9,0],3]],[[6,[2,8]],[[6,4],[6,0]]]] [[7,[[3,2],[9,0]]],[[[3,2],[2,8]],[[5,5],[9,2]]]] [[[[2,5],[3,1]],[7,[9,6]]],[[[7,0],7],[2,[9,1]]]] [[[[1,6],9],[1,[6,5]]],[[8,[4,1]],6]] [[[7,[4,6]],[[2,7],[6,6]]],[8,0]] [[9,7],[[[0,7],5],[[1,4],[1,3]]]] [[[1,[8,2]],[[0,6],[9,0]]],8] [[[4,0],[7,[3,3]]],[9,6]] [0,[[[6,9],7],[[0,6],1]]] [5,[[4,3],[[8,3],[5,7]]]] [[9,0],[0,[[7,8],[1,8]]]] [[[[4,3],[5,6]],2],[[2,3],1]] [4,[[9,9],[[1,8],[9,2]]]] [[[[6,9],5],1],[[[7,4],[8,1]],3]] [[8,[5,[2,6]]],[[[2,7],6],[6,0]]] [[[[6,8],8],6],[[[5,7],2],[[6,5],[3,0]]]] [[[1,[2,5]],3],[5,[4,[6,6]]]] [[[[4,9],8],1],[9,0]] [[1,[0,[5,7]]],[[1,[5,9]],[[3,2],[1,7]]]] [[[[2,9],[2,7]],[[4,2],5]],[[[9,1],[7,2]],[2,[7,5]]]] [[[[5,7],[8,9]],[5,[7,9]]],[[7,[6,6]],[7,[8,0]]]] [[[[6,6],[4,6]],[4,[7,8]]],[1,[[5,5],[1,9]]]] [[[[4,3],8],2],[[9,[4,0]],[8,[7,0]]]] [[2,[7,5]],[[[0,1],1],[8,[3,5]]]] [[[4,[4,2]],[[0,4],9]],[1,4]] [[[5,5],[5,6]],[[0,[4,2]],[[7,8],[5,6]]]] [2,[[0,[9,1]],[[1,7],[0,0]]]] [[[5,[4,8]],1],9] [8,[[2,1],[3,0]]] [[[[6,5],[1,1]],7],[[[7,5],3],[0,1]]] [[[[0,3],7],7],[[[4,8],[6,1]],[[6,1],9]]] [[[[4,8],9],[1,0]],[6,[4,[4,8]]]] [[[[8,0],[5,1]],6],1] [[[[6,6],[7,7]],[[4,3],[2,6]]],[[3,5],[[7,0],[7,3]]]] [[1,[5,8]],[[[3,7],[9,6]],[[4,8],[3,4]]]] [[[1,5],[8,2]],[[[3,1],5],[4,1]]] [[[[6,3],5],8],[[9,[3,6]],[[3,5],[6,9]]]] [[[7,[5,4]],[0,[6,0]]],[[[7,7],[1,1]],[[5,1],7]]] [[[1,5],[[8,6],0]],5] [[[[0,8],[6,0]],[[3,0],9]],[[[7,1],2],[4,2]]] [[[6,[8,7]],[2,[2,0]]],[9,[7,[6,6]]]] [3,[[7,[4,5]],[[8,5],4]]] [[[[8,0],[8,3]],[[5,4],[1,6]]],[[0,[8,5]],3]] [[[7,2],1],[9,[[3,8],4]]] [[4,[7,[9,9]]],[3,8]] [[[[7,1],9],[[6,9],[9,6]]],[2,0]] [[[[6,2],9],[3,[3,9]]],[[8,[3,4]],[3,7]]] [[4,9],[8,[5,[9,8]]]] [3,[[9,[9,7]],4]] [[[[5,9],6],[1,[3,1]]],[4,[1,[3,8]]]] [[[[7,6],2],3],[[0,[1,8]],[[4,9],[4,3]]]] [[3,[[8,1],[3,8]]],[[[2,0],[0,8]],[[7,0],9]]] [[[[9,7],[9,3]],[[5,8],6]],[[[6,2],0],[2,4]]] [[[8,[9,7]],[[5,1],[1,4]]],3] [[7,[[5,6],[2,7]]],[[[7,3],0],[1,[0,6]]]] [[2,[[5,5],2]],[[3,[7,2]],[[7,1],8]]] [[[[2,4],[6,8]],[0,[7,5]]],[[3,[2,5]],[7,7]]] ================================================ FILE: advent-of-code/2021/inputs/19 ================================================ --- scanner 0 --- -880,-557,778 -611,290,670 598,502,694 627,-521,631 -908,-626,915 -667,517,-416 653,-608,742 619,-567,601 -541,508,-276 -573,475,-350 616,389,617 658,483,734 -501,223,776 -92,5,101 -966,-685,-334 310,-833,-657 -879,-602,773 472,-843,-557 472,-871,-567 -510,239,817 -861,-803,-266 783,524,-377 -878,-591,-260 815,640,-317 -16,-141,-1 657,597,-394 --- scanner 1 --- -342,623,-335 437,-326,644 -751,454,509 748,716,528 -785,566,599 53,-5,-74 513,-321,703 -749,-226,-474 588,626,-626 -20,119,90 524,-325,650 -639,-293,-580 -436,-750,548 669,671,572 -370,554,-472 -371,599,-477 528,523,-532 503,-433,-410 486,-567,-427 -541,-724,467 -433,-711,594 -689,495,689 519,-502,-310 655,503,-676 -740,-242,-433 728,797,546 --- scanner 2 --- -447,446,-705 623,695,-536 -532,-388,322 349,542,589 -467,590,-578 -498,650,320 761,-419,-459 298,689,690 -543,645,321 534,-478,627 -93,-60,24 -570,496,-638 282,648,699 48,-137,-88 567,-404,659 -567,787,292 810,-519,-397 -618,-568,-794 576,-544,533 558,812,-569 489,712,-553 -744,-394,339 -625,-611,-753 819,-575,-440 -569,-592,-825 -626,-462,234 --- scanner 3 --- 339,-815,388 -500,420,-617 -495,-671,-609 -526,333,-506 -370,-712,502 719,347,-563 787,-838,-639 716,250,670 -338,-828,442 717,335,667 -681,683,692 -681,655,682 854,306,-541 -843,645,782 -537,-577,-492 -555,-690,-569 -496,-785,519 785,247,-677 423,-840,474 329,-909,487 -534,379,-476 771,-983,-606 -33,-41,127 631,-897,-674 554,240,687 --- scanner 4 --- -107,-126,10 -622,461,-286 -558,-808,-479 -550,-803,612 -56,0,159 557,315,573 -377,758,630 -675,-766,-385 647,411,502 -661,-777,525 -598,-748,-498 552,667,-704 315,-485,663 -514,730,561 502,-533,608 -519,729,606 467,349,461 505,-810,-622 413,-899,-635 391,-440,662 -475,360,-235 425,559,-717 506,664,-743 -691,-769,571 394,-748,-744 -516,351,-219 --- scanner 5 --- -738,-555,723 -662,510,693 -694,-436,671 322,-502,799 -73,73,-94 -813,-399,-583 388,-574,840 -827,-610,-513 627,856,-730 -662,414,-785 346,-644,754 724,825,401 -824,-574,-637 -653,623,561 -549,414,-712 464,-365,-561 503,-392,-428 -468,436,-812 676,746,-667 701,845,-823 715,834,446 557,790,356 520,-310,-383 -725,561,553 -741,-497,785 --- scanner 6 --- 498,-465,753 -291,-666,829 568,-977,-581 -599,740,826 708,713,795 851,686,-818 -411,-886,-379 422,-891,-574 92,-196,0 441,-978,-422 -750,631,807 813,739,714 816,700,668 560,-506,573 -568,438,-378 -481,-844,-293 -553,-910,-334 -389,430,-288 -5,-12,128 464,-577,663 702,614,-783 -564,308,-288 -336,-667,905 -661,618,715 -384,-612,718 675,645,-768 --- scanner 7 --- 650,-645,583 -548,631,-805 631,-833,-572 645,-597,667 607,449,671 -856,723,531 -159,-19,-111 673,363,591 -380,-625,689 663,473,-639 -506,792,-879 -445,-665,687 -932,-509,-946 695,-721,-572 -21,-134,12 -897,783,484 553,324,644 485,498,-648 -743,740,579 -762,-575,-965 736,-825,-707 -394,-443,661 -834,-564,-882 -458,582,-873 813,-587,573 580,330,-627 --- scanner 8 --- -535,-646,373 49,64,7 712,545,482 -413,428,-787 -564,-583,-650 -502,520,-774 845,-611,346 778,-513,-798 -872,406,510 490,330,-589 -564,409,-896 -33,-62,-155 320,432,-615 -543,-676,419 -546,-660,-537 776,-475,287 620,491,492 762,-546,-943 -827,330,511 -504,-543,-631 710,-589,387 -509,-535,460 469,421,-592 622,-478,-857 443,548,498 -779,517,456 --- scanner 9 --- -691,697,-504 606,-525,-831 -708,312,884 604,-422,-859 -879,-787,632 -805,-755,599 582,-530,-757 -864,331,826 -672,625,-560 369,295,745 394,311,803 865,-899,630 -889,-467,-679 -895,-450,-467 -715,666,-553 -764,269,875 814,-826,548 -739,-661,641 669,693,-398 835,-907,511 323,329,771 503,633,-342 41,-84,54 459,696,-317 -821,-362,-561 --- scanner 10 --- 700,-673,733 565,566,545 -655,-386,666 -35,27,-40 -440,-441,-330 -588,352,-383 432,723,-488 -529,-330,581 -528,-379,-456 739,-726,613 280,-566,-837 -500,-339,-395 733,545,640 340,-613,-796 271,797,-446 614,-753,667 -435,429,515 -383,391,594 -520,-401,719 590,557,723 -488,390,504 -545,334,-423 481,791,-398 -646,448,-404 323,-661,-683 --- scanner 11 --- -523,667,-763 -761,-605,298 553,-663,332 748,-670,-550 427,451,-834 481,495,-926 -234,733,382 -234,552,415 746,522,514 876,432,518 140,27,-65 -561,474,-740 -537,-491,-834 -571,597,-800 754,432,693 -690,-669,445 -325,661,340 491,494,-716 751,-761,-571 -547,-647,-812 444,-682,483 -740,-625,380 -476,-528,-761 725,-659,-401 566,-571,421 --- scanner 12 --- 534,-664,530 506,566,785 -651,-482,723 -531,374,-562 933,613,-583 444,-668,400 -658,400,528 -749,-896,-575 535,-821,-794 -7,-29,73 -647,251,551 -534,643,-546 -559,-571,710 -749,421,525 463,684,849 843,657,-425 106,-110,-59 507,776,795 -670,-633,832 449,-751,-752 -673,-941,-574 490,-679,-818 -588,551,-556 888,648,-416 444,-843,522 -562,-848,-520 --- scanner 13 --- 661,639,-831 -683,-841,-609 -555,-518,629 859,376,374 -559,681,-427 713,528,-837 -711,637,549 -750,-824,-776 -401,588,-408 -477,611,-393 -606,645,684 787,387,291 720,-842,-411 529,-822,-422 -655,-918,-710 -638,-661,617 -670,533,684 483,-770,383 6,-65,-36 531,-980,377 502,-841,-406 755,671,-764 -460,-686,608 129,9,74 957,321,310 573,-819,451 --- scanner 14 --- 538,411,-771 -675,874,471 -837,-690,-720 348,-523,-489 316,-298,707 -523,-771,931 -731,696,526 -692,829,553 431,508,964 -543,-739,767 499,501,861 559,425,-605 414,-293,789 386,549,964 363,-287,605 -413,-702,878 -636,-698,-697 414,-514,-578 -494,434,-684 -568,527,-695 -124,-5,130 -690,-633,-734 330,-424,-459 -519,590,-585 616,362,-777 --- scanner 15 --- -391,431,-743 592,-436,-482 -474,-609,-535 516,-464,478 706,705,-770 512,-502,-568 -7,-73,54 -789,642,691 -452,-577,411 -346,407,-601 -34,95,-83 600,-459,526 732,669,629 678,679,721 -699,800,735 -744,809,726 893,650,-818 -305,473,-673 675,663,452 -592,-640,462 817,651,-863 -422,-653,-654 610,-296,468 539,-556,-443 -360,-656,-596 -584,-568,524 --- scanner 16 --- 711,389,-690 -640,572,459 -579,475,-510 -447,-653,-613 -587,452,498 -663,480,-462 690,-772,542 633,-758,-703 -667,518,584 652,640,633 576,430,-586 720,-726,550 655,-799,-838 643,462,608 -569,312,-452 -501,-663,-705 576,494,-698 579,-685,516 631,545,465 519,-858,-769 90,60,61 -362,-635,879 -504,-647,-436 -286,-634,834 -473,-689,786 --- scanner 17 --- -670,636,302 433,641,-915 -454,541,-877 -590,-680,-722 -678,601,506 -31,3,-135 741,657,647 467,-357,313 685,-356,318 496,-218,-470 -673,-537,-710 -465,488,-838 877,642,566 448,-428,-476 -495,-512,-701 88,176,-48 538,-379,-544 -690,-280,617 -585,672,383 473,598,-933 -718,-357,516 775,649,632 -785,-374,683 494,-376,329 -544,436,-876 454,699,-819 --- scanner 18 --- 484,-782,-326 -828,475,486 725,568,651 -879,557,413 -467,-815,-419 -89,-133,-37 -596,-830,782 -760,408,-799 791,526,557 747,648,-673 584,-792,-488 -849,438,405 824,691,-831 -618,-932,890 764,575,-799 -459,-820,-543 807,-634,950 -620,-904,787 574,-820,-488 -619,479,-825 -80,55,77 881,-540,862 -435,-841,-339 875,-752,845 865,559,525 -752,370,-817 --- scanner 19 --- 278,-537,-508 -527,901,494 -98,173,111 -619,812,507 -666,-665,425 -521,788,-749 -585,935,-820 -86,41,-48 245,-556,-553 -508,750,385 322,542,-664 561,768,744 383,527,-541 -565,853,-799 508,-459,843 -539,-557,412 361,-358,894 -620,-662,386 -710,-796,-605 484,750,631 323,514,-585 444,810,650 402,-349,910 -723,-641,-724 420,-563,-614 -608,-760,-696 --- scanner 20 --- 431,-704,-682 -147,26,66 -696,-545,-708 426,-620,-634 445,535,-446 381,535,-558 -702,-488,-531 560,610,790 -848,614,-306 505,548,698 -907,478,-375 536,492,879 -483,757,852 -533,901,844 -807,592,-441 -477,-539,567 414,-641,417 -625,873,822 -593,-578,691 464,-627,539 -28,-46,-73 340,670,-454 263,-610,-692 520,-680,479 -466,-669,669 -712,-542,-439 --- scanner 21 --- -266,486,648 578,-611,-708 -818,735,-464 -759,-456,-789 -691,-545,727 407,-548,624 -407,414,606 496,-666,600 -706,-562,774 -278,471,630 634,761,-544 747,571,696 -676,657,-492 -698,-556,767 63,-153,67 807,624,640 525,774,-558 626,-676,-624 624,-631,-871 -627,-432,-708 550,778,-542 -734,-461,-727 -742,786,-431 869,585,746 588,-604,655 --- scanner 22 --- -658,443,-873 688,-773,-852 94,86,-43 365,435,679 316,-602,678 -101,19,38 -343,-416,-420 -561,407,-825 -462,383,561 -405,-615,824 -359,-493,-424 -404,-525,719 -443,-536,772 636,-689,-733 749,-675,-833 372,-687,552 325,374,707 387,-740,687 -564,-448,-433 623,594,-764 -348,402,662 531,670,-784 629,524,-772 427,309,767 65,-103,67 -684,443,-722 -366,362,619 --- scanner 23 --- 435,-295,689 376,-489,-751 -776,528,-600 756,497,-606 -659,601,725 -827,580,630 342,-579,-639 426,-366,551 -413,-413,-550 -506,-524,-604 394,425,766 -833,-691,657 -684,592,547 341,464,755 -794,-638,537 785,355,-582 -750,639,-687 561,-351,604 -144,111,172 -458,-337,-549 289,426,676 25,-25,67 438,-669,-710 -742,669,-641 -708,-718,603 757,492,-651 --- scanner 24 --- -111,-95,111 361,-657,765 -582,632,729 505,-558,752 -589,-581,768 -530,716,848 -893,-431,-711 748,709,611 -831,683,-691 657,337,-287 -853,-492,-683 -791,-366,-771 740,-662,-280 63,-50,-45 -846,630,-556 382,-527,879 737,-458,-369 819,-451,-281 656,803,580 701,756,570 567,372,-315 645,506,-298 -595,-651,760 -469,618,829 -902,545,-682 -687,-727,780 --- scanner 25 --- 538,-604,597 -69,170,-40 486,-485,641 424,-543,644 -475,-696,544 455,-396,-443 -800,563,438 -448,-571,490 498,456,-351 688,967,784 369,-466,-485 -528,-657,424 -587,479,-752 -497,575,-823 410,-538,-419 598,939,749 676,956,615 650,437,-438 657,583,-352 63,30,10 -677,513,-864 -753,-276,-663 -642,-369,-717 -815,698,491 -871,572,576 -829,-321,-662 --- scanner 26 --- 603,-662,-789 921,616,705 838,688,716 -837,496,-760 528,-777,447 541,-717,-697 -711,-791,683 663,-882,455 -705,248,837 -627,-796,635 -733,234,655 -634,-758,-538 902,786,771 485,-686,-878 117,-22,-80 528,-841,559 613,562,-659 -731,299,615 -824,482,-651 -648,-808,-416 548,646,-707 -687,-702,-478 -617,-959,693 -841,480,-735 43,-158,54 568,809,-661 --- scanner 27 --- -688,503,355 602,-599,627 633,-605,-905 638,-650,-906 666,756,-490 -8,72,-119 -707,-336,446 -789,531,278 -474,551,-638 491,-686,601 461,-640,593 -400,-616,-904 -406,-404,-887 -555,636,-674 -678,543,-603 550,631,678 775,-581,-934 -697,-364,446 -855,436,372 704,677,-438 705,767,-543 -191,149,-166 -474,-522,-992 538,548,535 -797,-374,284 529,726,510 --- scanner 28 --- -713,-683,864 710,829,-871 569,-596,779 888,752,850 561,-775,869 -637,-474,-537 -425,637,-643 -779,-611,823 -544,681,380 -474,747,-706 126,-94,-57 88,32,118 525,-912,-725 480,-912,-684 824,634,807 -598,-501,-404 653,657,-808 -755,-753,778 -400,736,-799 -581,-419,-359 632,823,-822 439,-600,869 593,-809,-732 834,844,806 -386,725,470 -377,716,425 --- scanner 29 --- 423,-939,368 496,689,481 907,-613,-518 -502,-588,597 492,-886,258 -442,-468,-499 -476,281,-751 680,570,-569 561,726,535 -322,-453,-521 671,481,-503 -15,4,-8 -48,-164,-115 901,-797,-569 -445,-665,573 504,712,682 -417,456,-807 -398,384,755 -320,-554,-541 896,-715,-471 -557,396,-782 -571,416,772 -454,-643,535 455,-775,388 770,451,-485 -477,321,741 ================================================ FILE: advent-of-code/2021/inputs/20 ================================================ ##.##.#..###....##..##.#.##...#..#..##.####..##...###.....##.####.##.##.##...####.######..#.###.#.##..###.#..#####...#.##.#..#.#.#..######..###.##.#..##.#..##..##..#...###.##..####.#..#....#####.#.###..##.....#...#.##.#####.###.###....#.#..###.##.##.#..##.##.#.##..##.##.##..###.#.#....#.##..###.###.#.##......#.##..#..#.#...##.##.....###...#..#...###..##.####..#..##..#.#..###......#.#####....#####..###..####...###.#.####..#.##..#.#####..##...##.#.#.#...##.#...#.##.##..#.#.##....##.####.#.#..#.##.#.#..#..#.#. .#..###.....###.#..#.#.###.#..##.#.#..#.###.#..##..#.#.#.##.##..###....#..#.#....####.##...##....### .#.#.##.#..###...#.#.####..#...##.#.#...#..#...#.###...##..#.#..#.#.##..#.##..#.###.##..##..#...#.## ##..##.#....#...#....##.#..####..#.#.####....#.##..##.###...#..#..######.####....#..#.#.#.###..#.### .##.#.#..#......##......##.#.#.#.###...###.#.##...##..#..#..######.#.##.###.#...#.#.####.#.#.####... ...#..#####..#....###...#.......#.#..####..#....##..#..####...#...#..#.....#..#...#.#.....##..####.# ##..##.....###.#.##.#.###.###.#.#####..#.....#...##.#.##.#...##..#####...##.###..###...#...#.##...## #.#####..###...#.####.#.#.....##...###.#..##.##...#...##.#..#.###..###.#.##..#.##..##.###.#.#.#...#. ##...#.#...#..####.#.#..###...#####.#######.##..###..#.#.###.#.#.#..#####.##.#......##.#.#.#..##..#. .#.#.#.#..#...##.#.#..###.###.#.#...##..#..##.####.#########.......#.#.#.#.#.#.#..##.#..#..#....##.# #######.#.##.##..#......#..#...##..##...#..###.#...#....#.####.##.#.##.....###...##.##..#..##...#### #.###.#....##.##....#.....####.#.####...###..#..###..#..###.##..###.##.##....#####.##...###.#.##..#. ...##...##.###.#.#..........##..##.###..#..#....#..#...#.##.#..####.#.#.###..###..#........###.#.##. #....#..######....##.######.#.########....#.###.###.#####.#.####.#.....#..#.###.##...........##.###. ..##.#######.##.#..#.#.#.###..........#.#.#...##...###..####.#.#....#.####.#..#.#####..####.##.#.### ...###..#...#.###.#.#######..#####.....#.##.##..##....##....#####.#..#.##..##...##...#.#.##...#.##.. .#...###.#.....#.##.######.#.#..#.....####....#..###.##.........#.###.....#....#.###.....##.#.#.#### .###.##..###....##...##......###...#....#.##....#...#.#.####.#.......#..#.#.######...###........#..# .###..#...#..#..##....##..#.#.#....#..#.#.....#.##.....#.#####..##...#.###..#...#.##..###.####.#.### #..#......#####.###.#.##.###...#.#..#....#.##..#..#....#.#..#.##.###...####...##.######.#...#.#..#.# .#..#...#####..#.#.#.###.#..##..#.##.#...#..#.##.#..#.##..#..#..####.....#......#.#.#.##...#.##..### ..#....#..#..##.####.###.#..####...###.#.####.###.#.##....##.....#.##.#.##....##...#....#.##.#####.. ######..#..#...##.#........##.##.#...####...##.....#.##.#.#.#..#.#..##.#...##...#.#.....#.#..#..#### ##...#....#.#.#.....#.#.##.#..#...###..######...###..#.#.#....###.####.#######.##.#.#....#..###..#.. ##.....#....#.#.##.##.#....#.###...##.##.#....##.#####..###.##.#...#..##..#.###.#.#.#...#.########.. .......###.#.##.....#.##..##..#.#..#.####.#.#...#.##.###.#.##...#..####......#.##.###.#.#...#.....#. .##.#.##...#..##.#.#...###..#.#...###.##..#........##.#.##...##.########.......##.#.##.####..####.## #.#..###.#...##.....#....#...##..##.#...##.....#..#####...###.##....#####.####.##.#...#...####....#. ###.####.##....##.#.##.##.....#.##..##.##.##.#.#.##.#..#.###.##..#.##.....#.#...##.##..#.#.##.##.### #......##..##.##.#.#####.##..###.....#.##.........##..###.##..#...#..###.#..#.####...#####..#..###.# #.##.#.#...##..#..#.#..#.###.#...#..#...#####....###....#..#.###...#.###.#.#####.#..#....##.##..##.# ..###..###.#..........#.....#...##..##.####.#.##.##.#.#.#..##.#..###..#..#..#...##..#.#..#.#####.#.. .###..#.###..###..#...#...##.#......####...####..#..###.#.######...#.###..##.......##.##.########.## ...#...#...#..##....###.#.###..##.#.#...##....#.#...#.#.#....#..####.####.####..#.#######.#.#.....#. .#...#....##....#.##...##...##.#..####.....####..##.###..#..##.........##..#...####..##......##.#.#. ##.####.#...####.#..###..#####.#.#######.#.#...###..###....##..##..##..#......#.#..#.###.###.##.#..# ...###.##.####.##....##.....#.#...##.#..#.#.#.##..#.#.###..#..#..##.#.##.#..####..####.....#.#.#..## #.#.##.##....#.###.##..####.##..#.#..##..#.###.#..###.#....##..#...#...#..#.#.#.#.#....##...##..#.## ####.####.#####.####.##..#.###.#..#..#.....###......#......#...#.#.#....#....#.##.###..#.#.##.#####. .##.#..#.###.#.#.###.....###.######..#..##.###.#.##..#..#.####..#.##.##.#.###..####..#..##.######### ###..######......#...#..###.##.#...######....#.###....#...###....##.#..##..##.#.##.#....###.###..##. #....###..##....###...#.#...##..##...#.......#.####.....######..###....###..##...##.#..###.#.##....# .##.##...##..#..##...########.##..##.##.#......##.##..#####.#.#..######.#####....#.#.....##..####... #.......##.##.#..#....#.#.###...#.##.##...#..#.#..#..#.#.##.#...##.###.###...#.######......##..###.# ##.###.######.#..###..##.#.#.#.........##...##.####.#.####............###....#...#..#.#####.#..###.# #####...#..##.#.#.#.#.#..####.##.#####.###.###...###.###.#.##..##...##..##..#.#.#...##...#.####..##. ...##..#...#..#.###..#...#.##...##.##..#.##.#..##.#..#.###....##.#######.###.#.###..#.###..######.## .#..####....##.#..#.#.######.#..#...##..#....##.#....##.##.###..#...##.....##.###..#.##.....##..#..# ....###.####.#..####.....#....#.###...#.....#..##..#.#####.###.####.#.....#####.......###.###.##..#. ..#...#..#.##..##.###.##......#..#.##..######..####..#.#####..###.######..####...####..#.#####..#... ####....##...#.##.##.####..#..#.#...#..###.##..###...#......#.#..##..#.##....######.........##..##.# ..#...#.####.###.#.#..###..#.####..#.#.#.#..#..#..###.#...#...#.##.#.#####.##..#.##.##.......#..##.. ##...#.##...##.#..###########.#.#.#####.#.##.#####.#.#..##.#.#.####.......#....#.#....####.#...###.# ..#.##...##..##.#.#......###.#...#####.....#...#..####...########.###.#####..##.###...#.#.#..#...### #.##..#####.#...#..#.#...####.........##..#..#.#.#..##..#.##...###....#.##..#..#.#.#.#.#..#......#.# .#..##..##.###.##..##...##.#.####..##.###.#..#.###.#####..#..#...##..#.#####........#...###.##.##### ..##..#.###..########.##.#....###.####.#.#..#.#.#...#.#.#..##...##.#..##..##..#.###.##.####...#..... ###.#.###.#.......#.####.###.....#.####.#.#..#...###....#.####........#...##.##.#..#...####.#######. .##...#...#....##.#.##.###.....#..#..##.#..#..#####..#.##.#####.#....#...#.#.....####.#.###.#.#.###. ######.#.#..#.###.#..#.######.#.#########..##.#.#...##..###.....###...#.###...#.#..###.#.###..####.# ..#.#.##.#.###.#....#.#.####.#..#.##.##.#..###...###...##.#.#.##.##.#.###.#.#...#.#.#..#.##.#####... ###.#...#.#..##...#.....##.#..##.#.###.#..#.##...#......###..##.###.....##.##....#.##.#..#####.#...# #..#..########...#.#####.###.#...#####....##.#...##...#.#.######.##....###.#.######..#..##.##.#.#.## ..#.#.#....#.#.#.#.#.#..##..#....#...####.##..###.#...#.#.####.##.#....###.#...###.###..#.##.....#.# #####.####..#.#....#.#......##....##..#######....###.#.#.#.#.#.##.#..##.#..####.###.#...#.###..#.### #.###..#...###..#...##.#####.###...#.#.#....#######.##.##.###..##..#....##...#.##.#.#...#####.#.#... .##..##..##..###..#.#..#..#.#.#.#.#..##..###..####.#..###.#.#....########..###.#.#.##.########..##.. .....##..#..####.#.#..#...#..#..#..#...#.#.#####.....#..#.###...######..###...#...#.##.##..##.##..## .###..####..###...#.####....##..#...#.#.#.....##.#.######....##..###..###.####.##...#......#..##.#.. #...###..#..#.#.#..#..###.###...#..#........#.#.#.##...#.####..#.#.#...####..#.##.#..#....#...#.#..# #.######..####.######..##.##.#.####.....##..#.#.###.####..#...#..##..#..##.#####.#.#########...##..# .#.#...#.#..###....###..#....####.#....##..######.....#.####.###.#...##.#..#..#...#.#.#..#..####..## ##..#.#..##..#####..#.###.....##.#.#...##.##..#.##.#......#.#..###.......#####...########..#...#..#. #..##.###.##.#..##.#..#...####.#.#...#.##..#.###.#.#..#####.###...#.###.####...##...##.#...###.###.# .#.#....#.##.##.####.##.#.##..###.###.....#..##.#####.....###............#.#.##.#.#..#.#..##.#...... #..##..##.###.#..#.#.###.#####....#..#.#####.##.#.####.#####.#...#..######...#.###..#......##..#..#. ..##.##.#...#.#..###....#.#...#.#.#####..###.###.#..#####.....##..#..#.#.#.#.###.##..##..####.#....# ##...#..##.#.##..###.#..#..##.##...##....#..##..##.#####.###..#.#.##...##.#####.#.##.##....#......#. #.#..#.#.####......#.##....##.#....###...##.#####....###.#.##.######..###...#..###..####...#####.### .##.##...###.#.##.##........##..###..#.#####....##.#...#..#####.###.#...##...######.##...###.#..#... #...#...##.#....#.###.##.##.#####.###..##..#..##.##...##.#.#####...##..##..##........###..#...##.##. ..##..##..##.#..#.#.###..###..##.#.#.#.#.#.......#.##.##.#.##.#####......##....#..#......#.####..##. .#.#.#....#..#...#..#.##.#.....####.#.###..##.#..#.....###....##.###...##..#.###..###...#.#.#..#...# ..######.##.#####.##.######.##....###....####.....#..##..#.#####.#.#.#.##...###.#####.#......####... .##..#.#######..#...###..##.#.#.#...#...#####.#.#.##.#.....###..#.##..#.#.#.####.###..#####....###.. ..#...##..####....####..#.##...#.....####..#......#.##.###.#....#..#..##.####....###.#..#.###..###.. .##..##..######.##....#.##.#..##.#.#.#...##...#.##.#.##.###..#..###..##.##..#...###..#.#.#..##.###.# ####.#..##.#.###..##.##..#..###..#.#.....#.#.#.##..##..###.#.....#.##.#.#.##.###.###...####.#.##.#.# .##..#####.###.#...#######.#...#.#.####.####.#..#...#.#..#######..#...##..###.#..#####.##..#.#.##..# ####..####.##....##.#.#.##.#..##...#.##.#.####...#.#####.#.##...#.#.##.##.#..#.###.#.##...###..###.# .#..##....##..#.##...##..####....###..#....####.#.###...###.#.#..#.#.##.##..###..##.#..###.##.#####. #.#....######....#....##.#.#.###.#..####...##.###...###..#.###.#..##.##....#...####.#.##....#...#.## ...#..#.###.##.##....####.#.#.######.###....##.######.#..##.#..##...##...###..#######....#.##..#..## #....#.##.###.##......#....###.##.#..########.#####.##.#######.###.##.###..#.#.#.#...#########..#.## ###.#..#...##.#....##..###.....#.#.#.##..#####.##.###.#.#...#.####.#..####.#....#####..##.#.#....... ##...##...###...#.#.##....##.......#...#........####....#..#.###....#.#.####........##.#...##..##### .....#...#....#.#####.#..#.#.###.#..###..........#...########.#......#.######..#.#..#.##.#.#..##.... ..#.###.#..#.##.##..#.#...####.##.#.##.###...##.#..#..##.#.##...##.....#...##.###......#..#.######.. .##...#..##.##..#.###.#.#..##.#..##..###.##..#.##.....#.#.#######..###.###.##.###..#.#...##..#.#..## #.#.#.##.##..###.##.#.##.##...#.##.#####.#.#.....###.##..#####.......#.####.#..#.###.###.##.#.#...## #..#..#.#...#..##..###.##..##.#.###.##...#....#..#...##.#####.##..##.#...###.#..##.###..####.##.##.# ================================================ FILE: advent-of-code/2021/inputs/21 ================================================ Player 1 starting position: 1 Player 2 starting position: 2 ================================================ FILE: advent-of-code/2021/inputs/22 ================================================ on x=-38..7,y=-5..47,z=-4..41 on x=-16..35,y=-21..25,z=-48..5 on x=-43..4,y=-32..21,z=-18..27 on x=-16..38,y=-37..9,z=-10..40 on x=-3..43,y=-40..13,z=-48..-4 on x=-6..43,y=-4..41,z=-6..47 on x=-29..15,y=-9..43,z=-39..5 on x=-37..9,y=-16..37,z=-1..45 on x=-28..21,y=-7..46,z=-10..36 on x=-26..27,y=-6..40,z=-18..34 off x=13..30,y=32..41,z=-10..1 on x=-43..6,y=-7..46,z=-15..31 off x=19..30,y=-43..-27,z=-36..-26 on x=-15..34,y=-41..10,z=-45..0 off x=15..31,y=27..36,z=20..33 on x=-8..42,y=-44..6,z=-22..25 off x=-37..-20,y=22..40,z=35..44 on x=2..46,y=-43..3,z=-17..36 off x=23..34,y=5..16,z=-5..6 on x=-9..36,y=-47..7,z=-47..5 on x=-160..27861,y=57453..76567,z=10007..35491 on x=-34240..-12876,y=-87116..-51990,z=33628..53802 on x=-23262..4944,y=62820..88113,z=-7149..-1858 on x=-48127..-16845,y=59088..86535,z=-5102..744 on x=-54674..-32293,y=21567..47184,z=55761..72099 on x=-69807..-50439,y=-53937..-38431,z=14338..28485 on x=13123..34571,y=-74162..-53699,z=5810..32903 on x=-36751..-16860,y=49545..75658,z=-34660..-21694 on x=-68435..-62588,y=-40370..-6437,z=-39677..-23920 on x=-82974..-59309,y=18720..41775,z=-39850..-17189 on x=-72347..-41708,y=9850..18229,z=-53512..-34975 on x=-30894..4418,y=65635..84979,z=19530..39249 on x=15288..25235,y=-29448..1499,z=71472..85280 on x=-54686..-44312,y=36734..56590,z=-60370..-40555 on x=-5266..21740,y=-63065..-47319,z=-53244..-34997 on x=30363..46391,y=65963..73471,z=-16696..-1815 on x=8243..24278,y=-94018..-69081,z=4245..29009 on x=-37020..-23168,y=-72025..-55051,z=-35968..-10146 on x=-47068..-26645,y=-20779..13147,z=56626..75638 on x=-38276..-11929,y=-75280..-63708,z=19483..24673 on x=3913..16625,y=66848..92341,z=9711..32412 on x=-33513..-7553,y=-44460..-19203,z=53802..84399 on x=-46017..-22850,y=-46589..-32578,z=-70024..-47623 on x=48573..58330,y=2974..29593,z=34454..60055 on x=-10056..10090,y=8646..37530,z=-95368..-64816 on x=-40314..-23851,y=49027..75546,z=33133..59153 on x=9529..39846,y=-43216..-6720,z=66362..84337 on x=-45474..-33807,y=15249..40850,z=-72058..-42686 on x=51316..72889,y=-20375..8377,z=32410..56709 on x=-2105..32624,y=-78827..-73957,z=-36836..-9360 on x=28703..45480,y=7042..25778,z=-82005..-55614 on x=6954..42651,y=4674..37873,z=57207..93287 on x=29735..50615,y=17210..29568,z=64317..74832 on x=-71817..-57182,y=-52937..-34602,z=-16791..8172 on x=62789..73440,y=-8262..6641,z=-47239..-39833 on x=22253..33377,y=-66419..-35421,z=-76817..-56664 on x=-81664..-74289,y=-19781..2191,z=-47797..-9331 on x=-15501..3487,y=57147..69359,z=30481..53449 on x=65898..70034,y=-42224..-28303,z=-36101..-5313 on x=43494..54307,y=42390..54768,z=-48993..-31471 on x=-78098..-51348,y=-31792..-29005,z=-59011..-31680 on x=1733..29690,y=-76915..-65890,z=-51511..-21684 on x=15663..36026,y=-43573..-32068,z=54160..67763 on x=-15046..8020,y=73251..81288,z=-6407..6193 on x=-27828..-7924,y=-81275..-66773,z=-6446..19063 on x=53718..81429,y=8690..21113,z=-46849..-30403 on x=-36511..1151,y=59425..77413,z=7092..45917 on x=1629..15400,y=11693..34093,z=68313..91797 on x=-26483..210,y=1338..31754,z=-84816..-58477 on x=-83237..-62066,y=4539..25394,z=-51906..-28397 on x=-9149..923,y=-81989..-60157,z=-26789..-5365 on x=17517..37608,y=26598..46873,z=57508..64782 on x=-7119..11105,y=62942..83529,z=9625..26513 on x=-51514..-30945,y=20145..42149,z=-62845..-43704 on x=5756..29641,y=-22431..5811,z=63100..78564 on x=2390..19403,y=-20570..2836,z=62003..85329 on x=-30076..-15623,y=55291..75814,z=15603..36585 on x=31384..53207,y=-52113..-34713,z=-53230..-48671 on x=-22679..10340,y=13595..27259,z=74909..82901 on x=67880..82348,y=8971..27422,z=-2124..15487 on x=-18895..10483,y=-85666..-59455,z=34047..51125 on x=55861..76270,y=-63315..-43630,z=-14734..14650 on x=574..29499,y=-45563..-10582,z=-90533..-55006 on x=-69275..-42476,y=-59658..-25077,z=-52699..-28481 on x=-56824..-33936,y=-25868..8029,z=-82735..-53242 on x=-90068..-61105,y=25564..34118,z=-8753..8383 on x=-16748..-8507,y=-60001..-44220,z=39386..65527 on x=47454..61550,y=30183..42751,z=-48341..-40487 on x=-75242..-56708,y=-18345..7252,z=27135..42009 on x=-58608..-41635,y=-77670..-51210,z=-19528..-1735 on x=-52353..-35577,y=65342..71094,z=-34292..-10437 on x=-13904..390,y=-85050..-62408,z=-40671..-16675 on x=-70826..-61780,y=-28261..-8503,z=-43838..-22314 on x=23456..34852,y=-75129..-39146,z=-59367..-27639 on x=-21289..-10174,y=-4853..32679,z=-90593..-71383 on x=-37590..-9368,y=-75394..-60296,z=-44762..-24730 on x=-60024..-32249,y=59509..67462,z=-2182..22377 on x=-8113..11767,y=-35418..-18956,z=64722..86638 on x=46854..82238,y=40215..59083,z=-11037..11812 on x=49339..85055,y=28346..47525,z=5491..39152 on x=-50591..-22806,y=-33668..-17243,z=58370..72406 on x=54558..69946,y=-56413..-35097,z=-27088..7730 on x=-64262..-47635,y=-74110..-35937,z=13887..37783 on x=-51771..-28374,y=-60611..-46568,z=23665..55950 on x=-81107..-54757,y=-26037..7731,z=-40004..-22397 on x=-41417..-19367,y=54161..90953,z=12299..44226 on x=-89805..-55266,y=-31643..-22791,z=-15805..-3577 on x=-78290..-54183,y=8949..18096,z=-47920..-37582 on x=-44972..-27636,y=-56757..-33114,z=43862..61796 on x=34720..58327,y=40641..60954,z=5688..14788 on x=-56983..-26271,y=-69520..-43968,z=5457..30306 on x=52234..80932,y=-28451..-12788,z=25327..31570 on x=-20283..-10624,y=55145..77699,z=-55377..-51731 on x=-8918..23862,y=-26789..-7902,z=78219..83878 on x=-81127..-49088,y=-33284..-13921,z=-50207..-32847 on x=3968..12957,y=62162..90459,z=-32604..-13525 on x=50536..63270,y=47029..71173,z=25852..40402 on x=-19947..3085,y=69295..98557,z=-7457..15697 on x=56416..88951,y=-49125..-23678,z=13033..31254 on x=-45415..-13431,y=-70617..-33184,z=-67667..-43697 on x=-25226..-16517,y=11281..39430,z=65912..87788 on x=32863..54130,y=33778..71445,z=42050..55059 on x=-61047..-29947,y=59749..68086,z=-42477..-13948 on x=-18251..9292,y=-89783..-58004,z=-41787..-15274 on x=5759..16739,y=31155..46337,z=-75036..-53352 on x=31554..54658,y=53243..73463,z=-26575..5972 on x=-33007..-6786,y=-62474..-41434,z=50315..75779 on x=27458..32973,y=22810..54163,z=-75563..-58647 on x=8075..18075,y=-50635..-24172,z=62978..85992 on x=-76736..-47443,y=-4014..19377,z=45970..58134 on x=-60157..-52753,y=-43338..-22023,z=-51719..-41956 on x=-3216..22631,y=49983..61450,z=-77551..-54695 on x=-46004..-40643,y=51830..62022,z=18230..48510 on x=42330..66450,y=-40592..-14557,z=-58845..-29636 on x=-32729..-9787,y=-91565..-69806,z=18117..35690 on x=-32002..-10885,y=-1443..14786,z=-90524..-68253 on x=50978..75653,y=7140..18805,z=-63220..-43305 on x=-64568..-49330,y=15278..36078,z=28629..42531 on x=19040..44557,y=-75487..-59006,z=-37514..-20407 on x=-2797..6071,y=-87782..-64015,z=-23722..-9160 on x=30427..40250,y=-51346..-20826,z=-76885..-46217 on x=-9837..5654,y=49778..66163,z=42263..63916 on x=-21072..11872,y=28390..51048,z=-77577..-49183 on x=31541..48623,y=37624..58494,z=-42361..-30931 on x=-56299..-27988,y=47361..70101,z=1213..10546 on x=-23456..-16890,y=-79546..-59160,z=-6743..10289 on x=14204..41142,y=56511..74601,z=5095..33434 on x=-36005..-14701,y=-68016..-39674,z=36553..63480 on x=60545..74232,y=15015..42503,z=-43149..-34200 on x=41594..65337,y=50002..72588,z=12856..37989 on x=-90432..-62701,y=-37837..-4386,z=-32554..-13392 on x=70315..83165,y=-40717..-23351,z=-28440..-1511 on x=-24120..5947,y=34921..55704,z=-69582..-46555 on x=-32209..-8756,y=-77077..-58552,z=-48224..-14837 on x=-43510..-17400,y=64412..85528,z=6143..27595 on x=36053..55013,y=53314..68720,z=-22332..-5189 on x=-29743..-3821,y=65395..78815,z=-9292..23641 on x=-69714..-38553,y=-44109..-30469,z=29793..51760 on x=62579..74277,y=11751..29748,z=23050..34754 on x=-2338..12874,y=75847..79442,z=10731..41551 on x=-47619..-35145,y=-52665..-37628,z=39702..49423 on x=-18665..-6319,y=-71514..-63562,z=42460..45818 on x=-30044..-12170,y=53793..59153,z=-63499..-40230 on x=-12567..16134,y=-90016..-66446,z=-35676..-19472 on x=-85062..-55201,y=4912..28423,z=-41593..-11980 on x=56423..80218,y=-37562..-16517,z=36700..48100 on x=-79818..-55704,y=11491..34326,z=8367..40952 on x=-26293..-12220,y=41552..57647,z=51547..73246 on x=-92036..-71546,y=10557..30361,z=-37285..-11767 on x=36855..65165,y=-77057..-59070,z=4400..24300 on x=-50136..-35853,y=35165..54382,z=37467..66189 on x=16047..55776,y=-39553..-11227,z=58349..80407 on x=27458..35035,y=-32489..-4540,z=-78886..-68473 on x=46937..76452,y=12250..27089,z=-55190..-45467 on x=-60706..-29052,y=-43190..-26027,z=48544..56051 on x=33102..61073,y=27580..41152,z=41873..64266 on x=-83817..-62138,y=-874..20403,z=-57292..-40933 on x=54691..83982,y=-26668..-1254,z=25108..50265 on x=-64405..-32749,y=44513..79090,z=-13114..-3445 on x=4627..28855,y=-38014..-18427,z=-78981..-56867 on x=39450..53446,y=42289..75373,z=-33901..-6131 on x=63899..90602,y=26653..55063,z=-10988..9550 on x=14634..44509,y=-78079..-56702,z=28926..52784 on x=38612..58844,y=41733..50901,z=-69067..-31286 on x=-76929..-61757,y=-65663..-31719,z=-735..7695 on x=28516..47164,y=-29956..-15347,z=-75568..-61002 on x=-50167..-42193,y=-40926..-30244,z=-60920..-47646 on x=-55502..-47750,y=54875..64454,z=-29489..-3798 on x=14430..36601,y=26459..39911,z=-79289..-57027 on x=25075..27283,y=52962..87505,z=18854..33830 on x=-58860..-43502,y=58845..85498,z=-18144..7960 on x=-53792..-49597,y=-62122..-48441,z=-6272..16303 on x=-1823..9424,y=-44705..-17073,z=70120..80148 on x=63692..82216,y=-19361..8359,z=33210..45303 on x=-11840..-2979,y=24389..52039,z=60315..71939 on x=-73992..-63729,y=-45246..-14461,z=-46112..-19286 on x=44923..62221,y=-54960..-42011,z=-38137..-20135 on x=14722..33976,y=-61145..-30720,z=-75360..-54000 on x=245..27732,y=58258..82234,z=30097..48740 on x=6991..26059,y=17174..25794,z=71284..89533 on x=35195..56084,y=51212..74918,z=-32483..-9615 on x=33703..66981,y=-60122..-54236,z=-53453..-17926 on x=-61940..-36371,y=-16581..-4570,z=-60706..-40703 on x=60760..77773,y=-33429..-9006,z=14598..31427 on x=18431..39521,y=-7515..9629,z=60150..89625 on x=54831..71507,y=20590..53690,z=18166..24092 on x=-25927..-4852,y=56797..80031,z=24590..44494 on x=58156..74392,y=-54667..-25937,z=-34893..-13568 on x=-46251..-30782,y=70616..92727,z=-10301..13242 on x=-54435..-31583,y=18809..57238,z=52002..64018 on x=-87191..-65448,y=21016..30554,z=-7539..18577 on x=-27162..-8066,y=-76175..-58675,z=-45390..-18705 on x=-28095..-21402,y=-70382..-55725,z=38509..56620 on x=49521..65654,y=31848..57013,z=29190..51381 on x=-75558..-48003,y=15704..38247,z=17226..43613 on x=23884..58026,y=50160..65808,z=6785..27572 on x=58063..93764,y=-22911..-4938,z=-11895..2739 on x=43350..68759,y=-71427..-46464,z=-6078..15892 on x=-33140..-3203,y=-20673..-10382,z=-75944..-67085 on x=-21259..-17037,y=67489..78783,z=-8541..11664 on x=36779..59339,y=24261..52940,z=-53125..-35093 on x=-30493..793,y=44829..70216,z=-52950..-47982 on x=45292..72628,y=-55273..-48706,z=-1598..9919 on x=29403..34110,y=-54445..-36095,z=43199..56783 on x=-59861..-33784,y=-53249..-37265,z=34591..65790 off x=41754..57148,y=-80200..-55875,z=3599..22722 on x=-10075..4386,y=27944..45112,z=-79226..-60131 off x=-15187..248,y=-83279..-72364,z=5037..32511 on x=54933..58881,y=12281..29091,z=-69028..-54121 on x=8090..25240,y=70064..81196,z=-16223..-13021 off x=-60400..-26105,y=-62607..-40191,z=47851..67422 off x=24451..46164,y=-75961..-52303,z=-49916..-25476 on x=-44857..-7989,y=-38916..-18382,z=-70680..-58913 off x=-72200..-43203,y=24727..57702,z=-44696..-7928 on x=26323..57990,y=-14888..994,z=-79264..-65525 on x=-48909..-40386,y=-73244..-64696,z=-323..16342 on x=35358..52991,y=10687..27904,z=-70944..-57912 off x=-23236..-4162,y=-29712..-17951,z=59106..79389 off x=53581..72320,y=6800..13298,z=-45872..-42480 on x=-43571..-35441,y=41386..68207,z=-44478..-35187 on x=29214..36514,y=2338..22755,z=54949..83144 on x=-84002..-51122,y=41833..51908,z=9476..15499 off x=7540..23221,y=-12461..-7794,z=-95431..-66096 on x=76564..93348,y=-9452..16724,z=-13630..7535 on x=24899..35662,y=-61799..-36371,z=50395..73121 off x=-23379..-14671,y=-61654..-26944,z=-66602..-52265 on x=-75965..-53958,y=-25180..-13183,z=24409..52392 on x=-10197..4622,y=-15474..1783,z=-92565..-76011 off x=45082..71453,y=9055..32401,z=53858..58811 on x=-76326..-55011,y=-39530..-20949,z=21859..44714 off x=32466..57949,y=29661..50902,z=38020..60279 off x=-48739..-19365,y=36215..74060,z=-61189..-33437 off x=-13146..-2771,y=9021..18827,z=60320..97125 on x=-224..15138,y=31517..57835,z=-83757..-53030 on x=48425..68878,y=14971..40195,z=-64239..-33895 on x=-3608..5152,y=-30571..-5399,z=75733..96504 on x=62972..67090,y=-52211..-34797,z=-11592..8052 on x=6468..27085,y=-75658..-53084,z=24332..51031 on x=-9175..29042,y=-47119..-33884,z=-82475..-62552 off x=-15847..4062,y=60344..89283,z=-30211..-17239 on x=25768..49899,y=62273..71708,z=349..10734 off x=42707..63210,y=13025..46778,z=36022..55110 on x=46293..67516,y=-7202..26002,z=-66272..-31228 off x=-62283..-34594,y=-38660..-16958,z=38044..60467 off x=-70095..-49102,y=31813..56709,z=8713..28863 on x=13788..17456,y=-12132..6791,z=61871..77520 on x=-43439..-29707,y=-56265..-39662,z=-72104..-38103 off x=13592..44088,y=-74894..-45793,z=37968..66601 off x=46700..52734,y=-40463..-19848,z=-69191..-42886 on x=20538..39375,y=61182..85768,z=15326..29409 on x=54417..76403,y=-19878..-1308,z=-42875..-26138 on x=-86317..-61464,y=-18403..3486,z=-18507..6337 on x=2786..19873,y=-20405..9939,z=59315..81073 off x=-59877..-54443,y=34487..69275,z=3488..18241 off x=-39007..-20035,y=4078..30312,z=-82731..-51587 on x=32588..56936,y=-76500..-67396,z=-21385..-397 off x=25080..41990,y=-28846..-19737,z=69970..78086 on x=23152..34879,y=52174..69560,z=27953..49114 on x=60684..71642,y=-30692..-3159,z=31270..54443 off x=-45205..-29098,y=58510..89307,z=-17925..2596 off x=19582..24130,y=-83134..-57590,z=35254..46862 on x=-11911..23624,y=-67005..-30930,z=-81907..-60918 off x=4727..24751,y=-39077..-37491,z=-71684..-61996 off x=-9593..7610,y=-9049..14670,z=62634..98129 on x=-66988..-43094,y=-62996..-35119,z=11118..43202 on x=-35998..-5275,y=-37152..-15041,z=-87055..-60774 off x=-14073..-1453,y=48138..72420,z=-55577..-47324 on x=53303..57735,y=-50475..-39459,z=28711..49776 on x=50327..79524,y=-20647..-7189,z=32930..64357 off x=-21585..-2673,y=67475..97316,z=-16225..10334 on x=12761..42162,y=-75198..-45687,z=27773..56590 off x=10780..29984,y=30806..53252,z=45151..82121 on x=46365..68175,y=-3920..2578,z=-68115..-55420 off x=26455..49250,y=-55979..-42110,z=-63322..-50217 off x=-62311..-44896,y=-70433..-49939,z=-6372..6167 off x=-68448..-49911,y=12490..21799,z=-66820..-50662 on x=11680..41135,y=42991..76600,z=38991..56525 off x=60371..92603,y=19664..34168,z=-32784..-13415 off x=-72850..-41597,y=-58644..-37918,z=-37165..-19623 off x=53858..74510,y=34819..52123,z=16497..43908 on x=48488..52121,y=-45360..-24737,z=-66885..-37749 on x=20448..57476,y=27537..48980,z=46019..57068 on x=-27248..-19724,y=41351..47693,z=-77216..-44436 on x=-52950..-33175,y=41728..62787,z=-16516..-11981 off x=-51177..-31463,y=-63233..-45533,z=32418..61549 off x=-37057..-12370,y=18117..43449,z=-74085..-60338 off x=-12503..2846,y=-42876..-30104,z=63819..75029 on x=60667..70952,y=-46497..-30751,z=16478..34217 on x=10069..26074,y=50365..61240,z=-68598..-56464 off x=17685..45785,y=44978..64857,z=53362..71129 off x=-73990..-42336,y=-72284..-40294,z=8863..26728 off x=68782..80879,y=22420..46148,z=-2329..26525 on x=59344..83826,y=-40162..-30633,z=2097..16442 on x=-27562..-10414,y=27820..58187,z=-65865..-46977 on x=36887..65981,y=-73709..-52311,z=-42786..-24070 off x=-20682..-3178,y=64806..78374,z=10659..34470 off x=-8804..15550,y=-8444..-2404,z=-96231..-65363 off x=-66648..-53156,y=-56554..-29056,z=-33726..-17793 on x=-203..26059,y=68129..80958,z=-43219..-27404 on x=47218..72444,y=35342..44493,z=-36229..-12760 on x=46904..60309,y=-54993..-32818,z=-50008..-30454 off x=-21694..-6209,y=-88469..-65433,z=-11873..12245 off x=-62399..-24805,y=28232..34853,z=51230..60419 on x=-79596..-57362,y=-48983..-34721,z=-13420..10701 on x=-6768..1790,y=-19645..-5406,z=-92627..-74287 on x=-33652..-18284,y=-23439..-8382,z=67655..90006 off x=16524..39458,y=29152..49162,z=55749..83384 on x=-54254..-34002,y=-88855..-70903,z=-22296..3410 on x=-20779..8521,y=-89181..-73450,z=-7812..26787 on x=1615..21625,y=-6080..17570,z=71668..83316 off x=-9715..12709,y=-50780..-22669,z=-74774..-69626 on x=9867..24037,y=12358..42384,z=72370..82642 on x=3224..30208,y=28864..51571,z=61883..84706 off x=-945..19284,y=66805..89823,z=25957..49425 off x=-25280..-6091,y=-97225..-62630,z=-19807..-7788 off x=-2250..13009,y=50093..83251,z=-51760..-30168 off x=-54440..-34334,y=26817..48120,z=48074..60160 on x=23262..49261,y=40455..52393,z=-60959..-43615 on x=-23294..-2268,y=-52310..-24691,z=-87802..-57989 off x=-26612..7840,y=72808..79999,z=-29713..-3816 on x=54391..88234,y=-51754..-15468,z=1945..19324 off x=17508..32841,y=-73524..-65420,z=-35218..-11372 off x=31152..49478,y=-70736..-54693,z=-43913..-40242 on x=53480..64046,y=-62586..-42748,z=34500..47779 off x=34058..63228,y=-61928..-58936,z=-31573..-3659 off x=-58697..-39679,y=-81148..-49181,z=13624..23687 off x=-27245..-8270,y=35092..58039,z=40192..57884 off x=32739..63309,y=-40682..-17682,z=47869..70035 on x=52219..64202,y=-67303..-51407,z=4800..23668 on x=-54654..-29433,y=-86817..-62196,z=-5556..23658 off x=-75279..-49504,y=-7178..9542,z=44327..53956 on x=-7810..8890,y=-30024..-89,z=66319..97476 on x=8400..36435,y=12009..44304,z=-80097..-67512 off x=22016..38709,y=71634..74972,z=-3129..1171 off x=48394..68796,y=44368..57057,z=-40373..-16910 off x=-56815..-38268,y=36694..67658,z=-47750..-32089 off x=-57877..-35052,y=46097..56601,z=33355..49073 on x=23011..37434,y=-53974..-23058,z=-61883..-45402 off x=11872..42043,y=19031..22704,z=-83665..-55245 off x=-73243..-46798,y=-4329..17893,z=-57779..-44793 on x=67456..73394,y=-22388..-14950,z=-37499..-28618 off x=30365..66533,y=-70682..-46579,z=-16208..-5031 on x=21360..45088,y=-76539..-50147,z=21845..41905 on x=-18419..-11559,y=76149..84053,z=-11328..-2185 off x=33020..55476,y=-15536..2658,z=64275..79458 on x=-48063..-26857,y=-20734..10735,z=-85808..-52673 off x=43790..66834,y=-56342..-29394,z=31254..58327 off x=67314..83024,y=-13230..17187,z=-23371..-4720 off x=-40007..-14810,y=-73067..-57103,z=-66195..-38082 off x=25841..57188,y=-26024..897,z=-87581..-52851 off x=45794..76267,y=-52081..-18959,z=-40107..-15901 off x=-40509..-4365,y=56716..81562,z=-22853..6830 off x=-77503..-45958,y=-63620..-34287,z=-19880..-7413 off x=-19264..12115,y=-19022..8117,z=-93523..-72932 off x=39766..60651,y=-59973..-42774,z=-28355..-7554 on x=-5185..26343,y=42329..68147,z=56719..69801 off x=-1117..14361,y=41023..50863,z=-73482..-62392 off x=14618..41995,y=-57249..-23838,z=-82100..-56433 on x=-73588..-51361,y=3468..30508,z=-52360..-20267 on x=12744..37529,y=-54963..-50978,z=-53987..-45070 off x=-72308..-43455,y=-38389..-24377,z=-50714..-45259 off x=-78117..-42852,y=-13721..13148,z=-55905..-37080 off x=-4467..22317,y=-12170..5957,z=71290..88500 on x=-95981..-66408,y=7590..8037,z=-2404..26148 off x=12232..45401,y=12849..45079,z=-78972..-62278 on x=-46581..-20385,y=43824..70561,z=32388..58000 off x=14142..24293,y=-26356..7327,z=-82833..-56772 on x=-62185..-54635,y=-62453..-44051,z=-17689..-15452 off x=7493..30003,y=51943..75363,z=19045..35329 on x=10852..22754,y=-21936..-12574,z=58047..81390 on x=-85885..-60870,y=-5186..26456,z=-18838..-15144 off x=573..10699,y=-12795..12158,z=62024..82285 on x=-53647..-41451,y=6744..19177,z=-65585..-52437 on x=-1937..13101,y=16787..44245,z=-89301..-69691 off x=11648..28117,y=65897..81495,z=-51744..-31456 on x=-34510..-23114,y=64316..84122,z=11745..26248 on x=46597..67036,y=-49078..-18339,z=-55106..-43379 on x=-1630..16917,y=44609..68512,z=50592..75476 off x=-21971..1123,y=24005..48686,z=60732..80668 off x=42871..68726,y=-60814..-42185,z=27184..53921 off x=38826..47043,y=-40691..-34285,z=-57815..-35188 on x=44616..56936,y=-18905..4924,z=53303..63015 on x=22934..47063,y=21220..45110,z=48969..72456 off x=31507..57059,y=41717..67987,z=-48794..-42062 on x=63949..80604,y=11054..40766,z=17043..53534 on x=28112..49371,y=-69150..-55767,z=-37760..-7539 off x=-39198..-18198,y=-10040..11413,z=-84459..-58961 on x=-21052..258,y=-11980..13528,z=-92447..-67079 off x=-72190..-65264,y=-11322..11452,z=20127..52589 on x=9456..34476,y=75111..90133,z=-3087..22015 off x=-48678..-16972,y=-41882..-11490,z=63832..72591 on x=711..33910,y=-92450..-65393,z=-19051..4525 off x=62421..84065,y=26556..40786,z=14281..29967 on x=-67588..-56095,y=28175..65003,z=22332..47033 on x=-70974..-36736,y=9539..20776,z=49351..68205 off x=-25177..13122,y=-61323..-41425,z=46642..75842 on x=-52446..-40486,y=-62884..-38244,z=20759..52144 on x=-42548..-33936,y=-53496..-46698,z=-50788..-30250 off x=33339..50697,y=-75051..-48370,z=36655..54219 off x=43213..72026,y=-22655..-11856,z=37238..51298 ================================================ FILE: advent-of-code/2021/inputs/23 ================================================ ############# #...........# ###B#B#D#D### #C#A#A#C# ######### ================================================ FILE: advent-of-code/2021/inputs/24 ================================================ inp w mul x 0 add x z mod x 26 div z 1 add x 10 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 0 mul y x add z y inp w mul x 0 add x z mod x 26 div z 1 add x 12 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 6 mul y x add z y inp w mul x 0 add x z mod x 26 div z 1 add x 13 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 4 mul y x add z y inp w mul x 0 add x z mod x 26 div z 1 add x 13 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 2 mul y x add z y inp w mul x 0 add x z mod x 26 div z 1 add x 14 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 9 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -2 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 1 mul y x add z y inp w mul x 0 add x z mod x 26 div z 1 add x 11 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 10 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -15 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 6 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -10 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 4 mul y x add z y inp w mul x 0 add x z mod x 26 div z 1 add x 10 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 6 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -10 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 3 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -4 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 9 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -1 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 15 mul y x add z y inp w mul x 0 add x z mod x 26 div z 26 add x -1 eql x w eql x 0 mul y 0 add y 25 mul y x add y 1 mul z y mul y 0 add y w add y 5 mul y x add z y ================================================ FILE: advent-of-code/2021/inputs/25 ================================================ ..vv.v>vv.>..>..>.>...v>vv..>.vv>..v>.v...v>vv.>.>....v>..v>.>.vvv>...>>vvvvv..v.v.>>..v>v.v>..>..>>v>>..v>.>v..>>>>>v.....v..>v.>v..>..... .>....>..v.>v>>>.>.v>....>.v.vv>v.>...>....>v..v...v..v>.>.>v.....>.v.v>.>v....v.>..>.v>>>>v.v>vvv>>.>.>v.>..v.v...v.>....>>v..v....v>>>vv> >v>>.vvv......>vv.>>>..vv>.v....>>.v..>>..v......v>..>>.>..v..>..>>v.v>v.v.v>v>.>>...vv..v.v>v>.>v.>vv..>>v.>.v.>>>v>>..v.>>...>...>v.>v>.v >.>..>>.v...>v.>v..vv....>..v>.>v.v.v>vv.>v..>.>v.vv.>..v.v.v..v>>..v....v>v>>.>v>...v>.>v>>vv>..v..>>>v>...>.>>>v.v.>.>vvvvv...v>v>v..v... v>.>>v..v>v>v>>v>v>....v....>>vv>........>.>>v.v>...>.>..v>..v.v>.>.>>v..v.>v>v....>>...v.>v>>>vv....>v>.v.>>>>>.....>vv.>v>.....>.vv.>.vvv ...>>...v..>..v>.>.v..vvv.v>vvv.>.>..v>>.>..v>v..v...>.>.v.v..v>.v.>..v..>vvvv>v>.>...v.v..>....v.>..>.v>.vv.v>..>.v.>.....>.>...v.>..>v.>v >.v.>>..>.vv.>..v>>v..v.>v..vv>v.vv.>vv.>..vv>.v...>v.>vv.>>..v....>.v...v.>......>v..v>...>>..>>v...v.>...>>v.v...>.>>v...v..>>..v.>>v..>. v.v.>>v...v....>..>..>.v....vvv.>..>.>...>>v>.>.>v>.>..>>.vv>.vv..v..>v.v.>.v......>..>..>v>v>>..>v>.>.vv.vvv>.v..>v.>>....v>>.v..>.>>>>.>v .v>.>.v.v>>v>.......>>>v>.>...>vv>>...v....>v>>.v>>v>v..>v.vv.>v>...v.>.vvv>..v.>v....v.v.>.>.v>.v>vv>.>...v..v..>v.>....vv>.>..>.v....v... vv....>>v.>.v...v......>.>>>.vv>v..v.>.v.>...v.>v>.>.v...>>.>>>.>..vv.v>.>...vv>v.v>vv......>vv..v.v>v.>.>>>v.>.>>.>v>...v>v>...v>v..>v..>v >.v.>>.v..>>.>v>.>v.v...>.>....vvvv....v..v>v.>.....v>v.v.v>...v>v..>..>>>>v.>.v.>.>v...v.v.>v..>.>.vv>.v.v>>vv>v.>...>v..>..>vv>>.....v... v>.>..v.>>.......>...>vv..v.v>.>>.v.>>..>>.>>>....>..>...>.>vv>..v>.>...v.>...v..>...>vvv.v.>.v>v..v...v.vvv>v.v.>.>.v.>...v.v.....>v.>.v.v v.>vv....>...>.>v>.....>......v.vv..>....v>.>>......vvv..v..v.......>....>..v...>.vvv.vv>.....>.v>v..v...v>>....v..>v..>..>>>>.>.vv.>..v>>v >v.v>>..v..v>.v..v>.v.>>.>.>>>v...>>...vv.v....>v>...vv>>v..>...>.v.>.v>vv>....v.vv..>v>.....>v>vv......>>>>v..>v>>.....>v.v.v>>>..v......> v>>>>v.>>.>..>.>>.>.>>>...vv.v...vv>...>.v>>>>>v..>..v.>.>....vv..>>v..v..>..>.v>..vvvv...v..>>>>>v.v..vv.>.v>.>vvv...vv.>..v..>v.v.>....v. v>.v.vvv>.vv>>>.>.v>..>...v....v>v>.v...v.>.v.>v.>.v.>v.v...v>..>vv..>..>>.......v..v>>>>.v....>>.>>...>....v>.v>..vvv..>vv>.>v>>....v...>. .>...v>...v.>v.....vv.>>>.>.v..vv.vv.vv>.>>v>..v....v.v>v>v>..v>.>v.v>....v...>v.>.v......v...>.>vv>v.v...>.v.>vv>vv.......v..>v.v.vv.>.v>> .>.>.>>..>..v....>.vvvv>.>.v>.>v.>.v>.v...>...>..>>.>>.>....vv.>>...>v>>v.>v......>.>>vv.v...>v.>.>v.>>..>>.>.....v.vv.......v.>>.>>v>.>v.. >...v.>..v>..vv>vv..v>vv>...v...>..>v>.>v....vv.>v>v.v..>>v>.v.>...>.v.>.vv>>.v.vv.v>>>v..v.vv.vv....>>.v..>vv......v.v>..vv>v.vv>.>vv.>... >.>v.vv>>>.>v..v>...>.>..>>.......v.vv.>>>>.>v>>..v.v.>v>....v>v.>.>v..v>.v>>...v>.v.v...vv..v>>vv.vv>...v.vv.v..>v>.>..>>...>>>>>v..>vvv>> >.vvvv..v>..v....>v.>>>vv>.v..v>....>v>v...vv....>>>v..>v....v...>vv.>>>>.v.>.>v>>vv.>>vv...>>v>v...>>..>>.>>....>.v..v..vvvv>.>>>v.>vv..>> ...v....>.....>.v.v>.>...v>v..v.>.vv..>.....v.v>v..v>>>.v.v.>.>..>>>v...v.>.>..v.v...>.v>v.>..v...>v>.v>v.v..v...vvvv...>.>>.v.>>>..>.vv>.v ....>...v.vv>>..>.>.>v....v.vv.v.v.>>..>..v.>>..>v..vv..v.>.vvv...v..>.vv.v>..v.>>v...v.v.>v>.v.>v>>vv.>.>..v.v>...>.>v..>>v>....v..v.>vv.. ....>>v.vv>vv......vv>..vv>..>......vvv.>v.v...v.>.....>..>>....>..>vv>..v..v>.>v..v...v>v..>....v..v.v.....v>>v.>v...v>.v...>.vv>>..v.>..v .vv>>v.v..>.>>vv.v...>.v.>.>v.vvv.>.v.>..>...>.>..v.v>.v.v>..vv>>vvv.v.v>>>.>.v..v>.>.>.v.v.v>>...>v..>..>.>>v.v.....v...>...>.vv..>v..vv.. >v.v.vv....v..v>.v.vvv..v.v.>>>.vv.>..>>.v......>..vv>>.>...v>...v.v>.vv..v>v>.>>..>.>.>>>>>....>..v...>>v>v>...v...v>v..>..v.>>>.......vvv ..vv.v.>vv.>.>vv..v>>>>>.vv.v>>..>......>v.>.v.>...v>vv.>.>.v.>..v..vvv>..>.v..>.>.>....v>>v>v>....>....>>v>>.v....vv>>>..>.>>>vv....v.vv>> ...v.>.vv.v.>>v.v..>v>vv........>..>>.......>>.>v.>v>v.>...>>...>.....v..v>..v>>..v...v...>.v..>>..v>>.>>....v..>..>..v.>v....>.....v>.v>.. .>.>vv.vvv.>v..v.v.v..v..>.>>..vvv>v>>>..v.v.>v....vvv.v......>>...vv>...v>v>..v.>v>>..v>.>.v....v....vvv.>>.v>..v>>>v>..v...v...>>>.vv.>v. ...vv>.>>>>.v..v.>.v.v.>>>..v.>vvvvvv.v>........>.>.>.vvv>v>v..v>>>>v...v.v>.>..vvv..>..vvv.vvv.v>>>>.v..v.>....v..>>.vv..vv.>..>>.>v....v> >v>>v>.>..>>.vv>v.vv..vvv.v.v..>.v.>.>v>.>....v.>>..vv>......>>v>v.v.v..>.vv.>..>>.v>....>vv.>v.....>.v>>.>.v...>>....v.>v.>....>.v>..v>... .v.v.vv.>....>>v....v......>>>>.>.>.>....v>..>>....>.>vv.v>>.>.v.>v..>>>.v.>.>..v>>.....vv.vv.v..v>v>>..>>.>v>...v>>>..>vv>....>...vv.v...> >..>.vvv..>vv>>..>.>...>..v.>>.....v.v>v.>v.v>.v....v.......>v...vv.vv..>>.v..v>.v.>>v.v..v..v......v>>>>>.....vv.vv..>.v>>>vv.>>>.>.>....> ..v.v>>vv..v>>>...v....>..v.v.>vv.v>>>.....vv..>.>.v.>.vv..>>.>..>>vv....>v.v.....>vv>.v....>.v..>.>v>..v.>v.>>>v.>...>>.>v..>>v.v..>....vv .>v..vv..>.>>..v>>vv>....>..v..v>>>.....v.v>.>>....vv..>vv...>..>>.vvvv.>>>.....v..>v>>>>.>.>vv>....>...>v.>...vv>......v>vv.>vvvvvv.>>>>.v >>....>>v>..>.>v.>....v.vv.v>>.>.>.vv...v>.>........v>.>v>v>.....>.vvvv>..vv....v..v..>v.v..>v>....>>.vvv.v.v..v.>.v>vvv>.>>>.>.>.vv.vvv>.> .>>.>..vv>>>..v>.>vv..>>.vvv>...>...vv>....>.v..>v.>>.v..>.v.v..>.v.v.v>.>...v>.>>v..v>.>>v..vv..>v.>.......v.>..>v.vv.v>..>..vvv.>v>>.>.>> .>>..>.>.v>v..vv..>>>.vv...v.>.>v..>.v.v...v..>....>.....v..>v.>.v.>..v>..vv..>.>.v>v....>>v..>>.....vv.......vvv>>>>v...>>.v....>.v>..v.v. .v.v...>.>.>..v>>.>>>v....>v...v.>>.>>>.......>....>....v..v.vvvv>...v..>v...v....>.>v>v.v.v.>>vvv...>...>v.>>vv..v.....v>>>v.>vv>.>>.vv>.v .>.>v...>.v..>..>.vvv..>...>v.v.>....>>v>..>.v>...>v.>.v.vv..v..v.>v>vvv>>v>.v>vvvv.>>.v>>.>..>>.v>>v>.v...>..vv>v.vv...>v..v.....v>...>v>> >.v.vv.....>>v.>v..v......v.........vv.v.....v>>.vv>.>v..>.v>.v.>..>..v>.>..v.v.>..>....v.>v...v...>......v>.>.>.....>.vv.v>...>.>>>..>v..v v>..v..>v>>>>.v....>v>vv>vv......v>>.>>.>vv....>vv>vv.>>...v>>v>v..>>....v>>.v.>..>v>v.>.vv..v..>.v.v.....v.v.>>.v>.....>.....>..>.v>>..v.v .>.vv>v>.>v>>>v.......v...>v.v>.v>vvv>>v>>v>>.v.>v.v.>v.>v..v....v..v...vv..v>.>.v>..>..v>..v>v>.....>vv..v>.>v>.v>v>...v>>..v.....v>v....v .>>.>.>>..>....>>v....v...vv>.....v.>vv>v.v.>..v>v.>.v.>>.>..v.v.>v.>..>v..>>..vvv>>>vv>..>.>v>>vv..v....vv>v..vv.>.>v....v.>v>v..>>>>>.>>. >..v.v.>..>.vv..>>.v....v>..>.v>>...>.>v.v..>>.v>.vv>v..v.>>>...v.>..v..v...>...v.v>>.>.v>>v.v.>.>.v.>.v>.......>.vv.v>>.>>v>.>>v...>>..vv. v>..v>.....v....>>>.vv..v..>v...v.>>....>>>...>.>.....v>>.>....>..>>>>>...vv.>.>.v.v>.v>......v..v.>>..v........v.v>..>...>....>....>vv.v>> .>>>..vvv.>v>vvvv.v>...vv.vv>v..vvv>v...>v....v.vv>.v.v...>.......>v>..vv>...>...vv>>>....vvv.>v.v.v.v>>.vvv..>..>.v>.>v.>.v..v>.v..v>v.v.v ..>...v.>v.>>.>v.vv.v...>v>.>..v..v.vv.vvv..>...v>v>v..>>>v>..>>>v>.>.v..>.....>>vvv..v>...>>>>vv.v.>.>......vv>>>vvvv>..v.>vvvvv.>v>v..v>. >>....v..v.>.>>.v...vv......v....vv...>>..v>>>.v...>>.>..v.v..>....>>v.>vv>vv..v...>.v..vv...>.>v..>..>.v.v....>v.v.>vv.>..v>>v....>..v>v.v vvv..>>v...>.v.v...>.>v.v....>...v.>.......>.>..>>v..vv.v>....vvv>.vv.>vv.v.vvv..>..v....v.v...>>vvvv.>.>>.v..>v.>.>>>..>>>...v...v...>>... .>.v>..>..>.....vvv>v..>v..vv.>........v.v>..>..v.v.>v.>v>v.....v.>>>..vvv>>.v..>v>v...>>>>.>v..v..v.>..v>....>..>>v..v.v.>>..>>..vvv>.>v>. >........v>..>>>..>v..>.v.>....>v.v>v..>.>>v...v>.v>v>.>>vv....>..>..>.>vvv.v>.>vv.v..v.>>>>....v..v.....>>.>v>>v>v..>>>.>..v..>.>...>...v> >>>.>>>vv>.>>.vv.v.>v>.v>...v.v..>.>vvv>vv>v.>>..>>..>.>vv.>..>...vvvv>..v.>v.v>>......>.vv.v..>....>>.v..v>>.>>v....v.vvv...v>>v.v.>v...v. >>>>>>..v..v...>vv.>v..>.v..>.>v.>..v.>v.>..v>...>>.>.>.>.>v...v>.v..>>.>>>.v.v>v..v.>>..>...>..v.vv.>....v.>.>>.v..>.>....>.v.v..v>.>v>v.v v.....>.>..vv...>v..v.>.>vv>.....>vv....>>vvvv.v..>.>.v...>..v>...>..>>vv..v..v>....>v..>.vv...>vvv.>>..v.v>>.v..vv>..v.v>.....>v.v..vv..v> ..v..v.v>..>.vvv>..v..vv>v...>.vv..>>>...vv.>.vv..v.v>.>.v.v>v>....>>v...>.>..>>>.>...>v.>.v>>vv.>.>..>..vvv..>.v>.>vv..>..v.vvv>..>vv.>... >v.>.>v>>..v>>>v>.>..>>v>v>>...>..v...>.......v..>.>>.v.>>..v...vv..>>.>.>>>v..v...>v...v.v>..v.v...vv>v..>vv>v>..>..v..>..vv.>>v..>....>.v v..>v..v>vv..>v...>..v.v>vv....>...v>>v>.....>>.v.vv.v>..>...vv>vvv..>vvv.v...>...v.v>.vv.>.>.v..vvvv.>...>vv.v>v.v....>.v...vv.>vv>.vv.... .>v..v..v>vvv...v.>..v>vvvvv>>....>>.vv...v.>.>v>...v..>.v.v..vv.vvv>>...v.>..v......>v>.>>v>.v...v.>..>.v..>v.>>..>.vv.>>>...>>>>>v>>>.... v.....>v.>..>...>vvv..>>>>v.vvvvv..>v.>.>.>....v>..>v.v>...>...>..v.v.vvvvv.v>>>...>.>>>..v..>v.v....>..v...v.>..>..v>..>>......v...>>>.>>> .>.v>>v.vvvvv.v..v.vv.>>v.....>>v>..>.v.v>>>>>vvvv...>>>v..>>...vv.v...>vv....>>.>.v..v.v.>>v.>.......>.v>v.vv....>vv.>.>v.vv......>.>vv.v> >.....v.>....v.>>vvv.vv.>.vv.>>v..>.v.>vv.>.>v.v.>>..>..>v.v.>>.>>.......vvv>v>>>.>>v>v.vv>..v>v>>>v...>vvvv>.v.....v>...v.>v..vv>v>.v.v>.. v..v>.>.>......v.v>v...>.>>.>>vv>>>vv.>.v>v>.>v.>>v.v.v..>v.>v..v>>v>>........>.>v..v>...>.v...v..>.v..>....>>.vvv..>>v.v>v..>...v........> v.v..>>...>>.v.>v>.v.....v..v>>v>v..v.>.>vv..>v>.>.....>..>...>.v..>.>.v>...>>....>.>>v.v.>v..>>>.>..>v>v.>.>..v>....v...vvv..v.v>.>.v...vv v..v..v.....vv..>v>..v>v.>v.>>.>.>..v>....>v>v.....v..vv..>..>.v>v>v..>>v.>..>>>.>...v.>......vv>..>v>v.vv>>v..>.>>v>.v..v...v....v..>..vv. ...>.>.v.....>>>v.......vvvvv.v>>>v.>>.v>v..v.v..vv>.....>>.>>>v>..v>>>>>..v..>>>.vv....v>v....vv..vv.vvv..>.>.>>>>.vvv....v.>>.>..>>...>.. .>>.v.vv.v>.>>.v..>..>.v>>..v...>.>>.vv..v>.>>..v..>..>>.>.vv...>v>>>>..>.>>v...v..v.>>v>>....>..>>.v>vv..vvv.>.v..>v..v..v>..vvv.v>..>>.vv .>..vv>.v>.....v>.>.>....vv>vv.v.>..vv>..v.vv..>vv...v>>>>..>..>.v..v.v>>v.>..v..>>..v>.>v.v...v....vvvv>v..>>>.>.>v..v.>.v>v..>>.>.>>.vv>v .v...vv..>>v>>.>..v..vv>>>>v..v>>.v.>>.v.>>v>>>..v...>>.v.v>>..vv>....v>..v.>.>.vv.v>..>>...>....>v.v>..v>vv..v..vv.>v..v..vv..>...>.v..... ....>..v>>v.v..vv...v>..v.>>v.........>>..v>.>>>vvv>..>.v..>v>.>.v>..>..v..>vv.v.v>v..vv>.>....>..>....v>>v.>.v..v>>.v.>>....>..v>.v..v>>v. ......>>>..v.>...v>>vvvv...v>v...>v>>>v.>.>...v...>.vvv.>....>.v.v...>.>>..v..v..>....>v>...>.v>v.v...v>.>.v..v.>>.>.>v..>.>.v....>v.>>>vvv .v.v...vv...v>..v>vv.v..>.v>>...>.vv..v.>v.>.vvv>...>v>>>>.>..v>>>v.>v..v..v>....>.>vv>>.>.v.>..>v.....v..v...>v...>..v......v.v.vv..v>.>>. ..>.v.>>>>...>....>v.>..v...>v.>.v>..>v>.>vv.v......v>v.>.>>......vv..>v...v..vv..v..v.>.....vvv>.>>vv..v.....>v.v.vv>v..>.vvv>..>..>vv>.v> vv.>v...v>..>>....>.>...vv..vv>.vv>..vv>>.>v...vvv.>..v.v...v...>vv>.>..>.vv>......>.>vv.vv..v>>>vv>>.v>vvvv>vv>>>..>......>.v>>>v.v>.>.vv> >>>v.>..vv..>v..>>vvv.>...v>.v.>v..v>>v.v..v...>>>>.vvv.v>v.v..v>vv..>.vvv>.v...v.....v>>v....v.>>vv>v..>v>....v.>.>>.....v>>>.v>..v.>v.v>. .v.vv>>v.>...v>.>v.>.>.>>vv.>..v.vv...>>vv>..>v.>>>.v....v.>>vv.>.vvvv......v.....>>v>...>...>vvv..v.v.v>.>.v..>>v>v.v.vv>v......v>>v.>v>.. v>..>...>vv..>.v.>.v..vv>v>>>...vvv>..v.>.vvvvv....>..vvv>.>.....vv>v.>>.>v....>>..>.>..vv.>>.....v..>...v...v.>..>>.v>vv>..v..v>.>.vv.>..> v>....vv>.v>.>>..>.>.>v..v.>>vv..v...>v...>>.v.vv..v>v.>..v.v.v>.>.>>..vvv>.v>......v....>>>>>v>.v...>.v.v..>v.v..>v....>.v.....>..>...v>.v .....vv>...>.vv..v>.>.v.>.vv.vv>v..>>.v.....vv.>>>>.>.v....vv.v.>..>...vvv....v>v.>vv.>..>....>.>.v>.>>>..>..v>...vv.v>>.>>.v..>>>.>v...>.. ...v>v.v.....vvv..vv>.>.>v.....>>.>vv.>.v.v.......v>vvv.....vv...>>..v.>>.>..>.v...>>>..>..v>.v.vv....>>.>>...>v>v.>>.>v..v..>....>....>v.> .v>.>.v.v..v>v..v>...v..>>v.>v>vv.v.....v>>..>.......v>.v.>>>>>v>....>>>vv>v.....vv...v.vvv.>...v>v...v>..>.v.v.>..vv....v.vv.....v.>..v>.. >vv....>.v>>..v..v>vv.>>vv..>.vv...vv.>.........>v.>>..v.>>..>.v>vv.vv.v.>v.v>>.v.v..>>v.v.v..v.>.>..>..vv.vv..vv.v.v..>...>.vv.v.v>..>>>>v >..v.v>v.>.v>v..>.v..v>vv.>v..v>v....vv>>v..>...v.>>..v....v>....v......v..>..v....>.>.>.vv...>v.v>vv>..>..v.v..>>.v.v..>..>.vv.>...v..>>vv .>..v..v.v>.vv>.vv>..>.vv>.>.v..>v...v...>.v..v...v..>...v..v>.v.v..>>...v.>v..>..vv...>.>..v..>......v.v..>....>v...>.>v...v>.>>>vvv>.v.>v v.>>.>..v.>.vv.>..>>>.......v>.v.>....>..vv>v>>v...>>v.>>vvv..>vv>..>v.>>.>>..v..vv...>..vv..vv>.v....>v.>.>.>....v...>>...>>..>..>.>...v>v ...v...>.v>..>..vv..vv.v>>....v..v.v>.v..>.>v>v.v.v>.v.>>v>>v>.v..>....v.vvv.v.>.>>..>>..>.>.....>>.v.>.v..>>>vvvv>.>....>vvvv>>>.vv....... v.v...>>..>.>>>>.>...>..>.vv..v..>>>...>v>..>>>....>..v..v.>....>v>v..v>v.>>..>vv>vv>...>>..v.v.vv>>..v..>.....v..vv>>.v>>>>v>>>.>.vv>...>> >.v>v..>.>v..v.v.....>....vv>.v>>..>v.>>v>.>..>....vv.vv..>vv..>..>>.v.v.>.>>......v.v>.>>....v>v..vv>>>v>..v.>..>v..v.vv.v>v>>v>.>>.>v.>.v ...>>v..>....>......vvv.>v..>>vv....>v..>v>>v>.v..>.>>...v>>vv.>>.>...v>>v...>.v..vvv..>....vv....vvv..>v>..v.v>v.v.>vv>..>..>..v.v.>.>>vv. v.v..vv.>>v>v.v>.vv..>v>v.>...>.>.v..>v.>>>>..>..vv.v>..v.v.>.>vv>v.>..>....v...>..>>.>>v....v...>.vv..>vv.>>>..>....>>v>v...vvv.v.>..>.... v>...v...v...v>.v...>>.v>v...>......>v...>..v..>>..vv.vv.....>.>vv....v.v.v>vvv>..v..v...v...v>vvv>>v>..>.v>.>......>v....v.>v>>>....>vv.v> .v>.v...v.v.>>.>vv>...v>>..>.vvv.....>..vv.....v.>v.v>.....>.>....v>...>v.v.v.v>>.>>.>........>.vvvvv>.>.>vvv..>..v..>>v.v.vv>>>.v>.v...v.v .vv.>.v....>.>>>.>.>.v>.>>>v..vvv....>v.>.v.>.>>vv>.vv.>v.....v.>>.v>v....vv.......v>.>.>v>....v..>.>.>vv>>..vv.v..>..vvv>v..>..>>>v..v..v. .>>.>.>v.vv....>..>v>....v..>.v.>..v....>...>..>v>>>>vv....vvvvv.>v....v>.>>.v..>..>..>.....>.vvv>>.v.v>.v....>>>>..v...v>vv>.....v..>.v.vv .vvv>v...>....vv>.>>..>v.v.....v.v.....v>.>>.>v>>.v>v.v.v>vv.vvv>.>....v..v>>v.v.v.>>..v.>v.>.>........v.vv.>.v..v...v>.v.v.v.v>....>>vv.v. vv.>>>...>..>>.....>...>....>..>.>>.>>>.v.v...vvv.....v>..vv..>...v.>.>v....>v.vvv....>...vv.>v...>>>..>>.v...>..>.>..>..vv...vv..>>.v.v>v. .v.>..vv..v.v.>>....>>..vv>...v.vv..v.vv.>vvv...>vv...v..v.>...v....>>.....v>.v..>.>>>...vv>.v..vv>>.v>>>.>v>....vvvv>>.v.vv>....>v..vv.v>> >>>>>...v.......>.vv>>..>.v.>.vv>.v>vv>v.....vv....>>.>.>......>.>.>>>.v.....>.v>v..v.....vv.>.....v...vvvv>..v.v>.v>.v..>>vv.......>vvv... >..vv>..v...v...>>.>v>>vv.>...>>>..vv.>v......v.vv>>>>>.vvvv.........vvv>.>.....vv.v...v......vv......v..v.....>v.....v>..vv.>..>vv.>>v>v>. v>v..>v.v.v....>vv>>>>v..vvv.vvv.v.....vv.v>..vv..v>v..v>..vvv>>.>..v.vv>.>v.>v...vv..>v>.vv..v..>>v.v..vv>>.>>>vvvvv>.vv>.>.vv..>...>.v>.> .v......>v.......v...v...v..v>>vv.>v.vv.vv.>v.v...>v.>v.>vv>..>v>v.>.v.>.>>..vv.vv>.>>v...>v..>v.v>v>>..v.v.v>..>.>>........>>vv......vv>v> >..v..>v.>>....>v>.>...>......>.>...v.>.>.>.v..>.v>.>>...>..v.v...v..v...>.vv>v...v>>.>..v....>>...>>>.>..v>v.v>v....v>>.....v>..>>>...>v>. v.>vv>.>.v>v>v.v..>>>v>.v>.....v.....v>..vvv.>>v>..v..>.>.>..>.v>...>>>>...>>vv>...>......>..>..>vv.>v>>>...>>.>..v>>>...vv>...vv..>v.v..v> .....>v.v>v.v>>>.v..>>..>>>....>..vvv..v..vvvv....vvv.....>>v.>>>....vvv..>v....>v...>v..>.>v>v.vv...>v.vvv.....>v.v.>.v.v.v...v......>v..> >v...>.vv>v>...v.>.v.>v>v.v>..v>v>v.>v..>vvv.>...>>>.>..v.>.....>v>.v.vv>.v.>v>>..>>v.>...v...>>>.....>...vv>vv>.v>>....>>...v>vv...v...... .>..>vv.>.>>.v>.>v..v>v.....>>....vv.>..>>>.v.v..vv>.>>.....v..>>v...>vv..>.v>>>.....>>.>..>.....>..v.>>v.v>.v....>.v......v>..vvv>>>>v>v>. vvv.>v...>..>.v...>.v>v....>>...>>.>..>>...>v.v..v.v..>..>..>.>.v.>..>.v...>..>v...>v.vv..v....>..>...v>>v>vv.>>.>>v.v..vv...>>>v>.v.>v...v .>.v..v.>>...vv>>.>>v>.vv.vv......>..v.v.>....v.v.>v..v.v...v....v.v..>.>v...>v>.>..>>>v>>v>v.>v>>.v....v...>v..vv.v....>>.>>v>>.....>.>>.. .>.>....v>.>>......vv...>.>.>..>.vv.>....>.v>>>.v.vv..>.vv.....v>.vv>>>..>>.>v.vv..>v>..v>.>....>>..>.v..>v>.>v..v.....>.>>.v.>.>..v.vv.... ..>.>v......>.vv>....v..vv.v.v.v...>>.>vv..v..>v.>.>.v.v.....>>>.v.>.vv.v......>vv>..v>>.v..>.v...v..>.....v..>>..>....>.......v.>..>.v...v .>.v>>v.v...>.v>>..v...vv.>>.>v..v..v.>>vv>.v>vv..>....vv>.v.>v>vv>.vvvv>vvv..>.>.>vv..vv>v>>.v.vv.>>...>vv....vvv>v.>.>>>>.v..vvv.>....v.> ...v.>..>..>.>.>..vv....>>v.v..vv.>.v>..>v..vv...>>>v.>>.>.v>v>v..v>v....v.>vv.....v>v...........>v...>.>vv>..v>>v>vv.v>v..>>vv...>v.>..>.. ...v...v..>..>.v.>.v.v>..v....v..vv>.>..v..>...>v>>>..>.>...v..v>>>>>vv..v>...v>v.....vv.>.v......>.....>.v>........vvv>v>.v..v......v.>vv. ..>v>.>.v.v.v..vv....>>v..>......>.vvv>>.v...v>.....v>>v.v>>..vv....vvv>>.>vv....v.>....v....v..vvvv..v..v>..>>.......v.v.>..v.>vv.....v... ..>vv........>...vvv..v.>...v...v....>>>.v.>.>v..v.>v........v..v>...>>..>...>v.v..>..v>...>>>...>v.>>>v>.>.>....v...v.v...v......>.v..v>.v v>>v>..vv.v>.>..>..>>v...>>..vv.vv........>>.>..v.v....vvv>.v..v.>....>>>..vv>.>v..>.>.v.v.>.>v.....>....>.>>.v.v>..>vv.>.>vv......v.>.v>v> v>v>>v>...v>.>.......v.v.vv.vvv....vv..vv.v.v>>...v.v>.v...>vv>.>.>.>..>..>v....vvv.v.......>>..>>.v...>.>.v.v.vv.>vv...v.v.vv...>...>>..>v >.>...>..v>v.v.>.>.v>>v>>>..>>>..>..>.>>......>.v.>.v>>>>>.v>.v.vv>v>.v>.v....>.....vv.>vv>v.v>.v>....vv.....vv>>>...vvvv......v>>.......v> v>.v.>>..vv..>........>>vvv..>>.v>>>>..>>v>.v.v.vvvv>..v>>.>v.>....>vv.v....>.vv.>.vv..v>>..>.>.>..v.>.v>vvv..>>>..vvv.>v....>......>.v...> ..>>.v...vv>....>.v.>v>v>...>.........v.>vv.>.>v.>>.v....>>.>...v>v>>v>vv>.v>....vv..v......vv>.v.>>vv.vvv>..>....>.>v.>>..>v..v>.>....>.v. .>>v..>..>.v..v...>v.>v.>>....vv..>v>vv>>v>v....v...>v...>.v.>>>...v.v....>v..>..v.v....>.>>..>>>..v.vv.v.>..>......>.>v.vvv..v......v>.v.. ..>>v>vvvvv.vv..v..v>v.>..>v>..>..>.vvv>.v>.vv.>.>v>v.>.....vvv.vv.v..v.v...>>>v.vv>..>v.>>.v.vvv.v.>vv......>.v.v..v>.>>vv..>....vv...v..> .>.>.>.v..v.>...>.>..v..>v.>>v.>..>..v>.>.>..>v>......v.>..>...>....>.>.v>>>.>v.v>..>v>>..>>>..>.vv>.>v...v.>..>..>.>>.v.v>>.......>.vv>vv. ....>>.>..>.>.>..vv>.v>v.>vv....>....v...vvv.>v.>..>....>...vvv>v..>v.....vv..v.>vv>.>>..>..>>.v..>.v>>v>.vv>.>vv..v...>..>vv>v>>>>v.>.v.v> vv....>.....>.v...v>.........>.>.>.v>>vv>v..vv>v.v>v.vv>..>....>>.>v..v...>.v.>..vv>.>.v...>vv>.vv>vv>>>.v......>..>.>.v>..v..>.v...>.>.v.. v>.>...v.vv..v..>vv>>v..v.vv.vv...v.>.vv...v>.>.v>>..v...>...>...>v.>....vv>.v>..vv>..vv.>.vvv.>>v..v...vv.v.v>.v>....>..>vv..>.v..>>...>.. .>.>v>v>..v>>...>.>.>v......v>.>.v..v.>v.vv.>v..>v>v.v>>v..v.vv..>>>>>...vv......>v.>>>.>>...v.v>.v.>>.>vvv>>..>>vv.>.>vvv.>.>v>v.....>.>.. ..>>...v.>.>>>v.vvvvvv>vv......v.>>.v>vv>.>.>.>.v...>vv.>>>>.....vv.>..>.>>>..v>>>.>v..>.>.>...>>.>.>v..>.vv>>.v..>.v>v..vvv>...>...v..v>.. ..v..>vv..v...v...v.>.>..>v..v..v.>.>>v>.v....vv>>.....>>>v.>.v.>v..>.>v>v.v.v.v...vv.v..vvvv.>.>>.>..>>.v..v...v>..>v..>.>>..vvv..>.>>.>.. >v.>.vvv.>>.>.>..v>.>.>>...v>..>>v>..v>>.....vv>.v.v....>>...>.v.>.v.....v...>.>..v.>v..>...>.v..v..v..>>v...>>>..v.>.vv..>.>vv..>..v.....> >.v..v.>.v.v.>.v.vv.>vv>.v>.vvv>...v>.v..>>v>>..>.>>>>>....v>vv..v.v..>>v...v....vv.....>vv...>..v.v....v..v>>.>>.v.>v>vv>>......v...>.vv.v vv..vv.....v.>v......vv.>v...>.>.v>....v.v.....>v>..vv...>.>..v>>.>..v.v.>>..>>..v.v.vvv.v.vv.v>vv.>v>....>>v>>>>.....>v.....>vv..>.>..>v>v vv>...v>....>..v>vv..v>.v..>....>v>.v.v>>v..>v.>.....>vv.>>.v>.>v...v..>v>vvv...>....v.v.>v.>..v>v>>.>v..v..>vvv>..>.vv>...>>..>..v.>.>>v.. ...vvv.v.>>.>vv..>..>v..>>.>.......vv.>.v...vvv>.v.>..v..>....vv.vv.>>>..>>>.v.>v>.>>.........>.>>v.>v>>>....>>.>.>.>v...v.vvv.v.>.v.>>>>v> >.v..>....>.v.>...>v>v.v>>>..v.v>..v.>v.v.>>v>...v>>..>>vv>>.>.>>>>vv.v>...>..v..>.....v.>..v...vv.v...>v..>>v>.....>..v.>.v.>v>v.v.v>.v>.. >>v>......>>>.>v>..>v...>>v>v>..v>....>.>.>.>v>...v.vv>v>.>>..>.v.v....>>......v.>.v..vvv>...>.v.>v....v>..>>v>....>..>v>..v.>>v..>...>.>>> .v>..>.>.v..v..v...v.>v...v>.v>v.vv.vv....>>vv..>vv.....>>v.vv>.vv...v..v.v.>.......v...>.........>v.v>....>>vv>.>..>v.>.>>.>>>.v...>..>v>. ================================================ FILE: advent-of-code/2022/.gitignore ================================================ day*/day[0-9][0-9] day*/sample ================================================ FILE: advent-of-code/2022/day01/day01.nimble ================================================ srcDir = "src" bin = @["day01"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day01/src/day01.nim ================================================ import strutils, sequtils, strformat, algorithm let data = readFile("../inputs/01") proc calories(): seq[int] = for chunk in data.split("\n\n"): var chunk = chunk chunk.removeSuffix result.add(chunk.split("\n").map(parseInt).foldl(a + b)) result.sort(Descending) let part1 = calories()[0] let part2 = calories()[0..2].foldl(a + b) echo fmt"Part 1: {part1}" echo fmt"Part 2: {part2}" ================================================ FILE: advent-of-code/2022/day02/day02.nimble ================================================ srcDir = "src" bin = @["day02"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day02/src/day02.nim ================================================ import strformat var partOne = 0 var partTwo = 0 for line in lines("../inputs/02"): let first = int(line[0]) - int('A') let second = int(line[2]) - int('X') partOne += ((second - first + 4) mod 3) * 3 + second + 1 partTwo += second * 3 + (first + second + 2) mod 3 + 1 echo &"Part 1: {partOne}" echo &"Part 2: {partTwo}" ================================================ FILE: advent-of-code/2022/day03/day03.nimble ================================================ srcDir = "src" bin = @["day03"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day03/src/day03.nim ================================================ import sugar, sets, sequtils, strutils, math, strformat proc score(groups: seq[seq[string]]): int = groups .map(group => group.mapIt(it.toHashSet).foldl(a * b).toSeq[0]) .map(item => item.ord - (if item >= 'a': 'a'.ord else: 'A'.ord - 26) + 1) .sum let lines = lines("../inputs/03").toSeq let partOne = lines.map(it => it.toSeq.distribute(2).mapIt(it.join)).score let partTwo = countup(0, lines.len - 1, 3).toSeq.mapIt(lines[it..it+2]).score echo &"Part 1: {partOne}" echo &"Part 2: {partTwo}" ================================================ FILE: advent-of-code/2022/day04/day04.nimble ================================================ srcDir = "src" bin = @["day04"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day04/src/day04.nim ================================================ import sequtils, strutils, strformat let inputs = lines("../inputs/04") .toSeq .mapIt(it.split({',', '-'}).map(parseInt)) .mapIt(((it[0], it[1]), (it[2], it[3]))) var partOne = 0 var partTwo = 0 for (a, b) in inputs: let overlap = (max(a[0], b[0]), min(a[1], b[1])) if overlap == a or overlap == b: partOne += 1 if a[0] <= b[1] and b[0] <= a[1]: partTwo += 1 echo &"Part 1: {partOne}" echo &"Part 2: {partTwo}" ================================================ FILE: advent-of-code/2022/day05/day05.nimble ================================================ srcDir = "src" bin = @["day05"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day05/src/day05.nim ================================================ import strutils, sequtils, algorithm, sugar type Input = object stacks: seq[seq[char]] instructions: seq[tuple[count, source, target: int]] proc readInput(): Input = let parts = readFile("../inputs/05").split("\n\n") let stackLines = parts[0].split("\n").reversed[1..^1] let numStacks = stackLines[0].len div 4 + 1 result.stacks = repeat(newSeq[char](), numStacks) for i in 0..stackLines.len-1: for j in 0.. seq[char]): string = var stacks = input.stacks for (count, source, target) in input.instructions: let start = max(stacks[source].len - count, 0) stacks[target].add stacks[source][start..^1].transform stacks[source] = stacks[source][0.. x.reversed) echo "Part 2: ", readInput().solve(x => x) ================================================ FILE: advent-of-code/2022/day06/day06.nimble ================================================ srcDir = "src" bin = @["day06"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day06/src/day06.nim ================================================ import sets proc solve(size: int): int = let chars = readFile("../inputs/06") for i in 0 ..< chars.len - size: if chars[i..= 1.6.10" ================================================ FILE: advent-of-code/2022/day07/src/day07.nim ================================================ import strutils, tables, sugar, sequtils, math, strformat var cwd: seq[string] = @[""] var sizes = {"/": 0}.toTable for line in lines("../inputs/07"): let words = line.split(" ") let path = cwd.join("/") if line == "$ cd /": cwd = @[""] elif line == "$ cd ..": cwd = cwd[0..^2] elif line.startsWith("$ cd"): cwd.add words[2] elif line.startsWith("dir"): sizes[&"{path}/{words[1]}/"] = 0 elif line == "$ ls": discard else: sizes[&"{path}/{words[1]}"] = words[0].parseInt var dirs = initCountTable[string]() for dir in sizes.keys.toSeq.filter(d => d.endsWith("/")): for (file, size) in sizes.pairs: if file.startsWith(dir): dirs.inc dir, size let delta = dirs["/"] - 40000000 echo "Part 1: ", dirs.values.toSeq.filter(x => x <= 100000).sum echo "Part 2: ", dirs.values.toSeq.filter(x => x >= delta).min ================================================ FILE: advent-of-code/2022/day08/day08.nimble ================================================ srcDir = "src" bin = @["day08"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day08/src/day08.nim ================================================ import algorithm, sequtils, strformat, sugar let grid = lines("../inputs/08").toSeq.map(line => line.toSeq.mapIt(it.int - '0'.int)) var visible = 0 var optimal = 0 for x in 0.. line.allIt(it < height)): inc visible proc reach(line: seq[int]): int = for tree in line: inc result if tree >= height: break optimal = lines.mapIt(reach(it.reversed)).foldl(a * b).max(optimal) echo &"Part 1: {visible}" echo &"Part 2: {optimal}" ================================================ FILE: advent-of-code/2022/day09/day09.nimble ================================================ srcDir = "src" bin = @["day09"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day09/src/day09.nim ================================================ import strutils, math, sets, strformat type Point = tuple[x, y: int] proc `+`(a, b: Point): Point = (a.x + b.x, a.y + b.y) proc `-`(a, b: Point): Point = (a.x - b.x, a.y - b.y) proc sgn(a: Point): Point = (sgn(a.x), sgn(a.y)) iterator directions(): string = for line in lines("../inputs/09"): let parts = line.split(" ") for _ in 0.. 1 or delta.y.abs > 1: rope[i] = rope[i] + delta.sgn one.incl(rope[1]) two.incl(rope[^1]) echo &"Part 1: {one.len}" echo &"Part 2: {two.len}" ================================================ FILE: advent-of-code/2022/day10/day10.nimble ================================================ srcDir = "src" bin = @["day10"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day10/src/day10.nim ================================================ import strutils, sequtils iterator changes(): int = for line in lines("../inputs/10"): yield 0 if line != "noop": yield line.split(" ")[1].parseInt var cycle = 0 var register = 1 var sum = 0 var display = newSeq[array[40, bool]](6) for n in changes(): if (register - (cycle mod 40)).abs <= 1: display[cycle div 40][cycle mod 40] = true cycle += 1 if cycle mod 40 == 20: sum += register * cycle register += n echo sum for row in display: echo row.mapIt(if it: "#" else: " ").join ================================================ FILE: advent-of-code/2022/day11/day11.nimble ================================================ srcDir = "src" bin = @["day11"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day11/src/day11.nim ================================================ import strscans, strutils, sequtils, parseutils, sugar, algorithm type Monkey = object index: int things: seq[int] operation: Operation divisor: int success: int failure: int inspections: int OperandKind = enum Self, Number Operator = enum Multiply, Add Operation = ref object operator: Operator case kind: OperandKind of Self: discard of Number: operand: int proc parseInput(): seq[Monkey] = proc operation(input: string, output: var Operation, start: int): int = if input[start + 2..start + 4] == "old": output = Operation(kind: Self) result = 5 else: output = Operation(kind: Number) result = parseutils.parseInt(input[start + 2..^1], output.operand) + 2 case input[start] of '*': output.operator = Multiply of '+': output.operator = Add else: raise proc numbers(input: string, output: var seq[int], start: int): int = var parts: string result = parseWhile(input[start..^1], parts, Digits + {',', ' '}) output = input[start.. int): int = var monkeys = parseInput() for _ in 1..turns: for monkey in monkeys.mitems: for item in monkey.things: let item = monkey.operation.apply(item).fn if (item mod monkey.divisor) == 0: monkeys[monkey.success].things.add(item) else: monkeys[monkey.failure].things.add(item) inc monkey.inspections monkey.things.setLen(0) return monkeys.mapIt(-it.inspections).sorted[0..1].foldl(a * b) let m = parseInput().mapIt(it.divisor).foldl(a * b) echo solve(20, x => x div 3) echo solve(10000, x => x mod m) ================================================ FILE: advent-of-code/2022/day12/day12.nimble ================================================ srcDir = "src" bin = @["day12"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day12/src/day12.nim ================================================ import sequtils, strutils, deques var map: seq[seq[char]] var start: (int, int) var target: (int, int) var distance: seq[seq[int]] var x = 0 for line in lines("../inputs/12"): distance.add repeat(-1, line.len) if line.contains('S'): start = (x, line.find('S')) if line.contains('E'): target = (x, line.find('E')) map.add(cast[seq[char]](line.replace("E", "z").replace("S", "a"))) inc x let height = map.len let width = map[0].len var left = [(target, 0)].toDeque while left.len > 0: let (point, steps) = left.popFirst let (x, y) = point if distance[x][y] != -1 and distance[x][y] <= steps: continue distance[x][y] = steps for (dx, dy) in [(0, 1), (0, -1), (1, 0), (-1, 0)]: let (nx, ny) = (x + dx, y + dy) if 0 <= nx and nx < height and 0 <= ny and ny < width and map[nx][ny].ord + 1 >= map[x][y].ord: left.addLast(((nx, ny), steps + 1)) let first = distance[start[0]][start[1]] var second = first for x in 0..= 1.6.10" ================================================ FILE: advent-of-code/2022/day13/src/day13.nim ================================================ import json, math, strutils, algorithm, sequtils proc wrap(node: JsonNode): JsonNode = if node.kind == JInt: result = newJArray() result.add(node) else: result = node proc cmp(a, b: JsonNode): int = if a.kind == JInt and b.kind == JInt: return (a.getInt() - b.getInt()).sgn elif a.kind == JArray and b.kind == JArray: let first = a.getElems let second = b.getElems for i in 0..= 1.6.10" ================================================ FILE: advent-of-code/2022/day14/src/day14.nim ================================================ import strutils, sequtils, sets, math type Point = tuple[x, y: int] proc `-`(a, b: Point): Point = (a.x - b.x, a.y - b.y) proc `+`(a, b: Point): Point = (a.x + b.x, a.y + b.y) proc sgn(a: Point): Point = (a.x.sgn, a.y.sgn) proc parsePoint(s: string): Point = let parts = s.split(',') (parts[0].parseInt, parts[1].parseInt) proc parseInput(): HashSet[Point] = for line in lines("../inputs/14"): let points = line.split(" -> ").map(parsePoint) var point = points[0] for waypoint in points: result.incl waypoint while point != waypoint: result.incl point point = point + (waypoint - point).sgn iterator flow(map: var HashSet[Point], point: Point, limit: int): Point {.closure.} = if not (point in map) and (point.y < limit + 2): for delta in [(0, 1), (-1, 1), (1, 1)]: let recur = flow for another in recur(map, point + delta, limit): yield another map.incl point yield point var input = parseInput() let limit = input.mapIt(it.y).max var count = 0 var found = false for point in flow(input, (500, 0), limit): if not found and point.y > limit: echo "Part 1: ", count found = true inc count echo "Part 2: ", count ================================================ FILE: advent-of-code/2022/day15/day15.nimble ================================================ srcDir = "src" bin = @["day15"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day15/src/day15.nim ================================================ import re, strutils, sequtils, algorithm, options, math, sugar const LIMIT = 4_000_000 type Point = tuple[x, y: int] Sensor = tuple[location: Point, distance: int] Span = tuple[a, b: int] proc manhattan(p1, p2: Point): int = abs(p1.x - p2.x) + abs(p1.y - p2.y) proc `&`(x, y: Span): bool = x.a <= y.b and y.a <= x.b proc `in`(x: int, span: Span): bool = span.a <= x and x <= span.b proc len(span: Span): int = span.b - span.a + 1 proc parseInput(): tuple[sensors: seq[Sensor], beacons: seq[Point]] = for line in lines("../inputs/15"): let numbers = line.findAll(re"-?\d+").map(parseInt) let location = (x: numbers[0], y: numbers[1]) let beacon = (x: numbers[2], y: numbers[3]) result.sensors.add (location: location, distance: manhattan(location, beacon)) result.beacons.add beacon proc project(sensor: Sensor, y: int): Option[Span] = let point = (x: sensor.location.x, y: y) let distance = manhattan(point, sensor.location) if distance > sensor.distance: return none(Span) let delta = sensor.distance - distance return some((a: point.x - delta, b: point.x + delta)) proc compact(spans: openarray[Span]): seq[Span] = var left = spans.toSeq while left.len > 0: var span = left.pop var i = 0 while i < left.len: if span & left[i]: span = (min(span.a, left[i].a), max(span.b, left[i].b)) left.delete(i) i = 0 else: inc i result.add span proc nonBeacons(sensors: seq[Sensor], beacons: openarray[Point], y: int): int = let spans = sensors.mapIt(project(it, y)).filterIt(it.isSome).mapIt(it.get).compact let overlapped = beacons.filter(b => b.y == y and spans.anyIt(b.x in it)).deduplicate return spans.mapIt(it.len).sum - overlapped.len proc tuningFrequency(sensors: openarray[Sensor], limit: int): int = var sorted = sensors.sortedByIt((it.location.x, it.distance)) for y in 0..LIMIT: var x = 0 for sensor in sorted: if manhattan((x: x, y: y), sensor.location) <= sensor.distance: x = sensor.location.x + sensor.distance - abs(sensor.location.y - y) + 1 if x <= LIMIT: return x * 4_000_000 + y let (sensors, beacons) = parseInput() echo "Part 1: ", nonBeacons(sensors, beacons, LIMIT div 2) echo "Part 2: ", tuningFrequency(sensors, LIMIT) ================================================ FILE: advent-of-code/2022/day16/day16.nimble ================================================ srcDir = "src" bin = @["day16"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day16/src/day16.nim ================================================ import re, tables, strutils, sequtils type Index = range[0..63] var indices: Table[string, Index] var rates: array[low(Index)..high(Index), int] var paths: array[low(Index)..high(Index), seq[Index]] var index: Index = 0 var pathNames: Table[string, seq[string]] for line in lines("../inputs/16"): let name = line[6..7] let rate = line.findAll(re"\d+")[0].parseInt let rooms = line.split(re"valves? ")[1].split(", ") rates[index] = rate pathNames[name] = rooms indices[name] = index inc index for (name, rooms) in pathNames.pairs: paths[indices[name]] = rooms.mapIt(indices[it]) proc flow(open: set[Index]): int = for i in open: inc result, rates[i] type Memo = tuple[a, b: Index, time: int] iterator possible(position: Index, open: set[Index], valid: bool): (Index, set[Index]) = if valid: if not(position in open) and rates[position] > 0: yield (position, open + {position}) for next in paths[position]: yield (next, open) else: yield (position, open) proc solve(steps: int, moveElephant: bool): int = var best = 0 var seen: Table[Memo, int] proc go(time: int, one: Index, two: Index, score: int, open: set[Index]) = if time == 1: best = best.max(score) return if seen.hasKey((one, two, time)) and seen[(one, two, time)] >= score: return seen[(one, two, time)] = score for (one, open) in possible(one, open, moveElephant): for (two, open) in possible(two, open, true): go time - 1, one, two, score + flow(open), open go steps, indices["AA"], indices["AA"], 0, {} return best echo "Part 1: ", solve(30, false) echo "Part 2: ", solve(26, true) ================================================ FILE: advent-of-code/2022/day17/day17.nimble ================================================ srcDir = "src" bin = @["day17"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day17/src/day17.nim ================================================ import std/enumerate, sets, sequtils, tables type Point = tuple[x: int, y: int] let shapes = [ @[(0, 0), (1, 0), (2, 0), (3, 0)], @[(1, 0), (0, 1), (1, 1), (2, 1), (1, 2)], @[(0, 0), (1, 0), (2, 0), (2, 1), (2, 2)], @[(0, 0), (0, 1), (0, 2), (0, 3)], @[(0, 0), (1, 0), (0, 1), (1, 1)], ] proc `+`(a, b: Point): Point = (a.x + b.x, a.y + b.y) proc fingerprint(cave: HashSet[Point], top: int): string = for y in countdown(top, top - 30): for x in 0 .. 6: result.add(if (x, y) in cave: '#' else: '.') var wind: seq[Point] for c in readFile("../inputs/17"): case c: of '<': wind.add((-1, 0)) of '>': wind.add((1, 0)) of '\n': discard else: raise newException(ValueError, "Invalid character: " & $c) var rock: seq[Point] = shapes[0].mapIt(it + (2, 4)) var cave: HashSet[Point] var fallen = 1 var foundPhase = false var gain: int64 = 0 var left = 0 var seen: Table[(int, int, string), (int, int)] proc move(point: seq[Point], delta: Point): seq[Point] = let moved = point.mapIt(it + delta) if moved.allIt(it notin cave and 0 <= it.x and it.x <= 6 and 0 <= it.y): return moved else: return point block solution: while true: for (beat, delta) in enumerate(wind): rock = rock.move((0, -1)) rock = rock.move(delta) if rock.move((0, -1)) != rock: continue for pebble in rock: cave.incl pebble let height = cave.mapIt(it.y).max + 1 let memo = (fallen mod shapes.len, beat, fingerprint(cave, height)) if fallen == 2022: echo "Part 1: ", height if foundPhase: dec left if left == 0: echo "Part 2: ", height + gain elif seen.hasKey(memo): let (a, b) = seen[memo] let phase = fallen - a let remaining = 1_000_000_000_000 - fallen let ha = (remaining div phase).int left = int(remaining mod phase) gain = ha * (height - b) foundPhase = true else: seen[memo] = (fallen, height) rock = shapes[fallen mod shapes.len].mapIt(it + (2, height + 4)) inc fallen if left < 0 and fallen > 2022: break solution ================================================ FILE: advent-of-code/2022/day18/day18.nimble ================================================ srcDir = "src" bin = @["day18"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day18/src/day18.nim ================================================ import strutils, sequtils, sets, sequtils, sugar, math type Point = tuple[x, y, z: int] proc within(p: Point, lower: int, higher: int): bool = lower <= p.x and p.x <= higher and lower <= p.y and p.y <= higher and lower <= p.z and p.z <= higher proc sides(p: Point): seq[Point] = @[ (p.x - 1, p.y, p.z), (p.x + 1, p.y, p.z), (p.x, p.y - 1, p.z), (p.x, p.y + 1, p.z), (p.x, p.y, p.z - 1), (p.x, p.y, p.z + 1), ] var cubes: HashSet[Point] for line in lines("../inputs/18"): let parts = line.split(',').mapIt(it.parseInt) cubes.incl (x: parts[0], y: parts[1], z: parts[2]) let lower = cubes.mapIt([it.x, it.y, it.z].min).min - 1 let higher = cubes.mapIt([it.x, it.y, it.z].max).max + 1 var left: seq[Point] = @[(x: lower, y: lower, z: lower)] var seen: HashSet[Point] var count = 0 while left.len > 0: let point = left.pop if point in seen: continue seen.incl point for side in sides(point): if side in cubes: inc count elif side notin seen and within(side, lower, higher): left.add side echo "Part 1: ", cubes.toSeq.map(cube => cube.sides.countIt(it notin cubes)).sum echo "Part 2: ", count ================================================ FILE: advent-of-code/2022/day19/day19.nimble ================================================ srcDir = "src" bin = @["day19"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day19/src/day19.nim ================================================ import strutils, sequtils, sets, math type Blueprint = seq[int] State = array[9, int] var blueprints = newSeq[Blueprint]() for line in lines("../inputs/19"): blueprints.add line.replace(":", "").split(' ').filterIt(it.all(isDigit)).map(parseInt) proc `+`(a, b: State): State = for i in 0..8: result[i] = a[i] + b[i] proc solve(blueprint: Blueprint, steps: int): int = var best = 0 let a = blueprint[1] b = blueprint[2] c = blueprint[3] d = blueprint[4] e = blueprint[5] f = blueprint[6] var seen: HashSet[State] let max1 = max([a, b, c, e]) let max2 = d let max3 = f proc dfs(state: State) = let t = state[0] if t == 0: best = max(best, state[8]) return var state = state state[1] = min(state[1], max1) state[2] = min(state[2], max2) state[3] = min(state[3], max3) state[5] = min(state[5], t * max1 - state[1] * (t - 1)) state[6] = min(state[6], t * max2 - state[2] * (t - 1)) state[7] = min(state[7], t * max3 - state[3] * (t - 1)) if state in seen: return seen.incl state let next = state + [-1, 0, 0, 0, 0, state[1], state[2], state[3], state[4]] dfs next if state[5] >= a: dfs next + [0, 1, 0, 0, 0, -a, 0, 0, 0] if state[5] >= b: dfs next + [0, 0, 1, 0, 0, -b, 0, 0, 0] if state[5] >= c and state[6] >= d: dfs next + [0, 0, 0, 1, 0, -c, -d, 0, 0] if state[5] >= e and state[7] >= f: dfs next + [0, 0, 0, 0, 1, -e, 0, -f, 0] dfs [steps, 1, 0, 0, 0, 0, 0, 0, 0] return best echo blueprints.mapIt(solve(it, 24) * it[0]).sum echo blueprints[0..2].mapIt(solve(it, 32)).foldl(a * b) ================================================ FILE: advent-of-code/2022/day20/day20.nimble ================================================ srcDir = "src" bin = @["day20"] requires "nim >= 1.6.10" ================================================ FILE: advent-of-code/2022/day20/src/day20.nim ================================================ import strutils, lists proc properMod(a, b: int): int = (a mod b + b) mod b proc advance(node: var DoublyLinkedNode[int], count: int) = for _ in 0.. 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 502,32 -> 507,32 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 516,32 -> 521,32 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 512,30 -> 517,30 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 506,34 -> 511,34 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 512,173 -> 517,173 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 545,94 -> 550,94 539,100 -> 544,100 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 553,100 -> 558,100 501,170 -> 506,170 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 546,100 -> 551,100 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 542,97 -> 547,97 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 535,97 -> 540,97 533,108 -> 533,109 -> 538,109 -> 538,108 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 509,32 -> 514,32 513,34 -> 518,34 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 507,164 -> 512,164 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 557,103 -> 562,103 538,94 -> 543,94 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 501,28 -> 506,28 505,173 -> 510,173 531,87 -> 531,88 -> 543,88 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 524,126 -> 524,127 -> 528,127 -> 528,126 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 508,28 -> 513,28 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 511,167 -> 516,167 549,97 -> 554,97 541,91 -> 546,91 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 520,34 -> 525,34 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 505,30 -> 510,30 543,103 -> 548,103 510,146 -> 515,146 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 498,173 -> 503,173 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 498,13 -> 498,15 -> 492,15 -> 492,23 -> 506,23 -> 506,15 -> 501,15 -> 501,13 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 533,108 -> 533,109 -> 538,109 -> 538,108 517,146 -> 522,146 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 513,144 -> 518,144 515,170 -> 520,170 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 519,173 -> 524,173 532,100 -> 537,100 524,126 -> 524,127 -> 528,127 -> 528,126 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 521,148 -> 526,148 504,167 -> 509,167 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 520,130 -> 520,133 -> 515,133 -> 515,138 -> 533,138 -> 533,133 -> 525,133 -> 525,130 514,148 -> 519,148 510,141 -> 515,141 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 533,108 -> 533,109 -> 538,109 -> 538,108 524,126 -> 524,127 -> 528,127 -> 528,126 550,103 -> 555,103 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 529,103 -> 534,103 504,26 -> 509,26 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 508,170 -> 513,170 523,63 -> 523,66 -> 515,66 -> 515,71 -> 529,71 -> 529,66 -> 528,66 -> 528,63 499,34 -> 504,34 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 495,32 -> 500,32 507,148 -> 512,148 515,60 -> 515,52 -> 515,60 -> 517,60 -> 517,55 -> 517,60 -> 519,60 -> 519,50 -> 519,60 -> 521,60 -> 521,56 -> 521,60 -> 523,60 -> 523,53 -> 523,60 -> 525,60 -> 525,53 -> 525,60 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 531,87 -> 531,88 -> 543,88 536,103 -> 541,103 501,161 -> 501,152 -> 501,161 -> 503,161 -> 503,157 -> 503,161 -> 505,161 -> 505,155 -> 505,161 -> 507,161 -> 507,154 -> 507,161 -> 509,161 -> 509,155 -> 509,161 522,84 -> 522,76 -> 522,84 -> 524,84 -> 524,75 -> 524,84 -> 526,84 -> 526,81 -> 526,84 -> 528,84 -> 528,74 -> 528,84 -> 530,84 -> 530,79 -> 530,84 -> 532,84 -> 532,77 -> 532,84 -> 534,84 -> 534,78 -> 534,84 -> 536,84 -> 536,80 -> 536,84 522,47 -> 522,43 -> 522,47 -> 524,47 -> 524,41 -> 524,47 -> 526,47 -> 526,39 -> 526,47 -> 528,47 -> 528,39 -> 528,47 498,30 -> 503,30 492,34 -> 497,34 529,112 -> 529,116 -> 526,116 -> 526,122 -> 541,122 -> 541,116 -> 535,116 -> 535,112 ================================================ FILE: advent-of-code/2022/inputs/15 ================================================ Sensor at x=3482210, y=422224: closest beacon is at x=2273934, y=-202439 Sensor at x=3679395, y=2737332: closest beacon is at x=4104213, y=2980736 Sensor at x=3173475, y=3948494: closest beacon is at x=3494250, y=3554521 Sensor at x=27235, y=3642190: closest beacon is at x=-190885, y=3635525 Sensor at x=3851721, y=1754784: closest beacon is at x=3145586, y=2167751 Sensor at x=327074, y=3250656: closest beacon is at x=-190885, y=3635525 Sensor at x=3499970, y=3186179: closest beacon is at x=3494250, y=3554521 Sensor at x=150736, y=2522778: closest beacon is at x=-85806, y=2000000 Sensor at x=3000768, y=3333983: closest beacon is at x=2564067, y=3163630 Sensor at x=1751302, y=1660540: closest beacon is at x=3145586, y=2167751 Sensor at x=2591068, y=2923079: closest beacon is at x=2564067, y=3163630 Sensor at x=48946, y=3999178: closest beacon is at x=-190885, y=3635525 Sensor at x=3695475, y=3863101: closest beacon is at x=3494250, y=3554521 Sensor at x=1504031, y=2760: closest beacon is at x=2273934, y=-202439 Sensor at x=3021186, y=2667125: closest beacon is at x=3145586, y=2167751 Sensor at x=1514629, y=3771171: closest beacon is at x=2564067, y=3163630 Sensor at x=234064, y=616106: closest beacon is at x=-85806, y=2000000 Sensor at x=3990843, y=3393575: closest beacon is at x=4104213, y=2980736 Sensor at x=768875, y=2665271: closest beacon is at x=-85806, y=2000000 ================================================ FILE: advent-of-code/2022/inputs/16 ================================================ Valve VN has flow rate=0; tunnels lead to valves LW, TK Valve FQ has flow rate=0; tunnels lead to valves AJ, YC Valve DO has flow rate=0; tunnels lead to valves RV, HJ Valve MW has flow rate=0; tunnels lead to valves TE, HJ Valve LT has flow rate=5; tunnels lead to valves KO, SG, KH, HZ, RV Valve UJ has flow rate=0; tunnels lead to valves FW, DE Valve IZ has flow rate=0; tunnels lead to valves LU, SX Valve FE has flow rate=17; tunnels lead to valves WG, WI, LC Valve KS has flow rate=25; tunnels lead to valves QA, BT Valve HJ has flow rate=11; tunnels lead to valves MW, CZ, ZE, DO Valve WI has flow rate=0; tunnels lead to valves WX, FE Valve EK has flow rate=0; tunnels lead to valves KE, BS Valve HD has flow rate=0; tunnels lead to valves KH, FW Valve HZ has flow rate=0; tunnels lead to valves XY, LT Valve CD has flow rate=0; tunnels lead to valves XD, LU Valve OZ has flow rate=0; tunnels lead to valves GX, LW Valve AA has flow rate=0; tunnels lead to valves EP, FU, DV, OU, HC Valve OU has flow rate=0; tunnels lead to valves VX, AA Valve XD has flow rate=10; tunnels lead to valves VX, VW, BS, XY, CD Valve AI has flow rate=0; tunnels lead to valves KE, FW Valve GX has flow rate=0; tunnels lead to valves OZ, WX Valve FW has flow rate=8; tunnels lead to valves AI, FU, UJ, TK, HD Valve KO has flow rate=0; tunnels lead to valves DV, LT Valve DV has flow rate=0; tunnels lead to valves KO, AA Valve CZ has flow rate=0; tunnels lead to valves LU, HJ Valve WG has flow rate=0; tunnels lead to valves KE, FE Valve WX has flow rate=15; tunnels lead to valves WI, GX Valve AJ has flow rate=0; tunnels lead to valves FQ, LU Valve LC has flow rate=0; tunnels lead to valves LW, FE Valve XX has flow rate=0; tunnels lead to valves LA, VW Valve RK has flow rate=0; tunnels lead to valves BX, LW Valve YC has flow rate=22; tunnels lead to valves FQ, QA Valve KH has flow rate=0; tunnels lead to valves HD, LT Valve ZE has flow rate=0; tunnels lead to valves HJ, SX Valve BX has flow rate=0; tunnels lead to valves KE, RK Valve VS has flow rate=24; tunnel leads to valve UP Valve SX has flow rate=16; tunnels lead to valves IZ, ZE, LV Valve RV has flow rate=0; tunnels lead to valves LT, DO Valve UP has flow rate=0; tunnels lead to valves VS, LW Valve EP has flow rate=0; tunnels lead to valves AA, AU Valve VO has flow rate=0; tunnels lead to valves KE, HC Valve HC has flow rate=0; tunnels lead to valves AA, VO Valve TE has flow rate=0; tunnels lead to valves LA, MW Valve LW has flow rate=19; tunnels lead to valves UP, OZ, LC, VN, RK Valve SG has flow rate=0; tunnels lead to valves OY, LT Valve BT has flow rate=0; tunnels lead to valves KS, LU Valve DE has flow rate=0; tunnels lead to valves LA, UJ Valve BS has flow rate=0; tunnels lead to valves EK, XD Valve VX has flow rate=0; tunnels lead to valves OU, XD Valve TK has flow rate=0; tunnels lead to valves VN, FW Valve HQ has flow rate=14; tunnel leads to valve LV Valve LU has flow rate=20; tunnels lead to valves CZ, IZ, AJ, BT, CD Valve LA has flow rate=7; tunnels lead to valves OY, XX, TE, DE, AU Valve VW has flow rate=0; tunnels lead to valves XD, XX Valve LV has flow rate=0; tunnels lead to valves SX, HQ Valve XY has flow rate=0; tunnels lead to valves XD, HZ Valve OY has flow rate=0; tunnels lead to valves SG, LA Valve KE has flow rate=12; tunnels lead to valves VO, EK, WG, AI, BX Valve AU has flow rate=0; tunnels lead to valves LA, EP Valve QA has flow rate=0; tunnels lead to valves YC, KS Valve FU has flow rate=0; tunnels lead to valves AA, FW ================================================ FILE: advent-of-code/2022/inputs/17 ================================================ ><<<<>>><<<><<<<>>><<<>>><<<><<<<><<>>><<<>><<<<>>>><<<><<>>><>><<<<>>><><<><<>><<<>>><<<>>>><<>><>>>><>>><<<<>>>><<<<>>><<<>>>><>>><<<>><>><<><<<>>>><>>><<>><<<><<<><<<>>><>>><<<>><<<><><<>>>><<>>><>>>><<<>>><<<><<<<>>><<<><<<<><<>><>>><<>><<<<>>>><<<>><>>><<>><<>>>><<<<><<<<><<<><<>>><>>><<><<>><<>><<>>><<>>><>>>><<<><><<>>><<<<><<>>>><>>>><<<><>><<>>><<<<>>><<<<>>>><>><>><<>>>><<<<>><<<<>>><<<<><<<<><<<<>>>><<<<>>><<>>><<>>>><>>><<<>>>><<<>><<<>>>><<><<<<>><<>>><<<<><<<>>>><<><<>>><<<<><<><><<<<>><<<>>>><>>>><<<>>>><<<<>><><<<<>><<<<><><<<<>>>><<<>>>><>><<<>><<<<>>><>>><<<><<>>>><<>><>>>><>>><<<<>><><<<>>>><<><<<<><<<>><<<<>>><<>>><<<<><>>>><<><<<>><<<><>><<>>><<<><>>><<<<><<<>>><<<<>>><<>>><<<<>><<<<><<>>><<<>>><>>>><<<>><>>>><<>>>><<<>><<>>>><><<><<<<>>>><<<>><<<><<<>>><<>>>><<>><<><<<>><><<<<><<>>>><<<<>>>><<><>><<<><<>>>><<<><<<<>>>><<<><<>>><<>>>><>><>>>><<>>>><<<>>>><<<>>>><>>><<<<>>>><<<<>><<>><>>><<>>><<><<<>>>><<<<>>>><<><<<>><<>>><>>><<><<<<><<>><<<>>>><<<>>><<<><>>><<<<>>>><<>>><>>><<<<>>><>>>><<<<>><<<<>>>><<<<>><>>><<<<>>>><<><<<<>>><<>><<>>><<<>>><><<><<<>>>><>><>><<>>><<>>>><<<<>>>><<<<>><<<<>><>>><<>>><<<<>>><<<<><>>><<<><<<<><<<>><>>><<<>><<<<>><<<<><<><<<><<<<>>><<>><<<>><<<>>><<<<><<<>>><<><>>>><<<<><<<>><<<>>>><<<<><<<>>><<><<<<>>>><<<<>>>><<>>>><<<>>>><<><>>><>>><<<<>>><<>>>><<<<>>>><<<<>>>><<<>>><><<<><><<<><><><>>><><<<<><<>>><>>>><<>>>><<<<>><<<>>><<<><><<>><<<<><<<><<>>><>>>><<<<>><<>><<>><<<<>>>><<<>>>><<<>>><>><<>><>>><<>>>><<<<>>>><<<<>>><<<><>>>><>><<<<>>>><>>>><<><<<<>>>><<<>><<<>>><<>>><<>>><><<<<><<>>>><<>>>><<<>><<>><<>>>><><<<>><<>>>><<<>><<<>>><<>>><>><<<<>>>><>>>><<<<>>>><<>>>><<>>><>>><<<>>><<>><<<<><<<<><<>>>><<>>>><<<><<<<><<<><>><>><<<><><>><>><><<<>><<<<>>><>>><<<>><<<>>><<<>>>><>>>><<<>>>><<<<>>>><<<><>>>><<<>>>><<<><<<<>>><>>>><<<>><<<<><<<>>><<<<>><><<<<>>>><<<>>><>>>><>>>><><<>><<><<<>><>>><><><<>>><><<<>>>><<><>>><<<<>><<>><><>><<<>>>><<<>>>><<><<<>>><<<<><<>>><<><<>><<>><<<<>>>><<><<<>>>><<><>>>><<><<<>><<<<>>>><<<<>><<><<<<><<<<><<>>><<<<>>><<>>>><<<<>>>><>>>><>>><<>><<<<><<<>><<>><<<>>><<<>><<<><<<<>>>><>>>><<><<>><<<>>><<<<>><<<>>>><<>>>><<<><<<>>>><<<><<<<>><<<<>>>><<><<>><<<>>><<<><<<>>>><<<<>><<><<><<<<>>>><<>><>>>><<>>>><>>>><<><<>><<<>>><>>><<<<>><>>>><<<<>>>><>><<<>>>><<<<>><<<<>>><<<>><<<<>><<<>><<<<>><<<<>>>><<<><>><<<<>>><<<<>>>><<>><<<><<<<>>><<<>><<<>>><<>><>>><<>><<<<>>><<<><>>><>>><>>><<<<>>><<<<>><<<<>>><>>><>><<<<>><<<<>>>><<><<<>>><<<<>>><>><<>>><<>><<<>><>>>><<>><<<><<<>>><<<>>><><<><<<><<>>><<>>><<>><<>>><<>>>><<<><>><>>><<<<>>><<<>>>><<>><<><<<<>><<<>>><<<><<>><>><>>><<<>>><<>><<<<>>>><<<<>>>><<>><<<><<<<>><<<>>><><<>>>><<<<>><>><<<>><<<>>>><<<<><<<>>>><<<><<<<><>>><<>><>>>><<>>><>>>><<<>><<<<><<><<>>>><<><<<<><<>><<<<>>><<<<>>>><>>><<<><>>>><<>>>><<<>><<<>>>><<>><<<<>><><<<<>>><<>>>><<<<><<>>><<<>><>>>><<<><<<<><<<><><>>><<><<<>><<>>><<<<><<>>><><<<>>><>><<>>>><<>><<>>><<>>><<>>><>><><<<><<<>>>><>>>><<><<<<>>>><<<>>><<<<>>><<<><<<>>>><<<><<<><<<<>>>><<<<><<><<<>>>><>>><<<><>><<>><<<<>>>><>><<>><<<<>>><<<<>>><>>><>>><>><<<<><<<><<<><<<<>><>>><<<><<>>><<<>><>><><><><>>><<><<<<>><<<>>>><<><<<<>>>><<<>>><><<<<>>>><>>>><<<<><<>><>><>>><>>>><<><>><<<<>><<<<>><<><<<>>>><<<<>>>><<<<>>><<><<<<>><<<<>><<<>>><<<>>><>><<<<>>><<<>><<<><<<<><<<<><<<>>><<>>><<><<>>><><<>>><<<<>><<<>>><>>>><<>><>>>><<>><<<<>>>><<><<<>>><<<>>>><>>><<>><>><<<>><>>>><<<>><<<<>>>><<>>><>><<>>>><<<<><<<<><<<>><<<>><><<<<>>>><<<>>><<<<>><><>>><<><>>>><>><<<<>>><>>><<<><>>><>><>>>><<>>><<<><><<<<>><>>>><>>>><<<>>><<<<>>><<<<>><<<<>><<<>>>><<<><<<<>><<<>>><<<><<<>>><<><<>>><<<>>><<>><<<<>>><<<>>><>><<<<><<<<><>><><<<<>><<<>><<>>>><<<>><<>><<<<>>>><<>>><<<<><<<<><<>>>><<>>><<<>><>>>><<<<><<><<>>>><<>>>><<<>><>>><>>><<<<>>><<<<>>><<>><<>>><>>><<<>>>><<>>><<<>>><<>><<<<>>><>><<<>>>><><<<<><<>>><<<<>>><<<<>>>><<<<>><>>>><>>><<><<>>><<>><<<>>><><<<<>>>><<<<><<<>>>><<<>>><<>>><>><<><<>>>><>><<<><<<<>><<<<>><<<><>><<>><<><<<<><<<><<<>><<>>>><<>>><<<<><<<>><<>>>><<<<><<>>><<>><<<<><<><<<<>>>><<>>><<<<>><<<<>>><<<<>>><<<<>><<<<><<>>>><>>>><<<>>>><>>><<<>><<>><><<<><>>>><<<<>>><<<>>>><<><<<<>>>><><>>>><<<>>>><<><<<<>><<><<<<>>><<<<><>>>><>>><<><<<>><>>>><<<>>>><<>>><<>>><<<><<>>><<<>><<>>><<<>>>><>>><<>>>><>>><>><><<>>>><>>><<>>>><>>>><>><><<<<><<<>>>><<<<>>>><<<<>>><<>>><>>>><>><<<><<<<>>><<<<>>>><<>>>><<>>>><<>><<><>><<<<>>><<<>>>><<<<>>><><<<<>><<<><><><<<><<>>>><<>>>><>>><<>><<><<<<><><>>>><<<<>>>><<<<>><>><<<>><<><<>>>><<<<>>>><<<>><>><<<>><>>><<>>>><<>><<>>>><<>><<>>>><<<><>>>><<<<>>><<>><<<><<<<><<>><<<<>><<<>>>><<>>>><<<<>>>><<>>><>>><<><<<<><<>>><<<>>>><<><<>>>><<<>>>><<<<><<><<>>><<<<>><<<>>><>><<<<>>>><<>>><<<<>>>><>><<<><<><<<>>>><<<<><<>>><>>>><<>>>><<<<>>><>>>><<<<>>><<>>><<>>><<>>>><<>><<<>>><<<><<>>><<>>><<>>><>>><<<>>>><<<<>><<<<>>>><><<>>>><<>>>><<><<<>>>><<<>>>><<<><<>>><<<>>>><<><<<>>><<>><<<>>>><<><<>>><>>><>>><<>>>><><<<<><>>><>>>><<<<>>>><<>>>><>>><<<>>>><<>>>><<><<<<>>><<<<>><><<>>>><<<>>><<<<>>><<>>>><<<<>><>>>><<<<><<<<>>>><<<<>><<<<>><<<<><<><<<><<><<><<<<><<>>><<<<>><><<<>>>><<>><>><<<<>>>><><<><<<<>><<<<>><<<>>><>><<<<>>>><<>>><>>><<<>>>><<<>>>><<<>><<>><<<><>>>><<<<>>>><>>>><<<<>>><<>>>><<<>>><<<<>><>>>><<<><<<<>>><>>><<<<>><<<>><<<>><<<>>>><>>>><<>><<<>><><>>>><<<<><<>><<>>><<<>>><>>>><<<><<<<>><<>>><<<<>>>><<>>>><<<>><<<<>>><<<><<>><>>>><<<<><<<<>>><<>><<<>>><<>><<<>>><<<>>><>>><<<<><<>>><<<<>><<<<>>>><>>><<<<>>>><>>><<<<>>>><<<<>><<><<>><<<<>><<<<>>><<>>><<<><<>><>><<<><<<<>>>><<>><<>><<<<>>><<>><<>>>><<>><><<>>>><<<<>>><<><<<>>><<<>>><>>><<<<>>>><<<>><<>>>><<<<>><>><>>><<>><<<>>>><<<><<<<>>><><<<<>>><<<>>>><<<<>>>><<<>><<><<>><<<<>>><<><<<<><>>><>>>><><<>>>><<<><<<<><><<>>><<>>><<<<>>><<<>>>><>><<<<>><<<<>>><<<<>>><<<<>><<<>>><<<>>>><<<><<>>>><<<><<<<>><<<<><<<<>><<<<>>>><<>>>><<<<>>><><<<>>>><<<><>>><<><<<<>>>><<>>><<<<>>><<<>><<<>>><<<<>>>><<<><<<>>>><<<>>><<>>>><>><<>>><<<>>><<<>>>><>>><<<>>><<><><><<<<>><<<<>><<<<>>><<<>>>><<><>><>><<><<<<>>>><>><><<<<>><<<<><>>>><<<>>>><><><<<<><>>><<<>><<<>>>><<<<>>><<<>><<<<><<>><>><>>><<><<>>>><<<<>>><>>><><><<<<>>><<<<>>><><>><<><<<>><>>>><<<<><<<>>>><>>><<<>>>><<>><>>><<<<>><<<><<<>>>><>>><<<>><>>>><<<>>><<<><<<><<<>>>><<><<<>>>><<>>><<<<>>>><>><<>><<<>><<<<>>><<<>><<>><<<>>>><<<>>>><<<<>>><<<<>><<<<>>><<<<><<>>>><<>>><<<><><>><<>><<<>><>>>><<<>><<<<>>>><<<<><<<><<<><<>><<>>><<<<>>><>><>>>><<<<>>>><>>><<>>><>>>><>>>><<<>><<<<>>>><<<><>>>><<<<><<>><<<<>>>><<>><>><<>>><<>><<>>>><<<<>><<<>>><<><<<<>><<<<>>><<<><>><<><<>><<<<>><<<>>><<<<>>><<<>>><>><>><<<<>><<<>>>><<<<>>><<>>><<<<>>><<<>>>><<<<>><<>>>><><<><<<>>>><<<<>>>><><><>>>><<<<><<<>>>><>><>><<<>>>><<<>>>><>><><<>><<<><>><<>>><><>>><<>><<>><<>><<><<<>><<>><<<<><<<<>>>><<<<>><<<<>><<<>><<<<>><<<<>><>><>>><<<>>><<<><<>>>><<>><<<><<<>>><<<>>><<<<><<<>>><<>>><>><<<>>>><<<>><>>>><><<>>>><<<<><<>>><<<<><>>><<><>>><<<<>><<<>>><>><<<>>>><<<>><<><<<><<<>><<<>>>><<<>>>><>>>><<><>>>><<>>>><<>>>><<<<>><<>>>><<><>><<<<>><<<<><<<<><><><<>>>><><>>><<>>>><>><<<<>>><>>>><><<<<>>>><>><<<><<<><<<<>>>><<<>>>><<<>>><<<<>><<<><<<>>>><<<<>>><>>>><<>><<>>>><<<>>><<><<<<>>><><<><<<<>>><><<<>>>><<<>><<<><><<<<>><>><<<><<<>><>>><<<<>>><<<>>><<<>>>><<>><<<>>>><>>>><<>><<<>>>><<<<>>>><<<>>>><<<>>>><>><>>>><<<>><<>>><<><<<<>>><<<<><<>><<>><<<>><<<>>><<<><<<<>>><<<<>><>><<<>><<<<><>>><<<>>><<>>>><<<>><>><>>><<>>>><<<<><<<<>>><<<>>><<<>>>><<<>><<<<>>><<<<>>>><>>><<<>>>><<<>><<<>>><<<>>>><<<<>>>><<>>><><<<<><<>>><<><>>><<>>><<>>>><<<<>><<>>>><<<><><<<>><><<<>>>><<>>><>>>><<>><<>>><<>>>><<<<>>>><<>>>><<<><<><<<><<>><<>>><>><<>>>><<<>>>><>><<<>><>><<<<>><>><<<><<><><<><<<<>>><<><<><<<><<>>><<<>><<<>>>><<>>><>><><<><<<<><>><<<>><<>>>><>>><<<>>><>>>><<<<>>><>><<>>>><<<>>><<><<<<>>><<<>>>><<<<>>>><<<<>>>><>>>><<<<>><><><>>>><<<>><<<<>>>><<<>>><<>><<><<<>>><<<><<<><>>>><<<<>><<<<>>><<<>>><<<>>><<>><<><><<<>>><<<>>><<<><><<>><<>>><>>><<<>>><<<<>>>><<<<><<>>>><>>>><<><<>>><>>><<>>>><><<>>>><<>><<<<>>><><<>><<>><<>>><>><>>>><<<<>>><<>><<<><<<<>>><<<<>>><<><<<<>><>>><<><<<>>><<<<>>><<>>><><>>><<<<>>>><>><<<>><<<><<><<<>>><<<<>>><<>><<>>><<><<<>><<<<>>>><>>>><<<<>>><<>>>><><<<<>>><>><<>><<<>><<<<><<<>><<<<>>><<<>>><<><>><<<<><>><<<<>><<<><<<<>>><<<>><<<>><<<<><<<><<>>>><<>><<<>>>><><<<<>>>><<<<>><<<<><<>>>><><>>>><<<>>><>>><<<>><<<<>>><<<<>>>><<<<>>><<><>><<<<>><>>>><<<<>>>><>><<>><<<>><<<>><<>><<<>>><<<<>>><<<<>><<<<>>>><<><<<>><<<>>>><>>>><<>><<>><<<>>><<>><<<<><<>>><<<>>><><<><>><>>><<>>><<<<><<><<<<><><<<>>><>>>><>>>><<<>>>><>><<<>>><>><><><<><>>><<>><<<>>><<<<>>>><<>><>>>><>>><<<>><<<>><<<<>>>><<<>><<<>>><>>>><<<<>><>><<><>>>><<<><>><<<>>>><<>>><>>><<<<>>>><<<><>>>><<<<><<<<>>><<<>>>><<<>>><<<>><<<<>>><<<<>><<<<>>>><<<<><<>>>><<>>><<>>><<<<>>>><><<<<>>>><<<>>>><>>>><<<><<><><<>><<<<>><<>><<<<>>>><<<>><<<>><<<><<<><<<<><<<>>><><>>>><>>><<<>>><<<>>><<<>><<<<>><<<<>>>><<<>>>><<>><<<>>><>>>><<>><>>>><>><<<<>>>><><<<>>>><<<>><<>>>><<<<><><<>>>><><<>><<<>><<<<>>><<<>>>><<<><>><<<><><<<<>><<<>><<<><<>>><<<>>><<<<>><>><<<><<<<>>><<<<><><><<<>><<<<>><<>><<<><<>><<<<>>><<<<>>>><<<>>><<>>>><<<<>>>><<<><<<>>>><<>>>><<<<>>><<>>>><<<>>><<<>><>>>><<<<>>><<>><<<>><<><>>>><<<><<<<>>><><<<<>><<<>>>><>><<><>>>><<<<>>><>>><<><>><><<<<>><>>><<>><<>>><<>><<>><<>>>><<<>>><>><<>>><<>>><>><><<<>><<<<>>>><<<>>>><<>><<><<>>><<>><<<>><>>><<>>>><<<<><<><<<<>><>>><<>><><<<><<<<>>>><<<>><<>>><<<<>>>><>>>><<<>>>><<<><<>><><<<<><<<>>><<<<>>><<<>>><<<>>><>><>><><<>>>><<>><<<>><<<>>><<<>>>><<><<<><>>><<<><<<>><<<>>><<>><<<>>><<>>><<<<>><>><><<<>>><<<>>>><>>><>>><<<>>><<<>>><<>>><<<<><<<<>><><<>>>><<<>>><<<><<<>>><><<>>>><<>>><<>><<<>>><<><<<>>><>><<>>><<>><<<><<>>><><<><<>>><<><><<<>>>><<<<>>>><<<>><<<<>><<<<><<<><>>>><<>>>><<><>>><<>>><<><>>>><<<<>>>><<<>><<<<>><>>><<<<>>>><<<<>>>><<<<>>>><<<<>>><><><<>>><<<>>>><<<<>><<<<><<<>><<><<><>>>><><<<>>><<>>>><<<>>>><<<<>>><<<<>>>><<<>><<<>><<<<><<<<>>>><<>><<>>>><<<<>>><<<>>><<>>><<>>>><><<<<>><<<>>><<<>><<<<>>><<<<>>>><>><>><<>>>><<<>><<<>>>><<<<>><<<<>><>>>><><>><<<<>><<<>><<<>>><><>>><<<<>>><<<>>>><<<>><><<<>><<<<>><<<<>>>><><<<>>><>><<<><>>>><<<>>>><>>>><<<>>>><<<><<<><<>>>><>><<<<>><<>>><<<<>>>><<>><<<<>>><<<>>><<<<>>>><>><<>><<<>>>><<<>>><<>>><<<>>><>>><<<<><<<<><<>>><>> ================================================ FILE: advent-of-code/2022/inputs/18 ================================================ 3,5,10 8,13,17 9,4,8 8,8,18 10,10,1 12,9,14 4,6,15 4,10,15 17,7,7 17,6,9 7,13,2 16,4,9 9,1,8 5,8,14 12,14,13 3,7,8 17,11,10 11,17,14 7,4,8 3,11,6 6,15,10 6,7,5 7,2,14 4,7,7 13,18,10 9,2,11 11,16,12 1,10,7 14,14,8 4,9,15 10,10,18 17,9,4 18,11,10 14,5,7 4,14,13 1,11,8 12,5,17 9,7,4 13,16,9 10,18,12 5,4,5 4,15,10 14,4,4 6,4,5 18,7,10 5,6,3 5,11,3 12,10,1 7,3,6 8,6,3 15,7,5 3,8,8 16,6,6 5,3,8 12,15,13 5,4,11 13,17,14 15,11,7 2,7,9 7,1,7 7,7,2 7,7,17 17,10,10 13,14,14 2,12,8 6,10,3 5,2,10 3,8,12 15,14,12 12,17,14 13,2,9 12,2,11 17,10,9 3,3,7 16,9,12 8,12,2 17,6,10 3,10,4 13,16,7 15,11,4 12,8,2 17,12,11 13,9,16 3,4,9 14,4,13 13,2,13 5,16,12 10,18,11 2,7,10 14,6,13 4,4,9 5,5,7 5,16,11 3,15,9 11,8,15 15,15,8 6,16,6 9,14,17 7,14,15 13,10,2 8,15,3 2,7,13 10,1,11 13,13,14 2,8,6 6,12,4 7,5,13 7,3,14 11,11,18 5,3,7 11,9,3 10,17,12 9,18,7 14,3,6 15,10,16 13,8,16 7,3,13 13,2,10 6,3,12 10,7,17 13,9,17 15,11,15 11,3,12 2,10,13 12,3,8 8,14,5 3,6,6 16,14,10 14,10,4 10,18,9 15,6,13 12,2,10 10,4,5 14,11,17 16,9,6 3,7,7 16,9,16 11,1,8 15,10,3 12,10,17 8,14,13 4,5,7 14,9,4 4,12,3 8,7,17 16,14,8 14,6,15 10,17,9 11,2,6 6,15,4 4,13,6 1,8,10 12,8,16 4,12,14 9,17,9 6,16,11 12,3,13 13,2,11 5,4,13 13,9,2 12,13,4 3,15,10 5,8,15 12,4,5 13,4,6 10,12,17 16,6,9 9,10,16 17,14,12 14,16,7 4,14,9 4,3,9 15,7,15 10,14,5 13,13,16 11,7,2 7,7,4 12,4,10 14,6,4 8,9,16 3,7,6 13,16,13 16,4,7 4,3,6 6,17,8 10,16,14 10,14,3 10,1,6 11,17,9 2,9,7 3,7,14 4,5,3 16,9,5 16,9,13 11,16,15 5,5,5 3,14,10 4,14,6 7,11,16 15,7,6 6,9,16 15,12,14 2,12,9 15,14,14 2,13,10 17,8,10 8,13,15 16,6,10 5,16,9 11,16,5 5,14,11 2,11,7 9,11,17 8,16,12 8,18,12 14,7,3 11,17,7 9,16,10 8,18,11 13,6,15 12,18,8 12,3,7 4,13,14 6,16,10 9,6,17 9,12,16 4,6,8 13,4,7 8,13,3 3,14,9 16,6,12 9,16,7 5,13,13 18,10,9 16,12,13 15,5,9 1,14,9 6,4,9 3,8,6 10,15,5 8,9,17 12,3,11 12,7,18 7,9,18 13,16,10 5,4,7 4,12,13 14,14,14 10,17,10 6,7,18 8,5,5 5,13,3 3,15,11 15,7,7 10,15,15 7,14,5 11,5,3 15,14,4 14,14,15 16,5,8 16,11,7 5,3,14 14,12,15 9,18,8 15,3,7 15,7,13 16,8,9 10,11,2 6,5,5 3,14,5 16,10,4 8,8,1 4,12,6 8,2,6 8,15,14 15,5,5 8,2,14 12,10,2 2,11,12 15,16,12 14,8,16 14,15,4 2,10,9 15,14,9 8,13,16 14,4,8 14,5,15 9,15,14 5,6,6 4,14,11 17,8,11 5,15,10 9,4,9 12,4,4 15,12,6 5,13,16 15,7,4 11,8,18 6,11,15 17,8,7 7,9,15 14,15,12 10,8,17 12,14,5 4,4,10 10,4,4 14,16,11 17,10,13 10,2,13 15,6,14 17,10,8 9,16,4 12,5,15 13,16,8 4,8,14 17,8,8 11,18,10 4,8,16 2,13,11 17,8,14 4,13,11 2,8,12 5,3,11 18,13,8 11,3,14 1,9,12 12,13,16 13,4,13 15,15,11 8,10,17 16,11,6 8,16,10 9,1,10 1,8,7 3,7,4 11,4,4 7,13,16 9,6,4 16,7,13 11,6,15 5,15,4 7,14,3 4,11,4 3,10,12 3,12,10 10,16,13 10,3,6 10,3,5 9,2,7 9,3,14 15,6,7 13,3,7 5,12,4 16,5,6 14,13,15 17,8,6 5,9,16 17,10,5 7,10,2 5,14,12 7,2,11 16,10,14 8,10,2 13,4,14 7,3,4 12,1,10 18,9,11 8,14,15 14,13,14 9,9,17 13,5,13 2,14,10 8,8,2 2,10,7 11,8,2 8,17,7 9,15,16 11,17,12 11,17,13 2,10,5 12,5,4 6,17,4 3,10,10 11,16,13 7,2,9 7,14,4 5,5,16 14,14,6 4,14,14 17,7,10 9,12,3 5,13,4 13,11,2 10,15,3 14,5,10 14,7,16 5,5,15 4,7,5 14,5,4 8,10,16 9,17,8 7,12,17 16,7,4 17,8,12 14,9,3 6,10,16 6,6,16 7,13,3 10,13,17 17,9,11 13,15,5 15,14,15 6,13,16 12,17,8 4,6,14 10,17,8 7,16,10 13,8,2 17,11,4 15,14,8 10,13,16 2,8,8 4,14,12 9,16,5 13,14,13 13,7,17 5,14,5 13,14,16 15,15,6 7,7,16 15,12,15 7,4,14 11,6,3 2,12,10 6,15,9 11,15,5 7,3,8 4,15,9 10,5,3 14,15,5 10,6,3 16,4,6 11,9,16 9,7,18 6,2,8 4,5,13 8,7,16 12,3,10 10,8,1 4,9,8 7,17,6 7,4,16 9,10,18 13,15,8 11,2,11 14,4,7 3,10,6 4,7,15 17,11,14 6,16,4 1,7,10 8,4,5 14,16,9 11,13,2 3,6,7 5,15,9 15,13,13 10,4,15 15,8,6 8,3,13 13,12,3 15,4,10 10,17,13 11,5,14 16,7,7 17,6,11 14,5,12 2,7,7 15,13,14 3,14,6 17,11,7 10,11,17 13,7,2 3,11,4 16,13,14 4,2,10 16,12,9 17,6,12 2,4,10 6,16,5 6,11,17 15,9,16 13,16,12 13,5,5 9,17,7 5,6,13 17,7,6 11,9,18 9,4,17 10,5,16 6,11,5 5,4,6 5,15,13 8,2,11 8,9,3 6,17,6 6,4,7 14,3,7 3,13,6 10,3,10 7,5,4 12,4,16 6,3,11 9,12,2 5,9,15 5,13,15 13,16,14 11,16,9 15,4,9 14,10,16 13,3,5 7,17,10 8,9,18 16,9,11 15,6,4 15,12,13 6,11,3 17,9,12 14,13,5 2,10,8 9,11,16 5,7,16 11,15,14 3,11,5 11,11,1 5,6,14 4,7,14 3,9,14 8,14,2 12,3,14 7,16,6 6,3,10 17,13,11 14,6,5 14,4,14 7,8,3 8,12,1 4,6,5 5,9,3 15,3,11 11,16,14 2,9,5 13,17,10 2,10,10 11,5,4 6,6,3 15,6,8 13,8,3 3,10,5 8,16,14 4,12,5 4,9,3 11,11,3 6,9,2 2,13,12 14,10,13 9,6,16 13,15,13 10,2,9 4,6,3 8,5,16 5,17,10 15,3,10 3,13,9 10,13,3 4,10,14 9,8,2 3,6,12 11,13,18 16,12,6 5,13,14 4,7,16 3,5,13 8,3,12 3,15,7 16,5,9 9,15,15 7,12,1 9,4,4 14,7,14 4,7,4 12,5,5 7,13,4 16,6,7 17,7,12 8,10,18 16,11,14 15,16,7 4,15,6 7,12,16 10,16,6 4,5,6 8,14,3 5,12,11 9,10,1 15,10,14 12,6,1 11,4,6 4,14,7 16,14,6 16,7,8 11,6,11 12,6,2 14,14,4 12,16,7 7,16,13 9,5,16 9,17,13 9,2,10 3,9,15 11,18,9 4,6,12 9,6,14 4,3,7 16,13,6 11,13,15 3,7,9 15,14,10 4,6,7 10,7,4 17,14,9 5,6,15 12,6,3 11,14,4 5,11,13 11,14,5 8,8,3 11,9,2 10,14,4 12,6,16 13,8,17 17,6,7 14,16,12 9,18,9 5,6,12 14,11,4 8,12,4 8,15,16 10,4,3 6,12,3 2,9,6 3,14,12 10,2,10 9,4,12 18,10,10 4,5,14 7,8,17 11,15,11 17,10,7 8,12,17 8,1,10 11,3,15 10,13,1 8,16,13 14,15,7 14,7,4 7,17,12 12,4,13 9,7,16 7,3,12 3,15,13 5,12,16 2,10,11 11,8,1 5,8,16 3,5,7 10,10,3 16,12,8 6,10,1 4,13,7 7,18,10 18,10,11 16,10,12 8,11,16 4,13,13 12,16,5 14,11,5 5,9,14 3,4,11 18,13,10 17,11,11 7,8,1 5,14,15 8,17,14 7,5,14 3,5,14 9,2,12 9,15,3 6,16,14 9,8,3 12,15,4 9,2,14 4,7,3 14,6,7 4,11,6 17,9,6 4,10,4 2,13,13 1,7,9 10,5,13 18,10,7 7,10,17 4,4,14 3,10,15 12,6,15 10,10,17 5,15,11 17,12,7 12,14,14 4,4,8 6,15,14 13,16,5 14,5,5 4,4,6 10,8,18 13,17,8 16,8,8 12,2,13 12,16,13 5,3,5 4,4,7 9,5,15 12,14,2 12,4,6 6,5,6 13,8,5 4,15,7 17,12,6 5,5,10 11,14,16 14,3,13 18,7,9 15,8,3 1,8,8 3,8,13 11,13,17 6,17,12 7,12,15 11,9,1 15,9,15 16,12,11 12,6,17 15,15,12 9,16,12 1,7,7 6,4,12 3,13,11 3,9,12 15,17,8 5,7,3 7,8,2 9,14,5 5,15,8 10,15,4 6,10,2 4,5,5 8,5,14 4,5,10 6,12,14 7,4,6 4,13,3 14,5,16 9,17,12 4,14,15 7,8,16 15,15,7 18,12,8 10,9,2 5,7,15 10,4,6 12,7,17 10,16,12 3,12,7 5,3,12 15,5,3 16,15,10 17,9,10 9,4,15 6,14,15 6,17,9 10,15,7 4,11,5 13,6,13 9,3,6 5,4,15 15,14,7 6,7,3 12,12,16 15,15,10 16,10,7 6,3,7 8,7,2 2,8,11 6,8,3 5,5,4 5,15,12 17,13,9 13,7,3 13,15,6 2,9,11 10,12,2 8,11,3 10,13,4 12,9,2 15,9,5 7,10,3 11,10,17 7,7,3 12,17,11 8,8,15 2,14,9 8,8,16 9,9,18 5,15,5 15,13,12 5,12,15 2,7,8 18,12,11 10,15,14 16,12,12 11,3,5 11,10,18 16,5,10 7,16,14 2,11,10 14,10,15 4,8,4 13,7,16 9,17,10 13,4,11 9,5,4 7,3,10 8,17,10 17,8,5 6,4,15 9,17,4 4,8,3 13,16,6 13,15,11 6,12,16 9,18,11 4,14,8 10,14,17 6,3,5 6,6,4 11,14,15 13,11,3 12,13,2 6,17,13 4,11,16 7,4,5 12,3,6 6,7,15 17,13,8 14,7,15 11,7,3 12,15,14 11,2,15 9,3,12 12,16,11 5,3,9 12,16,15 8,8,17 4,12,4 18,8,9 4,12,15 5,6,4 10,5,4 1,10,11 16,13,11 5,16,8 9,4,14 12,13,17 11,13,4 12,2,8 8,17,12 17,11,13 13,10,16 13,17,6 9,14,2 16,5,7 16,9,7 3,10,13 14,4,5 16,14,13 8,4,8 4,9,5 8,12,3 14,14,5 12,10,16 11,6,17 16,6,8 6,2,10 14,3,11 17,7,5 3,9,5 2,8,7 5,5,12 11,4,13 10,7,16 9,14,6 17,11,12 10,2,6 9,11,18 11,3,13 13,6,16 15,9,6 7,14,2 13,6,3 9,4,16 16,13,8 8,17,5 14,10,3 10,2,5 2,6,10 11,1,10 5,10,17 2,13,4 4,11,7 5,14,3 15,14,5 14,16,14 15,14,13 16,11,11 17,10,6 4,17,7 4,16,11 12,8,1 8,6,2 15,5,10 13,6,14 18,9,10 10,8,3 10,14,16 4,13,10 8,7,3 5,3,10 7,10,16 12,10,3 9,6,15 7,15,4 8,4,15 15,11,16 14,4,15 8,17,8 12,6,4 9,2,8 9,14,4 6,2,11 16,7,10 15,11,5 6,8,2 10,15,13 12,15,5 10,1,9 3,14,8 4,16,10 2,12,12 9,17,11 8,15,5 9,17,6 16,8,14 14,8,4 3,15,8 18,10,8 7,2,7 13,15,14 5,4,14 10,16,4 14,5,14 16,11,15 9,3,7 1,12,8 15,5,6 12,15,2 4,8,15 17,13,12 5,8,3 15,10,15 3,11,13 18,11,9 8,5,3 17,6,8 16,7,6 15,5,12 9,14,3 4,14,5 3,9,7 6,5,13 5,11,6 14,2,10 14,15,8 10,17,15 8,1,12 16,15,7 13,11,4 12,17,10 6,14,7 8,6,14 8,9,1 10,12,3 12,18,11 10,9,3 5,14,14 1,9,10 5,13,5 11,17,10 16,8,5 11,15,13 6,16,9 11,4,15 5,10,2 6,5,4 17,12,13 10,9,1 6,9,15 13,12,15 7,4,15 7,4,13 5,6,16 10,3,14 2,13,9 5,9,18 8,6,15 6,14,5 14,17,8 18,9,8 13,5,15 10,17,7 5,7,13 13,14,15 11,11,2 12,2,7 12,11,2 9,12,1 15,16,8 3,9,10 9,16,13 3,6,10 5,15,14 15,5,14 12,18,10 11,15,12 14,16,5 5,1,12 6,5,8 10,16,7 4,5,8 11,1,7 8,2,9 17,10,14 14,8,15 8,17,13 15,4,11 14,5,13 14,6,3 17,13,10 15,7,3 8,11,2 8,3,5 17,10,11 16,7,12 15,11,13 16,12,5 4,8,10 7,5,3 2,9,12 6,15,6 7,4,4 13,3,8 10,10,2 9,1,6 13,10,3 11,4,2 7,4,9 2,9,10 7,9,16 15,13,5 16,14,9 7,17,11 16,10,9 13,10,15 14,2,13 9,2,9 10,6,16 12,5,16 7,15,8 11,3,8 5,9,5 7,3,11 2,6,11 2,10,6 6,5,15 9,18,12 11,10,2 4,3,11 17,9,9 10,18,10 16,6,13 14,4,12 12,12,2 6,13,4 12,9,17 15,5,11 17,12,8 2,15,11 14,5,9 16,12,10 14,9,15 10,13,2 5,10,3 3,7,5 16,12,4 10,9,15 4,16,8 6,3,8 12,12,17 15,6,12 10,2,11 13,9,5 9,15,13 7,9,2 8,3,15 17,5,10 13,4,4 11,2,12 4,16,12 13,12,4 17,6,13 15,8,15 3,6,8 2,9,4 13,12,2 8,3,6 9,18,10 3,4,7 10,7,15 5,3,6 9,9,1 7,2,12 10,4,16 14,11,3 8,7,18 11,2,13 6,11,4 9,10,3 12,18,7 15,5,4 16,13,12 16,15,8 12,3,3 16,11,5 14,16,8 11,3,4 16,13,9 9,2,5 7,14,14 13,11,5 2,13,6 8,13,2 18,11,8 12,9,15 4,10,16 18,8,7 7,11,15 6,8,17 15,12,16 4,6,13 6,16,13 6,14,3 13,6,4 15,9,13 7,9,17 4,12,16 15,7,11 16,14,7 2,11,11 10,1,13 6,18,10 15,13,11 10,16,11 13,3,13 9,6,2 14,13,3 7,2,8 12,2,6 9,8,18 3,13,12 7,6,3 3,7,12 6,3,9 9,8,17 8,4,13 12,15,7 5,17,8 16,16,8 7,6,14 10,9,17 14,3,8 4,11,15 6,6,2 13,6,6 3,11,12 15,6,6 14,8,7 5,16,6 10,3,15 9,8,1 14,4,10 11,17,6 6,4,14 14,11,15 6,6,15 11,12,15 15,11,8 7,18,8 12,4,11 10,3,13 6,10,18 10,16,15 14,5,3 14,13,11 6,15,12 10,2,8 16,10,13 16,8,11 6,1,10 9,16,8 10,3,4 16,6,5 16,6,11 8,15,15 16,15,12 8,15,13 15,8,4 3,6,9 16,8,16 6,15,11 12,11,17 10,2,12 9,6,3 11,12,16 16,16,10 7,2,13 8,1,5 6,4,13 5,2,11 6,14,16 13,2,7 9,18,13 14,4,6 15,13,6 14,15,10 8,7,1 13,13,7 14,16,6 11,10,1 8,17,11 9,17,15 6,11,16 12,3,12 17,12,10 10,18,8 16,8,7 17,5,12 11,5,6 3,13,5 10,5,15 4,8,5 1,10,9 6,4,8 11,15,6 10,3,12 11,5,16 5,16,7 6,15,13 2,7,5 3,5,8 2,9,8 9,14,15 3,13,13 4,15,13 7,2,6 2,8,14 4,14,10 11,6,5 15,4,12 11,12,18 15,13,7 12,16,12 16,9,8 16,9,15 15,12,11 7,15,5 16,8,13 3,12,12 15,7,16 14,2,12 15,16,6 9,17,5 2,10,12 14,14,7 11,14,3 8,4,14 7,17,5 7,11,17 16,15,9 13,4,5 3,14,7 8,6,17 7,12,2 13,13,3 10,1,8 13,17,7 3,8,5 12,8,17 12,14,4 4,9,9 13,17,11 5,9,2 9,1,7 11,15,4 8,5,15 3,8,11 11,16,6 4,8,11 3,5,11 13,9,3 16,4,11 18,8,13 14,13,7 13,3,11 12,17,7 6,3,6 16,5,12 4,4,5 13,6,17 3,9,13 5,7,17 14,8,14 1,7,8 14,7,2 6,10,17 10,15,6 14,11,2 9,3,4 12,12,15 14,5,6 12,17,9 11,16,7 17,10,12 13,5,8 9,18,6 16,11,12 12,8,18 17,8,9 12,8,3 1,11,12 7,5,5 3,11,7 8,2,12 3,9,4 8,12,18 10,7,2 4,13,5 13,1,7 11,11,16 14,14,11 12,15,6 9,17,14 7,5,15 13,12,16 4,2,9 4,15,8 6,16,8 6,5,16 14,7,12 18,13,9 5,14,16 8,14,16 15,10,7 13,2,12 8,6,5 6,15,5 12,9,3 3,10,14 4,5,4 16,5,11 9,5,3 4,3,8 13,17,9 14,9,16 3,9,9 13,15,7 13,14,10 4,7,9 5,14,6 3,3,8 15,13,15 3,3,12 14,13,6 13,3,12 10,4,14 15,7,14 6,15,15 11,2,10 9,9,3 14,6,12 5,14,7 17,7,13 1,11,11 7,15,7 14,14,13 15,3,8 7,6,16 16,4,8 10,14,14 10,2,7 5,4,12 4,9,6 13,14,4 16,8,12 8,12,16 12,7,2 7,9,14 10,8,16 7,7,1 3,15,6 15,6,16 2,11,15 2,5,9 16,13,13 17,12,14 5,11,12 4,11,14 10,13,14 14,15,11 7,15,9 7,17,9 6,3,13 9,4,5 17,9,13 13,9,4 7,15,16 11,2,8 4,11,2 16,10,8 14,15,6 14,13,8 14,5,8 16,7,14 17,11,5 10,17,6 2,12,11 17,12,4 4,16,9 11,13,5 15,2,9 10,7,18 10,5,6 7,1,10 6,7,14 6,14,4 9,5,17 11,12,2 13,3,14 6,14,13 3,9,11 17,11,8 8,4,7 16,9,14 16,8,15 13,11,1 9,2,13 9,14,16 6,17,11 3,14,11 10,5,17 12,16,14 10,11,16 16,5,13 9,16,15 6,7,17 2,8,9 4,13,12 6,8,16 13,15,12 11,11,15 12,17,13 2,9,9 5,14,4 3,6,13 4,16,7 5,5,13 12,11,3 8,11,17 7,5,17 3,12,5 10,1,10 11,3,7 14,10,2 8,13,5 13,4,3 16,11,8 8,2,5 8,4,16 16,12,7 17,11,6 6,7,16 16,11,9 10,7,3 4,6,9 6,5,3 7,17,14 13,13,4 16,12,14 6,12,15 16,11,4 7,15,3 2,13,7 11,16,11 10,5,2 7,18,11 15,4,6 10,11,18 4,13,15 12,16,6 3,16,10 7,16,7 5,10,15 5,14,9 14,17,7 10,13,18 6,4,6 11,17,4 10,6,17 7,16,12 16,12,15 4,9,16 9,15,6 4,4,11 5,11,16 8,3,4 15,10,5 4,10,3 3,4,8 10,6,15 6,9,1 13,13,12 6,17,10 12,14,16 14,13,4 8,15,9 16,9,4 8,10,3 14,10,14 2,12,14 14,3,5 17,9,7 16,10,6 10,17,14 13,14,3 9,7,17 9,12,17 10,8,2 11,6,1 6,8,18 6,14,2 9,2,6 13,9,18 5,6,5 1,11,10 6,15,3 12,5,6 11,4,16 9,3,11 14,8,17 2,7,11 10,3,7 16,15,11 15,4,8 3,13,7 6,13,15 14,8,5 11,9,17 5,15,15 8,15,2 8,16,7 14,8,3 11,3,6 16,11,13 13,13,17 3,8,14 14,17,9 8,9,2 6,12,2 9,15,4 4,12,9 1,6,9 5,7,4 6,13,5 6,9,18 3,15,12 7,11,4 9,3,13 3,12,14 4,5,9 2,6,9 14,9,17 12,12,3 3,12,13 2,7,14 9,9,15 9,3,5 3,16,11 9,5,13 7,2,10 15,5,13 8,16,5 8,5,2 13,5,16 5,4,4 13,11,14 11,3,11 11,12,17 8,10,1 10,7,1 4,3,10 8,16,4 12,17,6 18,9,9 17,5,8 7,12,18 7,15,15 7,16,8 16,14,12 7,17,13 6,5,11 2,12,7 5,3,13 15,6,5 17,12,12 17,7,9 1,10,12 3,13,8 4,11,12 6,16,12 12,2,14 11,11,17 13,13,15 11,8,16 18,12,9 11,8,3 7,9,4 13,12,17 12,12,13 13,15,4 11,2,9 11,18,8 4,7,8 8,14,4 9,10,17 4,5,11 16,4,10 2,6,8 15,2,8 9,3,15 5,10,16 3,13,14 4,8,6 2,9,13 12,16,8 8,1,9 8,2,13 2,11,9 15,11,3 5,15,7 13,11,15 6,3,14 10,11,1 4,6,4 4,12,7 15,6,11 15,11,14 7,17,7 10,16,5 9,16,14 5,16,10 11,4,14 5,10,14 16,10,5 13,3,10 6,9,17 6,18,12 17,7,8 13,17,12 4,9,2 13,14,6 2,8,13 8,1,11 17,8,13 5,10,4 12,1,9 2,9,14 5,8,2 1,12,10 5,5,8 7,5,6 14,3,12 14,17,11 4,7,13 17,13,7 11,5,17 13,13,5 6,11,2 10,18,6 10,17,11 18,11,7 8,6,16 8,11,1 6,15,7 5,13,7 8,15,6 5,15,6 8,2,7 15,12,4 6,2,9 1,9,11 14,16,13 17,7,11 11,14,13 11,2,14 5,12,2 9,13,5 5,9,6 13,3,6 5,16,13 3,6,11 5,2,12 11,15,3 17,14,10 7,3,7 5,5,6 2,14,8 8,8,19 8,2,8 2,11,8 7,18,12 9,4,3 3,14,13 11,8,17 9,10,2 6,18,9 6,14,6 4,4,12 11,16,10 10,4,12 5,7,5 7,13,15 1,10,8 2,11,13 17,5,11 10,6,4 3,5,9 14,15,9 16,10,15 7,3,5 5,7,2 3,5,6 7,1,11 12,11,4 10,6,2 3,12,4 1,12,9 13,15,9 13,3,4 15,13,10 14,13,13 16,3,9 5,8,4 6,13,9 8,3,10 10,12,1 11,4,17 4,13,16 14,11,14 5,2,9 9,15,9 12,2,9 1,10,5 5,12,12 11,1,9 15,9,14 6,12,5 1,11,9 13,1,10 10,12,18 12,17,12 12,1,8 9,7,3 7,1,8 2,13,8 8,2,10 15,8,12 11,7,1 11,14,14 14,6,16 11,10,4 15,8,5 11,18,14 3,12,6 13,7,15 10,9,0 7,15,14 13,11,16 15,16,10 15,13,4 9,13,16 11,13,16 7,12,3 10,16,3 10,3,9 16,13,7 3,7,11 6,16,7 15,16,9 12,2,12 5,12,17 10,16,8 11,2,5 14,3,9 6,2,13 7,7,5 15,9,4 4,13,9 14,12,3 2,15,8 15,16,11 5,14,13 11,15,7 14,12,4 6,4,4 4,11,3 14,12,6 12,16,16 5,6,11 12,3,5 12,13,3 6,13,3 12,4,12 16,15,6 12,4,14 14,7,7 1,13,12 10,2,14 16,10,10 5,8,6 14,14,10 3,7,13 4,9,14 15,10,6 14,4,9 12,4,3 2,6,13 7,5,10 15,17,10 14,9,2 3,8,9 11,10,3 5,8,1 4,5,12 3,8,10 9,6,18 13,13,2 10,12,4 12,5,3 14,2,9 8,15,4 14,16,10 16,4,14 16,7,5 7,6,4 11,7,17 1,7,11 8,17,6 12,4,15 2,7,15 8,18,8 15,10,4 2,4,11 4,14,4 4,10,6 13,14,5 7,6,15 13,1,8 9,4,13 14,6,14 9,9,16 14,15,13 6,5,2 7,10,18 7,16,15 18,6,7 2,7,12 11,12,1 2,12,13 12,15,16 17,5,9 14,3,14 3,8,7 1,11,7 1,8,11 12,15,15 12,16,9 12,10,4 5,5,14 2,5,8 10,4,17 7,3,9 9,1,9 7,7,15 3,4,12 13,6,2 4,17,9 15,3,12 12,9,16 15,15,14 11,7,16 6,5,12 13,7,7 15,12,5 7,9,3 11,17,8 4,10,13 7,13,17 15,15,13 11,6,2 6,4,16 3,6,14 11,1,11 13,3,15 13,8,14 13,10,18 15,10,2 12,9,18 9,15,5 14,14,16 6,4,11 3,9,6 8,6,4 6,11,1 15,9,8 8,13,13 8,16,6 8,16,11 8,3,7 16,13,10 7,14,16 6,9,3 6,14,14 10,11,0 6,12,6 5,17,13 14,7,5 6,17,7 14,12,5 1,7,13 8,4,4 13,16,11 5,6,8 15,9,12 18,11,11 11,18,11 7,4,7 11,3,9 18,7,7 11,11,14 9,3,9 5,4,8 7,13,14 11,7,18 17,4,8 10,14,18 15,7,10 9,13,3 16,14,14 11,15,15 12,10,0 15,8,14 14,16,15 5,9,8 13,7,4 18,6,8 11,17,11 6,10,4 10,14,2 3,11,9 14,3,10 12,13,11 11,3,10 8,18,7 10,18,7 1,6,11 4,9,4 12,10,18 9,1,11 13,2,8 14,4,11 10,9,16 7,11,2 5,9,4 6,15,8 9,13,18 10,4,13 15,5,7 17,15,9 10,6,1 2,6,6 12,4,7 8,16,9 16,7,9 10,6,14 15,9,3 10,6,18 9,4,6 8,13,11 13,8,4 4,11,9 11,6,16 12,5,14 5,12,14 8,4,6 10,1,7 18,10,12 18,8,12 12,7,5 10,15,2 13,3,3 8,4,3 6,6,17 7,16,16 15,15,5 8,3,9 4,12,12 2,12,6 9,13,2 8,2,4 15,4,13 3,10,9 2,14,7 14,7,17 2,5,6 11,5,2 6,2,6 16,7,15 7,15,10 7,18,9 16,8,6 8,5,17 18,12,7 8,7,15 4,6,6 18,6,10 13,5,4 4,11,13 7,15,6 7,6,6 3,14,14 4,10,10 13,5,14 4,10,5 3,5,12 12,13,15 9,11,1 6,8,14 6,1,9 5,17,9 3,7,10 9,8,16 7,5,9 ================================================ FILE: advent-of-code/2022/inputs/19 ================================================ Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 14 clay. Each geode robot costs 2 ore and 16 obsidian. Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 2 ore. Each obsidian robot costs 2 ore and 15 clay. Each geode robot costs 2 ore and 7 obsidian. Blueprint 3: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 14 clay. Each geode robot costs 2 ore and 7 obsidian. Blueprint 4: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 17 clay. Each geode robot costs 3 ore and 16 obsidian. Blueprint 5: Each ore robot costs 2 ore. Each clay robot costs 2 ore. Each obsidian robot costs 2 ore and 17 clay. Each geode robot costs 2 ore and 10 obsidian. Blueprint 6: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 17 clay. Each geode robot costs 4 ore and 8 obsidian. Blueprint 7: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 9 clay. Each geode robot costs 2 ore and 20 obsidian. Blueprint 8: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 20 clay. Each geode robot costs 3 ore and 14 obsidian. Blueprint 9: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 20 clay. Each geode robot costs 3 ore and 18 obsidian. Blueprint 10: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 16 clay. Each geode robot costs 4 ore and 16 obsidian. Blueprint 11: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 5 clay. Each geode robot costs 3 ore and 15 obsidian. Blueprint 12: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 14 clay. Each geode robot costs 3 ore and 8 obsidian. Blueprint 13: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 20 clay. Each geode robot costs 2 ore and 17 obsidian. Blueprint 14: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 19 clay. Each geode robot costs 3 ore and 10 obsidian. Blueprint 15: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 17 clay. Each geode robot costs 4 ore and 20 obsidian. Blueprint 16: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 14 clay. Each geode robot costs 3 ore and 20 obsidian. Blueprint 17: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 12 clay. Each geode robot costs 3 ore and 15 obsidian. Blueprint 18: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 19 clay. Each geode robot costs 3 ore and 13 obsidian. Blueprint 19: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 18 clay. Each geode robot costs 2 ore and 19 obsidian. Blueprint 20: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 16 clay. Each geode robot costs 2 ore and 9 obsidian. Blueprint 21: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 20 clay. Each geode robot costs 2 ore and 20 obsidian. Blueprint 22: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 6 clay. Each geode robot costs 2 ore and 16 obsidian. Blueprint 23: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 6 clay. Each geode robot costs 4 ore and 11 obsidian. Blueprint 24: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 5 clay. Each geode robot costs 2 ore and 10 obsidian. Blueprint 25: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 14 clay. Each geode robot costs 3 ore and 14 obsidian. Blueprint 26: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 15 clay. Each geode robot costs 4 ore and 16 obsidian. Blueprint 27: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 4 ore and 11 obsidian. Blueprint 28: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 4 ore and 17 obsidian. Blueprint 29: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 11 clay. Each geode robot costs 3 ore and 14 obsidian. Blueprint 30: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 8 clay. Each geode robot costs 4 ore and 14 obsidian. ================================================ FILE: advent-of-code/2022/inputs/20 ================================================ -7594 -3313 -7404 -8208 -9315 -9537 -5293 860 -1368 1984 7865 3261 -8361 7267 8401 9525 -6388 1575 -2979 4074 3379 -491 6952 5987 -4809 7905 5893 -7169 -4650 -9473 4438 -8592 -2454 -110 7510 -2309 -5571 -8966 5781 905 -7638 -7436 8821 6952 954 6194 -9722 4210 4548 2907 2543 -6544 2742 -6822 -5556 -8895 -9108 -8759 -2341 7076 -5188 -9029 5796 -2045 -8804 3794 3121 7085 -8338 -3039 6767 3594 2229 5355 6694 1207 -6718 6920 -4092 -8567 -6375 8836 244 7560 -7793 -6655 3756 827 -4075 -9189 -6625 -4539 -6433 1742 789 -3230 -2575 8755 8471 4736 3170 -8943 -2014 -2729 4700 -1357 2496 746 -3807 9860 1990 -7597 7366 1432 -1146 -9647 1332 7913 1234 -1091 4381 5096 3837 952 -8199 -6018 -581 -6519 7418 274 8781 6382 393 5342 -2353 3534 726 -1895 8540 -5598 -7041 4927 -3962 -9798 -7154 -7497 -3902 -5906 -5740 1328 7085 -8173 -5962 -1706 -8396 2996 -638 3739 7927 -5041 -8804 -6869 9210 5838 6646 6211 -6827 -7068 7788 216 -978 -1190 -6966 -9187 8438 -7553 4968 4014 -3818 6693 -2275 8672 4148 9654 -5520 -5412 -1689 -8991 1932 -897 -292 9181 3229 -8960 5333 3810 3938 -1064 9019 -7495 8516 4642 7434 -7404 -1823 -2366 715 -6810 -152 -4154 8479 6389 -3301 -5421 3424 1726 -5262 -8135 -9021 -5901 -8165 -5152 -1371 -7666 -4131 -6878 -9000 -2303 2689 -4766 -9607 -292 482 9493 -3764 8361 -436 1694 2458 -96 615 9924 -1306 7557 -8585 291 -7185 -5387 9841 -3776 5264 6442 1521 3495 761 -5964 -9123 7595 -5991 5053 7909 -8804 6012 -4826 -8081 2728 4402 -5020 247 3388 -2765 -355 8225 1670 -5092 -7752 -7594 -1463 -1518 7141 1974 7673 -9803 -6573 6616 8998 8434 -8549 3370 -6046 -8133 -1190 8190 3525 -4387 3787 -165 490 -9642 -1014 1721 -4642 -4636 7182 6870 -9609 2273 839 1247 9654 5613 -8030 -7587 -8789 2063 8454 4021 9566 2909 9226 4838 58 -657 -82 6871 -6332 -3012 -4320 8514 2623 -9294 -3240 -7936 -8287 4794 -8718 5235 -5777 -8847 -8229 564 3204 4950 7962 2844 6639 3507 611 -2513 -6433 -5194 -4084 -670 3021 -416 -2309 -5005 -7518 7207 1259 4790 7801 -1832 -7692 -176 -3061 -911 7319 -3908 3050 -5347 5138 2954 9836 -2356 2775 7565 -6447 -6480 -3501 -5695 -254 -5353 -2538 -2178 -2532 -7486 5363 8176 837 8438 -2778 9526 3239 -5365 6775 -7335 -3886 863 6894 -5439 -6083 -6479 -5408 -6783 -4390 -7032 -5929 -2115 9778 1148 -1973 3612 -6204 -2410 -4825 3015 -3737 -7273 -5412 6846 -5157 9397 -5681 5253 8843 1708 -4796 5860 4739 6276 7041 2566 3470 -6474 8042 9564 -1936 758 -6420 353 9045 8105 6412 6669 8093 2630 -2275 4337 -6287 3896 2800 -9557 6789 5264 2756 -7471 6083 -844 -9186 -9550 669 -1007 1084 150 -4160 -2950 2120 3350 -9604 -1102 -355 -5644 4298 8620 -9017 729 201 -2148 3537 4922 -3863 1200 -4544 6908 7461 -5902 3184 -5718 -8506 4482 4660 -384 -4218 -6858 5161 7827 -7856 7894 2120 2280 8997 -4150 1939 -1351 9023 2137 -1656 -9698 5096 7001 8104 -9274 -2055 -1627 -2866 -5020 1543 -6672 -7601 1399 9446 8338 5236 1400 841 3206 -2650 3519 6161 8982 -8454 -342 1666 -662 -9294 -170 966 4453 9225 8444 8591 7846 -125 -8517 -6122 -5371 -1149 -8818 -4863 -3537 -859 -5860 7434 6293 -4037 -8423 8606 9836 6262 7951 15 7550 2927 1295 5831 -5700 789 1484 -4544 6651 2525 -1342 3295 -7558 -4797 -6673 -6663 -2566 4791 -4663 5856 -1323 6720 1881 -826 -5116 -1653 353 1913 314 7242 2141 7374 2448 5681 3890 -4020 -2877 -3510 6333 1369 424 7192 6552 -9173 4443 1429 -3409 -9622 -4117 8389 9664 -4650 -4671 4615 3959 5469 6018 -3038 -7793 -4445 3737 -8429 3853 7576 9545 -9895 6295 4253 -3848 6841 -601 -8764 5063 -6904 -5577 7003 -5905 -5156 -3630 2704 -2625 -2386 7213 380 -9481 -2845 2808 4411 7658 -7800 -6080 9612 8190 -150 3911 -5114 -161 6172 -9083 -152 -2565 6960 -5897 -3307 -9226 6214 -3887 -3792 -2222 -8301 -1836 7478 -5831 -6303 -6240 8677 -8663 5177 4618 -2326 -4829 2392 4848 -3393 9443 8452 5455 -340 -5513 1661 -1966 -2009 -9334 3433 58 -1011 -3712 1650 -8973 5584 424 9049 -2629 -9269 -8940 9342 -4164 -8823 5079 -5897 5121 -2009 232 1195 1014 5405 -2122 -7185 8555 5923 576 -5881 3584 -911 -8612 2254 -8461 -8819 -1078 6375 -9792 -8759 -4612 5707 -937 -5826 -587 3226 7702 5976 5628 -3836 -7803 4199 8262 9546 3424 3156 7342 -3580 8787 -35 7607 9951 -4416 -33 207 4857 9397 -7209 -4454 4712 4989 -5817 -461 7827 -1077 -9754 2732 4756 -5434 -9048 2840 -6710 -5438 -2200 3451 9205 1578 -5702 -4730 -4776 -3737 3974 -3230 640 996 -6287 4823 -7087 481 4999 -1236 -8045 -3467 9098 946 -601 7594 9772 1183 1683 -974 -7495 6110 8207 -9299 9564 8135 6925 7380 -2282 2554 521 -4996 8978 -780 -5851 9388 2488 -6175 5840 6738 -8875 -1999 -7447 9098 8739 4054 3470 -801 -9299 -6027 1377 -1062 -9315 -1190 132 -8882 -370 6104 -4927 -3240 2875 5937 -714 -9541 -2268 -7663 -483 2618 5012 244 3696 9056 5381 -6255 4741 -270 7790 -3317 1709 8322 1566 5079 8960 4428 5446 5851 -4642 -3319 6630 3156 7734 9839 -4390 -5005 -8165 1973 4402 6408 3863 4514 4470 6177 1081 -7681 -6084 9122 -966 -5781 -5166 -3571 4927 6043 8295 1759 3215 -3737 -3956 -1260 2935 6407 7530 -5523 -601 -413 4158 4333 4767 -7856 -6840 2085 -8262 3038 -3373 -5367 -6280 9070 2106 -3499 -8330 -3688 1207 -257 2173 275 552 8129 -6204 8113 -7936 9470 -6598 -814 -2722 4965 4700 5096 607 3050 -337 -3822 -429 7324 -4765 1485 -8576 9309 -808 964 2539 -9918 -7195 -7944 7539 -3618 7403 8187 -688 482 7466 -6760 5232 -6382 8592 8266 -302 8849 8605 -7127 4453 -8091 -8209 -5739 4427 4510 -5887 -1648 4277 -8685 -3892 -2400 -1863 -4316 -1484 1775 -753 -670 2480 -5153 -3160 3341 -2096 4395 -5229 4837 8139 4589 -8821 -4485 -419 -1817 8196 -3663 -3127 5560 4940 -495 -3160 2063 -8245 -562 3255 7904 6442 9701 1855 -7111 3795 4927 4373 7201 3629 2219 -9338 7806 -1306 2169 6065 -7498 233 7927 -6455 1326 1605 -1423 4366 -4301 3411 -3544 -1955 -9138 -5752 -3856 -2526 1107 5893 2085 1056 -9294 9525 760 -6165 -8742 6424 5330 -4443 -8230 1161 -1686 -1607 -6447 -3509 4753 -8727 3594 -5262 1949 1151 -987 -1849 -3746 991 8268 -1983 8622 -5740 -4868 -2760 220 789 181 2533 -5526 -2718 7401 -3330 -760 4097 -4233 -9776 -8171 1817 9953 -6621 -1110 -8372 -9226 8484 4960 -6911 -5042 -5629 -4662 -458 4851 -3864 -8604 -6151 879 -3201 -2573 5186 7268 -8685 2829 536 -9196 1810 9282 9321 4588 -7653 3495 8119 3816 -6603 5703 8118 -7078 8510 3926 5072 1195 -8948 4927 -5313 5707 -9778 -5460 5787 7070 8882 -5975 4 4411 2928 -9502 402 6740 9506 -3111 8806 5525 -795 4225 1322 -4297 -8850 0 7320 4923 6926 -1511 342 -8209 5854 3797 -9798 9328 6209 -2073 -2414 3782 112 -8102 607 7961 2529 -8364 -2532 -8066 -468 7574 -6604 4919 3995 -1589 -4055 281 8115 8127 -2711 6846 -9396 -4020 9206 7577 1195 4386 -853 4447 -7716 -1511 6331 -6591 2333 -1030 1768 6989 -7196 482 -9201 -9049 -8934 4339 8035 -8764 1915 -9669 -491 -9294 -7967 1913 2516 -2027 -7321 9540 -9484 1699 -2199 -7318 -4037 8252 -2216 -3142 -5005 -8011 -6212 7601 7712 7525 7514 -6844 7267 8576 -647 7654 7303 7863 -1121 615 -2123 413 -7349 -8804 -7044 5405 3433 1403 -2178 -2649 -402 5079 -4964 834 4964 -5042 2954 8832 -8939 -5493 -58 5116 7899 -5948 9664 -4344 -269 7790 -5153 132 -3915 -4106 -764 -8205 -2694 -5851 9372 2634 -8384 -7562 -292 5519 7009 8389 -891 -7889 1478 933 5193 -3794 4170 -5734 6003 5627 1790 6698 -3588 8474 6289 -1652 -2159 5864 -5681 -5089 -78 -2878 -8908 5429 5853 -7001 3828 -3698 3541 -9550 2913 626 6868 -1604 8104 -8369 3265 5736 4894 2426 -1148 -562 -4030 -6245 -7755 -7752 7075 133 5913 3363 2790 1456 -5313 5266 -4187 285 -2980 1995 592 4490 -2845 -3848 -2302 -1669 -9166 9095 3991 8000 -1554 8842 5346 9755 2900 -5149 -6209 -1881 1113 -4822 576 4981 -8296 -8878 -1330 -4730 6803 6825 8238 3959 -2025 -2872 -4490 780 -1566 3698 -6252 144 -2573 2341 6569 3727 -1614 7403 69 9855 9250 5787 7283 1456 -9872 -2473 1234 2885 -4166 -2988 -626 9031 6893 -8635 5346 3080 -6174 -1479 -8869 1089 -7895 -6150 8452 6868 7883 2106 1955 -7831 5819 6994 -8253 739 -9396 -2206 7380 -9698 -3238 9443 9591 6869 -3143 9070 -3968 -4868 2678 -8377 8270 7696 -5902 -6163 4283 8692 5711 9544 -8209 -5323 -1609 -4407 5002 -7803 -1375 6456 110 3153 -5412 -2326 3159 -1637 6538 -8634 7560 -4764 3666 -6653 -9136 6373 -8679 3204 1029 6846 -7808 -5192 3911 3454 7013 -2403 253 3018 -9845 -1428 -3940 5693 -7075 -4802 -6004 -5106 6401 4866 -1292 1351 -4842 7213 -3330 -1836 3520 6899 -7138 2089 -4375 -3178 -6209 -3325 -6705 -4490 -6407 -2384 -9488 1699 4141 -4031 -7583 -1694 1913 9700 -9949 1573 -2319 -5830 -9735 -5388 -7795 9772 1105 9342 -232 -1479 -2638 -5685 -7877 8818 1675 -494 -4117 -4145 -6165 3847 -5840 -5745 9940 -6162 5196 7654 9368 -869 2899 -7733 -933 -7513 4989 -8493 -220 2900 8577 7579 -7698 5041 -9061 -8698 -3560 6416 -176 -161 1880 -6298 775 -8490 -8601 6699 1720 -528 7136 7752 8704 -4014 -6787 -9044 9355 -2196 5986 8429 1770 2306 1104 4300 174 -8830 6518 -269 -7256 -7144 4074 1565 -5260 3196 554 9897 6659 929 -9568 -5561 -850 -418 -7897 4262 4323 -2262 5456 3449 -745 -8045 -4188 -3403 -5819 9692 -6005 1025 -1825 6914 -7954 -4538 7696 -3185 -8742 -6348 5831 -6185 2873 7638 7913 769 -9108 -2250 -4678 640 -9406 -6432 -5234 -4517 -6713 9566 -4667 -2784 8595 -1845 -9895 6302 -9184 7870 2983 6727 -8295 19 -6298 -8611 9762 -7596 3993 4923 380 -2302 -1613 5173 -3973 -3752 -2595 -909 -2134 1486 -6184 -4682 -3882 3853 -7333 1865 1104 1882 -8840 -8226 8065 5860 8234 -7910 -346 -5179 6717 -6497 -8281 6886 4463 8264 -7253 5405 -4062 820 4237 -5303 -9473 -2639 -587 -6110 -3996 1734 -8024 -2982 -6783 -4109 4875 -4927 2689 -2055 1223 -8445 2698 4757 -8066 4328 -1975 6348 -1750 -9311 3345 1708 -2619 -3571 -4125 9372 4968 -2077 6988 6752 5780 2319 -1257 -6807 -5213 3387 3397 462 -3375 7667 -8537 -1781 9664 4816 -9221 8151 -4649 -269 -1282 -539 -7613 -7041 2999 7639 1208 -4871 5835 3784 -2440 7537 247 -9592 -6151 -1839 1021 -3011 6822 3271 -4387 8170 1430 9075 9098 3544 -3334 -1146 8856 -9091 5782 -4021 35 -1134 -3380 -3009 -9375 4111 -5380 -7753 -1236 -7722 -1653 555 -1304 8037 -134 9025 -1282 -5354 -8061 2821 7296 -4560 8145 3292 -6280 3464 -6020 -1378 5692 -465 -5032 -9585 305 -3665 -427 9474 -3323 6669 -4697 272 -7511 -5464 3541 -5520 1852 -4796 1063 -2351 7627 -3590 -7 6758 -2430 7676 8942 -1656 3640 6565 769 7790 9463 -8281 -7349 -2450 7136 3454 -8493 5036 2403 -7756 -3672 6177 7428 -2483 -9036 1829 3248 -8578 3050 -2159 -2123 -4267 -3867 -4187 -4096 3229 -458 -8872 7552 2015 2035 -2867 -2555 -4018 -201 8727 -3986 -5305 1227 3514 2750 -5270 -7326 9120 7896 5173 -475 2465 -10000 8934 -860 807 7077 -190 9711 9403 7374 3583 6785 -8771 2759 5161 7692 -1262 -251 -662 748 -5101 -2709 -7857 622 -2020 7087 2713 -2568 3786 -8209 -2505 7587 -5804 5913 114 423 2164 -3192 -662 -5149 -2115 -5660 -4192 -3102 -6976 4989 7133 -7865 -7364 -5883 6934 -5774 6883 4063 6841 -9564 9431 -7793 -5266 -7889 8099 -9293 4122 7275 1332 1172 3537 -1823 -2732 4158 -339 -2228 4718 7009 9620 4626 1575 -4838 -4138 -3202 -6033 7446 -2706 3959 5873 7141 3026 -8122 2566 -3616 -2716 -4257 -2966 -4151 3786 2655 9571 -580 -3723 8372 -4042 -5718 -6297 -6844 -9226 -9919 -9201 -4853 -3324 -671 9368 3460 3244 -7520 -588 -7349 -5419 -4881 -4953 1258 9043 6212 -8426 -5739 -7472 -523 -5776 -2522 6755 -8301 271 4828 -8164 3993 -6638 3987 7787 -3409 8622 462 6263 -9653 -5850 -7803 1482 -171 6517 -2492 -7920 4589 7141 -3294 -8612 7491 4158 -2148 -365 6359 -1880 -5878 -165 -3275 6408 8397 -8954 -1605 4851 -3180 1908 -4351 568 -1138 3403 -1880 6736 4272 804 9323 -6147 8732 4675 -2376 970 8405 3589 2828 2266 -6215 -9598 4589 -6718 3005 7283 1698 1932 -8820 -4949 30 5134 5758 7207 -6014 7788 3636 4589 -3571 3619 -8996 -5953 2187 9183 -4443 -2703 4589 739 4540 -490 -711 -9948 5453 -2598 -3443 -6929 -1791 1699 8563 -9551 6569 5425 -8910 5321 -5493 2769 7777 3037 4356 -2787 -2354 -8295 4703 8391 -4826 4923 -3441 9650 -7037 -3162 -8629 -8950 3428 -9698 -9311 -4702 -3863 -9986 -2012 1234 -427 -4164 9564 -490 -7762 -5869 3744 7588 5156 -1457 -5330 -9653 -4143 7240 1842 -220 9311 -1160 -3247 -9041 455 -14 -7594 6883 6431 -5032 -8618 -3465 -711 6333 803 4923 -8244 7891 9368 8039 -1518 -7353 -8330 -5440 1390 -4955 1345 4985 4589 -1836 2618 870 1168 -9065 4589 -2302 7583 7595 1694 8989 -8651 8343 -8862 -7666 -4528 4097 -8521 2747 165 856 996 -7689 -2995 1927 -3963 2664 275 -3996 7262 -5014 -1845 -4 -3182 -5542 -4891 -797 9801 9534 -7596 -5426 5141 -8173 6695 9426 -8450 316 -92 -6312 9218 4335 9288 813 6751 6727 8178 2543 -7583 8824 -150 32 2471 -1359 -8464 -4055 -6306 3363 9627 -6733 9604 1634 62 4589 6945 -3114 1116 -6438 1998 -3670 -5767 -4139 -1225 2286 -9436 6738 -9467 4428 8354 4471 -4890 -8564 5253 -2009 -105 8879 -2172 -8685 -1724 -7110 250 4655 2938 1207 2154 2001 7663 -1803 19 -5863 8641 -1257 -7378 -3320 -6312 9068 -8493 5519 6855 -4940 -302 -3946 6456 -8910 -425 -3481 9415 5986 -9291 54 -74 2454 3548 -7991 1409 -3492 2236 552 -2838 -8356 -2475 9056 1216 -6020 -3114 -6098 -9609 -9258 -6432 -6019 1476 -4348 8677 4141 3666 -6932 3548 -3852 -10 6359 -9598 -4664 -6741 3457 4675 -146 -974 1084 3064 -3963 -8135 -8736 -3931 7423 2250 -3267 167 -6832 1973 -2305 -5412 -5997 -7127 159 9506 9825 -1789 -8736 2782 3640 4870 -903 6216 7552 2219 -8789 -3220 7374 -3497 -4587 977 -8806 462 2529 -5432 -3008 -355 2570 -523 3470 -8390 -5081 7595 -2428 6958 -524 -6827 -8117 -8206 2972 -4934 -8910 9839 -3761 4663 -7061 6958 8606 2124 -3497 5467 1089 -5446 -7981 570 6706 138 -5345 -3243 -6535 -6699 -9000 170 6717 5828 4031 -1862 -5856 -2966 -883 -4603 4837 7283 8238 9644 3057 -5249 -9568 7800 -8615 1345 -1944 -1119 -8616 8564 -3303 -3238 9063 -1992 9660 -7582 6217 -4481 9940 -1729 9056 3414 2429 6594 2760 -3198 -6340 -6323 -9976 -7741 8333 -5330 -3892 3790 7550 -6187 7086 -9080 8941 -2276 8355 -1306 249 -4937 6181 -2388 -8709 -6556 2187 6759 -1325 -4208 -4347 -2471 -2629 -1125 402 8019 3741 3039 -7453 -6179 9357 -4707 -2623 3301 -5948 -9264 1901 1500 -737 6504 5854 -1527 8606 -3109 4654 4239 7560 -2988 -2138 6159 6462 5795 4618 -6877 7143 -6716 -2960 112 8067 2017 9483 -8384 9690 5978 -4595 9210 -1726 8143 2808 5175 -1931 -1860 -3240 2566 9654 -640 -2452 185 -8671 4932 2333 -3162 -8574 -4145 -461 -5156 7450 9523 3819 -1708 -9141 649 -7138 -7330 5986 -7357 4100 -8918 -3723 638 1988 8530 264 -6579 3514 1915 1243 -7820 4336 -9375 7192 2937 -8627 2468 -9843 -2457 -3077 -3831 -745 8190 675 -8684 -9224 -9199 -9000 -2275 -688 -9667 -6955 4964 4510 5006 -3821 -5483 5892 -9445 257 441 -6923 -4736 -8303 1521 2244 6035 -3319 906 7383 9490 3424 -7721 -626 -211 -3764 -8744 -5469 -2716 6844 9225 -5460 -9000 -5917 1993 -7375 4132 3959 -450 4447 2940 6159 -1972 -8805 -132 -7642 7346 4950 -1353 -4707 -1131 -9786 -8426 3301 -9802 7525 -9464 3863 7143 -171 2020 -601 6699 6281 -5222 7213 9230 1453 -6488 -6752 -4827 -941 -5167 3881 4929 1507 8050 3010 -2847 4572 3874 5558 8115 946 -1125 2054 9368 7086 -3756 -1475 -3162 -5492 1056 -1310 9221 -1239 5330 -171 -8671 464 4015 -6125 3594 3228 8864 -2123 4999 -8356 -8060 5896 3187 7774 2533 6789 -9026 -6638 -5290 8704 4851 4380 9477 6731 2873 -2654 1207 -8818 -1895 989 -111 6925 4302 -1430 -1551 2063 -495 -8364 -9585 9206 3109 102 3401 -9187 9656 6988 -6884 506 -3978 6043 -6194 5613 6452 -1877 7003 1463 -2419 9403 -8990 -3450 -7218 -8043 -1078 8757 9958 2313 6264 1555 -5981 -9348 -2410 -3243 -9792 -9451 8373 5310 6639 2483 -5298 -191 1060 760 -6580 8127 -8382 -2439 3615 7525 -1126 -5738 -3327 -6632 2460 -6285 27 188 -9941 6821 3057 -1430 8891 -9053 -3759 7931 -3127 4028 8128 4900 -9980 -7738 52 2930 -2440 -1078 -4938 2174 1071 9860 -1653 -3718 -3106 -4634 -2080 -780 6214 -7266 -9017 -6673 -9899 3292 -3789 2501 9029 5052 -4442 -9279 -9235 -4334 342 -1889 -4953 -1279 -4117 -5086 -9115 3772 6900 -1508 3764 -6150 6555 -4301 9685 3915 -7200 820 7371 6278 3979 -5150 7801 -7227 -3122 -4421 -8135 -9944 -3254 -3295 -4964 -4695 2761 4283 -2838 4753 1104 -5390 -3789 6825 -1965 1683 -6936 -2034 -8666 -3089 -9027 9062 -962 -322 6641 -5041 -3737 -3822 -6850 8952 6594 5273 -5064 1640 -600 -9351 -5211 -6705 -6884 824 -1479 8759 -2204 -4434 -9265 -7857 -3228 3089 -1920 2382 2355 -8068 -7939 -3042 -1671 2988 -6298 -2115 8147 1481 3607 -6337 -4381 7044 -3162 -558 5719 8231 8051 -4884 3594 1646 7114 -6125 -7994 -1541 -6921 3736 3853 7901 -4237 7905 -7413 812 -5506 3367 754 -7027 -626 9383 -1159 4676 1793 1762 -5371 6594 -3614 -8493 -8410 -7350 3330 -9412 4130 5053 -3863 112 -426 7531 -3180 -5684 3010 3524 5868 -8618 -6840 -2066 5670 5838 -1980 -3484 -6867 4675 464 -384 4014 -7527 -8352 3406 4122 6382 -5089 5868 -1581 -2283 -2809 -7834 -3670 1432 6752 -5887 -6972 -4034 -9221 -5963 1247 5519 -8087 -4746 -7863 -8547 -1757 1671 5279 1799 7764 3350 1172 -2450 6755 -8872 -6500 -7012 4031 -2619 1237 -2743 -3247 -737 2899 6386 4755 7790 9550 -3697 -3167 4514 5284 526 -1750 542 -521 -3573 2356 7894 -2238 7466 2706 5153 -602 -2716 -3537 2098 8262 970 -630 -1724 -9561 -5906 -2853 -1372 -4989 1998 -1160 -5842 -3313 3059 -2695 -9499 7595 9907 1577 -6358 9860 -2706 -9097 -6239 -1300 8125 -233 4979 -7597 -7138 -4128 -935 -8219 8592 -3205 5367 9996 -4713 -3809 -7486 2437 4312 2355 -271 2254 -5794 2756 9432 -9871 -6347 -8745 -8716 2434 5216 4630 -9911 3297 7421 9664 8239 3983 -7387 3405 8877 -7782 -8983 7150 8212 4579 4097 -5033 3085 -8356 -1094 -1412 -4155 3951 8874 -4931 -6637 -1071 7169 5716 -4746 1034 -9201 -2625 -5131 -3042 8462 -6635 -4321 -3872 -780 4218 4837 -2716 2566 4825 4141 -9342 -3407 -7721 9880 -6433 -318 3089 -9044 5077 1467 -8224 9358 -1893 -2638 9232 4304 -7003 -8718 -7270 -4212 3109 4298 3883 -4131 -2384 2601 34 -9495 -9634 2790 565 1078 9049 9862 -7372 5905 3137 -775 385 586 -9041 7677 -2728 5670 3234 -2956 5946 359 -7759 -4687 2141 8264 -3934 9062 -6580 -3762 -5223 -5280 4941 4626 -3815 4724 4999 -4644 2623 8787 2577 -6638 8077 -1577 5235 4680 -3126 -1703 1913 -5081 2934 -8206 -3025 7380 -7807 9835 1110 -6214 -7130 -3996 -4657 5600 -40 -9565 1476 7421 -5957 -9604 3969 -5341 9036 -792 3819 7633 2587 -3889 -7446 1276 -8287 -6962 1009 8389 5891 -2896 4463 -4671 1745 4485 -6428 -4953 6720 934 2254 9880 6095 -6972 -1605 -1564 -82 8401 -4840 -541 -3599 -8868 4703 -6655 -9496 9205 -6929 1939 -8974 -4953 -5906 -2045 54 -5020 894 -6751 2941 -2115 2219 -6165 -1931 5917 -5053 -1292 4792 -9414 -8814 -1720 -5944 -6932 -7640 4897 6693 -808 -6644 -9265 -3224 -8847 7275 5990 6727 -2018 -7020 -1479 9652 6805 -1075 -4641 -2070 6032 -4746 -9009 4782 2402 6251 -9044 -7345 2547 9350 -592 7130 -1181 -2708 9375 -843 4254 -6867 -1669 1998 -7729 -6325 1288 759 -3612 129 5797 -4291 -7275 2061 4968 -5754 -6669 -4763 7731 -6285 8776 5767 -621 1642 1226 3234 1476 8440 -4651 -3628 -435 -5488 3687 -143 -7353 -9450 2234 -6799 4846 2373 5042 -9448 8853 9581 -3172 -7196 35 -8840 -3086 252 9685 3501 4431 -2326 -3831 746 4186 -3275 -3973 -640 8104 -9572 8193 -92 -5625 7635 -2215 3300 -977 9091 -4139 1009 -5209 -178 1512 -2596 -2934 1155 1652 8777 4343 9731 9760 9070 -5918 2286 -4891 -1484 -7404 6362 6068 -5017 -1337 6735 -1686 -4770 -8006 -9751 -9239 -6312 -9184 675 -6884 -3661 8778 1654 5034 -6614 -6087 -6525 -269 -9449 8299 3006 -5957 353 1507 8083 1810 -6204 -144 -1027 5795 -4092 -6474 6636 -3024 -6071 4651 5732 -6151 -8316 5620 -5092 -1427 8252 15 -1859 -7878 -5143 287 -5530 1927 -955 -1823 2508 1299 509 -8612 4021 1262 -8791 -3978 759 2641 4333 -4938 -3084 -9116 6675 6951 -7593 3258 -2499 -2337 2547 2974 -110 8893 -7538 -2151 -5146 -9789 2869 -7339 -9980 -4746 -9117 -6591 -2376 -9253 -9116 6232 -2159 -2838 -4119 -8626 -3369 -6568 8479 8524 -1881 -8233 -7353 8445 6540 -4390 1274 9545 -8211 -6448 -8277 102 7790 2707 -190 -9581 4800 3658 7467 -6889 814 -2206 6281 5405 7374 -3794 190 8479 6531 -1243 2048 -7099 -5632 5077 9652 9470 -3661 6516 7933 5560 9973 1155 -8364 -6638 -419 -8493 -600 1604 369 -7395 -8612 -4055 -7752 -6382 1021 1523 -4825 6629 -3893 8916 -2677 -814 7372 -6923 6214 1383 -8273 2187 -6877 7403 673 4989 9095 6180 -2539 -7990 -2066 5063 -9021 -1170 2931 5260 -4381 -878 3948 -1325 4964 -5394 -4610 -6672 8876 -8900 6572 5158 4501 -2623 963 -8626 4486 -3818 -4416 9499 4298 3915 8299 3671 -7749 -3414 8093 4131 879 -9189 -5499 -5670 8470 7588 316 -8604 363 -5316 3246 7010 8399 1443 -9658 -8206 -9406 9430 -2109 -2305 -6454 7720 -4905 -4587 7601 -6904 7461 7951 -9675 -191 -3806 841 9171 -4822 -7395 4682 -1505 -7880 -7498 9591 -9606 -3904 -4237 2410 -3537 -3290 5319 2799 -8209 -4008 9068 -3956 2759 -8676 -6179 9839 4276 -8068 4329 4630 -4853 1358 151 -1686 -4085 -2333 1615 2477 2698 6041 -2092 9365 -5742 3765 3727 2742 6013 9618 6281 4834 -9291 -3089 -2940 5039 -2331 -2202 -2687 -2148 2829 -7345 8304 7184 -7793 -3862 9364 -3202 1771 5063 -1077 -8536 -5776 3325 -7701 -8818 6248 9020 8125 4453 1878 1825 -4166 -4160 4253 7086 3816 -7689 -2322 7413 1195 977 -8146 8092 -343 6205 4131 -4739 -5434 -7495 -4991 -7075 -2291 4950 -3160 3039 952 7891 -5861 -893 -8385 3786 -3927 -1818 8285 1161 -461 -1097 6163 812 -7700 -4085 -7020 4801 8548 -5316 9631 -402 2465 240 9274 1880 -96 3391 -9754 3313 -6179 4438 385 -1170 -5354 7421 5895 -5711 -3666 -9756 -1639 14 -4387 1532 8476 3114 -7878 8556 1237 -1022 -8157 2927 3722 -6380 -7597 7856 -9802 -1412 5285 -6752 5896 -8358 -1924 -292 -882 -5493 -804 -6863 -5606 -4411 5656 -3822 8327 -1859 2709 -3560 2756 -1724 5343 -5320 -7793 -8334 -5141 -8330 9957 3244 7311 9181 -2238 -523 -9096 2263 -7742 -6601 2252 8193 9393 9863 6558 1909 4988 -4913 -1320 3898 3962 -6507 -6904 -5373 262 3038 2049 5740 9568 2759 -6942 6934 9388 9210 6561 -6208 -3240 197 3204 9227 -663 -2480 7640 -4083 7529 -1372 -8264 -1763 5351 -3594 -1562 7892 951 1843 -366 1762 -3641 3961 -8227 1345 -5955 -2305 -7378 4923 -5324 -5549 3948 -780 8927 4063 62 -5975 -4044 -2928 -7175 8600 -6544 -6248 -9093 5130 7216 -3164 -3260 -8780 6135 1880 9609 -7020 -2200 4506 -4170 3455 2417 -6670 8080 -8287 8776 3676 9745 -2838 2447 -9605 9483 -6979 5289 7136 9462 2615 9113 2441 -3510 -6895 -755 -8779 9464 -8064 -6526 7426 -8830 6855 -7512 -9136 -9437 -8064 5311 5105 -3863 -8560 35 -5826 -6029 -1292 4110 2181 -4303 6918 -2277 7246 1975 -8727 -3357 604 3698 -637 6489 -2104 1071 -5287 -7567 -9022 2900 4309 9622 -4281 9347 6683 6307 -323 -1170 2800 -5961 5913 54 3009 2410 -7178 -1980 9486 -8338 -396 709 882 4964 982 -4351 -5989 -3855 1578 1518 5412 2474 -2020 -5795 -3922 505 -305 -2202 2017 -8940 -8764 6594 9313 -7501 2272 4551 6671 5782 -5542 3583 -8919 9692 3702 -2558 -2188 5067 6752 8876 2468 -6358 7197 1575 4726 -1193 4965 -969 -2204 5552 1881 4520 -7677 -1511 -8690 6579 5236 -4977 -3059 -2014 -806 -2970 8071 -8791 -5483 5462 6892 -926 -8334 7607 784 5429 -9949 -8377 2806 6782 2400 -4223 -1446 -3697 7506 8803 -9161 2531 -6474 -692 -7222 4482 5351 -4504 -418 -4844 -1337 6885 6722 6177 1622 -4536 -159 -2445 8713 -828 -1237 5036 6767 -8036 5395 1727 6760 81 -2540 -2606 -688 6449 -4371 -5845 5725 -9975 9922 -4977 -2499 -9394 -4930 8499 -5368 -7931 8893 -4588 6045 -4390 -1951 2749 2305 -7442 9260 3461 7777 -3209 -1412 -3348 -3219 9518 -8176 4650 -6827 -3234 9320 -3067 4490 -3024 -8428 380 -232 4919 5145 6452 -5380 1345 6710 7143 4262 2373 6591 4474 305 -3943 -6019 2089 -5304 -3956 -3752 -4106 5663 -9121 -7638 -1904 -1130 -2292 3117 4898 3755 9049 -4644 -585 -9754 8533 -4014 -11 129 -4348 9738 353 3271 -7004 7565 3031 -8847 -5381 8434 3363 -2009 3989 -7183 5480 5779 -4907 552 9821 -780 8916 8527 -1685 9838 -1525 6706 -304 -6923 359 1320 -1266 4333 -2443 -8381 -9605 -2657 3257 4473 4761 -9422 2954 3336 4790 4850 383 6424 -3931 -9892 5860 -4588 -2587 752 4558 2612 -387 -7969 -5141 3837 -2080 -6515 924 3354 9297 -502 -8795 -9449 5839 6229 7554 -1542 -8838 -4973 1422 4390 -8157 -8429 4959 -9276 -9814 -6580 -9311 9388 -1479 -6632 8279 -6977 -8133 -8152 8080 -2156 4682 -7486 -6225 -9322 6424 2864 8267 5060 -9299 2556 -371 -6573 3258 1413 -6103 -5381 -4301 -1999 570 -8615 6043 8538 6569 -8454 -3185 -5513 9432 2725 -1474 -662 -7020 3096 8703 -2680 8622 -8946 -1372 -7497 -130 -4119 9940 -8358 -9635 3455 -9723 -621 -2956 9992 -2009 5679 -3617 7305 8592 2423 692 4959 -9565 5617 -6667 -9364 5868 9534 -775 4077 -4229 5069 -3667 -2539 8344 6815 7371 -4021 1820 114 -8103 -7700 -935 -4381 8274 -909 1853 -1216 7438 -4695 4439 -6151 9226 3922 2285 -5625 8945 6402 2224 -740 7583 -8356 1789 8285 6810 6182 6076 -7736 -759 -9606 5333 8163 -3145 -3749 -9215 5026 8553 4619 -9116 -6184 -4884 2930 -3413 4512 1476 5234 946 -3583 5781 -4569 1854 -1342 7626 -8950 -3061 2426 9909 -5489 -7803 -8493 7825 5469 6394 8333 9830 1668 1386 2058 3904 8129 -903 7003 185 1018 -7863 4252 -1697 -4429 8389 6295 4731 2702 6009 2024 -8086 -2364 769 -9689 1576 6009 114 -9211 380 6323 -7223 2014 -5343 -146 -6798 -8612 5063 -6781 -962 -1390 -6201 4566 7421 -3993 -6697 6212 9818 -5200 3717 4074 -2022 -4645 1873 3033 -4042 -9975 -2595 7670 -2074 8396 5072 -1671 -2169 3139 -9786 -490 -1501 -2055 -8894 -6125 9062 6344 9743 -410 -3956 4999 -6384 -6405 5509 -8896 7206 -9297 2400 -2956 3910 7892 -5369 9499 -9713 8397 5346 -1807 -5065 -1685 -134 -1378 2124 2782 -4277 -2912 69 -6877 -933 7918 5266 2927 -134 9688 -7874 31 -8406 -7939 -6581 -775 -2073 -9949 570 8958 3078 3727 4233 -4529 -8923 -3253 -8441 -3195 -4897 -7587 6104 4291 5077 -3409 -9128 5460 464 -35 1880 -2331 -3915 6727 6194 -8075 -7629 769 9904 9743 -5414 -4416 5258 -1372 -6996 -750 4408 -3930 9755 6059 4097 3089 9019 2792 -7495 -8372 6104 -9342 4724 -6447 1999 2089 300 -8334 -8801 6544 9317 -6445 -4342 7702 6668 1476 6159 -4085 -7 8282 6382 626 -7931 9786 960 -6396 -2743 6086 -8611 -4538 -7434 9887 -8642 -8806 7183 2280 2595 -2706 -79 5324 666 475 1723 -6768 -366 6140 -7466 8426 -7037 -4443 1820 7428 -4579 -527 9897 8852 6841 6518 -7205 -6704 -6036 -6626 803 -5219 3371 789 -8454 7471 5728 9019 5627 -4441 4373 -2224 -1559 7588 -8173 6699 -4375 -7663 7830 4548 -7353 -2144 5707 -3496 -3492 -6969 4029 5693 2704 -5860 8818 -7120 9336 -859 -4029 7539 413 -3783 423 -9159 2470 -5370 -9267 -5403 -9079 -9153 3047 2981 -4008 -5207 -9912 5858 -4782 7515 -6663 -1934 -1369 -7012 2161 -9647 6914 -8135 -5381 5818 -251 4447 -6701 -8801 -5423 -3718 3226 3110 -773 70 3669 -6403 -502 -4825 7087 3745 -2301 1235 5839 6176 3133 745 -3202 5795 -4438 -8206 -241 7535 1207 8004 -3289 -4838 5291 -2624 -6398 934 8736 -4528 9953 1860 -2826 -3706 -6736 5279 -4645 7584 4324 -795 -8990 2084 5648 9914 1498 157 -5094 9321 -6491 4090 4989 6304 240 2785 -6335 1084 6658 -5321 -1142 8724 -4059 775 1415 -7555 -8224 1503 14 5067 -6427 -631 -4116 6157 -1940 -3324 -1305 305 -9592 9259 7667 -486 -7349 -3363 626 -7453 -4746 5285 -1837 3253 5962 9945 1058 -6884 -584 7701 -7853 -1907 8054 -4529 -5538 8824 -45 4613 2417 104 -9083 8564 -1499 -6339 -8900 -6019 2811 4049 8648 -8864 -7889 5480 -631 -6055 2934 4937 9332 8925 7796 -7563 5132 -2638 -9100 -6966 -3235 8891 -7130 5740 -5792 -5345 9332 7539 5691 8204 19 -4517 2694 5173 -7130 5289 -6323 1296 5288 -2064 9839 4332 -5145 7723 -588 5753 -7666 7287 -4356 -794 -6259 -8718 -8230 8479 -5029 1274 -4582 -8266 -1692 -9199 -3848 -7688 3466 769 6532 498 -2027 9023 5343 7255 8474 5383 7328 5723 3722 -7257 -6808 3879 -4593 -8424 9211 -3735 -7326 -8493 7555 -9798 -3213 6024 3579 -2061 6106 -5489 8576 -3725 3704 1854 -9157 9678 7814 9505 34 -621 9321 4272 7409 -9116 -7977 -2693 -2606 -3821 -1649 2623 1678 8462 3594 2156 -6396 -493 7656 6172 1880 6297 -5156 970 -6433 -9173 -8181 -2156 -2787 -7115 -2607 ================================================ FILE: git-hooks/prepare-commit-msg ================================================ #!/usr/bin/env ruby message = File.read(ARGV[0]) exit 0 unless message.start_with? "\n" prefixes = [ [%r{^other/clrs/(\d+)/(\d+)/(\d+)\.}, -> { "clrs; exercise #{$1.to_i}.#{$2.to_i}.#{$3.to_i} – " }], [%r{^other/clrs/(\d+)/problems/(\d+)\.}, -> { chapter, number = $1, $2 title = File.read("other/clrs/#$1/problems/#$2.markdown")[/\A#+\s+(.*)/, 1].downcase rescue "FAILED TO GET TITLE" "clrs; problem #{chapter.to_i}.#{number.to_i} – #{title}" }], ] files = `git diff-index --cached --name-only HEAD`.split("\n") exit 0 if files.empty? first = files.first prefixes.each do |regexp, title| next unless regexp =~ first prefix = $& header = title.() break unless files.all? { |file| file.start_with? prefix } File.write ARGV[0], header + message end ================================================ FILE: go/gopl/.ruby-version ================================================ 2.3.3 ================================================ FILE: go/gopl/01/01/echo.go ================================================ // Exercise 1.1: Modify the echo program to also print os.Args[0], the name of // the command that invoked it. package main import ( "fmt" "io" "os" "strings" ) var out io.Writer = os.Stdout func main() { echo(os.Args) } func echo(args []string) { fmt.Fprintln(out, strings.Join(args, " ")) } ================================================ FILE: go/gopl/01/01/echo_test.go ================================================ package main import ( "bytes" "testing" ) func TestEcho(t *testing.T) { out = new(bytes.Buffer) args := []string{"ls", "-la", "whatever"} want := "ls -la whatever\n" echo(args) got := out.(*bytes.Buffer).String() if got != want { t.Errorf("echo(%q) = %q, want %q", args, got, want) } } ================================================ FILE: go/gopl/01/02/echo.go ================================================ // Exercise 1.2: Modify the echo program to print the index and value of each // of its arguments, one per line. package main import ( "fmt" "io" "os" ) var out io.Writer = os.Stdout func main() { echo(os.Args) } func echo(args []string) { for i, arg := range args { fmt.Fprintf(out, "%d %s\n", i, arg) } } ================================================ FILE: go/gopl/01/02/echo_test.go ================================================ package main import ( "bytes" "testing" ) func TestEcho(t *testing.T) { out = new(bytes.Buffer) args := []string{"ls", "-la", "whatever"} want := "0 ls\n1 -la\n2 whatever\n" echo(args) got := out.(*bytes.Buffer).String() if got != want { t.Errorf("echo(%q) = %q, want %q", args, got, want) } } ================================================ FILE: go/gopl/01/03/echo.go ================================================ // Exercise 1.3: Experiment to measure the difference in running time between // our potentially inefficient versions and the one that users strings.Join // (Section 1.6 illustrates part of the time package, and Section 11.4 shows // how to write benchmark tests for systematic performance evaluation.) package main import ( "fmt" "io" "os" "strings" ) func main() { echo1(os.Stdout, os.Args[1:]) } func echo1(out io.Writer, args []string) { var s, sep string for i := 0; i < len(args); i++ { s += sep + args[i] sep = " " } fmt.Fprintln(out, s) } func echo2(out io.Writer, args []string) { var s, sep string for _, arg := range args { s += sep + arg sep = " " } fmt.Fprintln(out, s) } func echo3(out io.Writer, args []string) { fmt.Fprintln(out, strings.Join(args, " ")) } ================================================ FILE: go/gopl/01/03/echo_test.go ================================================ package main import ( "bytes" "strings" "testing" ) var testInput = strings.Split(` Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean dictum lacinia purus, at rutrum erat vulputate id. Vestibulum vel elementum metus, in vehicula sem. Nullam vitae magna hendrerit, sodales erat vel, placerat sapien. Integer pharetra, lectus a scelerisque imperdiet, tortor leo sagittis nisi, in pellentesque quam ipsum a turpis. Morbi nec neque porta, dapibus velit at, mattis elit. Praesent elementum nisl est, in facilisis lacus ullamcorper eu. Praesent sed eros a nisi vulputate viverra nec et tortor. Maecenas volutpat sed purus et fermentum. Sed pulvinar dolor ut diam imperdiet dictum. Nullam venenatis odio nisi, vestibulum dignissim mauris auctor id. Mauris sagittis neque interdum dignissim vulputate. Curabitur congue tempus lectus. Pellentesque habitant morbi tristique senectus et netus et malesuada fames ac turpis egestas. Ut consequat convallis urna, et venenatis nisl laoreet at. Proin id porta odio, nec luctus justo. `, " ") func TestEcho1(t *testing.T) { out := new(bytes.Buffer) args := []string{"ls", "-la", "whatever"} want := "ls -la whatever\n" echo1(out, args) got := out.String() if got != want { t.Errorf("echo(%q) = %q, want %q", args, got, want) } } func TestEcho2(t *testing.T) { out := new(bytes.Buffer) args := []string{"ls", "-la", "whatever"} want := "ls -la whatever\n" echo2(out, args) got := out.String() if got != want { t.Errorf("echo(%q) = %q, want %q", args, got, want) } } func TestEcho3(t *testing.T) { out := new(bytes.Buffer) args := []string{"ls", "-la", "whatever"} want := "ls -la whatever\n" echo3(out, args) got := out.String() if got != want { t.Errorf("echo(%q) = %q, want %q", args, got, want) } } func BenchmarkEcho1(b *testing.B) { out := new(bytes.Buffer) for i := 0; i < b.N; i++ { echo1(out, testInput) } } func BenchmarkEcho2(b *testing.B) { out := new(bytes.Buffer) for i := 0; i < b.N; i++ { echo2(out, testInput) } } func BenchmarkEcho3(b *testing.B) { out := new(bytes.Buffer) for i := 0; i < b.N; i++ { echo3(out, testInput) } } ================================================ FILE: go/gopl/01/04/dup.go ================================================ // Exercise 1.4: Modify dup2 to print the names of all files in which each // duplicated line occurs. package main import ( "bufio" "fmt" "io" "os" ) var out io.Writer = os.Stdout func main() { dup2(os.Stdout, os.Args[1:]) } func dup2(out io.Writer, files []string) { counts := make(map[string]int) locations := make(map[string]map[string]bool) if len(files) == 0 { countLines(os.Stdin, "", counts, locations) } else { for _, filename := range files { f, err := os.Open(filename) if err != nil { fmt.Fprintf(os.Stderr, "dup: %v\n", err) } countLines(f, filename, counts, locations) f.Close() } } for line, n := range counts { if n > 1 { fmt.Fprintf(out, "%d\t%s", n, line) for location, _ := range locations[line] { fmt.Fprintf(out, " %s", location) } fmt.Fprintf(out, "\n") } } } func countLines(f *os.File, filename string, counts map[string]int, locations map[string]map[string]bool) { input := bufio.NewScanner(f) for input.Scan() { text := input.Text() counts[text]++ if locations[text] == nil { locations[text] = make(map[string]bool) } locations[text][filename] = true } } ================================================ FILE: go/gopl/01/04/dup_test.go ================================================ package main import ( "bytes" "sort" "strings" "testing" ) func TestDup(t *testing.T) { out := new(bytes.Buffer) args := []string{"fixtures/first", "fixtures/second", "fixtures/third"} want := []string{"", "2\tthree fixtures/first fixtures/second", "2\tfive fixtures/second fixtures/third", "2\tseven fixtures/third"} dup2(out, args) got := strings.Split(out.String(), "\n") sort.Strings(want) sort.Strings(got) if strings.Join(got, "\n") != strings.Join(want, "\n") { t.Errorf("result = %q\nwant %q", got, want) } } ================================================ FILE: go/gopl/01/04/fixtures/first ================================================ one two three ================================================ FILE: go/gopl/01/04/fixtures/second ================================================ three four five ================================================ FILE: go/gopl/01/04/fixtures/third ================================================ five six seven seven ================================================ FILE: go/gopl/01/05/lissajous.go ================================================ // Exercise 1.5: Change the Lissajous program's color palette to green on // black, for added authenticity. To create the web color #RRGGBB, use // color.RGBA{0xRR, 0xGG, 0xBB, 0xff} where each pair of hexadecimal digits // represents the intensity of the red, green, or blue component of the pixel. package main import ( "image" "image/color" "image/gif" "io" "math" "math/rand" "os" ) var palette = []color.Color{color.Black, color.RGBA{0x00, 0xFF, 0x00, 0xFF}} const ( foregroundIndex = 0 backgroundIndex = 1 ) func main() { lissajous(os.Stdout) } func lissajous(out io.Writer) { const ( cycles = 5 res = 0.001 size = 100 nframes = 64 delay = 8 ) freq := rand.Float64() * 3.0 anim := gif.GIF{LoopCount: nframes} phase := 0.0 for i := 0; i < nframes; i++ { rect := image.Rect(0, 0, 2*size+1, 2*size+1) img := image.NewPaletted(rect, palette) for t := 0.0; t < cycles*2*math.Pi; t += res { x := math.Sin(t) y := math.Sin(t*freq + phase) img.SetColorIndex(size+int(x*size+0.5), size+int(y*size+0.5), backgroundIndex) } phase += 0.1 anim.Delay = append(anim.Delay, delay) anim.Image = append(anim.Image, img) } gif.EncodeAll(out, &anim) } ================================================ FILE: go/gopl/01/06/lissajous.go ================================================ // Exercise 1.06: Modify the Lissajous program to produce images in multiple // colors by adding more values to palette and then displaying them by changing // the third argument of SetColorIndex in some interesting way. package main import ( "image" "image/color" "image/gif" "io" "math" "math/rand" "os" ) var palette = []color.Color{ color.Black, color.RGBA{0x00, 0xFF, 0x00, 0xFF}, color.RGBA{0xFF, 0x00, 0x00, 0xFF}, color.RGBA{0x00, 0x00, 0xFF, 0xFF}, color.RGBA{0xFF, 0x00, 0xFF, 0xFF}, color.RGBA{0xFF, 0xFF, 0x00, 0xFF}, } const ( foregroundIndex = 0 backgroundIndex = 1 ) func main() { lissajous(os.Stdout) } func lissajous(out io.Writer) { const ( cycles = 5 res = 0.001 size = 100 nframes = 64 delay = 8 ) freq := rand.Float64() * 3.0 anim := gif.GIF{LoopCount: nframes} phase := 0.0 for i := 0; i < nframes; i++ { rect := image.Rect(0, 0, 2*size+1, 2*size+1) img := image.NewPaletted(rect, palette) for t := 0.0; t < cycles*2*math.Pi; t += res { x := math.Sin(t) y := math.Sin(t*freq + phase) img.SetColorIndex(size+int(x*size+0.5), size+int(y*size+0.5), uint8(t/(2*math.Pi))+1) } phase += 0.1 anim.Delay = append(anim.Delay, delay) anim.Image = append(anim.Image, img) } gif.EncodeAll(out, &anim) } ================================================ FILE: go/gopl/01/07/fetch.go ================================================ // Exercise 1.7: The function call io.Copy(dst, src) reads from src and writes // to dst. Use it instead of ioutil.ReadAll to copy the response body to // os.Stdout without requiring a buffer large enough to hold the entire stream. // Be sure to check the error result of io.Copy. package main import ( "fmt" "io" "net/http" "os" ) func main() { for _, url := range os.Args[1:] { resp, err := http.Get(url) if err != nil { fmt.Fprintf(os.Stderr, "fetch: %v\n", err) os.Exit(1) } _, err = io.Copy(os.Stdout, resp.Body) if err != nil { fmt.Fprintf(os.Stderr, "fetch: reading %s: %v\n", url, err) os.Exit(1) } } } ================================================ FILE: go/gopl/01/08/fetch.go ================================================ // Exercise 1.8: Modify fetch to add the prefix http:// to each argument URL if // it is missing. You might want to use strings.HasPrefix. package main import ( "fmt" "io" "net/http" "os" "strings" ) func main() { for _, url := range os.Args[1:] { if !strings.HasPrefix(url, "http://") && !strings.HasPrefix(url, "https://") { url = "http://" + url } resp, err := http.Get(url) if err != nil { fmt.Fprintf(os.Stderr, "fetch: %v\n", err) os.Exit(1) } _, err = io.Copy(os.Stdout, resp.Body) if err != nil { fmt.Fprintf(os.Stderr, "fetch: reading %s: %v\n", url, err) os.Exit(1) } } } ================================================ FILE: go/gopl/01/09/fetch.go ================================================ // Exercise 1.9: Modify fetch to also print the HTTP status code, found in // resp.Status package main import ( "fmt" "io" "net/http" "os" "strings" ) func main() { for _, url := range os.Args[1:] { if !strings.HasPrefix(url, "http://") && !strings.HasPrefix(url, "https://") { url = "http://" + url } resp, err := http.Get(url) if err != nil { fmt.Fprintf(os.Stderr, "fetch: %v\n", err) os.Exit(1) } fmt.Println(resp.Status) _, err = io.Copy(os.Stdout, resp.Body) if err != nil { fmt.Fprintf(os.Stderr, "fetch: reading %s: %v\n", url, err) os.Exit(1) } } } ================================================ FILE: go/gopl/Gemfile ================================================ source :rubygems gem 'guard' gem 'guard-shell' gem 'thor' gem 'term-ansicolor' gem 'rb-fsevent', require: false gem 'rb-inotify', require: false ================================================ FILE: go/gopl/README.markdown ================================================ # The Go Programming Language This is some code I've written while reading [The Go Programming Language](http://www.gopl.io/). I'm trying to solve all exercises one by one. I initially decided not to do the exercises of the book, but they just turned out to be too much fun. Ideally they will help me get a bit more familiar with the language before I try to do something with it. ================================================ FILE: go/gopl/Thorfile ================================================ require 'term/ansicolor' class Exercise class << self def next current_chapter = chapters(false).last last_exercise = exercises_in_chapter(current_chapter).last next_exercise = last_exercise.to_i + 1 new current_chapter, next_exercise end def each chapters.each do |chapter| exercises_in_chapter(chapter).each do |number| yield new chapter, number end end end def each_with_test each do |exercise| next unless exercise.has_test? yield exercise end end private def chapters Dir['*'].grep(/^(\d+)$/).sort.map(&:to_i) end def exercises_in_chapter(chapter) chapter = format "%02d", chapter.to_i Dir["#{chapter}/*"].grep(%r{^(?:\d+)/(\d+)$}) { $1.to_i }.sort end end def initialize(chapter, number) @chapter = chapter.to_i @number = number.to_i end def name format "%d.%02d", @chapter, @number end def run files = Dir.glob('*.go').reject { |name| name.end_with?('_test.go') } raise "Don't know how to run multiple files yet" if files.count != 1 file = files.first cd { system "go run #{file}" } end def run_test(stdout: true) raise "No tests found in #{path}" unless has_test? command = "go test" command += " > /dev/null 2>&1" unless stdout cd { system command } end def run_benchmark raise "No tests found in #{path}" unless has_test? cd { system "go test -bench=. -benchmem" } end def has_test? Dir["#{path}/*_test.go"] != [] end private def cd Dir.chdir(path) { yield } end def path format "%02d/%02d", @chapter, @number end end class Run < Thor include Term::ANSIColor desc :exercise, 'Runs an exercise or its tests' method_option :chapter, type: :numeric, desc: 'The chapter number' method_option :number, type: :numeric, desc: 'The exercise number' def exercise(chapter, number) exercise = Exercise.new(chapter, number) exercise.run end desc :test, 'Runs the tests of an exercise' method_option :chapter, type: :numeric, desc: 'The chapter number' method_option :number, type: :numeric, desc: 'The exercise number' def test(chapter, number) exercise = Exercise.new(chapter, number) exit exercise.run_test ? 0 : 1 end desc :benchmark, 'Runs the benchmark of an exercise' method_option :chapter, type: :numeric, desc: 'The chapter number' method_option :number, type: :numeric, desc: 'The exercise number' def benchmark(chapter, number) exercise = Exercise.new(chapter, number) exit exercise.run_benchmark ? 0 : 1 end desc :all, 'Runs all the tests' def all Exercise.each_with_test do |exercise| print bold("#{exercise.name}: ") success = exercise.run_test stdout: false if success puts "success" else puts red("FAILURE") exit(1) unless success end end puts green("OK") end end ================================================ FILE: haskell/aryth/Ast.hs ================================================ module Ast ( Expr(..), BinaryOp(..), Statement(..), build ) where import qualified Data.Map as M import Data.List (nub, intercalate, (\\)) import Control.Applicative ((<$>)) data BinaryOp = Add | Sub | Mul | Div | Exp deriving (Eq, Show) data Expr = Number Float | Name String | Call String [Expr] | Binary BinaryOp Expr Expr deriving (Eq) data Statement = Expr Expr | Assignment String Expr | Definition String [String] Expr deriving (Eq) instance Show Statement where show (Expr expr) = show expr show (Assignment var expr) = var ++ " = " ++ show expr show (Definition name args body) = name ++ "(" ++ intercalate ", " args ++ ") { " ++ show body ++ " }" instance Show Expr where show (Number n) = show n show (Name v) = v show (Call name args) = name ++ "(" ++ intercalate ", " (map show args) ++ ")" show (Binary op a b) = "(" ++ show a ++ " " ++ symbol op ++ " " ++ show b ++ ")" instance Num Expr where (+) = Binary Add (*) = Binary Mul (-) = Binary Sub abs = undefined signum = undefined fromInteger = Number . fromIntegral instance Fractional Expr where (/) = Binary Div fromRational = Number . fromRational instance Floating Expr where (**) = Binary Exp pi = undefined exp = undefined log = undefined sin = undefined cos = undefined asin = undefined atan = undefined acos = undefined sinh = undefined cosh = undefined asinh = undefined atanh = undefined acosh = undefined symbol :: BinaryOp -> String symbol Add = "+" symbol Sub = "-" symbol Mul = "*" symbol Div = "/" symbol Exp = "^" showOp :: (Show s) => String -> s -> s -> String showOp op a b = "(" ++ show a ++ " " ++ op ++ " " ++ show b ++ ")" someExpr :: Expr someExpr = (3 + 1) * 3 - 1 / 2 + 2 ** 1 ** 2 variables :: Expr -> [String] variables = nub . nonUnique where nonUnique (Number _) = [] nonUnique (Name n) = [n] nonUnique (Binary _ a b) = variables a ++ variables b build :: String -> [String] -> Expr -> Either String Statement build name args body | length args /= length (nub args) = Left $ "Duplicate argument name: " ++ show args | not . null $ variables body \\ args = Left $ "Undefined arguments: " ++ show (variables body \\ args) | otherwise = Right $ Definition name args body main = do print $ show someExpr print $ 1 + Call "foo" [1, 2, Name "a" + 1] ================================================ FILE: haskell/aryth/Interpreter.hs ================================================ import Ast import Parser import World import qualified Data.Map as M import Control.Monad (forM) exec :: World -> Statement -> (Computation (Maybe Float), World) exec world (Expr expr) = (Just `fmap` evaluate world expr, world) exec world (Assignment name expr) = case evaluate world expr of Failure err -> (Failure err, world) Success val -> (Success Nothing, M.insert name (Value val) world) exec world (Definition name args body) = (Success Nothing, world') where world' = M.insert name (Function (FuncDef args body)) world process :: World -> IO () process world = do putStr "> " input <- getLine case input of "q" -> return () "defs" -> do forM (M.toAscList world) $ \(n, i) -> putStrLn $ n ++ ": " ++ show i process world _ -> case parseAst input of Left err -> do putStrLn "Parsing error:" putStrLn $ concat $ map (\s -> " " ++ s ++ "\n") (lines (show err)) process world Right stmt -> let (comp, world') = exec world stmt in case comp of Failure msg -> print msg >> process world' Success (Just val) -> print val >> process world' Success Nothing -> process world' main = process caladan m = main ================================================ FILE: haskell/aryth/Parser.hs ================================================ module Parser ( parseAst ) where import Ast import Data.List (intercalate) import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr (buildExpressionParser, Assoc(..), OperatorTable(..), Operator(..)) import qualified Text.ParserCombinators.Parsec.Token as P import Text.ParserCombinators.Parsec.Language (emptyDef) import Control.Monad (liftM, forM) lexer = P.makeTokenParser emptyDef whiteSpace = P.whiteSpace lexer natural = P.natural lexer parens = P.parens lexer reservedOp = P.reservedOp lexer identifier = P.identifier lexer comma = P.comma lexer braces = P.braces lexer statement = (try definition >>= either fail return) <|> try assignment <|> liftM Expr expr assignment = do name <- identifier reservedOp "=" value <- expr return $ Assignment name value call = do name <- identifier args <- parens (sepBy expr comma) return $ Call name args definition = do name <- identifier args <- parens (sepBy identifier comma) body <- braces expr return $ build name args body expr = buildExpressionParser table term "expression" term = try call <|> parens expr <|> liftM (Number . fromIntegral) natural <|> liftM Name identifier "simple expression" table :: OperatorTable Char () Expr table = [ [binary "^" Exp AssocRight], [binary "*" Mul AssocLeft, binary "/" Div AssocLeft], [binary "+" Add AssocLeft, binary "-" Sub AssocLeft] ] binary symbol op assoc = Infix (reservedOp symbol >> return (Binary op)) assoc parseAst input = parse parser "(ast input)" input where parser = do whiteSpace ast <- statement eof return ast codes = [ "1 + 2", "f(a,b)", "f(c, d) { c + d }", "f(a, a) { 1 }", "f(a) { 1 }", "f(x) { x + c }" ] main = do forM codes $ \code -> do case parseAst code of Left err -> putStrLn $ code ++ ": " ++ intercalate " | " (lines (show err)) Right ast -> putStrLn $ code ++ ": " ++ show ast return () ================================================ FILE: haskell/aryth/World.hs ================================================ {-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} module World ( World, Inhabitant(..), Computation(..), ComputationError(..), FuncDef(..), evaluate, caladan ) where import Ast import qualified Data.Map as M import Data.List (intercalate) import Control.Monad (liftM2, mapM) import Control.Monad.Error --(Error(..), throwError, MonadError(..)) data FuncDef = FuncDef { args :: [String], body :: Expr } deriving (Eq, Show) data Inhabitant = Value Float | Function FuncDef deriving (Eq) type World = M.Map String Inhabitant newtype ComputationError = ComputationError { msgOf :: String } deriving (Show, Eq) data Computation a = Success a | Failure ComputationError deriving (Show, Eq) instance Functor Computation where f `fmap` Success a = Success (f a) f `fmap` Failure e = Failure e instance Monad Computation where return x = Success x (Failure err) >>= _ = Failure err (Success x) >>= f = f x instance MonadError ComputationError Computation where throwError = Failure catchError = undefined instance Error ComputationError where noMsg = ComputationError "What the phukk?" strMsg = ComputationError instance Show Inhabitant where show (Value float) = show float show (Function (FuncDef args body)) = "f(" ++ intercalate ", " args ++ ") { " ++ show body ++ " }" evaluate :: World -> Expr -> Computation Float evaluate world (Number n) = return n evaluate world (Binary op a b) = liftM2 (apply op) (evaluate world a) (evaluate world b) evaluate world (Name name) = maybe err return (value world name) where err = throwError (strMsg $ "Undefined variable `" ++ name ++ "'") evaluate world (Call name exprs) = do FuncDef args body <- maybe undefinedFunc return (function world name) params <- evaluate world `mapM` exprs funcWorld <- bind args params evaluate funcWorld body where undefinedFunc = throwError (strMsg $ "Undefined function `" ++ name ++ "'") bind :: [String] -> [Float] -> Computation World bind names values | length names == length values = return $ M.fromList (zip names (map Value values)) | otherwise = throwError (strMsg $ "Supplied arguments " ++ show values ++ " for " ++ show names) value :: World -> String -> Maybe Float value world name = do Value val <- M.lookup name world return val function :: World -> String -> Maybe FuncDef function world name = do Function def <- M.lookup name world return def apply :: BinaryOp -> Float -> Float -> Float apply Add = (+) apply Sub = (-) apply Mul = (*) apply Div = (/) apply Exp = (**) caladan :: World caladan = M.fromList [ ("paul", Value 3.14), ("jessica", Value 2.71), ("larodi", Function (FuncDef [] (Number 1))), ("add", Function (FuncDef ["a", "b"] (Name "a" + Name "b"))), ("f", Function (FuncDef ["a"] (Name "a" + Name "a"))) ] main = do print $ evaluate caladan (1 + 2) print $ evaluate caladan (1 + 2 + Name "paul") print $ evaluate caladan (1 + 2 + Name "larodi") print $ evaluate caladan (Call "foo" [1.4, 2]) print $ evaluate caladan (Call "add" [Name "jessica", 2]) print $ evaluate caladan (Call "f" [1]) print $ evaluate caladan (Call "larodi" []) return () ================================================ FILE: haskell/programming_haskell/Chapter01.hs ================================================ product' (x:xs) = x * product xs product' [] = 1 qsort [] = [] qsort (x:xs) = qsort larger ++ [x] ++ qsort smaller where smaller = [a | a <- xs, a <= x] larger = [b | b <- xs, b > x] ================================================ FILE: haskell/programming_haskell/Chapter04.hs ================================================ halve :: [a] -> ([a], [a]) halve l = splitAt ((length l) `div` 2) l safetail1 :: [a] -> [a] safetail1 x = if (null x) then [] else tail x safetail2 :: [a] -> [a] safetail2 l | null l = [] | otherwise = tail l safetail3 :: [a] -> [a] safetail3 (x:xs) = xs safetail3 _ = [] ================================================ FILE: haskell/programming_haskell/Chapter05.hs ================================================ squareSum :: Int -> Int squareSum n = sum [x ^ 2 | x <- [1..n]] replicate2 :: Int -> a -> [a] replicate2 n x = [x | _ <- [1..n]] pairs xs = zip xs (tail xs) pyths :: Int -> [(Int, Int, Int)] pyths n = [(x, y, z) | z <- [1..], y <- [1..z], x <- [1..y], x ^ 2 + y ^ 2 == z ^ 2] perfects :: Int -> [Int] perfects x = [n | n <- [1..x], (sum (factors n)) == n] where factors n = [a | a <- [1..(n-1)], n `mod` a == 0] find :: Eq a => a -> [(a, b)] -> [b] find k t = [v | (k', v) <- t, k == k'] positions :: Eq a => a -> [a] -> [Int] positions x xs = find x (zip xs [0..]) scalarproduct :: [Int] -> [Int] -> Int scalarproduct xs ys = sum [ x * y | (x, y) <- zip xs ys] main = print (scalarproduct [1, 2, 3] [4, 5, 6]) --main = print (perfects 500) --main = print (positions False [True, False, False, True, False]) --main = print (take 10 (pyths 10)) ================================================ FILE: haskell/programming_haskell/Chapter06.hs ================================================ (^^) :: Int -> Int -> Int x ^^ 0 = 1 x ^^ (a + 1) = x * (x ^ a) and' :: [Bool] -> Bool and' [] = True and' (x:xs) = x && and xs concat' :: [[a]] -> [a] concat' xss = [ x | xs <- xss, x <- xs] replicate' :: Int -> a -> [a] replicate' 0 _ = [] replicate' (n + 1) x = x:replicate n x (!!!) :: [a] -> Int -> a (x:xs) !!! 0 = x (x:xs) !!! (a + 1) = xs !!! a elm :: Eq a => a -> [a] -> Bool e `elm` [] = False e `elm` (x:xs) | e == x = True | otherwise = e `elm` xs merge :: Ord a => [a] -> [a] -> [a] merge xs [] = xs merge [] ys = ys merge (x:xs) (y:ys) | x <= y = x:merge xs (y:ys) | otherwise = y:merge (x:xs) ys halve :: [a] -> ([a], [a]) halve l = splitAt ((length l) `div` 2) l mergesort :: Ord a => [a] -> [a] mergesort [] = [] mergesort [a] = [a] mergesort xs = merge (mergesort left) (mergesort right) where (left, right) = halve xs sum' :: [Int] -> Int sum' [] = 0 sum' (x:xs) = x + sum' xs take' :: Num a => Int -> [a] -> [a] take' 0 _ = [] take' _ [] = [] take' (n + 1) (x:xs) = x:(take' n xs) last' :: [a] -> a last' [x] = x last' (x:xs) = last' xs --main = print (take' 12 [1, 2, 3, 4, 5]) --main = print (mergesort [5, 4, 2, 8, 11, 3, 23, 9]) --main = print (halve [1]) --main = print (merge [2, 5, 6] [1, 3, 4]) --main = print (5 `elm` [1, 2, 3]) --main = print ([1, 2, 3, 4] !!! 1) --main = print (concat [[1, 2, 3], [4, 5, 6], [7, 8, 9]]) --main = print (2 ^ 8) ================================================ FILE: haskell/programming_haskell/Chapter07.hs ================================================ all' :: (a -> Bool) -> [a] -> Bool all' _ [] = True all' p (x:xs) | p x = all' p xs | otherwise = False any' :: (a -> Bool) -> [a] -> Bool any' _ [] = False any' p (x:xs) | p x = True | otherwise = any' p xs all'' :: (a -> Bool) -> ([a] -> Bool) all'' p = foldr (&&) True . map p any'' :: (a -> Bool) -> ([a] -> Bool) any'' p = foldr (||) False . map p takeWhile' :: (a -> Bool) -> [a] -> [a] takeWhile' p [] = [] takeWhile' p (x:xs) | p x = x:takeWhile p xs | otherwise = [] dropWhile' :: (a -> Bool) -> [a] -> [a] dropWhile' p [] = [] dropWhile' p (x:xs) | p x = dropWhile' p xs | otherwise = x:xs map' :: (a -> b) -> [a] -> [b] map' f = foldr ((:) . f) [] --map' f = foldr (\x xs -> f x:xs) [] filter' :: (a -> Bool) -> [a] -> [a] filter' p = foldr (\x xs -> if p x then x:xs else xs) [] dec2int :: [Int] -> Int dec2int = foldl ((+) . (*10)) 0 --dec2int = foldl (\s n -> s * 10 + n) 0 curry' :: ((a, b) -> c) -> a -> b -> c curry' f = \x y -> f (x, y) uncurry' :: (a -> b -> c) -> (a, b) -> c uncurry' f = \(x, y) -> f x y add' (x, y) = x + y add'' x y = x + y unfold :: (a -> Bool) -> (a -> b) -> (a -> a) -> a -> [b] unfold p h t x | p x = [] | otherwise = h x : unfold p h t (t x) map'' :: (a -> b) -> [a] -> [b] map'' f = unfold null (f . head) tail iterate' :: (a -> a) -> a -> [a] iterate' = unfold (\_ -> False) id main = print (take 10 (iterate' (*2) 1)) --main = print (take 10 (map'' (*2) [1..])) --main = print (uncurry' add'' (1, 5)) --main = print (curry add' 1 2) --main = print (sse [1, 2, 3, 4, 5]) --main = print (dec2int [1, 2, 3]) --main = print (take 10 (filter' even [1..])) --main = print (dropWhile' odd [1, 3, 5, 7, 8, 9, 11]) ================================================ FILE: haskell/programming_haskell/Chapter09.hs ================================================ import IO getLine' :: IO String getLine' = do x <- getChar if x == '\n' then return [] else do xs <- getLine return (x:xs) strlen :: IO () strlen = do putStr "Enter a string: " xs <- getLine putStr "The string has " putStr (show (length xs)) putStrLn " characters" beep :: IO () beep = putStr "\BEL" cls :: IO () cls = putStr "\ESC[2J" type Pos = (Int, Int) goto :: Pos -> IO () goto (x, y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H") writeat :: Pos -> String -> IO () writeat p xs = do goto p putStr xs seqn :: [IO a] -> IO () seqn [] = return () seqn (ac:acs) = do ac seqn acs -- Game of Life -- width = 50 height = 50 type Board = [Pos] glider :: [Pos] glider = [(4, 2), (2, 3), (4, 3), (3, 4), (4, 4)] showcells :: Board -> IO () showcells b = seqn [ writeat p "*" | p <- b] isAlive :: Board -> Pos -> Bool isAlive b p = elem p b isEmpty :: Board -> Pos -> Bool isEmpty b p = not (isAlive b p) neighbs :: Pos -> [Pos] neighbs (x, y) = map wrap [(x - 1, y - 1), (x, y - 1), (x + 1, y - 1), (x - 1, y), (x + 1, y), (x - 1, y + 1), (x, y + 1), (x + 1, y + 1)] wrap :: Pos -> Pos wrap (x, y) = (((x - 1) `mod` width) + 1, ((y - 1) `mod` height) + 1) liveneighbs :: Board -> Pos -> Int liveneighbs b = length . filter (isAlive b) . neighbs survivors :: Board -> [Pos] survivors b = [p | p <- b, elem (liveneighbs b p) [2, 3]] rmdups :: Eq a => [a] -> [a] rmdups [] = [] rmdups (x:xs) = x:rmdups (filter (/= x) xs) births :: Board -> [Pos] --births b = [(x, y) | x <- [1..width], y <- [1..height], isEmpty b (x, y), liveneighbs b (x, y) == 3] births b = [(x, y) | (x, y) <- rmdups (concat (map neighbs b)), isEmpty b (x, y), liveneighbs b (x, y) == 3] nextgen :: Board -> Board nextgen b = survivors b ++ births b life b = do cls showcells b wait 50000 life (nextgen b) wait :: Int -> IO () wait n = seqn [ return () | _ <- [1..n]] -- Rather unimaginative ================================================ FILE: haskell/programming_haskell/Nim.hs ================================================ import Data.Char type Pos = (Int, Int) beep :: IO () beep = putStr "\BEL" cls :: IO () cls = putStr "\ESC[2J" goto :: Pos -> IO () goto (x, y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H") writeat :: Pos -> String -> IO () writeat p xs = do goto p putStr xs seqn :: [IO a] -> IO () seqn [] = return () seqn (ac:acs) = do ac seqn acs type Board = [Int] data Player = First | Second other :: Player -> Player other First = Second other Second = First name :: Player -> String name First = "N1" name Second = "N2" initial :: Board initial = [5, 4, 3, 2, 1] showboard :: Board -> IO () showboard b = do cls seqn [writeat (1, y) (show y ++ ": " ++ line t) | (y, t) <- zip [1..5] b] line :: Int -> String line tokens = (replicate tokens '*') ++ (replicate 5 ' ') move :: Board -> Player -> IO () move board player = do cls showboard board if complete board then writeat (1, 6) ("Winner: " ++ name (other player) ++ "\n") else do writeat (1, 6) (name player ++ " (row-number): ") input <- getLine case process board input of [row, number] -> move (takeAt board (row - 1) number) (other player) [] -> do beep move board player complete :: Board -> Bool complete [0, 0, 0, 0, 0] = True complete _ = False chr2num :: Char -> Int chr2num c | (ord '0' <= ord c) && (ord c <= ord '9') = ord c - ord '0' | otherwise = -1 takeAt :: Board -> Int -> Int -> Board takeAt (x:xs) 0 n = x - n:xs takeAt (x:xs) (r + 1) n = x:takeAt xs r n at :: Board -> Int -> Int at board row = board !! (row - 1) feasible :: Board -> Int -> Int -> Bool feasible b r n = and [r >= 1, r <= 5, n >= 1, n <= (at b r)] process :: Board -> String -> [Int] process b [r, '-', n] | feasible b (chr2num r) (chr2num n) = [(chr2num r), (chr2num n)] process b _ = [] f = main main = move initial First ================================================ FILE: haskell/programming_haskell/README ================================================ Exercises from Programming Haskell, carried out of curiosity. ================================================ FILE: haskell/real_world_haskell/Find.hs ================================================ {-# LANGUAGE ScopedTypeVariables #-} import Control.Monad import System.Directory (Permissions(..), getModificationTime, getPermissions, getDirectoryContents, doesDirectoryExist) import System.Time (ClockTime(..)) import System.FilePath ((), takeExtension) import Control.Exception import System.IO (IOMode(..), hClose, hFileSize, openFile) getRecursiveContents :: FilePath -> IO [FilePath] getRecursiveContents top = do names <- getDirectoryContents top let proper = filter (`notElem` [".", ".."]) names paths <- forM proper $ \name -> do let path = top name isDir <- doesDirectoryExist path if isDir then getRecursiveContents path else return [path] return (concat paths) simpleFind :: (FilePath -> Bool) -> FilePath -> IO [FilePath] simpleFind p path = do names <- getRecursiveContents path return (filter p names) type Predicate = FilePath -> Permissions -> Maybe Integer -> ClockTime -> Bool betterFind :: Predicate -> FilePath -> IO [FilePath] betterFind p path = do paths <- getRecursiveContents path filterM check paths where check name = do perms <- getPermissions name size <- getFileSize name modified <- getModificationTime name return (p name perms size modified) getFileSize :: FilePath -> IO (Maybe Integer) getFileSize path = handle (\(_ :: IOException) -> return Nothing) $ do bracket (openFile path ReadMode) hClose $ \h -> do size <- hFileSize h return (Just size) type InfoP a = FilePath -> Permissions -> Maybe Integer -> ClockTime -> a pathP :: InfoP FilePath pathP p _ _ _ = p sizeP :: InfoP Integer sizeP _ _ (Just size) _ = size sizeP _ _ Nothing _ = -1 liftPath :: (FilePath -> a) -> InfoP a liftPath f = \n _ _ _ -> f n liftP :: (a -> b -> c) -> InfoP a -> b -> InfoP c liftP o f r = \n p s m -> f n p s m `o` r lift2P :: (a -> b -> c) -> InfoP a -> InfoP b -> InfoP c lift2P o l r = \n p s m -> l n p s m `o` r n p s m greaterP, lesserP :: (Ord a) => InfoP a -> a -> InfoP Bool greaterP = liftP (>) lesserP = liftP (<) andP, orP :: InfoP Bool -> InfoP Bool -> InfoP Bool andP = lift2P (&&) orP = lift2P (||) equalP :: (Eq a) => InfoP a -> a -> InfoP Bool equalP = liftP (==) (==?) = equalP (&&?) = andP (>?) = greaterP (? main = do paths <- betterFind (sizeP >? 20 &&? sizeP do putStrLn p ================================================ FILE: haskell/real_world_haskell/Glob.hs ================================================ import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents) import System.FilePath (dropTrailingPathSeparator, splitFileName, ()) import Control.Monad (forM, filterM, mapM, liftM) import Text.Regex.Posix ((=~)) globToRegex :: String -> String globToRegex cs = '^' : globToRegex' cs ++ "$" globToRegex' :: String -> String globToRegex' "" = "" globToRegex' ('*':cs) = ".*" ++ globToRegex' cs globToRegex' ('?':cs) = '.' : globToRegex' cs globToRegex' ('[':'!':c:cs) = "[^" ++ c :charClass cs globToRegex' ('[':c:cs) = '[' : c : charClass cs globToRegex' ('[':_) = error "uncompleted character class" globToRegex' (c:cs) = escape c ++ globToRegex' cs escape :: Char -> String escape c | c `elem` regexChars = "\\" ++ [c] | otherwise = [c] where regexChars = "\\().^$]|+" charClass :: String -> String charClass (']':cs) = ']' : globToRegex' cs charClass (c:cs) = c : charClass cs charClass [] = error "unterminated character class" dotless :: [FilePath] -> [FilePath] dotless (".":xs) = dotless xs dotless ("..":xs) = dotless xs dotless (x:xs) = (x:dotless xs) dotless [] = [] lsLa :: FilePath -> IO [FilePath] lsLa dir = do contents <- (liftM dotless) (getDirectoryContents dir) files <- filterM doesFileExist (map (dir ) contents) directories <- filterM doesDirectoryExist (map (dir ) contents) nestedFiles <- mapM lsLa directories return $ files ++ (concat nestedFiles) match :: String -> String -> IO [FilePath] match dir glob = case splitFileName glob of ("", fileGlob) -> do result <- getDirectoryContents dir return $ filter (=~ globToRegex fileGlob) (map (dir ) (dotless result)) (dirGlob, fileGlob) -> do matches <- match dir (dropTrailingPathSeparator dirGlob) dirs <- filterM doesDirectoryExist matches files <- mapM (`match` fileGlob) dirs return $ concat files main = match "../.." "*a*/*haskell" {- } main = do dir <- getCurrentDirectory files <- lsLa dir forM files putStrLn return () -} --main = do dir <- getCurrentDirectory -- getDirectoryContents dir ================================================ FILE: haskell/real_world_haskell/PgmParser.hs ================================================ -- The non-improved version of the PGM parser import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy as L import Data.Char (isSpace, chr, isDigit) import System.IO (IOMode(..), hClose, hFileSize, openFile) import Word (Word8) import Control.Applicative ((<$>)) data Greymap = Greymap { greyWidth :: Int, greyHeight :: Int, greyMax :: Int, greyData :: L.ByteString } deriving (Eq) instance Show Greymap where show (Greymap w h m _) = "Greymap " ++ show w ++ "x" ++ show h ++ " " ++ show m data ParseState = ParseState { string :: L.ByteString, offset :: Integer } deriving (Show) newtype Parse a = Parse { runParse :: ParseState -> Either String (a, ParseState) } identity :: a -> Parse a identity a = Parse (\s -> Right (a, s)) parse :: Parse a -> L.ByteString -> Either String a parse parser init = case runParse parser (ParseState init 0) of Left error -> Left error Right (result, _) -> Right result parseByte :: Parse Word8 parseByte = getState ==> \state -> case L.uncons (string state) of Nothing -> bail "not enough input" Just (char, remainder) -> putState newState ==> \_ -> identity char where newState = state { string = remainder, offset = newOffset } newOffset = (offset state) + 1 getState :: Parse ParseState getState = Parse (\s -> Right (s, s)) putState :: ParseState -> Parse () putState s = Parse (\_ -> Right ((), s)) (==>) :: Parse a -> (a -> Parse b) -> Parse b first ==> second = Parse result where result init = case runParse first init of Left msg -> Left msg Right (result, newState) -> runParse (second result) newState bail :: String -> Parse a bail err = Parse $ \s -> Left $ "byte offset " ++ show (offset s) ++ ": " ++ err instance Functor Parse where fmap f parser = parser ==> \result -> identity (f result) w2c :: Word8 -> Char w2c = chr . fromIntegral parseChar :: Parse Char parseChar = w2c <$> parseByte peekByte :: Parse (Maybe Word8) peekByte = (fmap fst . L.uncons . string) <$> getState peekChar :: Parse (Maybe Char) peekChar = fmap w2c <$> peekByte parseWhile :: (Word8 -> Bool) -> Parse [Word8] parseWhile p = (fmap p <$> peekByte) ==> \mp -> if mp == Just True then parseByte ==> \b -> (b:) <$> parseWhile p else identity [] parseWhileWith :: (Word8 -> a) -> (a -> Bool) -> Parse [a] parseWhileWith f p = fmap f <$> parseWhile (p . f) parseNat :: Parse Int parseNat = parseWhileWith w2c isDigit ==> \digits -> if null digits then bail "no more input" else let n = read digits in if n < 0 then bail "Integer overflow" else identity n (==>&) :: Parse a -> Parse b -> Parse b p ==>& f = p ==> \_ -> f skipSpaces :: Parse () skipSpaces = parseWhileWith w2c isSpace ==>& identity () assert :: Bool -> String -> Parse () assert True _ = identity () assert False msg = bail msg parseBytes :: Int -> Parse L.ByteString parseBytes n = getState ==> \st -> let n' = fromIntegral n (h, t) = L.splitAt n' (string st) st' = st { offset = offset st + fromIntegral (L.length h), string = t } in putState st' ==>& assert (L.length h == n') "end of input" ==>& identity h parseRawPGM = parseWhileWith w2c notWhite ==> \header -> skipSpaces ==>& assert (header == "P5") "Bad header" ==>& parseNat ==> \width -> skipSpaces ==>& parseNat ==> \height -> skipSpaces ==>& parseNat ==> \maxGrey -> parseByte ==>& assert (maxGrey <= 255) "Max grey is far too big" ==>& parseBytes (width * height) ==> \bytes -> identity $ Greymap width height maxGrey bytes where notWhite = (`notElem` " \r\n\t") main = do handle <- openFile "./sample/foo.pgm" ReadMode contents <- L8.hGetContents handle print (parse parseRawPGM contents) ================================================ FILE: haskell/real_world_haskell/PgmSimple.hs ================================================ -- The non-improved version of the PGM parser import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy as L import Data.Char (isSpace) import System.IO (IOMode(..), hClose, hFileSize, openFile) data Greymap = Greymap { greyWidth :: Int, greyHeight :: Int, greyMax :: Int, greyData :: L.ByteString } deriving (Eq) instance Show Greymap where show (Greymap w h m _) = "Greymap " ++ show w ++ "x" ++ show h ++ " " ++ show m matchHeader :: L.ByteString -> L.ByteString -> Maybe L.ByteString matchHeader prefix str | prefix `L8.isPrefixOf` str = Just (L8.dropWhile isSpace (L.drop (L.length prefix) str)) | otherwise = Nothing getNat :: L.ByteString -> Maybe (Int, L.ByteString) getNat str = case L8.readInt str of Nothing -> Nothing Just (num, rest) | num < 0 -> Nothing | otherwise -> Just (fromIntegral num, rest) getBytes :: Int -> L.ByteString -> Maybe (L.ByteString, L.ByteString) getBytes num str = let count = fromIntegral num both@(prefix, _) = L.splitAt count str in if L.length prefix < count then Nothing else Just both parseP5 :: L.ByteString -> Maybe (Greymap, L.ByteString) parseP5 s = case matchHeader (L8.pack "P5") s of Nothing -> Nothing Just s1 -> case getNat s1 of Nothing -> Nothing Just (width, s2) -> case getNat (L8.dropWhile isSpace s2) of Nothing -> Nothing Just (height, s3) -> case getNat (L8.dropWhile isSpace s3) of Nothing -> Nothing Just (maxGrey, s4) | maxGrey > 255 -> Nothing | otherwise -> case getBytes 1 s4 of Nothing -> Nothing Just (_, s5) -> case getBytes (width * height) s5 of Nothing -> Nothing Just (bitmap, s6) -> Just (Greymap width height maxGrey bitmap, s6) (>>?) :: Maybe a -> (a -> Maybe b) -> Maybe b Nothing >>? _ = Nothing Just a >>? f = f a parseP5_take2 :: L.ByteString -> Maybe (Greymap, L.ByteString) parseP5_take2 s = matchHeader (L8.pack "P5") s >>? \s -> skipSpace ((), s) >>? (getNat . snd) >>? skipSpace >>? \(width, s) -> getNat s >>? skipSpace >>? \(height, s) -> getNat s >>? \(maxGrey, s) -> getBytes 1 s >>? (getBytes (width * height) . snd) >>? \(bitmap, s) -> Just (Greymap width height maxGrey bitmap, s) skipSpace :: (a, L.ByteString) -> Maybe (a, L.ByteString) skipSpace (a, s) = Just (a, L8.dropWhile isSpace s) main = do handle <- openFile "./sample/foo.pgm" ReadMode contents <- L8.hGetContents handle print (parseP5_take2 contents) ================================================ FILE: haskell/real_world_haskell/Traverse.hs ================================================ {-# LANGUAGE ScopedTypeVariables #-} import Control.Monad (liftM, forM) import Control.Exception (IOException(..), handle, bracket) import System.Directory (Permissions(..), getPermissions, getModificationTime, getDirectoryContents, doesDirectoryExist) import System.FilePath ((), takeFileName, takeExtension) import System.Time (ClockTime(..)) import System.IO (IOMode(..), openFile, hClose, hFileSize) data Info = Info { infoPath :: FilePath, infoPerms :: Maybe Permissions, infoSize :: Maybe Integer, infoModTime :: Maybe ClockTime } deriving (Eq, Ord, Show) maybeIO :: IO a -> IO (Maybe a) maybeIO action = handle (\(_ :: IOException) -> return Nothing) (liftM Just action) getInfo :: FilePath -> IO Info getInfo path = do perms <- maybeIO (getPermissions path) size <- maybeIO (bracket (openFile path ReadMode) hClose hFileSize) modificationTime <- maybeIO (getModificationTime path) return $ Info path perms size modificationTime traverse :: ([Info] -> [Info]) -> FilePath -> IO [Info] traverse order path = do names <- getUsefulContents path contents <- mapM getInfo (path : map (path ) names) liftM concat $ forM (order contents) $ \info -> do if isDirectory info && infoPath info /= path then traverse order (infoPath info) else return [info] isDirectory :: Info -> Bool isDirectory = maybe False searchable . infoPerms getUsefulContents :: FilePath -> IO [FilePath] getUsefulContents path = do names <- getDirectoryContents path return $ filter (`notElem` [".", ".."]) names data Iterate seed = Done { unwrap :: seed } | Skip { unwrap :: seed } | Continue { unwrap :: seed } deriving (Show) type Iterator seed = seed -> Info -> Iterate seed foldTree :: Iterator a -> a -> FilePath -> IO a foldTree iter initSeed path = do endSeed <- fold initSeed path return (unwrap endSeed) where fold seed subpath = getUsefulContents subpath >>= walk seed walk seed (name:names) = do let path' = path name info <- getInfo path' case iter seed info of done@(Done _) -> return done Skip seed' -> walk seed' names Continue seed' | isDirectory info -> do next <- fold seed' path' case next of done@(Done _) -> return done seed'' -> walk (unwrap seed'') names | otherwise -> walk seed' names walk seed _ = return (Continue seed) firstThreeRubyFiles :: Iterator [FilePath] firstThreeRubyFiles files info | length files == 3 = Done files | isDirectory info && takeFileName path == ".svn" = Skip files | extension == ".rb" = Continue (path:files) | otherwise = Continue files where extension = takeExtension path path = infoPath info main = do names <- foldTree firstThreeRubyFiles [] "/work/pyfmi/site/app/" forM names putStrLn return () ================================================ FILE: haskell/real_world_haskell/json/Main.hs ================================================ module Main () where import SimpleJSON import PutJSON main = putJValue (JObject [("foo", JNumber 1), ("bar", JBool False)]) ================================================ FILE: haskell/real_world_haskell/json/Prettify.hs ================================================ module Prettify where data Doc = Empty | Char Char | Text String | Line | Concat Doc Doc | Union Doc Doc deriving (Show, Eq) empty :: Doc empty = Empty char :: Char -> Doc char c = Char c text :: String -> Doc text "" = Empty text s = Text s double :: Double -> Doc double d = text (show d) line :: Doc line = Line (<>) :: Doc -> Doc -> Doc Empty <> y = y x <> Empty = x x <> y = x `Concat` y hcat :: [Doc] -> Doc hcat = fold (<>) fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc fold f = foldr f empty fsep :: [Doc] -> Doc fsep = fold () () :: Doc -> Doc -> Doc x y = x <> softline <> y softline :: Doc softline = group line group :: Doc -> Doc group x = flatten x `Union` x flatten :: Doc -> Doc flatten (x `Concat` y) = flatten x `Concat` flatten y flatten Line = Char ' ' flatten (x `Union` _) = flatten x flatten other = other compact :: Doc -> String compact x = transform [x] where transform [] = "" transform (d:ds) = case d of Empty -> transform ds Char c -> c : transform ds Text s -> s ++ transform ds Line -> '\n' : transform ds a `Concat` b -> transform (a:b:ds) _ `Union` b -> transform (b:ds) punctuate :: Doc -> [Doc] -> [Doc] punctuate p [] = [] punctuate p [d] = [d] punctuate p (d:ds) = (d <> p) : punctuate p ds pretty :: Int -> Doc -> String pretty width x = best 0 [x] where best col (d:ds) = case d of Empty -> best col ds Char c -> c : best (col + 1) ds Text s -> s ++ best (col + length s) ds Line -> '\n' : best 0 ds a `Concat` b -> best col (a:b:ds) a `Union` b -> nicest col (best col (a:ds)) (best col (b:ds)) best _ _ = "" nicest col a b | (width - least) `fits` a = a | otherwise = b where least = min width col nest :: Int -> Int -> Doc -> String nest shiftwidth width x = best 0 0 [x] where best i len (d:ds) = case d of Empty -> best i len ds Char c -> c:best indent (len + 1) ds where indent = case c of '{' -> i + 1 '}' -> i - 1 '[' -> i + 1 ']' -> i - 1 otherwise -> i Text str -> str ++ best i (len + (length str)) ds Line -> "\n" ++ shift ++ best i (length shift) ds where shift = (replicate (i * shiftwidth) ' ') a `Concat` b -> best i len (a:b:ds) a `Union` b -> nicest len (best i len (a:ds)) (best i len (b:ds)) best _ _ _ = "" nicest pad x y | (width - pad) `fits` x = x | otherwise = y -- where least = min width pad fits :: Int -> String -> Bool w `fits` _ | w < 0 = False w `fits` "" = True w `fits` ('\n':_) = True w `fits` (c:cs) = (w - 1) `fits` cs ================================================ FILE: haskell/real_world_haskell/json/PrettyJSON.hs ================================================ module PrettyJSON (renderJValue) where import Numeric (showHex) import Data.Bits (shiftR, (.&.)) import Data.Char (ord) import SimpleJSON (JValue(..)) import Prettify (Doc, (<>), char, double, fsep, hcat, punctuate, text, compact, pretty, nest) string :: String -> Doc string = enclose '"' '"' .hcat . map oneChar enclose :: Char -> Char -> Doc -> Doc enclose left right x = char left <> x <> char right oneChar :: Char -> Doc oneChar c = case lookup c simpleEscapes of Just r -> text r Nothing | mustEscape c -> hexEscape c | otherwise -> char c where mustEscape c = c < ' ' || c == '\x7f' || c > '\xff' smallHex :: Int -> Doc smallHex x = text "\\u" <> text (replicate (4 - length h) '0') <> text h where h = showHex x "" astral :: Int -> Doc astral n = smallHex (a + 0xd800) <> smallHex (b + 0xdc00) where a = (n `shiftR` 10) .&. 0x3ff b = n .&. 0x3ff hexEscape :: Char -> Doc hexEscape c | d < 0x10000 = smallHex d | otherwise = astral (d - 010000) where d = ord c simpleEscapes :: [(Char, String)] simpleEscapes = zipWith ch "\b\n\f\r\t\\\"/" "bnfrt\\\"/" where ch a b = (a, ['\\', b]) series :: Char -> Char -> (a -> Doc) -> [a] -> Doc series open close item = enclose open close . fsep . punctuate (char ',') . map item renderJValue :: JValue -> Doc renderJValue (JBool True) = text "true" renderJValue (JBool False) = text "false" renderJValue JNull = text "null" renderJValue (JNumber num) = double num renderJValue (JString str) = string str renderJValue (JArray ary) = series '[' ']' renderJValue ary renderJValue (JObject obj) = series '{' '}' field obj where field (name, val) = string name <> text ": " <> renderJValue val value = renderJValue (JObject [("f", JNumber 1), ("z", JArray [JString "Foo", JBool True, JNull]), ("q", JBool True)]) main = putStrLn (nest 2 13 value) -- TODO Rewrite Prettify.pretty in a more senseful way -- http://book.realworldhaskell.org/read/writing-a-library-working-with-json-data.html ================================================ FILE: haskell/real_world_haskell/json/PrettyStub.hs ================================================ module PrettyStub where data Doc = ToBeDefined deriving (Show) (<>) :: Doc -> Doc -> Doc a <> b = undefined char :: Char -> Doc char c = undefined hcat :: [Doc] -> Doc hcat xs = undefined text :: String -> Doc text str = undefined double :: Double -> Doc double num = undefined fsep :: [Doc] -> Doc fsep xs = undefined ================================================ FILE: haskell/real_world_haskell/json/PutJSON.hs ================================================ module PutJSON where import Data.List (intercalate) import SimpleJSON renderJValue :: JValue -> String renderJValue (JString s) = show s renderJValue (JNumber n) = show n renderJValue (JBool True) = "true" renderJValue (JBool False) = "false" renderJValue JNull = "null" renderJValue (JObject o) = "{" ++ pairs o ++ "}" where pairs [] = "" pairs ps = intercalate ", " (map renderPair ps) renderPair (k, v) = show k ++ ": " ++ renderJValue v renderJValue (JArray a) = "[" ++ values a ++ "]" where values [] = "" values vs = intercalate ", " (map renderJValue vs) putJValue :: JValue -> IO () putJValue v = putStrLn (renderJValue v) ================================================ FILE: haskell/real_world_haskell/json/README ================================================ Code from chapter 5 of Real World Haskell http://book.realworldhaskell.org/read/writing-a-library-working-with-json-data.html ================================================ FILE: haskell/real_world_haskell/json/SimpleJSON.hs ================================================ {-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-} module SimpleJSON ( JValue(..), getString, getInt, getDouble, getBool, getObject, getArray, isNull ) where newtype JAry a = JAry { fromJAry :: [a] } deriving (Eq, Ord, Show) newtype JObj a = JObj { fromJObj :: [(String, a)] } deriving (Eq, Ord, Show) data JValue = JString String | JNumber Double | JBool Bool | JNull | JObject (JObj JValue) | JArray (JAry JValue) deriving (Eq, Ord, Show) getString :: JValue -> Maybe String getString (JString s) = Just s getString _ = Nothing getInt (JNumber n) = Just n getInt _ = Nothing getDouble (JNumber n) = Just n getDouble _ = Nothing getBool (JBool b) = Just b getBool _ = Nothing getObject (JObject o) = Just o getObject _ = Nothing getArray (JArray a) = Just a getArray _ = Nothing isNull v = v == JNull type JSONError = String class JSON a where toJValue :: a -> JValue fromJValue :: JValue -> Either JSONError a instance JSON JValue where toJValue = id fromJValue = Right instance JSON Bool where toJValue = JBool fromJValue (JBool b) = Right b fromJValue _ = Left "not a JSON boolean" instance JSON String where toJValue = JString fromJValue (JString s) = Right s fromJValue _ = Left "not a JSON string" doubleToJValue :: (Double -> a) -> JValue -> Either JSONError a doubleToJValue f (JNumber v) = Right (f v) doubleToJValue _ _ = Left "not a JSON number" instance JSON Int where toJValue = JNumber . realToFrac fromJValue = doubleToJValue round instance JSON Integer where toJValue = JNumber . realToFrac fromJValue = doubleToJValue round instance JSON Double where toJValue = JNumber fromJValue = doubleToJValue id jaryFromJValue :: (JSON a) => JValue -> Either JSONError (JAry a) jaryFromJValue (JArray (JAry a)) = whenRight JAry (mapEithers fromJValue a) jaryFromJValue _ = Left "not a JSON array" whenRight :: (b -> c) -> Either a b -> Either a c whenRight _ (Left err) = Left err whenRight f (Right a) = Right (f a) mapEithers :: (a -> Either b c) -> [a] -> Either b [c] mapEithers f (x:xs) = case mapEithers f xs of Left err -> Left err Right ys -> case f x of Left err -> Left err Right y -> Right (y:ys) mapEithers _ _ = Right [] jaryToJValue :: (JSON a) => JAry a -> JValue jaryToJValue = JArray . JAry . map toJValue . fromJAry instance (JSON a) => JSON (JAry a) where toJValue = jaryToJValue fromJValue = jaryFromJValue listToJValues :: (JSON a) => [a] -> [JValue] listToJValues = map toJValue jvaluesToJAry :: [JValue] -> JAry JValue jvaluesToJAry = JAry jaryOfJValuesToJValue :: JAry JValue -> JValue jaryOfJValuesToJValue = JArray ================================================ FILE: java/tdd_by_example/Money.java ================================================ import java.util.HashMap; import java.util.Map; public class Money implements Expression { protected int amount; protected String currency; public Money(int amount, String currency) { this.amount = amount; this.currency = currency; } @Override public boolean equals(Object object) { Money money = (Money) object; return money.amount == this.amount && money.currency().equals(this.currency()); } public static Money dollar(int amount) { return new Money(amount, "USD"); } public static Money franc(int amount) { return new Money(amount, "CHF"); } public Expression times(int multiplier) { return new Money(amount * multiplier, currency); } public String currency() { return currency; } public Expression plus(Expression addend) { return new Sum(this, addend); } public Money reduce(Bank bank, String to) { return new Money(amount / bank.rate(currency, to), to); } @Override public String toString() { return amount + " " + currency; } } interface Expression { Money reduce(Bank bank, String to); Expression times(int multiplier); Expression plus(Expression addend); } class Sum implements Expression { Expression augend; Expression addend; public Sum(Expression augend, Expression addend) { this.augend = augend; this.addend = addend; } public Money reduce(Bank bank, String to) { int amount = augend.reduce(bank, to).amount + addend.reduce(bank, to).amount; return new Money(amount, to); } public Expression plus(Expression addend) { return new Sum(this, addend); } public Expression times(int multiplier) { return new Sum(augend.times(multiplier), addend.times(multiplier)); } } class Bank { private Map rates = new HashMap(); public Money reduce(Expression source, String to) { return source.reduce(this, to); } public void addRate(String from, String to, int amount) { rates.put(new Pair(from, to), amount); } int rate(String from, String to) { if (from.equals(to)) return 1; return rates.get(new Pair(from, to)); } } class Pair { private String from; private String to; Pair(String from, String to) { this.from = from; this.to = to; } @Override public boolean equals(Object obj) { Pair pair = (Pair) obj; return from.equals(pair.from) && to.equals(pair.to); } @Override public int hashCode() { return 0; } } ================================================ FILE: java/tdd_by_example/MoneyTest.java ================================================ import junit.framework.TestCase; public class MoneyTest extends TestCase { public void testMultiplication() { Money five = Money.dollar(5); assertEquals(Money.dollar(10), five.times(2)); assertEquals(Money.dollar(15), five.times(3)); } public void testEquality() { assertTrue(Money.dollar(5).equals(Money.dollar(5))); assertFalse(Money.dollar(5).equals(Money.dollar(6))); assertTrue(Money.franc(5).equals(Money.franc(5))); } public void testSimpleAddition() { Money five = Money.dollar(5); Expression sum = five.plus(five); Bank bank = new Bank(); Money reduced = bank.reduce(sum, "USD"); assertEquals(Money.dollar(10), reduced); } public void testCurrency() { assertEquals("USD", Money.dollar(1).currency()); assertEquals("CHF", Money.franc(1).currency()); } public void testPlusReturnsSumm() { Money five = Money.dollar(5); Money ten = Money.dollar(10); Expression result = five.plus(ten); Sum sum = (Sum) result; assertEquals(five, sum.augend); assertEquals(ten, sum.addend); } public void testReduceSum() { Expression sum = new Sum(Money.dollar(3), Money.dollar(4)); Bank bank = new Bank(); Money result = bank.reduce(sum, "USD"); assertEquals(Money.dollar(7), result); } public void testReduceMoney() { Bank bank = new Bank(); Money result = bank.reduce(Money.dollar(1), "USD"); assertEquals(Money.dollar(1), result); } public void testReduceMoneyDifferentCurreny() { Bank bank = new Bank(); bank.addRate("CHF", "USD", 2); Money result = bank.reduce(Money.franc(2), "USD"); assertEquals(Money.dollar(1), result); } public void testIdentityRate() { assertEquals(1, new Bank().rate("USD", "USD")); } public void testMixedAddition() { Expression fiveBucks = Money.dollar(5); Expression tenFrancs = Money.franc(10); Bank bank = new Bank(); bank.addRate("CHF", "USD", 2); Money result = bank.reduce(fiveBucks.plus(tenFrancs), "USD"); assertEquals(Money.dollar(10), result); } public void testSumPlusMoney() { Expression fiveBucks = Money.dollar(5); Expression tenFrancs = Money.franc(10); Bank bank = new Bank(); bank.addRate("CHF", "USD", 2); Expression sum = new Sum(fiveBucks, tenFrancs).plus(fiveBucks); Money result = bank.reduce(sum, "USD"); assertEquals(Money.dollar(15), result); } public void testSumTimes() { Expression fiveBucks = Money.dollar(5); Expression tenFrancs = Money.franc(10); Bank bank = new Bank(); bank.addRate("CHF", "USD", 2); Expression sum = new Sum(fiveBucks, tenFrancs).times(2); Money result = bank.reduce(sum, "USD"); assertEquals(Money.dollar(20), result); } } ================================================ FILE: java/tdd_by_example/README ================================================ Try-outs from Test-Driven Development by Kent Beck ================================================== The book advocates doing TDD in very small increments, writing the simplest test possible, followed by the simplest implementation possible and then refactoring. Known as the red/green/refactory cycle. The curious thing is that the steps are really tiny and that after writing the test you should make it pass as quick as possible, even if that means returning a constant or "Faking it" some other way. This way you get a test that you know works and refactor "in the green". Another curious thing is that when you follow this approach, you end up having very high coverage, since you basically don't write code you have no test for. Overall, you're progressing slower, but you should end up having a very nice test suite in the end. The examples here were done following the book very closely. Different commits represent the result after the end of each chapter (with one skipped). One can find the book here: * http://www.amazon.com/Test-Driven-Development-Addison-Wesley-Signature/dp/0321146530 ================================================ FILE: other/7languages/erlang/day1/count_to_ten.erl ================================================ -module(count_to_ten). -export([count_to_ten/0]). count_to_ten() -> count_to(1, 10). count_to(X, X) -> io:format("~p.~nDone!~n", [X]); count_to(A, B) -> io:format("~p...~n", [A]), count_to(A + 1, B). count(X) -> io:format("~p...~n", [X]). ================================================ FILE: other/7languages/erlang/day1/result_of.erl ================================================ -module(result_of). -export([result_of/1]). result_of(success) -> io:format("Success.~n"); result_of({error, Message}) -> io:format("Error occurred: ~s.~n", [Message]). ================================================ FILE: other/7languages/erlang/day1/word_count.erl ================================================ % Seven Languages in Seven Weeks, Erlang, day 1, exercise 1: % % Write a function that uses recursion to return the number of % words in a string. % % This is an awful exercise, given the language features introduced so far % (pattern matching, lists, function definition). Thus, the solution is a % hand-rolled state machine that counts transitions from space to character. -module(word_count). -export([word_count/1]). word_count(String) -> word_count(String, space, 0). word_count([32 | T], space, Count) -> word_count(T, space, Count); word_count([ _ | T], space, Count) -> word_count(T, character, Count + 1); word_count([32 | T], character, Count) -> word_count(T, space, Count); word_count([ _ | T], character, Count) -> word_count(T, character, Count); word_count([], _, Count) -> Count. ================================================ FILE: other/7languages/erlang/day2/pseudo_dict.erl ================================================ -module(pseudo_dict). -export([value_in/2]). value_in([{Key, Value} | _], Key) -> Value; value_in([_ | Tail], Key) -> value_in(Tail, Key); value_in([], _) -> undefined. ================================================ FILE: other/7languages/erlang/day2/tictactoe.erl ================================================ -module(tictactoe). -export([outcome/1]). outcome([W, W, W, _, _, _, _, _, _]) -> W; outcome([_, _, _, W, W, W, _, _, _]) -> W; outcome([_, _, _, _, _, _, W, W, W]) -> W; outcome([W, _, _, W, _, _, W, _, _]) -> W; outcome([_, W, _, _, W, _, _, W, _]) -> W; outcome([_, _, W, _, _, W, _, _, W]) -> W; outcome([W, _, _, _, W, _, _, _, W]) -> W; outcome([_, _, W, _, W, _, W, _, _]) -> W; outcome(Board) -> case lists:all(fun(E) -> (E =:= x) or (E == o) end, Board) of true -> cat; false -> no_winner end. ================================================ FILE: other/7languages/erlang/day2/total_price.erl ================================================ -module(total_price). -export([total_price/1]). total_price(ShoppingList) -> [{Item, Quantity * Price} || {Item, Quantity, Price} <- ShoppingList]. ================================================ FILE: other/7languages/io/day2/1/loop.io ================================================ fib := method(number, a := 1 b := 1 (number - 2) repeat ( b = a + b a = b - a ) b ) fib(1) println fib(2) println fib(3) println fib(4) println fib(5) println fib(6) println fib(7) println fib(8) println fib(9) println fib(10) println ================================================ FILE: other/7languages/io/day2/1/recursive.io ================================================ fib := method(number, if(number == 1 or number == 2, 1, fib(number - 1) + fib(number - 2)) ) fib(1) println fib(2) println fib(3) println fib(4) println fib(5) println fib(6) println fib(7) println fib(8) println fib(9) println fib(10) println ================================================ FILE: other/7languages/io/day2/2.io ================================================ Number oldDivide := Number getSlot("/") Number / = method(arg, if(arg == 0, 0, call target oldDivide(arg)) ) (1 / 2) println (2 / 3) println (3 / 0) println ================================================ FILE: other/7languages/io/day2/3.io ================================================ sum := method(lists, lists map(sum) sum) (sum(list(list(1, 2), list(3, 4))) == 10) println (sum(list(list(1), list(2, 3))) == 6) println ================================================ FILE: other/7languages/io/day2/4.io ================================================ List myAverage := method( isEmpty ifTrue(Exception raise("List has no elements")) select(proto != Number) isEmpty ifFalse(Exception raise("List contains non-number elements")) sum / size ) (list(1, 2, 3) myAverage == 2) println (list(1, 2, 3, 4) myAverage == 2.5) println try(list() myAverage) error println try(list(22, 0xF, "Sofia") myAverage) error println ================================================ FILE: other/7languages/io/day2/5.io ================================================ Matrix := Object clone do( dim := method(x, y, self items := list() setSize(y) map(list() setSize(x)) self ) set := method(x, y, value, items at(y) atPut(x, value) ) get := method(x, y, items at(y) at(x) ) ) m := Matrix clone dim(2, 4) m set(0, 0, "top left") m set(1, 3, "bottom right") m get(0, 0) println m get(1, 3) println ================================================ FILE: other/7languages/io/day2/6.io ================================================ Matrix := Object clone do( dim := method(x, y, self items := list() setSize(y) map(list() setSize(x)) self ) set := method(x, y, value, items at(y) atPut(x, value) ) get := method(x, y, items at(y) at(x) ) transpose := method( n := items at(0) size transposedItems := list for(i, 0, n - 1, transposedItems append(items map(at(i)))) newMatrix := Matrix clone newMatrix items := transposedItems newMatrix ) ) m := Matrix clone dim(2, 4) m set(0, 3, "top right") m set(1, 0, "bottom left") t := m transpose (t get(3, 0) == m get(0, 3)) println (t get(0, 1) == m get(1, 0)) println ================================================ FILE: other/7languages/io/day2/7.io ================================================ Matrix := Object clone do( dim := method(x, y, withItems list() setSize(y) map(list() setSize(x)) ) withItems := method(items, self items := items self ) set := method(x, y, value, items at(y) atPut(x, value) ) get := method(x, y, items at(y) at(x) ) saveTo := method(filename, file := File with(filename) file remove file openForUpdating file write(items map(join(",")) join("\n")) file close ) readFrom := method(filename, file := File with(filename) file openForReading readItems := file readLines map(split(",") map(asNumber)) file close withItems(readItems) ) ) original := Matrix clone withItems(list(list(1, 2), list(3, 4))) original saveTo("matrix.txt") reloaded := Matrix clone readFrom("matrix.txt") reloaded items println (reloaded items == original items) println File with("matrix.txt") remove ================================================ FILE: other/7languages/io/day2/8.io ================================================ guesses := 10 guess := nil lastGuess := nil number := (Random value * 100) floor + 1 loop( lastGuess = guess guess = File standardInput readLine("Your guess: ") asNumber guesses = guesses - 1 (guess == number) ifTrue(writeln("You got it. Congratulations!"); break) (guesses == 0) ifTrue(writeln("Sorry, you failed. The number was: ", number); break) lastGuess ifNonNil( thisDistance := (number - guess) abs lastDistance := (number - lastGuess) abs if(thisDistance > lastDistance, "Colder", "Hotter") print ) ifNil ( "Nope" print ) writeln(". ", guesses, " guesses left") ) ================================================ FILE: other/7languages/io/day2/reflection.io ================================================ Object ancestors := method( prototype := self proto if(prototype != Object, writeln("Slots of ", prototype type, "\n------------------") prototype slotNames foreach(slotName, writeln(slotName)) writeln prototype ancestors ) ) Animal := Object clone Animal speak := method("ambiguous animal noise" println) Duck := Animal clone Duck speak := method("quack" println) Duck walk := method("waddle" println) disco := Duck clone disco ancestors ================================================ FILE: other/7languages/io/day3/1.io ================================================ Builder := Object clone Builder spacing := 0 Builder forward := method( printWithSpacing("<", call message name, ">") increaseSpacing call message arguments foreach(arg, content := self doMessage(arg) if(content type == "Sequence", printWithSpacing(content)) ) decreaseSpacing printWithSpacing("") ) Builder increaseSpacing := method(self spacing := spacing + 1) Builder decreaseSpacing := method(self spacing := spacing - 1) Builder printWithSpacing := method( spacing repeat(" " print) call delegateToMethod(self, "writeln") ) Builder ul( li("Io"), li("Lua"), li("JavaScript") ) ================================================ FILE: other/7languages/io/day3/2.io ================================================ squareBrackets := method(call evalArgs) [1, 2, 3, 4] println [1 + 2, 2 + 3, 3 + 4] println ================================================ FILE: other/7languages/io/day3/3.io ================================================ OperatorTable addAssignOperator(":", "makeHashPair") CoolBuilder := Object clone do( spacing := 0 forward := method( tagName := call message name items := call message arguments if(items at(0) ?name == "curlyBrackets", printWithSpacing("<", tagName, " ", AttributesPrinter makeAttributesString(items removeFirst), ">") , printWithSpacing("<", tagName, ">") ) printContents(items) printWithSpacing("") ) printContents := method(contents, self spacing = spacing + 1 contents foreach(item, content := self doMessage(item) if(content type == "Sequence", printWithSpacing(content)) ) self spacing = spacing - 1 ) printWithSpacing := method( spacing repeat(" " print) call delegateToMethod(self, "writeln") ) ) AttributesPrinter := Map clone do( makeAttributesString := method(msg, printer := AttributesPrinter clone printer doMessage(msg) printer map(key, value, key .. "=\"" .. value .. "\"") join(" ") ) curlyBrackets := method( call message arguments foreach(arg, doMessage(arg)) ) makeHashPair := method( self atPut( call evalArgAt(0) asMutable removePrefix("\"") removeSuffix("\""), call evalArgAt(1) ) ) ) doFile("3.xml.io") ================================================ FILE: other/7languages/io/day3/3.xml.io ================================================ CoolBuilder ul( li({"class": "important", "id": "io"}, "Io"), li({"id": "lua"}, "Lua"), li("JavaScript") ) ================================================ FILE: other/7languages/io/day3/actors.io ================================================ slower := Object clone faster := Object clone slower start := method(wait(2); writeln("slowly")) faster start := method(wait(1); writeln("quickly")) slower start; faster start slower @@start; faster @@start; wait(3) ================================================ FILE: other/7languages/io/day3/builder.io ================================================ Builder := Object clone Builder forward := method( writeln("<", call message name, ">") call message arguments foreach(arg, content := self doMessage(arg) content println if(content type == "Sequence", writeln(content)) ) writeln("") ) Builder ul( li("Io"), li("Lua"), li("JavaScript") ) ================================================ FILE: other/7languages/io/day3/coroutine.io ================================================ vizzini := Object clone vizzini talk := method( "Fezzik, are there rocks ahead?" println yield "No more rhymes now, I mean it" println yield ) fezzik := Object clone fezzik rhyme := method( yield "If there are, we'll all be dead" println yield "Anybody want a peanut?" println ) vizzini @@talk; fezzik @@rhyme Coroutine currentCoroutine pause ================================================ FILE: other/7languages/io/day3/futures.io ================================================ Lobby countAMillion := method( writeln("Counter started") for(i, 1, 1000000, "") "Counter done" ) counter := Lobby @countAMillion writeln("Starting counter...") writeln(counter) writeln("Exiting") ================================================ FILE: other/7languages/io/day3/phonebook.io ================================================ OperatorTable addAssignOperator(":", "atPutNumber") curlyBrackets := method( r := Map clone call message arguments foreach(arg, r doMessage(arg) ) r ) Map atPutNumber := method( self atPut( call evalArgAt(0) asMutable removePrefix("\"") removeSuffix("\""), call evalArgAt(1) ) ) phoneNumbers := doString("{\"Bob Smith\": \"5195551212\", \"Mary Walsh\": \"4162223434\"}") phoneNumbers keys println phoneNumbers values println ================================================ FILE: other/7languages/prolog/day1/food.prolog ================================================ food_type(velveeta, cheese). food_type(ritz, cracker). food_type(spam, meat). food_type(sausage, meat). food_type(jolt, soda). food_type(twinkie, dessert). flavor(sweet, dessert). flavor(savory, meat). flavor(savory, cheese). flavor(sweet, soda). food_flavor(X, Y) :- food_type(X, Z), flavor(Y, Z). ================================================ FILE: other/7languages/prolog/day1/friends.prolog ================================================ likes(wallace, cheese). likes(grommit, cheese). likes(wendolene, sheep). friend(X, Y) :- \+(X = Y), likes(X, Z), likes(Y, Z). ================================================ FILE: other/7languages/prolog/day1/map.prolog ================================================ different(red, green). different(red, blue). different(green, red). different(green, blue). different(blue, red). different(blue, green). coloring(Alabama, Mississippi, Georgia, Tennessee, Florida) :- different(Mississippi, Tennessee), different(Mississippi, Alabama), different(Alabama, Tennessee), different(Alabama, Mississippi), different(Alabama, Georgia), different(Alabama, Florida), different(Georgia, Florida), different(Georgia, Tennessee). ================================================ FILE: other/7languages/prolog/day2/2.1.prolog ================================================ reversed(X, Y) :- reversed(X, [], Y). reversed([], X, X). reversed([X|Y], W, Z) :- reversed(Y, [X|W], Z). ================================================ FILE: other/7languages/prolog/day2/2.2.2.prolog ================================================ smallest(Min, [Min]). smallest(Min, [A, B | Tail]) :- A =< B, smallest(Min, [A | Tail]). smallest(Min, [A, B | Tail]) :- A >= B, smallest(Min, [B | Tail]). ================================================ FILE: other/7languages/prolog/day2/2.2.prolog ================================================ smallest(Number, List) :- member(Number, List), less_or_equal_than(Number, List). member(Number, [Number|_]). member(Number, [_|Tail]) :- member(Number, Tail). less_or_equal_than(Number, []). less_or_equal_than(Number, [Head|Tail]) :- Number =< Head, less_or_equal_than(Number, Tail). ================================================ FILE: other/7languages/prolog/day2/2.3.prolog ================================================ sorted([H | T], B, C) :- inserted(H, B, B1), sorted(T, B1, C). sorted([], X, X). inserted(A, [], [A]). inserted(A, [H | T], [A, H | T]) :- A < H. inserted(A, [H | T1], [H | T2]) :- H < A, inserted(A, T1, T2). ================================================ FILE: other/7languages/prolog/day2/concatenate.prolog ================================================ concatenate([], List, List). concatenate([Head|Tail1], List, [Head|Tail2]) :- concatenate(Tail1, List, Tail2). ================================================ FILE: other/7languages/prolog/day2/fibonacci.prolog ================================================ fib(0, 1). fib(1, 1). fib(X, Y) :- S1 is X - 1, S2 is X - 2, fib(S1, F1), fib(S2, F2), Y is F1 + F2. ================================================ FILE: other/7languages/prolog/day2/list_math.prolog ================================================ count(0, []). count(Count, [_|Tail]) :- count(TailCount, Tail), Count is TailCount + 1. sum(0, []). sum(Total, [Head|Tail]) :- sum(TailTotal, Tail), Total is TailTotal + Head. average(Average, List) :- count(Count, List), sum(Sum, List), Average is Sum / Count. ================================================ FILE: other/7languages/prolog/day3/queens.prolog ================================================ valid_queen((Row, Col)) :- between(1, 8, Row), between(1, 8, Col). valid_board([]). valid_board([Head | Tail]) :- valid_queen(Head), valid_board(Tail). rows([], []). rows([(Row, _) | QueensTail], [Row | RowsTail]) :- rows(QueensTail, RowsTail). cols([], []). cols([(_, Col) | QueensTail], [Col | ColsTail]) :- cols(QueensTail, ColsTail). diags1([], []). diags1([(Row, Col) | QueensTail], [Diagonal | DiagonalsTail]) :- Diagonal is Col - Row, diags1(QueensTail, DiagonalsTail). diags2([], []). diags2([(Row, Col) | QueensTail], [Diagonal | DiagonalsTail]) :- Diagonal is Col + Row, diags2(QueensTail, DiagonalsTail). eight_queens(Board) :- length(Board, 8), valid_board(Board), rows(Board, Rows), cols(Board, Cols), diags1(Board, Diags1), diags2(Board, Diags2), is_set(Rows), is_set(Cols), is_set(Diags1), is_set(Diags2). ================================================ FILE: other/7languages/prolog/day3/sudoku.prolog ================================================ domain([]). domain([Head | Tail]) :- between(1, 4, Head), domain(Tail). valid([]). valid([Head | Tail]) :- is_set(Head), valid(Tail). sudoku(Puzzle, Solution) :- Puzzle = Solution, Puzzle = [S11, S12, S13, S14, S21, S22, S23, S24, S31, S32, S33, S34, S41, S42, S43, S44], domain(Puzzle), Row1 = [S11, S12, S13, S14], Row2 = [S21, S22, S23, S24], Row3 = [S31, S32, S33, S34], Row4 = [S41, S42, S43, S44], Col1 = [S11, S21, S31, S41], Col2 = [S12, S22, S32, S42], Col3 = [S13, S23, S33, S43], Col4 = [S14, S24, S34, S44], Square1 = [S11, S12, S21, S22], Square2 = [S13, S14, S23, S24], Square3 = [S31, S32, S41, S42], Square4 = [S33, S34, S43, S44], valid([Row1, Row2, Row3, Row4, Col1, Col2, Col3, Col4, Square1, Square2, Square3, Square4]). ================================================ FILE: other/7languages/prolog/other/einstein.prolog ================================================ /* Einstein's riddle In a street there are five houses, painted five different colors. In each house lives a person of different nationality. These five homeowners each drink a different kind of beverage, smoke different brand of cigar and keep a different pet. 1. The Brit lives in a red house. 2. The Swede keeps dogs as pets. 3. The Dane drinks tea. 4. The green house is next to, and on the left of the white house. 5. The owner of the green house drinks coffee. 6. The person who smokes Pall Mall rears birds. 7. The owner of the yellow house smokes Dunhill. 8. The man living in the centre house drinks milk. 9. The Norwegian lives in the first house. 10. The man who smokes Blends lives next to the one who keeps cats. 11. The man who keeps horses lives next to the man who smokes Dunhill. 12. The man who smokes Blue Master drinks beer. 13. The German smokes Prince. 14. The Norwegian lives next to the blue house. 15. The man who smokes Blends has a neighbour who drinks water. Who owns the fish? */ nationality(Nationality) :- member(Nationality, [brit, swede, dane, norwegian, german]). color(Color) :- member(Color, [green, yellow, white, red, blue]). pet(Pet) :- member(Pet, [fish, dogs, birds, horses, cats]). beverage(Beverage) :- member(Beverage, [tea, coffee, milk, beer, water]). cigars(Brand) :- member(Brand, [pall_mall, dunhill, blends, prince, blue_master]). person([Nation, Color, Pet, Beverage, Cigars]) :- nationality(Nation), color(Color), pet(Pet), beverage(Beverage), cigars(Cigars). has(Thing, Person) :- nationality(Thing), Person = [Thing, _, _, _, _]. has(Thing, Person) :- color(Thing), Person = [_, Thing, _, _, _]. has(Thing, Person) :- pet(Thing), Person = [_, _, Thing, _, _]. has(Thing, Person) :- beverage(Thing), Person = [_, _, _, Thing, _]. has(Thing, Person) :- cigars(Thing), Person = [_, _, _, _, Thing]. same(A, B, People) :- has(A, Person), has(B, Person), member(Person, People). first_house(A, People) :- has(A, Person), People = [Person, _, _, _, _]. center_house(A, People) :- has(A, Person), People = [_, _, Person, _, _]. left_of(A, B, People) :- has(A, PersonA), has(B, PersonB), nextto(PersonA, PersonB, People). neighbours(A, B, People) :- left_of(A, B, People); left_of(B, A, People). solution(People) :- People = [_, _, _, _, _], same(brit, red, People), same(swede, dogs, People), same(dane, tea, People), left_of(green, white, People), same(green, coffee, People), same(birds, pall_mall, People), same(yellow, dunhill, People), center_house(milk, People), first_house(norwegian, People), neighbours(blends, cats, People), neighbours(horses, dunhill, People), same(beer, blue_master, People), same(german, prince, People), neighbours(norwegian, blue, People), neighbours(blends, water, People), maplist(person, People), flatten(People, Items), is_set(Items). has_fish(Nationality) :- solution(Solution), member([Nationality, _, fish, _, _], Solution). ================================================ FILE: other/7languages/scala/day1/1.scala ================================================ object Player extends Enumeration { val X = Value("X") val O = Value("O") def fromChar(char : Char) : Player.Value = { char match { case 'X' => X case 'O' => O case ' ' => null case _ => throw new AssertionError("Illegal character " + char) } } } import Player.X import Player.O object Board { val rows = List((0, 1, 2), (3, 4, 5), (6, 7, 8)) val columns = List((0, 3, 6), (1, 4, 7), (2, 5, 8)) val diagonals = List((0, 4, 8), (2, 4, 6)) val lanes = rows ::: columns ::: diagonals } class Board(marks : List[Player.Value]) { assert(marks.length == 9) def this(boardAsString : String) { this(boardAsString.map(Player.fromChar).toList) assert(boardAsString.matches("^[XO ]{9}$")) } def winner() : Player.Value = { val markedLanes = Board.lanes.map(marksOnLane) markedLanes.foreach { lane => lane match { case (X, X, X) => return X case (O, O, O) => return O case _ => } } return null } def marksOnLane(lane : (Int, Int, Int)) : (Player.Value, Player.Value, Player.Value) = { (marks(lane._1), marks(lane._2), marks(lane._3)) } } println(new Board("XXXO X ").winner) // X println(new Board("X O X ").winner) // null println(new Board("XO OO XO ").winner) // O println(new Board("XO OX XOX").winner) // X ================================================ FILE: other/7languages/scala/day1/2.scala ================================================ object Player extends Enumeration { val X = Value("X") val O = Value("O") def other(value : Value) = if (value == X) { O } else { X } def asChar(value : Value) : Char = { value match { case X => 'X' case O => 'O' case null => ' ' } } } import Player.X import Player.O object Board { val rows = List((0, 1, 2), (3, 4, 5), (6, 7, 8)) val columns = List((0, 3, 6), (1, 4, 7), (2, 5, 8)) val diagonals = List((0, 4, 8), (2, 4, 6)) val lanes = rows ::: columns ::: diagonals } class Board { var marks : Array[Player.Value] = Array(null, null, null, null, null, null, null, null, null) def apply(square : Int) = marks(square) def marksOnLane(lane : (Int, Int, Int)) = (marks(lane._1), marks(lane._2), marks(lane._3)) def taken(square : Int) = marks(square) != null def isFull = marks.forall(_ != null) def hasWinner = winner != null def placeMark(player : Player.Value, square : Int) { marks(square) = player } def winner : Player.Value = { val markedLanes = Board.lanes.map(marksOnLane) markedLanes.foreach { lane => lane match { case (X, X, X) => return X case (O, O, O) => return O case _ => } } return null } } object GridRenderer { def render(grid : Seq[Char]) = new GridRenderer(grid).render } class GridRenderer(grid : Seq[Char]) { def render { println(separator) for (row <- 0 to 2) { println(rowLine(row)) println(separator) } } def separator = "+---+---+---+" def rowLine(row : Int) = "| %c | %c | %c |".format(at(row, 0), at(row, 1), at(row, 2)) def at(row : Int, column : Int) = grid(row * 3 + column) } class Game { var currentPlayer = X val board = new Board def play { renderSquareNumbers while (inProgress) { playOn(readPosition) renderBoard switchPlayer } showOutcome } def inProgress = !(board.hasWinner || board.isFull) def renderBoard = GridRenderer render board.marks.map(Player.asChar) def renderSquareNumbers = GridRenderer render '1'.to('9') def playOn(square : Int) = board.placeMark(currentPlayer, square) def switchPlayer = this.currentPlayer = Player.other(currentPlayer) def showOutcome { if (board.winner != null) { println("The winner is player " + board.winner + ".") } else { println("The game was a tie.") } } def readPosition : Int = { while (true) { print("Player " + currentPlayer + "'s turn. Pick square (1-9): ") try { val input = Console.readInt - 1 if (!0.to(8).contains(input)) { println("Specify the square with a number from 1 to 9") } else if (board.taken(input)) { println("Square is taken. Try another one") } else { return input } } catch { case e: NumberFormatException => println("Please enter an integer between 1 and 9.") } } throw new AssertionError("Unreachable code :P") } } new Game().play ================================================ FILE: other/7languages/scala/day2/1.scala ================================================ val strings = List("Foo", "Bar", "Baz") val totalSize = (0 /: strings) { _ + _.size } println(totalSize) ================================================ FILE: other/7languages/scala/day2/2.scala ================================================ class Person(name: String, catchPhrase: String) { def greet() = println(greeting) protected def greeting() = "Hi, I am %s. %s".format(name, catchPhrase) } object Censor { val censoredWords = Map( "Shoot" -> "Puckey", "Darn" -> "Breans" ) } trait Censor extends Person { override protected def greeting(): String = { (super.greeting /: Censor.censoredWords) { (greeting, replacement) => greeting.replace(replacement._1, replacement._2) } } } var homer = new Person("Homer Simpsons", "Darn. Shoot! Darn it to Shoot") with Censor homer.greet() ================================================ FILE: other/7languages/scala/day2/3.scala ================================================ class Person(name: String, catchPhrase: String) { def greet() = println(greeting) protected def greeting() = "Hi, I am %s. %s".format(name, catchPhrase) } object Censor { val censoredWords = readWordsFromFile private def readWordsFromFile: Map[String, String] = { val emptyMap: Map[String, String] = Map.empty val linesInFile = scala.io.Source.fromFile("censored_words.txt").getLines linesInFile. map(_.trim.split(": +")). filter(_.length == 2). foldLeft(emptyMap) { (map, words) => map + (words(0) -> words(1)) } } } trait Censor extends Person { override protected def greeting(): String = { (super.greeting /: Censor.censoredWords) { (greeting, replacement) => greeting.replace(replacement._1, replacement._2) } } } var homer = new Person("Homer Simpsons", "Darn. Shoot! Darn it to Shoot.") with Censor homer.greet() ================================================ FILE: other/7languages/scala/day2/censored_words.txt ================================================ Shoot: Puckey Darn: Beans ================================================ FILE: other/7languages/scala/day3/sizer.scala ================================================ import scala.io._ import scala.actors._ import Actor._ object PageLoader { def getPageSize(url: String) = Source.fromURL(url).mkString.length } val urls = List("http://www.amazon.com/", "http://www.google.com/", "http://www.cnn.com/") def timeMethod(method: () => Unit) = { val start = System.nanoTime method() val end = System.nanoTime println("Method took " + (end - start)/1000000000.0 + " seconds.") } def getPageSizeSequentially() = { for (url <- urls) { println("Size for " + url + ": " + PageLoader.getPageSize(url)) } } def getPageSizeConcurrently() = { val caller = self for (url <- urls) { caller ! (url, PageLoader.getPageSize(url)) } for (i <- 1 to urls.size) { receive { case (url, size) => println("Size for " + url + ": " + size) } } } println("Sequential run:") timeMethod { getPageSizeSequentially } println("Concurrent run:") timeMethod { getPageSizeConcurrently } ================================================ FILE: other/clrs/.gitignore ================================================ __pycache__ *.pyc ================================================ FILE: other/clrs/.powrc ================================================ export LC_ALL=en_US.utf-8 export LANG=en_US.utf-8 source ".rvmrc" ================================================ FILE: other/clrs/.ruby-version ================================================ 2.7.2 ================================================ FILE: other/clrs/.rvmrc ================================================ rvm --create 2.0.0@playground ================================================ FILE: other/clrs/01/01/01.markdown ================================================ > Give a real-world example that requires sorting or a real-world example > that requires computing a convex hull. A real-world example of sorting is pretty straightforward - for example, every web page that renders a list alphabetically needs to sort the entries - a catalog, an index or whatever. I have no clue why we need to compute convex hulls, but Wikipedia says that there are a bunch of applications. ================================================ FILE: other/clrs/01/01/02.markdown ================================================ > Other than speed, what other measures of efficiency might one use in a > real-world setting? Memory usage and resource utilization (network, database) are good answers. ================================================ FILE: other/clrs/01/01/03.markdown ================================================ > Select a data structure that you have seen previously, and discuss its > strengths and limitations. Let's take the singly-linked list. Strengths: * It does not need sequential space in memory * We can insert a new element at any place Limitations: * Random access is $\mathcal{O}(n)$ * It takes additional memory for the links ================================================ FILE: other/clrs/01/01/04.markdown ================================================ > How are the shortest-path and traveling-salesman problems given above > similar? How are they different? They are similar, because each of then has to walk a graph and find a path in them. The difference is the constraint on the solution. The shortest-path requires just a path between two points, while the traveling salesman requires a path between more points that returns to the first point. ================================================ FILE: other/clrs/01/01/05.markdown ================================================ > Come up with a real-world problem in which only the best solution will do. > Then come up with one in which a solution that is "approximately" the best > is good enough. Sorting a catalog is a problem, where only the best solution will do. An "approximately" sorted catalog won't be that useful. Finding the shortest path between two points in a city is a problem, where good-enough will do. It might not be the fastest way, but you will still get there. ================================================ FILE: other/clrs/01/02/01.markdown ================================================ > Give an example of an application that requires algorithmic content at > the application level, and discuss the function of the algorithms > involved. Google Maps when finding a route between two places. The algorithms are an essential part of this use case, since the route is what the user cares for the most. ================================================ FILE: other/clrs/01/02/02.markdown ================================================ > Suppose we are comparing implementations of insetion sort and merge sort on > the same machine. For inputs of size $n$, insertion sort runs in $ 8n\^{2} $ > steps, while merge sort runs in $ 64n\lg{n} $ steps. For which values of $n$ > does insertion sort beat merge sort? At $ n > 43 $ merge sort beats insertion sort. ================================================ FILE: other/clrs/01/02/03.markdown ================================================ > What is the smallest value of $n$ such that an algorithm whose running time > is $ 100n\^{2} $ runs faster than an algorithm whose running time is $ > 2\^{n} $ on the same machine? At $ n > 14 $, the first algorithm runs faster. ================================================ FILE: other/clrs/01/problems/01.markdown ================================================ ## Comparison of running times > For each function $ f(n) $ and time $ t $ in the following table, determine > the largest size $ n $ of a problem that can be solved in time $ t $, > assuming that the algorithm to solve the problem takes $ f(n) $ > microseconds. | | 1 second | 1 minute | 1 hour | 1 day | 1 month | 1 year | 1 century | |:------------:| -----------------:| -------------------------:| -----------------------:| -------------------------:| --------------------------:| ----------------------------:| ----------------------------------:| | $ \lg{n} $ | $ 2\^{10\^6} $ | $ 2\^{6 \cdot 10\^7} $ | $ 2\^{36 \cdot 10\^8} $ | $ 2\^{864 \cdot 10\^8} $ | $ 2\^{25920 \cdot 10\^8} $ | $ 2\^{315360 \cdot 10\^8} $ | $ 2\^{31556736 \cdot 10\^8} $ | | $ \sqrt{n} $ | $ 10\^{12} $ | $ 36 \cdot 10\^{14} $ | $ 1296 \cdot 10\^{16} $ | $ 746496 \cdot 10\^{16} $ | $ 6718464 \cdot 10\^{18} $ | $ 994519296 \cdot 10\^{18} $ | $ 995827586973696 \cdot 10\^{16} $ | | $ n $ | $ 10\^6 $ | $ 6 \cdot 10\^7 $ | $ 36 \cdot 10\^{8} $ | $ 864 \cdot 10\^{8} $ | $ 2592 \cdot 10\^{9} $ | $ 31536 \cdot 10\^{9} $ | $ 31556736 \cdot 10\^{8} $ | | $ n\lg{n} $ | $ 62746 $ | $ 2801417 $ | $ 133378058 $ | $ 2755147513 $ | $ 71870856404 $ | $ 797633893349 $ | $ 68654697441062 $ | | $ n\^2 $ | $ 1000 $ | $ 7745 $ | $ 60000 $ | $ 293938 $ | $ 1609968 $ | $ 5615692 $ | $ 56175382 $ | | $ n\^3 $ | $ 100 $ | $ 391 $ | $ 1532 $ | $ 4420 $ | $ 13736 $ | $ 31593 $ | $ 146677 $ | | $ 2\^n $ | $ 19 $ | $ 25 $ | $ 31 $ | $ 36 $ | $ 41 $ | $ 44 $ | $ 51 $ | | $ n! $ | $ 9 $ | $ 11 $ | $ 12 $ | $ 13 $ | $ 15 $ | $ 16 $ | $ 17 $ | ================================================ FILE: other/clrs/02/01/01.dot ================================================ digraph g { node [shape=box style=filled fillcolor=white]; subgraph cluster_A { A1 [label="31" fillcolor=gray]; A2 [label="41" fillcolor=black fontcolor=white]; A3 [label="59"]; A4 [label="26"]; A5 [label="41"]; A6 [label="58"]; { rank=same; A1, A2, A3, A4, A5, A6 } A1 -> A2 -> A3 -> A4 -> A5 -> A6 [style=invis]; } subgraph cluster_B { B1 [label="31"]; B2 [label="41" fillcolor=gray]; B3 [label="59" fillcolor=black fontcolor=white]; B4 [label="26"]; B5 [label="41"]; B6 [label="58"]; { rank=same; B1, B2, B3, B4, B5, B6 } B1 -> B2 -> B3 -> B4 -> B5 -> B6 [style=invis]; } subgraph cluster_C { C1 [label="31" fillcolor=gray]; C2 [label="41" fillcolor=gray]; C3 [label="59" fillcolor=gray]; C4 [label="26" fillcolor=black fontcolor=white]; C5 [label="41"]; C6 [label="58"]; { rank=same; C1, C2, C3, C4, C5, C6 } C1 -> C2 -> C3 -> C4 [color=gray]; C4 -> C1 [constraint=false]; C4 -> C5 -> C6 [style=invis]; } subgraph cluster_D { D1 [label="26"]; D2 [label="31"]; D3 [label="41" fillcolor=gray]; D4 [label="59" fillcolor=gray]; D5 [label="41" fillcolor=black fontcolor=white]; D6 [label="58"]; { rank=same; D1, D2, D3, D4, D5, D6 } D1 -> D2 -> D3 -> D4 -> D5 -> D6 [style=invis]; D4 -> D5 [constraint=false color=gray]; D5 -> D4 [constraint=false color=black]; } subgraph cluster_E { E1 [label="26"]; E2 [label="31"]; E3 [label="41"]; E4 [label="41" fillcolor=gray]; E5 [label="59" fillcolor=gray]; E6 [label="58" fillcolor=black fontcolor=white]; { rank=same; E1, E2, E3, E4, E5, E6 } E1 -> E2 -> E3 -> E4 -> E5 -> E6 [style=invis]; E5 -> E6 [constraint=false color=gray]; E6 -> E5 [constraint=false color=black]; } subgraph cluster_F { F1 [label="26"]; F2 [label="31"]; F3 [label="41"]; F4 [label="41"]; F5 [label="58"]; F6 [label="59"]; { rank=same; F1, F2, F3, F4, F5, F6 } F1 -> F2 -> F3 -> F4 -> F5 -> F6 [style=invis]; } A1 -> B1 -> C1 -> D1 -> E1 -> F1 [style=invis]; } ================================================ FILE: other/clrs/02/01/01.markdown ================================================ > Using figure 2.4 as a model, illustrate the operations of _Insertion-Sort_ on the array $ A = \langle 31, 41, 59, 26, 41, 58 \rangle $. Wow, this took a while to implement. Graphviz sucks. ================================================ FILE: other/clrs/02/01/02.markdown ================================================ > Rewrite the _Insertion-Sort_ procedure to sort into nonincreasing instead of nondecreasing order. The only thing we need to do, is flip the comparison: for j = 2 to A.length key = A[j] i = j - 1 while i > 0 and A[i] < key A[i + 1] = A[i] i = i - 1 A[i + 1] = key ================================================ FILE: other/clrs/02/01/03.markdown ================================================ > Consider the **searching problem**: > > **Input**: A sequence of $ n $ numbers $ A = \langle a_1, a_2, \ldots, a_n \rangle $ > and a value $\nu$. > > **Output**: And index $i$ such that $ \nu = A[i] $ or the special value $\mathrm{NIL}$ if $\nu$ does > not appear in $A$ > > Write the pseudocode for *linear search*, which scans through the sequence, looking > for $\nu$. Using a loop invariant, prove that your algorithm is correct. Make sure that > your loop invariant fulfills the three necessary properties. The pseudocode looks like this: SEARCH(A, v): for i = 1 to A.length if A[i] == v return i return NIL I'm going to state the loop invariant as: > At the start of each iteration of the for loop, the subarray $A[1..i - 1]$ consists > of elements that are different than $\nu$. Here are the three properties: --- #### Initialization Initially the subarray is the empty array, so proving it is trivial. #### Maintenance On each step, we know that $A[1..i-1]$ does not contain $\nu$. We compare it with $A[i]$. If they are the same, we return $i$, which is a correct result. Otherwise, we continue to the next step. We have already insured that $A[A..i-1]$ does not contain $\nu$ and that $A[i]$ is different from $\nu$, so this step preserves the invariant. #### Termination The loop terminates when $i > A.length$. Since $i$ increases by $1$ and $i > A.length$, we know that all the elements in $A$ have been checked and it has been found that $\nu$ is not among them. Thus, we return $\mathrm{NIL}$. --- ================================================ FILE: other/clrs/02/01/04.markdown ================================================ > Consider the problem of adding two $n$-bit binary integers, stored in two n-element arrays > $A$ and $B$. The sum of the two integers should be stored in binary form in an > $(n + 1)$-element array $C$. State the problem formally and write pseudocode for adding > the two integers. I'm just happy that I don't need to write the loop invariant, since that seems tedious. The formal statement: --- **Input**: An array of booleans $A = \langle a_1, a_2, \ldots, a_n \rangle$, an array of booleans $B = \langle b_1, b_2, \ldots, b_n \rangle$, each representing an integer stored in binary format (each digit is a number, either 0 or 1, least-significant digit first) and each of length $n$. **Output**: An array $C = \langle c_1, c_2, \ldots, c_{n+1} \rangle$ that such that $C' = A' + B'$, where $A'$, $B'$ and $C'$ are the integers, represented by $A$, $B$ and $C$. --- Here is the pseudocode: ADD-BINARY(A, B): C = new integer[A.length + 1] carry = 0 for i = 1 to A.length C[i] = (A[i] + B[i] + carry) % 2 // remainder carry = (A[i] + B[i] + carry) / 2 // quotient C[i] = carry return C ================================================ FILE: other/clrs/02/02/01.markdown ================================================ > Express the function $ n^3 / 1000 - 100n^2 - 100n + 3 $ in terms of $\Theta$-notation It is as simple as $\Theta(n^3)$. ================================================ FILE: other/clrs/02/02/02.markdown ================================================ > Consider sorting $n$ numbers in an array $A$ by first finding the smallest > element of $A$ and exchanging it with the element in $A[1]$. Then find the > second smallest element of $A$, and exchange it with $A[2]$. Continue in > this manner for the first $n - 1$ elements of $A$. Write pseudocode for this > algorithm, which is known as **selection sort**. What loop invariants does > this algorithm maintain? Why does it need to run for only the first $n - 1$ > elements, rather than for all $n$ elements? Give the best-case and the > worst-case running times of selection sort in $\Theta$-notation. ## Pseudocode SELECTION-SORT(A): for i = 1 to A.length - 1 min = i for j = i + 1 to A.length if A[j] < A[min] min = j temp = A[i] A[i] = A[min] A[min] = temp ## Loop invariants > At the start of each iteration of the outer **for** loop, the subarray > $A[1..i - 1]$ contains the smallest $i - 1$ elements of the array, sorted > in nondecreasing order. And: > At the start of each iteration of the inner **for** loop, $A[min]$ is the > smallest number in the subarray $A[i..j - 1]$. ## Why $n - 1$ elements? In the final step, the algorithm will be left with two elements to compare. It will store the smaller one in $A[n-1]$ and leave the larger in $A[n]$. The final one will be the largest element of the array, since all the previous iteration would have sorted all but the last two elements (the outer loop invariant). If we do it $n$ times, we will end up with a redundant step that sorts a single-element subarray. ## Running times In the best-case time (the array is sorted), the body of the if is never invoked. The number of operations (counting the comparison as one operation) is: $$ (n - 1)(\frac{n + 2}{2} + 4) $$ In the worst-case time (the array is reversed), the body of the if is invoked on every occasion, which doubles the number of steps in the inner loop, that is: $$ (n - 1)(n + 6) $$ Both are clearly $\Theta(n^2)$. ================================================ FILE: other/clrs/02/02/03.markdown ================================================ > Consider linear search again (see exercise 2.1-3). How many elements of the > input sequence need to be checked on the average, assuming that the element > being searched for is equally likely to be any element in the array? How > about the worst case? What are the average-case and worst-case running times > of linear search in $\Theta$-notation? Justify your answers. If the element is present in the sequence, half of the elements are likely to be checked before it is found in the average case. In the worst case, all of them will be checked. That is, $n/2$ checks for the average case and $n$ for the worst case. Both of them are $\Theta(n)$. ================================================ FILE: other/clrs/02/02/04.markdown ================================================ > How can we modify almost any algorithm to have a good best-case running time? We can modify it to handle the best-case efficiently. For example, if we modify merge-sort to check if the array is sorted and just return it, the best-case running time will be $\Theta(n)$. ================================================ FILE: other/clrs/02/03/01.dot ================================================ digraph G { rankdir=BT; { node[shape=box]; rank=same; 03, 41, 52, 26, 38, 57, 09, 49 } node[shape=record]; { rank=same; a1[label="03|41"]; a2[label="26|52"]; a3[label="38|57"]; a4[label="09|49"]; } { rank=same; b1[label="03|26|41|52"]; b2[label="09|38|49|57"]; } c1[label="03|09|26|38|41|49|52|57"]; 03 -> a1; 41 -> a1; 52 -> a2; 26 -> a2; 38 -> a3; 57 -> a3; 09 -> a4; 49 -> a4; a1 -> b1; a2 -> b1; a3 -> b2; a4 -> b2; b1 -> c1; b2 -> c1; } ================================================ FILE: other/clrs/02/03/01.markdown ================================================ > Using Figure 2.4 as a model, illustrate the operation of merge sort on the > array $A = \langle 3, 41, 52, 26, 38, 57, 9, 49 \rangle$. This is perfect for graphviz! ================================================ FILE: other/clrs/02/03/02.c ================================================ #include void merge(int A[], int p, int q, int r) { int i, j, k; int n1 = q - p + 1; int n2 = r - q; int L[n1]; int R[n2]; for (i = 0; i < n1; i++) L[i] = A[p + i]; for (j = 0; j < n2; j++) R[j] = A[q + j + 1]; for(i = 0, j = 0, k = p; k <= r; k++) { if (i == n1) { A[k] = R[j++]; } else if (j == n2) { A[k] = L[i++]; } else if (L[i] <= R[j]) { A[k] = L[i++]; } else { A[k] = R[j++]; } } } void merge_sort(int A[], int p, int r) { if (p < r) { int q = (p + r) / 2; merge_sort(A, p, q); merge_sort(A, q + 1, r); merge(A, p, q, r); } } ================================================ FILE: other/clrs/02/03/02.markdown ================================================ > Rewrite the *MERGE* procedure so that it does not use sentinels, instead > stopping once either array L or R has had all its elements copied back to A > and then copying the remainder of the other array back into A. Here is a simple modification: MERGE(A, p, q, r) n1 = q - p + 1 n2 = r - q let L[1..n₁] and R[1..n₂] be new arrays for i = 1 to n₁ L[i] = A[p + i - 1] for j = 1 to n₂ R[j] = A[q + j] i = 1 j = 1 for k = p to r if i > n₁ A[k] = R[j] j = j + 1 else if j > n₂ A[k] = L[i] i = i + 1 else if L[i] ≤ R[j] A[k] = L[i] i = i + 1 else A[k] = R[j] j = j + 1 ================================================ FILE: other/clrs/02/03/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" TEST(trivial_case) { int expected[] = {1}, actual[] = {1}; merge_sort(actual, 0, 1); ASSERT_SAME_ARRAYS(actual, expected); } TEST(chapter_example) { int expected[] = {1, 2, 2, 3, 4, 5, 6, 7}, actual[] = {5, 2, 4, 7, 1, 3, 2, 6}; merge_sort(actual, 0, 7); ASSERT_SAME_ARRAYS(actual, expected); } TEST(exercise_example) { int expected[] = {3, 9, 26, 38, 41, 49, 52, 57}, actual[] = {3, 41, 52, 26, 38, 57, 9, 49}; merge_sort(actual, 0, 7); ASSERT_SAME_ARRAYS(actual, expected); } TEST(reversed_merge) { int actual[] = {5, 6, 7, 8, 9, 0, 1, 2, 3, 4}, expected[] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}; merge_sort(actual, 0, 9); ASSERT_SAME_ARRAYS(actual, expected); } ================================================ FILE: other/clrs/02/03/03.markdown ================================================ > Use mathematical induction to show that when $n$ is an exact power of 2, the > solution of the recurrence > > $$ T(n) = \begin{cases} > 2 & \text{if } n = 2, \\\\ > 2T(n/2) + n & \text{if } n = 2^k, \text{for } k > 1. > \end{cases} $$ > > is $T(n) = n\lg{n}$ Boy, this is going to be a lot of $\LaTeX$. First, let's establish a function on which we're going to perform induction: $$ F(k) = T(2^k) $$ We want to prove that: $$ F(k) = 2^k \lg{2^k} $$ **Base.** It is simple enough: $$ F(1) = T(2) = 2 = 2\lg2 = 2^1\lg{2^1} $$ **Step.** We assume that: $$ F(k) = 2^k \lg{2^k} $$ We prove it for $k + 1$: $$ \begin{aligned} F(k + 1) & = T(2^{k+1})= 2T(\frac{2^{k+1}}{2}) + 2^{k+1} = \\\\ & = 2T(2^k) + 2^{k+1} = 2 \cdot 2^k \lg{2^k} + 2^{k+1} = \\\\ & = 2^{k+1}(\lg{2^k} + 1) = 2^{k+1}(\lg{2^k} + \lg2) = \\\\ & = 2^{k+1}\lg{2^{k+1}} \end{aligned} $$ □ ================================================ FILE: other/clrs/02/03/04.markdown ================================================ > We can express insertion sort as a recursive procedure as follows. In order > to sort $A[1..n]$, we recursively sort $A[1..n-1]$ and then insert $A[n]$ > into the sorted array $A[1..n-1]$. Write a recurrence for the running time > of this recursive version of insertion sort. The recurrence is $$ T(n) = \begin{cases} \Theta(1) & \text{if } n = 1, \\\\ T(n-1) + C(n-1) & \text{otherwise}. \end{cases} $$ where $C(n)$ is the time to insert an element in a sorted array of $n$ elements. ================================================ FILE: other/clrs/02/03/05.c ================================================ // Indices in the C code are different int binary_search(int A[], int length, int v) { int low = 0; int high = length; int mid; while (low < high) { mid = (low + high) / 2; if (A[mid] == v) return mid; else if (A[mid] < v) low = mid + 1; else high = mid; } return -1; } ================================================ FILE: other/clrs/02/03/05.markdown ================================================ > Referring back to the searching problem (see Exercise 2.1-3), observe that > if the sequence A is sorted, we can check the midpoint of the sequence > against $\nu$ and eliminate half of the sequence from further consideration. > The **binary search** algorithm repeats this procedure, halving the size of > the remaining portion of the sequence each time. Write pseudocode, either > iterative or recursive, for binary search. Argue that the worst-case running > time of binary search is $\Theta(\lg{n})$. Here's the presudocode: BINARY-SEARCH(A, v): low = 1 high = A.length while low <= high mid = (low + high) / 2 if A[mid] == v return mid if A[mid] < v low = mid + 1 else high = mid - 1 return NIL The argument is fairly straightforward and I will make it brief: $$ T(n+1) = T(n/2) + c $$ This is the recurrence shown in the chapter text, and we know, that this is logarithmic time. ================================================ FILE: other/clrs/02/03/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" TEST(array_empty) { int array[] = {}; int length = 0; ASSERT_EQUALS(binary_search(array, length, 1), -1); } TEST(array_one_element) { int array[] = {1}; int length = 1; ASSERT_EQUALS(binary_search(array, length, 1), 0); ASSERT_EQUALS(binary_search(array, length, 0), -1); ASSERT_EQUALS(binary_search(array, length, 2), -1); } TEST(array_odd_elements) { int array[] = {2, 4, 6, 8, 10}; int length = 5; ASSERT_EQUALS(binary_search(array, length, 2), 0); ASSERT_EQUALS(binary_search(array, length, 4), 1); ASSERT_EQUALS(binary_search(array, length, 6), 2); ASSERT_EQUALS(binary_search(array, length, 8), 3); ASSERT_EQUALS(binary_search(array, length, 10), 4); ASSERT_EQUALS(binary_search(array, length, 1), -1); ASSERT_EQUALS(binary_search(array, length, 3), -1); ASSERT_EQUALS(binary_search(array, length, 5), -1); ASSERT_EQUALS(binary_search(array, length, 7), -1); ASSERT_EQUALS(binary_search(array, length, 9), -1); ASSERT_EQUALS(binary_search(array, length, 11), -1); } TEST(array_even_elements) { int array[] = {2, 4, 6, 8, 10, 12}; int length = 6; ASSERT_EQUALS(binary_search(array, length, 2), 0); ASSERT_EQUALS(binary_search(array, length, 4), 1); ASSERT_EQUALS(binary_search(array, length, 6), 2); ASSERT_EQUALS(binary_search(array, length, 8), 3); ASSERT_EQUALS(binary_search(array, length, 10), 4); ASSERT_EQUALS(binary_search(array, length, 12), 5); ASSERT_EQUALS(binary_search(array, length, 1), -1); ASSERT_EQUALS(binary_search(array, length, 3), -1); ASSERT_EQUALS(binary_search(array, length, 5), -1); ASSERT_EQUALS(binary_search(array, length, 7), -1); ASSERT_EQUALS(binary_search(array, length, 9), -1); ASSERT_EQUALS(binary_search(array, length, 11), -1); ASSERT_EQUALS(binary_search(array, length, 13), -1); } ================================================ FILE: other/clrs/02/03/06.markdown ================================================ > Observe that the while loop line 5-7 of the *INSERTION-SORT* procedure in > Section 2.1 uses a linear search to scan (backward) through the sorted > subarray $A[i..j-1]$. Can we use a binary search (see Exercise 2.3-5) > instead to improve the overall worst-case running time of insertion sort to > $\Theta(n\lg{n})$? No. Even if it finds the position in logarithmic time, it still needs to shift all elements after it to the right, which is linear in the worst case. It will perform the same number of swaps, although it would reduce the number of comparisons. ================================================ FILE: other/clrs/02/03/07.markdown ================================================ > ★ Describe a $\Theta(n\lg{n})$-time algorithm that, given a set $S$ of $n$ > integers and another integer $x$, determines whether or not there exists two > elements of $S$ whose sum is exactly $x$. First we sort $S$. Afterwards, we iterate it and for each element $i$ we perform a binary search to see if there is an element equal to $x - i$. If one is found, the algorithm returns true. Otherwise, it returns false. We iterate $n$ elements and perform binary search for each on in an $n$-sized array, which leads to $\Theta(n\lg{n})$-time. If we sort first (with merge sort) it will introduce another $\Theta(n\lg{n})$ time, that would change the constant in the final algorithm, but not the asymptotic time. Here's the pseudocode: PAIR-EXISTS(S, x): A = MERGE-SORT(S) for i = 1 to S.length if BINARY-SEARCH(A, x - S[i]) != NIL return true return false ================================================ FILE: other/clrs/02/problems/01.c ================================================ #include #include #define INSERTION_SORT_TRESHOLD 20 #define SELECTION_SORT_TRESHOLD 15 void merge(int A[], int p, int q, int r) { int i, j, k; int n1 = q - p + 1; int n2 = r - q; #ifdef MERGE_HEAP_ALLOCATION int *L = calloc(n1, sizeof(int)); int *R = calloc(n2, sizeof(int)); #else int L[n1]; int R[n2]; #endif memcpy(L, A + p, n1 * sizeof(int)); memcpy(R, A + q + 1, n2 * sizeof(int)); for(i = 0, j = 0, k = p; k <= r; k++) { if (i == n1) { A[k] = R[j++]; } else if (j == n2) { A[k] = L[i++]; } else if (L[i] <= R[j]) { A[k] = L[i++]; } else { A[k] = R[j++]; } } #ifdef MERGE_HEAP_ALLOCATION free(L); free(R); #endif } void merge_sort(int A[], int p, int r) { if (p < r) { int q = (p + r) / 2; merge_sort(A, p, q); merge_sort(A, q + 1, r); merge(A, p, q, r); } } void insertion_sort(int A[], int p, int r) { int i, j, key; for (j = p + 1; j <= r; j++) { key = A[j]; i = j - 1; while (i >= p && A[i] > key) { A[i + 1] = A[i]; i = i - 1; } A[i + 1] = key; } } void selection_sort(int A[], int p, int r) { int min, temp; for (int i = p; i < r; i++) { min = i; for (int j = i + 1; j <= r; j++) if (A[j] < A[min]) min = j; temp = A[i]; A[i] = A[min]; A[min] = temp; } } void mixed_sort_insertion(int A[], int p, int r) { if (p >= r) return; if (r - p < INSERTION_SORT_TRESHOLD) { insertion_sort(A, p, r); } else { int q = (p + r) / 2; mixed_sort_insertion(A, p, q); mixed_sort_insertion(A, q + 1, r); merge(A, p, q, r); } } void mixed_sort_selection(int A[], int p, int r) { if (p >= r) return; if (r - p < SELECTION_SORT_TRESHOLD) { selection_sort(A, p, r); } else { int q = (p + r) / 2; mixed_sort_selection(A, p, q); mixed_sort_selection(A, q + 1, r); merge(A, p, q, r); } } ================================================ FILE: other/clrs/02/problems/01.markdown ================================================ ## Insertion sort on small arrays in merge sort > Although merge sort runs in $\Theta(\lg{n})$ worst-case time and insertion > sort runs in $\Theta(n^2)$ worst-case time, the constant factors in > insertion sort can make it faster in practice for small problem sizes on > many machines. Thus, it makes sense to **coarsen** the leaves of the > recursion by using insertion sort within merge sort when subproblems become > sufficiently small. Consider a modification to merge sort in which $n/k$ > sublists of length $k$ are sorted using insertion sort and then merged using > the standard merging mechanism, where $k$ is a value to be determined. > > 1. Show that insertion sort can sort the $n/k$ sublists, each of length $k$, > in $\Theta(nk)$ worst-case time. > 2. Show how to merge the sublists in $\Theta(n\lg(n/k))$ worst-case time. > 3. Given that the modified algorithm runs in $\Theta(nk + n\lg(n/k))$ > worst-case time, what is the largest value of $k$ as a function of $n$ > for which the modified algorithm has the same running time as standard > merge sort, in terms of $\Theta$-notation? > 4. How should we choose $k$ in practice? ### 1. Sorting sublists This is simple enough. We know that sorting each list takes $ak^2 + bk + c$ for some constants $a$, $b$ and $c$. We have $n/k$ of those, thus: $$ \frac{n}{k}(ak^2 + bk + c) = ank + bn + \frac{cn}{k} = \Theta(nk) $$ ### 2. Merging sublists This is a bit trickier. Sorting $a$ sublists of length $k$ each takes: $$ T(a) = \begin{cases} 0 & \text{if } a = 1, \\\\ 2T(a/2) + ak & \text{if } a = 2^p, \text{if } p > 0. \end{cases} $$ This makes sense, since merging one sublist is trivial and merging $a$ sublists means splitting dividing them in two groups of $a/2$ lists, merging each group recursively and then combining the results in $ak$ steps, since have two arrays, each of length $\frac{a}{2}k$. I don't know the master theorem yet, but it seems to me that the recurrence is actually $ak\lg{a}$. Let's try to prove this via induction: **Base**. Simple as ever: $$ T(1) = 1k\lg1 = k \cdot 0 = 0 $$ **Step**. We assume that $T(a) = ak\lg{a}$ and we calculate $T(2a)$: $$ \begin{aligned} T(2a) &= 2T(a) + 2ak = 2(T(a) + ak) = 2(ak\lg{a} + ak) = \\\\ &= 2ak(\lg{a} + 1) = 2ak(\lg{a} + \lg{2}) = 2ak\lg(2a) \end{aligned} $$ This proves it. Now if we substitue the number of sublists $n/k$ for $a$: $$ T(n/k) = \frac{n}{k}k\lg{\frac{n}{k}} = n\lg(n/k) $$ While this is exact only when $n/k$ is a power of 2, it tells us that the overall time complexity of the merge is $\Theta(n\lg(n/k))$. ### 3. The largest value of k The largest value is $k = \lg{n}$. If we substitute, we get: $$ \Theta(n\lg{n} + n\lg{\frac{n}{\lg{n}}}) = \Theta(n\lg{n}) $$ If $k = f(n) > \lg{n}$, the complexity will be $\Theta(nf(n))$, which is larger running time than merge sort. ### 4. The value of k in practice It's constant factors, so we just figure out when insertion sort beats merge sort, exactly as we did in exercise 1.2.2, and pick that number for $k$. ### Runtime comparison I'm implemented this in C and in Python. I added selection for completeness sake in the C version. I ran two variants, depending on whether `merge()` allocates its arrays on the stack or on the heap (stack won't work for huge arrays). Here are the results: STACK ALLOCATION ================ merge-sort = 0.173352 mixed-insertion = 0.150485 mixed-selection = 0.165806 HEAP ALLOCATION =============== merge-sort = 1.731111 mixed-insertion = 0.903480 mixed-selection = 1.017437 Here's the results I got from Python: merge-sort = 2.6207s mixed-sort = 1.4959s I can safely conclude that this approach is faster. ================================================ FILE: other/clrs/02/problems/01.py ================================================ from itertools import repeat def insertion_sort(A, p, r): for j in range(p + 1, r + 1): key = A[j] i = j - 1 while i >= p and A[i] > key: A[i + 1] = A[i] i = i - 1 A[i + 1] = key def merge(A, p, q, r): n1 = q - p + 1 n2 = r - q L = list(repeat(None, n1)) R = list(repeat(None, n2)) for i in range(n1): L[i] = A[p + i] for j in range(n2): R[j] = A[q + j + 1] i = 0 j = 0 for k in range(p, r + 1): if i == n1: A[k] = R[j] j += 1 elif j == n2: A[k] = L[i] i += 1 elif L[i] <= R[j]: A[k] = L[i] i += 1 else: A[k] = R[j] j += 1 def merge_sort(A, p, r): if p < r: q = int((p + r) / 2) merge_sort(A, p, q) merge_sort(A, q + 1, r) merge(A, p, q, r) def mixed_sort(A, p, r): if p >= r: return if r - p < 20: insertion_sort(A, p, r) else: q = int((p + r) / 2) mixed_sort(A, p, q) mixed_sort(A, q + 1, r) merge(A, p, q, r) ================================================ FILE: other/clrs/02/problems/01.run.c ================================================ #include #include #include #define SIZE 400000 #define SEED 300 #define MERGE_HEAP_ALLOCATION #include "01.c" #define TIME(message, sort) \ randomize_array(array, SIZE, SEED); \ timer_start_time = clock(); \ sort(array, 0, SIZE - 1); \ printf(message " = %f\n", (double) (clock() - timer_start_time) / CLOCKS_PER_SEC); \ check_sorted(array, SIZE); static clock_t timer_start_time; void randomize_array(int array[], unsigned length, unsigned int seed) { srand(seed); for (unsigned i = 0; i < length; i++) { array[i] = rand() % 1000 + 1; } } void check_sorted(int array[], int length) { for (int i = 1; i < length; i++) { if (array[i - 1] > array[i]) { printf("%d %d %d %d\n", i - 1, i, array[i - 1], array[i]); fprintf(stderr, "...but the array is not sorted!"); exit(1); } } } int main() { int *array = calloc(SIZE, sizeof(int)); TIME("merge-sort ", merge_sort); TIME("merge-insertion", mixed_sort_insertion); TIME("merge-selection", mixed_sort_selection); return 0; } ================================================ FILE: other/clrs/02/problems/01.run.py ================================================ import os.path as path import random import time filename = path.join(path.dirname(__file__), '01.py') exec(open(filename).read()) def report_time(name, func): begin = time.time() func() end = time.time() print("{:} = {:.4f}s".format(name, end - begin)) array = [] random.seed(300) for _ in range(10000): array.append(random.randint(0, 999)) report_time('merge-sort', lambda: merge_sort(array[:], 0, len(array) - 1)) report_time('mixed-sort', lambda: mixed_sort(array[:], 0, len(array) - 1)) ================================================ FILE: other/clrs/02/problems/02.markdown ================================================ ## Correctness of bubblesort > Bubblesort is popular, but inefficient, sorting algorithm. It works by > repeatedly swapping adjancent elements that are out of order. > > BUBBLESORT(A) > for i to A.length - 1 > for j = A.length downto i + 1 > if A[j] < A[j - 1] > exchange A[j] with A[j - 1] > > 1. Let $A'$ denote the output of *BUBBLESORT(A)*. To prove that *BUBBLESORT* > is correct, we need to prove that it terminates and that > > $$ A'[1] \leq A'[2] \leq \cdots \leq A'[n] \tag{2.3}$$ > > where $n = A.length$. In order to show that *BUBBLESORT* actually sorts, > what else do we need to prove? > > 2. State precisely a loop invariant for the **for** loop in lines 2-4, and > prove that this loop invariant holds. Your proof should use the structure > of the loop invariant proof presented in this chapter. > > 3. Using the termination condition of the loop invariant proved in part (2), > state a loop invariant for the **for** loop in lines 1-4 that will allow > you to prove inequality (2.3). Your proof should use the structure of the > loop invariant proof presented in this chapter. > > 4. What is the worst-case running time of bubblesort? How does it compare to > the running time of insertion sort? ### 1. What else? We need to prove that $A'$ consists of the original elements in $A$, although in (possibly) different order. ### 2. Inner loop invariant > At the start of each iteration of the **for** loop of lines 2-4, (1) the > subarray $A[j...]$ consists of elements that were in $A[j...]$ before > entering the inner loop (possibly) in different order and (2) $A[j]$ is the > smallest of those elements. **Initialization:** It holds trivially, because $A[j...]$ consists of only one element and it is the last element of $A$ when execution starts the inner loop. **Maintenance:** On each step, we replace $A[j]$ with $A[j - 1]$ if it is smaller. Because we're only adding the previous element and possibly swapping two values (1) holds. Since $A[j-1]$ becomes the smallest of $A[j]$ and $A[j-1]$ and the loop invariant states that $A[j]$ is the smallest one in $A[j...]$, we know that (2) holds. **Termination:** After the loop terminates, we will get $j = i$. This implies that $A[i]$ is the smallest element of the subarray $A[i...]$ and array contains the original elements in some order. ### 3. Outer loop invariant > At the start of each iteration, $A[1..i-1]$ consists of sorted elements, all > of which are smaller or equal to the ones in $A[i...]$. **Initialization:** Initially we have the empty array, which holds trivially. **Maintenance:** The invariant of the inner loop tells us that on each iteration, $A[i]$ becomes the smallest element of $A[i...]$ while the rest get shuffled. This impliest that at the end of the loop: $$ A[i] < A[k] \text{, for } i < k $$ **Termination:** The loop terminates with $i = n$, where $n$ is the length of the array. Substituting the $n$ for $i$ in the invariant, we have that the subarray $A[1..n]$ consists of the original elements, but in sorted order. This is the entire array, so the entire array is sorted. ### 4. Worst-case running time? The number of comparisons is $$ n - 1, n - 2, \cdots , 1 = \frac{n(n - 1)}{2} $$ Which is a quadratic function. The swaps are at most the same ammount, which means that the worst-case complexity is $\Theta(n^2)$. Insertion sort has the same worst-case complexity. In general, the best-case complexity of both algorithms should be $\Theta(n)$, but this implementation of bubble-sort has $\Theta(n^2)$ best-case complexity. That can be fixed by returning if no swaps happened in an iteration of the outer loop. Furthermore, bubble-sort should be even slower than insertion sort, because the swaps imply a lot more assignments than what insertion sort does. ================================================ FILE: other/clrs/02/problems/03.markdown ================================================ ## Correctness of Horner's rule > The following code fragment implements Horner's rule for evaluating a > polynomial > > $$ \begin{aligned} > P(x) &= \sum_{k=0}^n a_kx^k = \\\\ > &= a_0 + x(a_1 + x(a_2 + \cdots + x(a_{n-1} + xa_n) \cdots)) > \end{aligned} $$ > > given the coefficients $a_0, a_1, \ldots ,a_n$ and a value for $x$: > > y = 0 > for i = n downto 0 > y = aᵢ + x·y > > 1. In terms of $\Theta$-notation, what is the running time of this code > fragment for Horner's rule? > > 2. Write pseudocode to implement the naive polynomial-evaluation algorithm > that computes each term of the polynomial from scratch. What is the > running time of this algorithm? How does it compare to Horner's rule? > > 3. Consider the following loop invariant: > > At the start of each iteration of the **for** loop of lines 2-3, > > > > $$ y = \sum_{k=0}^{n-(i+1)}a_{k+i+1}x^k $$ > > > > Interpret a summation with no terms as equaling 0. Following the > > structure of the loop invariant proof presented in this chapter, use > > this loop invariant to show that, at termination, > > $y = \sum_{k=0}^na_kx^k$. > > 4. Conclude by arguing that the given code fragment correctly evaluates a > polynomial characterized by the coefficients $a_0,a_1,\ldots,a_n$. ### 1. Running time Obviously $\Theta(n)$. ### 2. Naive algorithm We assume that we have no exponentiation in the language. Thus: y = 0 for i = 0 to n m = 1 for k = 1 to i m = m·x y = y + aᵢ·m The running time is $\Theta(n^2)$, because of the nested loop. It is, obviosly, slower. ### 3. The loop invariant **Initialization:** It is pretty trivial, since the summation has no terms, which implies $y = 0$. **Maintenance:** By using the loop invariant, in the end of the $i$-th iteration, we have: $$ \begin{aligned} y &= a_i + x\sum_{k=0}^{n-(i+1)}a_{k+i+1}x^k = a_ix^0 + \sum_{k=0}^{n-i-1}a_{k+i+1}x^{k+1} = \\\\ &= a_ix^0 \sum_{k=1}^{n-i}a_{k+i}x^k = \sum_{k=0}^{n-i}a_{k+i}x^k \end{aligned} $$ **Termination:** The loop terminates at $i = -1$. If we substitute, we get: $$ y = \sum_{k=0}^{n-i-1}a_{k+i+1}x^k = \sum_{k=0}^na_kx^k $$ ### 4. Conclude It should be fairly obvious, but the invariant of the loop is a sum that equals a polynomial with the given coefficients. ================================================ FILE: other/clrs/02/problems/04.c ================================================ #include int merge(int A[], int p, int q, int r) { int i, j, k, inversions = 0; int n1 = q - p + 1; int n2 = r - q; int L[n1]; int R[n2]; for (i = 0; i < n1; i++) L[i] = A[p + i]; for (j = 0; j < n2; j++) R[j] = A[q + j + 1]; for(i = 0, j = 0, k = p; k <= r; k++) { if (i == n1) { A[k] = R[j++]; } else if (j == n2) { A[k] = L[i++]; } else if (L[i] <= R[j]) { A[k] = L[i++]; } else { A[k] = R[j++]; inversions += n1 - i; } } return inversions; } int merge_sort(int A[], int p, int r) { if (p < r) { int inversions = 0; int q = (p + r) / 2; inversions += merge_sort(A, p, q); inversions += merge_sort(A, q + 1, r); inversions += merge(A, p, q, r); return inversions; } else { return 0; } } ================================================ FILE: other/clrs/02/problems/04.markdown ================================================ ## Inversions > Let $A[1..n]$ be an array of $n$ distinct numbers. If $i < j$ and > $A[i] > A[j]$, then the pair $(i, j)$ is called an inversion of $A$. > > 1. List the five inversions in the array $\langle 2, 3, 8, 6, 1 \rangle$. > 2. What array with elements from the set $\lbrace 1, 2, \ldots, n \rbrace$ > has the most inversions? How many does it have? > 3. What is the relationship between the running time of insertion sort and > the number of inversions in the input array? Justify your answer. > 4. Give an algorithm that determines the number of inversions in any > permutation of n elements in $\Theta(n\lg{n})$ worst-case time. (Hint: > Modify merge sort). ### 1. The five inversions $\langle 2, 1 \rangle$, $\langle 3, 1 \rangle$, $\langle 8, 6 \rangle$, $\langle 8, 1 \rangle$ and $\langle 6, 1 \rangle$. ### 2. Array with most inversions It is the reversed array, that is $\langle n, n-1, \ldots , 1 \rangle$. It has $(n-1) + (n-2) + \cdots + 1 = \frac{n(n-1)}{2}$ inversions. ### 3. Relationship with insertion sort Insertion sort performs the body of the inner loop once for each inversion. Due to the nature of the algorithm, on each $k$-th iteration, if $A[1..k]$ has $m$ inversions with $A[k]$, they are in $A[k-m..k-1]$ (since the elements before $k$ are sorted). Thus, the inner loop needs to execute its body $m$ times. This process does not introduce new inversions and each outer loop iteration resolves exactly $m$ inversions, where $m$ is the distance the element is "pushed towards the front of the array". Thus, the running time is $\Theta(n + d)$, where $d$ is the number of inversions ($n$ comes from the outer loop). ### 4. Calculating inversions We just modify merge sort (in exercise 2.3.2) to return the number of inversions: MERGE-SORT(A, p, r): if p < r inversions = 0 q = (p + r) / 2 inversions += merge_sort(A, p, q) inversions += merge_sort(A, q + 1, r) inversions += merge(A, p, q, r) return inversions else return 0 MERGE(A, p, q, r) n1 = q - p + 1 n2 = r - q let L[1..n₁] and R[1..n₂] be new arrays for i = 1 to n₁ L[i] = A[p + i - 1] for j = 1 to n₂ R[j] = A[q + j] i = 1 j = 1 for k = p to r if i > n₁ A[k] = R[j] j = j + 1 else if j > n₂ A[k] = L[i] i = i + 1 else if L[i] ≤ R[j] A[k] = L[i] i = i + 1 else A[k] = R[j] j = j + 1 inversions += n₁ - i return inversions ================================================ FILE: other/clrs/02/problems/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" TEST(trivial_case) { int array[] = {1}, inversions = merge_sort(array, 0, 1); ASSERT_EQUALS(inversions, 0); } TEST(problem_example) { int array[] = {2, 3, 8, 6, 1}, inversions = merge_sort(array, 0, 4); ASSERT_EQUALS(inversions, 5); } TEST(chapter_example) { int array[] = {5, 2, 4, 7, 1, 3, 2, 6}, inversions = merge_sort(array, 0, 7); ASSERT_EQUALS(inversions, 14); } TEST(reversed_array) { int array[] = {9, 8, 7, 6, 5, 4, 3, 2, 1, 0}, inversions = merge_sort(array, 0, 9); ASSERT_EQUALS(inversions, 45); } ================================================ FILE: other/clrs/03/01/01.markdown ================================================ > Let $f(n)$ + $g(n)$ be asymptotically nonnegative functions. Using the basic > definition of $\Theta$-notation, prove that $\max(f(n), g(n)) = \Theta(f(n) + g(n))$. From "asymptotically nonnegative", we can assume that $$\begin{aligned} \exists n_1, n_2: & f(n) \geq 0 & \text{for } n > n_1 \\\\ & g(n) \geq 0 & \text{for } n > n_2 \end{aligned}$$ Let $n_0 = max(n_1, n_2)$. Some obvious things for $n > n_0$: $$ f(n) \leq \max(f(n), g(n)) \\\\ g(n) \leq \max(f(n), g(n)) \\\\ \big(f(n) + g(n)\big)/2 \leq \max(f(n), g(n)) \\\\ \max(f(n), g(n)) \leq f(n) + g(n) $$ From the last two inequalities, we get: $$ 0 \leq \frac{1}{2}\big(f(n) + g(n)\big) \leq \min\big(f(n), g(n)\big) \leq f(n) + g(n) \quad \text{for } n > n_0 $$ Which is the definition of $\Theta(f(n) + g(n))$ with $c_1 = 1/2, c_2 = 1$. ================================================ FILE: other/clrs/03/01/02.markdown ================================================ > Show that for any real constants $a$ and $b$, where $b > 0$, > > $$(n + a)^b = \Theta(n^b)$$ Quite simply: $$(n + a)^b = \binom{n}0n^b + \binom{n}1n^{b-1}b + \cdots + \binom{n}0a^b$$ The most significant term is $n^b$ and this is obviously polynomially tightly bound. ================================================ FILE: other/clrs/03/01/03.markdown ================================================ > Explain why the statement, "The running time of algorithm $A$ is at least > $O(n^2)$ is meaningless. The $O$-notation provides an upper bound. "At least" implies a lower bound. ================================================ FILE: other/clrs/03/01/04.markdown ================================================ > Is $2^{n+1} = O(2^n)$? Is $2^{2n} = O(2^n)$? Yes, because if we choose $2$ for both constants in the $O$-notation definition, we get an equality. No, because $\nexists c: 2^n \cdot 2^n \leq c 2^n$. ================================================ FILE: other/clrs/03/01/05.markdown ================================================ > Prove Theorem 3.1 The theorem states: > For any two functions $f(n)$ and $g(n)$, we have $f(n) = \Theta(g(n))$ if and > only if $f(n) = O(g(n))$ and $f(n) = \Omega(g(n))$. From $f(n) = \Theta(g(n))$, we have that: $$ 0 \leq c_1g(n) \leq f(n) \leq c_2g(n) \quad \text{for } n > n_0$$ We can pick the constants from here and use them in the definitions of $O$ and $\Omega$ to show that both hold. From $f(n) = \Omega(g(n))$ and $f(n) = O(g(n))$: $$ 0 \leq c_3g(n) \leq f(n) \quad \text{for all } n \geq n_1 \\\\ 0 \leq f(n) \leq c_4g(n) \quad \text{for all } n \geq n_2 $$ If we let $n_3 = \max(n_1, n_2)$ and merge the inequalities, we get: $$ 0 \leq c_3g(n) \leq f(n) \leq c_4g(n) \quad \text{for all } n > n_3 $$ Which is the definiition of $\Theta$. ================================================ FILE: other/clrs/03/01/06.markdown ================================================ > Prove that the running time of an algorithm is $\Theta(g(n))$ if and only if > its worst-case running time is $O(g(n))$ and its best-case running time is > $\Omega(g(n))$. If $T_w$ is the worst-case running time and $T_b$ is the best-case running time, we know that: $$ 0 \leq c_1g(n) \leq T_b(n) \quad \text{for } n > n_b \\\\ 0 \leq T_w(n) \leq c_2g(n) \quad \text{for } n > n_w $$ Combining them we get: $$ 0 \leq c_1g(n) \leq T_b(n) \leq T_w(n) \leq c_2g(n) \quad \text{for } n > \max(n_b, n_w) $$ Since the running time is bound between $T_b$ and $T_w$ and the above is the definition of the $\Theta$-notation, we have our proof. ================================================ FILE: other/clrs/03/01/07.markdown ================================================ > Prove $o(g(n)) \cap \omega(g(n))$ is the empty set. From each term we know that for any positive constant $c > 0$: $$ \begin{aligned} \exists & n_1 > 0 : 0 \leq f(n) < cg(n) \\\\ \exists & n_2 > 0 : 0 \leq cg(n) < f(n) \end{aligned} $$ If we pick $n_0 = max(n_1, n_2)$, from the problem definition we get: $$ f(n) < cg(n) < f(n) $$ Which obviously has no solutions. Thus, such function $f(n)$ exists, which means that the intersection is the empty set. ================================================ FILE: other/clrs/03/01/08.markdown ================================================ > We can extend our notation to the case of two parameters $n$ and $m$ that > can go to infinity independently at different rates. For a given function > $g(n, m)$ we denote $O(g(n, m))$ the set of functions: > > $$ \begin{aligned} > O(g(n, m)) = \lbrace f(n, m): > &\text{there exist positive constants } c, n_0, \text{ and } m_0 \\\\ > &\text{such that } 0 \leq f(n, m) \leq cg(n, m) \\\\ > &\text{for all } n \geq n_0 \text{ or } m \geq m_0. \rbrace > \end{aligned} $$ > > Give corresponding definitions for $\Omega(g(n, m))$ and $\Theta(g(n, m))$. In the University of Sofia, we woud have writen that tersely. $$ \begin{aligned} \Omega(g(n, m)) = \lbrace f(n, m): &\text{there exist positive constants } c, n_0, \text{ and } m_0 \\\\ &\text{such that } 0 \leq cg(n, m) \leq f(n, m) \\\\ &\text{for all } n \geq n_0 \text{ or } m \geq m_0. \rbrace \end{aligned} $$ $$ \begin{aligned} \Theta(g(n, m)) = \lbrace f(n, m): &\text{there exist positive constants } c_1, c_2, n_0, \text{ and } m_0 \\\\ &\text{such that } 0 \leq c_1g(n, m) \leq f(n, m) \leq c_2g(n, m) \\\\ &\text{for all } n \geq n_0 \text{ or } m \geq m_0. \rbrace \end{aligned} $$ ================================================ FILE: other/clrs/03/02/01.markdown ================================================ > Show that if $f(n)$ and $g(n)$ are monotonically increasing functions, then > so are the functions $f(n) + g(n)$ and $f(g(n))$, and if $f(n)$ and $g(n)$ > are in addition nonnegative, then $f(n) \cdot g(n)$ is monotonically > increasing. So: $$ f(m) \leq f(n) \quad \text{for } m \leq n \\\\ g(m) \leq f(n) \quad \text{for } m \leq n \\\\ $$ When we combine them, we get: $$ f(m) + g(m) \leq f(n) + g(n) $$ Which proves the first function. Then: $$ f(g(m)) \leq f(g(n)) \quad \text{for } m \leq n $$ This is true, since $g(m) > g(n)$ and $f(n)$ is monotonically increasing. If both functions are nonnegative, then we can multiply the two inequalities and we get: $$ f(m) \cdot g(m) \leq f(n) \cdot g(n) $$ ================================================ FILE: other/clrs/03/02/02.markdown ================================================ > Prove equation (3.16) > > $$ a^{\log_bc} = c^{\log_ba} $$ $$ \begin{aligned} a^{\log_bc} = a^{\frac{\log_ac}{\log_ab}} = \big(a^{\log_ac})^\frac{1}{\log_ab} = c^{\log_ba} \end{aligned} $$ ================================================ FILE: other/clrs/03/02/03.markdown ================================================ > Prove equation (3.19). Also prove that $n! = \omega(2^n)$ and $n! = o(n^n)$. > > $$ \lg(n!) = \Theta(n\lg{n}) \tag{3.19} $$ We use **Stirling's approximation**: $$ \begin{aligned} \lg(n!) &= \lg\Bigg(\sqrt{2\pi{n}}\Big(\frac{n}{e}\Big)^n\Big(1+\Theta(\frac{1}{n})\Big)\Bigg) = \lg\sqrt{2\pi{n}} + \lg\Big(\frac{n}{e}\Big)^n + \lg\Big(1+\Theta(\frac{1}{n})\Big) = \\\\ &= \Theta(\sqrt{n}) + n\lg{\frac{n}{e}} + \lg\Big(\Theta(1) + \Theta(\frac{1}{n})\Big) = \Theta(\sqrt{n}) + \Theta(n\lg{n}) + \Theta(\frac{1}{n}) = \\\\ &= \Theta(n\lg{n}) \end{aligned} $$ The other two are kind of obvious: $$ \forall n > 3: 2^n = \underbrace{2 \cdot 2 \cdot \cdots \cdot 2}_\text{n times} < 1 \cdot 2 \cdot \cdots \cdot n = n! \quad\Rightarrow\quad n! = \omega(2^n) $$ And: $$ \forall n > 1 : n! = 1 \cdot 2 \cdot \cdots n < \underbrace{n \cdot n \cdot \cdots \cdot n}_\text{n times} = n^n \quad \text{for } \quad\Rightarrow\quad n! = o(n^n) $$ ================================================ FILE: other/clrs/03/02/04.markdown ================================================ > $\star$ Is the function $\lceil \lg{n} \rceil!$ polynomially bounded? Is > the function $\lceil \lg\lg{n} \rceil$ polynomially bounded? If we take the definition of polynomially bound: $$ f(n) \leq cn^k $$ and take the logarithm of each side, we get: $$ \lg{f(n)} \leq \lg{c} + k\lg{n} $$ Thus, a function is polynomially bound if $\lg{f(n)} = \Theta(\lg{n})$. If we let $m = \lceil \lg{n} \rceil$, from the previous exercise we know that: $$ \lg{m!} = \Theta(m\lg{m}) = \Theta(\lceil\lg{n}\rceil\lg\lceil\lg{n}\rceil) $$ Thus, it is not polynomially bounded. As for the other, if le let $p = \lceil \lg\lg{n} \rceil$: $$ \begin{aligned} \lg{p!} &= \Theta(p\lg{p}) = \Theta(\lceil\lg\lg{n}\rceil\lg\lceil\lg\lg{n}\rceil) = \Theta(\lg\lg{n}\lg\lg\lg{n}) = o(\lg\lg{n}\lg\lg{n}) \\\\ &= o(\lg^2\lg{n}) = o(\lg{n}) \end{aligned} $$ The last follows from the statement in the chapter that polylogarithmic functions grow slower than polynomial functions. ================================================ FILE: other/clrs/03/02/05.markdown ================================================ > $\star$ Which is asymptotically larger: $\lg(\lg^\*n)$ or $\lg^\*(\lg{n})$. The second, because: $$ \lg^\*(\lg{n}) = \lg^\*n - 1 > \lg(\lg^\*(n)) $$ ================================================ FILE: other/clrs/03/02/06.markdown ================================================ > Show that the golden ratio $\phi$ and its conjugate $\hat \phi$ both satisfy > the equation $x^2 = x + 1$. This is so obvious, that it is painful: $$ \phi^2 - \phi - 1 = \bigg(\frac{1 + \sqrt5}{2}\bigg)^2 - \frac{1 + \sqrt5}{2} - 1 = \frac{1 + 2\sqrt{5} + 5 - 2 - 2\sqrt{5} - 4}{4} = 0$$ And now the conjugate: $$ \hat\phi^2 - \hat\phi - 1 = \bigg(\frac{1 - \sqrt5}{2}\bigg)^2 - \frac{1 - \sqrt5}{2} - 1 = \frac{1 - 2\sqrt{5} + 5 - 2 + 2\sqrt{5} - 4}{4} = 0$$ ================================================ FILE: other/clrs/03/02/07.markdown ================================================ > Proove by induction that the $i$th Fibonacci number satisfies the equality > > $$ F_i = \frac{\phi^i - \hat{\phi^i}}{\sqrt5} $$ I've done this [earlier in plain text](https://github.com/skanev/playground/blob/master/scheme/sicp/01/13.scm). Let's do it properly, in $LaTeX$. **Base**: $$ \frac{\phi^0 - \hat{\phi^0}}{\sqrt{5}} = \frac{1 - 1}{\sqrt{5}} = 0 = F_0 $$ $$ \frac{\phi - \hat{\phi}}{\sqrt{5}} = \frac{1 + \sqrt{5} - 1 + \sqrt{5}}{2\sqrt{5}} = 1 = F_1 $$ **Step**: $$ F_{n + 2} = F_{n + 1} + F_n = \frac{\phi^{n+1} - \hat\phi^{n+1}}{\sqrt{5}} + \frac{\phi^n - \hat{\phi^n}}{\sqrt{5}} = \frac{\phi^n(\phi + 1) - \hat{\phi^n}(\hat\phi + 1)}{\sqrt{5}} = \frac{\phi^n\phi^2 - \hat{\phi^n}\hat{\phi^2}}{\sqrt{5}} = \frac{\phi^{n+2} + \hat\phi^{n+2}}{\sqrt{5}} $$ ================================================ FILE: other/clrs/03/02/08.markdown ================================================ > Show that $k\ln{k} = \Theta(n)$ implies $k = \Theta(n/\ln{n})$. From the symmetry of $\Theta$: $$ k\ln{k} = \Theta(n) \Rightarrow n = \Theta(k\ln{k}) $$ Lets find $\ln{n}$: $$ \ln{n} = \Theta(\ln(k\ln{k})) = \Theta(\ln{k} + \ln\ln{k}) = \Theta(\ln{k})$$ Let's divide the two: $$ \frac{n}{\ln{n}} = \frac{\Theta(k\ln{k})}{\Theta(\ln{k})} = \Theta{\frac{k\ln{k}}{\ln{k}}} = \Theta(k) $$ ================================================ FILE: other/clrs/03/problems/01.markdown ================================================ ## Asymptotic behavior of polynomials > Let > > $$ p(n) = \sum_{i=0}^da_in^i $$ > > where $a_d > 0$, be a degree-$d$ polynomial in $n$, and let $k$ be a > constant. Use the definitions of the asymptotic notations to prove the > following properties. > > 1. If $k \geq d$, then $p(n) = O(n^k)$. > 2. If $k \leq d$, then $p(n) = \Omega(n^k)$. > 3. If $k = d$, then $p(n) = \Theta(n^k)$. > 4. If $k > d$, then $p(n) = o(n^k)$. > 5. If $k < d$, then $p(n) = \omega(n^k)$. This is very boring. I'm just going to examine half of one case, since everything else follows easliy from it. Let's see that $p(n) = O(n^d)$. We need do pick $c = a_d + b$, such that: $$ \sum_{i=0}^d = a_dn^d + a_{d-1}n^{d-1} + \ldots + a_1n + a_0 \leq cn^d $$ When we divide by $n^d$, we get: $$ c = a_d + b \geq a_d + \frac{a_{d-1}}n + \frac{a_{d-2}}{n^2} + \ldots + \frac{a_0}{n^d} $$ Or: $$ b \geq \frac{a_{d-1}}n + \frac{a_{d-2}}{n^2} + \ldots + \frac{a_0}{n^d} $$ If we choose $b = 1$, then we can choose $n_0$ to be: $$ n_0 = \max(da_{d-1}, d\sqrt{a_{d-2}}, \ldots, d\sqrt[d]{a_0}) $$ Now we have $n_0$ and $c$, such that: $$ p(n) \leq cn^d \quad \text{for } n \geq n_0 $$ Which is the definition of $O(n^d)$. By chosing $b = -1$ we can prove the $\Omega(n^d)$ inequality and thus the $\Theta(n^d)$ inequality. It's very similar to proove the other inequalities. ================================================ FILE: other/clrs/03/problems/02.markdown ================================================ ## Relative asymptotic growths > Indicate for each pair of expressions $(A, B)$ in the table below, whether > $A$ is $O$, $o$, $\Omega$, $\omega$, or $\Theta$ of $B$. Assume that $k \geq 1$, > $\epsilon > 0$, and $c > 1$ are constants. Your answer should be in the form > of the table with "yes" or "no" written in each box. | A | B | $O$ | $o$ | $\Omega$ | $\omega$ | $\Theta$ | |:------------:|:-------------:|:---:|:---:|:--------:|:--------:|:--------:| | $\lg^kn$ | $n^\epsilon$ | yes | yes | no | no | no | | $n^k$ | $c^n$ | yes | yes | no | no | no | | $\sqrt{n}$ | $n^{\sin{n}}$ | no | no | no | no | no | | $2^n$ | $2^{n/2}$ | no | no | yes | yes | no | | $n^{\lg{c}}$ | $c^{\lg{n}}$ | yes | no | yes | no | yes | | $\lg(n!)$ | $\lg(n^n)$ | yes | no | yes | no | yes | ================================================ FILE: other/clrs/03/problems/03.markdown ================================================ ## Ordering by asymptotic growth rates > 1. Rank the following functions by order of growth; that is, find an > arrangement $g_1, g_2, \ldots , g_{30}$ of the functions $g_1 = > \Omega(g_2), g_2 = \Omega(g_3), \ldots, g_{29} = \Omega(g_{30}) $. > Partition your list into equivalence classes such that functions $f(n)$ > and $g(n)$ are in the same class if and only if $f(n) = \Theta(g(n))$. > > 2. Give an example of a single nonnegative function $f(n)$ such that for all > functions $g_i(n)$ in part (1), $f(n)$ is neither $O(g_i(n))$ nor > $\Omega(g_i(n))$. > > | | | | | | | > |:-----------------:|:--------------------:|:---------------------:|:---------------:|:----------:|:---------------:| > | $\lg(\lg^*n)$ | $2^{\lg^*n}$ | $(\sqrt{2})^{\lg{n}}$ | $n^2$ | $n!$ | $(\lg{n})!$ | > | $(\frac{3}{2})^n$ | $n^3$ | $\lg^2{n}$ | $\lg(n!)$ | $2^{2^n}$ | $n^{1/\lg{n}}$ | > | $\ln{\ln{n}}$ | $\lg^*n$ | $n \cdot 2^n$ | $n^{\lg\lg{n}}$ | $\ln{n}$ | $1$ | > | $2^{\lg{n}}$ | $(\lg{n})^{\lg{n}}$ | $e^n$ | $4^{\lg{n}}$ | $(n + 1)!$ | $\sqrt{\lg{n}}$ | > | $\lg^*(\lg{n})$ | $2^{\sqrt{2\lg{n}}}$ | $n$ | $2^n$ | $n\lg{n}$ | $2^{2^{n + 1}}$ | Some facts: $$ (\sqrt{2})^{\lg{n}} = \sqrt{n} $$ $$ \sqrt{2}^{\lg{n}} = 2^{1/2\lg{n}} = 2^{\lg{\sqrt{n}}} = \sqrt{n} $$ $$ n! < n^n = 2^{\lg{n^n}} = 2^{n\lg{n}} $$ $$ n^{1/\lg{n}} = n^{\log_n{2}} = 2$$ $$ n^{\lg{\lg{n}}} = (2^{\lg{n}})^{\lg\lg{n}} = (2^{\lg\lg{n}})^{\lg{n}} = (\lg{n})^{\lg{n}} $$ $$ \lg^2{n} = 2^\{\lg{\lg^2{n}}} = o(2^{\sqrt{2\lg{n}}}) $$ The order is thus: 1. $1 = n^{1/\lg{n}}$ 2. $\lg(\lg^*n)$ 3. $\lg^{\*}n \simeq \lg^{\*}(\lg{n})$ 4. $2^{\lg^*n}$ 5. $\ln{\ln{n}}$ 6. $\sqrt{\lg{n}}$ 7. $\ln{n}$ 8. $\lg^2{n}$ 9. $2^{\sqrt{2\lg{n}}}$ 10. $(\sqrt{2})^{\lg{n}}$ 11. $n = 2^{\lg{n}}$ 12. $n\lg{n} \simeq \lg(n!)$ 13. $n^2 = 1 4^{\lg{n}}$ 14. $n^3$ 15. $n^{\lg\lg{n}} = (\lg{n})^{\lg{n}}$ 16. $(\frac{3}{2})^n$ 17. $2^n$ 18. $n \cdot 2^n$ 19. $e^n$ 20. $n!$ 21. $(n + 1)!$ 22. $2^{2^n}$ 23. $2^{2^{n + 1}}$ --- The asked function can be: $$ 2^{2^{(n + 1)\sin{x}}} $$ ================================================ FILE: other/clrs/03/problems/04.markdown ================================================ ## Asymptotic notation properties > Let $f(n)$ and $g(n)$ be asymptotically positive functions. Prove or > disprove each of the following conjectures. > > 1. $ f(n) = O(g(n)) \text{ implies } g(n) = O(f(n)) $ > 2. $ f(n) + g(n) = \Theta(\min(f(n), g(n))) $ > 3. $ f(n) = O(g(n)) \text{ implies } \lg(f(n)) = O(lg(g(n))), \text{ where } > \lg(g(n)) \geq 1 \text{ and } f(n) \geq 1 \text{ for all sufficiently > large n} $ > 4. $ f(n) = O(g(n)) \text{ implies } 2^{f(n)} = O(2^{g(n)}). $ > 5. $ f(n) = O((f(n))^2) $ > 6. $ f(n) = O(g(n)) \text{ implies } g(n) = \Omega(f(n)) $ > 7. $ f(n) = \Theta(f(n/2)) $ > 8. $ f(n) + o(f(n)) = \Theta(f(n)) $ ### a. $ f(n) = O(g(n)) \text{ implies } g(n) = O(f(n)) $ **Incorrect**. It's easy to see that $n = O(n^2)$, but $n^2 \neq O(n)$. ### b. $ f(n) + g(n) = \Theta(\min(f(n), g(n))) $ **Incorrect**. Simply $n^2 + n \neq \Theta(\min(n^2, n)) = \Theta(n) $ ### c. $ f(n) = O(g(n)) \Rightarrow \lg(f(n)) = O(lg(g(n))) \text{ if } \lg(g(n)) \geq 1, f(n) \geq 1 $ **Correct**. We can do this, because $f(n) \geq 1$ after a certain $n \geq n_0$. $$ \exists c, n_0 : \forall n \geq n_0 : 0 \leq f(n) \leq cg(n) \\\\ \Downarrow \\\\ 0 \leq \lg{f(n)} \leq \lg(cg(n)) = \lg{c} + \lg{g(n)}$$ We need to prove that: $$ \lg{f(n)} \leq d\lg{g(n)} $$ We can easily find $d$: $$ d = \frac{\lg{c} + \lg{g(n)}}{\lg{g(n)}} = \frac{\lg{c}}{\lg{g}} + 1 \leq \lg{c} + 1 $$ The last step is valid, because $\lg{g(n)} \geq 1$. ### d. $ f(n) = O(g(n)) \Rightarrow 2^{f(n)} = O(2^{g(n)}). $ **Incorrect**, because $2n = O(n)$, but $2^{2n} = 4^n \neq O(2^n)$. ### e. $ f(n) = O((f(n))^2) $ **Correct**. $0 \leq f(n) \leq cf^2(n)$ is trivial when $f(n) \geq 1$. It would be incorrect if $f(n) < 1$ for all $n$, but we are usually not interested in such functions. ### f. $ f(n) = O(g(n)) \Rightarrow g(n) = \Omega(f(n)) $ **Correct**. From the first, we know that: $$ 0 \leq f(n) \leq cg(n) $$ We need to prove that: $$ 0 \leq df(n) \leq g(n) $$ Which is straightforward with $d = 1/c$. ### g. $ f(n) = \Theta(f(n/2)) $ **Incorrect**. Let's pick $f(n) = 2^{n}$. We will need to prove that: $$ \exists c_1, c_2, n: \forall n \geq n_0 : 0 \leq c_1 \cdot 2^{n/2} \leq 2^n \leq c_2 \cdot 2^{n/2} $$ Which is obviously untrue. ### h. $ f(n) + o(f(n)) = \Theta(f(n)) $ **Correct**. Let $g(n) = o(f(n))$. We need to proove that: $$ c_1f(n) \leq f(n) + g(n) \leq c_2f(n) $$ We know that: $$ \forall c \exists n_0 \forall n \geq n_0 : cg(n) < f(n) $$ Thus, if we pick $c_1 = 1$ and $c_2 = 2$, it holds. ================================================ FILE: other/clrs/03/problems/05.markdown ================================================ ## Variations on $O$ and $\Omega$ > Some authors define $\Omega$ in a slightly different way than we do; let's > use $\mathop{\Omega}^{\infty}$ (read "omega infinity") for this alternative > definition. We say that $f(n) = \mathop{\Omega}^{\infty}(g(n))$ if there > exists a positive constant $c$ such that $f(n) \geq cg(n) \geq 0$ for > infinitely many integers $n$. > > 1. Show that for any two functions $f(n)$ and $g(n)$ that are asymptotically > nonnegative, either $f(n) = O(g(n))$ or $f(n) = > \mathop{\Omega}^{\infty}(g(n))$ or both, whereas this is not true if we > use $\Omega$ in place of $\mathop{\Omega}^{\infty}$. > 2. Describe the potential advantages and disadvantages of using > $\mathop{\Omega}^{\infty}$ instead of $\Omega$ to characterize the > running times of programs. > 3. Some authors also define $O$ in a slightly different manner; let's use > $O'$ for the alternative definition. We say that $f(n) = O'(g(n))$ if and > only if $|f(n)| = O(g(n))$. What happens to each direction of the "if and > only if" in Theorem 3.1 if we substitute $O'$ for $O$ but we still use > $\Omega$? > 4. Some authors define $\tilde{O}$ (read "soft-oh") to mean $O$ with > logarithmic factors ignored: > $$ \tilde{O} = \lbrace f(n) : \exists c > 0, k > 0 n_0 \forall n \geq n_0: 0 \leq f(n) \leq > cg(n)\lg^k(n) \rbrace $$ > Define $\tilde{\Omega}$ and $\tilde{\Theta}$ in a similar manner. Prove > the corresponding analog to Theorem 3.1. ### Omega infinity We need to compare: $$ cg(n) \leq f(n) $$ Either this holds for an infinite number of integers or for a finite one (or zero). If the former, we have $\mathop{\Omega}^{\infty}$. If it is a finite number, then the largest is $n_0$ and we have that: $$ \forall n > n_0: f(n) < cg(n) $$ Which is sufficient for $f(n) = O(g(n))$. Both can hold if $f(n) = g(n)$, obviously. It's not true for $\Omega$, because $n = \mathop{\Omega}^{\infty}(n^{\sin{n}})$, but $n \neq \Omega(n^{\sin{n}})$. ### Potential advantages I can't think of anything meaningful. It lets us reason for functions like $n^{\sin{n}}$, but I'm not sure that lower bound is the most useful thing here. ### $O'$ Theorem 3.1 will change the "if and only if" to "implies", that is, $\Theta \Rightarrow O'$, but not the other way around. This can be illustrated by $f(n) = n \cdot \sin{n}$, which is $O'(n)$, but not $O(n)$ or $\Theta(n)$. ### Soft-oh I'm uncertain how we should define $\tilde{\Omega}$. I assume that $n = \tilde{\Omega}(n\lg{n})$. In that case, $$ \tilde{\Omega} = \lbrace f(n) : \exists c, k, n \forall n > n_0 : 0 \leq cg(n) \lg^{-k}(n) \leq f(n) \rbrace $$ And: $$ \tilde{\Theta} = \lbrace f(n) : \exists c_1, c_2, k_1, k_2, n \forall n > n_0 : 0 \leq c_1g(n) \lg^{-k_1}(n) \leq f(n) \leq c_2g(n) \lg^{k_2}(n)\rbrace $$ Proving the theorem is very trivial. ================================================ FILE: other/clrs/03/problems/06.markdown ================================================ ## Iterated functions > We can apply the iteration operator $\*$ used in the $\lg^\*$ function to any > monotonically increasing function $f(n)$ over the reals. For a given > constant $c \in \mathbb{R}$, we define the iterated function $f_c^*$ by > > $$ f_c^*(n) = min \lbrace i \geq 0 : f^{(i)}(n) \leq c \rbrace $$ > > which need not be well defined in all cases. In other words, the quantity > $f_c^*(n)$ is the number of iterated applications of the function $f$ > required to reduce its argument down to $c$ or less. > > For each of the following functions $f(n)$ and constants $c$, give as tight > a bound as possible on $f_c^*(n)$. | $ f(n) $ | $ c $ | $ f_c^*(n) $ | |:------------:|:-----:|:--------------------------------:| | $ n - 1 $ | $ 0 $ | $ \Theta(n) $ | | $ \lg{n} $ | $ 1 $ | $ \Theta(\lg^*{n}) $ | | $ n / 2 $ | $ 1 $ | $ \Theta(\lg{n}) $ | | $ n / 2 $ | $ 2 $ | $ \Theta(\lg{n}) $ | | $ \sqrt{n} $ | $ 2 $ | $ \Theta(\lg\lg{n}) $ | | $ \sqrt{n} $ | $ 1 $ | *does not converge* | | $ n^{1/3} $ | $ 2 $ | $ \Theta(\log_3{\lg{n}}) $ | | $ n/\lg{n} $ | $ 2 $ | $ \omega(\lg\lg{n}), o(\lg{n}) $ | ================================================ FILE: other/clrs/04/01/01.markdown ================================================ > What does *FIND-MAXIMUM-SUBARRAY* return when all elements of $A$ are > negative? It will return a single-element array with the largest negative integer. ================================================ FILE: other/clrs/04/01/02.markdown ================================================ > Write pseudocode for the brute-force method of solving the maximum-subarray > problem. Your procedure should run in $\Theta(n^2)$ time. FIND-MAX-SUBARRAY(A, low, high) left = 0 right = 0 sum = -∞ for i = low to high current-sum = 0 for j = i to high current-sum += A[j] if sum < current-sum sum = current-sum left = i right = j return (left, right, sum) ================================================ FILE: other/clrs/04/01/03.c ================================================ #include #define CROSSOVER_POINT 37 // A struct to represent the tuple typedef struct { unsigned left; unsigned right; int sum; } max_subarray; // The brute force approach max_subarray find_maximum_subarray_brute(int A[], unsigned low, unsigned high) { max_subarray result = {0, 0, INT_MIN}; for (int i = low; i < high; i++) { int current_sum = 0; for (int j = i; j < high; j++) { current_sum += A[j]; if (result.sum < current_sum) { result.left = i; result.right = j + 1; result.sum = current_sum; } } } return result; } // The divide-and-conquer solution max_subarray find_max_crossing_subarray(int A[], unsigned low, unsigned mid, unsigned high) { max_subarray result = {-1, -1, 0}; int sum = 0, left_sum = INT_MIN, right_sum = INT_MIN; for (int i = mid - 1; i >= (int) low; i--) { sum += A[i]; if (sum > left_sum) { left_sum = sum; result.left = i; } } sum = 0; for (int j = mid; j < high; j++) { sum += A[j]; if (sum > right_sum) { right_sum = sum; result.right = j + 1; } } result.sum = left_sum + right_sum; return result; } max_subarray find_maximum_subarray(int A[], unsigned low, unsigned high) { if (high == low + 1) { max_subarray result = {low, high, A[low]}; return result; } else { unsigned mid = (low + high) / 2; max_subarray left = find_maximum_subarray(A, low, mid); max_subarray right = find_maximum_subarray(A, mid, high); max_subarray cross = find_max_crossing_subarray(A, low, mid, high); if (left.sum >= right.sum && left.sum >= cross.sum) { return left; } else if (right.sum >= left.sum && right.sum >= cross.sum) { return right; } else { return cross; } } } // The mixed algorithm max_subarray find_maximum_subarray_mixed(int A[], unsigned low, unsigned high) { if (high - low < CROSSOVER_POINT) { return find_maximum_subarray_brute(A, low, high); } else { unsigned mid = (low + high) / 2; max_subarray left = find_maximum_subarray_mixed(A, low, mid); max_subarray right = find_maximum_subarray_mixed(A, mid, high); max_subarray cross = find_max_crossing_subarray(A, low, mid, high); if (left.sum >= right.sum && left.sum >= cross.sum) { return left; } else if (right.sum >= left.sum && right.sum >= cross.sum) { return right; } else { return cross; } } } ================================================ FILE: other/clrs/04/01/03.markdown ================================================ > Implement both the brute-force and recursive algorithms for the > maximum-subarray problem on your own computer. What problem size $n_0$ gives > the crossover point at which the recursive algorithm beats the brute-force > algorithm? Then, change the base case of the recursive algorithm to use the > brute-force algorithm whenever the problem size is less than $n_0$. Does > that change the crossover point? On my computer, $n_0$ is 37. If the algorithm is modified to used divide in conquer when $n \geq 37$ and the brute-force approach when $n$ is less, the performance at the crossover point almost doubles. The performance at $n_0 - 1$ stays the same, though (or even gets worse, because of the added overhead). What I find interesting is that if we set $n_0 = 20$ and used the mixed approach to sort $40$ elements, it is still faster than both. ================================================ FILE: other/clrs/04/01/03.run.c ================================================ #include #include #include #include "03.c" #include "../../build/ext/debug_helpers.h" #define SIZE CROSSOVER_POINT * 200 #ifndef SEED #define SEED 300 #endif static clock_t timer_start_time; #define TIME(times, message, subarray, size) \ timer_start_time = clock(); \ for (int i = 0; i < times; i++) { \ answer = subarray(array, 0, size); \ } \ printf(message " = %f\n", (double) (clock() - timer_start_time) / CLOCKS_PER_SEC); \ check_right_answer(expected, answer); void randomize_array(int array[], unsigned length, unsigned int seed) { srand(seed); for (unsigned i = 0; i < length; i++) { array[i] = rand() % 101 - 50; } } void check_right_answer(max_subarray expected, max_subarray actual) { if (expected.sum != actual.sum) { printf("%u %u %d\n", expected.left, expected.right, expected.sum); printf("%u %u %d\n", actual.left, actual.right, actual.sum); fprintf(stderr, "Incorrect result ;(\n"); exit(1); } } int main() { int array[SIZE]; randomize_array(array, SIZE, SEED); max_subarray expected, answer; expected = find_maximum_subarray(array, 0, CROSSOVER_POINT); printf("%d elements, 10000 times...\n", CROSSOVER_POINT); TIME(10000, "brute-force ", find_maximum_subarray_brute, CROSSOVER_POINT); TIME(10000, "divide-and-conquer", find_maximum_subarray, CROSSOVER_POINT); TIME(10000, "mixed ", find_maximum_subarray_mixed, CROSSOVER_POINT); printf("=============================\n"); expected = find_maximum_subarray(array, 0, SIZE); printf("%d elements, 1 time...\n", SIZE); TIME(1, "brute-force ", find_maximum_subarray_brute, SIZE); TIME(1, "divide-and-conquer", find_maximum_subarray, SIZE); TIME(1, "mixed ", find_maximum_subarray_mixed, SIZE); exit(0); } ================================================ FILE: other/clrs/04/01/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" TEST(chapter_example_brute) { int array[] = { 13, -3, -25, 20, -3, -16, -23, 18, 20, -7, 12, -5, -22, 15, -4, 7 }; max_subarray result = find_maximum_subarray_brute(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 7); ASSERT_EQUALS(result.right, 11); ASSERT_EQUALS(result.sum, 43); } TEST(chapter_example_divide_and_conquer) { int array[] = { 13, -3, -25, 20, -3, -16, -23, 18, 20, -7, 12, -5, -22, 15, -4, 7 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 7); ASSERT_EQUALS(result.right, 11); ASSERT_EQUALS(result.sum, 43); } TEST(chapter_example_mixed) { int array[] = { 13, -3, -25, 20, -3, -16, -23, 18, 20, -7, 12, -5, -22, 15, -4, 7 }; max_subarray result = find_maximum_subarray_mixed(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 7); ASSERT_EQUALS(result.right, 11); ASSERT_EQUALS(result.sum, 43); } ================================================ FILE: other/clrs/04/01/04.c ================================================ #include typedef struct { unsigned left; unsigned right; int sum; } max_subarray; max_subarray find_max_crossing_subarray(int A[], unsigned low, unsigned mid, unsigned high) { max_subarray result = {mid + 1, mid, 0}; int sum = 0, left_sum = INT_MIN, right_sum = INT_MIN; for (int i = mid - 1; i >= (int) low; i--) { sum += A[i]; if (sum > left_sum) { left_sum = sum; result.left = i; } } sum = 0; for (int j = mid; j < high; j++) { sum += A[j]; if (sum > right_sum) { right_sum = sum; result.right = j + 1; } } if (left_sum + right_sum < 0) { max_subarray empty = { mid, mid, 0 }; return empty; } else { result.sum = left_sum + right_sum; return result; } } max_subarray find_maximum_subarray(int A[], unsigned low, unsigned high) { if (high == low + 1) { if (A[low] < 0) { max_subarray empty = {low, low, 0}; return empty; } else { max_subarray result = {low, high, A[low]}; return result; } } else { unsigned mid = (low + high) / 2; max_subarray left = find_maximum_subarray(A, low, mid); max_subarray right = find_maximum_subarray(A, mid, high); max_subarray cross = find_max_crossing_subarray(A, low, mid, high); if (left.sum >= right.sum && left.sum >= cross.sum) { return left; } else if (right.sum >= left.sum && right.sum >= cross.sum) { return right; } else { return cross; } } } ================================================ FILE: other/clrs/04/01/04.markdown ================================================ > Suppose we change the definition of the maximum-subarray problem to allow > the result to be an empty subarray, where the sum of the values of an empty > subarray is 0. How would you change any of the algorithms that do not allow > empty subarrays to permit an empty subarray to be the result? We need to modify two things - the base case of the algorithm and the subroutine that finds the maximum subarray crossing the midpoint. The base case needs to return an empty array if `A[low]` is negative. The subroutine needs to return an empty array in case the maximum subarray has a negative sum. ================================================ FILE: other/clrs/04/01/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" TEST(chapter_example) { int array[] = { 13, -3, -25, 20, -3, -16, -23, 18, 20, -7, 12, -5, -22, 15, -4, 7 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 7); ASSERT_EQUALS(result.right, 11); ASSERT_EQUALS(result.sum, 43); } TEST(negative_numbers) { int array[] = { -4, -2, -8, -1, -2, -5 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, result.right); ASSERT_EQUALS(result.sum, 0); } TEST(trivial_case_negative_numbers) { int array[] = { -4 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.sum, 0); ASSERT_EQUALS(result.left, result.right); } TEST(trivial_case_positive_numbers) { int array[] = { 4 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 0); ASSERT_EQUALS(result.right, 1); ASSERT_EQUALS(result.sum, 4); } ================================================ FILE: other/clrs/04/01/05.c ================================================ typedef struct { unsigned left; unsigned right; int sum; } max_subarray; max_subarray find_maximum_subarray(int A[], unsigned low, unsigned high) { max_subarray suffixes[high - low]; suffixes[0].left = low; suffixes[0].right = low + 1; suffixes[0].sum = A[low]; for (int i = low + 1; i < high; i++) { if (suffixes[i - 1].sum < 0) { suffixes[i].left = i; suffixes[i].right = i + 1; suffixes[i].sum = A[i]; } else { max_subarray *previous = &suffixes[i - 1]; suffixes[i].left = previous->left; suffixes[i].right = i + 1; suffixes[i].sum = previous->sum + A[i]; } } max_subarray *max = &suffixes[0]; for (int i = low + 1; i < high; i++) { if (max->sum < suffixes[i].sum) { max = &suffixes[i]; } } return *max; } ================================================ FILE: other/clrs/04/01/05.markdown ================================================ > Use the following ideas to develop a nonrecursive, linear-time algorithm for > the maximum-subarray problem. Start at the left end of the array, and > progress toward the right, keeping track of the maximum subarray seen so > far. Knowing a maximum subarray $A[1..j]$, extend the answer to find a > maximum subarray ending at index $j + 1$ by using the following observation: > a maximum subarray $A[i..j+1]$, for some $1 \leq i \leq j + 1$. Determine a > maximum subarray of the form $A[i..j+1]$ in constant time based on knowing a > maximum subarray ending at index $j$. We need to build an array $S$ that holds the maximum subarrays ending on each index of $A$. That is, $S[j]$ holds information about the maximum subarray ending on $j$. We first loop through the input to build $S$. Afterwards, we do what they suggest in the text. This is $n + n = 2n = \Theta(n)$. ================================================ FILE: other/clrs/04/01/05.test.c ================================================ #include #include #include "05.c" #include "../../build/ext/test.h" TEST(chapter_example) { int array[] = { 13, -3, -25, 20, -3, -16, -23, 18, 20, -7, 12, -5, -22, 15, -4, 7 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 7); ASSERT_EQUALS(result.right, 11); ASSERT_EQUALS(result.sum, 43); } TEST(negative_numbers) { int array[] = { -4, -2, -8, -1, -2, -5 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 3); ASSERT_EQUALS(result.right, 4); ASSERT_EQUALS(result.sum, -1); } TEST(trivial_case_negative_numbers) { int array[] = { -4 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 0); ASSERT_EQUALS(result.right, 1); ASSERT_EQUALS(result.sum, -4); } TEST(trivial_case_positive_numbers) { int array[] = { 4 }; max_subarray result = find_maximum_subarray(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(result.left, 0); ASSERT_EQUALS(result.right, 1); ASSERT_EQUALS(result.sum, 4); } void generate_random_array(int array[], unsigned size, unsigned seed); max_subarray find_maximum_subarray_brute(int A[], unsigned low, unsigned high); TEST(comparison_with_brute_force) { int size = 50; int array[size]; max_subarray expected, actual; for (int i = 0; i < 10000; i++) { generate_random_array(array, size, i); actual = find_maximum_subarray_brute(array, 0, size); expected = find_maximum_subarray(array, 0, size); ASSERT_EQUALS(expected.sum, actual.sum); } } max_subarray find_maximum_subarray_brute(int A[], unsigned low, unsigned high) { max_subarray result = {0, 0, INT_MIN}; for (int i = low; i < high; i++) { int current_sum = 0; for (int j = i; j < high; j++) { current_sum += A[j]; if (result.sum < current_sum) { result.left = i; result.right = j + 1; result.sum = current_sum; } } } return result; } void generate_random_array(int array[], unsigned size, unsigned seed) { srand(seed); for (unsigned i = 0; i < size; i++) { array[i] = rand() % 101 - 50; } } ================================================ FILE: other/clrs/04/02/01.markdown ================================================ > Use Strassen's algorithm to compute the matrix product > > $$ \begin{pmatrix} > 1 & 2 \\\\ > 7 & 5 > \end{pmatrix} > \begin{pmatrix} > 6 & 8 \\\\ > 4 & 2 > \end{pmatrix} $$ > > Show your work. The first matrices are: $$ S_1 = 6 \quad S_2 = 4 \quad S_3 = 12 \quad S_4 = -2 \quad S_5 = 5 \\\\ S_6 = 8 \quad S_7 = -2 \quad S_8 = 6 \quad S_9 = -6 \quad S_{10} = 14 $$ The products are: $$ P_1 = 1 \cdot 6 = 6 \qquad P_2 = 4 \cdot 2 = 8 \\\\ P_3 = 6 \cdot 12 = 72 \qquad P_4 = (-2) \cdot 5 = -10 \\\\ P_5 = 6 \cdot 8 = 48 \qquad P_6 = (-2) \cdot 6 = -12 \\\\ P_7 = (-6) \cdot 14 = -84 $$ The four matrices are: $$ C_{11} = 48 + (-10) - 8 + (-12) = 18 \\\\ C_{12} = 6 + 8 = 14 \\\\ C_{21} = 72 + (-10) = 62 \\\\ C_{22} = 48 + 6 - 72 - (-84) = 66 $$ The result is: $$ \begin{pmatrix} 18 & 14 \\\\ 62 & 66 \end{pmatrix} $$ ================================================ FILE: other/clrs/04/02/02.c ================================================ #include #include // The matrix representation. One structure to fit both a matrix and a // submatrix. typedef struct { int x; int y; int size; int original_size; int *data; } matrix; // Functions to index matrices int get(matrix m, int x, int y) { return m.data[m.original_size * (m.x + x) + m.y + y]; }; void put(matrix m, int x, int y, int value) { m.data[m.original_size * (m.x + x) + m.y + y] = value; }; // Matrix building matrix create_matrix(int size, int *data) { matrix result; result.x = 0; result.y = 0; result.size = size; result.original_size = size; result.data = data; return result; } matrix submatrix(matrix A, int x, int y, int size) { matrix result; result.x = A.x + x; result.y = A.y + y; result.size = size; result.original_size = A.original_size; result.data = A.data; return result; } #define INIT_ON_STACK(m_, size_) \ m_.x = 0; \ m_.y = 0; \ m_.size = size_; \ m_.original_size = size_; \ m_.data = alloca(size_ * size_ * sizeof(int)); // Adding and subtracting matrices void plus(matrix C, matrix A, matrix B) { for (int i = 0; i < C.size; i++) { for (int j = 0; j < C.size; j++) { put(C, i, j, get(A, i, j) + get(B, i, j)); } } } void minus(matrix C, matrix A, matrix B) { for (int i = 0; i < C.size; i++) { for (int j = 0; j < C.size; j++) { put(C, i, j, get(A, i, j) - get(B, i, j)); } } } void add(matrix T, matrix S) { for (int i = 0; i < T.size; i++) { for (int j = 0; j < T.size; j++) { put(T, i, j, get(T, i, j) + get(S, i, j)); } } } void sub(matrix T, matrix S) { for (int i = 0; i < T.size; i++) { for (int j = 0; j < T.size; j++) { put(T, i, j, get(T, i, j) - get(S, i, j)); } } } void zero(matrix m) { for (int i = 0; i < m.size; i++) { for (int j = 0; j < m.size; j++) { put(m, i, j, 0); } } } // A function to print matrices void print_matrix(matrix m) { printf("%dx%d (+%d+%d) (%d)\n", m.size, m.size, m.x, m.y, m.original_size); printf("==============\n"); for (int i = 0; i < m.size; i++) { for (int j = 0; j < m.size; j++) { printf("%4d", get(m, i, j)); } printf("\n"); } printf("\n"); } // Strassen's algorithm void strassen(matrix C, matrix A, matrix B) { int size = A.size, half = size / 2; if (A.size == 1) { put(C, 0, 0, get(A, 0, 0) * get(B, 0, 0)); } else { matrix s1, s2, s3, s4, s5, s6, s7, s8, s9, s10; matrix p1, p2, p3, p4, p5, p6, p7; INIT_ON_STACK(s1, half); INIT_ON_STACK(s2, half); INIT_ON_STACK(s3, half); INIT_ON_STACK(s4, half); INIT_ON_STACK(s5, half); INIT_ON_STACK(s6, half); INIT_ON_STACK(s7, half); INIT_ON_STACK(s8, half); INIT_ON_STACK(s9, half); INIT_ON_STACK(s10, half); INIT_ON_STACK(p1, half); INIT_ON_STACK(p2, half); INIT_ON_STACK(p3, half); INIT_ON_STACK(p4, half); INIT_ON_STACK(p5, half); INIT_ON_STACK(p6, half); INIT_ON_STACK(p7, half); matrix a11 = submatrix(A, 0, 0, half); matrix a12 = submatrix(A, 0, half, half); matrix a21 = submatrix(A, half, 0, half); matrix a22 = submatrix(A, half, half, half); matrix b11 = submatrix(B, 0, 0, half); matrix b12 = submatrix(B, 0, half, half); matrix b21 = submatrix(B, half, 0, half); matrix b22 = submatrix(B, half, half, half); matrix c11 = submatrix(C, 0, 0, half); matrix c12 = submatrix(C, 0, half, half); matrix c21 = submatrix(C, half, 0, half); matrix c22 = submatrix(C, half, half, half); minus(s1, b12, b22); plus(s2, a11, a12); plus(s3, a21, a22); minus(s4, b21, b11); plus(s5, a11, a22); plus(s6, b11, b22); minus(s7, a12, a22); plus(s8, b21, b22); minus(s9, a11, a21); plus(s10, b11, b12); strassen(p1, a11, s1); strassen(p2, s2, b22); strassen(p3, s3, b11); strassen(p4, a22, s4); strassen(p5, s5, s6); strassen(p6, s7, s8); strassen(p7, s9, s10); zero(c11); zero(c12); zero(c21); zero(c22); add(c11, p5); add(c11, p4); sub(c11, p2); add(c11, p6); add(c12, p1); add(c12, p2); add(c21, p3); add(c21, p4); add(c22, p5); add(c22, p1); sub(c22, p3); sub(c22, p7); } } ================================================ FILE: other/clrs/04/02/02.markdown ================================================ > Write pseudocode for Strassen's algorithm Pseudocode is for sissies. Let's write it in C! _60 minutes later:_ OK, bad decision. ================================================ FILE: other/clrs/04/02/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" #include #define SIZE 8 #define CHECKS 1000 #define MAX_ELEMENT_SIZE 10 void multiply(matrix C, matrix A, matrix B) { for (int i = 0; i < C.size; i++) { for (int j = 0; j < C.size; j++) { int result = 0; for (int k = 0; k < C.size; k++) { result += get(A, i, k) * get(B, k, j); } put(C, i, j, result); } } } TEST(random_matches) { int a[SIZE * SIZE]; int b[SIZE * SIZE]; int c[SIZE * SIZE]; int d[SIZE * SIZE]; matrix A = create_matrix(SIZE, a); matrix B = create_matrix(SIZE, b); matrix C = create_matrix(SIZE, c); matrix D = create_matrix(SIZE, d); for (unsigned seed = 0; seed < CHECKS; seed++) { srand(seed); for (int i = 0; i < SIZE; i++) { for (int j = 0; j < SIZE; j++) { put(A, i, j, rand() % MAX_ELEMENT_SIZE); put(B, i, j, rand() % MAX_ELEMENT_SIZE); } } strassen(C, A, B); multiply(D, A, B); for (int i = 0; i < SIZE; i++) { for (int j = 0; j < SIZE; j++) { ASSERT_EQUALS(get(C, i, j), get(D, i, j)); } } } } ================================================ FILE: other/clrs/04/02/03.markdown ================================================ > How would you modify Strassen's algorithm to multiply $n \times n$ matrices > in which $n$ is not an exact power of 2? Show that the resulting algorithm > runs in time $\Theta(n^{\lg7})$. I'm not sure what resulting algorithm we have in mind. In any case, we can just extend it to an $n \times n$ matrix and pad it with zeroes. It's obviously $\Theta(n^{\lg7})$. ================================================ FILE: other/clrs/04/02/04.markdown ================================================ > What is the largest $k$ such that if you can multiply $3 \times 3$ matrices > using $k$ multiplications (not assuming commutativity of multiplication), > then you can multiply $n \times n$ matrices is time $o(n^{\lg7})$? What > would the running time of this algorithm be? If we apply divide and conquer on this, we get the following recurrence: $$ T(n) = kT(n/3) + \Theta(n) $$ The master method tells us that if $k$ is large enough, the complexity of this recurrence is $\Theta(n^{\log_{3}k})$. We need to solve: $$ n^{\log_3k} < n^{\lg7} \\\\ \Downarrow \\\\ \log_3k < \lg7 \\\\ \Downarrow \\\\ k < 3^{\lg7} \approx 21.84986 $$ ================================================ FILE: other/clrs/04/02/05.markdown ================================================ > V. Pan has discovered a way of multiplying $68 \times 68$ matrices using > $132,464$ multiplications, a way of multiplying $70 \times 70$ matrices > using $143,640$ multiplications, and a way of multiplying $72 \times 72$ > matrices using $155,424$ multiplications. Which method yields the best > asymptotic running time when used in a divide-and-conquer > matrix-multiplication algorithm? How does it compare to Strassen's > algorithm? Using what we know from the last exercise, we need to pick the smalles of the following: $$ \log_{68} 132464 \approx 2.795128 \\\\ \log_{70} 143640 \approx 2.795122 \\\\ \log_{72} 155424 \approx 2.795147 $$ The fastest one asymptotically is $70 \times 70$ using $143,640$. ================================================ FILE: other/clrs/04/02/06.markdown ================================================ > How quickly can you multiply a $kn \times n$ matrix by an $n \times kn$ > matrix, using Strassen's algorithm as a subroutine? Answer the same question > with the order of the input matrices reversed. $(kn \times n)(n \times kn)$ produces a $kn \times kn$ matrix. This produces $k^2$ multiplications of $n \times n$ matrices. $(n \times kn)(kn \times n)$ produces an $n \times n$ matrix. This produces $k$ multiplications and $k - 1$ additions. ================================================ FILE: other/clrs/04/02/07.markdown ================================================ > Show how to multiply the complex numbers $a + bi$ and $c + di$ using only > three multiplications of real numbers. The algorithm should take $a$, $b$, > $c$ and $d$ as input and produce the real component $ac - bd$ and the > imaginary component $ad + bc$ separately. Simple enough. The three multiplications are: $$ A = (a + b)(c + d) = ac + ad + bc + bd \\\\ B = ac \quad\qquad C = bd $$ The result is: $$ (B - C) + (A - B - C)i $$ ================================================ FILE: other/clrs/04/03/01.markdown ================================================ > Show that the solution of $T(n) = T(n - 1) + n$ is $O(n^2)$ We guess $T(n) \le cn^2$ for a particular $c$. Then: $$ T(n) \le c(n-1)^2 + n = cn^2 - 2cn + c + n$$ If we pick $c = 1$ we have: $$ n^2 - 2n + 1 + n = n^2 - n + 1 \le n^2 \text{ for } n \ge 1 $$ ================================================ FILE: other/clrs/04/03/02.markdown ================================================ > Show that the solution of $T(n) = T(\lceil n/2 \rceil) + 1$ is $O(\lg{n})$ We guess $T(n) \le c\lg(n - 2)$: $$ T(n) \le c\lg(\lceil n/2 \rceil - 2) + 1 \le c\lg(n/2 + 1 - 2) + 1 \le c\lg((n - 2)/2) + 1 \le c\lg(n - 2) - c\lg2 + 1 \le c\lg(n - 2) $$ ================================================ FILE: other/clrs/04/03/03.markdown ================================================ > We saw that the solution of $T(n) = 2T(\lfloor n/2 \rfloor) + n$ is > $O(n\lg{n})$. Show that the solution of this recurrence is also > $\Omega(n\lg{n})$. Conclude that the solution is $\Theta(n\lg{n})$. First we guess $T(n) \le cn\lg{n}$: $$ \begin{aligned} T(n) & \le 2c\lfloor n/2 \rfloor\lg{\lfloor n/2 \rfloor} + n \\\\ & \le cn\lg(n/2) + n \\\\ & \le cn\lg{n} - cn\lg{2} + n \\\\ & \le cn\lg{n} + (1 - c)n \\\\ & \le cn\lg{n} \\\\ & \text{for } c \ge 0 \end{aligned} $$ Next we guess $T(n) \ge c(n+2)\lg(n+2)$: $$ \begin{aligned} T(n) & \ge 2c(\lfloor n/2 \rfloor + 2)(\lg(\lfloor n/2 \rfloor + 2) + n \\\\ & \ge 2c(n/2 - 1 + 2)(\lg(n/2 - 1 + 2) + n \\\\ & \ge 2c\frac{n+2}{2}\lg\frac{n+2}{2} + n \\\\ & \ge c(n+2)\lg(n+2) - c(n+2)\lg2 + n \\\\ & \ge c(n+2)\lg(n+2) + (1 - c)n - 2c \qquad \text{for } n \ge 2c/(1-c), 0 < c < 1 \\\\ & \ge c(n+2)\lg(n+2) \end{aligned} $$ ================================================ FILE: other/clrs/04/03/04.markdown ================================================ > Show that by making a different inductive hyptohesis, we can overcome the > difficulty with the boundary condition $T(1) = 1$ for recurrence (4.19) > without adjusting the boundary conditions for the inductive proof. We shall make the guess $T(n) \le n\lg{n} + n$: $$ \begin{aligned} T(n) & \le 2(c\lfloor n/2 \rfloor\lg{\lfloor n/2 \rfloor} + \lfloor n/2 \rfloor) + n \\\\ & \le 2c(n/2)\lg(n/2) + 2(n/2) + n \\\\ & \le cn\lg(n/2) + 2n \\\\ & \le cn\lg(n/2) + 2n \\\\ & \le cn\lg{n} - cn\lg{2} + 2n \\\\ & \le cn\lg{n} + (2 - c)n \qquad (c \ge 1)\\\\ & \le cn\lg{n} + n \end{aligned} $$ This time, the boundary condition is: $$ T(1) = 1 \le cn\lg{n} + n = 0 + 1 = 1 $$ ================================================ FILE: other/clrs/04/03/05.markdown ================================================ > Show that $\Theta(n\lg{n})$ is the solution to the "exact" recurrence (4.3) > for merge sort. The recurrence is: $$ T(n) = T(\lfloor n/2 \rfloor) + T(\lceil n/2 \rceil) + \Theta(n) $$ Let's guess $T(n) \le c(n - 2)\lg(n -2)$: $$ \begin{aligned} T(n) & \le c(\lfloor n/2 \rfloor - 2)\lg(\lfloor n/2 \rfloor - 2) + c(\lceil n/2 \rceil -2 )\lg(\lceil n/2 \rceil - 2) + dn \\\\ & \le c(n/2 - 2)\lg(n/2 - 2) + c(n/2 + 1 -2 )\lg(n/2 + 1 - 2) + dn \\\\ & \le c(n/2 - 1)\lg(n/2 - 1) + c(n/2 - 1 )\lg(n/2 - 1) + dn \\\\ & \le c\frac{n-2}{2}\lg\frac{n-2}{2} + c\frac{n-2}{2}\lg\frac{n-2}{2} + dn \\\\ & \le c(n-2)\lg\frac{n-2}{2} + dn \\\\ & \le c(n-2)\lg(n-2) - c(n-2) + dn \\\\ & \le c(n-2)\lg(n-2) + (d - c)n + 2c \qquad (c > d, n > 2c)\\\\ & \le c(n-2)\lg(n-2) \end{aligned} $$ This is $\Theta(n\lg{n})$. $\Omega(n\lg{n})$ is very similar. ================================================ FILE: other/clrs/04/03/06.markdown ================================================ > Show that the solution to $T(n) = 2T(\lfloor n/2 \rfloor + 17) + n$ is > $O(n\lg{n})$ Let's guess $T(n) \le c(n-a)\lg(n-a)$: $$ \begin{aligned} T(n) & \le 2c(\lfloor n/2 \rfloor + 17 - a)\lg(\lfloor n/2 \rfloor + 17 - a) + n \\\\ & \le 2c(n/2 + 1 + 17 - a)\lg(n/2 + 1 + 17 - a) + n \\\\ & \le c(n + 36 - 2a)\lg\frac{n + 36 - 2a}{2} + n \\\\ & \le c(n + 36 - 2a)\lg(n + 36 - 2a) - c(n + 36 - 2a) + n & (c > 1, n > n_0 = f(a))\\\\ & \le c(n + 36 - 2a)\lg(n + 36 - 2a) & (a \ge 36) \\\\ & \le c(n - a)\lg(n - a) \end{aligned} $$ ================================================ FILE: other/clrs/04/03/07.markdown ================================================ > Using the master method in Section 4.5, you can show that the solution to > the recurrence $T(n) = 4T(n/3) + n$ is $T(n) = \Theta(n^{\log_{3}4})$. Show > that a substitution proof with the assumption $T(n) \leq cn^{\log_{3}4}$ > fails. Then show how to subtract off a lower-order term to make the > substitution proof work. First we guess $T(n) \le cn^{\log_3{4}}$. Thus: $$ \begin{aligned} T(n) & \le 4c(n/3)^{\log_3{4}} + n \\\\ & \le cn^{\log_3{4}} + n \end{aligned} $$ Dead-end! Let's guess $T(n) \le cn^{\log_3{4}} - n$. Thus: $$ \begin{aligned} T(n) & \le 4\Big(c(n/3)^{\log_3{4}} - n\Big) + n \\\\ & \le cn^{\log_3{4}} - 4n + n \\\\ & \le cn^{\log_3{4}} - 3n \\\\ & \le cn^{\log_3{4}} - n \end{aligned} $$ We're done! ================================================ FILE: other/clrs/04/03/08.markdown ================================================ > Using the master method in Section 4.5, you can show that the solution to > the recurrence $T(n) = 4T(n/2) + n^2$ is $T(n) = \Theta(n^2)$. Show that a > substitution proof with the assumption $T(n) \leq cn^2$ fails. Then show how > to subtract off a lower-order term to make the substitution proof work. Well: $$ T(n) \le 4c(n/2)^2 + n^2 \leq cn^2 + n^2 \leq (c + 1)n^2 $$ Dead-end! Now we guess $T(n) \le cn^2 - n$: $$ \begin{aligned} T(n) & \le 4\Big(c(n/2)^2 - n/2\Big) + n \\\\ & \le cn^2 - 2n + n \\\\ & \le cn^2 - n \end{aligned} $$ ================================================ FILE: other/clrs/04/03/09.markdown ================================================ > Solve the recurrence $T(n) = 3T(\sqrt{n}) + \log{n}$ by making a change of > variables. Your solution should be asymptotically tight. Do now worry about > whether values are integral. Let's go this way: $$ \begin{aligned} T(n) & = 3T(\sqrt{n}) + \lg{n} & \text{rename } m = \lg{n} \\\\ T(2^m) & = 3T(2^{m/2}) + m \\\\ S(m) & = 3S(m/2) + m \end{aligned} $$ Now we guess $S(m) \le cm^{\lg{3}} + dm$: $$ \begin{aligned} S(m) & \le 3\Big(c(m/2)^{\lg{3}} + d(m/2)\Big) + m \\\\ & \le cm^{\lg{3}} + (\frac{3}{2}d + 1)m & (d \le -2) \\\\ & \le cm^{\lg{3}} + dm \end{aligned} $$ Then we guess $S(m) \ge cm^{\lg{3}} + dm$: $$ \begin{aligned} S(m) & \ge 3\Big(c(m/2)^{\lg{3}} + d(m/2)\Big) + m \\\\ & \ge cm^{\lg{3}} + (\frac{3}{2}d + 1)m & (d \ge -2) \\\\ & \ge cm^{\lg{3}} + dm \end{aligned} $$ Thus: $$ \begin{aligned} S(m) & = \Theta(m^{\lg{3}}) \\\\ T(n) & = \Theta(\lg^{\lg{3}}{n}) \end{aligned} $$ ================================================ FILE: other/clrs/04/04/01.dot ================================================ digraph tree { node[shape=none]; edge[dir=none]; { rank=same; a1[label="n"] as[label="n"] } { rank=same; b1[label="n/2"]; b2[label="n/2"]; b3[label="n/2"]; bs[label="3n/2"]; } { rank=same; c1[label="n/4"]; c2[label="n/4"]; c3[label="n/4"]; c4[label="n/4"]; c5[label="n/4"]; c6[label="n/4"]; c7[label="n/4"]; c8[label="n/4"]; c9[label="n/4"]; cs[label="9n/4"]; } { rank=same; z1[label="T(1)"]; z2[label="T(1)"]; z3[label="T(1)"]; z4[label="T(1)"]; z5[label="T(1)"]; z6[label="T(1)"]; z7[label="T(1)"]; z8[label="T(1)"]; z9[label="T(1)"]; zs[label="(3/2)ⁱn"]; } a1 -> b1; a1 -> b2; a1 -> b3; b1 -> c1; b1 -> c2; b1 -> c3; b2 -> c4; b2 -> c5; b2 -> c6; b3 -> c7; b3 -> c8; b3 -> c9; { edge[style=dotted] c1 -> z1; c2 -> z2; c3 -> z3; c4 -> z4; c5 -> z5; c6 -> z6; c7 -> z7; c8 -> z8; c9 -> z9; } { edge[style=invis] as -> bs -> cs -> zs; } } ================================================ FILE: other/clrs/04/04/01.markdown ================================================ > Use a reccursion tree to determine a good asymptotic upper bound on the > recurrence $T(n) = 3T(\lfloor n/2 \rfloor) + n$. Use the substitution method > to verify your answer. Let's just ignore the floor, it makes no difference whatsoever. The tree is of depth $\lg{n}$ and has $\Theta(3^{\lg{2}}) = \Theta(2^{\lg{n}})$ leaves. Thus: $$ \begin{aligned} T(n) &= \sum_{i=0}^{\lg{n}-1}\Big(\frac{3}{2}\Big)^i n + \Theta(n^{\lg3}) \\\\ &= n\frac{(3/2)^{\lg{n}} - 1}{(3/2) - 1} + \Theta(n^{\lg3}) \\\\ &= n\Theta(n^{\lg3 - 1}) + \Theta(n^{\lg3}) \\\\ &= \Theta(n^{\lg3}) \end{aligned} $$ Let's use substitution. We guess $T(n) \le cn^{\lg3} + 2n$ (and drop the floor): $$ \begin{aligned} T(n) & \le 3c(n/2)^{\lg3} + 2n/2 + n \\\\ & \le cn^{\lg3} + 2n \\\\ & = \Theta(n^{\lg3}) \end{aligned} $$ ================================================ FILE: other/clrs/04/04/02.dot ================================================ digraph tree { node[shape=none]; edge[dir=none]; a1[label="n²"]; b1[label="n²/4"]; c1[label="n²/16"]; { rank=same z1[label="T(1)"]; zs[label="n²/4ⁱ"]; } a1 -> b1 -> c1; { edge[style=dotted] c1 -> z1; } } ================================================ FILE: other/clrs/04/04/02.markdown ================================================ > Use a reccursion tree to determine a good asymptotic upper bound on the > recurrence $T(n) = T(n/2) + n^2$. Use the substitution method to verify your > answer. Each level of the tree is $n^2/4^i$, there are $\lg{n}$ levels and 1 leaf. Thus: $$ T(n) = \sum_{i=0}^{\lg{n}-1}\Big(\frac{1}{4}\Big)^i n^2 + 1 < n^2 \sum_{i=0}^{\infty}\Big(\frac{1}{4}\Big)^i + 1 = n^2 \frac{1}{1-1/4} + 1 = \Theta(n^2) $$ We guess $T(n) \le cn^2$ $$ \begin{aligned} T(n) & \le c(n/2)^2 + n^2 \\\\ & \le cn^2/4 + n^2 \\\\ & \le (c/4 + 1)n^2 \qquad (c > 4/3) \\\\ & \le cn^2 \end{aligned} $$ ================================================ FILE: other/clrs/04/04/03.dot ================================================ digraph tree { node[shape=none, margin=0.0001]; edge[dir=none]; { rank=same; a1[label="n"] as[label="n"] } { rank=same; b1[label="n/2 + 2"]; b2[label="n/2 + 2"]; b3[label="n/2 + 2"]; b4[label="n/2 + 2"]; bs[label="2n"]; } { rank=same; c1[label="n/4 + 1"]; c2[label="n/4 + 1"]; c3[label="n/4 + 1"]; c4[label="n/4 + 1"]; c5[label="n/4 + 1"]; c6[label="n/4 + 1"]; c7[label="n/4 + 1"]; c8[label="n/4 + 1"]; c9[label="n/4 + 1"]; c10[label="n/4 + 1"]; c11[label="n/4 + 1"]; c12[label="n/4 + 1"]; c13[label="n/4 + 1"]; c14[label="n/4 + 1"]; c15[label="n/4 + 1"]; c16[label="n/4 + 1"]; cs[label="4n"]; } { rank=same; z1[label="T(1)"]; z2[label="T(1)"]; z3[label="T(1)"]; z4[label="T(1)"]; z5[label="T(1)"]; z6[label="T(1)"]; z7[label="T(1)"]; z8[label="T(1)"]; z9[label="T(1)"]; z10[label="T(1)"]; z11[label="T(1)"]; z12[label="T(1)"]; z13[label="T(1)"]; z14[label="T(1)"]; z15[label="T(1)"]; z16[label="T(1)"]; zs[label="2ⁱn + 2¹⁻ⁱ"]; } a1 -> b1; a1 -> b2; a1 -> b3; a1 -> b4; b1 -> c1; b1 -> c2; b1 -> c3; b1 -> c4; b2 -> c5; b2 -> c6; b2 -> c7; b2 -> c8; b3 -> c9; b3 -> c10; b3 -> c11; b3 -> c12 b4 -> c13; b4 -> c14; b4 -> c15; b4 -> c16 { edge[style=dotted] c1 -> z1; c2 -> z2; c3 -> z3; c4 -> z4; c5 -> z5; c6 -> z6; c7 -> z7; c8 -> z8; c9 -> z9; c10 -> z10; c11 -> z11; c12 -> z12; c13 -> z13; c14 -> z14; c15 -> z15; c16 -> z16; } { edge[style=invis] as -> bs -> cs -> zs; } } ================================================ FILE: other/clrs/04/04/03.markdown ================================================ > Use a reccursion tree to determine a good asymptotic upper bound on the > recurrence $T(n) = 4T(n/2 + 2) + n$. Use the substitution method to verify > your answer. With some simplification, the height of the tree is $\lg{n}$, each level adds up to $2^i n + 2^{1-i}$ and there are $4^{\lg{n}} = n^2$ leaves. We get: $$ \begin{aligned} T(n) &= \sum_{i=0}^{\lg{n}-1}\Big(2^i n + 2^{1-i}) + \Theta(n^2) \\\\ &= \sum_{i=0}^{\lg{n}-1}2^i n + \sum_{i=0}^{\lg{n}-1}2^{1-i} + \Theta(n^2) \\\\ &= \frac{2^{\lg{n}} - 1}{2 - 1} + 2\sum_{i=0}^{\lg{n}-1}\Big(\frac{1}{2}\Big)^i + \Theta(n^2) \\\\ &\le n - 1 + 2\sum_{i=0}^{\infty}\Big(\frac{1}{2}\Big)^i + \Theta(n^2) \\\\ &= n - 1 + 2\frac{1}{1-1/2} + \Theta(n^2) \\\\ &= \Theta(n^2) + n + 3 \\\\ &= \Theta(n^2) \end{aligned} $$ Let's substitute. We guess $T(n) \le cn^2 + 2n$: $$ \begin{aligned} T(n) & \le 4c(n/2)^2 + 2n/2 + n \\\\ & \le cn^2 + 2n \\\\ & = \Theta(n^2) \end{aligned} $$ ================================================ FILE: other/clrs/04/04/04.dot ================================================ digraph tree { node[shape=none, margin=0.0001]; edge[dir=none]; { rank=same; a1[label="1"] as[label="1"] } { rank=same; b1[label="1"] b2[label="1"] bs[label="2"] } { rank=same; c1[label="1"] c2[label="1"] c3[label="1"] c4[label="1"] cs[label="4"] } { rank=same; z1[label="T(1)"] z2[label="T(1)"] z3[label="T(1)"] z4[label="T(1)"] zs[label="2ⁱ"] } a1 -> b1; a1 -> b2; b1 -> c1; b1 -> c2; b2 -> c3; b2 -> c4; { edge[style=dotted]; c1 -> z1; c2 -> z2; c3 -> z3; c4 -> z4; } { edge[style=invis]; as -> bs -> cs -> zs; } } ================================================ FILE: other/clrs/04/04/04.markdown ================================================ > Use a reccursion tree to determine a good asymptotic upper bound on the > recurrence $T(n) = 2T(n - 1) + 1$. Use the substitution method to verify your > answer. The depth is $n$, each level is $2^i$ and there are $2^n$ leaves. Thus: $$ T(n) = \sum_{i=0}^{n-1}2^i + \Theta(2^n) = \frac{2^n - 1}{2 - 1} + \Theta(2^n) = \Theta(2^n) + 2^n - 1 = \Theta(2^n) $$ We guess $T(n) \le c2^n + n$. Thus: $$ \begin{aligned} T(n) & \le 2c2^{n-1} + (n - 1) + 1 \\\\ & \le c2^n + n \\\\ & = O(2^n) \end{aligned} $$ ================================================ FILE: other/clrs/04/04/05.markdown ================================================ > Use a reccursion tree to determine a good asymptotic upper bound on the > recurrence $T(n) = T(n-1) + T(n/2) + n$. Use the substitution method to > verify your answer. This is a curious one. The tree makes it look like it is exponential in the worst case. The tree is not full (not a complete binary tree of height $n$), but it is not polynomial either. It's easy to show $\Omega(n^2)$ and $O(2^n)$: We guess $T(n) \le c2^n - 4n$: $$ \begin{aligned} T(n) & \le c2^{n-1} - 4(n-1) + c2^{n/2} - 4n/2 + n \\\\ & \le c(2^{n-1} + 2^{n/2}) - 5n + 1 & (n > 1/4) \\\\ & \le c(2^{n-1} + 2^{n/2}) - 4n & (n > 2)\\\\ & \le c(2^{n-1} + 2^{n-1}) - 4n \\\\ & \le c2^n - 4n \\\\ & = O(2^n) \end{aligned} $$ We guess $T(n) \ge cn^2$: $$ \begin{aligned} T(n) & \ge c(n - 1)^2 + c(n/2)^2 + n \\\\ & \ge cn^2 - 2cn + 1 + cn^2/4 + n \\\\ & \ge (5/4)cn^2 + (1 - 2c)n + 1 \\\\ & \ge cn^2 + (1 - 2c)n + 1 & (c < 1/2)\\\\ & \ge cn^2 \\\\ & = O(n^2) \end{aligned} $$ As to more details - I am lost. ================================================ FILE: other/clrs/04/04/06.markdown ================================================ > Argue that the solution to the recurrence $T(n) = T(n/3) + T(2n/3) + cn$, > where $c$ is a constant, is $\Omega(n\lg{n})$ by appealing to the recurrsion > tree. The shortest path to a leaf has $\log_3{n}$ levels. The cost at each level is $cn$. If we cut the tree right below the first leaf, we are left with complexity of $cn\log_3{n}$, which is $\Omega(n\lg{n})$. ================================================ FILE: other/clrs/04/04/07.dot ================================================ digraph tree { node[shape=none, margin=0.0001]; edge[dir=none]; { rank=same; a1[label="cn"]; as[label="cn"] } { rank=same; b1[label="cn/2"]; b2[label="cn/2"]; b3[label="cn/2"]; b4[label="cn/2"]; bs[label="2cn"] } { rank=same; c1[label="cn/4"]; c2[label="cn/4"]; c3[label="cn/4"]; c4[label="cn/4"]; c5[label="cn/4"]; c6[label="cn/4"]; c7[label="cn/4"]; c8[label="cn/4"]; c9[label="cn/4"]; c10[label="cn/4"]; c11[label="cn/4"]; c12[label="cn/4"]; c13[label="cn/4"]; c14[label="cn/4"]; c15[label="cn/4"]; c16[label="cn/4"]; cs[label="4cn"] } { rank=same; z1[label="T(1)"]; z2[label="T(1)"]; z3[label="T(1)"]; z4[label="T(1)"]; z5[label="T(1)"]; z6[label="T(1)"]; z7[label="T(1)"]; z8[label="T(1)"]; z9[label="T(1)"]; z10[label="T(1)"]; z11[label="T(1)"]; z12[label="T(1)"]; z13[label="T(1)"]; z14[label="T(1)"]; z15[label="T(1)"]; z16[label="T(1)"]; zs[label="2ⁱcn"] } a1 -> b1; a1 -> b2; a1 -> b3; a1 -> b4; b1 -> c1; b1 -> c2; b1 -> c3; b1 -> c4; b2 -> c5; b2 -> c6; b2 -> c7; b2 -> c8; b3 -> c9; b3 -> c10; b3 -> c11; b3 -> c12; b4 -> c13; b4 -> c14; b4 -> c15; b4 -> c16; { edge[style=dotted]; c1 -> z1; c2 -> z2; c3 -> z3; c4 -> z4; c5 -> z5; c6 -> z6; c7 -> z7; c8 -> z8; c9 -> z9; c10 -> z10; c11 -> z11; c12 -> z12; c13 -> z13; c14 -> z14; c15 -> z15; c16 -> z16; } { edge[style=invis]; as -> bs -> cs -> zs; } } ================================================ FILE: other/clrs/04/04/07.markdown ================================================ > Draw the recursion tree for $T(n) = 4T(\lfloor n/2 \rfloor) + cn$, where $c$ > is a constant, and provide a tight asymptotic bound on its solution. Verify > your answer with the substitution method. Let's ignore the floor. Previous exercises illustrate how this can be handled. The depth of the tree is $\lg{n}$, each level is $2^icn$ and there are $4^\{\lg{n}} = n^2$ leaves. Thus: $$ T(n) = \sum_{i=0}^{\lg{n}- 1}2^icn + \Theta(n^2) = cn \sum_{i=0}^{\lg{n}-1}2^i + \Theta(n^2) = cn \frac{2^{\lg{n}} - 1}{2 - 1} + \Theta(n^2) = \Theta(n^2) $$ Let's guess $T(n) \le cn^2 + 2cn$: $$ T(n) \le 4c(n/2)^2 + 2cn/2 + cn \le cn^2 + 2cn $$ Let's guess $T(n) \ge cn^2 + 2cn$: $$ T(n) \ge 4c(n/2)^2 + 2cn/2 + cn \ge cn^2 + 2cn $$ ================================================ FILE: other/clrs/04/04/08.dot ================================================ digraph tree { node[shape=none, margin=0.0001]; edge[dir=none]; { rank=same; a1[label="cn"]; as[label="cn"]; } { rank=same; b1[label="c(n - a)"]; b2[label="ca"]; bs[label="cn"]; } { rank=same; c1[label="c(n - 2a)"]; c2[label="ca"]; cs[label="c(n - a)"]; } { rank=same; d1[label="c(n - 3a)"]; d2[label="ca"]; ds[label="c(n - 2a)"]; } { rank=same; z1[label="c(n - ia)"]; z2[label="ca"]; zs[label="c(n - (i - 1)a)"]; } a1 -> b1; a1 -> b2; b1 -> c1; b1 -> c2; c1 -> d1; c1 -> d2; { edge[style=dotted]; d1 -> z1; d1 -> z2; } { edge[style=invis]; as -> bs -> cs -> ds -> zs; } } ================================================ FILE: other/clrs/04/04/08.markdown ================================================ > Use a recursion tree to give an asymptotically tight solution to the > recurrence $T(n) = T(n-a) + T(a) + cn$, where $a \ge 1$ and $c > 0$ are > constants. The tree height is $n/a$ and each level is $c(n-ia)$. Thus: $$ T(n) = \sum_{i=0}^{n/a}c(n-ia) + (n/a)ca = \sum_{i=0}^{n/a}cn - \sum_{i=0}^{n/a}cia + (n/a)ca = cn^2/a - \Theta(n) + \Theta(n) = \Theta(n^2) $$ Another approach is: $$ \begin{aligned} T(n) &= cn + T(a) + T(n - a) + T(a) \\\\ &= cn + ca + c(n-a) + T(a) + T(n - 2a) \\\\ &= cn + c(n-a) + 2ca + c(n - 2a) + T(a) + T(n - 3a) \\\\ &= cn + c(n-a) + c(n - 2a) + c(n - 3a) + T(n - 4a) + 3ca + T(a) \\\\ &= \frac{n(n+1)}{2a} + cn \\\\ &= \Theta(n^2) \end{aligned} $$ We can guess $T(n) \le cn^2$: $$ \begin{aligned} T(n) & \le c(n-a)^2 + ca + cn \\\\ & \le cn^2 - 2acn + ca + cn \\\\ & \le cn^2 - c(2an - a - n) & (a > 1/2, n > 2a) \\\\ & \le cn^2 - cn \\\\ & \le cn^2 \\\\ & = \Theta(n^2) \end{aligned} $$ We can guess $T(n) \ge cn^2$: $$ \begin{aligned} T(n) & \ge c(n-a)^2 + ca + cn \\\\ & \ge cn^2 - 2acn + ca + cn \\\\ & \ge cn^2 - c(2an - a - n) & (a < 1/2, n > 2a) \\\\ & \ge cn^2 + cn \\\\ & \ge cn^2 \\\\ & = \Theta(n^2) \end{aligned} $$ ================================================ FILE: other/clrs/04/04/09.dot ================================================ digraph tree { node[shape=none, margin=0.0001]; edge[dir=none]; { rank=same; a1[label="cn"]; as[label="cn"]; } { rank=same; b1[label="cαn"]; b2[label="c(1-α)n"]; bs[label="cn"]; } { rank=same; c1[label="cα²n"]; c2[label="c(α-1)αn"]; c3[label="cα(α-1)n"]; c4[label="c(1-α)²n"]; cs[label="cn"]; } { rank=same; z1[label="T(1)"]; z2[label="T(1)"]; z3[label="T(1)"]; z4[label="T(1)"]; zs[label="cn"]; } a1 -> b1; a1 -> b2; b1 -> c1; b1 -> c2; b2 -> c3; b2 -> c4; { edge[style=dotted]; c1 -> z1; c2 -> z2; c3 -> z3; c4 -> z4; } { edge[style=invis]; as -> bs -> cs -> zs; } } ================================================ FILE: other/clrs/04/04/09.markdown ================================================ > Use a recursion tree to give an asymptotically tight solution to the > recurrence $T(n) = T(\alpha{n}) + T((1-\alpha)n) + cn$, where $\alpha$ is a > constant in the range $0 < \alpha < 1$, and $c > 0$ is also a constant. We can assume that $\alpha \le 1/2$, since otherwise we can let $\beta = 1 - \alpha$ and solve it for $\beta$. Thus, the depnth of the tree is $\log_{1/\alpha}n$ and each level is $cn$. The leaves ar not obvious, but let's guess they are $\Theta(n)$. $$ T(n) = \sum_{i=0}^{\log_{1/\alpha}n}cn + \Theta(n) = cn\log_{1/\alpha}n + \Theta(n) = \Theta(n\lg{n}) $$ There is another way to show it. Let $\beta = 1 - \alpha$. Thus: $$ \begin{aligned} T(n) = & T(\alpha n) + T(\beta n) + cn \\\\ = & T(\alpha^2 n) + 2T(\alpha \beta n) + T(\beta^2 n) + cn + c \alpha n + c \beta n \\\\ = & T(\alpha^2 n) + 2T(\alpha \beta n) + T(\beta^2 n) + 2cn \\\\ = & T(\alpha^3 n) + T(\alpha^2 \beta n) + c\alpha^2 n + 2T(\alpha^2 \beta n) + 2T(\alpha \beta^2 n) + 2c\alpha\beta n + T(\alpha \beta^2 n) + T(\beta ^ 3 n) + c\beta ^ 2 n + 2cn\\\\ = & T(\alpha^3 n) + 3T(\alpha^2 \beta n) + 3T(\alpha \beta^2 n) + T(\beta^3 n) + c \alpha^2 n + 2c \alpha \beta n + c \beta ^ 2 n + 2cn \\\\ = & T(\alpha^3 n) + 3T(\alpha^2 \beta n) + 3T(\alpha \beta^2 n) + T(\beta^3 n) + 3cn \\\\ = & \ldots \end{aligned} $$ This goes until $\alpha^kn \le 1$, after which we have $T(n) = \mathcal{O}(1) + ckn$. Well: $$ \alpha^k = \frac{1}{n} \Rightarrow \log{\alpha^k} = \log\frac{1}{n} \Rightarrow k\log\alpha = - \log{n} \Rightarrow k = \frac{-\log{n}}{\log\alpha} = \frac{\log{n}}{\log(1/\alpha)} = \log_{1/\alpha}n$$ Let's verify with substitution. We guess $T(n) \le dn\lg{n}$: $$ \begin{aligned} T(n) & \le d \alpha n \lg(\alpha n) + c \beta n \lg(\beta n) + cn \\\\ & \le d \alpha n \lg{n} + d \beta n \lg{n} + d \alpha n \lg\alpha + d \beta n \lg\beta + cn \\\\ & \le d n \lg{n} + \big(d (\alpha \lg\alpha + \beta \lg\beta) + c\big)n & (d(\alpha\lg\alpha + \beta\lg\beta) + c \le 0)\\\\ & \le d n \lg{n} \end{aligned} $$ In this case: $$ d \le -\frac{c}{\alpha\lg\alpha + (1-\alpha)\lg(1-\alpha)}$$ I can't proove it, but $-1 \le \alpha\lg\alpha + \beta\lg\beta\big < 0 $. And the other way around. We guess $T(n) \ge dn\lg{n}$: $$ \begin{aligned} T(n) & \ge d \alpha n \lg(\alpha n) + c \beta n \lg(\beta n) + cn \\\\ & \ge d \alpha n \lg{n} + d \beta n \lg{n} + d \alpha n \lg\alpha + d \beta n \lg\beta + cn \\\\ & \ge d n \lg{n} + \big(d (\alpha \lg\alpha + \beta \lg\beta) + c\big)n & (d(\alpha\lg\alpha + \beta\lg\beta) + c \ge 0)\\\\ & \ge d n \lg{n} \end{aligned} $$ ================================================ FILE: other/clrs/04/05/01.markdown ================================================ > Use the master method to give tight asymptotic bounds for the following > recurrences: > 1. $T(n) = 2T(n/4) + 1$ > 2. $T(n) = 2T(n/4) + \sqrt{n}$ > 3. $T(n) = 2T(n/4) + n$ > 4. $T(n) = 2T(n/4) + n^2$ 1. $\Theta(n^{\log_4{2}}) = \Theta(\sqrt{n})$ 1. $\Theta(n^{\log_4{2}}\lg{n}) = \Theta(\sqrt{n}\lg{n})$ 1. $\Theta(n)$ 1. $\Theta(n^2)$ ================================================ FILE: other/clrs/04/05/02.markdown ================================================ > Professor Caesar wishes to develop a matrix-multiplication algorithm that is > asymptotically faster than Strassen's algorithm. His algorithm will use the > divide-and-conquer method, dividing each matrix into pieces of size > $n/4 \times n/4$, and the divide and combine steps together will take > $\Theta(n^2)$ time. He needs to determine how many subproblems his algorithm > has to create in order to beat Strassen's algorithm. If his algorithm creates > $a$ subproblems, then the recurrence for the running time $T(n)$ becomes > $T(n) = aT(n/4) + \Theta(n^2)$. What is the largest integer value of $a$ for > which Professor Caesar's algorithm would be asymptotically faster than > Strassen's algorithm? To fall in third case of the master theorem, we need to have $a < 16$. In that case, the algorithm will be $T(n) = \Theta(n^2)$. For the second case, with $a = 16$, $T(n) = \Theta(n^2 \log n)$. In the first case of the master theorem, to be faster than Strassen, we need $\log_4{a} < \log_{2}7$, which is $a < 7^2 = 49$. Thus, the largest integer value will be $48$. ================================================ FILE: other/clrs/04/05/03.markdown ================================================ > Use the master method to show that the solution to the binary-search > recurrence $T(n) = T(n/2) + \Theta(1)$ is $T(n) = \Theta(\lg{n})$. (See > exercise 2.3-5 for a description of binary search). $$ a = 1, b = 2 \\\\ f(n) = \Theta(n^{\log_2{1}}) = \Theta(1) \\\\ T(n) = \Theta(\lg{n}) $$ ================================================ FILE: other/clrs/04/05/04.markdown ================================================ > Can the master method be applied to the recurrence $T(n) = 4T(n/2) + n^2\lg{n}$? > Why or why not? Give an asymptotic upper bound for this recurrence. With $a = 4, b = 2$, we have $f(n) = n^2\lg{n} \ne \mathcal{O}(n^{2-\epsilon}) \ne \Omega(n^{2-\epsilon})$, so no - we cannot apply the master method. Let's guess $\Theta(n^2\lg^2{n})$: $$ \begin{aligned} T(n) & \le 4T(n/2) + n^2\lg{n} \\\\ & \le 4c(n/2)^2\lg^2(n/2) + n^2\lg{n} \\\\ & \le cn^2\lg(n/2)\lg{n} - cn^2\lg(n/2)\lg{2} + n^2\lg{n} \\\\ & \le cn^2\lg^2{n} - cn^2\lg{n}\lg{2} - cn^2\lg(n/2) + n^2\lg{n} \\\\ & \le cn^2\lg^2{n} + (1 - c)n^2\lg{n} - cn^2\lg(n/2) & (c > 1) \\\\ & \le cn^2\lg^2{n} - cn^2\lg(n/2) \\\\ & \le cn^2\lg^2{n} \end{aligned} $$ Exercise 4.6-2 is the general case for this. ================================================ FILE: other/clrs/04/05/05.markdown ================================================ > $\star$ Consider the regularity condition $af(n/b) \ge cf(n)$ for some > constant $c < 1$, which is part of case 3 of the master theorem. Give an > example of constants $a \ge 1$ and $b > 1$ and a function $f(n)$ that > satisfies all the conditions in case 3 of the master theorem, except the > regularity condition. $$ a = 1 \\\\ b = 2 \\\\ f(n) = n(2-\cos{n}) $$ Thus, if we try to proove it: $$ \frac{n}{2}(2 - \cos\frac{n}{2}) < cn \\\\ \frac{1 - cos(n/2)}{2} < c \\\\ c \ge 1 - \frac{cos(n/2)}{2} $$ Since $\min\cos(n/2) = -1$, this implies that $c \ge 3/2$. But $c < 1$. ================================================ FILE: other/clrs/04/06/01.markdown ================================================ > $\star$ Give a simple and exact expression for $n_j$ in equation (4.27) for > the case in which $b$ is a positive integer instead of an arbitrary real > number. Some experimentation leas me to: $$ n_j = \lceil n / b^j \rceil $$ An [elaboration][elaboration] can be found on StackExchange. [elaboration]: http://math.stackexchange.com/questions/509862/simple-and-exact-expression-for-n-j-in-the-following-formula ================================================ FILE: other/clrs/04/06/02.markdown ================================================ > $\star$ Show that if $f(n) = \Theta(n^{\log_b{a}}\lg^k{n})$, where $k \ge 0$, > then the master recurrence has solution $T(n) = \Theta(n^{\log_b{a}}\lg^{k+1}n)$. > For simplicity, confine your analysis to exact powers of $b$. $$ g(n) = \sum_{j=0}^{\log_b{n}-1}a^jf(n/b^j) \\\\ f(n/b^j) = \Theta\Big((n/b^j)^{\log_b{a}}\lg^k(n/b^j)\Big) \\\\ g(n) = \Theta\Big(\sum_{j=0}^{\log_b{n}-1}a^j\big(\frac{n}{b^j}\big)^{\log_b{a}}\lg^k\big(\frac{n}{b^j}\big)\Big) = \Theta(A) \\\\ A = \sum_{j=0}^{\log_b{n}-1}a^j\big(\frac{n}{b^j}\big)^{\log_b{a}}\lg^k\frac{n}{b^j} = n^{\log_b{a}}\sum_{j=0}^{\log_b{n}-1}\Big(\frac{a}{b^{\log_b{a}}}\Big)^j\lg^k\frac{n}{b^j} = n^{\log_b{a}}\sum_{j=0}^{\log_b{n}-1}\lg^k\frac{n}{b^j} = n^{\log_b{a}}B\\\\ \lg^k\frac{n}{d} = (\lg{n} - \lg{d})^k = \lg^k{n} + o(\lg^k{n}) \\\\ B = \sum_{j=0}^{\log_b{n}-1}\lg^k\frac{n}{b^j} = \sum_{j=0}^{\log_b{n}-1}\Big(\lg^k{n} - o(\lg^k{n})\Big) = \log_b{n}\lg^k{n} + \log_b{n} \cdot o(\lg^k{n}) = \Theta(\log_b{n}\lg^k{n}) = \Theta(\lg^{k+1}{n}) \\\\ g(n) = \Theta(A) = \Theta(n^{\log_b{a}}B) = \Theta(n^{\log_b{a}}\lg^{k+1}{n}) $$ ================================================ FILE: other/clrs/04/06/03.markdown ================================================ > $\star$ Show that case 3 of the master method is overstated, in the sense > that the regularity condition $af(n/b) \le cf(n)$ for some constant $c < 1$ > implies that there exists a constant $\epsilon > 0$ such that > $f(n) = \Omega(n^{\log_b{a}+\epsilon})$. $$ af(n/b) \le cf(n) \\\\ \alpha f(n/b) \le f(n), \quad \alpha = a/c \\\\ \alpha f(n) \le f(nb) \\\\ \alpha^i f(1) \le f(b^i) \\\\ n = b^i \Rightarrow i = \log_{b}n \Rightarrow f(n) \ge \alpha^{\log_b{n}}f(1) = n^{\log_{b}\alpha} \\\\ \alpha > a \Rightarrow \alpha = a + d \quad (c < 1, d > 0) \\\\ \Rightarrow f(n) = n^{\log_b{a} + log_b{d}} = n^{\log_b{a}+\epsilon} \quad (\epsilon = \log_{b}d) $$ I did not think this up. I had [some help][help] at StackExchange. [help]: http://math.stackexchange.com/questions/510897/why-does-afn-b-cfn-for-c-1-imply-that-fn-omegan-log-ba-ep ================================================ FILE: other/clrs/04/problems/01.markdown ================================================ ## Recurrence examples > Give asymptotic upper and lower bound for $T(n)$ in each of the following > recurrences. Assume that $T(n)$ is constant for $n \le 2$. Make your bounds > as tight as possible, and justify your answers. > > 1. $T(n) = 2T(n/2) + n^4$ > 2. $T(n) = T(7n/10) + n$ > 3. $T(n) = 16T(n/4) + n^2$ > 4. $T(n) = 7T(n/3) + n^2$ > 5. $T(n) = 7T(n/2) + n^2$ > 6. $T(n) = 2T(n/4) + \sqrt{n}$ > 7. $T(n) = T(n - 2) + n^2$ 1. $\Theta(n^4)$ (master method) 2. $\Theta(n)$ (master method, $\log_{10/7}1 = 0$) 3. $\Theta(n^2\lg{n})$ (master method) 4. $\Theta(n^2)$ (master method) 5. $\Theta(n^{\log_2{7}})$ (master method) 6. $\Theta(\sqrt{n}\lg_{n})$ (master method) 7. $\Theta(n^3)$ by the following: $$ \begin{aligned} T(n) &= n^2 + T(n - 2) \\\\ &= n^2 + (n - 2)^2 + T(n - 4) \\\\ &= \sum_{i=0}^{n/2}(n -2i)^2 \\\\ &= n^2 \sum_{i=0}^{n/2} 1 + 4 \sum_{i=0}^{n/2} i^2 - 4n \sum_{i=0}^{n/2} i \\\\ \end{aligned}$$ For the three sums above: $$n^2 \sum_{i=0}^{n/2} 1 = \frac{n^3}{2}$$ $$4 \sum_{i=0}^{n/2} i^2 = \frac{4}{6} \left[\frac{n}{2}\left(\frac{n+2}{2}(n+1)\right)\right] = \frac{1}{3}(2n^3 + 6n^2 + 4n)$$ $$4n \sum_{i=0}^{n/2} i = 4n\left[\frac{1}{2}\frac{n}{2}\left(\frac{n+2}{2}\right)\right] = \frac{1}{2}(n^3 + 2n^2)$$ Now substitute back in these 3 simplifications: $$ \begin{aligned} T(n) &= n^2 \sum_{i=0}^{n/2} 1 + 4 \sum_{i=0}^{n/2} i^2 - 4n \sum_{i=0}^{n/2} i \\\\ &= \frac{n^3}{2} + \frac{1}{3}(2n^3 + 6n^2 + 4n) - \frac{1}{2}(n^3 + 2n^2) \\\\ &= \frac{2}{3}n^3 + n^2 + \frac{4}{3}n \\\\ &= \Theta(n^3) \end{aligned}$$ ================================================ FILE: other/clrs/04/problems/02.markdown ================================================ ## Parameter-passing costs > Throughout this book, we assume that parameter passing during procedure calls > takes constant time, even if an N-element array is being passed. This assumption > is valid in most systems because a pointer to the array is passed, not the array > itself. This problem examines the implications of three parameter-passing strategies: > > 1. An array is passed by pointer. Time $= \Theta(1)$ > 2. An array is passed by copying. Time $= \Theta(N)$, where $N$ is the size of the array. > 3. An array is passed by copying only the subrage that might be accessed by the called > procedure. Time $= \Theta(q - p + 1)$ if the subarray $A[p \ldots q]$ is passed. > > So: > > 1. Consider the recursive binary search algorithm for finding a number in a sorted > array (see Exercise 2.3-5). Give recurrences for the worst-case running times > of binary search when arrays are passed using each of the three methods above, > and give good upper bounds on the solutions of the recurrences. Let $N$ be the > size of the original problems and $n$ be the size of a subproblem. > 2. Redo part (a) for the MERGE-SORT algorithm from Section 2.3.1. ### Binary search 1. $T(n) = T(n/2) + c = \Theta(\lg{n})$ (master method) 2. $T(n) = T(n/2) + cN = 2cN + T(n/4) = 3cN + T(n/8) = \sum_{i=0}^{\lg{n}-1}(2^icN/2^i) = cN\lg{n} = \Theta(n\lg{n})$ 3. $T(n) = T(n/2) + cn = \Theta(n)$ (master method) ### Merge sort 1. $T(n) = 2T(n/2) + cn = \Theta(n\lg{n})$ (master method, duh) 2. $T(n) = 2T(n/2) + cn + 2N = 4N + cn + 2c(n/2) + 4T(n/4) = 8N + 2cn + 4c(n/4) + 8T(n/8) = \\\\ \qquad = \sum_{i=0}^{\lg{n}-1}(cn + 2^iN) = \sum_{i=0}^{\lg{n}-1}cn + N\sum_{i=0}^{\lg{n}-1}2^i = cn\lg{n} + N\frac{2^{\lg{n}} - 1}{2-1} = cn\lg{n} + nN - N = \Theta(nN) \\\\ \qquad = \Theta(n^2) $ 3. $T(n) = 2T(n/2) + cn + 2n/2 = 2T(n/2) + (c+1)n = \Theta(n\lg{n})$ (master method) ================================================ FILE: other/clrs/04/problems/03.markdown ================================================ ## More recurrence examples > Give asymptotic upper and lower bounds for $T(n)$ in each of the following > recurrences. Assume that $T(n)$ is constant for sufficiently small $n$. Make > your bounds as tight as possible, and justify your answers. > > 1. $T(n) = 4T(n/3) + n\lg{n}$ > 2. $T(n) = 3T(n/3) + n/\lg{n}$ > 3. $T(n) = 4T(n/2) + n^2\sqrt{n}$ > 4. $T(n) = 3T(n/3 - 2) + n/2$ > 5. $T(n) = 2T(n/2) + n/\lg{n}$ > 6. $T(n) = T(n/2) + T(n/4) + T(n/8) + n$ > 7. $T(n) = T(n - 1) + 1/n$ > 8. $T(n) = T(n - 1) + \lg{n}$ > 9. $T(n) = T(n - 2) + 1/\lg{n}$ > 10. $T(n) = \sqrt{n}T(\sqrt{n}) + n$ ### 1. $T(n) = 4T(n/3) + n\lg{n}$ $\Theta(n^{\log_3{4}})$ by the master method. ### 2. $T(n) = 3T(n/3) + n/\lg{n}$ It's $\Theta(n\lg\lg{n})$. Check subtask 5 for the reasoning. ### 3. $T(n) = 4T(n/2) + n^2\sqrt{n}$ $\Theta(n^2\sqrt{n}) = \Theta(n^{2.5})$ by the master method ($\log_2{4} = 2 < 2.5$). ### 4. $T(n) = 3T(n/3 - 2) + n/2$ We can ignore the $-2$ and using the master method, we arrive at $\Theta(n\lg{n})$. ### 5. $T(n) = 2T(n/2) + n/\lg{n}$ $$ \begin{aligned} T(n) & = 2T(n/2) + \frac{n}{\lg{n}} = 4(n/4) + 2\frac{n/2}{\lg(n/2)} + \frac{n}{\lg{n}} = 4T(n/4) + \frac{n}{\lg{n} - 1} + \frac{n}{\lg{n}} \\\\ & = nT(1) + \sum_{i=0}^{\lg{n} - 1}\frac{n}{\lg{n}-i} = nT(1) + n\sum_{i=1}^{\lg{n}}\frac{1}{\lg{n}} \\\\ & = \Theta(n\lg\lg{n}) \end{aligned} $$ ### 6. $T(n) = T(n/2) + T(n/4) + T(n/8) + n$ We guess $\Theta(n)$: $$ \begin{aligned} T(n) & = cn/2 + cn/4 + cn/8 + n \le (7/8)cn + n \le cn = O(n) \quad (c \ge 8) \\\\ T(n) & = cn/2 + cn/4 + cn/8 + n \ge (7/8)cn + n \ge cn = \Omega(n) \quad (c \le 8) \end{aligned} $$ ### 7. $T(n) = T(n - 1) + 1/n$ $$ \begin{aligned} T(n) &= T(n-1) + 1/n = \frac{1}{n} + \frac{1}{n-1} + T(n-2) \\\\ &= \frac{1}{n} + \frac{1}{n-1} + \frac{1}{n-2} + T(n-3) \\\\ &= \sum_{i=0}^{n-1}\frac{1}{n-i} = \sum_{i=1}^n\frac{1}{i} = \\\\ &= \Theta(\lg{n}) \end{aligned} $$ ### 8. $T(n) = T(n - 1) + \lg{n}$ $$ \begin{aligned} T(n) &= \lg{n} + T(n-1) = \lg{n} + \lg{n-1} + T(n-2) = \\\\ &= \sum_{i=0}^{n-1}\lg(n - i) = \sum_{i=1}^{n}\lg{i} = \lg(n!) \le \lg{n^n} = n\lg{n} \\\\ &= \Theta(n\lg{n}) \end{aligned} $$ ### 9. $T(n) = T(n - 2) + 1/\lg{n}$ $$ \begin{aligned} T(n) &= \frac{1}{\lg{n}} + \frac{1}{\lg{n-2}} + \ldots \\\\ &= \sum_{i=1}^{n/2}\frac{1}{\lg(2i)} \\\\ &= \sum_{i=1}^{\infty}\frac{1}{\lg{i}} \\\\ &= \Theta(\lg\lg{n}) \end{aligned} $$ ### 10. $T(n) = \sqrt{n}T(\sqrt{n}) + n$ Let $n = 2^m$, or $m = \lg{n}$. We use this to get another recurrence in hopes of being able to use the master theorem on it: $$ \begin{aligned} T(2^m) &= \sqrt{2^m}T(\sqrt{2^m}) + 2^m \\\\ &= 2^{m/2}T(2^{m/2}) + 2^m \\\\ Q(m) &= 2^{m/2} Q(m/2) + 2^m \end{aligned} $$ We still cannot use the master theorem. Now multiply $Q(m)$ by $\frac{1}{2^m}$ to get: $R(m) = R(m/2) + 1$. Now we can use the master theorem to compare $f(n) = 1$ and $n^{log_b a} = n^{log_2 1} = n^0 = 1$. Since $n^{log_b a} = f(n)$: $$ \begin{aligned} R(m) &= \Theta(1 \times \lg{m}) \\\\ Q(m) &= \Theta(2^m \lg{m}) \\\\ T(m) &= \Theta(2^{\lg{n}} \lg{\lg{n}}) \\\\ & = \Theta(n \lg{\lg{n}}) \end{aligned}$$ We verify $T(n) \le cn\lg\lg{n}$: $$ \begin{aligned} T(n) &\le \sqrt{n}c\sqrt{n}\lg\lg\sqrt{n} + n \\\\ & = cn\lg\lg\sqrt{n} + n \\\\ & = cn\lg\frac{\lg{n}}{2} + n \\\\ & = cn\lg\lg{n} - cn\lg{2} + n \\\\ & = cn\lg\lg{n} + (1 - c)n & (c > 1) \\\\ &\le cn\lg\lg{n} & = \Theta(n\lg\lg{n}) \end{aligned} $$ ================================================ FILE: other/clrs/04/problems/04.markdown ================================================ ## Fibonacci numbers > This problem develops properties of the Fibonacci numbers, which are defined > by recurrence (3.22). We shall use the technique of generating functions to > solve the Fibonacci recurrence. Define the generating function (or formal > power series) $\mathcal{F}$ as > > $$ \begin{aligned} > \mathcal{F}(z) &= \sum_{i=0}^{\infty}F_iz^i \\\\ > &= 0 + z + z^2 + 2z^3 + 3z^4 + 5z^5 + 8z^6 + 13z^7 + 21z^8 + \ldots, > \end{aligned} $$ > > where $F_i$ is the $i$th Fibonacci number. > > 1. Show that $\mathcal{F}(z) = z + z\mathcal{F}(z) + z^2\mathcal{F}$. > 2. Show that > $$ \begin{aligned} > \mathcal{F}(z) &= \frac{z}{1 - z - z^2} \\\\ > &= \frac{z}{(1 - \phi z)(1 - \hat\phi z)} \\\\ > &= \frac{1}{\sqrt5}\Big(\frac{1}{1 - \phi z} - \frac{1}{1 - \hat{\phi} z}\Big) > \end{aligned} $$ > where > $$ \phi = \frac{1 + \sqrt5}{2} = 1.61803\ldots \\\\ > \hat\phi = \frac{1 - \sqrt5}{2} = -0.61803\ldots $$ > 3. Show that > $$ \mathcal{F}(z) = \sum_{i=0}^{\infty}\frac{1}{\sqrt5}(\phi^i - \hat{\phi}^i)z^i $$ > 4. Use part (c) to prove that $F_i = \phi^i / \sqrt5$ for $i > 0$, rounded to the nearest > integer. (_Hint:_ Observe that $|\hat{\phi}| < 1$) ### Part 1 $$ \begin{aligned} & z + z\mathcal{F}(z) + z^2\mathcal{F}(Z) = \\\\ & = z + z\sum_{i=0}^{\infty}F_iz^i + z^2\sum_{i=0}^{\infty}F_iz^i \\\\ & = z + \sum_{i=1}^{\infty}F_{i-1}z^i + \sum_{i=2}^{\infty}F_{i-2}z^i \\\\ & = z + F_1z + \sum_{i=2}^{\infty}(F_{i-1} + F_{i-2})z^i \\\\ & = z + F_1z + \sum_{i=2}^{\infty}F_iz^i \\\\ & = \mathcal{F}(z) \end{aligned} $$ ### Part 2 Let's just note that $\phi - \hat\phi = \sqrt5$, $\phi + \hat\phi = 1$ and $\phi\hat\phi = - 1$ (just calculate them): $$ \begin{aligned} \mathcal{F}(z) &= \frac{\mathcal{F}(z)(1 - z - z^2)}{1 - z - z^2} \\\\ &= \frac{\mathcal{F}(z) - z\mathcal{F}(z) - z^2\mathcal{F}(z) - z + z}{1 - z - z^2} \\\\ &= \frac{\mathcal{F}(z) - \mathcal{F}(z) + z}{1 - z - z^2} \\\\ &= \frac{z}{1 - z - z^2} \\\\ &= \frac{z}{1 - (\phi + \hat\phi)z + \phi\hat\phi z^2} \\\\ &= \frac{z}{(1 - \phi z)(1 - \hat\phi z)} \\\\ &= \frac{\sqrt5 z}{\sqrt5 (1 - \phi z)(1 - \hat\phi z)} \\\\ &= \frac{(\phi - \hat\phi)z + 1 - 1}{\sqrt5 (1 - \phi z)(1 - \hat\phi z)} \\\\ &= \frac{(1 - \hat\phi z) - (1 - \phi z)}{\sqrt5 (1 - \phi z)(1 - \hat\phi z)} \\\\ &= \frac{1}{\sqrt5}\Big(\frac{1}{1 - \phi z} - \frac{1}{1 - \hat\phi z}\Big) \\\\ \end{aligned} $$ ### Part 3 We have that: $$ \frac{1}{1 - x} = \sum_{k=0}^{\infty}x^k \quad\text{when } |x| < 1 $$ Thus: $$ \begin{aligned} \mathcal{F}(n) &= \frac{1}{\sqrt5}\Big(\frac{1}{1 - \phi z} - \frac{1}{1 - \hat\phi z}\Big) \\\\ &= \frac{1}{\sqrt5}\Big(\sum_{i=0}^{\infty}\phi^i z^i - \sum_{i=0}^{\infty}\hat{\phi}^i z^i\Big) \\\\ &= \sum_{i=0}^{\infty}\frac{1}{\sqrt5}(\phi^i - \hat{\phi}^i) z^i \end{aligned} $$ ### Part 4 $$ \mathcal{F}(z) = \sum_{i=0}^{\infty}\alpha_iz^i \quad\text{ where } \alpha_i = \frac{\phi^i - \hat{\phi}^i}{\sqrt5} $$ From this follows that $\alpha_i = F_i$, that is: $$ F_i = \frac{\phi^i - \hat{\phi}^i}{\sqrt5} = \frac{\phi^i}{\sqrt5} - \frac{\hat{\phi}^i}{\sqrt5} $$ For $i = 0$, $\phi/\sqrt5 = (\sqrt5 + 5)/10 > 0.5$. For $i > 2$, $|\hat{\phi}^i| < 0.5$. ================================================ FILE: other/clrs/04/problems/05.markdown ================================================ ## Chip testing > Professor Diogenes has $n$ supposedly identical integrated-circuit chips that > in principle are capable of testing each other. The professor's test jig > accomodates two chips at a time. When the jig is loaded, each chip tests the > other and reports whether it is good or bad. A good chip always reports > accurately whether the other chip is good or bad, but the professor cannot > trust the answer of a bad chip. Thus, the four possible outcomes of a test > are as follows. > > | Chip A says | Chip B says | Conclusion | > |:------------|:------------|:-------------------------------| > | B is good | A is good | both are good, or both are bad | > | B is good | A is bad | at least one is bad | > | B is bad | A is good | at least one is bad | > | B is bad | A is bad | at least one is bad | > > 1. Show that if more than $n/2$ chips are bad, the professor cannot > necessarily determine which chips are good using any strategy based on > this kind of pairwise test. Assume that the bad chips can conspire to fool > the professor. > 2. Consider the problem of finding a single good chip from among $n$ chips, > assuming that more than $n/2$ of the chips are good. Show that $\lfloor > n/2 \rfloor$ pairwise tests are sufficient to reduce the problem to one of > nearly half the size. > 3. Show that the good chips can be identified with $\Theta(n)$ pairwise > tests, assuming that more than $n/2$ chips are good. Give and solve the > recurrence that describes the number of tests. ### If more than half are bad Lets say that there are $g < n/2$ good chips. The same amount of the remaining bad chips can choose to act similar to good chips. That is, they can identify each other as good and all other as faulty. Since this is what the good chips would do, both groups are symmetric in regards to the operation of parwise comparison. No strategy can distinguish between the two groups. ### Finding a single good chip in logarithmic time We split the chips in groups of two and compare them. We can take one of the chips if the outcome is the first one (both are good or both are bad) and but both away otherwise. When putting away, we're removing at least one bad chip for every good one we remove. Out of the pairs we've chosen a chip from, there would be more good chips than bad chips (there would be more good pairs, because the good chips are more than the half). Now we have at most $n/2$ chips, where at least half of them are good. ### Finding the good chips The recurrence for finding at least one good chip is: $$ T(n) = T(n/2) + n/2 $$ By the master method, this is $\Theta(n)$. After we've found one, we can compare it will all others, which is a $\Theta(n)$ operation. ================================================ FILE: other/clrs/04/problems/05.py ================================================ import random class GoodChip: def good(self): return True def check(self, other): return other.good() class BadChip: def good(self): return False def check(self, other): return [True, False][random.randint(0, 1)] def jig(a, b): return [a.check(b), b.check(a)] def diogenes(chips, verbose = False): def find_single(chips): if len(chips) <= 2: return chips[0] else: halfpoint = len(chips) // 2 pairs = zip(chips[0:halfpoint], chips[halfpoint:halfpoint * 2]) kept = [a for (a, b) in pairs if jig(a, b) == [True, True]] if len(chips) % 2 == 1: kept.append(chips[-1]) return find_single(kept) good = find_single(chips) return [chip for chip in chips if jig(good, chip) == [True, True]] ================================================ FILE: other/clrs/04/problems/05.test.py ================================================ import unittest import random import os.path as path import random import time filename = path.join(path.dirname(__file__), '05.py') exec(open(filename).read()) random.seed(1) def generate_chips(count): good = [GoodChip() for _ in range(random.randint(count // 2 + 1, 3 * count // 4 + 1))] bad = [BadChip() for _ in range(count - len(good))] chips = good + bad random.shuffle(chips) return chips class DiogenesTest(unittest.TestCase): def test_correctness(self): for n in range(100): chips = generate_chips(random.randint(1, 1000)) good = diogenes(chips, n == 155) good_count = sum(1 for chip in chips if chip.good()) self.assertTrue(good_count == len(good)) self.assertTrue(all(chip.good for chip in good)) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/04/problems/06.c ================================================ typedef struct array { int m; int n; int step; int *data; } array; int get(array A, int i, int j) { return A.data[((i + 1) * A.step - 1) * A.n + j]; } array half(array a) { array result = { a.m, a.n, a.step * 2, a.data }; return result; } int height(array array) { return array.m / array.step; } int min_index(array A, int row, int left, int right) { int min = left; for (int i = left; i < right; i++) { if (get(A, row, i) < get(A, row, min)) { min = i; } } return min; } void find_minimums(array A, int *mins) { if (height(A) == 1) { mins[0] = min_index(A, 0, 0, A.n); } else { array evens = half(A); int even_minimums[height(evens)]; find_minimums(evens, even_minimums); int leftmost = 0; for (int i = 0; i < height(evens); i++) { leftmost = min_index(A, 2 * i, leftmost, even_minimums[i] + 1); mins[2 * i] = leftmost; mins[2 * i + 1] = even_minimums[i]; } if (height(A) % 2) { mins[height(A) - 1] = min_index(A, height(A) - 1, leftmost, A.n); } } } ================================================ FILE: other/clrs/04/problems/06.markdown ================================================ ## Monge arrays > An $m \times n$ array $A$ of real numbers is a ***Monge array*** if for all > $i$, $j$, $k$, and $l$ such that $1 \le i < k \le m$ and $1 \le j < l \le n$, > we have > > $$ A[i, j] + a[k, l] \le A[i, l] + A[k, j] $$ > > In other words, whenever we pick two rows and two columns of a Monge array > and consider the four elements at the intersections of the rows and columns, > the sum of the upper-left and lower-right elements is less than or equal to > the sum of the lower-left and upper-right elements. For example, the > following array is Monge: > > $$ \begin{matrix} > 10 & 17 & 13 & 28 & 23 \\\\ > 17 & 22 & 16 & 29 & 23 \\\\ > 24 & 28 & 22 & 34 & 24 \\\\ > 11 & 13 & 6 & 17 & 7 \\\\ > 45 & 44 & 32 & 37 & 23 \\\\ > 36 & 33 & 19 & 21 & 6 \\\\ > 75 & 66 & 51 & 53 & 34 > \end{matrix} $$ > > 1. Prove that an array is Monge if and only i for all $i = 1,2,\ldots, m-1$, > and $j = 1,2,\ldots,n-1$ we have > $$ A[i,j] + A[i+1,j+1] \le A[i,j+1] + A[i+1,j] $$ > (Hint: For the "if" part, use induction seperately on rows and columns) > > 2. The following array is not Monge. Change one element in order to make it > Monge. (Hint: Use part (a).) > $$ \begin{matrix} > 37 & 23 & 22 & 32 \\\\ > 21 & 6 & 7 & 10 \\\\ > 53 & 34 & 30 & 31 \\\\ > 32 & 13 & 9 & 6 \\\\ > 43 & 21 & 15 & 8 \\\\ > \end{matrix} $$ > > 3. Let $f(i)$ be the index of the column containing the leftmost minimum > element of the row $i$. Prove that $f(1) \le f(2) \le \dots f(m)$ for > any $m \times n$ Monge array. > > 4. Here is a description of a divide-and-conquer algorithm that computes the > leftmost minimum element in each row of an $m \times n$ Monge array $A$: > > > Construct a submatrix $A'$ of $A$ consisting of the even-numbered rows > > of $A$. Recursively determine the leftmost minimum for each row in $A'$. > > Then compute the leftmost minimum in the odd-numbered rows of $A$. > > Explain how to compute the leftmost minimum in the odd-numbered rows of > $A$ (given that the leftmost minimum of the even-numbered rows is known) > in $O(m+n)$ time. > > 5. Write the recurrence describing the running time of the algorithm described > in part (d). Show that its solution is $O(m + n\log{m})$. ### Part one The "only if" part is trivial -- it follows form the definition of Monge array. As for the "if" part, let's first prove that: $$ A[i,j] + A[i+1, j+1] \le A[i,j+1] + A[i+1, j] \\\\ \Downarrow \\\\ A[i,j] + A[k, j+1] \le A[i, j+1] + A[k,j] $$ Where $i < k$. Let's prove it by induction. The base case of $k = i + 1$ is given. As for the inductive step, we assume it holds for $k = i + n$ and we want to prove it for $k + 1= i + n + 1$. If we add the given to the assumption, we get: $$ A[i, j] + A[k, j+1] \le A[i, j+1] + A[k, j] \quad (assumption) \\\\ A[k, j] + A[k+1, j+1] \le A[k, j+1] + A[k+1, j] \quad (given) \\\\ \Downarrow \\\\ A[i, j] + A[k, j+1] + A[k, j] + A[k+1, j+1] \le A[i, j+1] + A[k, j] + A[k, j+1] + A[k+1, j] \\\\ \Downarrow \\\\ A[i, j] + A[k+1, j+1] \le A[i, j+1] + A[k+1, j] $$ ### Part two $$ \begin{matrix} 37 & 23 & \mathbf{24} & 32 \\\\ 21 & 6 & 7 & 10 \\\\ 53 & 34 & 30 & 31 \\\\ 32 & 13 & 9 & 6 \\\\ 43 & 21 & 15 & 8 \\\\ \end{matrix} $$ ### Part three Let $a_i$ and $b_j$ be the leftmost minimal elements on rows $a$ and $b$ and let's assume that $i > j$. Then we have: $$ A[j, a] + A[i, b] \le A[i, a] + A[j, b] $$ But: $$ \begin{aligned} & A[j, a] \ge A[i, a] & (a_i \text{ is minimal}) \\\\ & A[i, b] \ge A[j, b] & (b_j \text{ is minimal}) \\\\ \end{aligned} $$ Which implies that: $$ A[j, a] + A[i, b] \ge A[i, a] + A[j, b] \\\\ \Downarrow \\\\ A[j, a] + A[i, b] = A[i, a] + A[j, b] $$ Which in turn implies that either: $$ \begin{aligned} &A[j, b] < A[i, b] \Rightarrow A[i, a] > A[j, a] && \Rightarrow a_i \text{ is not minimal} \\\\ &A[j, b] = A[i, b] && \Rightarrow b_j \text{ is not the leftmost minimal} \end{aligned} $$ ### Part four If $\mu_i$ is the index of the $i$-th row's leftmost minimum, then we have: $$ \mu_{i-1} \le \mu_i \le \mu_{i+1} $$ For $i = 2k + 1$, $k \ge 0$, finding $\mu_i$ takes $\mu_{i+1}-\mu_{i-1} + 1$ steps at most, since we only need to compare with those numbers. Thus: $$ \begin{aligned} T(m, n) &= \sum_{i=0}^{m/2-1}\Big(\mu_{2i + 2} - \mu_{2i} + 1\Big) \\\\ &= \sum_{i=0}^{m/2-1}\mu_{2i+2} - \sum_{i=0}^{m/2-1}\mu_{2i} + m/2 \\\\ &= \sum_{i=1}^{m/2}\mu{2i} - \sum_{i=0}^{m/2-1}\mu{2i} + m/2 \\\\ &= \mu_m - \mu_0 + m/2 \\\\ &= n + m/2 \\\\ &= O(m + n) \end{aligned} $$ ### Part five The divide time is $O(1)$, the conquer part is $T(m/2)$ and the merge part is $O(m+n)$. Thus: $$ \begin{aligned} T(m) &= T(m/2) + cn + dm \\\\ &= cn + dm + cn + dm/2 + cn + dm/4 + \ldots \\\\ &= \sum_{i=0}^{\lg{m}-1}cn + \sum_{i=0}^{\lg{m}-1}\frac{dm}{2^i} \\\\ &= cn\lg{m} + dm\sum_{i=0}^{\lg{m} - 1} \\\\ &< cn\lg{m} + 2dm \\\\ &= O(n\lg{m} + m) \end{aligned} $$ ================================================ FILE: other/clrs/04/problems/06.test.c ================================================ #include "06.c" #include "../../build/ext/test.h" TEST(large_example) { int data[] = {10, 17, 13, 28, 23, 17, 22, 16, 29, 23, 24, 28, 22, 34, 24, 11, 13, 6, 17, 7, 45, 44, 32, 37, 23, 36, 33, 19, 21, 6, 75, 66, 51, 53, 34}, expected[7] = {0, 2, 2, 2, 4, 4, 4}, actual[7]; array A = { 7, 5, 1, data }; find_minimums(A, actual); ASSERT_SAME_ARRAYS(actual, expected); } TEST(small_example) { int data[] = {37, 23, 24, 32, 21, 6, 7, 10, 53, 34, 30, 31, 32, 13, 9, 6, 43, 21, 15, 8}, expected[5] = {1, 1, 2, 3, 3}, actual[5]; array A = { 5, 4, 1, data }; find_minimums(A, actual); ASSERT_SAME_ARRAYS(actual, expected); } ================================================ FILE: other/clrs/05/01/01.markdown ================================================ > Show that the assumption that we are always able to determine which candidate > is best, in line 4 of procedure `HIRE-ASSISTANT`, implies that we know a > total order of the ranks of the candidates. A total order is a partial order that is a total relation ($\forall a,b \in A: a R b \text{ or } b R a$). A relation is a partial order if it is reflexive, antisymmetric and transitive. Let's assume that the relation is "is as good or better". * _Reflexive_: This is a bit trivial, but everybody is as good or better as themselves. * _Transitive_: If A is better than B and B is better than C, then A is better than C - that's also obvious. * _Antisymmetric_: If A is better than B, then B is not better than A. So far we have a partial order. Since we assume we can compare any two candidates, then comparison must be a total relation and thus we have a total order. ================================================ FILE: other/clrs/05/01/02.markdown ================================================ > $\star$ Describe an implementation of the procedure `RANDOM(a,b)` that only > makes calls to `RANDOM(0,1)`. What is the expected running time of your > procedure as a function of $a$ and $b$? Let $n = b - a$. The algorithm is as follows: 1. We find the smallest integer $c$ such that $2^c \ge n$ ($c = \lceil \ln{n} \rceil$) 2. We call `RANDOM(0, 1)` $c$ times to and get a $c$-digit binary number $r$ 3. If $r > n$ we go back to the previous step 4. Otherwise we return $a + r$ This produces a uniformly random number in that range. However, there is a possibility to have to repeat step 2. There is $p = n/2^c$ chance of not having to repeat step two. The geometric distribution suggests that on average it takes $1/p$ trials before we get such a number, that is $2^c/n$ trials. Since we perform $c$ calls to `RANDOM(0, 1)` on each trial, the expected running time is $$ \O\bigg(\frac{2^c}{n} c\bigg) = \O\bigg(\frac{\ln(b-a)2^{\ln(b-a)}}{b-a}\bigg) = \O(\ln(b-a)) $$ ================================================ FILE: other/clrs/05/01/03.markdown ================================================ > $\star$ Suppose that you want to output $0$ with probability $1/2$ and 1 with > probability $1/2$. At your disposal is a procedure `BIASED-RANDOM` that > outputs either $0$ or $1$. It outputs $1$ with some probability $p$ and $0$ > with probability $1 - p$, where $0 < p < 1$, but you don't now what $p$ is. > Give an algorithm that uses `BIASED-RANDOM` as a subroutine, and returns an > unbiased answer, returning $0$ with probability $1/2$ and $1$ with > probability $1/2$. What is the expected running time of your algorithm as a > function of $p$? Simple! 1. Generate two random numbers $x$ and $y$ 2. If they are not the same, return $x$ 3. Otherwise, repeat from step 1 The change of getting [0, 1] is the same as getting [1, 0]. The likelyhood of that happening is $2pq$. Thus, the expected number of trials is $1/(2pq)$ making the running time $\O\Big(\frac{1}{p(1-p)}\Big)$. ================================================ FILE: other/clrs/05/02/01.markdown ================================================ > In `HIRE-ASSISTANT`, assuming that the candidates are presented in a random > order, what is the probability that you hire exactly one time? What is the > probability you hire exactly $n$ times? You hire once when the best candidate is first. There is $1/n$ chance of that happening ($n!$ positions in $(n-1)!$ of which they are first). You hire $n$ times when the candidates come in increasing order, which is $1/n!$. ================================================ FILE: other/clrs/05/02/02.markdown ================================================ > In `HIRE-ASSISTANT`, assuming that the candidates are presented in a random > order, what is the probability that you hire exactly twice? You hire twice when you first hire is the candidate with rank $i$ and all the candidates with rank $k > i$ come after the candidate with rank $n$. There are $n - i$ better suited candidates and the probability of the best one coming first is $1/(n-i)$ (we can ignore the other candidates and they don't affect the probability). Thus, the probability for hiring twice if your first candidate has rank $i$ is: $$ \Pr\\{T_i\\} = \frac{1}{n}\frac{1}{n-i} $$ The first part reflects the probability of picking that particular candidate out of $n$. The probability to hire twice is: $$ \Pr\\{T\\} = \sum_{i=1}^{n-1}\Pr\\{T_i\\} = \sum_{i=1}^{n-1}\frac{1}{n}\frac{1}{n-i} = \frac{1}{n} \sum_{i=1}^{n-1}\frac{1}{i} = \frac{1}{n} \Big(\lg(n-1) + \O(1)\Big) $$ ================================================ FILE: other/clrs/05/02/03.markdown ================================================ > Use indicator random variables to compute the expected value of the sum of > $n$ dice Expectation of a single die $X_i$, is unsurprisingly: $$ \E[X_k] = \sum_{i=0}^6 i \Pr\\{X_k = i\\} = \frac{1 + 2 + 3 + 4 + 5 + 6}{6} = \frac{21}{6} = 3.5 $$ As for multiple dice: $$ \E[X] = \E\Big[\sum_{i=1}^nX_i\Big] = \sum_{i=1}^n \E[X_i] = \sum_{i=1}^n 3.5 = 3.5 \cdot n $$ ================================================ FILE: other/clrs/05/02/04.markdown ================================================ > Use indicator random variables to solve the following problem, which is > known as the **hat-check problem**. Each of $n$ customer gives a hat to a > hat-check person at a restaurant. The hat-check person gives the hats back > to the customers in a random order. What is the expected number of > customers who get back their hat? The probability that each person gets their hat back is $1/n$. Let $X_i$ be the event that the $i$th person gets their hat back. Thus: $$ \E[X] = \E[X_1 + X_2 + \ldots + X_n] = \sum_{i=1}^n \E[X_i] = \sum_{i=1}^n \frac{1}{n} = 1 $$ Yup. One person will get their hat back. I'm surprised too. ================================================ FILE: other/clrs/05/02/05.markdown ================================================ > Let $A[1 \ldots n]$ be an array of $n$ distinct numbers. If $i < j$ and > $A[i] > A[j]$, then the pair $(i, j)$ is called an **inversion** of $A$. > (See Problem 2-4 for more on inversions.) Suppose that the elements of $A$ > form a uniform random permutation of $\langle 1, 2, \ldots, n \rangle$. Use > indicator random variables to compute the expected number of inversions. Let $X_{ij}$ be the event that there is an inversion between $i$ and $j$. The probability of an inversion for each pair is $1/2$ because there are $\binom{n}{2}$ possible pairs and the probability of having the larger number first is $\frac{1}{n(n-1)}$. Dividing the two yields $1/2$. Thus we get that $\E[X_{ij}] = 1/2$. $$ \E[X] = \sum_{i=1}^{n-1} \sum_{j=i+1}^n \E[X_{ij}] = \sum_{i=1}^{n-1} \sum_{j=i+1}^n \frac{1}{2} = \frac{1}{2} \sum_{i=1}^{n-1} \sum_{j=i+1}^n 1 = \frac{1}{2} \sum_{i=1}^{n-1} (n-i) = \frac{1}{2} \sum_{i=1}^{n-1} i = \frac{n(n-1)}{4} = \binom{n}{2}/2 $$ ================================================ FILE: other/clrs/05/03/01.markdown ================================================ > Professor Marceau objects to the loop invariant used in the proof of Lemma > 5.5. He questions whether it is true prior to the first iteration. He > reasons that we could just as easily declare that an empty subarray > contains no 0-permutations. Therefore, the probability that an empty > subarray contains a 0-permutation should be 0, thus invalidating the loop > invariant prior to the first iteration. Rewrite the procedure > `RANDOMIZE-IN-PLACE` so that its associated loop invariant applies to a > nonempty subarray prior to the first iteration, and modify the proof of > Lemma 5.5 for your procedure. I'm not going to write any code since this is trivial. We can pick up an element at random before entering the loop and replace it with the first one. Now our invariant holds initially for a 1-permutation. ================================================ FILE: other/clrs/05/03/02.markdown ================================================ > Professor Kelp decides to write a procedure that produces at random any > permutation besides the identity permutation. He proposes the following > procedure: > > PERMUTE-WITHOUT-IDENTITY(A) > n = A.length > for i = 1 to n - 1 > swap A[i] with A[RANDOM(i + 1, n)] > > Does this code do what Professor Kelp intends? It does not. It always changes the position of each element. We cannot get the identity permutation, but we also can't get any permutation where an element is at the same place. ================================================ FILE: other/clrs/05/03/03.markdown ================================================ > Suppose that instead of swapping element $A[i]$ with a random element from > the subarray $A[i \ldots n]$, we swapped it with a random element from > anywhere in the array: > > PERMUTE-WITH-ALL(A) > n = A.length > for i = 1 to n > swap A[i] with A[RANDOM(1,n)] > > Does this code produce a uniform random permutation? Why or why not? It does not. Intuitivelly, this one can go in $n^n$ different ways while there are $n!$ combinations. Since $n!$ does not divide $n^n$, there is no way that this can be a uniform distribution. (Why doesn't it divide $n^n$? That's the intuitive part. $n!$ is divisable by $n-1$, but $n^n$ can't be for $n > 2$). Of course, this is a popular problem and there are tons of posts and papers written on it. Here's [one from Coding Horror](http://www.codinghorror.com/blog/2007/12/the-danger-of-naivete.html) ================================================ FILE: other/clrs/05/03/04.markdown ================================================ > Professor Armstrong suggests the following procedure for generating a uniform > random permutation: > > n = A.length > let B[1..n] be a new array > offset = RANDOM(1, n) > for i = 1 to n > dest = i + offset > if dest > n > dest = dest - n > B[dest] = A[i] > return B > > Show that each element $A[i]$ has a $1/n$ probability of winding up in any > particular position in $B$. Then show that Professor Armstrong is mistaken by > showing that the resulting permutation is not uniformly random. Both are trivial. $A[i]$ will go to $B[j]$ if $j \equiv \text{offset} + i \pmod{n}$. There is $1/n$ probability of that happening. It does not generate all permutations - it only generates permutations that can be obtained from the initial input by cycling. BTW, "Armstrong" and "cycling". Nice pun. ================================================ FILE: other/clrs/05/03/05.markdown ================================================ > $\star$ Prove that in the array $P$ in procedure `PERMUTE-BY-SORTING`, the > probability that all elements are unique is at least $1 - 1/n$. Let $\Pr\\{j\\}$ be the probability that the element with index $j$ is unique. If there are $n^3$ elements, then the $\Pr\\{j\\} = 1 - \frac{j-1}{n^3}$. $$ \begin{aligned} \Pr\\{1 \cap 2 \cap 3 \cap \ldots\\} &= \Pr\\{1\\} \cdot \Pr\\{2 | 1\\} \cdot \Pr\\{3 | 1 \cap 2\\} \cdots \\\\ &= 1 \bigg(1 - \frac{1}{n^3}\bigg) \bigg(1 - \frac{2}{n^3}\bigg) \bigg(1 - \frac{3}{n^3}\bigg) \cdots \\\\ &\ge 1 \bigg(1 - \frac{n}{n^3}\bigg) \bigg(1 - \frac{n}{n^3}\bigg) \bigg(1 - \frac{n}{n^3}\bigg) \cdots \\\\ &\ge \bigg(1 - \frac{1}{n^2}\bigg)^n \\\\ &\ge 1 - \frac{1}{n} \\\\ \end{aligned} $$ Why does the last derivation work, you ask? Well, $(1-x)^n \ge 1 - nx$. ================================================ FILE: other/clrs/05/03/06.markdown ================================================ > Explain how to implement the algorithm `PERMUTE-BY-SORTING` to handle the > case in which two or more priorities are identical. That is, your algorithm > should produce a uniform random permutation, even if two or more priorities > are identical. This is a stupid algorithm and requires a stupid solution. Just generate new priorities and try again. ================================================ FILE: other/clrs/05/03/07.markdown ================================================ > Suppose we want to create a **random sample** of the set $\\{1, 2, 3, \ldots, > n\\}$, that is, an $m$-element subset $S$, where $0 \le m \le n$, such that > each $m$-subset is equally likely to be created. One way would be to set > $A[i] = i$ for $i = 1, 2, 3, \ldots, n$, call `RANDOMIZE-IN-PLACE(A)`, and > then take just the first $m$ array elements. This method would make $n$ calls > to the `RANDOM` procedure. If $n$ is much larger than $m$, we can create a > random sample with fewer calls to `RANDOM`. Show that the following recursive > procedure returns a random $m$-subset $S$ of $\\{1, 2, \ldots, n\\}$, in > which each $m$-subset is equally likely, while making only $m$ calls to > `RANDOM`: > > RANDOM-SAMPLE(m,n) > if m == 0 > return ∅ > else > S = RANDOM-SAMPLE(m-1, n-1) > i = RANDOM(1,n) > if i ∈ S > S = S ∪ {n} > else > S = S ∪ {i} > return S Each combination should have a $1/\binom{n}{m}$ chance of showing up. Let's establish an invariant for `RANDOM-SAMPLE(m,n)`. We are going to go with: > `RANDOM-SAMPLE(m,n)` returns a uniformly distributed combination. We shall do induction on $m$. It's trivially so when $m$ is 1 (or 0). Let's assume the invariant holds for $m-1$. Let's see what happens when we pass $m$. The recursive call returns an $m-1$ sample with uniform probability. There are two options - either the new $m$-subset includes $n$ or not. If that happens (probability: $m/n$), the probability for each combination including $n$ is: $$ \frac{m}{n}\bigg(1/\binom{n-1}{m-1}\bigg) = 1/\binom{n}{m} $$ If it does not (probability: $(n-m)/n$), it includes one of the $(n-m)$ numbers not present. The chance for each is: $$ \frac{n-m}{n}\bigg(1/\binom{n-1}{m}\bigg) = 1/\binom{n}{m} $$ ================================================ FILE: other/clrs/05/04/01.markdown ================================================ > How many people must there be in a room before the probability that someone > has the same birthday as you do is at least $1/2$? How many people must there > be before the probability that at least two people have a birthday on July 4 > is greater than $1/2$? The probability of a person not having the same birthday as me is $(n-1)/n$. The probability of $k$ people not having the same birthday as me is that, squared. We apply the same approach as the text - we take the complementary event and solve it for $k$: $$ 1 - \bigg(\frac{n-1}{k}\bigg)^k \ge \frac{1}{2} \\\\ \bigg(\frac{n-1}{k}\bigg)^k \le \frac{1}{2} \\\\ k\lg\bigg(\frac{n-1}{n}\bigg) \ge \lg\frac{1}{2} \\\\ k = \frac{\log(1/2)}{\log(364/365)} \approx 263 $$ As for the other question: $$ \begin{aligned} \Pr\\{\text{2 born on Jul 4}\\} &= 1 - \Pr\\{\text{1 born on Jul 4}\\} - Pr\\{\text{0 born on Jul4}\\} \\\\ &= 1 - \frac{k}{n}\bigg(\frac{n-1}{n}\bigg)^{k-1} - \bigg(\frac{n-1}{n}\bigg)^k \\\\ &= 1 - \bigg(\frac{n-1}{n}\bigg)^{k-1}\bigg(\frac{n+k-1}{n}\bigg) \end{aligned} $$ Writing a Ruby programme to find the closest integer, we get 115. ================================================ FILE: other/clrs/05/04/02.markdown ================================================ > Suppose that we toss balls into $b$ bins until some bin contains two balls. > Each toss is independent, and each ball is equally likely to end up in any > bin. What is the expected number of ball tosses? This is just a restatement of the birthday problem. I consider this all that needs to be said on this subject. [More analysis can be found on wikipedia](http://en.wikipedia.org/wiki/Birthday_problem#Average_number_of_people) ================================================ FILE: other/clrs/05/04/03.markdown ================================================ > $\star$ For the analysis of the birthday paradox, is it important that the > birthdays be mutually independent, or is pairwise independence sufficient? > Justify your answer. Pairwise independence is enough. It's sufficient for the derivation after (5.6). ================================================ FILE: other/clrs/05/04/04.markdown ================================================ > $\star$ How many people should be invited to a party in order to make it > likely that there are *three* people with the same birthday? The answer is $88$. I reached it by trial and error. But let's analyze it with indicator random variables. Let $X_{ijk}$ be the indicator random variable for the event of the people with indices $i$, $j$ and $k$ have the same birthday. The probability is $1/n^2$. Then: $$ \begin{aligned} \E[X] &= \sum_{i=1}^n\sum_{j=i+1}^n\sum_{k=j+1}^nX_{ijk} \\\\ &= \sum_{i=1}^n\sum_{j=i+1}^n\sum_{k=j+1}^n\frac{1}{n^2} \\\\ &= \binom{n}{3}\frac{1}{n^2} \\\\ &= \frac{k(k-1)(k-2)}{6n^2} \end{aligned} $$ Solving this yields $94$. It's a bit more, but again, indicator random variables are approximate. Finding more commentary online is tricky. ================================================ FILE: other/clrs/05/04/05.markdown ================================================ > $\star$ What is the probability that a $k$-string over a set of size $n$ > forms a $k$-permutation? How does this question relate to the birthday > paradox? $$ \Pr\\{k\text{-perm in }n\\} = 1 \cdot \frac{n-1}{n} \cdot \frac{n-2}{n} \cdots \frac{n-k+1}{n} = \frac{(n-1)!}{(n-k)!n^k} $$ This is the complementary event to the birthday problem, that is, the chance of $k$ people have distinct birthdays. ================================================ FILE: other/clrs/05/04/06.markdown ================================================ > $\star$ Suppose that $n$ balls are tossed into $n$ bins, where each toss is > independent and the ball is equally likely to end up in any bin. What is the > expected number of empty bins? What is the expected number of bins with > exactly one ball? Both of them are $n/e$ or at least are approximatelly close to it when $n$ is large enough. Let's do empty bins first. Let $X_i$ be the event that all the balls fall in bins, other than the $i$th. $$ \Pr\\{X_i\\} = \bigg(\frac{n-1}{n}\bigg)^n = \bigg(1 - \frac{1}{n}\bigg)^n \approx \frac{1}{e} $$ The expectation: $$ \E[X] = \sum_{i=1}^n\E[X_i] = \frac{n}{e} $$ It's quite similar with exactly one ball. The probability is: $$ \Pr\\{Y_i\\} = n\frac{1}{n}\bigg(\frac{n-1}{n}\bigg)^{n-1} = \bigg(\frac{n-1}{n}\bigg)^{n-1} \approx \frac{1}{e} $$ The expectation is the same. Here's a [Math/StackExchange][question] question that clarifies it. [question]: http://math.stackexchange.com/questions/545920/expactation-of-throwing-n-balls-into-n-bins ================================================ FILE: other/clrs/05/04/07.markdown ================================================ > $\star$ Sharpen the lower bound on streak length by showing that in $n$ flips > of a fair coin, the probability is less than $1/n$ that no streak longer than > $\lg{n} - 2\lg\lg{n}$ consecutive heads occurs. **(UNSOLVED)** Too much work, too little connection to reality. ================================================ FILE: other/clrs/05/problems/01.markdown ================================================ ## Probabilstic counting > With a $b$-bit counter, we can ordinarily only count up to $2^b - 1$. With R. > Morris's **probabilistic counting**, we can count up to a much larger value > at the expense of some loss of precision. > > We let a counter value of $i$ represent that a count of $n_i$ for > $i = 0, 1, \ldots, 2^b-1$, where the $n_i$ form an increasing sequence of > nonnegative values. We assume that the initial value of the counter is 0, > representing a count of $n_0 = 0$. The `INCREMENT` operation works on a > counter containing the value $i$ in a probabilistic manner. If $i = 2^b - 1$, > then the operation reports an overflow error. Otherwise, the `INCREMENT` > operation increases the counter by 1 with probability $1/(n_{i+1} - n_i)$, > and it leaves the counter unchanged with probability $1-1/(n_{i+1} - n_i)$. > > If we select $n_i = i$ for all $i \ge 0$, then the counter is an ordinary > one. More interesting situations arise if we select, say, $n_i = 2^{i-1}$ for > $i > 0$ or $n_i = F_i$ (the $i$th Fibonacci number - see Section 3.2). > > For this problem, assume that $n_{2^b-1}$ is large enough that the > probability of an overflow error is negligible. > > 1. Show that the expected value represented by the counter after $n$ > `INCREMENT` operations have been performed is exactly $n$. > 2. The analysis of the variance of the count represented by the counter > depends on the sequence of the $n_i$. Let us consider a simple case: $n_i > = 100i$ for all $i \ge 0$. Estimate the variance in the value represented > by the register after $n$ `INCREMENT` operations have been performed. ### Expected value Suppose at the start of the $j$th increment, the counter holds $i$, which represents $n_i$. If the counter increases, then the value it will increase by $n_{i+1} - n_i$. It happens with probability $1/(n_{i+1} - n_i)$, and so: $$ \begin{aligned} \E[X_j] &= 0 \cdot \Pr\\{\text{stays same}\\} + 1 \cdot \Pr\\{\text{increases}\\} \\\\ &= 0 \cdot \bigg(1 - \frac{1}{n_{i+1} - n_i}\bigg) + 1 \cdot \bigg((n_{i+1} - n_i) \cdot \frac{1}{n_{i+1} - n_i}\bigg) \\\\ &= 1 \end{aligned} $$ This is the expectation any increment. Since there are $n$ increments, the execpted value will be $n$. ### Variance The variance of a single increment. $$ \begin{aligned} \Var[X_j] &= \E[X_j^2] - \E^2[X_j] \\\\ &= \bigg(0^2 \cdot \frac{99}{100} + 100^2 \frac{1}{100}\bigg) - 1 \\\\ &= 99 \end{aligned} $$ As for the variance of the total value: $$ \Var[X] = \Var[X_1 + X_2 + \ldots + X_n] = \sum_{i=1}^n\Var[X_i] = 99n $$ ================================================ FILE: other/clrs/05/problems/02.markdown ================================================ ## Searching an unsorted array > The problem examines three algorithms for searching for a value $x$ in an > unsorted array $A$ consisting for $n$ elements. > > Consider the following randomized strategy: pick a random index $i$ into $A$. > If $A[i] = x$, then we terminate; otherwise, we continue the search by > picking a new random index into $A$. We continue picking random indices into > $A$ until we find an index $j$ such that $A[j] = x$ or until we have checked > every element of $A$. Note that we pick from the whole set of indices each > time, so that we may examine a given element more than once. > > 1. Write pseudocode for a procedure `RANDOM-SEARCH` to implement the strategy > above. Be sure that your algorithm terminates when all indices into $A$ > have been picked. > 2. Suppose that there is exactly one index $i$ such that $A[i] = x$. What is > the expected number of indices into $A$ that we must pick before we find > $x$ and `RANDOM-SEARCH` terminates? > 3. Generalizing your solution to part (b), suppose that there are $k \ge 1$ > indices $i$ such that $A[i] = x$. What is the expected number of indices > into $A$ that we must pick before we find $x$ and `RANDOM-SEARCH` > terminates? Your answer should be a function of $n$ and $k$. > 4. Suppose that there are no indices $i$ such that $A[i] = x$. What is the > expected number of indices into $A$ that we must pick before we have > checked all elements of $A$ and `RANDOM-SEARCH` terminates? > > Now consider a deterministic linear search algorithm, which we refer to as > `DETERMINISTIC-SEARCH`. Specifically, the algorithm searches $A$ for $x$ in > order, considering $A[1], A[2], A[3], \ldots, A[n]$ until either it finds > $A[i] = x$ or it reaches the end of the array. Assume that possible > permutations of the input array are equally likely. > > 5. Suppose that there is exactly one index $i$ such that $A[i] = x$. What is > the average-case running time of `DETERMINISTIC-SEARCH`? What is the > worst-case running time of `DETERMINISTIC-SEARCH`? > 6. Generalizing your solution to part (e), suppose that there are $k \ge 1$ > indices $i$ such that $A[i] = x$. What is the average-case running time of > `DETERMINISTIC-SEARCH`? What is the worst-case running time of > `DETERMINISTIC-SEARCH`? Your answer should be a function of $n$ and $k$. > 7. Suppose that there are no indices $i$ such that $A[i] = x$. What is the > average-case running time of `DETERMINISTIC-SEARCH`? What is the > worst-case running time of `DETERMINISTIC-SEARCH`? > > Finally, consider a randomized algorithm `SCRAMBLE-SEARCH` that works by > first randomly permuting the input array and then running the deterministic > linear search given above on the resulting permuting array. > > 8. Letting $k$ be the number of indices $i$ such that $A[i] = x$, give the > worst-case and expected running time of `SCRAMBLE-SEARCH` for the cases in > which $k = 0$ and $k = 1$. Generalizing your solution to handle the case > in which $k \ge 1$. > 9. Which of the three searching algorithms would you use? Explain your > answer. ### RANDOM-SEARCH pseudocode RANDOM-SEARCH(x, A, n): v = ∅ while |∅| ≠ n i = RANDOM(1, n) if A[i] = x return i else: v = v ∩ i return ␀ `v` can be implemented in multiple ways - a hash table, a tree or a bitmap. The last one would probabily perform best and consume the least space. ### RANDOM-SEARCH with one match `RANDOM-SEARCH` is well-modelled by Bernoulli trials. The expected number of picks is $n$. ### RANDOM-SEARCH with multiple matches In similar fashion, the expected number of picks is $n/k$. ### RANDOM-SEARCH with no matches This is modelled by the balls and bins problem, explored in section 5.4.2. The answer is $n(\ln{n} + \O(1))$. ### DETERMINISTIC-SEARCH with one match The worst-case running time is $n$. The average-case is $(n+1)/2$ (obviously). ### DETERMINISTIC-SEARCH with multiple matches The worst-case running time is $n-k+1$. The average-case running time is $(n+1)/(k+1)$. Let $X_i$ be an indicator random variable that the $i$th element is a match. $\Pr\\{X_i\\} = 1/(k+1)$. Let $Y$ be an indicator random variable that we have found a match after the first $n-k+1$ elements ($\Pr\\{Y\\} = 1$). Thus: $$ \E[X] = \E[X_1 + X_2 + \ldots + X_{n-k} + Y] = 1 + \sum_{i=1}^{n-k}\E[X_i] = 1 + \frac{n-k}{k+1} = \frac{n+1}{k+1} $$ ### DETERMINISTIC-SEARCH with no matches Both the worst-case and average case is $n$. ### SCRAMBLE-SEARCH matches It's the same as `DETERMINISTIC-SEARCH`, only we replace "average-case" with "expected". ### Best algorithm Definitelly `DETERMINISTIC-SEARCH`. `SCRAMBLE-SEARCH` gives better expected results, but for the cost of randomly permuting the array, which is a linear operation. In the same time we could have scanned the full array and reported a result. ================================================ FILE: other/clrs/06/01/01.markdown ================================================ > What are the minimum and maximum numbers of elements in a heap of height $h$? It is between $2^n$ and $2^{n+1} - 1$. For example, a heap with $2$ ($2^1$) or $3$ ($2^2 - 1$) will have height $1$. If there are four elements, however, the heap height will be $2$. ================================================ FILE: other/clrs/06/01/02.markdown ================================================ > Show that an $n$-element heap has height $\lfloor \lg{n} \rfloor$ This is way too obvious, that it is hard to prove it. The number of internal nodes a complete binary tree has is $2^h - 1$ where $h$ is the height of the tree. A heap of height $h$ has at least one additional node (otherwise it would be a heap of length $h-1$) and at most $2^h$ additional nodes (otherwise it would be a heap of length $h+1$), which is similar to the answer in exercise 6.1-1. Thus, if $n \in (2^h, 2^{h+1} - 1)$, then the height will be $\lfloor \lg{n} \rfloor$. ================================================ FILE: other/clrs/06/01/03.markdown ================================================ > Show that in any subtree of a max-heap, the root of the subtree contains the > largest value occuring anywhere in the subtree. This follows from the max-heap property. If the $i$th element is the root of the subtree, then both its children would be less or equal to it. Since this properties holds for their children too and it is transitive, all of the descendents will be less or equal to the root, making it the largest value. ================================================ FILE: other/clrs/06/01/04.markdown ================================================ > Where in a max-heap might the smallest element reside, assuming that all > elements are distinct? In any of the leaves, that is, elements with index $\lfloor n/2 \rfloor + 1$ (see exercise 6.1-7), that is, in the second half of the heap array. ================================================ FILE: other/clrs/06/01/05.markdown ================================================ > Is an array that is in sorted order a min-heap? Yes. For any index $i$, both `LEFT(i)` and `RIGHT(i)` are larger and thus the elements indexed by them are greater or equal to $A[i]$ (because the array is sorted). ================================================ FILE: other/clrs/06/01/06.dot ================================================ graph Heap { 23 -- 17; 23 -- 14; 17 -- 6; 17 -- 13; 14 -- 10; 14 -- 1; 6 -- 5; 6 -- 7 [color=red]; 13 -- 12; } ================================================ FILE: other/clrs/06/01/06.markdown ================================================ > Is the array with values $\langle 23, 17, 14, 6, 13, 10, 1, 5, 7, 12 \rangle$ > a max-heap? No. The property is violated by the next-to-last leaf (illustrated below in red). ================================================ FILE: other/clrs/06/01/07.markdown ================================================ > Show that, with the array representation for sorting an $n$-element heap, the > leaves are the nodes indexed by $\lfloor n/2 \rfloor + 1,\lfloor n/2 \rfloor > + 2, \ldots, n$. Another very obvious one. Let's take the left child of the node indexed by $\lfloor n/2 \rfloor + 1$. $$ \text{LEFT}(\lfloor n/2 \rfloor + 1) = 2(\lfloor n/2 \rfloor + 1) > 2(n/2 - 1) + 2 = n - 2 + 2 = n $$ Since the index of the left child is larger than the number of elements in the heap, the node doesn't have childrens and thus is a leaf. Same goes for all nodes with larger indices. Note that if we take element indexed by $\lfloor n/2 \rfloor$, it will not be a leaf. In case of even number of nodes, it will have a left child with index $n$ and in the case of odd number of nodes, it will have a left child with index $n-1$ and a right child with index $n$. This makes the number of leaves in a heap of size $n$ equal to $\lceil n/2 \rceil$. ================================================ FILE: other/clrs/06/02/01.dot ================================================ graph Illustration { subgraph A { node[shape=circle, fixedsize=true]; a1[label=27]; a2[label=17]; a3[label=3, style=filled]; a4[label=16]; a5[label=13]; a6[label=10]; a7[label=1]; a8[label=5]; a9[label=7]; a10[label=12]; a11[label=4]; a12[label=8]; a13[label=9]; a14[label=0]; a1 -- a2; a1 -- a3; a2 -- a4; a2 -- a5; a3 -- a6; a3 -- a7; a4 -- a8; a4 -- a9; a5 -- a10; a5 -- a11; a6 -- a12; a6 -- a13; a7 -- a14; } subgraph B { node[shape=circle, fixedsize=true]; b1[label=27]; b2[label=17]; b3[label=10] b4[label=16]; b5[label=13]; b6[label=3, style=filled]; b7[label=1]; b8[label=5]; b9[label=7]; b10[label=12]; b11[label=4]; b12[label=8]; b13[label=9]; b14[label=0]; b1 -- b2; b1 -- b3; b2 -- b4; b2 -- b5; b3 -- b6; b3 -- b7; b4 -- b8; b4 -- b9; b5 -- b10; b5 -- b11; b6 -- b12; b6 -- b13; b7 -- b14; } subgraph C { node[shape=circle, fixedsize=true]; c1[label=27]; c2[label=17]; c3[label=10]; c4[label=16]; c5[label=13]; c6[label=9]; c7[label=1]; c8[label=5]; c9[label=7]; c10[label=12]; c11[label=4]; c12[label=8]; c13[label=3, style=filled]; c14[label=0]; c1 -- c2; c1 -- c3; c2 -- c4; c2 -- c5; c3 -- c6; c3 -- c7; c4 -- c8; c4 -- c9; c5 -- c10; c5 -- c11; c6 -- c12; c6 -- c13; c7 -- c14; } } ================================================ FILE: other/clrs/06/02/01.markdown ================================================ > Using figure 6.2 as a model, illustrate the operation of `MAX-HEAPIFY(A, 3)` > on the array $A = \langle 27, 17, 3, 16, 13, 10, 1, 5, 7, 12, 4, 8, 9, 0 > \rangle$. ================================================ FILE: other/clrs/06/02/02.markdown ================================================ > Starting with the procedure `MAX-HEAPIFY`, write pseudocode for the procedure > `MIN-HEAPIFY(A, i)`, which performs the corresponding manipulation on a > min-heap. How does the running time of `MIN-HEAPIFY` compare to that of > `MAX-HEAPIFY`? MIN-HEAPIFY(A, i) l = LEFT(i) r = RIGHT(i) if l ≤ A.heap-size and A[l] < A[i] smallest = l else smallest = i if r ≤ A.heap-size and A[r] < A[i] smallest = r if smallest ≠ i exchange A[i] with A[smallest] MIN-HEAPIFY(A, smallest) The running time is the same. Actually, the algorithm is the same with the exceptions of two comparisons and some names. ================================================ FILE: other/clrs/06/02/03.markdown ================================================ > What is the effect of calling `MAX-HEAPIFY(A, i)` when th element $A[i]$ is > larger than its children? No effect. The comparisons are carried out, $A[i]$ is found to be largest and the procedure just returns. ================================================ FILE: other/clrs/06/02/04.markdown ================================================ > What is the effect of calling `MAX-HEAPIFY(A, i)` for $i > A.heap-size / 2$? No effect. In that case, it is a leaf. Both `LEFT` and `RIGHT` return values that fail the comparison with the heap size and `i` is stored in `largest`. Afterwards the procedure just returns ================================================ FILE: other/clrs/06/02/05.c ================================================ #define PARENT(i) ((i - 1) / 2) #define LEFT(i) (2 * i + 1) #define RIGHT(i) (2 * i + 2) typedef struct { int *nodes; int length; int heap_size; } heap; void max_heapify(heap A, int i) { int left, right, largest, temp; while(1) { left = LEFT(i); right = RIGHT(i); if (left < A.heap_size && A.nodes[left] > A.nodes[i]) largest = left; else largest = i; if (right < A.heap_size && A.nodes[right] > A.nodes[largest]) largest = right; if (largest == i) return; temp = A.nodes[i]; A.nodes[i] = A.nodes[largest]; A.nodes[largest] = temp; i = largest; } } ================================================ FILE: other/clrs/06/02/05.markdown ================================================ > The code for `MAX-HEAPIFY` is quite efficient in terms of constant factors, > except possibly for the recursive call in line 10, which might cause some > compilers to produce inefficient code. Write an efficient `MAX-HEAPIFY` that > uses an iterative control construct (a loop) instead of recursion. As always, the most fun was converting from 1- to 0-based indexing. ================================================ FILE: other/clrs/06/02/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" TEST(chapter_example) { int expected[] = {16, 14, 10, 8, 7, 9, 3, 2, 4, 1}, actual[] = {16, 4, 10, 14, 7, 9, 3, 2, 8, 1}; heap A = {actual, 10, 10}; max_heapify(A, 1); ASSERT_SAME_ARRAYS(actual, expected); } TEST(exercise_6_2_1_example) { int expected[] = {27, 17, 10, 16, 13, 9, 1, 5, 7, 12, 4, 8, 3, 0}, actual[] = {27, 17, 3, 16, 13, 10, 1, 5, 7, 12, 4, 8, 9, 0}; heap A = {actual, 14, 14}; max_heapify(A, 2); ASSERT_SAME_ARRAYS(actual, expected); } ================================================ FILE: other/clrs/06/02/06.markdown ================================================ > Show that the worst-case running time of `MAX-HEAPIFY` on a heap of size $n$ > is $\Omega(\lg{n})$. (Hint: For a heap with $n$ nodes, give node values that > cause `MAX-HEAPIFY` to be called recursively at every node on a simple path > from the root down to a leaf.) This is another obvious one. Let's take the leftmost path in the given heap. If we put the largest elements in the heap on that path and the smallest one at the root, `MAX-HEAPIFY` will need to be invoked once for each level in the heap in order to push the minimum element to the leftmost leaf. Since the heap height (and thus the leftmost path's length) is $\lfloor \lg{n} \rfloor$ (exercise 6.1-2), the worst-case running time of the procedure is $\Omega(\lg{n})$. ================================================ FILE: other/clrs/06/03/01.dot ================================================ graph Illustration { node[shape=circle, fixedsize=true] subgraph A { a1[label=5]; a2[label=3]; a3[label=17]; a4[label=10, style=filled]; a5[label=84]; a6[label=19]; a7[label=6]; a8[label=22]; a9[label=9]; a1 -- a2; a1 -- a3; a2 -- a4; a2 -- a5; a3 -- a6; a3 -- a7; a4 -- a8; a4 -- a9; } subgraph B { b1[label=5]; b2[label=3]; b3[label=17 style=filled]; b4[label=22]; b5[label=84]; b6[label=19]; b7[label=6]; b8[label=10]; b9[label=9]; b1 -- b2; b1 -- b3; b2 -- b4; b2 -- b5; b3 -- b6; b3 -- b7; b4 -- b8; b4 -- b9; } subgraph C { c1[label=5]; c2[label=3 style=filled]; c3[label=19]; c4[label=22]; c5[label=84]; c6[label=17]; c7[label=6]; c8[label=10]; c9[label=9]; c1 -- c2; c1 -- c3; c2 -- c4; c2 -- c5; c3 -- c6; c3 -- c7; c4 -- c8; c4 -- c9; } subgraph D { d1[label=5 style=filled]; d2[label=84]; d3[label=19]; d4[label=22]; d5[label=3]; d6[label=17]; d7[label=6]; d8[label=10]; d9[label=9]; d1 -- d2; d1 -- d3; d2 -- d4; d2 -- d5; d3 -- d6; d3 -- d7; d4 -- d8; d4 -- d9; } subgraph E { e1[label=84]; e2[label=22]; e3[label=19]; e4[label=10]; e5[label=3]; e6[label=17]; e7[label=6]; e8[label=5]; e9[label=9]; e1 -- e2; e1 -- e3; e2 -- e4; e2 -- e5; e3 -- e6; e3 -- e7; e4 -- e8; e4 -- e9; } } ================================================ FILE: other/clrs/06/03/01.markdown ================================================ > Using figure 6.3 as a model, illustrate the operation of `BUILD-MAX-HEAP` on > the array $A = \langle 5, 3, 17, 10, 84, 19, 6, 22, 9 \rangle$. Oh boy. ================================================ FILE: other/clrs/06/03/02.markdown ================================================ > Why do we want the loop index $i$ in line 2 of `BUILD-MAX-HEAP` to decrease > from $\lfloor A.length / 2 \rfloor$ to $1$ rather than increase from $1$ to > $\lfloor A.length/2 \rfloor$? Otherwise we won't be allowed to call `MAX-HEAPIFY`, since it will fail the condition of having the subtrees be max-heaps. That is, if we start with $1$, there is no guarantee that $A[2]$ and $A[3]$ are roots of max-heaps. ================================================ FILE: other/clrs/06/03/03.markdown ================================================ > Show that there are at most $\lceil n/2^{h+1} \rceil$ nodes of height $h$ in > any $n$-element heap. First, let's observe that the number of leaves in a heap is $\lceil n/2 \rceil$ (exercise 6.1-7). Let's prove it by induction on $h$. **Base**: $h = 0$. The number of leaves is $\lceil n/2 \rceil = \lceil n/2^{0+1} \rceil$. **Step**: Let's assume it holds for nodes of height $h-1$. Let's take a tree and remove all it's leaves. We get a new tree with $n - \lceil n/2 \rceil = \lfloor n/2 \rfloor$ elements. Note that the nodes with height $h$ in the old tree have height $h-1$ in the new one. We will calculate the number of such nodes in the new tree. By the inductive assumption we have that $T$, the number of nodes with height $h-1$ in the new tree, is: $$ T = \bigg\lceil \lfloor n/2 \rfloor / 2^{h-1+1} \bigg\rceil < \bigg\lceil (n/2)/2^h \bigg\rceil = \bigg\lceil \frac{n}{2^{h+1}} \bigg\rceil $$ As mentioned, this is also the number of nodes with height $h$ in the old tree. ================================================ FILE: other/clrs/06/04/01.dot ================================================ graph Heapsort { node[shape=circle, fixedsize=true]; subgraph A { a1[label=25]; a2[label=13]; a3[label=20]; a4[label=8]; a5[label=7]; a6[label=17]; a7[label=2]; a8[label=5]; a9[label=4]; a1 -- a2; a1 -- a3; a2 -- a4; a2 -- a5; a3 -- a6; a3 -- a7; a4 -- a8; a4 -- a9; } subgraph B { b1[label=20]; b2[label=13]; b3[label=17]; b4[label=8]; b5[label=7]; b6[label=4]; b7[label=2]; b8[label=5]; b9[label=25 style=filled]; b1 -- b2; b1 -- b3; b2 -- b4; b2 -- b5; b3 -- b6; b3 -- b7; b4 -- b8; { edge[color=gray] b4 -- b9; } } subgraph C { c1[label=17]; c2[label=13]; c3[label=5]; c4[label=8]; c5[label=7]; c6[label=4]; c7[label=2]; c8[label=20 style=filled]; c9[label=25 style=filled]; c1 -- c2; c1 -- c3; c2 -- c4; c2 -- c5; c3 -- c6; c3 -- c7; { edge[color=gray] c4 -- c8; c4 -- c9; } } subgraph D { d1[label=13]; d2[label=8]; d3[label=5]; d4[label=2]; d5[label=7]; d6[label=4]; d7[label=17 style=filled]; d8[label=20 style=filled]; d9[label=25 style=filled]; d1 -- d2; d1 -- d3; d2 -- d4; d2 -- d5; d3 -- d6; { edge[color=gray] d3 -- d7; d4 -- d8; d4 -- d9; } } subgraph E { e1[label=8]; e2[label=7]; e3[label=5]; e4[label=2]; e5[label=4]; e6[label=13 style=filled]; e7[label=17 style=filled]; e8[label=20 style=filled]; e9[label=25 style=filled]; e1 -- e2; e1 -- e3; e2 -- e4; e2 -- e5; { edge[color=gray] e3 -- e6; e3 -- e7; e4 -- e8; e4 -- e9; } } subgraph F { f1[label=7]; f2[label=4]; f3[label=5]; f4[label=2]; f5[label=8 style=filled]; f6[label=13 style=filled]; f7[label=17 style=filled]; f8[label=20 style=filled]; f9[label=25 style=filled]; f1 -- f2; f1 -- f3; f2 -- f4; { edge[color=gray] f2 -- f5; f3 -- f6; f3 -- f7; f4 -- f8; f4 -- f9; } } subgraph G { g1[label=5]; g2[label=4]; g3[label=2]; g4[label=7 style=filled]; g5[label=8 style=filled]; g6[label=13 style=filled]; g7[label=17 style=filled]; g8[label=20 style=filled]; g9[label=25 style=filled]; g1 -- g2; g1 -- g3; { edge[color=gray] g2 -- g4; g2 -- g5; g3 -- g6; g3 -- g7; g4 -- g8; g4 -- g9; } } subgraph H { h1[label=4]; h2[label=2]; h3[label=5 style=filled]; h4[label=7 style=filled]; h5[label=8 style=filled]; h6[label=13 style=filled]; h7[label=17 style=filled]; h8[label=20 style=filled]; h9[label=25 style=filled]; h1 -- h2; { edge[color=gray] h1 -- h3; h2 -- h4; h2 -- h5; h3 -- h6; h3 -- h7; h4 -- h8; h4 -- h9; } } subgraph I { i1[label=4]; i2[label=2 style=filled]; i3[label=5 style=filled]; i4[label=7 style=filled]; i5[label=8 style=filled]; i6[label=13 style=filled]; i7[label=17 style=filled]; i8[label=20 style=filled]; i9[label=25 style=filled]; i1 -- i2; { edge[color=gray] i1 -- i3; i2 -- i4; i2 -- i5; i3 -- i6; i3 -- i7; i4 -- i8; i4 -- i9; } } } ================================================ FILE: other/clrs/06/04/01.markdown ================================================ > Using figure 6.4 as a model, illustrate the operation of `HEAPSORT` on the > array $A = \langle 5, 13, 2, 25, 7, 17, 20, 8, 4 \rangle$. ================================================ FILE: other/clrs/06/04/02.markdown ================================================ > Argue the correctness of `HEAPSORT` using the following loop invariant: > > > At the start of each iteration of the **for** loop of lines 2-5, the > > subarray $A[1 \ldots i]$ is a max-heap containing the $i$ smallest elements > > of $A[1 \ldots n]$, and the subarray $A[i + 1 \ldots n]$ contains the $n - > > i$ largest elements of $A[1 \ldots n]$, sorted. **Initialization**. The subarray $A[i + 1 \ldots n]$ is empty, thus the invariant holds. **Maintenance**. $A[1]$ is the largest element in $A[1 \ldots i]$ and it is smaller than the elements in $A[i + 1 \ldots n]$. When we put it in the $i$th position, then $A[i \ldots n]$ contains the largest elements, sorted. Decreasing the heap size and calling `MAX-HEAPIFY` turns $A[1 \ldots i-1]$ into a max-heap. Decrementing $i$ sets up the invariant for the next iteration. **Termination**. After the loop $i = 1$. This means that $A[2 \ldots n]$ is sorted and $A[1]$ is the smallest element in the array, which makes the array sorted. ================================================ FILE: other/clrs/06/04/03.markdown ================================================ > What is the running time of `HEAPSORT` on an array $A$ of length $n$ that is > already sorted in increasing order? What about decreasing order? Both of them are $\Theta(n\lg{n})$. If the array is sorted in increasing order, the algorithm will need to convert it to a heep that will take $\O(n)$. Afterwards, however, there are $n-1$ calls to `MAX-HEAPIFY` and each one will perform the full $\lg{k}$ operations. Since: $$ \sum_{i=1}^{n-1}\lg{k} = \lg\Big((n-1)!\Big) = \Theta(n\lg{n}) $$ Same goes for decreasing order. `BUILD-MAX-HEAP` will be faster (by a constant factor), but the computation time will be dominated by the loop in `HEAPSORT`, which is $\Theta(n\lg{n})$. ================================================ FILE: other/clrs/06/04/04.markdown ================================================ > Show that the worst-case running time of `HEAPSORT` is $\Omega(n\lg{n})$. This is essentially the first part of exercise 6.4-3. Whenever we have an array that is already sorted, we take linear time to convert it to a max-heap and then $n\lg{n}$ time to sort it. ================================================ FILE: other/clrs/06/04/05.markdown ================================================ > $\star$ Show that when all elements are distinct, the best-case running time > of `HEAPSORT` is $\Omega(n\lg{n})$. This proved to be quite tricky. My initial solution was wrong. Also, heapsort appeared in 1964, but the lower bound was proved by Schaffer and Sedgewick in 1992. It's evil to put this an exercise. Let's assume that the heap is a full binary tree with $n = 2^k - 1$. There are $2^{k-1}$ leaves and $2^{k-1} - 1$ inner nodes. Let's look at sorting the first $2^{k-1}$ elements of the heap. Let's consider their arrangement in the heap and color the leaves to be red and the inner nodes to be blue. The colored nodes are a subtree of the heap (otherwise there would be a contradiction). Since there are $2^{k-1}$ colored nodes, at most $2^{k-2}$ are red, which means that at least $2^{k-2} - 1$ are blue. While the red nodes can jump directly to the root, the blue nodes need to travel up before they get removed. Let's count the number of swaps to move the blue nodes to the root. The minimal case of swaps is when (1) there are $2^{k-2} - 1$ blue nodes and (2) they are arranged in a binary tree. If there are $d$ such blue nodes, then there would be $i = \lg{d}$ levels, each containing $2^i$ nodes with length $i$. Thus the number of swaps is: $$ \sum_{i=0}^{\lg{d}}i2^i = 2 + (\lg{d} - 2)2^{\lg{d}} = \Omega(d\lg{d}) $$ And now for a lazy (but cute) trick. We've figured out a tight bound on sorting half of the heap. We have the following recurrence: $$ T(n) = T(n/2) + \Omega(n\lg{n}) $$ Applying the master method, we get that $T(n) = \Omega(n\lg{n}) $. ================================================ FILE: other/clrs/06/05/01.dot ================================================ graph HeapExtractMax { node[shape=circle, fixedsize=true]; subgraph A { a1[label=15 style=filled]; a2[label=13]; a3[label=9]; a4[label=5]; a5[label=12]; a6[label=8]; a7[label=7]; a8[label=4]; a9[label=0]; a10[label=6]; a11[label=2]; a12[label=1]; a1 -- a2; a1 -- a3; a2 -- a4; a2 -- a5; a3 -- a6; a3 -- a7; a4 -- a8; a4 -- a9; a5 -- a10; a5 -- a11; a6 -- a12; { node[style=invis]; edge[style=invis]; a6 -- a13; a7 -- a14; a7 -- a15; } } subgraph B { b1[label=1 style=filled]; b2[label=13]; b3[label=9]; b4[label=5]; b5[label=12]; b6[label=8]; b7[label=7]; b8[label=4]; b9[label=0]; b10[label=6]; b11[label=2]; b1 -- b2; b1 -- b3; b2 -- b4; b2 -- b5; b3 -- b6; b3 -- b7; b4 -- b8; b4 -- b9; b5 -- b10; b5 -- b11; { node[style=invis]; edge[style=invis]; b6 -- b12; b6 -- b13; b7 -- b14; b7 -- b15; } } subgraph C { c1[label=13]; c2[label=12]; c3[label=9]; c4[label=5]; c5[label=6]; c6[label=8]; c7[label=7]; c8[label=4]; c9[label=0]; c10[label=1 style=filled]; c11[label=2]; c1 -- c2; c1 -- c3; c2 -- c4; c2 -- c5; c3 -- c6; c3 -- c7; c4 -- c8; c4 -- c9; c5 -- c10; c5 -- c11; { node[style=invis]; edge[style=invis]; c6 -- c12; c6 -- c13; c7 -- c14; c7 -- c15; } } } ================================================ FILE: other/clrs/06/05/01.markdown ================================================ > Illustrate the operation `HEAP-EXTRACT-MAX` on the heap $A = > \langle 15, 13, 9, 5, 12, 8, 7, 4, 0, 6, 2, 1 \rangle$. ================================================ FILE: other/clrs/06/05/02.dot ================================================ graph MaxHeapInsert { node[shape=circle, fixedsize=true]; subgraph A { a1[label=15]; a2[label=13]; a3[label=9]; a4[label=5]; a5[label=12]; a6[label=8]; a7[label=7]; a8[label=4]; a9[label=0]; a10[label=6]; a11[label=2]; a12[label=1]; a13[label=10 style=filled]; a1 -- a2; a1 -- a3; a2 -- a4; a2 -- a5; a3 -- a6; a3 -- a7; a4 -- a8; a4 -- a9; a5 -- a10; a5 -- a11; a6 -- a12; a6 -- a13; { node[style=invis]; edge[style=invis]; a7 -- a14; a7 -- a15; } } subgraph B { b1[label=15]; b2[label=13]; b3[label=9]; b4[label=5]; b5[label=12]; b6[label=10 style=filled]; b7[label=7]; b8[label=4]; b9[label=0]; b10[label=6]; b11[label=2]; b12[label=1]; b13[label=8]; b1 -- b2; b1 -- b3; b2 -- b4; b2 -- b5; b3 -- b6; b3 -- b7; b4 -- b8; b4 -- b9; b5 -- b10; b5 -- b11; b6 -- b12; b6 -- b13; { node[style=invis]; edge[style=invis]; b7 -- b14; b7 -- b15; } } subgraph C { c1[label=15]; c2[label=13]; c3[label=10 style=filled]; c4[label=5]; c5[label=12]; c6[label=9]; c7[label=7]; c8[label=4]; c9[label=0]; c10[label=6]; c11[label=2]; c12[label=1]; c13[label=8]; c1 -- c2; c1 -- c3; c2 -- c4; c2 -- c5; c3 -- c6; c3 -- c7; c4 -- c8; c4 -- c9; c5 -- c10; c5 -- c11; c6 -- c12; c6 -- c13; { node[style=invis]; edge[style=invis]; c7 -- c14; c7 -- c15; } } } ================================================ FILE: other/clrs/06/05/02.markdown ================================================ > Illustrate the operation of `MAX-HEAP-INSERT(A, 10)` on the heap $A = \langle > 15, 13, 9, 5, 12, 8, 7, 4, 0, 6, 2, 1 \rangle$. ================================================ FILE: other/clrs/06/05/03.c ================================================ #include #include #include #define PARENT(i) ((i - 1) / 2) #define LEFT(i) (2 * i + 1) #define RIGHT(i) (2 * i + 2) typedef struct { int *elements; int length; int heap_size; } heap_t; int heap_minimum(heap_t *heap) { return heap->elements[0]; } void min_heapify(heap_t *heap, int i) { int left = LEFT(i), right = RIGHT(i), smallest; if (left < heap->heap_size && heap->elements[left] < heap->elements[i]) { smallest = left; } else { smallest = i; } if (right < heap->heap_size && heap->elements[right] < heap->elements[smallest]) { smallest = right; } if (smallest != i) { int tmp = heap->elements[i]; heap->elements[i] = heap->elements[smallest]; heap->elements[smallest] = tmp; min_heapify(heap, smallest); } } int heap_extract_min(heap_t *heap) { if (heap->heap_size == 0) { fprintf(stderr, "heap underflow"); exit(0); } int min = heap->elements[0]; heap->elements[0] = heap->elements[heap->heap_size - 1]; heap->heap_size--; min_heapify(heap, 0); return min; } void heap_decrease_key(heap_t *heap, int i, int key) { if (key > heap->elements[i]) { fprintf(stderr, "new key is larger than current key"); exit(0); } heap->elements[i] = key; while (i > 0 && heap->elements[PARENT(i)] > heap->elements[i]) { int tmp = heap->elements[PARENT(i)]; heap->elements[PARENT(i)] = heap->elements[i]; heap->elements[i] = tmp; i = PARENT(i); } } void min_heap_insert(heap_t *heap, int key) { if (heap->length == heap->heap_size) { fprintf(stderr, "heap overflow"); exit(0); } heap->elements[heap->heap_size] = INT_MAX; heap->heap_size++; heap_decrease_key(heap, heap->heap_size - 1, key); } ================================================ FILE: other/clrs/06/05/03.markdown ================================================ > Write pseudocode for the procedures `HEAP-MINIMUM`, `HEAP-EXTRACT-MIN`, > `HEAP-DECREASE-KEY`, and `MIN-HEAP-INSERT` that implement a min-priority > queue with a min-heap. Pseudocode? Why, let's do some real code! ================================================ FILE: other/clrs/06/05/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" TEST(heap_minumum) { int numbers[] = {1, 2, 4}; heap_t heap = {numbers, 3, 3}; ASSERT_EQUALS(heap_minimum(&heap), 1); } TEST(heap_extract_min) { int actual[] = {1, 2, 4, 3, 5, 7}, expected[] = {2, 3, 4, 7, 5}; heap_t heap = {actual, 6, 6}; int min = heap_extract_min(&heap); ASSERT_EQUALS(min, 1); ASSERT_EQUALS(heap.heap_size, 5); ASSERT_SAME_ARRAYS_S(heap.elements, expected, 5); } TEST(heap_decrease_key) { int actual[] = {1, 2, 4, 3, 5}, expected[] = {0, 1, 4, 3, 2}; heap_t heap = {actual, 5, 5}; heap_decrease_key(&heap, 4, 0); ASSERT_SAME_ARRAYS(actual, expected); } TEST(min_heap_insert) { int actual[] = {1, 3, 4, 6, 5, -1}, expected[] = {1, 3, 2, 6, 5, 4}; heap_t heap = {actual, 6, 5}; min_heap_insert(&heap, 2); ASSERT_SAME_ARRAYS(actual, expected); } ================================================ FILE: other/clrs/06/05/04.markdown ================================================ > Why do we bother setting the key of the inserted node to $-\infty$ in line 2 > of `MAX-HEAP-INSERT` when the next thing we do is increase its key to the > desired value? In order to pass the guard clause. Otherwise we have to drop the check if $key < A[i]$. ================================================ FILE: other/clrs/06/05/05.markdown ================================================ > Argue the correctness of `HEAP-INCREASE-KEY` using the following loop > invariant: > > > At the start of each iteration of the **while** loop of lines 4-6, the > > subarray $A[1 \ldots A.heap\text{-}size]$ satisfies the max-heap property, > > except that there may be one violation: $A[i]$ may be larger than > > $A[\text{PARENT}(i)]$. > > You may assume that the subarray $A[1 \ldots A.heap\text{-}size]$ satisfies > the max-heap property at the time `HEAP-INCREASE-KEY` is called. **Initialization**. $A$ is a heap except that $A[i]$ might be larger that it's parent, because it has been modified. $A[i]$ is larger than its children, because otherwise the guard clause would fail and the loop will not be entered (the new value is larger than the old value and the old value is larger than the children). **Maintenance**. When we exchange $A[i]$ with its parent, the max-heap property is satisfied except that now $A[\text{PARENT}(i)]$ might be larger than its parent. Changing $i$ to its parent maintains the invariant. **Termination**. The loop terminates whenever the heap is exhausted or the max-heap property for $A[i]$ and its parent is preserved. At the loop termination, $A$ is a max-heap. ================================================ FILE: other/clrs/06/05/06.c ================================================ #include #include #include #define PARENT(i) ((i - 1) / 2) #define LEFT(i) (2 * i + 1) #define RIGHT(i) (2 * i + 2) typedef struct { int *elements; int length; int heap_size; } heap_t; void heap_increase_key(heap_t *heap, int i, int key) { if (key < heap->elements[i]) { fprintf(stderr, "new key is larger than current key"); exit(0); } while (i > 0 && heap->elements[PARENT(i)] < key) { heap->elements[i] = heap->elements[PARENT(i)]; i = PARENT(i); } heap->elements[i] = key; } ================================================ FILE: other/clrs/06/05/06.markdown ================================================ > Each exchange operation on line 5 of `HEAP-INCREASE-KEY` typically requires > three assignments. Show how to use the idea of the inner loop of > `INSERTION-SORT` to reduce the three assignments down to just one assignment. Here we really need the set to $- \infty$. ================================================ FILE: other/clrs/06/05/06.test.c ================================================ #include "06.c" #include "../../build/ext/test.h" TEST(heap_increase_key) { int actual[] = {16, 14, 10, 8, 7, 9, 3, 2, 4, 1}, expected[] = {16, 15, 10, 14, 7, 9, 3, 2, 8, 1}; heap_t heap = {actual, 10, 10}; heap_increase_key(&heap, 8, 15); ASSERT_SAME_ARRAYS(actual, expected); } ================================================ FILE: other/clrs/06/05/07.markdown ================================================ > Show how to implement a first-in, first-out queue with a priority queue. Show > how to implement a stack with a priority queue. (Queues and stacks are > defined in section 10.1). Both are simple. For a stack we keep adding elements in increasing priority, while in a queue we add them in decreasing priority. For the stack we can set the new priority to `HEAP-MAXIMUM(A) + 1`. For the queue we need to keep track of it and decrease it on every insertion. Both are not very efficient. Furthermore, if the priority can overflow or underflow, so will eventually need to reassign priorities. ================================================ FILE: other/clrs/06/05/08.markdown ================================================ > The operation `HEAP-DELETE(A,i)` deletes the item in node $i$ from heap $A$. > Give an implementation of `HEAP-DELETE` that runs in $\O(\lg{n})$ time for an > $n$-element max-heap. This is the pseudocode is as follows: HEAP-DELETE(A, i): A[i] = A[A.heap-size] A.heap-size -= 1 MAX-HEAPIFY(A, i) We just move the last element of the heap to the deleated position and then call `MAX-HEAPIFY` on it. This works, because the element is already smaller than its parent (because it was already under it on the heap), but might be larger than its children. `MAX-HEAPIFY` restored the heap property. ================================================ FILE: other/clrs/06/05/09.markdown ================================================ > Give an $\O(n\lg{k})$-time algorithm to merge $k$ sorted lists into one > sorted list, where $n$ is the total number of elements in all the input > lists. (Hint: Use a min-heap for $k$-way merging). We take one element of each list and put it in a min-heap. Along with each element we have to track which list we took it from. When merging, we take the minimum element from the heap and insert another element off the list it came from (unless the list is empty). We continue until we empty the heap. We have $n$ steps and at each step we're doing an insertion into the heap, which is $\lg{k}$. ================================================ FILE: other/clrs/06/problems/01.markdown ================================================ ## Building a heap using insertion > We can build a heap by repeatedly calling `MAX-HEAP-INSERT` to insert the > elements into the heap. Consider the following variation of the > `BUILD-MAX-HEAP` procedure. > > BUILD-MAX-HEAP'(A) > A.heap-size = 1 > for i = 2 to A.length > MAX-HEAP-INSERT(A, A[i]) > > 1. Do the procedures `BUILD-MAX-HEAP` and `BUILD-MAX-HEAP'` always create the > same heap when run on the same input array? Prove that they do, or provide > a counterexample. > 2. Show that in the worst case, `BUILD-MAX-HEAP'` requires $\Theta(n\lg{n})$ > time to build a $n$-element heap. ### Same heaps? No. They produce different heaps. This is illustrated with $\langle 1, 2, 3, 4, 5, 6 \rangle$. Results are shown below. ### Complexity `MAX-HEAP-INSERT` is a $\Theta(\lg{n})$ operation in the worst case and it gets called $n - 1$ times. `MAX-HEAP-INSERT` might need to pull each element up to the beginning of the heap, that is, $\lg{k}$ operations whatever $k$ currently is. The worst case happens when the array is sorted. Thus the complexity is: $$ \sum_{i=2}^{n}\lg{i} = \lg(n!) = \Theta(n\lg{n})$$ The above is due to exercise 3.2.3. ================================================ FILE: other/clrs/06/problems/01.py ================================================ ############################################################################## # DATA STRUCTURES ############################################################################## class heap: def __init__(self, items, size = None): self.items = items self.heap_size = size or len(items) def __getitem__(self, key): return self.items[key] def __setitem__(self, key, value): self.items[key] = value def __len__(self): return len(self.items) def left(i): return 2 * i + 1 def right(i): return 2 * i + 2 def parent(i): return (i - 1) // 2 ############################################################################## # Standard BUILD-MAX-HEAP ############################################################################## def max_heapify(A, i): l = left(i) r = right(i) if l < A.heap_size and A[l] > A[i]: largest = l else: largest = i if r < A.heap_size and A[r] > A[largest]: largest = r if largest != i: A[i], A[largest] = A[largest], A[i] max_heapify(A, largest) def build_max_heap(A): A.heap_size = len(A) for i in range(len(A) // 2, -1, -1): max_heapify(A, i) ############################################################################## # Exercise BUILD-MAX-HEAP' ############################################################################## def heap_increase_key(A, i, key): if key < A[i]: raise Exception("new key is smaller than current key") A[i] = key while i > 0 and A[parent(i)] < A[i]: A[i], A[parent(i)] = A[parent(i)], A[i] i = parent(i) def max_heap_insert(A, key): A.heap_size += 1 A[A.heap_size - 1] = float("-inf") heap_increase_key(A, A.heap_size - 1, key) def build_max_heap2(A): A.heap_size = 1 for i in range(1, len(A)): max_heap_insert(A, A[i]) ================================================ FILE: other/clrs/06/problems/01.run.py ================================================ import os.path as path import random import time filename = path.join(path.dirname(__file__), '01.py') exec(open(filename).read()) data = [1, 2, 3, 4, 5, 6] funcs = [("BUILD-MAX-HEAP: ", build_max_heap), ("BUILD-MAX-HEAP':", build_max_heap2)] print('Heap builds for: {}'.format(', '.join(map(str, data)))) print('---------------------------------') for (label, func) in funcs: h = heap(data[:]) func(h) print('{} {}'.format(label, ', '.join(str(item) for item in h.items))) ================================================ FILE: other/clrs/06/problems/02.c ================================================ #include #include #include #define PARENT(i,d) ((i - 1) / d) #define CHILD(i,c,d) (3 * i + c + 1) typedef struct { int *elements; int d; int heap_size; int length; } heap_t; void max_heapify(heap_t *heap, int i) { int largest = i; for (int k = 0; k < heap->d; k++) { int child = CHILD(i, k, heap->d); if (child < heap->heap_size && heap->elements[child] > heap->elements[largest]) largest = child; } if (largest != i) { int tmp = heap->elements[i]; heap->elements[i] = heap->elements[largest]; heap->elements[largest] = tmp; max_heapify(heap, largest); } } int extract_max(heap_t *heap) { int max = heap->elements[0]; heap->elements[0] = heap->elements[heap->heap_size - 1]; heap->heap_size--; max_heapify(heap, 0); return max; }; void increase_key(heap_t *heap, int i, int key) { if (key < heap->elements[i]) { exit(0); fprintf(stderr, "new key is smaller than current key\n"); } while (i > 0 && heap->elements[PARENT(i,heap->d)] < key) { heap->elements[i] = heap->elements[PARENT(i,heap->d)]; i = PARENT(i,heap->d); } heap->elements[i] = key; } void insert(heap_t *heap, int key) { heap->heap_size++; heap->elements[heap->heap_size - 1] = INT_MIN; increase_key(heap, heap->heap_size - 1, key); } ================================================ FILE: other/clrs/06/problems/02.markdown ================================================ ## Analysis of d-ary heaps > A **d-ary heap** is like a binary heap, but (with one possible exception) > non-leaf nodes have $d$ children instead of 2 children. > > 1. How would you represent a $d$-ary heap in an array? > 2. What is the height of a $d$-ary heap of $n$ elements in terms of $n$ and > $d$? > 3. Give an efficient implementation of `EXTRACT-MAX` in a $d$-ary max-heap. > Analyze its running time in terms of $d$ and $n$. > 4. Give an efficient implementation of `INSERT` in $d$-ary max-heap. Analyze > its running time in terms of $d$ and $n$. > 5. Give an efficient implementation of `INCREASE-KEY(A, i, k)`, which flags > an error if $k < A[i]$, but otherwise sets $A[i] = k$ and then updates the > $d$-ary max-heap structure appropriately. Analyze its running time in > terms of $d$ and $n$. ### Representation We just modify `LEFT`, `RIGHT` and `PARENT`. We can get the $k$-th child of the $i$th node with $d i + k - 1$ and the parent with $\lfloor i/d \rfloor$ (when indexing is 1-based). ### Height Of course it's $\log_dn$. ### Implementation The implementation is below. The complexity of `EXTRACT-MAX` is $\O(d\log_dn)$, while the other two are $\O(\log_dn)$. ================================================ FILE: other/clrs/06/problems/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" TEST(extract_min) { int actual[] = {13, 12, 10, 11, 5, 9, 8, 1, 7, 2, 4, 6, 3}, expected[] = {12, 9, 10, 11, 5, 3, 8, 1, 7, 2, 4, 6}; heap_t heap = {actual, 3, 13, 13}; int max = extract_max(&heap); ASSERT_EQUALS(max, 13); ASSERT_EQUALS(heap.heap_size, 12); ASSERT_SAME_ARRAYS_S(heap.elements, expected, 12); } TEST(insert) { int actual[] = {14, 12, 10, 11, 5, 9, 8, 1, 7, 2, 4, 6, -1}, expected[] = {14, 12, 10, 13, 5, 9, 8, 1, 7, 2, 4, 6, 11}; heap_t heap = {actual, 3, 12, 13}; insert(&heap, 13); ASSERT_EQUALS(heap.heap_size, 13); ASSERT_SAME_ARRAYS_S(heap.elements, expected, 13); } ================================================ FILE: other/clrs/06/problems/03.c ================================================ #include #include #include #include typedef struct { int i; int j; } cell; typedef struct { int *elements; int m; int n; } tableau_t; cell up(cell c) { cell result = {c.i - 1, c.j}; return result; } cell down(cell c) { cell result = {c.i + 1, c.j}; return result; } cell left(cell c) { cell result = {c.i, c.j - 1}; return result; } cell right(cell c) { cell result = {c.i, c.j + 1}; return result; } cell make_cell(int i, int j) { cell result = {i, j}; return result; } bool within(tableau_t *tableau, cell c) { return (c.i >= 0 && c.j >= 0 && c.i < tableau->m && c.j < tableau->n); } int get(tableau_t *tableau, cell c) { int index = c.i * tableau->n + c.j; return tableau->elements[index]; } void set(tableau_t *tableau, cell c, int value) { int index = c.i * tableau->n + c.j; tableau->elements[index] = value; } void init_empty_tableau(tableau_t *tableau) { for (int i = 0; i < tableau->m * tableau-> n; i++) { tableau->elements[i] = INT_MAX; } } int extract_min(tableau_t *tableau) { int min, new; cell current = {0, 0}, next; new = INT_MAX; min = get(tableau, current); set(tableau, current, INT_MAX); while (true) { int smallest; cell d = down(current); cell r = right(current); if (within(tableau, d) && get(tableau, d) < new) { next = d; smallest = get(tableau, next); } else { smallest = new; } if (within(tableau, r) && get(tableau, r) < smallest) { next = r; smallest = get(tableau, next); } if (new == smallest) { set(tableau, current, new); break; } set(tableau, current, smallest); current = next; } return min; } void insert(tableau_t *tableau, int key) { cell current = make_cell(tableau->m - 1, tableau->n - 1), next; if (get(tableau, current) != INT_MAX) { fprintf(stderr, "tableau is full\n"); exit(0); } while (true) { int largest; cell u = up(current); cell l = left(current); if (within(tableau, u) && get(tableau, u) > key) { next = u; largest = get(tableau, next); } else { largest = key; } if (within(tableau, l) && get(tableau, l) > largest) { next = l; largest = get(tableau, next); } if (key == largest) { set(tableau, current, key); break; } set(tableau, current, largest); current = next; } } void sort(int *array, int size_sqrt) { int elements[size_sqrt * size_sqrt]; tableau_t tableau = {elements, size_sqrt, size_sqrt}; init_empty_tableau(&tableau); for (int i = 0; i < size_sqrt * size_sqrt; i++) { insert(&tableau, array[i]); } for (int i = 0; i < size_sqrt * size_sqrt; i++) { int next = extract_min(&tableau); array[i] = next; } } bool find(tableau_t *tableau, int key) { cell c = {tableau->m - 1, 0}; while (within(tableau, c)) { int value = get(tableau, c); if (value == key) { return true; } else if (value > key) { c = up(c); } else { c = right(c); } } return false; } ================================================ FILE: other/clrs/06/problems/03.markdown ================================================ ## Young tableaus > An $m \times n$ **Young tableau** is an $m \times n$ matrix such that the > entries of each row are in sorted order from left to right and the entries of > each column are in sorted order from top to bottom. Some of the entries of a > Young tableau may be $\infty$, which we treat as nonexistent elements. Thus, > a Young tableau can be used to hold $r \le mn$ finite numbers. > > 1. Draw $4 \times 4$ tableau containing the elements $\\{9, 16, 3, 2, 4, 8, > 5, 14, 12\\}$ > 2. Argue that an $m \times n$ Young tableau $Y$ is empty if $Y[1, 1] = > \infty$. Argue that $Y$ is full (contains $mn$ elements) if $Y[m, n] < > \infty$. > 3. Give an algorithm to implement `EXTRACT-MIN` on a nonempty $m \times n$ > Young tableau that runs in $\O(m + n)$ time. Your algorithm should use a > recursive subroutine that solves an $m \times n$ problem by recursively > solving either an $(m - 1) \times n$ or an $m \times (n - 1)$ subproblem. > (Hint: Think about `MAX-HEAPIFY`.) Define $T(p)$ where $p = m + n$, to be > the maximum running time of `EXTRACT-MIN` on any $m \times n$ Young > tableau. Give and solve a recurrence relation for $T(p)$ that yields the > $\O(m + n)$ time bound. > 4. Show how to insert a new element into a nonfull $m \times n$ Young tableau > in $\O(m + n)$ time > 5. Using no other sorting method as a subroutine, show how to use an $n > \times n$ Young tableau to sort $n^2$ numbers in $\O(n^3)$ time. > 6. Give an $\O(m + n)$-time algorithm to determine whether a given number is > stored in a given $m \times n$ Young tableau. ### Draw a tableau $$ \begin{matrix} 2 & 3 & 12 & 14 \\\\ 4 & 8 & 16 & \infty \\\\ 5 & 9 & \infty & \infty \\\\ \infty & \infty & \infty & \infty \\\\ \end{matrix} $$ ### Empty and full If the top left element is $\infty$, then all the elements on the first row need to be $\infty$. But if this is the case, all other elements need to be $\infty$ because they are larger than the first element on their column. If the bottom right element is smaller than $\infty$, all the elements on the bottom row need to be smaller than $\infty$. But so are the other elements in the tableau, because each is smaller than the bottom element of its column. ### Extracting a minimum element The $A[1, 1]$ is the smallest elemnt. We store it, so we can return it later and then replace is with $\infty$. This breaks the Young tableau property and we need to perform a procedure, similar to `MAX-HEAPIFY` to restore it. We compare $A[i, j]$ with each of its neighbours and exchange it with the smallest. This restores the property for $A[i, j]$ but reduces the problem to either $A[i, j+1]$ or $A[i+1, j]$. We terminate when $A[i,j]$ is smaller than its neighbours. The relation in question is: $$ T(p) = T(p - 1) + \O(1) = T(p-2) + \O(1) + \O(1) = \ldots = \O(p) $$ ### Inserting a new element The algorithm is very similar to the previous, except that we start with the bottom right element of the tableau and move it upwards and leftwards to the correct position. The asymptotic analysis is the same. ### Sorting We can sort by starting with an empty tableau and inserting all the $n^2$ elements in it. Each insertion is $\O(n + n) = \O(n)$. The complexity is $n^2\O(n) = \O(n^3)$. Afterwards we can take them one by one and put them back in the original array which has the same complexity. In total, its $\O(n^3)$. We can also do it in place if we allow for "partial" tableaus where only a portion of the top rows (and a portion of the last of them) is in the tableau. Then we can build the tableau in place and then start putting each minimal element to the end. This would be asymptotically equal, but use constant memory. It would also sort the array in reverse. ### Finding We from the lower-left corner. We check the current element $current$ with the one we're looking for $key$ and move up if $current > key$ and right if $current < key$. We declare success if $current = key$ and otherwise terminate if we walk off the tableau. ================================================ FILE: other/clrs/06/problems/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" TEST(extract_min) { int actual[] = { 1, 3, 7, 8, 2, 5, 9, 100, 4, 100, 100, 100}, expected[] = { 2, 3, 7, 8, 4, 5, 9, 100, 100, 100, 100, INT_MAX}; tableau_t tableau = {actual, 3, 4}; int min = extract_min(&tableau); ASSERT_EQUALS(min, 1); ASSERT_SAME_ARRAYS_S(tableau.elements, expected, 12); } TEST(insert) { int actual[] = { 1, 3, 7, 8, 2, 5, 10, 100, 4, 100, 100, INT_MAX}, expected[] = { 1, 3, 7, 8, 2, 5, 9, 10, 4, 100, 100, 100}; tableau_t tableau = {actual, 3, 4}; insert(&tableau, 9); ASSERT_SAME_ARRAYS_S(tableau.elements, expected, 12); } TEST(sort) { int expected[] = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16}, actual[] = {9, 6, 13, 8, 16, 2, 14, 5, 4, 11, 3, 1, 12, 7, 10, 15}; sort(actual, 4); ASSERT_SAME_ARRAYS(expected, actual); } TEST(find) { int numbers[] = { 1, 3, 7, 8, 2, 5, 10, 100, 4, 100, 100, INT_MAX}; tableau_t tableau = {numbers, 3, 4}; ASSERT_TRUE(find(&tableau, 1)); ASSERT_TRUE(find(&tableau, 2)); ASSERT_TRUE(find(&tableau, 3)); ASSERT_TRUE(find(&tableau, 4)); ASSERT_TRUE(find(&tableau, 5)); ASSERT_TRUE(find(&tableau, 7)); ASSERT_TRUE(find(&tableau, 8)); ASSERT_TRUE(find(&tableau, 10)); ASSERT_FALSE(find(&tableau, 0)); ASSERT_FALSE(find(&tableau, 6)); ASSERT_FALSE(find(&tableau, 9)); ASSERT_FALSE(find(&tableau, 11)); } ================================================ FILE: other/clrs/07/01/01.dot ================================================ graph Partition { node [shape=box style=filled fillcolor=white]; subgraph cluster_A { a1[label=13]; a2[label=19]; a3[label=3]; a4[label=5]; a5[label=12]; a6[label=8]; a7[label=7]; a8[label=4]; a9[label=21]; a10[label=2]; a11[label=6]; a12[label=11 fillcolor=black fontcolor=white]; { rank=same; a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12; } { edge[style=invis]; a1 -- a2 -- a3 -- a4 -- a5 -- a6 -- a7 -- a8 -- a9 -- a10 -- a11 -- a12; } } subgraph cluster_B { b1[label=13 fillcolor="#dddddd"]; b2[label=19]; b3[label=3]; b4[label=5]; b5[label=12]; b6[label=8]; b7[label=7]; b8[label=4]; b9[label=21]; b10[label=2]; b11[label=6]; b12[label=11 fillcolor=black fontcolor=white]; { rank=same; b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12; } { edge[style=invis]; b1 -- b2 -- b3 -- b4 -- b5 -- b6 -- b7 -- b8 -- b9 -- b10 -- b11 -- b12; } } subgraph cluster_C { c1[label=13 fillcolor="#dddddd"]; c2[label=19 fillcolor="#dddddd"]; c3[label=3]; c4[label=5]; c5[label=12]; c6[label=8]; c7[label=7]; c8[label=4]; c9[label=21]; c10[label=2]; c11[label=6]; c12[label=11 fillcolor=black fontcolor=white]; { rank=same; c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12; } { edge[style=invis]; c1 -- c2 -- c3 -- c4 -- c5 -- c6 -- c7 -- c8 -- c9 -- c10 -- c11 -- c12; } } subgraph cluster_D { d1[label=3 fillcolor="#999999"]; d2[label=19 fillcolor="#dddddd"]; d3[label=13 fillcolor="#dddddd"]; d4[label=5]; d5[label=12]; d6[label=8]; d7[label=7]; d8[label=4]; d9[label=21]; d10[label=2]; d11[label=6]; d12[label=11 fillcolor=black fontcolor=white]; { rank=same; d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12; } { edge[style=invis]; d1 -- d2 -- d3 -- d4 -- d5 -- d6 -- d7 -- d8 -- d9 -- d10 -- d11 -- d12; } } subgraph cluster_E { e1[label=3 fillcolor="#999999"]; e2[label=5 fillcolor="#999999"]; e3[label=13 fillcolor="#dddddd"]; e4[label=19 fillcolor="#dddddd"]; e5[label=12]; e6[label=8]; e7[label=7]; e8[label=4]; e9[label=21]; e10[label=2]; e11[label=6]; e12[label=11 fillcolor=black fontcolor=white]; { rank=same; e1, e2, e3, e4, e5, e6, e7, e8, e9, e10, e11, e12; } { edge[style=invis]; e1 -- e2 -- e3 -- e4 -- e5 -- e6 -- e7 -- e8 -- e9 -- e10 -- e11 -- e12; } } subgraph cluster_F { f1[label=3 fillcolor="#999999"]; f2[label=5 fillcolor="#999999"]; f3[label=13 fillcolor="#dddddd"]; f4[label=19 fillcolor="#dddddd"]; f5[label=12 fillcolor="#dddddd"]; f6[label=8]; f7[label=7]; f8[label=4]; f9[label=21]; f10[label=2]; f11[label=6]; f12[label=11 fillcolor=black fontcolor=white]; { rank=same; f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12; } { edge[style=invis]; f1 -- f2 -- f3 -- f4 -- f5 -- f6 -- f7 -- f8 -- f9 -- f10 -- f11 -- f12; } } subgraph cluster_G { g1[label=3 fillcolor="#999999"]; g2[label=5 fillcolor="#999999"]; g3[label=8 fillcolor="#999999"]; g4[label=19 fillcolor="#dddddd"]; g5[label=12 fillcolor="#dddddd"]; g6[label=13 fillcolor="#dddddd"]; g7[label=7]; g8[label=4]; g9[label=21]; g10[label=2]; g11[label=6]; g12[label=11 fillcolor=black fontcolor=white]; { rank=same; g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11, g12; } { edge[style=invis]; g1 -- g2 -- g3 -- g4 -- g5 -- g6 -- g7 -- g8 -- g9 -- g10 -- g11 -- g12; } } subgraph cluster_H { h1[label=3 fillcolor="#999999"]; h2[label=5 fillcolor="#999999"]; h3[label=8 fillcolor="#999999"]; h4[label=7 fillcolor="#999999"]; h5[label=12 fillcolor="#dddddd"]; h6[label=13 fillcolor="#dddddd"]; h7[label=19 fillcolor="#dddddd"]; h8[label=4]; h9[label=21]; h10[label=2]; h11[label=6]; h12[label=11 fillcolor=black fontcolor=white]; { rank=same; h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12; } { edge[style=invis]; h1 -- h2 -- h3 -- h4 -- h5 -- h6 -- h7 -- h8 -- h9 -- h10 -- h11 -- h12; } } subgraph cluster_I { i1[label=3 fillcolor="#999999"]; i2[label=5 fillcolor="#999999"]; i3[label=8 fillcolor="#999999"]; i4[label=7 fillcolor="#999999"]; i5[label=4 fillcolor="#999999"]; i6[label=13 fillcolor="#dddddd"]; i7[label=19 fillcolor="#dddddd"]; i8[label=12 fillcolor="#dddddd"]; i9[label=21]; i10[label=2]; i11[label=6]; i12[label=11 fillcolor=black fontcolor=white]; { rank=same; i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12; } { edge[style=invis]; i1 -- i2 -- i3 -- i4 -- i5 -- i6 -- i7 -- i8 -- i9 -- i10 -- i11 -- i12; } } subgraph cluster_J { j1[label=3 fillcolor="#999999"]; j2[label=5 fillcolor="#999999"]; j3[label=8 fillcolor="#999999"]; j4[label=7 fillcolor="#999999"]; j5[label=4 fillcolor="#999999"]; j6[label=13 fillcolor="#dddddd"]; j7[label=19 fillcolor="#dddddd"]; j8[label=12 fillcolor="#dddddd"]; j9[label=21 fillcolor="#dddddd"]; j10[label=2]; j11[label=6]; j12[label=11 fillcolor=black fontcolor=white]; { rank=same; j1, j2, j3, j4, j5, j6, j7, j8, j9, j10, j11, j12; } { edge[style=invis]; j1 -- j2 -- j3 -- j4 -- j5 -- j6 -- j7 -- j8 -- j9 -- j10 -- j11 -- j12; } } subgraph cluster_K { k1[label=3 fillcolor="#999999"]; k2[label=5 fillcolor="#999999"]; k3[label=8 fillcolor="#999999"]; k4[label=7 fillcolor="#999999"]; k5[label=4 fillcolor="#999999"]; k6[label=2 fillcolor="#999999"]; k7[label=19 fillcolor="#dddddd"]; k8[label=12 fillcolor="#dddddd"]; k9[label=21 fillcolor="#dddddd"]; k10[label=13 fillcolor="#dddddd"]; k11[label=6]; k12[label=11 fillcolor=black fontcolor=white]; { rank=same; k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12; } { edge[style=invis]; k1 -- k2 -- k3 -- k4 -- k5 -- k6 -- k7 -- k8 -- k9 -- k10 -- k11 -- k12; } } subgraph cluster_L { l1[label=3 fillcolor="#999999"]; l2[label=5 fillcolor="#999999"]; l3[label=8 fillcolor="#999999"]; l4[label=7 fillcolor="#999999"]; l5[label=4 fillcolor="#999999"]; l6[label=2 fillcolor="#999999"]; l7[label=6 fillcolor="#999999"]; l8[label=12 fillcolor="#dddddd"]; l9[label=21 fillcolor="#dddddd"]; l10[label=13 fillcolor="#dddddd"]; l11[label=19 fillcolor="#dddddd"]; l12[label=11 fillcolor=black fontcolor=white]; { rank=same; l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12; } { edge[style=invis]; l1 -- l2 -- l3 -- l4 -- l5 -- l6 -- l7 -- l8 -- l9 -- l10 -- l11 -- l12; } } subgraph cluster_M { m1[label=3 fillcolor="#999999"]; m2[label=5 fillcolor="#999999"]; m3[label=8 fillcolor="#999999"]; m4[label=7 fillcolor="#999999"]; m5[label=4 fillcolor="#999999"]; m6[label=2 fillcolor="#999999"]; m7[label=6 fillcolor="#999999"]; m8[label=11 fillcolor=black fontcolor=white]; m9[label=21 fillcolor="#dddddd"]; m10[label=13 fillcolor="#dddddd"]; m11[label=19 fillcolor="#dddddd"]; m12[label=12 fillcolor="#dddddd"]; { rank=same; m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11, m12; } { edge[style=invis]; m1 -- m2 -- m3 -- m4 -- m5 -- m6 -- m7 -- m8 -- m9 -- m10 -- m11 -- m12; } } { edge[style=invis]; a1 -- b1 -- c1 -- d1 -- e1 -- f1 -- g1 -- h1 -- i1 -- j1 -- k1 -- l1 -- m1; } } ================================================ FILE: other/clrs/07/01/01.markdown ================================================ > Using figure 7.1 as a model, illustrate the operation of `PARTITION` on the > array $A = \langle 13, 19, 9, 5, 12, 8, 7, 4, 21, 2, 6, 11 \rangle$. ================================================ FILE: other/clrs/07/01/02.markdown ================================================ > What value of $q$ does `PARTITION` return when all elements in the array $A[p > \ldots r]$ have the same value? Modify `PARTITION` so that $q = \lfloor > (p+r)/2 \rfloor$ when all elements in the array $A[p \ldots r]$ have the same > value. It returns $r$. We can modify `PARTITION` by counting the number of comparisons in which $A[j] = A[r]$ and then subtracting half that number from the pivot index. ================================================ FILE: other/clrs/07/01/02.py ================================================ def partition(numbers, start = 0, end = None): last = end - 1 if end else len(numbers) - 1 pivot_value = numbers[last] pivot = start repetitions = 0 for i in range(start, last): value = numbers[i] if value == pivot_value: repetitions += 1 if value <= pivot_value: numbers[pivot], numbers[i] = numbers[i], numbers[pivot] pivot += 1 numbers[pivot], numbers[last] = numbers[last], numbers[pivot] return pivot - repetitions // 2 def quicksort(numbers, start = 0, end = None): end = end if end else len(numbers) if start < end - 1: pivot = partition(numbers, start, end) quicksort(numbers, start, pivot) quicksort(numbers, pivot + 1, end) ================================================ FILE: other/clrs/07/01/02.test.py ================================================ import unittest import random import os.path as path import random import time filename = path.join(path.dirname(__file__), '02.py') exec(open(filename).read()) class PartitionTest(unittest.TestCase): def test_normal_partition(self): numbers = [13, 19, 3, 5, 12, 8, 7, 4, 21, 2, 6, 11] pivot = partition(numbers) self.assertEqual(pivot, 7) self.assertEqual(numbers, [3, 5, 8, 7, 4, 2, 6, 11, 21, 13, 19, 12]) def test_partition_with_repetition(self): self.assertEqual(partition([2, 2, 2, 2, 2, 2]), 3) self.assertEqual(partition([1, 2, 2, 2, 3, 2]), 3) def test_quicksort(self): numbers = [13, 19, 3, 5, 12, 8, 7, 4, 21, 2, 6, 11] expected = sorted(numbers) quicksort(numbers) self.assertEqual(numbers, expected) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/07/01/03.markdown ================================================ > Give a brief argument that the running time of `PARTITION` on a subarray of > size $n$ is $\Theta(n)$ There is a **for** statement whose body executes $r - 1 - p = \Theta(n)$ times. In the worst case every time the body of the **if** is executed, but it takes constant time and so does the code outside of the loop. Thus the running time is $\Theta(n)$. ================================================ FILE: other/clrs/07/01/04.markdown ================================================ > How would you modify `QUICKSORT` to sort into nonincreasing order? We only need to flip the condition on line 4. ================================================ FILE: other/clrs/07/02/01.markdown ================================================ > Use the substitution method to prove that the recurrence $T(n) = T(n-1) + > \Theta(n)$ has the solution $T(n) = \Theta(n^2)$, as claimed at the beginning > of section 7.2 We represent $\Theta(n)$ as $c_2n$ and we guess that $T(n) \le c_1n^2$ $$ \begin{aligned} T(n) &= T(n-1) + c_2n \\\\ &\le c_1(n-1)^2 + c_2n \\\\ &= c_1n^2 - 2c_1n + c_1 + c_2n & (2c_1 > c_2, n \ge c_1/(2c_1 - c_2))\\\\ &\le c_1n^2 \end{aligned} $$ ================================================ FILE: other/clrs/07/02/02.markdown ================================================ > What is the running time of `QUICKSORT` when all elements of the array $A$ > have the same value? It is $\Theta(n^2)$, since one of the partitions is always empty (see exercise 7.1.2). ================================================ FILE: other/clrs/07/02/03.markdown ================================================ > Show that the running time of `QUICKSORT` is $\Theta(n^2)$ when the array $A$ > contains distict elements and is sorted in decreasing order. In this case `PARTITION` always returns $p$ because all the elements are greater than the pivot. While the **if** will never be executed, we still get one empty partition and the recurrence is $T(n) = T(n-1) + \Theta(n)$ (even if its body is not executed, the **for** is still $\Theta(n)$). ================================================ FILE: other/clrs/07/02/04.markdown ================================================ > Banks often record transactions on an account in order of the times of the > transactions, but many people like to receive their bank statements with > checks listed in order by check numbers. People usually write checks in order > by check number, and merchants usually cash them with reasonable dispatch. The > problem of converting time-of-transaction ordering to check-number ordering > is therefore the problem of sorting almost-sorted input. Argue that the > procedure `INSERTION-SORT` would tend to beat the procedure `QUICKSORT` on > this problem. A simple intuitive argument will suffice here. The more sorted the array is, the less work insertion sort will do. Namely, `INSERTION-SORT` is $\Theta(n + d)$, where $d$ is the number of inversions in the array. In the example above the number of inversions tends to be small so insertion sort will be close to linear. On the other hand, if `PARTITION` does pick a pivot that does not participate in an inversion, it will produce an empty partition. Since there is a small number of inversions, `QUICKSORT` is very likely to produce empty partitions. ================================================ FILE: other/clrs/07/02/05.markdown ================================================ > Suppose that the splits at every level of quicksort are in proportion $1 - > \alpha$ to $\alpha$, where $0 < \alpha \le 1/2$ is a constant. Show that the > minumum depth of a leaf in the recursion tree is approximately > $-\lg{n}/lg{\alpha}$ and the maximum depth is approximately > $-\lg{n}/\lg(1-\alpha)$. (Don't worry about integer round-off) The minimum depth of the tree is the solution of $n\alpha^x \le 1$: $$ n\alpha^x \le 1 \\\\ \Downarrow \\\\ \alpha^x \le \frac 1 n \\\\ \Downarrow \\\\ x \ge \log_{\alpha}\frac{1}{n} \\\\ \Downarrow \\\\ \log_{\alpha}\frac{1}{n} = \log_{1/\alpha} = \frac{\lg{n}}{\lg(1/\alpha)} = - \frac{\lg{n}}{\lg{\alpha}} $$ In the same way, the maximum depth is $\log_{1/(1-\alpha)}n = - \frac{\lg{n}}{\lg(1-\alpha)}$ ================================================ FILE: other/clrs/07/02/06.markdown ================================================ > $\star$ Argue that for any constant $0 < \alpha \le 1/2$, the probability is > approximately $1 - 2\alpha$ that on a random input array, `PARTITION` > produces a split more balanced than $1 - \alpha$ to $\alpha$. Oh, this is nice! In order to produce a worse split than $\alpha$ to $1 - \alpha$, `PARTITION` must pick a pivot that will be either within the smallest $\alpha n$ elements or the largest $\alpha n$ elements. The probability of either is (approximately) $\alpha n / n = \alpha$ and the probability of both is $2\alpha$. Thus, the probability of having a better partition is the complement, $1 - 2\alpha$. Sweet! ================================================ FILE: other/clrs/07/03/01.markdown ================================================ > Why do we analyze the expected running time of a randomized algorithm and not > its worst-case running time? The worst-case running time is not triggered by a specific output, but occurs randomly. We're not interested in it, since we cannot reproduce it reliably. Instead, it is factored in the analysis of the expected running time. ================================================ FILE: other/clrs/07/03/02.markdown ================================================ > When `RANDOMIZED-QUICKSORT` runs, how many calls are made to the random > number generator `RANDOM` in the worst case? How about in the best case? Give > your answer in terms of $\Theta$-notation. In the worst case, the number of calls to `RANDOM` is: $$ T(n) = T(n-1) + 1 = n = \Theta(n) $$ As for the best case: $$ T(n) = 2T(n/2) + 1 = \Theta(n) $$ This is not too surprising, because each third element (at least) gets picked as pivot. ================================================ FILE: other/clrs/07/04/01.markdown ================================================ > Show that in the recurrence > > $$ T(n) = \max_{0 \le q \le n-1} (T(q) + T(n-q-1)) + \Theta(n) $$ > > $$ T(n) = \Omega(n^2) $$ We guess $T(n) \ge cn^2 - 2n$: $$ \begin{aligned} T(n) &= \max_{0 \le q \le n-1} (T(q) + T(n-q-1)) + \Theta(n) \\\\ &\ge \max_{0 \le q \le n-1} (cq^2 - 2q + c(n-q-1)^2 - 2n - 2q -1) + \Theta(n) \\\\ &\ge c\max_{0 \le q \le n-1} (q^2 + (n-q-1)^2 - (2n + 4q + 1)/c) + \Theta(n) \\\\ &\ge cn^2 - c(2n-1) + \Theta(n) \\\\ &\ge cn^2 - 2cn + 2c & (c \le 1) \\\\ &\ge cn^2 - 2n \end{aligned} $$ ================================================ FILE: other/clrs/07/04/02.markdown ================================================ > Show that quicksort's best-case running time is $\Omega(n\lg{n})$. The best case happens when the partition is even, that is: $$ T(n) = 2T(n/2) + \Theta(n) $$ Using the master method, we get the solution $\Theta(n\lg{n})$. ================================================ FILE: other/clrs/07/04/03.markdown ================================================ > Show that the expression $q^2 + (n - q - 1)^2$ achieves a maximum over $q = > 0, 1, \ldots, n-1$ when $q = 0$ and $q = n - 1$. $$ \begin{aligned} f(q) &= q^2 + (n - q - 1)^2 \\\\ f'(q) &= 2q - 2(n - q - 1) = 4q - 2n + 2 \\\\ f''(q) &= 4 \\\\ \end{aligned} $$ $f'(q) = 0$ when $q = \frac{1}{2}n - \frac{1}{4}$. $f'(q)$ is also continious. $\forall q : f''(q) > 0$, which means that $f'(q)$ is negative left of $f'(q) = 0$ and positive right of it, which means that this is a local minima. In this case, $f(q)$ is decreasing in the beginning of the interval and increasing in the end, which means that those two points are the only candidates for a maximum in the interval. $$ f(0) = (n - 1)^2 \\\\ f(n-1) = (n - 1)^2 + 0^2 $$ ================================================ FILE: other/clrs/07/04/04.markdown ================================================ > Show that `RANDOMIZED-QUICKSORT`'s expected running time is > $\Omega(n\lg{n})$. We use the same reasoning for the expected number of comparisons, we just take in in a different direction. $$ \begin{aligned} \E[X] &= \sum_{i=1}^{n-1} \sum_{j=i+1}^n \frac{2}{j-i+1} \\\\ &= \sum_{i=1}^{n-1} \sum_{k=1}^{n-i} \frac{2}{k + 1} & (k \ge 1) \\\\ &\ge \sum_{i=1}^{n-1} \sum_{k=1}^{n-i} \frac{2}{2k} \\\\ &\ge \sum_{i=1}^{n-1} \Omega(\lg{n}) \\\\ &= \Omega(n\lg{n}) \end{aligned} $$ ================================================ FILE: other/clrs/07/04/05.c ================================================ #define K 550 int partition(int[], int, int); void limited_quicksort(int[], int, int, int); void insertion_sort(int[], int, int); void quicksort(int A[], int p, int r) { if (p < r - 1) { int q = partition(A, p, r); quicksort(A, p, q); quicksort(A, q + 1, r); } } void modified_quicksort(int A[], int p, int r) { limited_quicksort(A, p, r, K); insertion_sort(A, p, r); } void limited_quicksort(int A[], int p, int r, int treshold) { if (r - p > treshold) { int q = partition(A, p, r); limited_quicksort(A, p, q, treshold); limited_quicksort(A, q + 1, r, treshold); } } int partition(int A[], int p, int r) { int x, i, j, tmp; x = A[r - 1]; i = p; for (j = p; j < r - 1; j++) { if (A[j] <= x) { tmp = A[i]; A[i] = A[j]; A[j] = tmp; i++; } } tmp = A[i]; A[i] = A[r - 1]; A[r - 1] = tmp; return i; } void insertion_sort(int A[], int p, int r) { int i, j, key; for (j = p + 1; j < r; j++) { key = A[j]; for (i = j - 1; i >= p && A[i] > key; i--) { A[i + 1] = A[i]; } A[i + 1] = key; } } ================================================ FILE: other/clrs/07/04/05.markdown ================================================ > We can improve the running time of quicksort in practice by taking advantage > of the fast running time of insertion sort when its input is "nearly" sorted. > Upon calling quicksort on a subarray with fewer than $k$ elements, let it > simply return without sorting the subarray. After the top-level call to > quicksort returns, run insertion sort on the entire array to finish the > sorting process. Argue that this sorting algorithm runs in $\O(nk + n\lg(n/k))$ > expected time. How should we pick $k$, both in theory and practice? In the quicksort part of the proposed algorithm, the recursion stops at level $\lg(n/k)$, which makes the expected running time $\O(n\lg(n/k))$. However, this leaves $n/k$ non-sorted, non-intersecting subarrays of (maximum) length $k$. Because of the nature of the insertion sort algorithm, it will first sort fully one such subarray before consider the next one. Thus, it has the same complexity as sorting each of those arrays, that is $\frac{n}{k}\O(k^2) = \O(nk).$ In theory, if we ignore the constant factors, we need to solve: $$ n\lg{n} \ge nk + n\lg{n/k} \\\\ \Downarrow \\\\ \lg{n} \ge k + \lg{n} - \lg{k} \\\\ \Downarrow \\\\ \lg{k} \ge k $$ Which is not possible. If we add the constant factors, we get: $$ c_qn\lg{n} \ge c_ink + c_qn\lg(n/k) \\\\ \Downarrow \\\\ c_q\lg{n} \ge c_ik + c_q\lg{n} - c_q\lg{k} \\\\ \Downarrow \\\\ \lg{k} \ge \frac{c_i}{c_q}k $$ Which indicates that there might be a good candidate. Furthermore, the lower-order terms should be taken into consideration too. In practice, $k$ should be chosed by experiment. ================================================ FILE: other/clrs/07/04/05.run.c ================================================ #include #include #include #define SIZE 400000 #define SEED 300 #include "05.c" #define TIME(message, sort) \ randomize_array(array, SIZE, SEED); \ timer_start_time = clock(); \ sort(array, 0, SIZE); \ printf(message " = %f\n", (double) (clock() - timer_start_time) / CLOCKS_PER_SEC); \ check_sorted(array, SIZE); static clock_t timer_start_time; void randomize_array(int array[], unsigned length, unsigned int seed) { srand(seed); for (unsigned i = 0; i < length; i++) { array[i] = rand() % 1000 + 1; } } void check_sorted(int array[], int length) { for (int i = 1; i < length; i++) { if (array[i - 1] > array[i]) { printf("%d %d %d %d\n", i - 1, i, array[i - 1], array[i]); fprintf(stderr, "...but the array is not sorted!"); exit(1); } } } int main() { int *array = calloc(SIZE, sizeof(int)); printf("n = %d, k = %d\n", SIZE, K); printf("-----------------------------\n"); TIME("quicksort ", quicksort); TIME("modified-quicksort", modified_quicksort); return 0; } ================================================ FILE: other/clrs/07/04/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" TEST(trivial_case) { int array[] = {13, 19, 3, 5, 12, 8, 7, 4, 21, 2, 6, 11}, expected[] = {2, 3, 4, 5, 6, 7, 8, 11, 12, 13, 19, 21}; modified_quicksort(array, 0, sizeof(array) / sizeof(int)); ASSERT_SAME_ARRAYS(array, expected); } ================================================ FILE: other/clrs/07/04/06.markdown ================================================ > $\star$ Consider modifying the `PARTITION` procedure by randomly picking > three elements from array $A$ and partitioning about their median (the middle > value of the three elements). Approximate the probability of getting at worst > an $\alpha$-to-$(1-\alpha)$ split, as a function of $\alpha$ in the range > $0 < \alpha < 1$. First, for simplicity's sake, let's assume that we can pick the same element twice. Let's also assume that $0 < \alpha \le 1/2$. In order to get such a split, two out of three elements need need to be in the smallest $\alpha n$ elements. The probability of having one is $\alpha n / n = \alpha$. The probability of having exactly two is $\alpha^2 - \alpha^3$. There are three ways in which two elements can be in the smallest $\alpha n$ and one way in which all three can be in the smallest $\alpha n$ so the probability of getting such a median is $3\alpha^2 - 2\alpha^3$. We will get the same split if the median is in the largest $\alpha n$. Since the two events are mutually exclusive, the probability is: $$ \Pr\\{\text{OK split}\\} = 6\alpha^2 - 4\alpha^3 = 2\alpha^2(3 - 2\alpha) $$ ================================================ FILE: other/clrs/07/problems/01.c ================================================ #include int hoare_partition(int A[], int p, int r) { int x = A[p], i = p - 1, j = r, tmp; while(true) { do { j--; } while (!(A[j] <= x)); do { i++; } while (!(A[i] >= x)); if (i < j) { tmp = A[i]; A[i] = A[j]; A[j] = tmp; } else { return j; } } } void quicksort(int A[], int p, int r) { if (p < r - 1) { int q = hoare_partition(A, p, r); quicksort(A, p, q + 1); quicksort(A, q + 1, r); } } ================================================ FILE: other/clrs/07/problems/01.dot ================================================ graph Partition { node[shape=box style=filled fillcolor=white]; subgraph cluster_A { a1[label=13 fillcolor=black fontcolor=white]; a2[label=19]; a3[label=9]; a4[label=5]; a5[label=12]; a6[label=8]; a7[label=7]; a8[label=4]; a9[label=11]; a10[label=2]; a11[label=6]; a12[label=21]; { rank=same; a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12; } { edge[style=invis]; a1 -- a2 -- a3 -- a4 -- a5 -- a6 -- a7 -- a8 -- a9 -- a10 -- a11 -- a12; } } subgraph cluster_B { b1[label=6 fillcolor=lightgray]; b2[label=19]; b3[label=9]; b4[label=5]; b5[label=12]; b6[label=8]; b7[label=7]; b8[label=4]; b9[label=11]; b10[label=2]; b11[label=13 fillcolor=black fontcolor=white]; b12[label=21 fillcolor=lightgray]; { rank=same; b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12; } { edge[style=invis]; b1 -- b2 -- b3 -- b4 -- b5 -- b6 -- b7 -- b8 -- b9 -- b10 -- b11 -- b12; } } subgraph cluster_C { c1[label=6 fillcolor=lightgray]; c2[label=2 fillcolor=lightgray]; c3[label=9]; c4[label=5]; c5[label=12]; c6[label=8]; c7[label=7]; c8[label=4]; c9[label=11]; c10[label=19 fillcolor=lightgray]; c11[label=13 fillcolor=black fontcolor=white]; c12[label=21 fillcolor=lightgray]; { rank=same; c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12; } { edge[style=invis]; c1 -- c2 -- c3 -- c4 -- c5 -- c6 -- c7 -- c8 -- c9 -- c10 -- c11 -- c12; } } subgraph cluster_D { d1[label=6 fillcolor=lightgray]; d2[label=2 fillcolor=lightgray]; d3[label=9 fillcolor=lightgray]; d4[label=5 fillcolor=lightgray]; d5[label=12 fillcolor=lightgray]; d6[label=8 fillcolor=lightgray]; d7[label=7 fillcolor=lightgray]; d8[label=4 fillcolor=lightgray]; d9[label=11 fillcolor=lightgray]; d10[label=19 fillcolor=black fontcolor=white]; d11[label=13 fillcolor=lightgray]; d12[label=21 fillcolor=lightgray]; { rank=same; d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12; } { edge[style=invis]; d1 -- d2 -- d3 -- d4 -- d5 -- d6 -- d7 -- d8 -- d9 -- d10 -- d11 -- d12; } } { edge[style=invis]; a1 -- b1 -- c1 -- d1; } } ================================================ FILE: other/clrs/07/problems/01.markdown ================================================ ## Hoare partition correctness > The version of `PARTITION` given in this chapter is not the original > partitioning algorithm. Here is the original partition algorithm, which is > due to C.A.R. Hoare: > > HOARE-PARTITION(A, p, r) > x = A[p] > i = p - 1 > j = r + 1 > while TRUE > repeat > j = j - 1 > until A[j] ≤ x > repeat > i = i + 1 > until A[i] ≥ x > if i < j > exchange A[i] with A[j] > else return j > > 1. Demonstrate the operation of `HOARE-PARTITION` on the array $A = \langle > 13, 19, 9, 5, 12, 8, 7, 4, 11, 2, 6, 21 \rangle$, showing the values of > the array and auxiliary values after each iteration of the **while** loop > in lines 4-13. > > The next three questions ask you to give a careful argument that the > procedure `HOARE-PARTITION` is correct. Assuming that the subarray $A[p..r]$ > contains at least two elements, prove the following: > > 2. The indices $i$ and $j$ are such that we never access an element of $A$ > outside the subarray $A[p..r]$. > 3. When `HOARE-PARTITION` terminates, it returns a value $j$ such that $p \le > j < r$. > 4. Every element of $A[p..j]$ is less than or equal to every element of > $A[j + 1..r]$ when `HOARE-PARTITION` terminates. > > The `PARTITION` procedure in section 7.1 separates the pivot value > (originally in $A[r]$) from the two partitions it forms. The > `HOARE-PARTITION` procedure, on the other hand, always places the pivot value > (originally in $A[p]$) into one of the two parititions $A[p..j]$ and > $A[j + 1..r]$. Since $p \le j < r$, this split is always nontrivial. > > 5. Rewrite the `QUICKSORT` procedure to use `HOARE-PARTITION`. ### Demonstration At the end of the loop, the variables have the following values: x = 13 j = 9 i = 10 ### Correctness The indices will not walk of the array. At the first check $i < j$, $i = p$ and $j \ge p$ (because $A[p] = x$). If $i = j$, the algorithm will terminate without accessing "invalid" elements. If $i < j$, the next loop will also have indices $i$ and $j$ within the array, (because $i \le r$ and $j \ge p$). Note that if one of the indices gets to the end of the array, then $i$ won't be less or equal to $j$ any more. As for the return value, it will be at least one less than $j$. At the first iteration, either (1) $A[p]$ is the maximum element and then $i = p$ and $j = p < r$ or (2) it is not and $A[p]$ gets swapped with $A[j]$ where $j \le r$. The loop will not terminate and on the next iteration, $j$ gets decremented (before eventually getting returned). Combining those two cases we get $p \le j < r$. Finally, it's easy to observe the following invariant: > Before the condition comparing $i$ to $j$, all elements $A[p..i-1] \le x$ and > all elements $A[j+1..r] \ge x$. **Initialization**. The two **repeat** blocks establish just this condition. **Maintenance**. By exchanging $A[i]$ and $A[j]$ we make the $A[p..i] \le x$ and $A[j..r] \ge x$. Incrementing $i$ and decrementing $j$ maintain this invariant. **Termination**. The loop terminates when $i \ge j$. The invariant still holds at termination. The third bit follows directly from this invariant. ### Implementation There's some C code below. ================================================ FILE: other/clrs/07/problems/01.test.c ================================================ #include "01.c" #include "../../build/ext/test.h" TEST(partitioning) { int array[] = {13, 19, 9, 5, 12, 8, 7, 4, 11, 2, 6, 21}, expected[] = { 6, 2, 9, 5, 12, 8, 7, 4, 11, 19, 13, 21}; int index = hoare_partition(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(index, 8); ASSERT_SAME_ARRAYS(array, expected); } TEST(sorting) { int array[] = {13, 19, 9, 5, 12, 8, 7, 4, 11, 2, 6, 21}, expected[] = { 2, 4, 5, 6, 7, 8, 9, 11, 12, 13, 19, 21}; quicksort(array, 0, sizeof(array) / sizeof(int)); ASSERT_SAME_ARRAYS(array, expected); } ================================================ FILE: other/clrs/07/problems/02.c ================================================ #include #define EXCHANGE(a, b) tmp = a; a = b; b = tmp; typedef struct { int q; int t; } pivot_t; pivot_t partition(int[], int, int); pivot_t randomized_partition(int[], int, int); void quicksort(int A[], int p, int r) { if (p < r - 1) { pivot_t pivot = randomized_partition(A, p, r); quicksort(A, p, pivot.q); quicksort(A, pivot.t, r); } } pivot_t randomized_partition(int A[], int p, int r) { int i = rand() % (r - p) + p, tmp; EXCHANGE(A[i], A[r-1]); return partition(A, p, r); } pivot_t partition(int A[], int p, int r) { int x = A[r - 1], q = p, t, tmp; for (int i = p; i < r - 1; i++) { if (A[i] < x) { EXCHANGE(A[q], A[i]); q++; } } for (t = q; t < r && A[t] == x; t++); for (int i = r - 1; i >= t; i--) { if (A[i] == x) { EXCHANGE(A[t], A[i]); t++; } } pivot_t result = {q, t}; return result; } ================================================ FILE: other/clrs/07/problems/02.markdown ================================================ ## Quicksort with equal element values > The analysis of the expected running time of randomized quicksort in section > 7.4.2 assumes that all element values are distinct. In this problem. we > examine what happens when they are not. > > 1. Suppose that all element values are equal. What would be randomized > quick-sort's running time in this case? > 2. The `PARTITION` procedure returns an index $q$ such that each element of > $A[p \ldots q - 1]$ is less than or equal to $A[q]$ and each element of > $A[q + 1 \ldots r]$ is greater than $A[q]$. Modify the `PARTITION` > procedure to produce a procedure `PARTITION'(A, p, r)` which permutes the > elements of $A[p \ldots r]$ and returns two indices $q$ and $t$ where $p > \le q \le t \le r$, such that: >
    >
  • all elements of $A[q \ldots t]$ are equal,
    • >
  • each element of $A[p \ldots q - 1]$ is less than $A[q]$, and
    • >
  • each element of $A[t + 1 \ldots r]$ is greater than $A[q]$.
    • >
> Like `PARTITION`, your `PARTITION'` procedure should take $\Theta(r - p)$ > time. > 3. Modify the `RANDOMIZED-QUICKSORT` procedure to call `PARTITION'`, and name > the new procedure `RANDOMIZED-QUICKSORT'`. Then modify the `QUICKSORT` > procedure to produce a procedure `QUICKSORT'(p, r)` that calls > `RANDOMIZED-PARTITION'` and recurses only on partitions of elements not > know to be equal to each other. > 4. Using `QUICKSORT'`, how would you adjust the analysis of section 7.4.2 to > avoid the assumption that all elements are distinct? ### Running time It will be $\Theta(n^2)$, because each split will be (n-1)-to-1 (see exercise 7.1-2). ### Implementation The code is below. `PARTITION'` is very similar to `PARTITION`, except that after it completes arranging the elements around a pivot $q$, it moves all elements $t > q: A[t] = x$ right after $q$. That way we get a chuck of equal elements after the pivot. The procedure makes another pass at the array, which is at most $n$ more time and becuse $\Theta(n) + \Theta(n) = \Theta(n) = \Theta(r - p)$ we fulfill the condition. ### Analysis The analysis does not change much. Section 7.4.2 uses the knowledge that the elements are distinct in order to determine when two elements cannot be compared. It will still be true that in any interval $Z_{ij}$, two elements will get compared only if $z_i$ or $z_j$ gets picked as a pivot first. This would not hold with `PARTITION'` if there are repeated elements. Note that with this implementation, the number of comparisons increases, but only by a constant factor. The results from the analysis are the same. ================================================ FILE: other/clrs/07/problems/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" #include #include void randomize_array(int array[], unsigned length, unsigned int seed); bool is_sorted(int array[], int length); TEST(partitioning) { int array[] = {10, 19, 3, 5, 10, 8, 17, 4, 10, 2, 16, 10}, expected[] = { 3, 5, 8, 4, 2, 10, 10, 10, 10, 19, 16, 17}; pivot_t pivot = partition(array, 0, sizeof(array) / sizeof(int)); ASSERT_EQUALS(pivot.q, 5); ASSERT_EQUALS(pivot.t, 9); ASSERT_SAME_ARRAYS(array, expected); } TEST(sorting) { int array[] = {10, 19, 3, 5, 10, 8, 17, 4, 10, 2, 16, 10}, expected[] = { 2, 3, 4, 5, 8, 10, 10, 10, 10, 16, 17, 19}; quicksort(array, 0, sizeof(array) / sizeof(int)); ASSERT_SAME_ARRAYS(array, expected); } TEST(large_array) { int size = 100000, seed = 300, array[size]; randomize_array(array, size, seed); quicksort(array, 0, size); ASSERT_TRUE(is_sorted(array, size)); } void randomize_array(int array[], unsigned length, unsigned int seed) { srand(seed); for (unsigned i = 0; i < length; i++) { array[i] = rand() % 100 + 1; } } bool is_sorted(int array[], int length) { for (int i = 1; i < length; i++) { if (array[i - 1] > array[i]) { return false; } } return true; } ================================================ FILE: other/clrs/07/problems/03.markdown ================================================ ## Alternative quicksort analysis > An alternative analysis of the running time of randomized quicksort focuses > on the expected running time of each individual recursive call to > `RANDOMIZED-QUICKSORT`, rather than on the number of comparisons performed. > > 1. Argue that, given an array of size $n$, the probability that any > particular element is chosen as the pivot is $1/n$. Use this to define > indicator random variables $X_i = I\\{i\text{th smallest element is chosen > as the pivot}\\}$. What is $\E[X_i]$? > 2. Let $T(n)$ be a random variable denoting the running time of quicksort on > an array of size $n$. Argue that > $$ \E[T(n)] = \E\bigg[\sum_{q=1}^nX_q(T(q-1) + T(n-q) + \Theta(n))\bigg] \tag{7.5} $$ > 3. Show that we can rewrite equation (7.5) as > $$ \E[T(n)] = \frac{2}{n}\sum_{q=2}^{n-1}\E[T(q)] + \Theta(n) \tag{7.6} $$ > 4. Show that > $$ \sum_{k=2}^{n-1}k\lg{k} \le \frac{1}{2}n^2\lg{n} - \frac{1}{8}n^2 \tag{7.7} $$ > (Hint: Split the summation into two parts, one for $k = 2, 3, > \ldots, \lceil n/2 \rceil - 1$ and one for $k = \lceil n/2 \rceil, \ldots, > n - 1$. > 5. Using the bound from equation (7.7), show that the recurrence in equation > (7.6) has the solution $\E[T(n)] = \Theta(n\lg{n})$. (Hint: Show, > by substitution, that $\E[T(n)] \le an\lg{n}$ for sufficiently large $n$ > and for some positive constant $a$.) ### Choosing a pivot `PARTITION` is equally likely to pick any element as a pivot. Since there are $n$ elements, the probability of one being picked is $1/n$. For the same reason, $\E[X_i] = 1/n$. ### Running time of quicksort Let the $q$th smallest element be the pivot. There are $n$ possible choices for it, each with chance $X_q$. Each will solve the problem by breaking it down in two parts of size $q - 1$ and $n - q$ and adding a linear factor. The formula in (7.5) follows by the definition of expectation. ### The rewrite $$ \begin{aligned} \E[T(n)] &= \E\bigg[\sum_{q=1}^nX_q(T(q-1) + T(n-q) + \Theta(n))\bigg] \\\\ &= \sum_{q=1}^n\frac{1}{n}(\E[T(q-1)] + \E[T(n-q)] + \Theta(n))\bigg] \\\\ &= \frac{1}{n}\sum_{q=1}^n\E[T(q-1)] + \frac{1}{n}\sum_{q=1}^n\E[T(n - q)] + \frac{1}{n}\sum_{q=1}^n\Theta(n) \\\\ &= \frac{1}{n}\sum_{q=0}^{n-1}\E[T(q)] + \frac{1}{n}\sum_{q=0}^{n-1}\E[T(n - q + 1)] + \Theta(n) \\\\ &= \frac{1}{n}\sum_{q=0}^{n-1}\E[T(q)] + \frac{1}{n}\sum_{q=0}^{n-1}\E[T(q)] + \Theta(n) \\\\ &= \frac{2}{n}\sum_{q=0}^{n-1}\E[T(q)] + \Theta(n) \\\\ &= \frac{2}{n}\sum_{q=2}^{n-1}\E[T(q)] + \frac{2\E[T(0)]}{n} + \frac{2\E[T(1)]}{n} + \Theta(n) \\\\ &= \frac{2}{n}\sum_{q=2}^{n-1}\E[T(q)] + \Theta(n) \end{aligned} $$ ### The bound $$ \begin{aligned} \sum_{k=2}^{n-1}k\lg{k} &= \sum_{k=2}^{\lceil n/2 \rceil - 1}k\lg{k} + \sum_{k=\lceil n/2 \rceil}^{n - 1}k\lg{k} \\\\ &\le \sum_{k=2}^{n/2}k\lg{k} + \sum_{k=n/2 + 1}^{n}k\lg{k} \\\\ &\le \sum_{k=2}^{n/2}k\lg(n/2) + \sum_{k=n/2 + 1}^{n}k\lg{n} \\\\ &= \lg(n/2)\sum_{k=2}^{n/2}k\ + \lg{n}\sum_{k=n/2 + 1}^{n}k \\\\ &= (\lg{n} - \lg{2})\bigg(\frac{(n/2)(n/2 + 1)}{2}\bigg) + \lg{n}\bigg(\frac{n(n+1)}{2} - \frac{(n/2)(n/2 + 1)}{2}\bigg) \\\\ &= \lg{n}\frac{n(n+1)}{2} - \frac{(n/2)(n/2 + 1)}{2} \\\\ &= \frac{1}{2}\lg{n}(n^2 + 2n + 1) - \frac{1}{8}(n^2 + 2n + 1/8) \\\\ &= \frac{1}{2}n^2\lg{n} - \frac{1}{8}n^2 - \frac{8n\lg{n} + 4\lg{n} - 2n - 1/8}{8} \\\\ &\le \frac{1}{2}n^2\lg{n} - \frac{1}{8}n^2 \end{aligned} $$ ### The solution We guess $\E[T(n)] \le an\lg{n}$: $$ \begin{aligned} \E[T(n)] &= \frac{2}{n}\sum_{q=2}^{n-1}\E[T(q)] + \Theta(n) \\\\ &\le \frac{2}{n}\sum_{q=2}^{n-1}an\lg{n} + \Theta(n) & \text{(by the guess)} \\\\ &\le \frac{2a}{n}\bigg(\frac{1}{2}n^2\lg{n} - \frac{1}{8}n^2\bigg) + \Theta(n) & \text{(by 7.7)} \\\\ &= an\lg{n} - \frac{a}{4}n + \Theta(n) & \text{(by }\Theta\text{-notation)} \\\\ &\le an\lg{n} \end{aligned} $$ Note that $\Theta$-notation allows us to pick $a$ and $n$ such that the last derivation is possible. ================================================ FILE: other/clrs/07/problems/04.c ================================================ #include int partition(int[], int, int); static int stack_depth = 0; static int max_stack_depth = 0; void reset_stack_depth_counter(); void increment_stack_depth(); void decrement_stack_depth(); void tail_recursive_quicksort(int A[], int p, int r) { increment_stack_depth(); while (p < r - 1) { int q = partition(A, p, r); if (q < (p + r) / 2) { tail_recursive_quicksort(A, p, q); p = q; } else { tail_recursive_quicksort(A, q + 1, r); r = q; } } decrement_stack_depth(); } int partition(int A[], int p, int r) { int x, i, j, tmp; x = A[r - 1]; i = p; for (j = p; j < r - 1; j++) { if (A[j] <= x) { tmp = A[i]; A[i] = A[j]; A[j] = tmp; i++; } } tmp = A[i]; A[i] = A[r - 1]; A[r - 1] = tmp; return i; } void increment_stack_depth() { stack_depth++; if (max_stack_depth < stack_depth) { max_stack_depth = stack_depth; } } void decrement_stack_depth() { stack_depth--; } void reset_stack_depth_counter() { max_stack_depth = 0; stack_depth = 0; } ================================================ FILE: other/clrs/07/problems/04.markdown ================================================ ## Stack depth for quicksort > The `QUICKSORT` algorithm of Section 7.1 contains two recursive calls to > itself. After `QUICKSORT` calls `PARTITION`, it recursively sorts the left > subarray and then it recursively sorts the right subarray. The second > recursive call in `QUICKSORT` is not really necessary; we can avoid it by > using an iterative control structure. This technique, called **tail > recursion**, is provided automatically by good compilers. Consider the > following version of quicksort, which simulates tail recursion: > > TAIL-RECURSIVE-QUICKSORT(A, p, r) > while p < r > // Partition and sort left subarray > q = PARTITION(A, p, r) > TAIL-RECURSIVE-QUICKSORT(A, p, q - 1) > p = q + 1 > > 1. Argue that `TAIL-RECURSIVE-QUICKSORT(A, 1, A.length)` correctly sorts the > array $A$. > > Compilers usually execute recursive procedures by using a **stack** that > contains pertinent information, including the parameter values, for each > recursive call. The information for the most recent call is at the top of the > stack, and the information for the initial call is at the bottom. Upon > calling a procedure, its information is **pushed** onto the stack; when it > terminates, its information is **popped**. Since we assume that array > parameters are represented by pointers, the information for each procedure > call on the stack requires $\O(1)$ stack space. The **stack depth** is the > maximum amount of stack space used at any time during a computation. > > 2. Describe a scenario in which `TAIL-RECURSIVE-QUICKSORT`'s stack depth is > $\Theta(n)$ on an $n$-element input array. > 3. Modify the code for `TAIL-RECURSIVE-QUICKSORT` so that the worst-case > stack depth is $\Theta(\lg{n})$. Maintain the $\O(n\lg{n})$ expected > running time of the algorithm. ### Argue correctness The original version partitions the array and then calls `QUICKSORT` one on each side. This version does the same, although in a different fashion - instead of calling `TAIL-RECURSIVE-QUICKSORT`, it just changes `p` and restarts the loop. It amounts to the same. This is a straightforward tail-call unrolling. ### Linear stack depth This will happen whenever partition returns $r$. That is, whenever the array is sorted. ### Modified algorithm We are always doing a tail-recursive call on the second partition. We can modify the algorithm to do the tail recursion on the larger partition. That way, we'll consume less stack. ================================================ FILE: other/clrs/07/problems/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" #include #include #include void randomize_array(int array[], unsigned length, unsigned int seed); bool is_sorted(int array[], int length); TEST(sorting) { int array[] = {10, 19, 3, 5, 10, 8, 17, 4, 10, 2, 16, 10}, expected[] = { 2, 3, 4, 5, 8, 10, 10, 10, 10, 16, 17, 19}; tail_recursive_quicksort(array, 0, sizeof(array) / sizeof(int)); ASSERT_SAME_ARRAYS(array, expected); } TEST(stack_depth) { int array[] = {2, 1, 3, 4, 5, 6, 7, 8, 9, 10}, expected[] = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}; reset_stack_depth_counter(); tail_recursive_quicksort(array, 0, sizeof(array) / sizeof(int)); ASSERT_SAME_ARRAYS(array, expected); ASSERT_TRUE(max_stack_depth < 4); } TEST(large_array) { int size = 100000, seed = 300, array[size]; reset_stack_depth_counter(); randomize_array(array, size, seed); tail_recursive_quicksort(array, 0, size); ASSERT_TRUE(is_sorted(array, size)); ASSERT_TRUE(max_stack_depth <= log2(size)); } void randomize_array(int array[], unsigned length, unsigned int seed) { srand(seed); for (unsigned i = 0; i < length; i++) { array[i] = rand() % 100 + 1; } } bool is_sorted(int array[], int length) { for (int i = 1; i < length; i++) { if (array[i - 1] > array[i]) { return false; } } return true; } ================================================ FILE: other/clrs/07/problems/05.markdown ================================================ ## Median-of-3 partition > One way to improve the `RANDOMIZED-QUICKSORT` procedure is to partition > around a pivot that is chosen more carefully than by picking a random element > from the subarray. One common approach is the **median-of-3** method: choose > the pivot as the median (middle element) of a set of 3 elements randomly > selected from the subarray. (See exercise 7.4-6.) For this problem, let us > assume that the elements of the input array $A[1 \ldots n]$ are distinct and > that $n \ge 3$. We denote the sorted output array by $A'[1 \ldots n]$. Using > the median-of-3 method to choose the pivot element $x$, define $p_i = \Pr\\{x > = A'[i]\\}$. > > 1. Give an exact formula for $p_i$ as a function of $n$ and $i$ for $i = 2, > 3, \ldots, n - 1$. (Note that $p_1 = p_n = 0$.) > 2. By what amount have we increased the likelihood of choosing the pivot as > $x = A'[\lfloor(n+1)/2\rfloor]$, the median of $A[1 \ldots n]$, compared with > the ordinary implementation? Assume that $n \to \infty$, and give the > limiting ratio of these probabilities. > 3. If we define a "good" split to mean choosing the pivot as $x = A'[i]$, > where $n/3 \le i \le 2n/3$, by what amount have we increased the > likelihood of getting a good split compared with the ordinary > implementation? (Hint: Approximate the sum by an integral.) > 4. Argue that in the $\Omega(n\lg{n})$ running time of quicksort, the > median-of-3 method affects only the constant factor. ### Probability There are $n!/(n-3)!$ 3-permutations of all possible picks. In order to have the $i$th element, we need to pick one smaller, the $i$th element and one larger. There are $i - 1$ ways to pick a smaller one and $n-i$ ways to pick the larger. There are $3! ways to arrange how the three elements are picked. Thus: $$ p_i = \frac{6(i-1)(n-i)}{n(n-1)(n-2)} $$ ### Improvement $$ \lim_{n \to \infty}\frac{6(i-1)(n-i)}{n(n-1)(n-2)}/\frac{1}{n} = \lim_{n \to \infty}\frac{6n(n/2 - 1)(n/2)}{(n-1)(n-2)} = \lim_{n \to \infty}\frac{6(n^2 - 2n)}{4(n^2 - 3n + 2)} = \frac{6}{4} $$ We get a $1.5$ improvement, which does not seem that much. ### Improvement From exercise 7.2-6 we know that we get a "good" split with probability $1 - 2(1/3) = 1/3$. As for the probability of getting a good split with median-of-3: $$ \begin{aligned} \lim_{n \to \infty}\sum_{i=n/3}^{2n/3}\frac{6(i-1)(n-i)}{n(n-1)(n-2)} &= \lim_{n \to \infty}\frac{6}{n(n-1)(n-2)}\sum_{i=n/3}^{2n/3}(i-1)(n-i) \\\\ &= \lim_{n \to \infty}\binom{n}{3}\int_{n/3}^{2n/3}(i-1)(n-1)\mathrm{d}i \\\\ & \quad \Bigg( \int(i-1)(n-1)\mathrm{d}i = \frac{1}{6}(3ni^2 - 6ni - 2i^3 + 3i^2) \Bigg) \\\\ &= \lim_{n \to \infty}\binom{n}{3}\frac{1}{6}\bigg[ \frac{36}{27}n^3 - \frac{16}{27}n^3 + o(n^3) - \frac{9}{27}n^3 + \frac{2}{27}n^3 + o(n^3) \bigg] \\\\ &= \lim_{n \to \infty}\frac{1}{n(n-1)(n-2)} \frac{13}{27}(n^3 + o(n^3)) \\\\ &= \lim_{n \to \infty}\frac{13}{27}\frac{n^3 + o(n^3)}{n^3 + o(n^3)} \\\\ &= \frac{13}{27} \end{aligned} $$ Thus, as $n$ grows, the chance of getting a "good" split converges to $13/27$. The improvement is: $$ \frac{13}{27} \div \frac{1}{3} = \frac{39}{27} \approx 1.444(4) $$ ### Improvement The running time would improve if the new approach can always pick a good split. Unfortunatelly, it can't. It makes it impossible for one of the splits to be empty, but it can still pick a $1$-to-$n-2$ split. It improves the probability of a good split and adds some overhead to picking the pivot, but it makes no hard guarantees on the quality of the split. Thus, the algorithm remains $\Omega(n\lg{n})$ and $\O(n^2)$. ================================================ FILE: other/clrs/07/problems/06.c ================================================ #include #include typedef struct { int left; int right; } interval; bool intersects(interval a, interval b) { return a.left <= b.right && b.left <= a.right; } bool before(interval a, interval b) { return a.right < b.left; } bool after(interval a, interval b) { return a.left > b.right; } #define EXCHANGE(a, b) tmp = a; a = b; b = tmp; interval partition(interval A[], int p, int r) { int pick, s, t, i; interval intersection, tmp; // Pick a random interval as a pivot pick = p + rand() % (r - p); EXCHANGE(A[pick], A[r-1]); intersection = A[r-1]; // Find an intersection of the pivot and other intervals for (i = p; i < r - 1; i++) { if (intersects(intersection, A[i])) { if (A[i].left > intersection.left) intersection.left = A[i].left; if (A[i].right < intersection.right) intersection.right = A[i].right; } } // Classic partition around the intersection for (i = s = p; i < r - 1; i++) { if (before(A[i], intersection)) { EXCHANGE(A[i], A[s]); s++; } } EXCHANGE(A[r-1], A[s]); // Group intervals including the intersection for (t = s + 1, i = r - 1; t <= i;) { if (intersects(A[i], intersection)) { EXCHANGE(A[t], A[i]); t++; } else { i--; } } return (interval) {s, t}; } void fuzzy_sort(interval array[], int p, int r) { if (p < r - 1) { interval pivot = partition(array, p, r); fuzzy_sort(array, p, pivot.left); fuzzy_sort(array, pivot.right, r); } } ================================================ FILE: other/clrs/07/problems/06.markdown ================================================ ## Fuzzy sorting of intervals > Consider the problem in which we do not know the numbers exactly. Instead, > for each number, we know an interval on the real line to which it belongs. > That is, we are given $n$ closed intervals of the form $[a_i, b_i]$, where > $a_i \le b_i$. We wish to **fuzzy-sort** these intervals, i.e., to produce a > permutation $\langle i_1, i_2, \ldots, i_n \rangle$ of the intervals such > that for $j = 1, 2, \ldots, n$, there exists $c_j \in [a_{i_j}, b_{i_j}]$ > satisfying $c_1 \le c_2 \le \cdots \le c_n$. > > 1. Design a randomized algorithm for fuzzy-sorting $n$ intervals. Your > algorithm should have the general structure of an algorithm that > quicksorts the left endpoints (the $a_i$ values), but it should take > advantage of overlapping intervals to improve the running time. (As the > intervals overlap more and more, the problem of fuzzy-sorting the > intervals becoes progressively easier. Your algorithm should take > advantage of such overlapping, to the extend that it exists). > 2. Argue that your algorithm runs in expected time $\Theta(n\lg{n})$ in > general, but runs in expected time $\Theta(n)$ when all of the intervals > overlap (i.e., when there exists a value $x$ such that $x \in [a_i, b_i]$ > for all $i$). Your algorithm should not be checking for this case > explicitly; rather, its performance should naturally improve as the amount > of overlap increases. ### The algorithm The approach is very similar to problem 7.2. After we (randomly) choose a pivot interval, we check if it intersects with the other intervals. More precisely, we accumulate an intersection of the pivot and the other intervals. Afterwards we use this interval for comparison instead of the pivot. When comparing, we can treat intervals containing the intersection as equal to each other. Thus after we have arranged all the smaller intervals on the left of the pivot, we can put all the equal ones immediatelly to the right of the pivot. Like in problem 7.2, we return two points (an interval) to use as a for recursive calls. Even if partition does (worst-case) three passes over the array, it is still linear. ### Expected time If we assume that no two intervals have intersections, the analysis is identical to quicksort. If, however, all the intervals share a common point, the partitioning function would solve it in one go. ================================================ FILE: other/clrs/07/problems/06.test.c ================================================ #include "06.c" #include "../../build/ext/test.h" TEST(intersects) { ASSERT_TRUE(intersects((interval) {1, 3}, (interval) {0, 2})); ASSERT_TRUE(intersects((interval) {2, 4}, (interval) {1, 3})); ASSERT_TRUE(intersects((interval) {0, 4}, (interval) {1, 3})); ASSERT_TRUE(intersects((interval) {1, 3}, (interval) {0, 4})); ASSERT_FALSE(intersects((interval) {1, 2}, (interval) {3, 4})); ASSERT_FALSE(intersects((interval) {2, 3}, (interval) {0, 1})); } void randomize_array(interval[], unsigned, unsigned int); bool is_sorted(interval[], int); TEST(sorting) { int seed = 300, size = 100000; interval array[size]; randomize_array(array, size, seed); fuzzy_sort(array, 0, size); ASSERT_TRUE(is_sorted(array, size)); } void randomize_array(interval array[], unsigned length, unsigned int seed) { srand(seed); for (unsigned i = 0; i < length; i++) { array[i].left = rand() % 10000 + 1; array[i].right = array[i].left + rand() % 5000; } } bool is_sorted(interval array[], int length) { for (int i = 1; i < length; i++) { if (!(before(array[i - 1], array[i]) || intersects(array[i - 1], array[i]))) { return false; } } return true; } ================================================ FILE: other/clrs/08/01/01.markdown ================================================ > What is the smallest possible depth of a leaf in a decision tree for a > comparison sort? It's $\Theta(n)$, or more precisely, $n-1$. This is the minimal number of comparisons we need to perform in order to check if an array is sorted and return it. It's what insertion sort does. ================================================ FILE: other/clrs/08/01/02.markdown ================================================ > Obtain asymptotically tight bounds on $\lg(n!)$ without using Stirling's > approximation. Instead, evaluate the summation $\sum_{k=1}^n\lg{k}$ using > techniques from section A.2. First we show that it is $\O(n\lg{n})$: $$ \sum_{k=1}^n\lg{k} \le \sum_{k=1}^n\lg{n} = n\lg{n} = \O(n\lg{n})$$ Next we show that it is $\Omega(n\lg{n})$: $$ \begin{aligned} \sum_{k=1}^n\lg{k} &= \sum_{k=1}^{\lfloor n/2 \rfloor}\lg{k} + \sum_{k=\lfloor n/2 \rfloor + 1}^n\lg{k} \\\\ &\ge \sum_{k=\lfloor n/2 \rfloor + 1}^n\lg{k} \\\\ &\ge \sum_{k=n/2}^n\lg{k} \\\\ &\ge \sum_{k=n/2}^n\lg{n/2} \\\\ &\ge (n/2)\lg(n/2) \\\\ &= \frac{1}{2}n\lg{n} - \frac{1}{2}n \\\\ &= \Omega(n\lg{n}) \end{aligned} $$ ================================================ FILE: other/clrs/08/01/03.markdown ================================================ > Show that there is no comparison sort whose running time is linear for at > least half of the $n!$ inputs of length $n$. What about a fraction $1/n$ of > the inputs of length $n$? What about a fraction $1/2^n$? If it is linear for at least half of the inputs, then using the same reasoning as in the text, it must hold that: $$ \frac{n!}{2} \le 2^n $$ This holds only for small values for $n$. Same goes for the other: $$ \frac{n!}{n} \le 2^n $$ And: $$ \frac{n!}{2^n} \le 2^n \Leftrightarrow n! \le 4^n $$ All those have solutions for small $n < n_0$, but don't hold for larger values. In contrast, insertion sort gets its work done in $\Theta(n)$ time in the best case. But this is a $1/n!$ fraction of the inputs, which is smaller than $1/2^n$. ================================================ FILE: other/clrs/08/01/04.markdown ================================================ > Suppose that you are given a sequence of $n$ elements to sort. The input > sequence consists of $n/k$ subsequences, each containing $k$ elements. The > elements in a given subsequence are all smaller than the elements in the > succeeding subsequence and larger than the elements in the preceding > subsequence. Thus, all that is needed to sort the whole sequence of length > $n$ is to sort the $k$ elements in each of the $n/k$ subsequences. Show an > $\Omega(n\lg{k})$ lower bound on the number of comparisons needed to solve > this variant of the sorting problem. (Hint: It is not rigorous to > simply combine the lower bounds for the individual subsequences.) This is somehow tricky. There are $n/k$ subsequences and each can be ordered in $k!$ ways. This makes a $(k!)^{n/k}$ outputs. We use the same reasoning: $$ (k!)^{n/k} \le 2^h $$ Taking the logarithm of both sides, we get: $$ \begin{aligned} h &\ge \lg(k!)^{n/k} \\\\ &= (n/k)\lg(k!) \\\\ &\ge (n/k)(k/2)\lg(k/2) & \text{(ex 8.1.2)}\\\\ &= \frac{1}{2}n\lg{k} - \frac{1}{2}n \\\\ &= \Omega(n\lg{k}) \end{aligned} $$ ================================================ FILE: other/clrs/08/02/01.markdown ================================================ > Using figure 8.2 as a model, illustrate the operation of `COUNTING-SORT` on > the array $A = \langle 6, 0, 2, 0, 1, 3, 4, 6, 1, 3, 2 \rangle$ This is tricky to do with graphviz, so I'm going to resort to ASCII art. This is the array we sort +---+---+---+---+---+---+---+---+---+---+---+ A: | 6 | 0 | 2 | 0 | 1 | 3 | 4 | 6 | 1 | 3 | 2 | +---+---+---+---+---+---+---+---+---+---+---+ We build an array of counts: 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+ C: | 2 | 2 | 2 | 2 | 1 | 0 | 2 | +---+---+---+---+---+---+---+ The number of elements before each 0 1 2 3 4 5 6 +---+---+---+---+---+---+----+ C: | 2 | 4 | 6 | 8 | 9 | 9 | 11 | +---+---+---+---+---+---+----+ Then we start iterating: 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | | | | 2 | | | | | | C: | 2 | 4 | 5 | 8 | 9 | 9 | 11 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | | | | 2 | | 3 | | | | C: | 2 | 4 | 5 | 7 | 9 | 9 | 11 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | | 1 | | 2 | | 3 | | | | C: | 2 | 3 | 5 | 7 | 9 | 9 | 11 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | | 1 | | 2 | | 3 | | | 6 | C: | 2 | 3 | 5 | 7 | 9 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | | 1 | | 2 | | 3 | 4 | | 6 | C: | 2 | 3 | 5 | 7 | 8 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | | 1 | | 2 | 3 | 3 | 4 | | 6 | C: | 2 | 3 | 5 | 6 | 8 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | | 1 | 1 | | 2 | 3 | 3 | 4 | | 6 | C: | 2 | 2 | 5 | 6 | 8 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | 0 | 1 | 1 | | 2 | 3 | 3 | 4 | | 6 | C: | 1 | 2 | 5 | 6 | 8 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | | 0 | 1 | 1 | 2 | 2 | 3 | 3 | 4 | | 6 | C: | 1 | 2 | 4 | 6 | 8 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ A: | 0 | 0 | 1 | 1 | 2 | 2 | 3 | 3 | 4 | | 6 | C: | 0 | 2 | 4 | 6 | 8 | 9 | 10 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+----+ 1 2 3 4 5 6 7 8 9 10 11 0 1 2 3 4 5 6 +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+ A: | 0 | 0 | 1 | 1 | 2 | 2 | 3 | 3 | 4 | 6 | 6 | C: | 0 | 2 | 4 | 6 | 8 | 9 | 9 | +---+---+---+---+---+---+---+---+---+---+---+ +---+---+---+---+---+---+---+ ================================================ FILE: other/clrs/08/02/02.markdown ================================================ > Prove that `COUNTING-SORT` is stable. An informal argument will suffice. Let's say that two elements at indices $i_1 < i_2$ are equal to each other. In the sorted array, they take place at indices $j_1 + 1 = j_2$. Since the `COUNTING-SORT` processes the input array in reverse order, $A[i_2]$ is put in $B[j_2]$ first and then $A[i_1]$ is put in $A[j_2]$. Since the two elements preserve their order, the algorithm is stable. ================================================ FILE: other/clrs/08/02/03.markdown ================================================ > Suppose that we were to rewrite the for loop header in line 10 of the > `COUNTING-SORT` as > > for j = 1 to A.length > > Show that the algorithm still works properly. Is the modified algorithm > stable? It will work properly, but they are not stable. Equal elements will appear in reverse order in the sorted array. ================================================ FILE: other/clrs/08/02/04.markdown ================================================ > Describe an algorithm that, given $n$ integers in the range $0$ to $k$, > preprocesses its input and then answers any query about how many of the $n$ > integers fall into a range $[a..b]$ in $\O(1)$ time. Your algorithm should > use $\Theta(n+k)$ preprocessing time. This is not even challenging. We just take the part of `COUNTING-SORT` that builds up the array `C`. Whenever we want to count the number of integers in $[a..b]$, we take `C[b] - C[a-1]` (where `C[-1] = 0`). This yields the number of integers in the given range. ================================================ FILE: other/clrs/08/03/01.markdown ================================================ > Using figure 8.3 as a model, illustrate the operation of `RADIX-SORT` on the > following list of English words: `COW`, `DOG`, `SEA`, `RUG`, `ROW`, `MOB`, > `BOX`, `TAB`, `BAR`, `EAR`, `TAR`, `DIG`, `BIG`, `TEA`, `NOW`, `FOX`. Again, ASCII is way simpler for this. I miss solving all my problems with ASCII :/ COW SEA TAB BAR DOG => TEA => BAR => BIG SEA MOB EAR BOX RUG TAB TAR COW ROW DOG SEA DIG MOB RUG TEA DOG BOX DIG DIG EAR TAB BIG BIG FOX BAR BAR MOB MOB EAR EAR DOG NOW TAR TAR COW ROW DIG COW ROW RUG BIG ROW NOW SEA TEA NOW BOX TAB NOW => BOX => FOX => TAR FOX FOX RUG TEA ================================================ FILE: other/clrs/08/03/02.markdown ================================================ > Which of the following sorting algorithms are stable: insertion sort, merge > sort, heapsort, and quicksort? Give a simple scheme that makes any sorting > algorithm stable. How much additional time and space does your scheme entail? **Stable**: Insertion sort, merge sort **Not stable**: Heapsort, quicksort We can make any algorithm stable by mapping the array to an array of pairs, where the first element in each pair is the original element and the second is its index. Then we sort lexicographically. This scheme takes additional $\Theta(n)$ space. ================================================ FILE: other/clrs/08/03/03.markdown ================================================ > Use induction to prove that radix sort works. Where does your proof need the > assumption that the intermediate sort is stable? We can take the following invariant: > At the beginning of the **for** loop, the array is sorted on the last $i - 1$ > digits. **Initialization**. The array is trivially sorted on the last 0 digits. **Maintenance**. Let's assume that the array is sorted on the last $i - 1$ digits. After we sort on the $i$th digit, the array will be sorted on the last $i$ digits. It is obvious that elements with different digit in the $i$th position are ordered accordingly; in the case of the same $i$th digit, we still get a correct order, because we're using a stable sort and the elements were already sorted on the last $i - 1$ digits. **Termination**. The loop terminates when $i = d + 1$. Since the invariant holds, we have the numbers sorted on $d$ digits. We use the assumption in the maintenance explanation. ================================================ FILE: other/clrs/08/03/04.markdown ================================================ > Show how to sort $n$ integers in the range $0$ to $n^3 - 1$ in $\O(n)$ time. We use radix sort. In this case, we have 2-digit numbers in base $n$. This makes `RADIX-SORT` to be $\Theta(2(n + n)) = \Theta(4n) = \Theta(n)$. ================================================ FILE: other/clrs/08/03/05.markdown ================================================ > $\star$ In the first card-sorting algorithm in this section, exactly how many > sorting passes are needed to sort $d$-digit decimal numbers in the worst > case? How many piles of cards would an operator need to keep track of in the > worst case? The algorithm becomes exponential. Here's a simple breakdown for sorting n-digits numbers in base 3. - sort all on first digit into 3 piles - sort pile with first digit = 0 into 3 piles on second digit - sort pile with second digit = 0 on third digit ... - sort pile with second digit = 1 on third digit ... - sort pile with third digit = 1 on third digit ... - sort pile with first digit = 1 into 3 piles on second digit .. ... This is exponential. We need to perform $\Theta(k^d)$ passes. Furthermore, we need to keep track of $\Theta(nk)$ piles. Those correspond to space and time. ================================================ FILE: other/clrs/08/04/01.markdown ================================================ > Using figure 8.4 as a model, illustrate the operation of `BUCKET-SORT` on the > array $A = \langle .79, .13, .16, .64, .39, .20, .89, .53, .71, .42 \rangle$. A B +-----+ +---+ 1 | .79 | 0 | / | +-----+ +---+ 2 | .13 | 1 | o-----> (.13 .16) +-----+ +---+ 3 | .16 | 2 | o-----> (.20) +-----+ +---+ 4 | .64 | 3 | o-----> (.39) +-----+ +---+ 5 | .39 | 4 | o-----> (.42) +-----+ +---+ 6 | .20 | 5 | o-----> (.53) +-----+ +---+ 7 | .89 | 6 | o-----> (.64) +-----+ +---+ 8 | .53 | 7 | o-----> (.71 .79) +-----+ +---+ 9 | .71 | 8 | o-----> (.89) +-----+ +---+ 10 | .42 | 9 | / | +-----+ +---+ ================================================ FILE: other/clrs/08/04/02.markdown ================================================ > Explain why the worst-case running time for bucket sort is $\Theta(n^2)$. > What simple change to the algorithm preserves its linear average-case running > time and makes its worst-case running time $\O(n\lg{n})$. If all the keys fall in the same bucket and they happen to be in reverse order, we have to sort a single bucket with $n$ items in reversed order with insertion sort. This is $\Theta(n^2)$. We can use merge sort or heapsort to improve the worst-case running time. Insertion sort was chosen, because it operates well on linked lists. If we use another sorting algorithm, we have to convert each list to an array, which might slow down the algorithm in practice. ================================================ FILE: other/clrs/08/04/03.markdown ================================================ > Let $X$ be a random variable that is equal to the number of heads in two > flips of a fair coin. What is $\E[X^2]$? What is $\E^2[X]$. First let's see what $\E[X]$ is: $$ \E[X] = 2 \cdot \frac{1}{4} + 1 \cdot \frac{1}{2} + 0 \cdot \frac{1}{4} = 1 $$ Next we take $\E[X^2]$: $$ \E[X^2] = \E[X] \cdot \E[X] = 1 $$ Finally $\E^2[X]$: $$ \E^2[X] = \E[X] \cdot \E[X] = 1 $$ ================================================ FILE: other/clrs/08/04/04.markdown ================================================ > $\star$ We are given $n$ points in the unit circle, $p_i = (x_i, y_i)$, such > that $0 < x_i^2 + y_i^2 \le 1$ for $i = 1, 2, \ldots, n$. Suppose that the > points are uniformly distributed; that is, the probability of finding a point > in any region of the circle is proportional to the area of that region. > Design an algorithm with an average-case running time of $\Theta(n)$ to sort > the $n$ points by their distances $d_i = \sqrt{x_i^2 + y_i^2}$ from the > origin. (Hint: Design the bucket sizes in `BUCKET-SORT` to reflect the > uniform distribution of the points in the unit circle.) The unit circle has area $\pi 1^2 = \pi$. We need to split it in $n$ discs, each having area $\pi / n$. The radius of such a disc is $\pi(b^2 - a^2)$, where $b$ is the radius of the outer edge and $a$ is the radius of the inner edge of the disc. Let the points $a_0, a_1, a_2, \ldots a_n$ divide the circle in n dics, the $i$th disc having radiuses $a_i$ and $a_{i-1}$. We know that $a_0 = 0$ and $a_n = 1$. For any two discs we have: $$ \pi^2 \pi(a_i^2 - a_{i-1}^2) = \pi(a_j^2 - a_{j-1}^2) = \frac{\pi}{n} \\\\ \Downarrow \\\\ a_i^2 - a_{i-1}^2 = a_j^2 - a_{j-1}^2 = \frac{1}{n} \\\\ \Downarrow \\\\ a_i^2 = \frac{1}{n} + a_{i-1}^2 $$ We get the following recurrence: $$ \begin{aligned} a_0 &= 0 \\\\ a_i &= \sqrt{1/n + a_{i-1}^2} \end{aligned} $$ If we check some small values, we see the following pattern: $$ \pi n^2 $$ $$ \begin{aligned} a_0 & = 0 = \frac{1}{\sqrt n} \\\\ a_1 & = \sqrt{\frac{1}{n} + \frac{1}{n}} = \frac{\sqrt 2}{\sqrt n} \\\\ a_2 & = \sqrt{\frac{1}{n} + \frac{2}{n}} = \frac{\sqrt 2}{\sqrt n} \\\\ & \ldots \\\\ a_i & = \frac{\sqrt i}{\sqrt n} \end{aligned} $$ The last step is easy to prove by induction. If we assume it for $i \le k$, then: $$ a_{k+1} = \sqrt{\frac{1}{n} + a_k^2} = \sqrt{\frac{1}{n} + \frac{k}{n}} = \frac{\sqrt{k+1}}{\sqrt n} $$ Thus, we create buckets for the following intervals: $$ \bigg[0, \frac{1}{\sqrt n} \bigg), \bigg[\frac{1}{\sqrt n}, \frac{\sqrt 2}{\sqrt n}\bigg) \cdots \bigg[\frac{\sqrt{n-1}}{\sqrt n}, 1 \bigg] $$ And distribute elements according to their distance. To calculate the bucket $k$ for a distance $d$ in constant time, just take: $$ k = \begin{cases} \lfloor d^2n \rfloor + 1 & \text{if } d < 1, \\\\ n & \text{id } d = 1 \end{cases} $$ ...for 1-based buckets. ================================================ FILE: other/clrs/08/04/05.markdown ================================================ > $\star$ A **probability distribution function** $P(x)$ for a random variable > $X$ is defined by $P(x) = \Pr\\{X \le x\\}$. Suppose that we draw a list of > $n$ random variables $X_1, X_2, \ldots, X_n$ from a continuous probability > distribution function $P$ that is computable in $\O(1)$ time. Give an > algorithm that sorts these numbers in linear average-case time. **(UNSOLVED)** I don't really understand the math. But the approach is similar to exercise 8.4.4 - we pick a way to partition the buckets so each one is equally likely. ================================================ FILE: other/clrs/08/problems/01.markdown ================================================ ## Probabilistic lower bounds on comparison sorting > In this problem, we prove a probabilistic $\Omega(n\lg{n})$ on the running > time of any deterministic or randomized comparison sort on $n$ distinct input > elements. We begin by examining a deterministic comparison sort $A$ with > decision tree $T_A$. We assume that every permutation of $A$'s inputs is > equally likely. > > 1. Suppose that each leaf of $T_A$ is labeled with the probability that it is > reached given a random input. Prove that exactly $n!$ leaves are labeled > $1/n!$ and the rest are labeled $0$. > 2. Let $D(T)$ denote the external path length of a decision tree $T$; that > is, $D(T)$ is the sum of the depths of all the leaves of $T$. Let $T$ be a > decision tree with $k > 1$ leaves, and let $LT$ and $RT$ be the left and > right subtrees of $T$. Show that $D(T) = D(LT) + D(RT) + k$ > 3. Let $d(k)$ be the minimum value of $D(T)$ over all decision trees $T$ with > $k > 1$ leaves. Show that $d(k) = \min_{1 \le i \le k - 1} \\{d(i) + > d(k-i) + k\\}$. (Hint: Consider a decision tree $T$ with $k$ > leaves that achieves the minimum. Let $i_0$ be the number of leaves in > $LT$ and $k - i_0$ the number of leaves in $RT$.) > 4. Prove that for a given value of $k > 1$ and $i$ in the range $i \le i \le > k - 1$, the function $i\lg{i} + (k-i)\lg(k-i)$ is minimized at $i = k/2$. > Conclude that $d(k) = \Omega(k\lg{k})$. > 5. Prove that $D(T_A) = \Omega(n!\lg(n!))$, and conclude that the > average-case time to sort $n$ elements is $\Omega(n\lg{n})$. > > Now consider a *randomized* comparison sort $B$. We can extend the > decision-tree model to handle randomization by incorporating two kinds of > nodes: ordinary comparison nodes and "randomization" nodes. A randomization > node models a random choice of the form `RANDOM(1,r)` made by algorithm $B$; > the node has $r$ children, each of which is equally likely to be chosen > during an execution of the algorithm. > > 6. Show that for any randomized comparison sort $B$, there exists a deterministic > comparison sort $A$ whose expected number of comparisons is no more than > those made by $B$. ### Probability labels There are $n!$ permutations that the algorithm can perform and each corresponds to one of the $n!$ possible inputs. Each permutation will be a leaf in this tree and since the inputs are equally likely, the probability of reaching one will be $1/n!$. If the decision tree has more leaves, they will be unreachable. This is an intuitive argument. It's easy to see that it is so if you think about it, but a formal proof seems tricky to me. ### External path length If we take a node in the tree, all paths go either through the left or the right child. Both children have the same paths as the node itself, except that they are shorter by one. Thus, $D(T) = D(LT) + D(RT) + \mathrm{LEAVES}(LT) + \mathrm{LEAVES}(RT) = D(LT) + D(RT) + k$. ### Minimal external path length If we take a tree with $k$ leaves that achieves the minimal external path, we know from the previous point that: $$ D(T) = D(LT) + D(RT) + k $$ There are $k - 1$ possible pairs of left-right children and one of them is the minimum. That is: $$ d(k) = D(T) = D(LT) + D(RT) + k = \min_{1 \le i \le k-1}\\{d(i) + d(k-i) + k\\} $$ ### Minimal value Let: $$ \begin{aligned} f(i) &= i\lg{i} + (k-i)\lg(k-i) \\\\ f'(i) &= \lg{i} + 1 - \lg(k-i) - 1 = \lg\frac{i}{k-i} \\\\ f'(i) = 0 & \Leftrightarrow \lg\frac{i}{k-i} = 0 \Rightarrow i/(k-i) = 1 \Rightarrow i = \frac k 2 \end{aligned} $$ Since $f'(i)$ is monotonously increasing, $i = k/2$ is a local minimum. Intuitively said, the minimum is reached when the tree is balanced (as in the way merge sort halves is decision-tree on each step. ### Average-case time In $T_A$ there are $n!$ leaves, thus $D(n) > d(k) = \Omega(n!\lg(n!))$. Each permutation has an equal probability of $1/n!$, thus the expected time to sort it is: $$ \frac{\Omega(n!\lg(n!))}{n!} = \Omega(n\lg(n!)) = \Omega(n\lg{n}) $$ ### The randomized algorithm A deterministic algorithm $A$ corresponding to $B$ would be one that has made its "random" choices in advance. To construct it we just remove the randomized nodes by replacing them by a child we pick. The new result is a subtree (in respect to the non-randomized nodes) and its number of choices is less than or equal to the one of the randomized algorithm. Since any subtree we pick is $\Omega(n\lg{n})$, this implies that $B$ is $\Omega(n\lg{n})$. ================================================ FILE: other/clrs/08/problems/02.c ================================================ #include typedef struct { int key; int value; } item; static item tmp; #define EXCHANGE(a, b) tmp = a; a = b; b = tmp; void stable_linear_sort(item *A, int size) { int zero = 0, one = 0; item copy[size]; for (int i = 0; i < size; i++) { if (A[i].key == 0) { one++; } } for (int i = 0; i < size; i++) { if (A[i].key == 0) { copy[zero] = A[i]; zero++; } else { copy[one] = A[i]; one++; } } for (int i = 0; i < size; i++) { A[i] = copy[i]; } } void linear_in_place_sort(item *A, int size) { int left = -1, right = size; while (true) { do { left++; } while (A[left].key == 0); do { right--; } while (A[right].key == 1); if (left > right) { return; } EXCHANGE(A[left], A[right]); } } void stable_in_place_sort(item *A, int size) { for (int i = size; i > 0; i--) { for (int j = 0; j < i; j++) { if (A[j].key > A[j + 1].key) { EXCHANGE(A[j], A[j+1]); } } } } void in_place_counting_sort(item *A, int size, int range) { int counts[range + 1]; int positions[range + 1]; for (int i = 0; i <= range; i++) { counts[i] = 0; } for (int i = 0; i < size; i++) { counts[A[i].key]++; } for (int i = 2; i <= range; i++) { counts[i] += counts[i-1]; } for (int i = 0; i <= range; i++) { positions[i] = counts[i]; } int i = 0; while (i < size) { int key = A[i].key; bool placed = (positions[key - 1] <= i && i < positions[key]); if (placed) { i++; } else { EXCHANGE(A[i], A[counts[key] - 1]); counts[key]--; } } } ================================================ FILE: other/clrs/08/problems/02.markdown ================================================ ## Sorting in place in linear time > Suppose that we have an array of $n$ data records and that the key of each > record has the value 0 or 1. An algorithm for sorting such a set of records > might posses some subset of the following three desirable characteristics: > > 1. The algorithm runs in $\O(n)$ time > 2. The algorithm is stable. > 3. The algorithm sorts in place, using no more than a constant amount of > storage space in addition to the original array. > > Do the following: > > 1. Give an algorithm that satisfies criteria 1 and 2 above > 2. Give an algorithm that satisfies criteria 1 and 3 above > 3. Give an algorithm that satisfies criteria 2 and 3 above > 4. Can you use any of your algorithms from parts (a)-(c) as the sorting > method used in line 2 of `RADIX-SORT`, so that `RADIX-SORT` sorts $n$ > records with $b$-bit keys in $\O(bn)$ time? Explain how or why not. > 5. Suppose that the $n$ records have keys in the range $1$ to $k$. Show how > to modify counting sort so that it sorts the records in place in > $\O(n+k)$ time. You may use $\O(k)$ storage outside the input array. Is > your algorithm stable? (Hint: How would you do it for $k = 3$?) ### Algorithms 1. This can be done with counting sort. We need two variables to track the numbers/indices of ones and zeroes and $\Theta(n)$ space to make a copy. 2. This can be done with approach similar to Hoare partition in problem 7.1 3. I can't think of a stable in-place algorithm so bubble-sort will do ### Usage in radix sort Only the first one (the counting sort variant) can be used. The second is not stable, which is a requirement for radix sort, and the third takes $\Theta(n^2)$ time, which will turn the compound sorting algorithm $\Theta(bn^2)$. ### In place counting sort We build an array of counts as in `COUNTING-SORT`, but we perform the sorting differently. We start with `i = 0` and then. while i ≤ A.length if A[i] is correctly placed i = i + 1 else put A[i] in place, exchanging with the element there On each step we're either (1) incrementing `i` or (2) putting an element in its place. The algorithm terminates because eventually we run out of misplaced elements and have to increment `i`. There are some details about checking whether `A[i]` is correctly placed that are in the C code. ================================================ FILE: other/clrs/08/problems/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" #include #define SEED 300 #define SIZE 10000 #define RANGE 200 void generate_binary_array(item *A, int size, int from, int to); void assert_sorted(item *A, int size); void assert_stable(item *A, int size); TEST(stable_linear) { item items[SIZE]; generate_binary_array(items, SIZE, 0, 1); stable_linear_sort(items, SIZE); assert_sorted(items, SIZE); assert_stable(items, SIZE); } TEST(linear_in_place) { item items[SIZE]; generate_binary_array(items, SIZE, 0, 1); linear_in_place_sort(items, SIZE); assert_sorted(items, SIZE); } TEST(stable_in_place) { item items[SIZE]; generate_binary_array(items, SIZE, 0, 1); stable_in_place_sort(items, SIZE); assert_sorted(items, SIZE); assert_stable(items, SIZE); } TEST(in_place_counting_sort) { item items[SIZE]; generate_binary_array(items, SIZE, 1, RANGE); in_place_counting_sort(items, SIZE, RANGE); assert_sorted(items, SIZE); } int next_id(); void generate_binary_array(item *A, int size, int from, int to) { srand(SEED); for (int i = 0; i < size; i++) { A[i].key = rand() % (to - from + 1) + from; A[i].value = next_id(); } } void assert_sorted(item *A, int size) { for (int i = 0; i < size - 1; i++) { if (A[i].key > A[i+1].key) { FAIL("Not sorted at index %d: %d > %d", i, A[i].key, A[i+1].key); } } } void assert_stable(item *A, int size) { for (int i = 0; i < size - 1; i++) { if (A[i].key == A[i + 1].key && A[i].value > A[i+1].value) { FAIL("Not stable at index %d: %d > %d", i, A[i].value, A[i+1].value); } } } int next_id() { static int id = 1; return id++; } ================================================ FILE: other/clrs/08/problems/03.c ================================================ #include #include #define MAX_LENGTH 10 // --- Structs and typedefs --------------------------------------------------- // In order to simplify everything, both numbers and strings are meshed in a // single union called key_t. The key does not know whether it is a number or a // string - the handling code already knows it instead. union key_t { int number; char string[MAX_LENGTH + 1]; }; typedef struct { union key_t key; int value; } item; typedef int (*key_f)(item, int); typedef int (*dimension_f)(item); typedef int (*compare_f)(item, item); // --- Prototypes ------------------------------------------------------------- // Various sorting functinos void partition(item *A, int size, int digits, int *groups, dimension_f dimension); void radix_sort(item *A, int left, int right, int digits, key_f key); void counting_sort(item *A, int left, int right, int dimension, key_f key, int key_index); // Functions to work on numbers int item_nth_digit(item i, int d); int item_digits(item i); // Functions to work on strings int item_string_length(item i); int item_nth_char(item i, int d); // --- The solutions ---------------------------------------------------------- void sort_numbers(item *A, int size, int max_digits) { int groups[max_digits + 1]; partition(A, size, max_digits, groups, item_digits); for (int i = 1; i < max_digits + 1; i++) { radix_sort(A, groups[i - 1], groups[i], i, item_nth_digit); } } void sort_strings(item *A, int size, int max_length) { int groups[max_length + 1]; partition(A, size, max_length, groups, item_string_length); for (int len = max_length; len > 0; len--) { counting_sort(A, groups[len - 1], size, 26, item_nth_char, len - 1); } } // --- Auxiliary sorting functions -------------------------------------------- // Performs counting sort on a dimension (number of digits or string length) // and populates a table (groups) with the position of each dimension. void partition(item *A, int size, int max_dimension, int *groups, dimension_f dimension) { int counts[max_dimension + 1]; item temp[size]; for (int i = 0; i < max_dimension + 1; i++) { groups[i] = 0; } for (int i = 0; i < size; i++) { groups[dimension(A[i])]++; } for (int i = 1; i < max_dimension + 1; i++) { groups[i] += groups[i - 1]; } for (int i = 0; i < max_dimension + 1; i++) { counts[i] = groups[i]; } for (int i = 0; i < size; i++) { temp[i] = A[i]; } for (int i = size - 1; i >= 0; i--) { int d = dimension(temp[i]); int count = counts[d]; A[count - 1] = temp[i]; counts[d]--; } } // A simple radix sort void radix_sort(item *A, int left, int right, int digits, key_f key) { for (int i = 0; i < digits; i++) { counting_sort(A, left, right, 10, key, i); } } // A slightly generalized counting sort void counting_sort(item *A, int left, int right, int dimension, key_f key, int key_index) { int size = right - left; int counts[dimension]; item temp[size]; for (int i = 0; i < dimension; i++) { counts[i] = 0; } for (int i = left; i < right; i++) { counts[key(A[i], key_index)]++; } for (int i = 1; i < dimension; i++) { counts[i] += counts[i - 1]; } for (int i = 0; i < size; i++) { temp[i] = A[left + i]; } for (int i = size - 1; i >= 0; i--) { int n = key(temp[i], key_index); int count = counts[n]; A[left + count - 1] = temp[i]; counts[n]--; } } // --- Key handling ----------------------------------------------------------- int count_digits(int n) { if (n == 0) { return 1; } else { return (int) log10(n) + 1; } } int nth_digit(int n, int d) { int magnitude = (int) pow(10, d); return (n / magnitude) % 10; } int item_nth_digit(item i, int d) { return nth_digit(i.key.number, d); } int item_digits(item i) { return count_digits(i.key.number); } int item_string_length(item a) { return strlen(a.key.string); } int item_nth_char(item a, int n) { return a.key.string[n] - 'a'; } ================================================ FILE: other/clrs/08/problems/03.markdown ================================================ ## Sorting variable-length items > 1. You are given an array of integers, where different integers may have > different number of digits, but the total number of digits over *all* the > integers in the array is $n$. Show how to sort the array in $\O(n)$ time. > 2. You are given an array of strings, where different strings may have > different numbers of characters, but the total number of characters over > all the strings is $n$. Show how to sort the strings in $\O(n)$ time.
> (Note that the desired order here is the standard alphabetical order; for > example; $\mathrm{a} < \mathrm{ab} < \mathrm{b}$.) ### The numbers For the numbers, we can do this: 1. Group the numbers by number of digits and order the groups 2. Radix sort each group Let's analyze the number of steps. Let $G_i$ be the group of numbers with $i$ digits and $c_i = |G_i|$. Thus: $$ T(n) = \sum_{i=1}{n}c_i \cdot i = n $$ ### The strings For the strings, we can do this: 1. Groups the strings by length and order the groups 2. Starting $i$ on the maximum length and going down to 1, perform counting sort on the $i$th character. Make sure to include only groups that have an $i$th character. If the groups are subsequent subarrays in the original array, we're performing counting sort on a subarray ending on the last index of the original array. ### The implementation The C code is a bit clever, but this is an exercise, not a production system. ================================================ FILE: other/clrs/08/problems/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" #include #define SEED 300 #define N 400000 #define MAX_DIGITS 10 int generate_random_numbers(item *items); int generate_random_strings(item *items); void assert_sorted(item *A, int size, compare_f compare); void assert_stable(item *A, int size, compare_f compare); int compare_strings(item a, item b); int compare_numbers(item a, item b); TEST(sort_numbers) { item numbers[N]; int size = generate_random_numbers(numbers); sort_numbers(numbers, size, MAX_DIGITS); assert_sorted(numbers, size, compare_numbers); assert_stable(numbers, size, compare_numbers); } TEST(sort_strings) { item strings[N]; int size = generate_random_strings(strings); sort_strings(strings, size, MAX_LENGTH); assert_sorted(strings, size, compare_strings); assert_stable(strings, size, compare_strings); } int compare_strings(item a, item b) { return strcmp(a.key.string, b.key.string); } int compare_numbers(item a, item b) { return a.key.number - b.key.number; } void assert_sorted(item *A, int size, compare_f compare) { for (int i = 0; i < size - 1; i++) { if (compare(A[i], A[i + 1]) > 0) { FAIL("Not sorted at index %d", i); } } } void assert_stable(item *A, int size, compare_f compare) { for (int i = 0; i < size - 1; i++) { if (compare(A[i], A[i + 1]) == 0 && A[i].value > A[i+1].value) { FAIL("Not stable at index %d: %d > %d", i, A[i].value, A[i+1].value); } } } int next_id() { static int id = 1; return id++; } int generate_random_numbers(item *numbers) { srand(SEED); int i = 0, digits = 0; while (digits < N) { int magnitude = rand() % MAX_DIGITS + 1; if (magnitude > N - digits) { magnitude = N - digits; } int base = (int) pow(10, magnitude - 1); int number = rand() % ((int) pow(10, magnitude) - base) + base; numbers[i].key.number = number; numbers[i].value = next_id(); i++; digits += magnitude; } return i; } int generate_random_strings(item *strings) { srand(SEED); int i = 0, chars = 0; while (chars < N) { int length = rand() % MAX_LENGTH + 1; if (length > N - chars) { length = N - chars; } int j; for (j = 0; j < length; j++) { strings[i].key.string[j] = 'a' + rand() % 26; } strings[i].key.string[j] = '\0'; strings[i].value = next_id(); i++; chars += length; } return i; } ================================================ FILE: other/clrs/08/problems/04.c ================================================ #include typedef int jug; static int tmp; #define EXCHANGE(a, b) {tmp = a; a = b; b = tmp;} int cmp(jug red, jug blue); void quadratic_pair(jug *red, jug *blue, int size) { for (int i = 0; i < size; i++) { for (int j = i; j < size; j++) { if (cmp(red[i], blue[j]) == 0) { EXCHANGE(blue[i], blue[j]); break; } } } } int partition(jug *red, jug *blue, int p, int q); void quick_pair(jug *red, jug *blue, int p, int r) { if (p < r - 1) { int q = partition(red, blue, p, r); quick_pair(red, blue, p, q); quick_pair(red, blue, q + 1, r); } } int partition(jug *red, jug *blue, int p, int q) { int pivot, i; jug red_pivot, blue_pivot; // Pick a red pivot i = rand() % (q - p) + p; EXCHANGE(red[i], red[q - 1]); red_pivot = red[q - 1]; // Find the blue pivot and put it in final position // NOTE: This look can be folded in the next one to minimize the number of // comparisons, but I will keep it here for clarity for (int i = p; i < q; i++) { if (cmp(red_pivot, blue[i]) == 0) { EXCHANGE(blue[i], blue[q - 1]); break; } } // Partition the blue jugs around the red pivot pivot = p; for (int i = p; i < q - 1; i++) { if (cmp(red_pivot, blue[i]) > 0) { EXCHANGE(blue[pivot], blue[i]); pivot++; } } // Put the blue pivot in place EXCHANGE(blue[pivot], blue[q-1]); blue_pivot = blue[pivot]; // Partition the red jugs around the blue pivot int j = p; for (int i = p; i < q - 1; i++) { if (cmp(red[i], blue_pivot) < 0) { EXCHANGE(red[j], red[i]); j++; } } // Put the red pivot in place EXCHANGE(red[q - 1], red[j]); // Return the pivot index return pivot; } int cmp(jug red, jug blue) { return red - blue; } ================================================ FILE: other/clrs/08/problems/04.markdown ================================================ ## Water jugs > Suppose that you are given $n$ red and $n$ blue water jugs, all of different > shapes and sizes. All red jugs hold different amounts of water, as do the > blue ones. Moreover, for every red jug, there is a blue jug that holds the > same amount of water, and vice versa. > > Your task is to find a grouping of the jugs into pairs of red and blue jugs > that hold the same amount of water. To do so, you may perform the following > operation: pick a pair of jugs in which one is red and one is blue, fill the > red jug with water, and then pour the water into the blue jug. This > operation will tell you whether the red or the blue jug can hold more water, > or that they have the same volume. Assume that such a comparison takes one > time unit. Your goal is to find an algorithm that makes a minimum number of > comparisons to determine the grouping. Remember that you man not directly > compare two red jugs or two blue jugs. > > 1. Describe a deterministic algorithm that user a $\Theta(n^2)$ comparisons > to group the jugs into pairs. > 2. Prove a lower bound of $\Omega(n\lg{n})$ for the number of comparisons > that an algorithm solving this problem must make. > 3. Give a randomized algorithm whose expected number of comparisons is > $\O(n\lg{n})$, and prove that this bound is correct. What is the > worst-case number of comparisons for your algorithm? ### Deterministic algorithm We compare each red jug with each blue jug and pair them on the first match. ### Lower bound We approach it in a similar fashion as section 8.1. The difference is that the nodes in this decision tree have three children, instead of two (it's a 3-tree!). If both sets of jugs are ordered, then a pairing is a $n$-permutation that maps each red jug to a blue one. Since there are $n!$ possible outputs, they should be present as leaves in the decision tree. If the length of the tree is $l$ we get a similar inequality: $$ n! \le l \le 3^h$$ Again, taking the logarithms, we get: $$ h \ge lg(n!) = \Omega(n\lg{n}) $$ ### Randomized algorithm We can use an approach similar to quicksort. The partition function should work as follows: 1. Choose, at random, a red jug for a pivot ($\O(1)$) 2. Pick a corresponding blue jug ($\O(n)$) 3. Partition the blue jugs around the red pivot and put the blue pivot in place ($\O(n)$) 4. Partition the red jugs around the blue pivot and but the red pivot in place ($\O(n)$). We're only comparing red and blue jugs. The analysis is similar to the one of quicksort in section 7.4. There is some effort to translate the argument to having two arrays and additional comparisons, but the work is not hard. I will not present it here, since I think the applicability of the same argument is obvious. ================================================ FILE: other/clrs/08/problems/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" #define SIZE 10000 #define RANGE 1000000 #define SEED 300 void generate_jugs(int *red, int *blue); void assert_paired(int *red, int *blue); TEST(quadratic_pairing) { int red_jugs[SIZE]; int blue_jugs[SIZE]; generate_jugs(red_jugs, blue_jugs); quadratic_pair(red_jugs, blue_jugs, SIZE); assert_paired(red_jugs, blue_jugs); } TEST(quick_pairing) { int red_jugs[SIZE]; int blue_jugs[SIZE]; generate_jugs(red_jugs, blue_jugs); quick_pair(red_jugs, blue_jugs, 0, SIZE); assert_paired(red_jugs, blue_jugs); } void generate_jugs(int *red, int *blue) { srand(SEED); for (int i = 0; i < SIZE; i++) { red[i] = rand() % RANGE; } for (int i = 0; i < SIZE; i++) { blue[i] = red[i]; } for (int i = SIZE; i >= 1; i--) { int pos = rand() % i; EXCHANGE(blue[i - 1], blue[pos]); } } void assert_paired(int *red, int *blue) { for (int i = 0; i < SIZE; i++) { if (red[i] != blue[i]) { FAIL("Not paired at index %d: %d != %d", i, red[i], blue[i]); } } } ================================================ FILE: other/clrs/08/problems/05.c ================================================ #include #include #include #include typedef struct { int value; int s; } item; typedef struct { item *elements; int length; int heap_size; } heap_t; typedef struct { int size; int k; int exhausted; int *next_indices; } sort_state_t; void merge_sort(int A[], int p, int r, int k, int s); void min_heap_insert(heap_t *heap, item key); int state_took_column(sort_state_t *state, int index); item min_heap_push_pop(heap_t *heap, item new); item heap_minimum(heap_t *heap); item heap_extract_min(heap_t *heap); /* * Average soting is performed by just merge-sorting each column. That was * easy. Modifying merge sort was hard. */ void k_sort(int *numbers, int size, int k) { for (int i = 0; i < k; i++) { merge_sort(numbers, 0, size, k, i); } } /* * Sorting a k-sorted array. We need to keep track of which column produced * the minumum element in the heap and this resulted in quite the tricky C * code. I don't think this is a good practice, but still, that's the best I'm * willing to make it right now. */ void merge_k_sorted(int *numbers, int size, int k) { int copy[size]; item heap_elements[k]; heap_t heap = {heap_elements, k, 0}; int next_indices[k]; sort_state_t state = {size, k, 0, next_indices}; memcpy(copy, numbers, size * sizeof(int)); for (int i = 0; i < k; i++) { item new = {copy[i], i}; min_heap_insert(&heap, new); next_indices[i] = i + k; } for (int i = 0; i < size; i++) { item min = heap_minimum(&heap); numbers[i] = min.value; int next = state_took_column(&state, min.s); if (next != -1) { min_heap_push_pop(&heap, (item) {copy[next], next % k}); } else { heap_extract_min(&heap); } } } int state_took_column(sort_state_t *state, int index) { int size = state->size, k = state->k, s = index, *next_indices = state->next_indices; if (next_indices[s] >= size) { while (state->exhausted < k && next_indices[state->exhausted] >= state->size) { state->exhausted++; } if (state->exhausted == k) { return -1; } int next = next_indices[state->exhausted]; next_indices[state->exhausted] += k; return next; } else { next_indices[s] += k; return s; } } /* * This is the merge sort from Chapter 2, modified to look only at indices * congruent to k modulo s. There are two very ugly and long macroses that * perform this unpleasant job. There's probably a nicer way to do the * calculation, but modular arithmetic has always been my Achilles' heel. */ #define FIRST(index, k, s) ((index) + (s) - (index) % (k) + ((index) % (k) <= (s) ? 0 : (k))) #define COUNT(a, b, k, s) (((b) - (a)) / (k) + ((((s) - (a) % (k)) + (k)) % (k) < ((b) - (a)) % (k) ? 1 : 0)) void merge(int A[], int p, int q, int r, int k, int s) { int i, j, l; int n1 = COUNT(p, q, k, s); int n2 = COUNT(q, r, k, s); int L[n1]; int R[n2]; for (i = FIRST(p, k, s), j = 0; i < q; j++, i += k) L[j] = A[i]; for (i = FIRST(q, k, s), j = 0; i < r; j++, i += k) R[j] = A[i]; for(i = 0, j = 0, l = FIRST(p, k, s); l < r; l += k) { if (i == n1) { A[l] = R[j++]; } else if (j == n2) { A[l] = L[i++]; } else if (L[i] <= R[j]) { A[l] = L[i++]; } else { A[l] = R[j++]; } } } void merge_sort(int A[], int p, int r, int k, int s) { if (COUNT(p, r, k, s) > 1) { int q = (p + r) / 2; merge_sort(A, p, q, k, s); merge_sort(A, q, r, k, s); merge(A, p, q, r, k, s); } } /* * Finally, the min heap from exercise 6.5-3, modified to store items instead * of ints. When I first wrote it, I made an error in the implementation and * that sent me in a hour-long debugging session. C is fun. * * Also, there is a new heap operation (min_heap_push_pop) that is a faster * than heap_extract_min and then min_heap_insert. */ #define PARENT(i) ((i - 1) / 2) #define LEFT(i) (2 * i + 1) #define RIGHT(i) (2 * i + 2) item heap_minimum(heap_t *heap) { return heap->elements[0]; } void min_heapify(heap_t *heap, int i) { int left = LEFT(i), right = RIGHT(i), smallest; if (left < heap->heap_size && heap->elements[left].value < heap->elements[i].value) { smallest = left; } else { smallest = i; } if (right < heap->heap_size && heap->elements[right].value < heap->elements[smallest].value) { smallest = right; } if (smallest != i) { item tmp = heap->elements[i]; heap->elements[i] = heap->elements[smallest]; heap->elements[smallest] = tmp; min_heapify(heap, smallest); } } item heap_extract_min(heap_t *heap) { if (heap->heap_size == 0) { fprintf(stderr, "heap underflow"); exit(0); } item min = heap->elements[0]; heap->elements[0] = heap->elements[heap->heap_size - 1]; heap->heap_size--; min_heapify(heap, 0); return min; } void heap_decrease_key(heap_t *heap, int i, item key) { if (key.value > heap->elements[i].value) { fprintf(stderr, "new key is larger than current key"); exit(0); } heap->elements[i].value = key.value; while (i > 0 && heap->elements[PARENT(i)].value > heap->elements[i].value) { item tmp = heap->elements[PARENT(i)]; heap->elements[PARENT(i)] = heap->elements[i]; heap->elements[i] = tmp; i = PARENT(i); } } void min_heap_insert(heap_t *heap, item key) { if (heap->length == heap->heap_size) { fprintf(stderr, "heap overflow"); exit(0); } heap->elements[heap->heap_size].value = INT_MAX; heap->elements[heap->heap_size].s = key.s; heap->heap_size++; heap_decrease_key(heap, heap->heap_size - 1, key); } item min_heap_push_pop(heap_t *heap, item new) { item result = heap->elements[0]; heap->elements[0] = new; min_heapify(heap, 0); return result; } ================================================ FILE: other/clrs/08/problems/05.markdown ================================================ ## Average sorting > Suppose that instead of sorting an array, we just require that the elements > increase on average. More precisely, we call an $n$-element array > **k-sorted** if, for all $i = 1, 2, \ldots, n - k$, the following holds: > > $$ \frac{\sum_{j=i}^{i+k-1}A[j]}{k} \le > \frac{\sum_{j=i + 1}^{i+k}A[j]}{k} $$ > >
    >
  1. What does it mean for an array to be 1-sorted? >
  2. Give a permutation of the numbers $1, 2, \ldots, 10$ that is 2-sorted, > but not sorted >
  3. Prove that an $n$-element array is k-sorted if and only if $A[i] \le > A[i+k]$ for all $i = 1, 2, \ldots, n-k$. >
  4. Give an algorithm that $k$-sorts an $n$-element array in > $\O(n\lg(n/k))$ time. >
> > We can also show a lower bound on the time to produce a $k$-sorted array, > when $k$ is a constant. > >
    >
  1. Show that we can sort a $k$-sorted array of length $n$ in > $\O(n\lg{k})$ time. (Hint: Use the solution to exercise 6.5-9.) >
  2. Show that when $k$ is a constant, $k$-sorting an $n$-element array > requires $\Omega(n\lg{n})$ time. (Hint: Use the solution to the > previous part along with the lower bound on comparison sorts.) >
### Intuitive description I'm going to state an unintuitive description of what does it mean for an array to be $k$-sorted. It will be presented without proof. It will become evident later in the text. If we write out $k$-sorted array in a grid with $k$ columns, each column will be sorted from top to bottom. This is essentially what (c) means. ### Various notions For an array to be 1-sorted it means that it is sorted in the traditional sense of the word, that is, $A[i] \le A[i+1]$ for each index $i$. Here's a 2-sorted permutation that is not sorted: $2, 1, 4, 3, 6, 5, 8, 7, 10, 9$. ### Alternative condition Let's assume that an array is $k$-sorted. Then: $$ \frac{\sum_{j=i}^{i+k-1}A[j]}{k} \le \frac{\sum_{j=i + 1}^{i+k}A[j]}{k} \\\\ \Updownarrow \\\\ \frac{A[i] + \sum_{j=i+1}^{i+k-1}A[j]}{k} \le \frac{\sum_{j=i+1}^{i+k-1}A[j] + A[i+k]}{k} \\\\ \Updownarrow \\\\ \frac{A[i]}{k} \le \frac{A[i+k]}{k} \\\\ \Updownarrow \\\\ A[i] \le A[i+k] $$ Note that this derivation works backwards for proving the **if** part. ### The algorithms To $k$-sort the array, we need to sort the $k$ columns, that is, $k$ arrays of $n/k$ elements. This is a $(n/k)\lg(n/k)$ algorithm, performed $k$ times. We can use merge-sort. We don't even need to copy the array - we can calculate the indices on the fly, although that turned less fun than expected. To sort a $k$-sorted array, we just do what we suggested in exercise 6.5-9 - we build a min heap and every time we take an element from it, we pick another element from the column the minimal element was in. Keeping track of that in C is a bit hairy, so the implementation is gruesome. There is a new operation, `MIN-HEAP-PUSH-POP`, that is an improvement over first extracting the element and then inserting another one. ### Lower bound on comparisons The problem can be reduced to $k$ problems of size $(n/k)$, each with minimal number of comparisons $\Omega((n/k)\lg(n/k))$. The total is $\Omega(n\lg(n/k))$ and if $k$ is a constant, we get a very familiar $\Omega(n\lg{n})$. Really not that surprising. ================================================ FILE: other/clrs/08/problems/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" #include #define N 1000000 #define K 100 #define SEED 300 #define RANGE 1000000 void generate_random_array(int *numbers); void assert_k_sorted(int *numbers, int k); TEST(k_sorting) { int numbers[N]; generate_random_array(numbers); k_sort(numbers, N, K); assert_k_sorted(numbers, K); } TEST(merging_k_sorted) { int numbers[N]; generate_random_array(numbers); k_sort(numbers, N, K); merge_k_sorted(numbers, N, K); assert_k_sorted(numbers, 1); } void assert_k_sorted(int *numbers, int k) { for (int i = 0; i < N - k; i++) { if (numbers[i] > numbers[i + k]) { FAIL("Array not k-sorted at %d/%d: %d > %d:", i, i + k, numbers[i], numbers[i + k]); } } } void generate_random_array(int *numbers) { srand(SEED); for (int i = 0; i < N; i++) { numbers[i] = rand() % RANGE; } } ================================================ FILE: other/clrs/08/problems/06.markdown ================================================ ## Lower bound on merging sorted lists > The problem of merging two sorted lists arises frequently. We have seen a > procedure for it as the subroutine `MERGE` in Section 2.3.1. In this > problem, we will prove a lower bound of $2n - 1$ on the worst-case number of > comparisons required to merge two sorted lists, each containing $n$ items. > > First we will show a lower bound of $2n - o(n)$ comparisons by using a > decision tree. > >
    >
  1. Given $2n$ numbers, compute the number of possible ways to divide them > into two sorted lists, each with $n$ numbers. >
  2. Using a decision tree and your answer to part (a), show that any > algorithm that correctly merges two sorted lists must perform $2n - > o(n)$ comparisons. >
> > Now we will show a slightly tighter $2n - 1$ bound. > >
    >
  1. Show that if two elements are consecutive in the sorted order and from > different lists, then they must be compared. >
  2. Use your answers to the previous part to show a lower bound of $2n - > 1$ comparisons for merging two sorted lists. >
### The first bound This can be reduced to a counting problem: in how many ways can we pick $n$ items out of $2n$ items? That way we pick the first sorted list and each such pick determines a single, unique second list. In exercise C.1-13 we already proved that: $$ \binom{2n}{n} = \frac{2^{2n}}{\sqrt{\pi n}}(1 + \O(1/n)) $$ Using the familiar reasoning, if there are $l$ leaves in the decision tree and its height is $h$, the following inequality must hold: $$ \frac{2^{2n}}{\sqrt{\pi n}}(1 + \O(1/n)) \le l \le 2^h $$ Taking the logarithm of the leftmost and rightmost parts (and inverting their positions) we get; $$ \begin{aligned} h & \ge \lg\bigg(\frac{2^{2n}}{\sqrt{\pi n}}(1 + \O(1/n))\bigg) \\\\ & = \lg{2^{2n}} - \lg\sqrt{\pi n} + \lg(1 + O(1/n)) \\\\ & = 2n - \o(n) \end{aligned} $$ ### The tighter bound If we don't compare two consecutive elements, we don't know which one comes first. They are completely indistinguishable when comparing to the other elements. We have no way in determining which one should come first. (Note that if they were in the same sorted list, we don't need to compare them, since we already have that information). If the sorted order of the elements is $\langle a_1, b_2, a_2, b_2, \ldots, a_n, b_n \rangle$ and we have the two lists $\langle a_1, a_2, \ldots, a_n \rangle$ and $\langle b_1, b_2, \ldots, b_n \rangle$, then there are $2n - 1$ pairs of elements that need to be compared. Any algorithm that handles this case must perform $2n - 1$ comparisons in the worst case. ================================================ FILE: other/clrs/08/problems/07.c ================================================ #include #include #include #include #define STDLIB_SORT qsort typedef unsigned int number; typedef struct { size_t start; size_t size; } column_t; typedef void column_sorter(number *, column_t *, int); void check_dimensions(size_t r, size_t s); /** * The basic column sort implementation. It does a copy of the array for steps * 3 and 5. It also does not sort the half-columns in the beginning and the * end, since that is not necessary for the correctness of the algorithm. */ void columnsort(number *A, size_t r, size_t s, column_sorter sort_columns) { size_t size = r * s; number *copy; column_t columns[s]; check_dimensions(r, s); copy = calloc(size, sizeof(number)); for (size_t i = 0; i < s; i++) { columns[i] = (column_t) {i * r, r}; } sort_columns(A, columns, s); for (size_t i = 0; i < size; i++) { copy[(i % s) * r + i / s] = A[i]; } sort_columns(copy, columns, s); for (size_t i = 0; i < size; i++) { A[i] = copy[(i % s) * r + i / s]; } sort_columns(A, columns, s); for (size_t i = 0; i < s - 1; i++) { columns[i] = (column_t) {i * r + r / 2, r}; } sort_columns(A, columns, s - 1); free(copy); } /* * A function that compares numbers, to be passed to the stdlib sort. */ int compare(const void *a, const void *b) { number *first = (number *) a; number *second = (number *) b; if (*first == *second) { return 0; } else if (*first > *second) { return 1; } else { return -1; } } /* * Verified the dimensions of the passed array. */ void check_dimensions(size_t r, size_t s) { if (r % 2) { fprintf(stderr, "r must be even\n"); exit(0); } if (r % s) { fprintf(stderr, "s must divide r\n"); exit(0); } if (r < 2 * s * s) { fprintf(stderr, "r must be grater than 2s²\n"); exit(0); } } /* * A utility function to call with the array and a column. */ void sort(number *A, column_t column) { STDLIB_SORT(A + column.start, column.size, sizeof(number), compare); } /* * Sequential sorting of columns */ void sequential_sort_columns(number *numbers, column_t *columns, int size) { for (int i = 0; i < size; i++) { sort(numbers, columns[i]); } } /* * Parallel sorting of columns. This implementation is a bit naïve - it can * reuse existing threads instead of spawning new ones every time. Furthermore, * I never explored using locking mechanisms instead of joining the threads. */ typedef struct { number *numbers; column_t column; } job_t; void *sort_job(void *pjob) { job_t *job = (job_t *) pjob; sort(job->numbers, job->column); return NULL; } void threaded_sort_columns(number *numbers, column_t *columns, int size) { void *status; pthread_t threads[size]; job_t jobs[size]; pthread_attr_t attr; pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (int i = 0; i < size; i++) { jobs[i] = (job_t) {numbers, columns[i]}; pthread_create(&threads[i], &attr, sort_job, &jobs[i]); } for (int i = 0; i < size; i++) { pthread_join(threads[i], &status); } } ================================================ FILE: other/clrs/08/problems/07.markdown ================================================ ## The 0-1 sorting lemma and columnsort > A **compare-exchange** operation on two array elements $A[i]$ and $A[j]$, > where $i < j$ has the form: > > COMPARE-EXCHANGE(A, i, j) > if A[i] > A[j] > exchange A[i] with A[j] > > After the compare-exchange operation, we know that $A[i] \le A[j]$. > > An **oblivious compare-exchange algorithm** operates solely by a sequence > of prespecified compare-exchange operations. The indices of the positions > compared in the sequence must be determined in advance, and although they > can depend on the number of elements being sorted, they cannot depend on the > values being sorted, nor can they depend on the result of any prior > compare-exchange operation. For example, here is insertion sort expressed as > an oblivious compare-exchange algorithm: > > INSERTION-SORT(A) > for j = 2 to A.length > for i = j - 1 downto 1 > COMPARE-EXCHANGE(A, i, i + 1) > > The **0-1 sorting lemma** provides a powerful way to prove that an oblivious > compare-exchange algorithm produces a sorted result. It states that if an > oblivious compare-exchange algorithm correctly sorts all input sequences > consisting of only 0s and 1s, then it correctly sorts all inputs containing > arbitrary values. > > You will prove the 0-1 sorting lemma by proving its contrapositive: if an > oblivious compare-exchange algorithm fails to sort an input containing > arbitrary values, then it fails to sort some 0-1 input. Assume that an > oblivious compare-exchange algorithm X fails to correctly sort the array > $A[1..n]$. Let $A[p]$ be the smallest value in $A$ that algorithm X puts > into the wrong location, and let $A[q]$ be the value that algorithm X moves > to the location into which $A[p]$ should have gone. Define an array > $B[1..n]$ of 0s and 1s as follows: > > $$ B[i] = \begin{cases} > 0 & \text{ if } A[i] \le A[p] \\\\ > 1 & \text{ if } A[i] > A[p] > \end{cases} $$ > >
    >
  1. Argue that $A[q] > A[p]$, so that $B[p] = 0$ and $B[q] = 1$. >
  2. To complete the proof 0-1 sorting lemma, provide that algorithm X > fails to sort array $B$ correctly. >
> > Now you will use the 0-1 sorting lemma to prove that a particular sorting > algorithm works correctly. The algorithm, **columnsort**, works on a > rectangular array of $n$ elements. The array has $r$ rows and $s$ columns > (so that $n = rs$), subject to three restrictions: > > * $r$ must be even, > * $s$ must be a divisor of r, and > * $r \ge 2s^2$. > > When columnsort completes, the array is sorted in **column-major order**: > reading down the columns, from left to right, the elements monotonically > increase. > > Columnsort operates in eight steps, regardless of the value of $n$. The odd > steps are all the same: sort each column individually. Each even step is a > fixed permutation. Here are the steps: > > 1. Sort each column. > 2. Transpose the array, but reshape it back to $r$ rows and $s$ columns. In > other words, turn the leftmost column into the top $r/s$ rows, in order; > turn the next column into the next $r/s$ rows, in order; and so on. > 3. Sort each column. > 4. Perform the inverse of the permutation performed in step 2. > 5. Sort each column. > 6. Shift the top half of each column into the bottom half of the same > column, and shift the bottom half of each column into the top half of the > next column to the right. Leave the top half of the leftmost column > empty. Shift the bottom half of the last column into the top last column > into the top half of a new rightmost column, and leave the bottom half of > this new column empty. > 7. Sort each column > 8. Perform the inverse of the permutation performed in step 6. > > Figure 8.5 shows an example of the steps of columnsort with $r = 6$ and $s = > 3$. (Even though this example violated the requirement that $r \ge 2s^2$, it > happens to work.) > >
    >
  1. Argue that we can treat columnsort as an oblivious compare-exchange > algorithm, even if we do not know what sorting method the odd steps are. >
> > Although it might seem hard to believe that columnsort actually sorts, you > will use the 0-1 sorting lemma to prove that it does. The 0-1 dorting lemma > applies because we can treat columnsort as an oblivious compare-exchange > algorithm. A couple of definitions will help you apply the 0-1 sorting > lemma. We say that an area of an array is **clean** if we know that it > contains either all 0s or all 1s. Otherwise, the area might contain mixed 0s > and 1s, and it is dirty. From here on, assume that the input array contains > only 0s and 1s, and that we can treat it as an array with $r$ rows and $s$ > columns. > >
    >
  1. Prove that after steps 1-3, the array consists of some clean rows of > 0s at the top, some clean rows of 1s at the bottom, and at most $s$ dirty > rows between them >
  2. Prove that after step 4, the array, read in column-major order, starts > with a clean area of 0s, ends with a clean area of 1s, and has a dirty > area of at most $s^2$ elements in the middle. >
  3. Prove that steps 5-8 produce a fully sorted 0-1 output. Conclude that > columnsort correctly sorts all inputs containing arbitrary values. >
  4. Now suppose that $s$ does not divide $r$. Prove that after steps 1-3, > the array consists of some clean rows of 0s at the top, some clean rows of > 1s at the bottom, and at most $2s - 1$ dirty rows between them. How large > must $r$ be, compared with $s$, for columnsort to correctly sort when $s$ > does not divide $r$? >
  5. Suggest a simple change to step 1 that allow us to maintain the > requirement that $r \ge 2s^2$ when $s$ does not divide $r$, and prove that > with your change, columnsort correctly sorts. >
This one is tricky. I would not have been able to solve it by myself. I had help from those two: * [The 0-1 sorting principle][0-1-lemma] * [Stupid Column Sort Tricks][csort-tricks] ### Proof of the 0-1 sorting lemma We know that $A[q] > A[p]$ by definition ($A[q]$ is misplaced, but it cannot be smaller than $A[p]$, since $A[p]$ is the smallest misplaced element). From this it follows that $B[p] = 0$ and $B[q] = 1$. To prove the rest, we need to establish that a monotonous mapping and a compare-exchange operation commutate, that is, they can be applied in any order. This makes sense, since if the mapping is applied first, the order of the elements would not change (because the mapping is monotonic) and the compare-exchange would have the same result. An oblivious compare-exchange algorithm can be regarded as a sequence of compare-exchange operations. Thus, it doesn't matter if the monotonous mapping is applied before the fist or after the last compare-exchange operation. Applying that to $A$ and $B$, we conclude that $B[q] = 1$ and $B[p] = 0$. We know that $q < p$, otherwise $A[q]$ there would have been a smaller misplaced element. From this we gather that $B[q] > B[p]$ and $q < p$, which means that the array is unsorted. There is a more formal proof in [the first link][0-1-lemma]. ### Applicability Since the even-numbered steps perform things _blindly_, we can suspect that the algorithm has some elements of obliviousness in it. If we perform the odd numbered steps with an oblivious compare-exchange algorithm, then columnsort is obviously oblivious and we can apply the 0-1 sorting lemma. Since we can treat those steps as "black boxes", we can replace the sorting algorithm with any other algorithm that produces the same result (that is, any sorting algorithm) and the resulting columnsort would still sort. ### Correctness After the first step, each column becomes a sequences of 0s followed by a sequence of 1s. In this sense, there is only one `0 → 1` transition in each column. Since $s$ divides $r$, each column will map to $r/s$ rows. One of those rows will contain the `0 → 1` transition. The others will contain only 0s or 1s. That is, each column will map to at most one dirty row and the rest will be clean. After the transposition, and second sorting, the clean rows of 0s will move to the top and the clean rows of 1s will move to the bottom. We're left with at most $s$ dirty rows in the middle. After the reversal of the permutation, the $s$ dirty rows will map to a sequence of $s^2$. All the other elements are clean. The dirty sequence is at least half a column long now. It either fits in one column or crosses over in the next one. All columns left of it contain only 0s and all columns right of it contain only 1s. If the result is contained in a single column, step 5 will result in a sorting in column major mode and the subsequent steps will not interfere with it. If not, step 6 arranges the columns in a way that the dirty subsequence will fill a single column. Sorting all column cleans it and we have a sorted array. Note that sorting the half-columns is unnecessary - step 5 already sorted them. ### When s does not divide r If $s$ does not divide $r$, a row can contain not only a `0 → 1` transition, but also a `1 → 0` transitions. There would be at most $s - 1$ of those, resulting to a dirty region of $2s - 1$. We can make $r$ to be at least $2(2s - 1)^2$. As for the change to step one, we can either pad the array with $+ \infty$ until $s$ divides $r$, or we can chop off a small part of the array and sort it separately. The latter will be more efficient, since it does not require moving the array. Finally, all of that turns to be unnecessary - columnsort works without the divisibility restriction. Details can be found in [the paper][csort-tricks]. ### Implementation Surprising as it is, columnsort smokes the stdlib implementation of quicksort. I thought the overhead was to much, but it appears that it is not. Of course, the crossover point will vary. [0-1-lemma]: http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/networks/nulleinsen.htm [csort-tricks]: http://www.cs.dartmouth.edu/reports/TR2003-444.pdf ================================================ FILE: other/clrs/08/problems/07.run.c ================================================ #include "07.test.c" #include #ifdef __MACH__ #include #include #endif void current_utc_time(struct timespec *ts) { #ifdef __MACH__ clock_serv_t cclock; mach_timespec_t mts; host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock); clock_get_time(cclock, &mts); mach_port_deallocate(mach_task_self(), cclock); ts->tv_sec = mts.tv_sec; ts->tv_nsec = mts.tv_nsec; #else clock_gettime(CLOCK_REALTIME, ts); #endif } double elapsed; struct timespec start, finish; #define TIME(message, sorting) \ randomize(array, NUMBERS); \ current_utc_time(&start); \ sorting; \ current_utc_time(&finish); \ elapsed = (finish.tv_sec - start.tv_sec); \ elapsed += (finish.tv_nsec - start.tv_nsec) / 1000000000.0;\ printf(message " = %f\n", (double) elapsed); \ assert_sorted(array, NUMBERS); const size_t COLUMNS = 180; const size_t ROWS = 2 * COLUMNS * COLUMNS; const size_t NUMBERS = ROWS * COLUMNS; int main() { number *array = calloc(NUMBERS, sizeof(number)); TIME("stdlib sort", { sort(array, (column_t) {0, NUMBERS}); }); TIME("columnsort ", { columnsort(array, ROWS, COLUMNS, threaded_sort_columns); }); return 0; } ================================================ FILE: other/clrs/08/problems/07.test.c ================================================ #include "07.c" #include "../../build/ext/test.h" #include #include #include #define S 8 #define R (2 * S * S) #define SIZE (R * S) #define SEED 301 void assert_sorted(number *A, size_t size); void randomize(number *A, size_t size); TEST(single_process_columnsort) { number numbers[SIZE]; randomize(numbers, SIZE); columnsort(numbers, R, S, threaded_sort_columns); assert_sorted(numbers, SIZE); } TEST(paralel_sort) { number numbers[SIZE]; randomize(numbers, SIZE); columnsort(numbers, R, S, threaded_sort_columns); assert_sorted(numbers, SIZE); } void assert_sorted(number *A, size_t size) { for (size_t i = 0; i < size - 1; i++) { if (A[i] > A[i + 1]) { FAIL("Not sorted at index %lu", i); } } } void randomize(number *A, size_t size) { srand(SEED); for (size_t i = 0; i < size; i++) { A[i] = 0; for (size_t j = 0; j < sizeof(number); j += sizeof(int)) { A[i] <<= sizeof(number); A[i] += rand(); } } } void print_mesh(number *A, size_t r, size_t s) { size_t size = r * s; number max = 0; for (size_t i = 0; i < size; i++) { if (A[i] > max) { max = A[i]; } } char format[10]; sprintf(format, "%%%dd", (int) (log10(max) + 3)); for (size_t i = 0; i < r; i++) { for (size_t j = 0; j < s; j++) { printf(format, A[i + j * r]); } puts(""); } } ================================================ FILE: other/clrs/09/01/01.markdown ================================================ > Show that the second smallest of $n$ elements can be found with $n + \lceil > \lg{n} \rceil - 2$ comparisons in the worst case. (Hint: Also find > the smallest element.) We can compare the elements in a tournament fashion - we split them into pairs, compare each pair and then proceed to compare the winners in the same fashion. We need to keep track of each "match" the potential winners have participated in. We select a winner in $n - 1$ matches. At this point, we know that the second smallest element is one of the $\lg{n}$ elements that lost to the smallest ­ each of them is smaller than the ones it has been compared to, prior to losing. In another $\lceil \lg{n} \rceil - 1$ comparisons we can find the smallest element out of those. This is the answer we are looking for. ================================================ FILE: other/clrs/09/01/02.markdown ================================================ > $\star$ Prove the lower bound of $\lceil 3n/2 \rceil - 2$ comparisons in the > worst case to find both the maximum and minimum of $n$ numbers. > (Hint: Consider how many numbers are potentially either the maximum > or minimum, and investigate how a comparison affects these counts.) Each comparison can reduce both the potential minimums and maximums by one. Note that this is now always the case if we make two comparisons to infer that $a < b$ and $a < c$, we have excluded two elements from the potential minimums ($b$ and $c$), but only one from the potential maximums ($a$). We can optimize by splitting the input in pairs and comparing each pair. After $n/2$ comparisons, we have reduced the potential minimums and potential maximums to $n/2$ each. Furthermore, those two sets are disjoint so now we have two problems, one minimum and one maximum, each of size $n/2$. The total number of comparisons is: $$ n/2 + 2(n/2 - 1) = n/2 + n - 2 = 3n/2 - 2 $$ This assumes that $n$ is even. If $n$ is odd we need one additional comparison in order to determine whether the last element is a potential minimum or maximum. Hence the ceiling. ================================================ FILE: other/clrs/09/02/01.markdown ================================================ > Show that `RANDOMIZED-SELECT` never makes a recursive call to a 0-length > array. The are two cases where it appears that `RANDOMIZED-SELECT` can make a call to a 0-length array: 1. Line 8 with $k = 1$. But for this to happen, $i$ needs to be 0. And that cannot happen since the initial call is supposed to pass a nonzero $i$ and the recursive calls either pass $i$ unmodified or pass $i - k$ where $i > k$. 2. Line 9 with $q = r$. But for this to happen, $i$ must be greater than $k$, that is $i > q - p + 1 = r - p + 1$, that is, $i$ needs to be greater than the number of elements in the array. Initially that is not true and both recursive calls maintain an invariant that $i$ is less or equal to the number of elements in $A[p..q]$. ================================================ FILE: other/clrs/09/02/02.markdown ================================================ > Argue that the indicator random variable $X_k$ and the value > $T(\max(k-1,n-k))$ are independent. Picking the pivot in one partitioning does not affect the probabilities of the subproblem. That is, the call to `RANDOM` in `RANDOMIZED-PARTITION` produces a result, independent from the call in the next iteration. ================================================ FILE: other/clrs/09/02/03.c ================================================ #include static int tmp; #define EXCHANGE(a, b) { tmp = a; a = b; b = tmp; } int randomized_partition(int *A, int p, int r); int randomized_select(int *A, int p, int r, int i) { while (p < r - 1) { int q = randomized_partition(A, p, r); int k = q - p; if (i == k) { return A[q]; } else if (i < k) { r = q; } else { p = q + 1; i = i - k - 1; } } return A[p]; } int partition(int *A, int p, int r) { int x, i, j; x = A[r - 1]; i = p; for (j = p; j < r - 1; j++) { if (A[j] < x) { EXCHANGE(A[i], A[j]); i++; } } EXCHANGE(A[i], A[r - 1]); return i; } int randomized_partition(int *A, int p, int r) { int pivot = rand() % (r - p) + p; EXCHANGE(A[pivot], A[r - 1]); return partition(A, p, r); } ================================================ FILE: other/clrs/09/02/03.markdown ================================================ > Write an iterative version of `RANDOMIZED-SELECT`. With pleasure. ================================================ FILE: other/clrs/09/02/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" #define SIZE 10 #define SEED 300 void generate_array(int *numbers, int size); TEST(ith_order_statistic) { int numbers[SIZE]; generate_array(numbers, SIZE); ASSERT_EQUALS(randomized_select(numbers, 0, SIZE, 0), 0); generate_array(numbers, SIZE); ASSERT_EQUALS(randomized_select(numbers, 0, SIZE, SIZE / 2), SIZE / 2); generate_array(numbers, SIZE); ASSERT_EQUALS(randomized_select(numbers, 0, SIZE, SIZE - 1), SIZE - 1); } void generate_array(int *numbers, int size) { srand(SEED); for (int i = 0; i < size; i++) { numbers[i] = i; } for (int i = size; i >= 1; i--) { int pos = rand() % i; EXCHANGE(numbers[i - 1], numbers[pos]); } } ================================================ FILE: other/clrs/09/02/04.markdown ================================================ > Suppose we use `RANDOMIZED-SELECT` to select the minimum element of the > array $A = \langle 3, 2, 9, 0, 7, 5, 4, 8, 6, 1 \rangle$. Describe a > sequence of partitions that results in a worst-case performance of > `RANDOMIZED-SELECT`. This happens if all the elements get picked up in reverse order ­ that is, the first pivot chosen is 9, the second is 8, the third is 7 and so on. ================================================ FILE: other/clrs/09/03/01.markdown ================================================ > In the algorithm `SELECT`, the input elements are divided into groups of 5. > Will the algorithm work in linear time if they are divided into groups of 7? > Argue that `SELECT` does not run in linear time if groups of 3 are used. ### Groups of 7 The algorithm will work if the elements are divided in groups of 7. On each partitioning, the minimum number of elements that are less than (or greater than) $x$ will be: $$ 4 \bigg(\bigg\lceil \frac{1}{2} \Big\lceil \frac{n}{7} \Big\rceil \bigg\rceil - 2 \bigg) \ge \frac{2n}{7} - 8 $$ The partitioning will reduce the subproblem to size at most $5n/7 + 8$. This yields the following recurrence: $$ T(n) = \begin{cases} \O(1) & \text{ if } n < n_0 \\\\ T(\lceil n/7 \rceil) + T(5n/7 + 8) + \O(n) & \text{ if } n \ge n_0 \end{cases} $$ We guess $T(n) \le cn$ and bound the non-recursive term with $an$: $$ \begin{aligned} T(n) & \le c\lceil n/7 \rceil + c(5n/7 + 8) + an \\\\ & \le cn/7 + c + 5cn/7 + 8c + an \\\\ & = 6cn/7 + 9c + an \\\\ & = cn + (-cn/7 + 9c + an) \\\\ & \le cn \\\\ & = \O(n) \end{aligned} $$ The last step holds when $(-cn/7 + 9c + an) \le 0$. That is: $$ -cn/7 + 9c + an \le 0 \\\\ \Downarrow \\\\ c(n/7 - 9) \ge an \\\\ \Downarrow \\\\ \frac{c(n - 63)}{7} \ge an \\\\ \Downarrow \\\\ c \ge \frac{7an}{n - 63} $$ By picking $n_0 = 126$ and $n \le n_0$, we get that $n/(n - 63) \le 2$. Then we just need $c \ge 14a$. ### Groups of 3 The algorithm will not work for groups of three. The number of elements that are less than (or greater than) the median-of-medians is: $$ 2 \bigg(\bigg\lceil \frac{1}{2} \Big\lceil \frac{n}{3} \Big\rceil \bigg\rceil - 2 \bigg) \ge \frac{n}{3} - 4 $$ The recurrence is thus: $$ T(n) = T(\lceil n/3 \rceil) + T(2n/3 + 4) + \O(n) $$ We're going to prove that $T(n) = \omega(n)$ using the substitution method. We guess that $T(n) > cn$ and bound the non-recursive term with $an$. $$ \begin{aligned} T(n) & > c\lceil n/3 \rceil + c(2n/3 + 2) + an \\\\ & > cn/3 + c + 2cn/3 + 2c + an \\\\ & = cn + 3c + an & (c > 0, a > 0, n > 0)\\\\ & > cn \\\\ & = \omega(n) \end{aligned} $$ The calculation above holds for any $c > 0$. ================================================ FILE: other/clrs/09/03/02.markdown ================================================ > Analyze `SELECT` to show that if $n \ge 140$, then at least $\lceil n/4 > \rceil$ elements are greater than the median-of-medians $x$ and at least > $\lceil n/4 \rceil$ elements are less than $x$. The problem can be reduced to the following inequality: $$ \frac{3n}{10} - 6 \ge \bigg\lceil \frac{n}{4} \bigg\rceil \\\\ \Downarrow \\\\ \frac{3n}{10} - 6 \ge \frac{n}{4} + 1 \\\\ \Downarrow \\\\ \frac{3n}{10} - 7 \ge \frac{n}{4} \\\\ \Downarrow \\\\ 12n - 280 \ge 10n \\\\ \Downarrow \\\\ 2n \ge 280 \\\\ \Downarrow \\\\ n \ge 140 $$ ================================================ FILE: other/clrs/09/03/03.markdown ================================================ > Show how quicksort can be made to run in $\O(n\lg{n})$ time in the worst > case, assuming that all elements are distinct. If we rewrite `PARTITION` to use the same approach as `SELECT`, it will perform in $\O(n)$ time, but the smallest partition will be at least one-fourth of the input (for large enough $n$, as illustrated in exercise 9.3.2). This will yield a worst-case recurrence of: $ T(n) = T(n/4) + T(3n/4) + \O(n) $ As of exercise 4.4.9, we know that this is $\Theta(n\lg{n})$. And that's how we can prevent quicksort from getting quadratic in the worst case, although this approach probably has a constant that is too large for practical purposes. Another approach would be to find the median in linear time (with `SELECT`) and partition around it. That will always give an even split. ================================================ FILE: other/clrs/09/03/04.markdown ================================================ > $\star$ Suppose that an algorithm uses only comparisons to find the $i$th > smallest element in a set of $n$ elements. Show that it can also find the > $i - 1$ smaller elements and the $n - i$ larger elements without performing > any additional comparisons. A strict proof might require a more advanced proof apparatus than I command (like graphs and adversary algorithms, for example?), so I will just sketch it briefly. In order to determine the $i$th order statistic, any algorithm needs to establish in some way that there are $i - 1$ elements smaller than the result and $n - i$ elements larger than the result. We can visualize the algorithm as a directed graph, where all the elements are edges. Each comparison introduces a node from the smaller to the larger element. To produce a result, there must be $i - 1$ elements that (transitively) point to the $i$th order statistic and $n - i$ elements that the $i$th order statistic (transitively) points to. There cannot be more (property of the order statistics) and if there are less, then there are elements whose position in regard to the $i$th order statistic is undetermined. In order to find the result, the algorithm needs to build the knowledge presented in such a graph and it can use it to return the sets of smaller and larger elements. As an example, both algorithms presented in the chapter leave the array partitioned around the $i$th order statistic. ================================================ FILE: other/clrs/09/03/05.markdown ================================================ > Suppose that you have a "black-box" worst-case linear time median > subroutine. Give a simple, linear-time algorithm that solves the selection > problem for an arbitrary order statistic. We find the median in linear time partition the array around it (again, in linear time). If the median index (always $\lceil n/2 \rceil$) equals $n$ we return the median. Otherwise, we recurse either in the lower or upper part of the array, adjusting $n$ accordingly. This yields the following recurrence: $$ T(n) = T(n/2) + \O(n) $$ Applying the master method, we get an upper bound of $\O(n)$. ================================================ FILE: other/clrs/09/03/05.py ================================================ def select(items, n): med = median(items) smaller = [item for item in items if item < med] larger = [item for item in items if item > med] if len(smaller) == n: return med elif len(smaller) > n: return select(smaller, n) else: return select(list(larger), n - len(smaller) - 1) def median(items): def median_index(n): if n % 2: return n // 2 else: return n // 2 - 1 def partition(items, element): i = 0 for j in range(len(items) - 1): if items[j] == element: items[j], items[-1] = items[-1], items[j] if items[j] < element: items[i], items[j] = items[j], items[i] i += 1 items[i], items[-1] = items[-1], items[i] return i def select(items, n): if len(items) <= 1: return items[0] medians = [] for i in range(0, len(items), 5): group = sorted(items[i:i + 5]) items[i:i + 5] = group median = group[median_index(len(group))] medians.append(median) pivot = select(medians, median_index(len(medians))) index = partition(items, pivot) if n == index: return items[index] elif n < index: return select(items[:index], n) else: return select(items[index + 1:], n - index - 1) return select(items[:], median_index(len(items))) ================================================ FILE: other/clrs/09/03/05.test.py ================================================ import unittest import os.path as path filename = path.join(path.dirname(__file__), '05.py') exec(open(filename).read()) import random class SelectionTest(unittest.TestCase): def test_select(self): items = list(range(1, 10000)) random.shuffle(items) self.assertEqual(select(items[:], 42), 43) self.assertEqual(select(items[:], 5012), 5013) self.assertEqual(select(items[:], 9998), 9999) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/09/03/06.markdown ================================================ > The $k$th **quantiles** of an $n$-element set are $k - 1$ order statistics > that divide the sorted set into $k$ equal-sized sets (to within 1). Give an > $\O(n\lg{k})$-time algorithm to list the $k$th quantiles of a set. 1. If $k = 1$ we return an empty list. 2. If $k$ is even, we find the median, partition around it, solve two similar subproblems of size $\lfloor n / 2 \rfloor$ and return their solutions plus the median. 3. If $k$ is odd, we find the $\lfloor k/2 \rfloor$ and $\lceil k/2 \rceil$ boundaries and the we reduce to two subproblems, each with size less than $n/2$. The worst case recurrence is: $$ T(n, k) = 2T(\lfloor n/2 \rfloor, k / 2) + O(n) $$ Which is the desired bound ­ $\O(n\lg{k})$. This works easily when the number of elements is $ak + k - 1$ for a positive integer $a$. When they are a different number, some care with rounding needs to be taken in order to avoid creating two segments that differ by more than 1. ================================================ FILE: other/clrs/09/03/06.py ================================================ import math def k_quantiles(items, k): index = median_index(len(items)) if k == 1: return [] elif k % 2: n = len(items) left_index = math.ceil((k // 2) * (n / k)) - 1 right_index = n - left_index - 1 left = select(items, left_index) right = select(items, right_index) partition(items, left) lower = k_quantiles(items[:left], k // 2) partition(items, right) upper = k_quantiles(items[right + 1:], k // 2) return lower + [left, right] + upper else: index = median_index(len(items)) median = select(items, index) partition(items, median) return k_quantiles(items[:index], k // 2) + \ [median] + \ k_quantiles(items[index + 1:], k // 2) def median_index(n): if n % 2: return n // 2 else: return n // 2 - 1 def partition(items, element): i = 0 for j in range(len(items) - 1): if items[j] == element: items[j], items[-1] = items[-1], items[j] if items[j] < element: items[i], items[j] = items[j], items[i] i += 1 items[i], items[-1] = items[-1], items[i] return i def select(items, n): if len(items) <= 1: return items[0] medians = [] for i in range(0, len(items), 5): group = sorted(items[i:i + 5]) items[i:i + 5] = group median = group[median_index(len(group))] medians.append(median) pivot = select(medians, median_index(len(medians))) index = partition(items, pivot) if n == index: return items[index] elif n < index: return select(items[:index], n) else: return select(items[index + 1:], n - index - 1) ================================================ FILE: other/clrs/09/03/06.test.py ================================================ import unittest import os.path as path filename = path.join(path.dirname(__file__), '06.py') exec(open(filename).read()) import random def shuffled(n): items = list(range(n)) random.shuffle(items) return items def visualize(n, k): items = shuffled(n) quantiles = k_quantiles(items, k) result = '-' * len(items) for q in quantiles: result = result[:q] + 'o' + result[q+1:] return result class QuantilesTest(unittest.TestCase): def test_k_quantiles(self): self.assertEqual(k_quantiles(shuffled(11), 4), [2, 5, 8]) self.assertEqual(k_quantiles(shuffled(14), 5), [2, 5, 8, 11]) self.assertEqual(k_quantiles(shuffled(17), 6), [2, 5, 8, 11, 14]) self.assertEqual(k_quantiles(shuffled(20), 7), [2, 5, 8, 11, 14, 17]) self.assertEqual(k_quantiles(shuffled(23), 8), [2, 5, 8, 11, 14, 17, 20]) def test_visualized_quantiles(self): self.assertEqual(visualize(3, 1), '---') self.assertEqual(visualize(3, 2), '-o-') self.assertEqual(visualize(5, 2), '--o--') self.assertEqual(visualize(2, 3), 'oo') self.assertEqual(visualize(5, 3), '-o-o-') self.assertEqual(visualize(8, 3), '--o--o--') self.assertEqual(visualize(11, 3), '---o---o---') self.assertEqual(visualize(11, 4), '--o--o--o--') self.assertEqual(visualize(9, 5), '-o-o-o-o-') self.assertEqual(visualize(14, 5), '--o--o--o--o--') if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/09/03/07.markdown ================================================ > Describe an $\O(n)$-time algorithm that, given a set $S$ of $n$ distinct > numbers and a positive integer $k \le n$, determines the $k$ numbers in $S$ > that are closest to the median of $S$. This is a fun exercise. 1. We find the median of the array in linear time 2. We find the distance of each other element to the median in linear time 3. We find the $k$-th order statistic of the distance, again, in linear time 4. We select only the elements that have distance lower than or equal to the $k$-th order statistic ================================================ FILE: other/clrs/09/03/08.markdown ================================================ > Let $X[1..n]$ and $Y[1..n]$ be two arrays, each containing $n$ numbers > already in sorted order. Give an $\O(\lg{n})$-time algorithm to find the > median of all $2n$ elements in arrays $X$ and $Y$. This was fun! 1. If the two arrays are of length $1$, we pick the lower of the two elements 2. We the two medians of the array 3. We take the lower part of the array with the greater median and the upper part of the array with the lesser median. If each array has $n$ elements, we take the first/last $\lfloor n / 2 \rfloor$ elements 4. We solve the problem for the new arrays Let's reason about why this works. Since we have $2n$ elements, we know that the length is an even number and we're looking for a lower median. We need to observe that the median we're looking for is between the medians of the two arrays. Let's elaborate on that. Let's assume that the median is at position $k$ in array $A$. This means that there are $k - 1$ elements less than the median in $A$ and $n - k$ elements greater than the median in $B$. If $k < n / 2$ then the median of $A$ will be greater than the final median, but the median of $B$ will be lesser than it. It's the other way around for $k \ge n / 2$. Thus the median of the two arrays is always between the medians of each. Step 3 removes the same number of elements from each array, half of which are greater than the median and half of which are less than it. This reduces the subproblem to two smaller arrays that are sorted and their elements have the same median. ================================================ FILE: other/clrs/09/03/08.py ================================================ def two_array_median(a, b): if len(a) == 1: return min(a[0], b[0]) m = median_index(len(a)) i = m + 1 if a[m] < b[m]: return two_array_median(a[-i:], b[:i]) else: return two_array_median(a[:i], b[-i:]) def median_index(n): if n % 2: return n // 2 else: return n // 2 - 1 ================================================ FILE: other/clrs/09/03/08.test.py ================================================ import unittest import os.path as path filename = path.join(path.dirname(__file__), '08.py') exec(open(filename).read()) import random def shuffled(n): items = list(range(n)) random.shuffle(items) return items class QuantilesTest(unittest.TestCase): def test_k_quantiles(self): size = 300 median = median_index(size) numbers = shuffled(size) left, right = sorted(numbers[:size//2]), sorted(numbers[size//2:]) self.assertEqual(two_array_median(left, right), median) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/09/03/09.markdown ================================================ > Professor Olay is consulting for an oil company, which is planning a large > pipeline running east to west through an oil fields of $n$ wells. The > company wants to connect a spur pipeline from each well directly to the main > pipeline along a shortest route (either north or south), as shown on Figure > 9.2. Given the $x$- and $y$- coordinates of the wells, how should the > professor pick the optimal location of the main pipeline, which would be the > one that minimizes the total length of the spurs? Show how to determine the > optimal location in linear time. We just find the median of the $y$ coordinates. The $x$ coordinates are irrelevant. Let's assume that $n$ is odd. There are $\lfloor n / 2 \rfloor$ south of the median and the same amount of wells north of the median. Let the pipeline pass through the median. We shall reason about why this location is optimal. Suppose we move the pipeline one meter north. This reduces the total pipe length with $\lfloor n/2 \rfloor$ meters for the pipes north of the median, but adds another $\lceil n/2 \rceil$ for the pipes south of median, including the median itself. The more we move north, the more the total pipe length will increase. The same reasoning holds if we move the main pipeline south. If $n$ is even, then any location between the lower and upper median is optimal. ================================================ FILE: other/clrs/09/problems/01.markdown ================================================ ## Largest i numbers in sorted order > Given a set of $n$ numbers, we wish to find the $i$ largest in sorted order > using a comparison based algorithm. Find the algorithm that implements each > of the following methods with the best asymptotic worst-case running time, > and analyze the running time of the algorithms in terms of $n$ and $i$. > >
    >
  1. Sort the numbers, and list the $i$ largest >
  2. Build a max-priority queue from the numbers, and call > `EXTRACT-MAX` $i$ times >
  3. Use an order-statistic algorithm to find the $i$th largest number, > partition around that number, and sort the $i$ largest numbers. >
### Sorting We can sort with any of the $n\lg{n}$ algorithms, that is, merge sort or heap sort and then just take the first $i$ elements linearly. This will take $n\lg{n} + i$ time. ### Max-priority queue We can build the heap linearly and then take each of the largest $i$ elements in logarithmic time. This takes $n + i\lg{n}$. ### Partition and sort Let's assume we use the `SELECT` algorithm from the chapter. We can find the $i$th order statistic and partition around it in $n$ time and then we need to do a sort in $i\lg{i}$. This takes $n + i\lg{i}$ ================================================ FILE: other/clrs/09/problems/02.markdown ================================================ ## Weighted median > For $n$ distinct elements $x_1, x_2, \ldots, x_n$ with positive weights > $w_1, w_2, \ldots, w_n$ such that $\sum_{i=1}^n w_i = 1$, the **weighted > (lower) median** is the element $x_k$ satisfying > > $$ \sum_{x_i < x_k} w_i < \frac{1}{2} $$ > and > $$ \sum_{x_i > x_k} w_i \le \frac{1}{2} $$ > > For example, if the elments are $0.1, 0.35, 0.05, 0.1, 0.15, 0.05, 0.2$ and > each element equals its weight (that is, $w_i = x_i$ for $i = 1, 2, \ldots, > 7$, then the median is $0.1$, but the weighted median is $0.2$. > >
    >
  1. Argue that the median of $x_1, x_2, \ldots, x_n$ is the weighted > median of $x_i$ with weights $w_i = 1/n$ for $i = 1, 2, \ldots, n$. >
  2. Show how to compute the weighted median of $n$ elements in > $\O(n\lg{n})$ worst-case time using sorting. >
  3. Show how to compute the weighted median in $\Theta(n)$ worst-case time > using a linear-time median algorithm such as `SELECT` from Section 9.3. >
> > The **post-office location problem** is defined as follows. We are given $n$ > points $p_1, p_2, \ldots, p_n$ with associated weights $w_1, w_2, \ldots, > w_n$. We wish to find a point $p$ (not necessarily one of the input points) > that minimizes the sum $\sum_{i=1}^n w_i d(p,p_i)$, where $d(a, b)$ is the > distance between the points $a$ and $b$. > >
    >
  1. Argue that the weighted median is a best solution for the > 1-dimensional post-office location problem, in which points are simply > real numbers and the distance between points $a$ and $b$ is $d(a,b) = |a - > b|$. >
  2. Find the best solution for the 2-dimensional post-office location > problem, in which the points are $(x,y)$ coordinate pairs and the distance > between points $a = (x_1, y_1)$ and $b = (x_2, y_2)$ is the **Manhattan > distance** given by $d(a, b) = |x_1 - x_2| + |y_1 - y_2|$. >
### Median and weighted median If the weights all elements are $1/n$, then the sum of the weights of the elements, smaller than the median, is $\lfloor \frac{n - 1}{2} \rfloor \frac{1}{n}$ and the sum of the weights of the larger elements is $\lceil \frac{n - 1}{2} \rceil \frac{1}{n}$. This satisfies the condition for weighted median. Furthermore, choosing a smaller or greater value will not hold in the condition. ### Computing with sorting 1. Sort the array 2. Start walking the array from left to right, accumulating the weights of the elements encountered 3. The first element with accumulated weight $w \ge 1/2$ is the weighted median ### Computing in linear time It's a very similar to `SELECT`, but instead of passing $i$, we pass a number around which the weights should partition (initially $1/2$). We find a good pivot in linear time and we partition around it. When we sum the weights in the lower part of the array and the weights in the upper part. If they fulfill the condition, we have our weighted median. ### 1-dimensional post-office location problem I'll present an informal argument, since it is convincing enough. A more formal one can be found in the instructor's manual. The situation is similar to exercise 9.3.8. Let's assume that we pick the weighted median as the solution and then start moving left or right. As we move away from the weighted median (in any direction), we're moving towards elements with combined weight less than $1/2$ and away from elements wight combined weight greater than $1/2$. Every "step" we take, we're increasing the total distance. ### 2-dimensional post-office location problem with Manhattan distance The solution is finding $(x_m, y_m)$ where those are the weighted medians of the $x$- and $y$- coordinates. I'm not even going to start proving this formally, since it requires mathematics above my current comfort level. Reasoning informally, by the definition of Manhattan distance, the $x$ coordinates and the $y$ coordinates are independent ­ we can rearrange the $x$ in any way we want, without affecting the $y$ coordinate of the solution and vice-versa. ================================================ FILE: other/clrs/09/problems/03.markdown ================================================ ## Small order statistics > We showed that the worst-case number $T(n)$ of comparisons used by `SELECT` > to select the $i$th order statistic from $n$ numbers satisfies $T(n) = > \Theta(n)$, but the constant hidden by the $\Theta$-notation is rather > large. When $i$ is small relative to $n$, we can implement a different > procedure that uses `SELECT` as a subroutine but makes fewer comparisons in > the worst case. > >
    >
  1. Describe an algorithm that uses $U_i(n)$ comparisons to find the $i$th > smallest of $n$ elements, where > $$ U_i(n) = \begin{cases} > T(n) & \text{if } i \ge n/2 \\\\ > \lfloor n/2 \rfloor + U_i(\lceil n/2 \rceil) + T(2i) & \text{otherwise} > \end{cases} $$ > (Hint: Begin with $\lfloor n/2 \rfloor$ disjoint pairwise > comparisons, and recurse on the set containing the smaller element from > each pair.) >
  2. Show that, if $i < n/2$, then $U_i(n) = n + \O(T(2i)\lg(n/i))$. >
  3. Show that, if $i$ is a constant less than $n/2$, then $U_i(n) = n + > \O(\lg{n})$. >
  4. Show that, if $i = n/k$ for $k \ge 2$, then $U_i(n) = n + > \O(T(2n/k)\lg{k})$. > ### The algorithm This is a modified version of `SELECT`. Not only it finds the $i$th order statistic, but it also partitions the array, thus finding the $i-1$ smaller elements. 1. If $i \ge n/2$, we just use `SELECT` 2. Otherwise, split the array in pairs and compare each pair. 3. We take the smaller elements of each pair, but keep track of the other one. 4. We recursively find the first $i$ elements among the smaller elements 5. The $i$th order statistic is among the pairs containing the smaller elements we found in the previous step. We call `SELECT` on those $2i$ elements. That's the final answer. Just picking the smaller element of each pair is not enough. For example, if we're looking for the 2nd order statistic and our pairs are `1, 2`, `3, 4`, `5, 6`, `7, 8`, `9, 10`, the answer is in the larger part of the first pair. That's why we need to keep track and later perform `SELECT` on $2i$ elements. Steps 1-4 can be implemented in place by modifying the algorithm to put the larger elements of the pairs on the inactive side of the pivot and modifying `PARTITION` to swap the elements on the inactive side every time it swaps elements on the active side. More details can be found in the Instructor's Manual. ### The math We can prove (b) by induction. This is the step: $$ \begin{aligned} U_i(n) &= \lfloor n/2 \rfloor + U_i(\lceil n/2 \rceil) + T(2i) \\\\ &= \lfloor n/2 \rfloor + \lceil n/2 \rceil + \O(T(2i)\lg(\lfloor n/2 \rfloor / i)) + T(2i) \\\\ &= n + \O(T(2i)\lg(n/i)) + T(2i) \\\\ &= n + \O(T(2i)\lg(n/i)) \end{aligned} $$ This is a bit more sloppy that doing it with the substitution method, but that feels like grunt work to me at this point. The other two are obvious: $$ \begin{aligned} U_i(n) &= n + \O(T(2i)\lg(n/i)) \\\\ &= n + \O(\O(1)\lg(n/i)) \\\\ &= n + \O(\lg{n} - \lg{i}) \\\\ &= n + \O(\lg{n} - \O(1)) \\\\ &= n + \O(\lg{n}) \end{aligned} $$ $$ \begin{aligned} U_i(n) &= n + \O(T(2i)\lg(n/i)) \\\\ &= n + \O(T(2n/k)\lg(n/(n/k))) \\\\ &= n + \O(T(2n/k)\lg{k}) \\\\ \end{aligned} $$ Again, this reasoning is sloppy, but I don't feel like applying the substitution method. ================================================ FILE: other/clrs/09/problems/04.markdown ================================================ ## Alternative analysis of randomized selection > In this problem, we use indicator random variables to analyze the > `RANDOMIZED-SELECT` procedure in a manner akin to our analysis of > `RANDOMIZED-QUICKSORT` in section 7.4.2. > > As in the quicksort analysis, we assume that all the elements are distinct, > and we rename the elements of the input array $A$ as $z_1, z_2, \ldots, > z_n$, where $z_i$ is the $i$th smallest element. Thus, the call > `RANDOMIZED-SELECT(A,1,n,k)` returns $z_k$. > > For $i \le i < j \le n$, let > > $$ X_{ijk} = I\\{z_i \text{ is compared with } z_j \text{ sometime during > the execution of the algorithm to find } z_k \\} $$ > >
      >
    1. Give an exact expression for $\E[X_{ijk}]$. (Hint: Your > expression may have different values, depending on the values of $i$, $j$, > and $k$.) >
    2. Let $X_k$ denote the total number of comparisons between elements of > array $A$ when finding $z_k$. Show that > $$ \E[X_k] \le 2 \bigg( > \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} + > \sum_{j=k+1}^n \frac{j - k - 1}{j - k + 1} + > \sum_{i=1}^{k-2} \frac{k - i - 1}{k - i + 1} > \bigg) $$ >
    3. Show that $\E[X_k] \le 4n$. >
    4. Conclude that, assuming all elements of array $A$ are distinct, > `RANDOMIZED-SELECT` runs in expected time $\O(n)$. >
    ### Expectation of exchanging two elements The situation is very similar to the quicksort analysis, although $k$ matters. $z_i$ and $z_j$ will be compared if one of them is the first element to get picked as a pivot in the smallest interval containing $i$, $j$ and $k$. The exact expression depends on the position of $k$ in regards to the other two: $$ \E[X_{ijk}] = \begin{cases} 2 / (k - i + 1) & \text{if } i < j \le k \\\\ 2 / (j - i + 1) & \text{if } i \le k \le j \\\\ 2 / (j - k + 1) & \text{if } k \le i < j \end{cases} $$ ### The expected number of comparisons It's a long derivation: $$ \begin{aligned} \E[X_k] &= \sum_{i=1}^{n-1} \sum_{j=i+1}^n \E[X_{ijk}] \\\\ &= \sum_{i=1}^k \sum_{j=i+1}^n \E[X_{ijk}] + \sum_{i=k+1}^{n-1} \sum_{j=i+1}^n \E[X_{ijk}] \\\\ &= \sum_{i=1}^k \bigg(\sum_{j=i+1}^{k-1}\E[X_{ijk}] + \sum_{j=k}^n\E[X_{ijk}] \bigg) + \sum_{i=k+1}^{n-1}\sum_{j=i+1}^n\E[X_{ijk}] \\\\ &= \sum_{i=1}^k \sum_{j=i+1}^{k-1} \E[X_{ijk}] + \sum_{i=1}^k \sum_{j=k}^n \E[X_{ijk}] + \sum_{i=k+1}^{n-1} \sum_{j=i+1}^n \E[X_{ijk}] \\\\ &= \sum_{i=1}^{k-2} \sum_{j=i+1}^{k-1} \E[X_{ijk}] + \sum_{i=1}^k \sum_{j=k}^n \E[X_{ijk}] + \sum_{i=k+1}^{n-1} \sum_{j=i+1}^n \E[X_{ijk}] \\\\ &= \sum_{i=1}^{k-2} \sum_{j=i+1}^{k-1} \frac{2}{k - i + 1} + \sum_{i=1}^k \sum_{j=k}^n \frac{2}{j - i + 1} + \sum_{i=k+1}^{n-1} \sum_{j=i+1}^n \frac{2}{j - k + 1} \\\\ &= 2\bigg( \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} + \sum_{i=k+1}^{n-1} \sum_{j=i+1}^n \frac{1}{j - k + 1} + \sum_{i=1}^{k-2} \sum_{j=i+1}^{k-1} \frac{1}{k - i + 1} \bigg) \\\\ &= 2\bigg( \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} + \sum_{i=k+1}^{n-1} \sum_{j=i+1}^n \frac{1}{j - k + 1} + \sum_{i=1}^{k-2} \frac{k - i - 1}{k - i + 1} \bigg) \\\\ &= 2\bigg( \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} + \sum_{j=k+2}^n \sum_{i=k+1}^{j-1} \frac{1}{j - k + 1} + \sum_{i=1}^{k-2} \frac{k - i - 1}{k - i + 1} \bigg) & \text{(note below)} \\\\ &= 2\bigg( \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} + \sum_{j=k+2}^n \frac{j - k - 1}{j - k + 1} + \sum_{i=1}^{k-2} \frac{k - i - 1}{k - i + 1} \bigg) \\\\ &\le 2\bigg( \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} + \sum_{j=k+1}^n \frac{j - k - 1}{j - k + 1} + \sum_{i=1}^{k-2} \frac{k - i - 1}{k - i + 1} \bigg) \\\\ \end{aligned} $$ The last noted derivation is valid because of the following iversonian equation: $$ [k+1 \le i \le n - 1][i+1 \le j \le n] = [k+1 \le i < i + 1 < j \le n] = [k + 1 < j \le n][k + 1 \le i < j]$$ Concrete mathematics helped a lot! ### Bounding to 4n Let's take the expressions in parts. The last two are straightforward enough: $$ \sum_{j=k+1}^n\frac{j-k-1}{j-k+1} + \sum_{i=1}^{k-2}\frac{k-i-1}{k-i+1} \le \sum_{j=k+1}^n 1 + \sum_{i=1}^{k-2} 1 = n - k + k - 2 \le n $$ This one is a bit trickier for me: $$ \sum_{i=1}^k \sum_{j=k}^n \frac{1}{j - i + 1} $$ It contains terms of the form $1/m$ where $1 \le m \le n$. It contains $1/1$ at most once, $1/2$ at most twice, $1/3$ at most three times and so on. Thus, the sum of the expressions $1/m$ for each $m$ is at most $1$ and there are $n$ such different expressions, which bounds the whole sum to $n$. There should be a way to manipulate the sums to prove that, but I cannot find it. In any case, both expressions are at most $2n$, which means that $\E[X_k] \le 4n$. ### Conclusion Well, it's rather obvious, isn't it? The number of operations in `RANDOMIZED-SELECT` are linear to the number of comparisons, and the expected number of comparisons are bound by a linear function, which means that the expected running time is linear. ================================================ FILE: other/clrs/10/01/01.markdown ================================================ > Using figure 10.1 as a model, illustrate the result of each operation in the > sequence `PUSH(S, 4)`, `PUSH(S, 1)`, `PUSH(S, 3)`, `POP(S)`, `PUSH(S, 8)`, > and `POP(S)` on an initially empty stack `S` stored in array `S[1..6]`. Well, ASCII art to the rescue. +---+---+---+---+---+---+ | | | | | | | +---+---+---+---+---+---+ ^ S.top = 0 PUSH(S, 4) +---+---+---+---+---+---+ | 4 | | | | | | +---+---+---+---+---+---+ ^ S.top = 1 PUSH(S, 1) +---+---+---+---+---+---+ | 4 | 1 | | | | | +---+---+---+---+---+---+ ^ S.top = 2 PUSH(S, 3) +---+---+---+---+---+---+ | 4 | 1 | 3 | | | | +---+---+---+---+---+---+ ^ S.top = 3 POP(S) +---+---+---+---+---+---+ | 4 | 1 | 3 | | | | +---+---+---+---+---+---+ ^ S.top = 2 PUSH(S, 8) +---+---+---+---+---+---+ | 4 | 1 | 8 | | | | +---+---+---+---+---+---+ ^ S.top = 3 POP(S) +---+---+---+---+---+---+ | 4 | 1 | 8 | | | | +---+---+---+---+---+---+ ^ S.top = 2 ================================================ FILE: other/clrs/10/01/02.markdown ================================================ > Explain how to implement two stacks in one array $A[1..n]$ in such a way > that neither stack overflows unless the total number of elements in both > stacks together is $n$. The `PUSH` and `POP` operations should run in > $\O(1)$ time. The first stack starts at $1$ and grows up towards $n$, while the second starts form $n$ and grows down towards $1$. Stack overflow happens when an element is pushed when the two stack pointers are adjacent. ================================================ FILE: other/clrs/10/01/03.markdown ================================================ > Using figure 10.2 as a model, illustrate the result of each operation in the > sequence `ENQUEUE(Q, 4)`, `ENQUEUE(Q, 1)`, `ENQUEUE(Q, 3)`, `DEQUEUE(Q)`, > `ENQUEUE(Q, 8)`, and `DEQUEUE(Q)` on an initially empty queue `Q` stored in > array `Q[1..6]`. Again, ASCII art to the rescue: +---+---+---+---+---+---+ | | | | | | | +---+---+---+---+---+---+ ^ Q.head = Q.tail = 1 ENQUEUE(Q, 4) +---+---+---+---+---+---+ | 4 | | | | | | +---+---+---+---+---+---+ ^ ^ Q.head = 1 Q.tail = 2 ENQUEUE(Q, 1) +---+---+---+---+---+---+ | 4 | 1 | | | | | +---+---+---+---+---+---+ ^ ^ Q.head = 1 Q.tail = 3 ENQUEUE(Q, 3) +---+---+---+---+---+---+ | 4 | 1 | 3 | | | | +---+---+---+---+---+---+ ^ ^ Q.head = 1 Q.tail = 4 DEQUEUE(Q) +---+---+---+---+---+---+ | 4 | 1 | 3 | | | | +---+---+---+---+---+---+ ^ ^ Q.head = 2 Q.tail = 4 ENQUEUE(Q, 8) +---+---+---+---+---+---+ | 4 | 1 | 3 | 8 | | | +---+---+---+---+---+---+ ^ ^ Q.head = 2 Q.tail = 5 DEQUEUE(Q) +---+---+---+---+---+---+ | 4 | 1 | 3 | 8 | | | +---+---+---+---+---+---+ ^ ^ Q.head = 3 Q.tail = 5 ================================================ FILE: other/clrs/10/01/04.markdown ================================================ > Rewrite `ENQUEUE` and `DEQUEUE` to detect underflow and overflow of a queue. I shall go with the pseudo-code version, since I'm too lazy to bother figuring out how to test it in C. We need to do a slight modification, since the current version provides no way to tell whether a queue is empty or full. We should have `Q.head == NIL` when the queue is empty and `Q.head == Q.tail` when the queue is full. An empty queue is initializes with `NIL` in its head and `Q.tail = `. We need to update `Q.head` when a `DEQUEUE` operation causes the queue to become empty. ENQUEUE(Q, x) if Q.head == Q.tail error "Queue overflow" Q[Q.tail] = x if Q.head == NIL Q.head = Q.tail if Q.tail == Q.length Q.tail = 1 else Q.tail = Q.tail + 1 DEQUEUE(Q) if Q.head == NIL error "Queue underflow" x = Q[Q.head] if Q.head == Q.length Q.head = 1 else Q.head = Q.head + 1 if Q.head == Q.tail Q.head = NIL return x ================================================ FILE: other/clrs/10/01/05.c ================================================ #include #include #define MAX_SIZE 10 typedef struct { int items[MAX_SIZE]; int head; int tail; } deque_t; void init_deque(deque_t *deque) { deque->head = -1; deque->tail = 0; } int is_empty(deque_t *deque) { return (deque->head == -1); } void push(deque_t *deque, int n) { if (deque->head == deque->tail) { fprintf(stderr, "Deque overflow\n"); exit(1); } deque->items[deque->tail] = n; if (deque->head == -1) { deque->head = deque->tail; } deque->tail = (deque->tail + 1) % MAX_SIZE; } void unshift(deque_t *deque, int n) { if (deque->head == deque->tail) { fprintf(stderr, "Deque overflow\n"); exit(1); } if (deque->head == -1) { deque->head = deque->tail; } deque->head = (deque->head - 1 + MAX_SIZE) % MAX_SIZE; deque->items[deque->head] = n; } int pop(deque_t *deque) { if (deque->head == -1) { fprintf(stderr, "Deque underflow\n"); exit(1); } deque->tail = (deque->tail + MAX_SIZE - 1) % MAX_SIZE; if (deque->tail == deque->head) { deque->head = -1; } return deque->items[deque->tail]; } int shift(deque_t *deque) { if (deque->head == -1) { fprintf(stderr, "Deque underflow\n"); exit(1); } int result = deque->items[deque->head]; deque->head = (deque->head + 1) % MAX_SIZE; if (deque->head == deque->tail) { deque->head = -1; } return result; } ================================================ FILE: other/clrs/10/01/05.markdown ================================================ > Whereas a stack allows insertion and deletion of elements at only one end, > and a queue allows insertion at one end and deletion at the other end, a > **deque** (double-ended queue) allows insertion and deletion at both ends. > Write four $\O(1)$-time procedures to insert elements into and delete > elements from both ends of a deque implemented by an array. ================================================ FILE: other/clrs/10/01/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" TEST(using_as_a_stack) { deque_t deque; init_deque(&deque); push(&deque, 1); push(&deque, 2); push(&deque, 3); ASSERT_FALSE(is_empty(&deque)); ASSERT_EQUALS(pop(&deque), 3); ASSERT_EQUALS(pop(&deque), 2); ASSERT_EQUALS(pop(&deque), 1); ASSERT_TRUE(is_empty(&deque)); push(&deque, 4); ASSERT_FALSE(is_empty(&deque)); ASSERT_EQUALS(pop(&deque), 4); ASSERT_TRUE(is_empty(&deque)); } TEST(using_as_queue) { deque_t deque; init_deque(&deque); push(&deque, 1); push(&deque, 2); push(&deque, 3); ASSERT_FALSE(is_empty(&deque)); ASSERT_EQUALS(shift(&deque), 1); ASSERT_EQUALS(shift(&deque), 2); ASSERT_EQUALS(shift(&deque), 3); ASSERT_TRUE(is_empty(&deque)); } TEST(unshifting) { deque_t deque; init_deque(&deque); unshift(&deque, 1); unshift(&deque, 2); unshift(&deque, 3); ASSERT_FALSE(is_empty(&deque)); ASSERT_EQUALS(pop(&deque), 1); ASSERT_EQUALS(pop(&deque), 2); ASSERT_EQUALS(pop(&deque), 3); ASSERT_TRUE(is_empty(&deque)); } TEST(wrapping_around_on_push) { deque_t deque; int i; init_deque(&deque); for (i = 0; i < MAX_SIZE; i++) { push(&deque, i); } shift(&deque); push(&deque, i); ASSERT_EQUALS(deque.items[0], i); } TEST(wrapping_around_on_shift) { deque_t deque; int i; init_deque(&deque); for (i = 0; i < MAX_SIZE - 1; i++) { unshift(&deque, i); } unshift(&deque, i); ASSERT_EQUALS(deque.items[0], i); } ================================================ FILE: other/clrs/10/01/06.markdown ================================================ > Show how to implement a queue using two stacks. Analyze the running time of > the queue operations. Let the two stacks be `A` and `B`. `ENQUEUE` pushes elements on `B`. `DEQUEUE` pops elements from `A`. If `A` is empty, the contents of `B` are transfered to `A` by popping them out of `B` and pushing them to `A`. That way they appear in reverse order and are popped in the original. A `DEQUEUE` operation can perform in $\Theta(n)$ time, but that will happen only when `A` is empty. If many `ENQUEUE`s and `DEQUEUE`s are performed, the total time will be linear to the number of elements, not to the largest length of the queue. ================================================ FILE: other/clrs/10/01/07.markdown ================================================ > Show how to implement a stack using two queues. Analyze the running time of > the stack operations. We have two queues and mark one of them as active. `PUSH` queues an element on the active queue. `POP` should dequeue all but one element of the active queue and queue them on the inactive. The roles of the queues are then reversed, and the final element left in the (now) inactive queue is returned. The `PUSH` operation is $\Theta(1)$, but the `POP` operation is $\Theta(n)$ where $n$ is the number of elements in the stack. ================================================ FILE: other/clrs/10/02/01.markdown ================================================ > Can you implement the dynamic-set operation `INSERT` on a singly linked list > in $\O(1)$ time? How about `DELETE`? You can implement `INSERT` in constant time by prepending it to the list. You cannot implement `DELETE` in constant time, unless you pass to it as an argument the predecessor of the element you are deleting. ================================================ FILE: other/clrs/10/02/02.markdown ================================================ > Implement a stack using a singly linked list `L`. The operations `PUSH` and > `POP` should still take $\O(1)$ time. This is too simple to be worth implementing. The `PUSH` operation adds an element in the beginning of the list and the `POP` operation removes the first element from the list. ================================================ FILE: other/clrs/10/02/03.markdown ================================================ > Implement a queue by using a singly linked list `L`. The operations > `ENQUEUE` and `DEQUEUE` should still take $\O(1)$ time. This is a bit trickier than the previous one, but still simple. * We need to keep track of the last element of the list. * Whenever we `ENQUEUE`, we should be inserting the element after it and marking the new last element of the list. * Whenever we `DEQUEUE`, we should pop the first element of the list. ================================================ FILE: other/clrs/10/02/04.markdown ================================================ > As written, each loop iteration in the `LIST-SEARCH'` procedure requires two > tests: one for `x ≠ L.nil` and one for `x.key ≠ k`. Show how to eliminate > the test for `x ≠ L.nil` in each iteration. We can set the key of the sentinel and then return the sentinel itself. It's somehow weird, but it can work in some contexts: LIST-SEARCH'(L, k): x = L.nil.next L.nil.key = k while x.key ≠ k x = x.net return x I have implemented this in exercise 10.2.5. ================================================ FILE: other/clrs/10/02/05.c ================================================ #include typedef struct node_t { int key; struct node_t *next; } node_t; typedef struct { struct node_t nil; } list_t; void init_list(list_t *list) { list->nil.key = 0; list->nil.next = &(list->nil); } void destroy_list(list_t *list) { node_t *node = list->nil.next; node_t *next; while (node != &(list->nil)) { next = node->next; free(node); node = next; } } void insert(list_t *list, int key) { node_t *new = (node_t *) malloc(sizeof(node_t)); new->key = key; new->next = list->nil.next; list->nil.next = new; } node_t *search(list_t *list, int key) { node_t *node = list->nil.next; // The trick from exercise 10.2.4 list->nil.key = key; while (node->key != key) { node = node->next; } if (node == &(list->nil)) { return NULL; } else { return node; } } void delete(list_t *list, int key) { node_t *node = &(list->nil); while (node->next != &(list->nil)) { if (node->next->key == key) { node_t *to_be_deleted = node->next; node->next = node->next->next; free(to_be_deleted); } else { node = node->next; } } } ================================================ FILE: other/clrs/10/02/05.markdown ================================================ > Implement the dictionary operations `INSERT`, `DELETE`, and `SEARCH` using > singly linked, circular lists. What are the running times of your > procedures? I assume this should use a sentinel. Otherwise, there is no good way to terminate the search. We can track a pointer and abort when we reach it again, but not all languages allow us to compare pointers that way. The C implementation uses the trick from exercise 10.2.4. ================================================ FILE: other/clrs/10/02/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" TEST(inserting_and_searching) { list_t list; init_list(&list); insert(&list, 1); insert(&list, 2); insert(&list, 3); ASSERT_TRUE(search(&list, 1) != NULL); ASSERT_TRUE(search(&list, 2) != NULL); ASSERT_TRUE(search(&list, 3) != NULL); ASSERT_TRUE(search(&list, 4) == NULL); destroy_list(&list); } TEST(deleting) { list_t list; init_list(&list); insert(&list, 1); insert(&list, 2); insert(&list, 3); ASSERT_TRUE(search(&list, 1) != NULL); delete(&list, 2); ASSERT_TRUE(search(&list, 2) == NULL); delete(&list, 3); ASSERT_TRUE(search(&list, 3) == NULL); ASSERT_TRUE(search(&list, 1) != NULL); destroy_list(&list); } TEST(deleting_an_element_inserted_multiple_times) { list_t list; init_list(&list); insert(&list, 1); insert(&list, 2); insert(&list, 2); insert(&list, 3); insert(&list, 2); ASSERT_TRUE(search(&list, 2) != NULL); delete(&list, 2); ASSERT_TRUE(search(&list, 2) == NULL); destroy_list(&list); } ================================================ FILE: other/clrs/10/02/06.markdown ================================================ > The dynamic-set operation `UNION` takes two disjoint sets $S_1$ and $S_2$ as > input, and it returns a set $S = S_1 \cup S_2$ consisting of all the > elements $S_1$ and $S_2$. The sets $S_1$ and $S_2$ are usually destroyed by > the operation. Show how to support `UNION` in $\O(1)$ time using a suitable > list data structure. If both sets are a doubly linked lists, we just point link the last element of the first list to the first element in the second. If the implementation uses sentinels, we need to destroy one of them. ================================================ FILE: other/clrs/10/02/07.c ================================================ #include typedef struct node_t { int key; struct node_t *next; } node_t; typedef struct { struct node_t nil; } list_t; void init_list(list_t *list) { list->nil.key = 0; list->nil.next = &(list->nil); } void destroy_list(list_t *list) { node_t *node = list->nil.next; node_t *next; while (node != &(list->nil)) { next = node->next; free(node); node = next; } } void insert(list_t *list, int key) { node_t *new = (node_t *) malloc(sizeof(node_t)); new->key = key; new->next = list->nil.next; list->nil.next = new; } void reverse(list_t *list) { node_t *prev = &(list->nil); node_t *node = list->nil.next; node_t *next; while (node != &(list->nil)) { next = node->next; node->next = prev; prev = node; node = next; } list->nil.next = prev; } ================================================ FILE: other/clrs/10/02/07.markdown ================================================ > Give a $\Theta(n)$-time nonrecursive procedure that reverses a singly linked > list of $n$ elements. The procedure should use no more than a constant > storage beyond that needed for the list itself. ================================================ FILE: other/clrs/10/02/07.test.c ================================================ #include "07.c" #include "../../build/ext/test.h" TEST(inserting_and_searching) { list_t list; init_list(&list); insert(&list, 1); insert(&list, 2); insert(&list, 3); reverse(&list); ASSERT_EQUALS(list.nil.next->key, 1); ASSERT_EQUALS(list.nil.next->next->key, 2); ASSERT_EQUALS(list.nil.next->next->next->key, 3); destroy_list(&list); } ================================================ FILE: other/clrs/10/02/08.c ================================================ #include #include typedef struct node_t { int key; struct node_t *np; } node_t; typedef struct { struct node_t *head; struct node_t *tail; } list_t; node_t *xor(node_t *left, node_t *right) { return (node_t *) (((unsigned long) left) ^ ((unsigned long) right)); } void init_list(list_t *list) { list->head = NULL; list->tail = NULL; } void destroy_list(list_t *list) { node_t *prev = NULL; node_t *node = list->head; node_t *next; while (node) { next = xor(node->np, prev); free(node); prev = node; node = next; } } void insert(list_t *list, int key) { node_t *new = (node_t *) malloc(sizeof(node_t)); new->key = key; new->np = xor(NULL, list->tail); if (list->tail) { list->tail->np = xor(new, xor(NULL, list->tail->np)); } if (!list->head) { list->head = new; } list->tail = new; } int get(list_t *list, int index) { node_t *node = list->head; node_t *prev = NULL; node_t *next; while (index--) { if (!node) { fprintf(stderr, "Index out of bounds\n"); exit(1); } next = xor(node->np, prev); prev = node; node = next; } return node->key; } node_t *search(list_t *list, int key) { node_t *node = list->head; node_t *prev = NULL; node_t *next; while (node) { if (node->key == key) { return node; } next = xor(node->np, prev); prev = node; node = next; } return NULL; } void delete(list_t *list, int key) { node_t *node = list->head; node_t *prev = NULL; node_t *next; while (node) { if (node->key == key) { next = xor(node->np, prev); if (prev) { prev->np = xor(xor(prev->np, node), next); } else { list->head = next; } if (next) { next->np = xor(xor(next->np, node), prev); } else { list->tail = prev; } node = next; } else { next = xor(node->np, prev); prev = node; node = next; } } } void reverse(list_t *list) { node_t *tmp; tmp = list->head; list->head = list->tail; list->tail = tmp; } ================================================ FILE: other/clrs/10/02/08.markdown ================================================ > $\star$ Explain how to implement doubly linked lists using only one pointer > value `x.np` per item instead of the usual two (`next` and `prev`). Assume > that all pointer values can be interpreted as $k$-bit integers, and define > `x.np = x.next XOR x.prev`, the $k$-bit "exclusive-or" of `x.next` and > `x.prev`. (The value `NIL` is represented by 0). Be sure to describe what > information you need to access the head of the list. Show how to implement > the `SEARCH`, `INSERT` and `DELETE` operations on such a list. Also show how > to reverse such a list in $\O(1)$ time. We can find the pointer to the next item by XOR-ing `np` with the pointer to the previous item and vice-versa. If the previous pointer of the head of the list is to NIL and the next pointer of the tail is to NIL, then we only need a pointer to either end of the list to access it. Reversing the list is just swapping the head and the tail. ================================================ FILE: other/clrs/10/02/08.test.c ================================================ #include "08.c" #include "../../build/ext/test.h" TEST(inserting_and_searching) { list_t list; init_list(&list); insert(&list, 1); insert(&list, 2); insert(&list, 3); ASSERT_TRUE(search(&list, 0) == NULL); ASSERT_TRUE(search(&list, 1) != NULL); ASSERT_TRUE(search(&list, 2) != NULL); ASSERT_TRUE(search(&list, 3) != NULL); ASSERT_TRUE(search(&list, 4) == NULL); destroy_list(&list); } TEST(deleting) { list_t list; init_list(&list); insert(&list, 2); insert(&list, 1); insert(&list, 2); insert(&list, 3); insert(&list, 2); insert(&list, 2); delete(&list, 2); ASSERT_TRUE(search(&list, 2) == NULL); destroy_list(&list); } TEST(reversing) { list_t list; init_list(&list); insert(&list, 1); insert(&list, 2); insert(&list, 3); reverse(&list); ASSERT_EQUALS(get(&list, 0), 3); ASSERT_EQUALS(get(&list, 1), 2); ASSERT_EQUALS(get(&list, 2), 1); destroy_list(&list); } ================================================ FILE: other/clrs/10/03/01.markdown ================================================ > Draw a picture of the sequence $\langle 13, 4, 8, 19, 5, 11 \rangle$ stored > as a doubly linked list using the multiple-array representation. Do the same > for the single-array representation. Let the indexes start from 1. To make things interesting, let's write the elements in increasing order: +---+ | L |--------------------------------------+ +---+ V 1 2 3 4 5 6 7 8 9 10 11 12 +----+----+----+----+----+----+----+----+----+----+----+----+ next | | 5 | | 7 | 10 | | / | 2 | | 4 | | | +----+----+----+----+----+----+----+----+----+----+----+----+ key | | 4 | | 5 | 8 | | 11 | 13 | | 19 | | | +----+----+----+----+----+----+----+----+----+----+----+----+ prev | | 8 | | 10 | 2 | | 4 | / | | 5 | | | +----+----+----+----+----+----+----+----+----+----+----+----+ I'll do the next one in a slightly more compact fashion: 1 2 3 4 5 6 7 8 9 10 11 12 +----+----+----++----+----+----++----+----+----++----+----+----++-- | 4 | 7 | 13 || 5 | 10 | 16 || 8 | 16 | 1 || 11 | / | 4 || +----+----+----++----+----+----++----+----+----++----+----+----++-- 13 14 15 16 17 18 --++----+----+----++----+----+----+ || 13 | 1 | / || 19 | 4 | 7 | --++----+----+----++----+----+----+ ================================================ FILE: other/clrs/10/03/02.c ================================================ #include #include #define MAX_SIZE 3 typedef int list_t; typedef int obj_t; int empty_list = -1; int cells[MAX_SIZE * 3]; int free_list; #define NEXT(i) cells[(i) + 1] #define PREV(i) cells[(i) + 2] #define KEY(i) cells[i] void init_storage() { int i; for (i = 0; i < (MAX_SIZE - 1) * 3; i += 3) NEXT(i) = i + 3; NEXT(i) = -1; free_list = 0; } list_t allocate_object() { if (free_list == -1) { fprintf(stderr, "Storage depleted\n"); exit(1); } list_t new = free_list; free_list = NEXT(free_list); return new; } void free_object(list_t list) { NEXT(list) = free_list; free_list = list; } list_t cons(obj_t key, list_t list) { list_t new = allocate_object(); NEXT(new) = list; PREV(new) = empty_list; KEY(new) = key; if (list != empty_list) { PREV(list) = new; } return new; } void delete(list_t list) { if (PREV(list) != empty_list) { NEXT(PREV(list)) = NEXT(list); } if (NEXT(list) != empty_list) { PREV(NEXT(list)) = PREV(list); } free_object(list); } obj_t get(list) { if (list == empty_list) return -1; return KEY(list); } list_t next(list) { if (list == empty_list) return -1; return NEXT(list); } ================================================ FILE: other/clrs/10/03/02.markdown ================================================ > Write the procedures `ALLOCATE-OBJECT` and `FREE-OBJECT` for a homogeneous > collection of objects implemented by the single-array representation. ================================================ FILE: other/clrs/10/03/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" TEST(adding_elements) { list_t list; init_storage(); list = cons(1, empty_list); list = cons(2, list); list = cons(3, list); ASSERT_EQUALS(get(list), 3); ASSERT_EQUALS(get(next(list)), 2); ASSERT_EQUALS(get(next(next(list))), 1); ASSERT_EQUALS(get(next(next(next(list)))), empty_list); } TEST(removing_elements) { list_t list, freed; init_storage(); list = cons(1, empty_list); list = freed = cons(2, list); list = cons(3, list); delete(freed); ASSERT_EQUALS(get(list), 3); ASSERT_EQUALS(get(next(list)), 1); ASSERT_EQUALS(get(next(next(list))), empty_list); ASSERT_EQUALS(free_list, freed); } TEST(removing_and_adding) { list_t list, freed; init_storage(); list = cons(1, empty_list); list = freed = cons(2, list); list = cons(3, list); delete(freed); list = cons(4, list); ASSERT_EQUALS(get(list), 4); ASSERT_EQUALS(get(next(list)), 3); ASSERT_EQUALS(get(next(next(list))), 1); ASSERT_EQUALS(get(next(next(next(list)))), empty_list); ASSERT_EQUALS(free_list, -1); } ================================================ FILE: other/clrs/10/03/03.markdown ================================================ > Why don't we need to set or reset the `prev` attributes of objects in the > implementation of the `ALLOCATE-OBJECT` and `FREE-OBJECT` procedures? Because we're not using them. Having a singly linked free list is sufficient. We don't need the `prev` attribute and we don't even need the `key` attribute. Whenever we allocate and free objects, we're setting those fields anyway, so it does not matter that we don't reset them. ================================================ FILE: other/clrs/10/03/04.markdown ================================================ > It is often desirable to keep all elements of a doubly linked list compact > in storage, using, for example, the first $m$ index locations in the > multiple-array representation. (This is the case in a paged, virtual-memory > computing environment.) Explain how to implement the procedures > `ALLOCATE-OBJECT` and `FREE-OBJECT` so that the representation is compact. > Assume that there are no pointers to elements of the linked list outside the > list itself. (Hint: Use the array implementation of a stack.) We can allocate elements in the beginning of the array. Whenever we deallocate an element, other than the last (in the stack), we need to shift all elements after it left and then update all the indices that point beyond the deleted element (by decrementing them). This will take linear time. As an optimization, whenever we deallocate the last element in the array, we don't need to scan the array and update pointers. ================================================ FILE: other/clrs/10/03/05.c ================================================ #include #include #define MAX_SIZE 100 typedef int list_t; typedef int obj_t; int empty_list = -1; int prev[MAX_SIZE]; int next[MAX_SIZE]; obj_t keys[MAX_SIZE]; int free_list; void init_storage() { int i; for (i = 0; i < MAX_SIZE - 1; i++) next[i] = i + 1; next[i] = -1; free_list = 0; } list_t allocate_object() { if (free_list == -1) { fprintf(stderr, "Storage depleted\n"); exit(1); } list_t new = free_list; free_list = next[free_list]; return new; } void free_object(list_t list) { next[list] = free_list; free_list = list; } list_t cons(obj_t key, list_t list) { list_t new = allocate_object(); next[new] = list; prev[new] = empty_list; keys[new] = key; if (list != empty_list) { prev[list] = new; } return new; } void delete(list_t list) { if (prev[list] != empty_list) { next[prev[list]] = next[list]; } if (next[list] != empty_list) { prev[next[list]] = prev[list]; } free_object(list); } obj_t get(list) { if (list == empty_list) return -1; return keys[list]; } list_t next_obj(list) { if (list == empty_list) return -1; return next[list]; } list_t compatify_list(list_t list) { list_t left, right, i; if (free_list == empty_list) { return list; } i = free_list; while (i != empty_list) { prev[i] = -2; i = next[i]; } left = 0; right = MAX_SIZE - 1; while (1) { while (prev[left] != -2) left++; while (prev[right] == -2) right--; if (left >= right) break; prev[left] = prev[right]; next[left] = next[right]; keys[left] = keys[right]; next[right] = left; right--; left++; } right++; for (int i = 0; i < right; i++) { if (prev[i] >= right) { prev[i] = next[prev[i]]; } if (next[i] >= right) { next[i] = next[next[i]]; } } if (list >= right) { list = next[list]; } for (i = right; i < MAX_SIZE - 1; i++) { next[i] = i+1; } next[i] = -1; free_list = right; return list; } ================================================ FILE: other/clrs/10/03/05.markdown ================================================ > Let $L$ be a doubly linked list of length $n$ stored in arrays `key`, > `prev`, and `next` of length $m$. Suppose that these arrays are managed by > `ALLOCATE-OBJECT` and `FREE-OBJECT` procedures that keep a doubly linked > free list $L$. Suppose further that of the $m$ items, exactly $n$ are on the > list $L$ and $m - n$ are on the free list. Write a procedure > `COMPACTIFY-LIST(L, F)` that, given the list $L$ and the free list $F$, > moves the items in $L$ so that they occupy array positions $1, 2, \ldots, n$ > and adjust the free list $F$ so that it remains correct, occupying array > positions $n + 1, n + 2, \ldots, m$. The running time of your procedure > should be $\Theta(n)$, and it should use only a constant amount of extra > space. Argue that your procedure is correct. I'll use this approach: 1. We traverse the free list and mark each element by putting a special value in its `prev` pointer (it is not used by the free list) 2. We start two pointers, one from the beginning of the memory and one from the end. We increment the left pointer until it reaches an empty cell and decrement the right until it reaches a non-empty cell. We move the right cell to the left position and leave a forwarding address in the `next` field. This terminates when the two pointers catch up. At this point the "active" memory is in the beginning of the array and the free - in the end. We take note of the threshold. 3. We linearly scan the first part of the array and update all the pointers that point beyond the threshold, by using the forwarding address in `next`. 4. Finally, we organize the memory beyond the threshold in a free list. ================================================ FILE: other/clrs/10/03/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" TEST(compactify) { list_t list; init_storage(); list = cons(0, empty_list); list = cons(1, list); list = cons(2, list); list = cons(3, list); list = cons(4, list); list = cons(5, list); list = cons(6, list); list = cons(7, list); list = cons(8, list); delete(2); delete(3); delete(5); delete(6); list = compatify_list(list); ASSERT_EQUALS(get(list), 8); ASSERT_EQUALS(get(next_obj(list)), 7); ASSERT_EQUALS(get(next_obj(next_obj(list))), 4); ASSERT_EQUALS(get(next_obj(next_obj(next_obj(list)))), 1); ASSERT_EQUALS(get(next_obj(next_obj(next_obj(next_obj(list))))), 0); ASSERT_EQUALS(get(next_obj(next_obj(next_obj(next_obj(next_obj(list)))))), -1); ASSERT_EQUALS(free_list, 5); } ================================================ FILE: other/clrs/10/04/01.dot ================================================ graph { node[shape="circle"]; n1[label="12"]; n2[label="15"]; n3[label="4"]; n4[label="10"]; n5[label="2"]; n6[label="18"]; n7[label="7"]; n8[label="14"]; n9[label="21"]; n10[label="5"]; n6 -- n1; n6 -- n4; n1 -- n7; n1 -- n3; n4 -- n5; n4 -- n9; n3 -- n10; } ================================================ FILE: other/clrs/10/04/01.markdown ================================================ > Draw the binary tree rooted at index 6 that is represented by the following > attributes: > > | index | key | left | right | > |:-----:|:----:|:-----:|:-----:| > | 1 | 12 | 7 | 3 | > | 2 | 15 | 8 | NIL | > | 3 | 4 | 10 | NIL | > | 4 | 10 | 5 | 9 | > | 5 | 2 | NIL | NIL | > | 6 | 18 | 1 | 4 | > | 7 | 7 | NIL | NIL | > | 8 | 14 | 6 | 2 | > | 9 | 21 | NIL | NIL | > | 10 | 5 | NIL | NIL | This is a subtree, that does not contain two of the elements. ================================================ FILE: other/clrs/10/04/02.c ================================================ struct tree_t { struct tree_t *left; struct tree_t *right; struct tree_t *parent; int key; }; typedef struct tree_t tree_t; void store(int); void print_tree(tree_t *tree) { store(tree->key); if (tree->left) print_tree(tree->left); if (tree->right) print_tree(tree->right); } #define MAX_SIZE 10 int keys[MAX_SIZE]; int count = 0; void reset_storage() { count = 0; } void store(int key) { keys[count++] = key; } ================================================ FILE: other/clrs/10/04/02.markdown ================================================ > Write an $\O(n)$-time recursive procedure that, given an $n$-node binary > tree, prints out the key of each node in the tree. ================================================ FILE: other/clrs/10/04/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" #include tree_t* make_tree(int key) { tree_t *new = malloc(sizeof(tree_t)); new->key = key; new->left = NULL; new->right = NULL; new->parent = NULL; return new; } tree_t* make_left(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->left = new; return new; } tree_t* make_right(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->right = new; return new; } TEST(quote_printing_unquote) { tree_t *t1 = make_tree(1); tree_t *t2 = make_left(t1, 2); tree_t *t3 = make_right(t1, 3); tree_t *t4 = make_left(t2, 4); tree_t *t5 = make_left(t3, 5); tree_t *t6 = make_right(t3, 6); int expected[] = {1, 2, 4, 3, 5, 6}; print_tree(t1); ASSERT_SAME_ARRAYS_S(keys, expected, count); } ================================================ FILE: other/clrs/10/04/03.c ================================================ #define MAX_SIZE 10 struct tree_t { struct tree_t *left; struct tree_t *right; struct tree_t *parent; int key; }; typedef struct tree_t tree_t; void store(int); void print_tree(tree_t *tree) { tree_t *stack[MAX_SIZE]; int count = 0; stack[count++] = tree; while (count) { tree = stack[--count]; store(tree->key); if (tree->right) stack[count++] = tree->right; if (tree->left) stack[count++] = tree->left; } } int keys[MAX_SIZE]; int count = 0; void reset_storage() { count = 0; } void store(int key) { keys[count++] = key; } ================================================ FILE: other/clrs/10/04/03.markdown ================================================ > Write an $\O(n)$-time nonrecursive procedure that, given an $n$-node binary > tree, prints out the key of each node in the tree. Use a stack as an > auxiliary data structure. ================================================ FILE: other/clrs/10/04/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" #include tree_t* make_tree(int key) { tree_t *new = malloc(sizeof(tree_t)); new->key = key; new->left = NULL; new->right = NULL; new->parent = NULL; return new; } tree_t* make_left(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->left = new; return new; } tree_t* make_right(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->right = new; return new; } TEST(quote_printing_unquote) { tree_t *t1 = make_tree(1); tree_t *t2 = make_left(t1, 2); tree_t *t3 = make_right(t1, 3); tree_t *t4 = make_left(t2, 4); tree_t *t5 = make_left(t3, 5); tree_t *t6 = make_right(t3, 6); int expected[] = {1, 2, 4, 3, 5, 6}; print_tree(t1); ASSERT_SAME_ARRAYS_S(keys, expected, 6); } ================================================ FILE: other/clrs/10/04/04.c ================================================ #define MAX_SIZE 10 struct tree_t { struct tree_t *child; struct tree_t *sibling; struct tree_t *parent; int key; }; typedef struct tree_t tree_t; void store(int); void print_tree(tree_t *tree) { store(tree->key); if (tree->child) print_tree(tree->child); if (tree->sibling) print_tree(tree->sibling); } int keys[MAX_SIZE]; int count = 0; void reset_storage() { count = 0; } void store(int key) { keys[count++] = key; } ================================================ FILE: other/clrs/10/04/04.markdown ================================================ > Write an $\O(n)$-time procedure that prints all the keys of an arbitrary > rooted tree with $n$ nodes, where the tree is stored using the left-child, > right-sibling representation. ================================================ FILE: other/clrs/10/04/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" #include tree_t *make_tree(int key) { tree_t *new = malloc(sizeof(tree_t)); new->key = key; new->parent = NULL; new->child = NULL; new->sibling = NULL; return new; } tree_t *make_child(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->child = new; return new; } tree_t *make_sibling(tree_t *left, int key) { tree_t *new = make_tree(key); new->parent = left->parent; left->sibling = new; return new; } TEST(quote_printing_unquote) { tree_t *t1 = make_tree(1); tree_t *t2 = make_child(t1, 2); tree_t *t3 = make_sibling(t2, 3); tree_t *t4 = make_child(t3, 4); tree_t *t5 = make_sibling(t4, 5); tree_t *t6 = make_sibling(t5, 6); tree_t *t7 = make_child(t2, 7); tree_t *t8 = make_sibling(t7, 8); tree_t *t9 = make_child(t8, 9); tree_t *t10 = make_sibling(t9, 10); tree_t *t11 = make_sibling(t8, 11); int expected[] = {1, 2, 7, 8, 9, 10, 11, 3, 4, 5, 6}; print_tree(t1); ASSERT_SAME_ARRAYS_S(expected, keys, 11); } ================================================ FILE: other/clrs/10/04/05.c ================================================ struct tree_t { struct tree_t *left; struct tree_t *right; struct tree_t *parent; int key; }; typedef struct tree_t tree_t; void store(int); void print_tree(tree_t *tree) { tree_t *prev; prev = 0; while (tree) { if (prev == tree->parent) { store(tree->key); prev = tree; tree = tree->left ? tree->left : tree->right ? tree->right : tree->parent; } else if (prev == tree->left && tree->right) { prev = tree; tree = tree->right; } else { prev = tree; tree = tree->parent; } } } #define MAX_SIZE 10 int keys[MAX_SIZE]; int count = 0; void reset_storage() { count = 0; } void store(int key) { keys[count++] = key; } ================================================ FILE: other/clrs/10/04/05.markdown ================================================ > $\star$ Write an $\O(n)$-time nonrecursive procedure that, given an $n$-node > binary tree prints out the key of each node. Use no more than constant extra > space outside the tree itself and do not modify the tree, even temporarily, > during the procedure. This is tricky. We need a pointer to the parent. We keep track of the previous pointer (starting with NIL) and do the following. 1. If we're coming from the parent, move to the left child 2. If we're coming from the left child, move to the right child 3. If we're coming from the right child, move to the parent To handle cases of less than two children, we skip to the next step if the conditions allow for it. That is: * If there is only a right child, and we're coming form the parent, we move to the right child * If we come from the left child, but there is no right child, we move to the parent. * If we there are no children, we move to the parent. ================================================ FILE: other/clrs/10/04/05.test.c ================================================ #include "05.c" #include "../../build/ext/test.h" #include tree_t* make_tree(int key) { tree_t *new = malloc(sizeof(tree_t)); new->key = key; new->left = NULL; new->right = NULL; new->parent = NULL; return new; } tree_t* make_left(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->left = new; return new; } tree_t* make_right(tree_t *parent, int key) { tree_t *new = make_tree(key); new->parent = parent; parent->right = new; return new; } TEST(quote_printing_unquote) { tree_t *t1 = make_tree(1); tree_t *t2 = make_left(t1, 2); tree_t *t3 = make_right(t1, 3); tree_t *t4 = make_left(t2, 4); tree_t *t5 = make_left(t3, 5); tree_t *t6 = make_right(t3, 6); int expected[] = {1, 2, 4, 3, 5, 6}; print_tree(t1); ASSERT_SAME_ARRAYS_S(keys, expected, 6); } ================================================ FILE: other/clrs/10/04/06.markdown ================================================ > $\star$ The left-child, right-sibling representation of an arbitrary rooted > tree uses three pointers in each node: _left-child_, _right-sibling_, and > _parent_. From any node, its parent can be reached and identified in > constant time and all its children can be reached and identified in time > linear in the number of children. Show how to use only two pointers and one > boolean value in each node so that the parent of a node or all of its > children can be reached and identified in time linear in the number of > children. The two pointers will be _left-child_ and _next_. The boolean should be called _last-sibling_. Identifying the children is by starting with _left-child_ and moving through _next_ until the last sibling is reached. Identifying the parent is moving through _next_ until the last sibling is reached and then moving through it once again. ================================================ FILE: other/clrs/10/problems/01.markdown ================================================ ## Comparisons among lists > For each of the four types of lists in the following table, what is > the asymptotic worst-case running time fore each dynamic-set > operation listed? | | unsorted, singly linked | sorted, singly linked | unsorted, doubly linked | sorted, doubly linked | |:--------------------|:-----------------------:|:---------------------:|:-----------------------:|:---------------------:| | `SEARCH(L, k)` | linear | linear | linear | linear | | `INSERT(L, x)` | constant | linear | constant | linear | | `DELETE(L, x)` | linear | linear | constant | constant | | `SUCCESSOR(L, x)` | linear | constant | linear | constant | | `PREDECESSOR(L, x)` | linear | linear | linear | constant | | `MINIMUM(L, k)` | linear | constant | linear | constant | | `MAXIMUM(L, k)` | linear | linear | linear | linear | * `MAXIMUM` assumes that we don't keep track of the tail of the list. If it does, we can make the algorithms constant when the list is sorted ================================================ FILE: other/clrs/10/problems/02.c ================================================ #include #include ///////////////////////////////////////////////////////////////////////////// // List operations ///////////////////////////////////////////////////////////////////////////// struct list_t { int key; struct list_t *next; }; typedef struct list_t list_t; list_t *insert_sorted(list_t *list, int key) { list_t *new = malloc(sizeof(list_t)); new->key = key; if (!list || key < list->key) { new->next = list; return new; } list_t *l = list; while (l->next && l->next->key < key) { l = l->next; } new->next = l->next; l->next = new; return list; } list_t *delete_key(list_t *list, int key) { list_t *match; while (list && list->key == key) { match = list; list = list->next; free(match); } if (!list) { return NULL; } list_t *node = list; while (node->next) { if (node->next->key == key) { match = node->next; node->next = match->next; free(match); } else { node = node->next; } } return list; } list_t *prepend(list_t *list, int key) { list_t *new = malloc(sizeof(list_t)); new->key = key; new->next = list; return new; } int find_min(list_t *list) { int min = list->key; list = list->next; while (list) { if (list->key < min) { min = list->key; } list = list->next; } return min; } list_t *link_together(list_t *a, list_t *b) { list_t *result; if (!a) { result = b; } else { result = a; while (a->next) { a = a->next; } a->next = b; } return result; } list_t *merge_sorted(list_t *a, list_t *b) { list_t dummy; list_t *new = &dummy; while (a && b) { if (a->key < b->key) { new->next = a; a = a->next; new = new->next; } else { new->next = b; b = b->next; new = new->next; } } if (a) { new->next = a; } else { new->next = b; } return dummy.next; } ///////////////////////////////////////////////////////////////////////////// // 1. Mergreable heaps with sorted list ///////////////////////////////////////////////////////////////////////////// typedef struct { list_t *head; } heap1; heap1 *make_heap1() { heap1 *result = malloc(sizeof(heap1)); result->head = NULL; return result; } void insert1(heap1 *heap, int key) { heap->head = insert_sorted(heap->head, key); } int minimum1(heap1 *heap) { return heap->head->key; } int extract_min1(heap1 *heap) { list_t *head = heap->head; int result = head->key; heap->head = head->next; free(head); return result; } heap1 *union1(heap1 *ha, heap1 *hb) { heap1 *result = malloc(sizeof(heap1)); result->head = merge_sorted(ha->head, hb->head); free(ha); free(hb); return result; } ///////////////////////////////////////////////////////////////////////////// // 2. Mergreable heaps with unsorted lists ///////////////////////////////////////////////////////////////////////////// typedef struct { list_t *head; } heap2; heap2 *make_heap2() { heap2 *result = malloc(sizeof(heap2)); result->head = NULL; return result; } void insert2(heap2 *heap, int key) { heap->head = prepend(heap->head, key); } int minimum2(heap2 *heap) { return find_min(heap->head); } int extract_min2(heap2 *heap) { int min = minimum2(heap); heap->head = delete_key(heap->head, min); return min; } heap2 *union2(heap2 *ha, heap2 *hb) { heap2 *result = make_heap2(); result->head = link_together(ha->head, hb->head); free(ha); free(hb); return result; } ================================================ FILE: other/clrs/10/problems/02.markdown ================================================ ## Mergeable heaps using linked lists > A **mergeable heap** supports the following operations: `MAKE-HEAP` (which > creates an empty mergeable heap), `INSERT`, `MINIMUM`, `EXTRACT-MIN`, and > `UNION`. Show how to implement mergeable heaps using linked lists in each of > the following cases. Try to make each operation as efficient as possible. > Analyze the running time of each operation in terms of the size of the > dynamic set(s) being operated on. > >
      >
    1. Lists are sorted. >
    2. Lists are unsorted. >
    3. Lists are unsorted, and dynamic sets to be merged are disjoint. >
    There isn't a difference in my implementation between the sorted and unsorted lists. There will be a difference between (a) and (b) if we don't allow repetitions in the lists, but since this will make insertion linear, I find it better to let insert create duplicates and them remove them on `EXTRACT-MIN`. That way the latter is linear (even if with a larger constant), but `UNION` can be implemented constantly with doubly-linked lists. I've chosen singly-linked lists for no good reason. Mostly because I did not realize `UNION` is going to take linear time with such an implementation (in order to find the last element of the first list). If we switch to doubly-linked, we can make it constant easily. I find this problem too simple to bother further. Otherwise, the running times are as follows | | sorted | unsorted | |:--------------|:--------:|:--------:| | `MAKE-HEAP` | constant | constant | | `INSERT` | linear | constant | | `MINIMUM` | constant | linear | | `EXTRACT-MIN` | constant | linear | | `UNION` | linear | linear* | As I noted, `UNION` can be made constant if we keep track of the last element of the list. ================================================ FILE: other/clrs/10/problems/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" heap1 *build1(int first, ...) { heap1 *result = make_heap1(); va_list marker; int i = first; va_start(marker, first); while (i != -1) { insert1(result, i); i = va_arg(marker, int); } va_end(marker); return result; } heap2 *build2(int first, ...) { heap2 *result = make_heap2(); va_list marker; int i = first; va_start(marker, first); while (i != -1) { insert2(result, i); i = va_arg(marker, int); } va_end(marker); return result; } TEST(heap1) { heap1 *h1 = build1(4, 6, 1, -1); heap1 *h2 = build1(2, 5, 3, -1); ASSERT_EQUALS(minimum1(h1), 1); ASSERT_EQUALS(minimum1(h2), 2); heap1 *h3 = union1(h2, h1); ASSERT_EQUALS(extract_min1(h3), 1); ASSERT_EQUALS(extract_min1(h3), 2); ASSERT_EQUALS(extract_min1(h3), 3); } TEST(heap2) { heap2 *h1 = build2(4, 2, 6, 1, -1); heap2 *h2 = build2(2, 5, 3, 3, -1); ASSERT_EQUALS(minimum2(h2), 2); ASSERT_EQUALS(minimum2(h1), 1); heap2 *h3 = union2(h2, h1); ASSERT_EQUALS(extract_min2(h3), 1); ASSERT_EQUALS(extract_min2(h3), 2); ASSERT_EQUALS(extract_min2(h3), 3); ASSERT_EQUALS(extract_min2(h3), 4); } ================================================ FILE: other/clrs/10/problems/03.markdown ================================================ ## Searching a sorted compact list > Exercise 10.3-4 asked how we might maintain an $n$-element list compactly in > the first $n$ positions of an array. We shall assume that the keys are > distinct and that the compact list is also sorted, that is, `key[i] < > key[next[i]]` for all $i = 1, 2, \ldots, n$ such that `next[i] ≠ NIL`. We > will also assume that we have a variable $L$ that contains the index of the > first element on the list. Under these assumptions, you will show that we > can use the following randomized algorithm to search the list in > $\O(\sqrt{n})$ expected time. > > COMPACT-LIST-SEARCH(L, n, k) > i = L > while i ≠ ␀ and key[i] < k > j = RANDOM(1, n) > if key[i] < key[j] and key[j] ≤ k > i = j > if key[i] == k > return i > i = next[i] > if i == ␀ or key[i] > k > return ␀ > > If we ignore lines 3-7 of the procedure, we have an ordinary algorithm for > searching a sorted linked list, in which index $i$ points to each position > of the list in turn. The search terminates once the index $i$ "falls off" > the end of the list or once `key[i] ≥ k`. In the latter case, if `key[i] = > k`, clearly we have found a key with value $k$. If, however, `key[i] > k`, > then we will never find a key with the value $k$, and so terminating the > search was the right thing to do. > > Lines 3-7 attempt to skip ahead to a randomly chosen position $j$. Such a > skip benefits us if `key[j]` is larger than `key[i]` and no larger than $k$; > in such a case, $j$ marks a position in the list that $i$ would have to > reach during an ordinary list search. Because the list is compact, we know > that in any choice of $j$ between $1$ and $n$ indexes some object in the > list rather than a slot on the free list. > > Instead of analyzing the performance of `COMPACT-LIST-SEARCH` directly, we > shall analyze a related algorithm, `COMPACT-LIST-SEARCH'`, which executes > two separate loops. This algorithm takes an additional parameter $t$ which > determines an upper bound on the number of iterations of the first loop. > > COMPACT-LIST-SEARCH(L, n, k) > i = L > for q = 1 to t > j = RANDOM(1, n) > if key[i] < key[j] and key[j] ≤ k > i = j > if key[i] == k > return i > while i ≠ ␀ and key[i] < k > i = next[i] > if i == ␀ or key[i] > k > return ␀ > else > return i > > To compare the execution of the algorithms `COMPACT-LIST-SEARCH(L, n, k)` > and `COMPACT-LIST-SEARCH(L, n, k, t)`, assume that the sequence of integers > returned by the calls of `RANDOM(1, n)` is the same for both algorithms. > >
      >
    1. Suppose that COMPACT-LIST-SEARCH(L, n, k) takes $t$ > iterations of the while loop of lines 2-8. Argue that > COMPACT-LIST-SEARCH'(L, n, k, t) returns the same answer and > that total number of iterations of both the for and > while loops within COMPACT-LIST-SEARCH' is > at least $t$. >
    > > In the call `COMPACT-LIST-SEARCH'(L, n, k, t)`, let $X_t$ be the random > variable that describes the distance in the linked list (that is, through > the chain of _next_ pointers) from position $i$ in the desired key $k$ after > $t$ iterations of the **for** loop of lines 2-7 have occurred. > >
      >
    1. Argue that the expected running time of COMPACT-LIST-SEARCH'(L, > n, k, t) is $\O(t + \E[X_t])$. >
    2. Show that $\E[X_t] \le \sum_{r=1}^n(1 - r/n)^t$. (Hint: Use > equation (C.25).) >
    3. Show that $\sum_{r=0}^{n-1} r^t \le n^{t+1}/(t + 1)$. >
    4. Prove that $\E[X_t] \le n/(t+1)$. >
    5. Show that COMPACT-LIST-SEARCH'(L, n, k, t) runs in $\O(t > + n/t)$ expected time. >
    6. Conclude that COMPACT-LIST-SEARCH runs in $\O(\sqrt{n})$ > expected time. >
    7. Why do we assume that all keys are distinct in > COMPACT-LIST-SEARCH? Argue that random skips do not > necessarily help asymptotically when the list contains repeated key > values. >
    This is a very interesting problem. First, let's note that `COMPACT-LIST-SEARCH` a number of iterations, less or equal to those of `COMPACT-LIST-SEARCH'`. If the first version found the element on a random skip-ahead in $t$ iterations, so will the second version. If not, the last $k$ iterations only advanced the pointer until the result was found. Furthermore, none of the last $t - k$ iterations made a skip-ahead (by the definition of $k$. Since the second version does not advance inbetween skip-aheads, it has to perform $k$ additional iterations of its **while** loop until the result is found. Note also, that the first version minimizes the number of iterations. That is, $t$ is picked in an optimal way. Let's move on to the math. The expected running time of `COMPACT-LIST-SEARCH'` is indeed $\O(t + \E[X_t])$, since it either finds the element in $t$ skip-aheads, or it has to move forward a number of times, equal to the distance to $X_t$. Note that if the key is not present, this distance will either be the successor of that key or the last element of the array, so the analysis still holds. Let's find the value of the expectation. The probability of having a distance at least $r$ is the probability less than $r$. The probability of having distance less than $k$ when $t = 1$ is $(n-r)/n$, thus: $$ \Pr\\{X_t \ge r\\} = \bigg(\frac{n - r}{n}\bigg)^t = \bigg(1 - \frac{r}{n}\bigg)^t$$ That is, one of the `RANDOM` calls should advance to the desired distance, while the rest should advance to elements before it. Using the (C.25), we get: $$ \E[X_t] = \sum_{r=1}^{\infty} \Pr\\{X_t \ge r\\} = \sum_{r=1}^n \Pr\\{X_t \ge r\\} = \sum_{r=1}^n \bigg(1 - \frac{r}{n}\bigg)^t $$ The probability of getting distance, larger than $n$ is 0, so that's why we can bound the sum index to $n$. We can show (d) by approximating the sum with an integral with (A.11): $$ \sum_{r=0}^{n-1} r^t \le \int_0^n x^t dx = \frac{n^{t+1}}{t+1} $$ This lets us give an upper bound on the expectation: $$ \begin{aligned} \E[X_t] &= \sum_{r=1}^n \bigg(1 - \frac{r}{n}\bigg)^t \\\\ &= \sum_{r=0}^{n-1} \bigg(\frac{r}{n}\bigg)^t \\\\ &= \frac{1}{n^t} \sum_{r=0}^{n-1} r^t \\\\ &\le \frac{1}{n^t} \cdot \frac{n^{t+1}}{t + 1} \\\\ &= \frac{n}{t+1} \end{aligned} $$ The expected running time of `COMPACT-LIST-SEARCH'(L, n, k, t)` is thus: $$ \O(t + \E[X_t]) = \O(t + n/(t+1)) = \O(t + n/t) $$ Since `COMPACT-LIST-SEARCH` minimizes this running time, we need to find the minimum of $t + n/t$. The first derivative is $1 - n/t^2$ which is zero at $\sqrt{n}$ and this is a local minimum. It's also the minimum in the interval $[1,n]$. This makes the expected running time of the first version of the algorithm $\O(\sqrt{n})$. As for duplicates, we won't be able to conclude (c) if there are duplicates. The algorithm is able to skip ahead only if the value found by `RANDOM` is greater than the current. For example, if we have a list of `0`s and we're looking for a `1`, the algorithm will still need to iterate to the end of the list, since it will not skip-ahead at all. ================================================ FILE: other/clrs/11/01/01.markdown ================================================ > Suppose that a dynamic set $S$ is represented by a direct-address table $T$ > of length $m$. Describe a procedure that finds a maximum element of $S$. > What is the worst-case performance of your procedure? We start with the bottom of the table (the largest element) and scan the table backwards until we find a slot that contains an element. The worst case performance is $\Theta(m)$, if the maximum element is in the first position of the table (or the dynamic set is empty). ================================================ FILE: other/clrs/11/01/02.markdown ================================================ > A **bit vector** is simply an array of bits (0s and 1s). A bit vector of > length $m$ takes much less space than an array of $m$ pointers. Describe how > to use a bit vector to represent a dynamic set of distinct elements with no > satellite data. Dictionary operations should run in $\O(1)$ time. The elements have to be numbers. Each bit in the bit vector represents whether an element is present (1) or not present (0) in the dynamic set. This is sufficient when we're not storing satellite data. We need to use some binary operations (`&`, `|`) in order to modify the bit vector or query it. The operations are pretty straightforward. The only tricky part is the bit vector size. If a dynamic set is to store the element `1000`, then the vector needs to be at least `1000` bits. ================================================ FILE: other/clrs/11/01/03.markdown ================================================ > Suggest how to implement a direct-address table in which the keys of stored > elements do not need to be distinct and the elements can have satellite > data. All three dictionary operations (`INSERT`, `DELETE`, and `SEARCH`) > should run in $\O(1)$ time. (Don't forget that `DELETE` takes as an argument > a pointer to an object to be deleted, not a key). Assuming that fetching an element should return the satellite data of all the stored elements, we can have each key map to a doubly linked list. * `INSERT` appends the element to the list in constant time * `DELETE` removes the element from the linked list in constant time (the element contains pointers to the previous and next element) * `SEARCH` returns the first element, which is a node in a linked list, in constant time ================================================ FILE: other/clrs/11/01/04.markdown ================================================ > $\star$ We wish to implement a dictionary by using direct addressing on a > _huge_ array. At the start, the array entries may contain garbage, and > initializing the entire array is impractical because of its size. Describe a > scheme for implementing a direct-address dictionary on a huge array. Each > stored object should use $\O(1)$ space; the operations `SEARCH`, `INSERT`, > and `DELETE` should take $\O(1)$ time. (Hint: Use an additional > array, treated somewhat like a stack whose size is the number of keys > actually stored in the dictionary, to help determine whether a given entry > in the huge array is valid or not.) I don't really understand why this is an exercise - it's far to tricky for the common good. Anyhow. As the hint suggests, we use an addition stack. Each stack item will contain a pointer in the huge array. Each cell in the huge array will contain the index of the stack item. When we `INSERT` a new item, we push the pointer address in the huge array on the stack and set the value of that cell to the stack index. When we `SEARCH`, we get the value in the array. If it is a valid stack index (that is, if the value is $n$, the stack has at most $n$ items) and the value at that position of the stack is the original pointer, then we have a match. Otherwise, we don't. When we `DELETE` there would be a hole in the stack. We can fix it by moving the top item to the hole and updating the value in the huge array. If we need satellite data, we can keep it in a parallel stack that we also modify on those operations. There is an elaboration on this algorithm in the Instructor's Manual. ================================================ FILE: other/clrs/11/02/01.markdown ================================================ > Suppose we use a hash function $h$ to hash $n$ distinct keys into an array $T$ > of length $m$. Assuming simple uniform hashing, what is the expected number of > collisions? More precisely, what is the expected cardinality of $ \\{ \\{ k, l > \\} : k \neq l \text{ and } h(k) = h(l) \\} $? Let's use an indicator random variable $I_{kl} = 1$ when there is a collision of keys $k$ and $l$. We know that $$ \Pr \\{ I_{kl} = 1 \\} = \frac{1}{m} = \E[I_{kl}] $$ So the expectation of the total number of collisions is: $$ \E \Big[ \sum_{ k \neq l } { I_{kl} } \Big] = \sum_{ k \neq l }{ \E[I_{kl}] } = \sum_{ k \neq l }{ I_{kl} } = \sum_{ k \neq l }{ \frac{1}{m} } = \binom{n}{2} \frac{1}{m} = \frac{ n (n - 1) }{ 2m } $$ ================================================ FILE: other/clrs/11/02/02.markdown ================================================ > Demonstrate what happens when we insert the keys 5, 28, 19, 15, 20, 33, 12, > 17, 10 into a hash table with collisions resolved by chaining. Let the table > have 9 slots, and let the hash function be $h(k) = k \bmod 9$. First, let's calculate the hashes: h(5) = 5 h(28) = 1 h(19) = 1 h(15) = 6 h(20) = 2 h(33) = 6 h(12) = 3 h(17) = 8 h(10) = 1 Next, let's ASCII-ART this bad boy: +-----+ 0 | | +-----+ 1 | o--|---> [ 10 ] ---> [ 19 ] ---> [ 28 ] +-----+ 2 | o--|---> [ 20 ] +-----+ 3 | o--|---> [ 12 ] +-----+ 4 | | +-----+ 5 | o--|---> [ 5 ] +-----+ 6 | o--|---> [ 33 ] ---> [ 15 ] +-----+ 7 | | +-----+ 8 | o--|---> [ 17 ] +-----+ Where each cell of the array is a null pointer (empty bucket) or the pointer to a head of a linked list. ================================================ FILE: other/clrs/11/02/03.markdown ================================================ > Professor Marley hypothesizes that he can obtain substantial performance gains > by modifying the chaining scheme to keep each list in sorted order. How does > the professor's modification affect the running time for successful searches, > unsuccessful searches, insertions, and deletions? I'm not sure the professor is right. If we assume with delete with a key (instead of a pointer to an element), we have the following times (with regards to the number of collisions) without sorting: | operation | complexity | |-----------|----------------| | `SEARCH` | linear (both) | | `INSERT` | constant | | `DELETE` | linear | The only thing that changes when we sort the list, is that instead of prepending the item to the list, we have to find its right place, making `INSERT` linear: | operation | complexity | |-----------|----------------| | `SEARCH` | linear (both) | | `INSERT` | **linear** | | `DELETE` | linear | I'm not sure what the professor had in mind, but I believe he was mistaken. ================================================ FILE: other/clrs/11/02/04.c ================================================ #include #include #include #define SIZE 10 #define HASH(v) (v % 10) // --- Types and internals -------------------------------------------------- typedef int value_t; struct element_t; typedef struct element_t { char free; union { struct { struct element_t *prev; struct element_t *next; } empty; struct { value_t value; struct element_t *next; } used; }; } element_t; typedef struct { element_t buckets[SIZE]; element_t free_list; } hash_t; // --- Helpers -------------------------------------------------------------- int hash_value(value_t value) { return HASH(value); } void remove_from_free_list(hash_t *hash, element_t *element) { element->empty.prev->empty.next = element->empty.next; element->empty.next->empty.prev = element->empty.prev; element->free = 0; } void return_to_free_list(hash_t *hash, element_t *element) { element_t *sentinel = &(hash->free_list); element->free = 1; element->empty.next = sentinel->empty.next; element->empty.prev = sentinel; sentinel->empty.next = element; } element_t *allocate(hash_t *hash) { element_t *element = hash->free_list.used.next; assert(element != &(hash->free_list)); remove_from_free_list(hash, element); return element; } void reallocate(hash_t *hash, element_t *element) { int index = hash_value(element->used.value); element_t *location = &(hash->buckets[index]); assert(!location->free); element_t *new = allocate(hash); new->used.value = element->used.value; new->used.next = element->used.next; while (location->used.next != element) { location = location->used.next; assert(location); assert(!location->free); } location->used.next = new; } // --- Public interface ----------------------------------------------------- hash_t *make_hash() { hash_t *hash = malloc(sizeof(hash_t)); hash->free_list.empty.next = hash->buckets; hash->free_list.empty.prev = hash->buckets + SIZE; element_t *current = &(hash->free_list); current->free = 1; for (int i = 0; i < SIZE; i++) { element_t *next = &(hash->buckets[i]); next->free = 1; next->empty.prev = current; current->empty.next = next; current = next; } current->empty.next = &(hash->free_list); hash->free_list.empty.prev = current; return hash; } element_t *search(hash_t *hash, value_t value) { int index = hash_value(value); element_t *element = &(hash->buckets[index]); while (element && !element->free) { if (element->used.value == value) { return element; } element = element->used.next; } return NULL; } void insert(hash_t *hash, value_t value) { int index = hash_value(value); element_t *element = &(hash->buckets[index]); if (element->free) { remove_from_free_list(hash, element); element->used.value = value; element->used.next = NULL; } else if (hash_value(element->used.value) == index) { element_t *new = allocate(hash); new->used.value = value; new->used.next = element->used.next; element->used.next = new; } else { reallocate(hash, element); element->used.value = value; element->used.next = NULL; } } void delete(hash_t *hash, value_t value) { int index = hash_value(value); element_t *head = &(hash->buckets[index]); if (head->free || hash_value(head->used.value) != index) { return; } while (head->used.value == value) { element_t *next = head->used.next; if (next) { assert(!next->free); assert(hash_value(next->used.value) == index); head->used.value = next->used.value; head->used.next = next->used.next; return_to_free_list(hash, next); } else { return_to_free_list(hash, head); return; } } element_t *element = head; while (element->used.next) { element_t *next = element->used.next; assert(!next->free); assert(hash_value(next->used.value) == index); if (next->used.value == value) { element->used.next = next->used.next; return_to_free_list(hash, next); } else { element = next; } } } // --- Debug ---------------------------------------------------------------- void print_hash(hash_t *hash) { int free_slots = 0; element_t *item = hash->free_list.empty.next; while (item != &(hash->free_list)) { item = item->empty.next; free_slots++; } printf("\nfree slots in linked list: %d\n", free_slots); free_slots = 0; for (int i = 0; i < SIZE; i++) { if (hash->buckets[i].free) free_slots++; } printf("free slots in hash array: %d\n\n", free_slots); for (int i = 0; i < SIZE; i++) { element_t *element = &(hash->buckets[i]); printf(" +------+\n"); printf(" %-2d | ", i); if (element->free) { printf(" |"); } else { int foreign = hash_value(element->used.value) != i; printf("%1s %2d |", (foreign ? "/" : " "), element->used.value); if (!foreign) { while (element->used.next) { printf(" -> "); element = element->used.next; if (element->free) { printf("!!FREE\n"); break; } printf("%2d", element->used.value); } } } printf("\n"); } printf(" +------+\n"); printf("\n\n"); } ================================================ FILE: other/clrs/11/02/04.markdown ================================================ > Suggest how to allocate and deallocate storage for elements within the hash > table itself by linking all unused slots into a free list. Assume that one > slot can store a flag and either one element plus a pointer or two pointers. > All dictionary and free-list operations should run in $\O(1)$ expected time. > Does the free list need to be doubly linked or does a singly linked free list > suffice? Oh, wow. That was a doozy. First of all, in my 15+ years of professional programming and 20+ years of just coding, this is absolutely the first time I implement a hash table. Can you believe it? It's worth a celebration. Second, this is a bit exotic. It involves a few things: * Doubly linked lists with sentinels * Maintaining a free list * Hash tables ## Explanation The key phrase in the problem definition is "expected time". There's no way to solve this in constant time if every key hashes to the same bucket. ### How? Well, each element of the table is either: * `{free : boolean = false, value : element, next : pointer}`, when the slot is taken. `element` holds the value of the stored item, and `next` points to the next node in the chain. * `{free : boolean = true, prev : pointer, next : pointer}`, when the slot is empty. `prev` and `next` form a doubly linked list with a sentinel stored in the hash table. When we initialize the hash table, we need to iterate it and make sure that each slot is linked together in a free list. To allocate a slot, we remove it from the free list by modifying `prev` and `next` to point to each other, and setting `free` to false. To return a slot to the free list, we set `free` to true and insert it in the beginning. ### Searching Nothing really changes, apart from a small optimization - if the head of a chain in a bucket hashes to a value, different than the bucket index, we can treat this slot as empty (it's hosting an element for another chain). We don't need to walk it. ### Inserting There are three possibilities: 1. The bucket slot is empty. We allocate the slot (setting `free = true` and removing it from the free list), and put the element in there with an empty `next`. 2. The bucket slot contains an element with the same hash value. We allocate a new slot, and insert it after the head of the chain (avoids moving items). 3. The bucket slot contains an element with a different hash value. This means the slot is hosting an element from another chain. We need to relocate it to another empty slot and update the chain by starting from the head (which we can find with the hash value) and finding the pointer we need to update. Once the element has been reallocated, we can insert like in step 2. ### Deleting We hash the value to `h` and lookup the `h`-th slot. While the slot's value matches the value we need to delete, we copy the next element in the chain over, and free its slot. We repeat that until the chain is empty, or until it starts with an element with the same hash, but different value. We proceed with the rest of the chain to remove the other elements that match the value, returning slots to the free list. ### Does the free list need to be doubly linked? Yes. Otherwise, reserving a free slot will be linear to the size of the free list (e.g. the size of the hash), because we're not interested in _any_ free slot, but rather _a specific_ free slot. ## Code If the above didn't make sense, hopefully the code below might: ================================================ FILE: other/clrs/11/02/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" TEST(insertion) { hash_t *hash = make_hash(); insert(hash, 1); ASSERT_NOT_NULL(search(hash, 1)); ASSERT_NULL(search(hash, 2)); } TEST(deletion) { hash_t *hash = make_hash(); insert(hash, 1); delete(hash, 1); ASSERT_NULL(search(hash, 1)); } TEST(deleting_second_in_chain) { hash_t *hash = make_hash(); insert(hash, 1); insert(hash, 11); delete(hash, 11); ASSERT_NULL(search(hash, 11)); ASSERT_NOT_NULL(search(hash, 1)); } TEST(deleting_first_in_chain) { hash_t *hash = make_hash(); insert(hash, 1); insert(hash, 11); delete(hash, 1); ASSERT_NULL(search(hash, 1)); ASSERT_NOT_NULL(search(hash, 11)); } TEST(deleting_duplicates) { } TEST(inserting_duplicates) { hash_t *hash = make_hash(); insert(hash, 1); insert(hash, 1); ASSERT_NOT_NULL(search(hash, 1)); delete(hash, 1); ASSERT_NULL(search(hash, 1)); } TEST(inserting_colisions) { hash_t *hash = make_hash(); insert(hash, 1); insert(hash, 11); ASSERT_NOT_NULL(search(hash, 1)); ASSERT_NOT_NULL(search(hash, 11)); } TEST(inserting_in_foreign_slots) { hash_t *hash = make_hash(); insert(hash, 1); insert(hash, 11); insert(hash, 10); ASSERT_NOT_NULL(search(hash, 1)); ASSERT_NOT_NULL(search(hash, 11)); ASSERT_NOT_NULL(search(hash, 10)); } TEST(complicated_example) { hash_t *hash; hash = make_hash(); insert(hash, 1); insert(hash, 11); insert(hash, 21); insert(hash, 31); insert(hash, 3); insert(hash, 13); insert(hash, 23); insert(hash, 5); insert(hash, 15); ASSERT_NOT_NULL(search(hash, 1)); ASSERT_NOT_NULL(search(hash, 11)); ASSERT_NOT_NULL(search(hash, 21)); ASSERT_NOT_NULL(search(hash, 31)); ASSERT_NOT_NULL(search(hash, 3)); ASSERT_NOT_NULL(search(hash, 13)); ASSERT_NOT_NULL(search(hash, 23)); ASSERT_NOT_NULL(search(hash, 5)); ASSERT_NOT_NULL(search(hash, 15)); } ================================================ FILE: other/clrs/11/02/05.markdown ================================================ > Suppose that we are storing a set of $n$ keys into a hash table of size $m$. > Show that if the keys are drawn from a universe $U$ with $\| U \| > nm$ then > $U$ has a subset of size $n$ consisting of keys that all hash to the same > slot, so that the worst-case searching time for hashing with chaining is > $\Theta(n)$. Obvious statement is obvious. Oh well. We are hashing elements into $m$ distinct buckets. Let $h$ be the hash function, that is for $u \in U$ we have $0 \le h(u) < m$. Furthermore, let $C(k)$ be the number of elements in $U$ that hash to $k$. We need to demonstrate that there is some $j: 0 \le j < m$ for which there are are at least $n$ elements $x_i \in U$ (where for $i \in \\{1, 2, \dots, n\\} )$ such that $h(x_i) = j$, that is, there exists a $k$ such that $C(k) \ge n$. Let's assume this is incorrect, that is, every $j$ has at most $n - 1$ elements hashing into it, or in other words $C(x) \le n - 1$ for every $x$. We know that every element of $U$ needs to hash to one of $m$ values, that is: $$ \sum_{i = 0}^{i Suppose we have stored $n$ keys in a hash table of size $m$, with collisions > resolved by chaining, and that we know the length of each chain, including the > length $L$ of the longest chain. Describe a procedure that selects a key > uniformly at random from among the keys in the hash table and returns it in > expected time $\O(L \cdot (1 + 1 / \alpha))$. Think about the hash table as a matrix with $m$ rows and $L$ columns. The first element of chain with hash $k$ is put in the first column of the $k$-th row, the second is put in the second column of the $k$-th row and so on. Essentially, each row contains a chain followed by some empty elements. The procedure is: 1. Keep picking a random cell in that table (that is, pick a number `s = rand(m * L)`, row `s / L` and column `s % L`) until we get a non-empty one. 2. Walk the linked list for the chosen row until we get to the chosen column. Note that when step 1 picks a non-empty element, it does so uniformly. That is, each element has equal chance of getting picked. We need to calculate the time for the first step (say $A$) and add it to the time of the second step (say $B$). The probability to pick an element in step 1 is: $$ \Pr \\{ \text{not empty} \\} = \frac{n}{mL} = \frac{\alpha}{L} $$ The expected number of trials to pick a non-empty element is modelled by the geometric distribution (Bernoulli trials, (C.32)), and has $\E[X] = 1 / p$. That is, on average we expect the following number of trials: $$ A = \frac{L}{\alpha} = \O( L / \alpha ) $$ Once we have picked up the `i`th row and the `j`th column, we need to walk the linked list on row `i` and advance `j` elements. Worst case, that takes $L$ steps, because the longest chain has that many elements. That is: $$ B = \O(L) $$ And thence, the expected time is: $$ A + B = \O(L / \alpha) + \O(L) = \O( L \cdot ( 1 + 1 / \alpha ) ) $$ ================================================ FILE: other/clrs/11/03/01.markdown ================================================ > Suppose we wish to search a linked list of length $n$, where each element > contains a key $k$ along with a hash value $h(k)$. Each key is a long > character string. How might we take advantage of the hash values when > searching the list for an element with a given key? We can compute the hash of the key we search for, and then compare with a string in the list only if the hash value matches. We know that the same key hashes to the same hash value, so if the hash values are different, we can infer the strings are different. It will have an effect when the strings in the list have particularly bad comparison performance against the string we search for. For example, the comparison algorithm checks the first characters, and if they differ, the second characters, etc, and the strings have a very long common prefix. ================================================ FILE: other/clrs/11/03/02.markdown ================================================ > Suppose that we hash a string of $r$ characters into $m$ slots by treating it > as a radix-128 number and then using the division method. We can easily > represent the number $m$ as a 32-bit computer word, but the string of $r$ > characters, treated as a radix-128 number, takes many words. How can we apply > the division method to compute the hash value of the string without using more > than a constant number of words of storage outside the string itself? Yes, this follows pretty easily from the laws of modulo arithmetic. We need to observe that if the string is $s = \langle a_n, \ldots, a\_1, a\_0 \rangle$, then its hash $h(s)$ is going to be: $$ \begin{aligned} h(s) &= \left( \sum_{i=0}^{n}{a_i \cdot {128}^{i}} \right) \bmod m \\\\ &= \sum_{i=0}^{n}{ \Big( \left( a_i \cdot {128}^{i} \right) \bmod m \Big) } \\\\ &= \sum_{i=0}^{n}{ \Big( ( a_i \bmod m ) ( {128}^{i} \bmod m ) \Big) } \\\\ \end{aligned} $$ We can easily compute $a_i \bmod m$ without extra memory. To compute ${128}^{i} \bmod m$ without extra memory, we just need to observe that $k^i \bmod m = k(k^{i-1} \bmod m) \bmod m$, that is, we can compute the module for each power incrementally, without ever needing unbound memory. ================================================ FILE: other/clrs/11/03/02.py ================================================ K = 128 def consthash(digits, m): result = 0 power = 1 for d in reversed(digits): result += ((d % m) * power) % m result %= m power = (power * K) % m return result ================================================ FILE: other/clrs/11/03/02.test.py ================================================ import unittest import os.path as path from functools import reduce filename = path.join(path.dirname(__file__), '02.py') exec(open(filename).read()) def digits_to_number(digits): return reduce(lambda a, b: a + b, (d * (K ** i) for (i, d) in enumerate(reversed(digits)))) class HashingTest(unittest.TestCase): def test_select(self): m = 25 instances = [ [127], [123, 42], [1, 1], [12, 31, 85, 12] ] for instance in instances: self.assertEqual(consthash(instance, m), digits_to_number(instance) % m) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/11/03/03.markdown ================================================ > Consider a version of the division method in which $h(k) = k \bmod m$, where > $m = 2^p - 1$ and $k$ is a character string interpreted in radix $2^p$. Show > that if we can derive string $x$ from string $y$ by permuting its characters, > then $x$ and $y$ hash to the same value. Give an example of an application in > which this property would be undesirable in a hash function. We need to observe that the hash of the string is the sum of the hashes of each character, and it does not depend on the order they are in. If $x = \langle x_n, \ldots, x_1, x_0 \rangle$. $$ \begin{aligned} h(x) &= \left( \sum_{i=0}^{n}{x_i}{2^{ip}} \right) \bmod m \\\\ &= \sum_{i=0}^{n}{ (x_i \bmod m) \left( 2^{ip} \bmod {(2^p - 1)} \right) } \\\\ &= \sum_{i=0}^{n}{ (x_i \bmod m) \left( \prod_{1}^{i}{\left( 2^p \bmod {(2^p - 1)} \right)} \right) } \\\\ &= \sum_{i=0}^{n}{ (x_i \bmod m) \left( \prod_{1}^{i}{1} \right) } \\\\ &= \sum_{i=0}^{n}{ (x_i \bmod m) } \end{aligned} $$ We can put the elements of $x$ in any other order, and the result will still be the same. ================================================ FILE: other/clrs/11/03/04.markdown ================================================ > Consider a hash table of size $m = 1000$ and a corresponding hash function > $h(k) = \lfloor m (kA \bmod 1) \rfloor$ for $A = (\sqrt{5} - 1)/2$. Compute > the locations to which the keys 61, 62, 63, 64, and 65 are mapped. It would have been nice if we could $m$ was a power of 2, in which case we could have bit-shifted. Otherwise, he's the answer, along with some Python code to generate it ================================================ FILE: other/clrs/11/03/04.py ================================================ from math import floor m = 1000 s = 2654435769 A = s / (2 ** 32) def h(k): ka = k * A frac = ka - floor(ka) return int(m * frac) ================================================ FILE: other/clrs/11/03/04.run.py ================================================ import os.path as path filename = path.join(path.dirname(__file__), '04.py') exec(open(filename).read()) keys = [61, 62, 63, 64, 65] for key in keys: print("h({}) = {}".format(key, h(key))) ================================================ FILE: other/clrs/11/03/05.markdown ================================================ > $\star$ Define a family $\mathscr{H}$ of hash functions from a finite set $U$ > to a finite set $B$ to be **$\epsilon$-universal** if for all pairs of > distinct elements $k$ and $l$ in $U$, > > $$ \Pr\\{ h(k) = h(l) \\} \le \epsilon $$ > > where the probability is over the choice of the hash function $h$ drawn at > random from the family $\mathscr{H}$. Show that an $\epsilon$-universal family > of hash functions must have > > $$ \epsilon \ge \frac{1}{|B|} - \frac{1}{|U|} $$ I've found this a bit tricky, especially with (1) trying to wrap my brain around the notation, and (2) sticking to the formalism. Let's try to build some intuition here, and then use it to fill potential holes in a more formal proof. To save some typing, let $b = |B|$ and $u = |U|$. The assertion tells use that $Pr \\{ h(k) = h(l) \\} \ge \frac{1}{b} - \frac{1}{u} = (u - b) / bu$. If $b \ge u$, this means that we can design the function so that there are no collisions. If $b$ is lower, there are bound to be some collisions, however. For example, if $b = 5$ and $u = 8$, at most 4 elements can be stored without any collisions. The other 4 will collide to the same hash value. Alternatively, 6 elements can be mapped into three pairwise collisions, and the other two can be without any collisions. Let's sketch both, assuming without any loss of generality, that $B = \\{1, 2, 3, 4, 5\\}$ and $U = \\{ 1, 2, \ldots, 8 \\} $. $h_1$ will spread the collisions evenly, where $h_2$ will put them in a single bucket. | $v \in U$ | $h_1(v)$ | $h_2(v)$| |------------|----------|---------| | 1 | **1** | 1 | | 2 | **1** | 2 | | 3 | **2** | 3 | | 4 | **2** | 4 | | 5 | **3** | **5** | | 6 | **3** | **5** | | 7 | 4 | **5** | | 8 | 5 | **5** | Colliding elements are in **bold**. Which one is better? Note that it depends on whether we're talking about non-colliding elements, or no-colliding pairs. $h_2$ has fewer colliding elements (4), but more colliding pairs ($\\{5, 6\\}, \\{5, 7\\}, \\{5, 8\\}, \\{6, 7\\}, \\{6, 8\\}, \\{7, 8\\}$). On the other hand, $h_1$ has 6 colliding elements, but only 4 colliding pairs. Note that if $k$ elements are mapped to the same value in $B$, there are $\binom{k}{2}$ pairs that collide. Let's consider how to minimize the number of colliding pairs. Again, let's assume that $U = \\{1, 2, \ldots, |U| \\}$ and $B = \\{1, 2, \ldots, |B| \\}$. This is OK, because however we pick the original $U$ and $B$, there is a trivial bijection to the first few natural numbers. Let $c_i$ be the number of pairs for elements that map to $i \in B$. The total number of collisions, $C$, is then: $$ C = \sum_{i=1}^{b}{\binom{c_i}{2}} = \frac{1}{2} \sum_{i=1}^{k}{c_i (c_i - 1)} $$ Let's do a bit of hand-waving. What's better in order to minimize $C$ - (1) to distribute the collisions evenly across the buckets, or (2) to let $b - 1$ elements be without collisions, and put the remaining $u - b + 1$ elements go in the same bucket? In the first approach ($C_1$), each bucket would have at most $\binom{\lceil u/b \rceil}{2}$ pairs that collide. In the other approach, we would have $C_2 = \binom{u - b + 1}{2}$ total collisions for a single bucket. For $h_1(x)$, we have: $$ C_1 = \sum_{i=1}^{b} \binom{\lceil u/b \rceil}{2} = b \frac{ \lceil u/b \rceil ( \lceil u/b - 1 \rceil ) } { 2 } \le b \frac{ (u/b) (u/b - 1) } { 2 } = \frac { u (u - b) } { 2b } $$ For $h_2(x)$ we have: $$ C_2 = \binom{u - b + 1}{2} = \frac{ (u - b + 1)(u - b) }{2} = \frac{u^2 + u + b^2 - 2bu - b }{2} $$ It appears that $C_1$ is smaller and always minimizes the number of collisions. Plug in some concrete values to convince yourself (e.g. with $u = 1000$ and $b = 970$, $C_1$ is $15$, but $C_2$ is $456$; with a bigger in $u$ and $b$, we get a much bigger difference between the number of collisions). Let's try this another way – lower bound for number of colliding pairs: $$ C = \sum_{i=1}^{b}{c_i (c_i - 1) } = \sum_{i=1}^{b}{c_i^2} - \sum_{i=1}^{b}{c_i} = \sum_{i=1}^{b}{c_i^2} - |U| $$ The final bit, $|U| = \sum{c_i}$, is because each element from $U$ maps to a particular bucket $i$ and is counted once and only once. We also notice that (sort of): $$ c_i \ge \frac{u}{b} $$ And: $$ \sum_{i=1}^{b}{c_i} \ge \sum_{i=1}^{b}{\frac{u^2}{b^2}} = \frac{u^2}{b} $$ Thus, finally: $$ \epsilon \ge \Pr\\{h(k) = h(l)\\} = \frac{ \sum_{i=1}^{b}{ c_i (c_i - 1) } } { u(u - 1) } \ge \frac { \sum_{i=1}^{b}{c_i^2} - \sum_{i=1}^{b}{c_i} } {u^2} \ge \frac { \frac{u^2}{b} - u } {u^2} = \frac {u^2 - ub }{u^2b} = \frac{u - b}{ub} = \frac{1}{b} - \frac{1}{u} $$ ================================================ FILE: other/clrs/11/03/06.markdown ================================================ > $\star$ Let $U$ be the set of $n$-tuples of values drawn from $\mathbb{Z}\_p$, > and let $B = \mathbb{Z}\_p$, where $p$ is prime. Define the hash function $h_b > : U \rightarrow B$ for $b \in \mathbb{Z}_p$ on an input $n$-tuple $ \langle > a\_0, a\_1, \ldots , a\_{n-1} \rangle $ from $U$ as > > $$ > h_b( \langle a_0, a_1, \ldots, a_{n-1} \rangle ) = > \left( \sum_{j=0}^{n-1}{a_j b^j} \right) \bmod p > $$ > > and let $\mathscr{H} = \left\\{ h\_b : b \in \mathbb{Z}\_p \right\\}$. Argue > that $\mathscr{H}$ is $((n - 1)/p)$-universal according to the definition of > $\epsilon$-universal in Exercise 11.3-5. (_Hint:_ See Exercise 31.4-4). Let's figure out when when we have a colliding pair. We need to have: $$ h_b(k) = h_b(l) $$ Which is better written as: $$ h_b(k) - h_b(l) = 0 \mod p $$ Well, if we calculate the difference: $$ h_b(k) - h_b(l) = \sum_{j=0}^{n-1}{k_j b^j} - \sum_{j=0}^{n-1}{l_j b^j} = \sum_{j=0}^{n-1}{(k_j - l_j) b^j} $$ Which is a polynomial of the $(n-1)$-th degree. The referred exercise is a theorem, that tells us this polynomial would have a most $n-1$ zeroes modulo $p$. There are $p$ possible functions, at most $n-1$ of which will cause any pair to have a collision, therefore: $$ \Pr\\{ h(k) = h(l) \\} \le \frac{n-1}{p} $$ ================================================ FILE: other/clrs/11/04/01.markdown ================================================ > Consider inserting the keys 10, 22, 31, 4, 15, 28, 17, 88, 59 into a hash > table of length $m = 11$ using open addressing with the auxiliary hash > function $h'(k) = k$. Illustrate the result of inserting these keys using > linear probing, using quadratic probing with $c_1 = 1$ and $c_2 = 3$ and using > double hashing with $h_1(k) = k$ and $h_2(k) = 1 + (k \bmod (m-1))$. Here's a hand-rolled table: linear quadratic double +------+ +------+ +------+ 0 | 22 | | 22 | | 22 | +------+ +------+ +------+ 1 | 88 | | | | | +------+ +------+ +------+ 2 | | | 88 | | 59 | +------+ +------+ +------+ 3 | | | 17 | | 17 | +------+ +------+ +------+ 4 | 4 | | 4 | | 4 | +------+ +------+ +------+ 5 | 15 | | | | 15 | +------+ +------+ +------+ 6 | 28 | | 28 | | 28 | +------+ +------+ +------+ 7 | 17 | | 59 | | 88 | +------+ +------+ +------+ 8 | 59 | | 15 | | | +------+ +------+ +------+ 9 | 31 | | 31 | | 31 | +------+ +------+ +------+ 10 | 10 | | 10 | | 10 | +------+ +------+ +------+ Here's some python code as well: ================================================ FILE: other/clrs/11/04/01.py ================================================ def populate(m, keys, probe): table = [None] * m for key in keys: i = 0 for _ in range(m): pos = probe(key, i) i += 1 if table[pos] is None: table[pos] = key break else: raise RuntimeError(f"Could not put element {key} in {table!r}") return table def linear(m): return lambda key, i: (key + i) % m def quadratic(m, c1, c2): return lambda key, i: (key + i * c1 + i * c2 * c2) % m def double(m): return lambda key, i: (key + i * (1 + key % (m - 1))) % m ================================================ FILE: other/clrs/11/04/01.run.py ================================================ import os.path as path filename = path.join(path.dirname(__file__), '01.py') exec(open(filename).read()) keys = [10, 22, 31, 4, 15, 28, 17, 88, 59] m = 11 probes = [ ('linear', linear(m)), ('quadratic', quadratic(m, 1, 3)), ('double', double(m)), ] for (name, probe) in probes: table = " | ".join(("{:>2}".format(n) if n else " " for n in populate(m, keys, probe))) print("{:<10}: {}".format(name, table)) ================================================ FILE: other/clrs/11/04/02.markdown ================================================ > Write pseudocode for `HASH-DELETE` as outlined in the text and modify > `HASH-INSERT` to handle the special value `DELETED`. Deleting an element: HASH-DELETE(T, k) i = 0 repeat j = h(k, i) if T[j] == k T[j] == DELETED i = i + 1 until T[j] == NIL or i == m As for searching, interestingly enough we don't need to modify it, as long as `k` is never `DELETED` and `DELETED != NIL`. HASH-SEARCH(T, k) i = 0 repeat j = h(k, i) if T[j] == k return j i = i + 1 until T[j] == NIL or i == m return NIL ================================================ FILE: other/clrs/11/04/03.markdown ================================================ > Consider an open-address hash table with uniform hashing. Give upper bounds on > the expected number of probes in an unsuccessful search and on the expected > number of problems in a successful search when the load factor is $3/4$ and > when it is $7/8$. Those come directly from our formulas: | $\alpha$ | Unsuccessful | Successful | |----------|--------------|------------| | $3/4$ | $4$ | $1.84839$ | | $7/8$ | $8$ | $2.37650$ | What I find interesting, is that successful searches are dramatically less probes than unsuccessful searches. This implies that with uniform hashing the load factor can be pretty high if we're using the hash looking things up as opposed to checking if an element exists. ================================================ FILE: other/clrs/11/04/04.markdown ================================================ > $\star$ Suppose that we use double hashing to resolve collisions – that is, we > use the hash function $h(k, i) = (h_1(k) + i h_2(k)) \bmod m$. Show that if > $m$ and $h_2(k)$ greatest common divisor $d \ge 1$ for some key $k$, then an > unsuccessful search for key $k$ examines $(1/d)$th of the hash table before > returning to slot $h_1(k)$. Thus, when $d = 1$, so that $m$ and $h_2(k)$ are > relatively prime, the search may examine the entire hash table (_Hint:_ See > Chapter 31). This is a bit obvious. As the book made the argument either, the probe starts with $h_1(k)$ and then steps $h_2(k)$ places to check the next until it wraps around. If $\gcd(h_2(k), m) = d$, then probing would loop through $m/d$ elements before returning to starting position. For example, if $h_1(k) = 3$, $h_2(k) = 2$ and $m = 10$, we'll probe the following sequence: $3, 5, 7, 9, 1, 3, \ldots$, that is, we're looking only at the odd numbers. But, eh, let's try to make a formal argument. If $\gcd(h_2(k), m) = d$, let's define $s = m/d$ and $c = h_2(k)/d$, both of which are integers. The probe sequence $f_k(i)$ is defined to be: $$ f_k(i) = \left( h_1(k) + i h_2(k) \right) \mod m $$ Let's unpack the right part: $$ \begin{aligned} f_k(i) &= \left( h_1(k) + i h_2(k) \right) \bmod m \\\\ &= \big( h_1(k) \bmod m \big) + \big( icd \bmod m \big) \\\\ &= C + \big( icd \bmod m \big) \end{aligned} $$ ...where $=$ implies "modulo m". $C$ is constant in regards to $i$ and the only variable is $icd$. Note that function is $s$-periodic modulo $m$, because we have: $$ f_k(i + s) = C + (i + s)cd = C + icd + scd = C + icd = f_k(i) $$ Because $scd = mc = 0$ (modulo m). This means it can take $s$ distinct values, which means the probe sequence examines $s/m$th of the table before returning to the initial slot. $s/m = s/(sd) = 1/d$, which is what the exercise asks us to prove. ================================================ FILE: other/clrs/11/04/05.markdown ================================================ > Consider an open-address hash table with a load factor $\alpha$. Find the > nonzero value $\alpha$ for which the expected number of probes in an > unsuccessful search equals twice the expected number of problems in a > successful search. Use the upper bounds given by Theorems 11.6 and 11.8 for > these expected number of probes. Using the theorems, we get the following equation: $$ \frac{1}{1 - \alpha} = 2 \frac{1}{\alpha} \ln{\left(\frac{1}{1 - \alpha}\right)} $$ We can try to simplify it, but we get to a $x = 2 \ln x - 1$, or something similar, which I don't know how to solve in closed form. Luckily, that's why SciPY exists. ================================================ FILE: other/clrs/11/04/05.py ================================================ import numpy as np from scipy.optimize import root def fn(a): one = np.array([1.0]) two = np.array([2.0]) return (two / a) * np.log(one / (one - a)) - one/(one - a) print("alpha =", root(fn, 0.6).x[0]) ================================================ FILE: other/clrs/11/04/05.run.py ================================================ import os.path as path filename = path.join(path.dirname(__file__), '05.py') exec(open(filename).read()) ================================================ FILE: other/clrs/11/05/01.markdown ================================================ > $\star$ Suppose that we insert $n$ keys into a hash table of size $m$ using > open addressing and uniform hashing. Let $p(n,m)$ be the probability that no > collisions occur. Show that $p(n, m) \le e^{-n(n-1)/2m}$. (_Hint:_ see > equation (3.12).) Argue that when $n$ exceeds $\sqrt{m}$, the probability of > avoiding collisions goes rapidly to zero. Equation (3.12) states that: $$ e^x \ge 1 + x $$ Let's observe that: $$ p(n, m) = \frac{m}{m} \cdot \frac{m-1}{m} \cdots \frac{m-n+1}{m} = \frac{m!}{n!m^n} $$ And that $$ p(k + 1, m) = p(k, m) \cdot \frac{m - k}{m} = p(k, m) \cdot \left(1 - \frac{k}{m} \right) $$ Let's prove $p(n, m) \le e^{-n(n-1)/2m}$ by induction, fixing $m$ and treating $k = n$ as a variable. For $n = 1$: $$ p(1, m) = 1 \le e^{0} = 1 $$ If we assume the inequality holds for $k$, then for $k - 1$ we have: $$ \begin{aligned} p(k + 1, m) &= p(k, m) \cdot \left( 1 - \frac{k}{m} \right) \\\\ &\le e^{-k(k-1)/2m} \cdot \left( 1 - \frac{k}{m} \right) \\\\ &\le e^{-k(k-1)/2m} \cdot e^{-k/m} \\\\ &= e^{-k(k-1)/2m - k/m} \\\\ &= e^{-k(k-1)/2m - 2k/2m} \\\\ &= e^{-(k(k-1) + 2k)/2m} \\\\ &= e^{-k(k+1)/2m} \\\\ \end{aligned} $$ As for the "rapidly goes to zero" part, observe that if we rewrite the equation a bit, we get: $$ pr(n, m) = \frac{1}{e^{n(n-1)/2m}} $$ And that if $n \ge \sqrt{m}$ the power in the denominator becomes greater than 1, at which point it starts rapidly (exponentially) growing, and the fraction starts rapidly (exponentially) approaching zero. ================================================ FILE: other/clrs/11/problems/01.markdown ================================================ ## Longest-probe bound for hashing > Suppose that we use an open-addressed hash table of size $m$ to store $n \le > m/2$ items. > > a. Assuming uniform hashing, show that for $i = 1, 2, \ldots, n$, the > probability is at most $2^{-k}$ that the $i$th insertion requires strictly > more than $k$ probes. > > b. Show that for $i = 1, 2, \ldots, n$, the probability is $\O(1/n^2)$ that > the $i$th insertion requires more than $2\lg{n}$ probes. > > Let the random variable $X_i$ denote the number of probes required by the > $i$th insertion. You have shown in part (b) that $\Pr\\{X_i > 2\lg{n}\\} = > \O(1/n^2)$. Let the random variable $X = \max_{1 \le i \le n} X_i$ denote the > maximum number of probes required by any of the $n$ insertions. > > c. Show that $\Pr\\{X > 2 \lg{n}\\} = \O(1/n)$ > > d. Show that the expected length $\E[X]$ of the longest probe sequence is > $\O(\lg{n})$. Alright. ### a. Number of probes From the text we know that: $$ \Pr\\{ X \ge i \\} = \Pr\\{ X > i - 1 \\} = \frac{n}{m} \cdot \frac{n-1}{m-1} \cdots \frac{n-i+2}{m-i+2} \le \left( \frac{n}{m} \right)^{i-1} = \alpha^{i-1} $$ Since we know that $n \le m/2$, we know that: $$ \Pr\\{X > k\\} = \Pr\\{X \ge k+1 \\} \le \left( \frac{n}{m} \right)^k \le \left( \frac{m}{2m} \right)^k = \left( \frac{1}{2} \right)^k = 2^{-k} $$ ### b. Insertion requiring more than $2\lg{n}$ probes Well, just substitute in the previous with $k = 2\lg{n} = \lg{n^2}$: $$ \Pr\\{X > \lg{n^2}\\} \le 2^{-\lg{n^2}} = \frac{1}{n^2} = \O(1/n^2) $$ ### c. Probability for longest probe $$ \begin{aligned} \Pr\\{X > 2\lg{n}\\} &= \Pr\\{\bigcup_{i=1}^n \left( X_i > 2\lg{n} \right) \\} && \\\\ &\le \sum_{i=1}^{n} \Pr\\{X_i > 2\lg{n} \\} && \text{since } \Pr\\{A \cup B\\} \le \Pr\\{A\\} + \Pr\\{B\\} \\\\ &\le \sum_{i=1}^{n} \frac{1}{n^2} && \text{because of (b)} \\\\ &= \frac{n}{n^2} \\\\ &= \O(1/n) \end{aligned} $$ ### d. Expectation of the longest probe sequence Here's a weird way to do it that I lifted from the Instructor's Manual after I gave up. The point is to split the expectation into two parts: $$ \begin{aligned} \E[X] &= \sum_{k=1}^{n} k \Pr \\{ X = k \\} \\\\ &= \sum_{k=1}^{\lceil 2\lg{n} \rceil} k \Pr\\{X = k\\} + \sum_{\lceil 2\lg{n} \rceil + 1}^n k \Pr\\{X = k\\} \\\\ &\le \sum_{k=1}^{\lceil 2\lg{n} \rceil} \lceil 2\lg{n} \rceil \cdot \Pr\\{X = k\\} + \sum_{\lceil 2\lg{n} \rceil + 1}^n n \cdot \Pr\\{X = k\\} \\\\ &= \lceil 2\lg{n} \rceil \sum_{k=1}^{\lceil 2\lg{n} \rceil} \Pr\\{X = k\\} + n \sum_{\lceil 2\lg{n} \rceil + 1}^n \Pr\\{X = k\\} \\\\ \end{aligned} $$ We can then simplify the two parts of the sum. We know that $X$ takes only one value, so the sum of probabilities in the left part is at most $1$. We know from (c) that the sum in the right part is $\O(n)$. Thus: $$ \begin{aligned} \E[X] &\le \lceil 2 \lg{n} \rceil \cdot 1 + n \cdot \O(1/n) \\\\ &= \lceil 2 \lg{n} \rceil + \O(1) \\\\ &= \O(\lg{n}) \end{aligned} $$ ### Take-away This is basically saying that as long we keep half of the hash table empty, we can expect the longest probe to be no more than $\lg{n}$. ================================================ FILE: other/clrs/11/problems/02.markdown ================================================ ## Slot-size bound for chaining > Suppose that we have a hash table with $n$ slots with collisions resolved by > chaining, and suppose that $n$ keys are inserted into the table. Each key is > equally likely to be hashed in each slot. Let $M$ be the maximum number of > keys in any slot after all the keys have been inserted. Your mission is to > prove an $\O(\lg{n}/\lg\lg{n})$ upper bound on $\E[M]$, the expected value of > $M$. > > a. Argue that the probability $\mathcal{Q}\_k$ that exactly $k$ keys hash to a > particular slot is given by: > $$ \mathcal{Q}\_k = \left( \frac{1}{n} \right)^k \left( 1 - \frac{1}{n} \right)^{n-k} \binom{n}{k} $$ > > b. Let $P_k$ be the probability that $M = k$, that is, the probability that > the slot containing the most keys contains $k$ keys. Show that $P_k \le > n\mathcal{Q}_k$. > > c. Use Stirling's approximation, equation (3.18), to show that $\mathcal{Q}_k > < e^k / k^k$. > > d. Show that there exists a constant $c > 1$ such that $\mathcal{Q}_{k_0} < 1 > / n^3$ for $k_0 = c \lg{n} / \lg\lg{n}$. Conclude that $P_k < 1/n^2$ for $k > \ge k_0 = c \lg{n} / \lg\lg{n}$. > > e. Argue that > > $$ > \E[M] \le \Pr \left\\{ M > \frac{c\lg{n}}{\lg\lg{n}} \right\\} \cdot n + > \Pr \left\\{ M \le \frac{c\lg{n}}{\lg\lg{n}} \right\\} \cdot > \frac{c \lg{n}}{\lg\lg{n}} > $$ > > Conclude that $\E[M] = \O(\lg{n} / \lg\lg{n})$. ### a. Probability of exactly $k$ keys in a slot That's kinda obvious by the definition. $k$ keys need to be in that slot, each having probability $1/n$, $n-k$ keys need to be in a different slot with $(n-1)/n = 1 - 1/n$ probability, and there are $\binom{n}{k}$ ways to pick the $k$ keys out that collide out of the $n$ keys in total. ### b. Probability that the longest slot is $k$ We're looking for an upper bound on the probability that the longest chain is exactly $k$, that is $M = k$. This is less than the probability of $M \ge k$, which in turn is the probability that any of the chains has length $k$, which in turn is $\mathcal{Q}_k$. If $M_i$ is the number of keys contained in the $i$th element of the table, we have: $$ \Pr\\{M = k\\} \le \Pr\\{\bigcup_{i=1}^n \left( M_i = k \right)\\} \le \sum_{i=1}^n \Pr\\{M = k\\} = n \mathcal{Q}_k $$ ### c. Bounding $\mathcal{Q}_k$ From Stirling's approximation: $$ n! = \sqrt{2 \pi n} \left( \frac{n}{e} \right)^n \left( 1 + \Theta \left( \frac{1}{n} \right) \right) $$ We can get: $$ n! = \sqrt{2 \pi n} \left( \frac{n}{e} \right)^n \left( 1 + \Theta \left( \frac{1}{n} \right) \right) \ge \sqrt{2 \pi n} \left( \frac{n}{e} \right)^n > \frac{n^n}{e^n} $$ Or simply: $k! > k^k / e^k$. $$ \begin{aligned} \mathcal{Q}_k &= \left( \frac{1}{n} \right)^k \left( 1 - \frac{1}{n} \right)^{n-k} \binom{n}{k} \\\\ &= \frac{1}{n^k} \cdot \frac{(n-1)^{n-k}}{n^{n-k}} \frac{n!}{k!(n-k)!} \\\\ &= \left( 1 - \frac{1}{n} \right)^{n-k} \cdot \frac{n \cdot (n-1) \cdots (n-k+1)}{n^k} \cdot \frac{1}{k!} \\\\ &\le \frac{ \overbrace{n \cdot (n-1) \cdots (n-k+1) }^\text{k times}}{ n^k } \cdot \frac{1}{k!} && \text{(product of probability)} \\\\ &\le \frac{ \overbrace{n \cdot n \cdots n}^\text{k times} }{n^k} \cdot \frac{1}{k!} \\\\ &= \frac{n^k}{n^k} \cdot \frac{1}{k!} \\\\ &= \frac{1}{k!} \\\\ &< \frac{e^k}{k^k} \end{aligned} $$ ### d. More bounds I got stuck here, consulted the Instructor Manual, and discovered it also did a bunch of hand-waving. Go and consult it if you want, I'll try to summarize how I understood the approach here. We're looking for $\frac{e^{k_0}}{k^{k_0}} < \frac{1}{n^3}$, also known as $n^3 < \frac{k^{k_0}}{e^{k_0}}$. Taking $\lg$ of each side we get: $$ 3\lg{n} < k_0(\lg k_0 - \lg e) \\\\ \Updownarrow \\\\ 3 < \frac{ k_0(\lg k_0 - \lg e) }{ \lg n } $$ We now plug $k_0$ in to get Lovecraftian: $$ \begin{aligned} 3 &< \frac{ c \lg n }{ \lg n \lg \lg n } \left( \lg \frac{ c \lg n }{ \lg \lg n } - \lg e \right) \\\\ &= \frac{ c }{ \lg \lg n } \left( \lg c + \lg \lg n - \lg \lg \lg n - \lg e \right) \\\\ &= c \left( \frac{\lg c}{\lg \lg n} + \frac{\lg \lg n}{\lg \lg n} - \frac{\lg \lg \lg n}{\lg \lg n} - \frac{\lg e}{\lg \lg n} \right) \\\\ &= c \left(1 + \frac{ \lg c - \lg e }{ \lg \lg n } - \frac{ \lg \lg n }{ \lg \lg \lg n } \right) \end{aligned} $$ Now for the hand-waving. First, we notice that picking the necessary $c$ depends on the value of $n$. Next, let's call the expression in parentheses $A$ and notice that: $$ \lim_{n \to \infty} A = 1 $$ Hence, there is a $n_0$ for which if $n \ge n_0$ we have that $A \ge 1/2$ and therefore if we pick $c > 6$ we have $3 < cA$ when $n$ is larger than $n_0$. Next we need to figure it out for $n < n_0$. We notice that $n \ge 3$, because $\lg \lg 2 = \lg 1 = 0$ and that won't work, because we'll be dividing by $0$ in $c$. So for $3 \le n < n_0$ we choose $\max_{3 \le n < n_{0}}\\{ c : 3 < cx \\}$, that is, any $c$ that is large enough to satisfy all of the cases. We then pick $c$ to be the larger of that and $6$ and we're done. We're convinced a number like that exists, although we haven't spelled it out. Now we know that $\mathcal{Q}_k < 1 / n^3$. We can easily conclude, then, than: $$ P_k \le n \mathcal{Q}_k < n \frac{1}{n^3} = 1/n^2 $$ ### e. Expectation This is simpler: $$ \begin{aligned} \E[M] &= \sum_{k=0}^{n} k \cdot \Pr \\{ M = k \\} \\\\ &= \sum_{k=0}^{k_0} k \cdot \Pr \\{ M = k \\} + \sum_{k=k_0 + 1}^{n} k \cdot \Pr \\{ M = k \\} \\\\ &\le \sum_{k=0}^{k_0} k_0 \cdot \Pr \\{ M = k \\} + \sum_{k=k_0 + 1}^{n} n \cdot \Pr \\{ M = k \\} \\\\ &= k_0 \cdot \sum_{k=0}^{k_0} \Pr \\{ M = k \\} + n \cdot \sum_{k=k_0 + 1}^{n} \Pr \\{ M = k \\} \\\\ &= k_0 \cdot \Pr\\{ M \le k_0 \\} + n \cdot \Pr \\{ M > k_0 \\} \end{aligned} $$ Which is the long expression we needed to prove. Taking the last piece, we have: $$ \Pr \\{ M > k_0 \\} = \sum_{k=k_0+1}^{n} \Pr\\{ M = k \\} \le \sum_{k=k_0+1}^{n} \frac{1}{n^2} \le n \frac{1}{n^2} = \frac{1}{n} $$ We know that $\Pr\\{M \le k_0\\} \le 1$ (probability axiom), so: $$ \begin{aligned} \E[M] &= k_0 \cdot \Pr\\{ M \le k_0 \\} + n \cdot \Pr \\{ M > k_0 \\} \\\\ &\le k_0 + n \cdot \frac{1}{n} \\\\ &= \frac{c \lg n}{\lg \lg n} + 1 \\\\ &= \O(\lg n / \lg \lg n) \end{aligned} $$ How is one supposed to figure this out, I have no idea. Maybe by reading Knuth. ================================================ FILE: other/clrs/11/problems/03.markdown ================================================ ## Quadratic probing > Suppose that we are given a key $k$ to search for in a hash table with > positions $0, 1, \ldots, m - 1$, and suppose that we have a hash function $h$ > mapping the key space into the set $\\{0, 1, \ldots, m - 1\\}$. The search > scheme is as follows: > > 1. Compute the value of $j = h(k)$, and set $i = 0$. > 2. Probe in position $j$ for the desired key $k$. If you find it, or if this > position is empty, terminate the search. > 3. Set $i = i + 1$. If $i$ now equals $m$, the table is full, so terminate the > search. Otherwise, set $j = (i + j) \bmod m$, and return to step 2. > > Assume that $m$ is a power of $2$. > > a. Show that this scheme is an instance of the general "quadratic probing" > scheme by exhibiting the appropriate constants $c_1$ and $c_2$ for equation > (11.5). > > b. Prove that this algorithm examines every table position in the worst case. ### a. Is it quadratic? Observing what this process yields, and let's calculate a few values for $f(k, i)$ produced by this method. $$ \begin{aligned} & f(k, 0) = h(k) + 0 & = C + 0 \\\\ & f(k, 1) = f(0) + 1 = h(k) + 1 &= C + 1 \\\\ & f(k, 2) = f(1) + 2 = f(0) + 1 + 2 = h(k) + 3 &= C + 3 \\\\ & f(k, 3) = f(2) + 3 = f(1) + 2 + 3 = f(0) + 1 + 2 + 3 = h(k) + 6 &= C + 6 \\\\ \end{aligned} $$ Or generally: $$ f(k, i) = f(k, i - 1) + i $$ Which is a recurring relation that we can use induction to prove that $$ f(k, i) = h(k) + \sum_{j=0}^{j} j = h(k) + \frac{n(n+1)}{2} $$ (because the sum is just an arithmetic progression) This fits equation (11.5) with $c_1 = c_2 = 1/2$, because: $$ f(k, i) = h(k) + \frac{1}{2}i + \frac{1}{2}i^2 $$ ### b. Does it examine every position? Had to consult the Instructor Manual yet again. Let's assume it doesn't. This means that there are two separate values $a$ and $b$ such that $0 \le a < b < m$ for which $f(k, a) = f(k, b)$ modulo $m$, that is: $$ h(k) + \frac{a(a + 1)}{2} = h(k) \frac{b(b + 1)}{2} \mod m \\\\ \Downarrow \\\\ \frac{a(a + 1)}{2} = \frac{b(b + 1)}{2} \mod m \\\\ \Downarrow \\\\ \frac{a(a + 1)}{2} - \frac{b(b + 1)}{2} = 0 \mod m \\\\ \Downarrow \\\\ \frac{a^2 + a - b^2 - b}{2} = 0 \mod m \\\\ \Downarrow \\\\ \frac{a^2 + a + ab - b^2 - b -ab}{2} = 0 \mod m \\\\ \Downarrow \\\\ \frac{(a - b)(a + b + 1)}{2} = 0 \mod m $$ The final part means that there is an integer $r$ so that: $$ \frac{(a - b)(a + b + 1)}{2} = rm \\\\ \Downarrow \\\\ (a - b)(a + b + 1) = 2rm \\\\ \Downarrow \\\\ (a - b)(a + b + 1) = r \cdot 2^{p+1} $$ The last step is because we know that $m$ is a power of $2$, that is there is an integer $p$ such that $m = 2^p$. Now, since $a$ and $b$ are both integers, this means that $a - b$ and $a + b + 1$ are integers as well, and more importantly, one of them is even, and another one is odd. That is, at least one of them is not dividable by $2$. This means the other is dividable by $2^{p+1}$. But it can't be $(a - b)$ because $a - b < m < 2^{p+1}$. It can't be $(a + b + 1)$, because $a + b + 1 \le (m - 1) + (m - 2) + 1 = 2m - 2 < 2^{p+1}$. We've reacted a contradiction, which means that $f(k, a) \ne f(k, b)$, for $0 \le a < b < m$, which means that the algorithm will exhaust all slots before it reaches $m$. ================================================ FILE: other/clrs/11/problems/04.markdown ================================================ ## Hashing and authentication > Let $\mathscr{H}$ be a class of hash functions in which each hash function $h > \in \mathscr{H}$ maps the universe $U$ of keys to $\\{0, 1, \ldots, m - 1\\}$. > We say that $\mathscr{H}$ is **k-universal** if, for every fixed sequence of > $k$ distinct keys $\langle x^{(1)}, x^{(2)}, \ldots, x^{(k)} \rangle$ and for > any $h$ chosen at random from $\mathscr{H}$, the sequence $\langle h(x^{(1)}), > h(x^{(2)}), \ldots, h(x^{(k)}) \rangle$ is equally likely to be any of the > $m^k$ sequences of length $k$ with elements drawn from $\\{0, 1, \ldots, m - > 1\\}$. > > **a.** Show that if the family $\mathscr{H}$ of hash functions is 2-universal, > then it is universal. > > **b.** Suppose that the universe $U$ is the set of $n$-tuples of values drawn > from $\mathbb{Z}\_p = \\{0, 1, \ldots, p - 1\\}$, where $p$ is prime. Consider > an example $x = \langle x\_0, x\_1, \ldots, x_{n-1} \rangle \in U$. For > any $n$-tuple $a = \langle a_0, a_1, \ldots, a_{n-1} \rangle \in U$, define > the hash function $h_a$ by > > $$ h_a(x) = \left( \sum_{j=0}^{n-1} a_j x_j \right) \bmod p $$ > > Let $\mathscr{H} = \\{h_a\\}$. Show that $\mathscr{H}$ is universal, but not > 2-universal. (_Hint:_ Find a key for which all hash functions in $\mathscr{H}$ > produce the same value.) > > **c.** Suppose that we modify $\mathscr{H}$ slightly from part (b): for any $a > \in U$ and for any $b \in \mathbb{Z}_p$, define > > $$ h_{ab}'(x) = \left( \sum_{j=0}^{n-1} a_j x_j + b \right) \bmod p $$ > > and $\mathscr{H}' = \\{h_{ab}'\\}$. Argue that $\mathscr{H}'$ is 2-universal. > (_Hint:_ Consider fixed $n$-tuples $x \in U$ and $y \in U$, with $x_i \ne y_i$ > for some $i$. What happens to $h_{ab}'(x)$ and $h_{ab}'(y)$ and $a_i$ and $b$ > over range $\mathbb{Z}_p$?) > > **d.** Suppose that Alice and Bob secretly agree on a hash function $h$ from a > 2-universal family $\mathscr{H}$ of hash functions. Each $h \in \mathscr{H}$ > maps from a universe of keys $U$ to $\mathbb{Z}_p$, where $p$ is prime. Later, > Alice sends a message $m$ to BoB over the Internet, where $m \in U$. She > authenticates this message to Bob by also sending an authentication tag $t = > h(m)$, and Bob checks that the pair $(m, t)$ he receives indeed satisfies $t = > h(m)$. Suppose that an adversary intercepts $(m, t)$ en route and tries to > fool Bob by replacing the pair $(m, t)$ with a different pair $(m', t')$. > Argue that the probability that the adversary succeeds in fooling Bob into > accepting $(m', t')$ is at most $1/p$, no matter how much computing power the > adversary has, and even if the adversary knows the family $\mathscr{H}$ of > hash functions used. ### a. 2-universal implies universal This is pretty much by the definition. 2-universal means that the tuple/pair $\langle a, b \rangle$ is equally likely to be any of the $m^2$ possible pairs, $m$ of which contain the same element repeating, placing the chance of collision at $1/m$, which is the requirement for "universal". ### b. One possible family of hash functions In order to convince ourselves that it's universal, we need to establish an upper bound on the probability of $h_a(x) = h_a(y)$ when $x \ne y$. This holds when: $$ \sum_{j=0}^{n-1} (x_k - y_k)a_j = 0 \mod p $$ ...or fully we're looking for: $$ \Pr\\{ \sum_{j=0}^{n-1} (x_k - y_k)a_j \bmod p = 0 \\} \le \frac{1}{p} $$ Let's acknowledge that $(x_k - y_k)$ is fixed, and the only thing we're considering is the possible values for $a\_j$. Furthermore, let's also note that $a_j < p$. Now let's establish for which tuples the above condition holds. If we fix the first $n - 1$ elements of the tuple, we're left with a choice of the last one. Since $a_{n-1} < p$, there is only one possible value for the last element that will be produce a sum equal to 0 modulo $p$. All other will be $\ne p$. That is, $1$ in every $p$ functions will produce a collision, and the overall probability is $1/p$, which is the requirement for universality. It's not 2-universal, however, because all functions of the family produce $h_a(x) = 0$ when $x = \langle 0, 0, \ldots, 0 \rangle$. ### c. A better family of functions At this point it gets pretty intuitive that this is 2-universal, because it eliminates the problem with the zeroes. Following the hint, if we have two tuples that differ only for some it, that is $x_i \ne y_i$, we'll have $h_{ab}'(x) = h_{ab}'(y)$ only when: $$ a_i x_i + b = a_i y_i + b \mod p $$ Or rather: $$ a_i (x_i - y_i) + b = 0 \mod p $$ Since $x_i - y_i$ is fixed, and both $a_i < p$ and $b < p$, there is only one value of $b$ that satisfies the equation for a given value of $a_i$. That is, there are $p/p^2 = 1/p$ pairs which collide. This argument can be formalized, but honestly, it's not worth it. ### d. Hash fingerprints, but with more words Well, there if the adversary has $(m, t)$ and they would like to craft $m'$, they need to calculate $t'$ correctly. They can limit the family of functions in $\mathscr{H}$ to only those that produce $h(m) = t$. But even then, 2-universal implies that for $\langle m, m' \rangle$, any of the possible $\langle t, t' \rangle$ are equality likely (probability $1/p^2$), which in turn means that for any fixed $t$, any of the $p$ possible values of $t'$ is equally likely as well. With no additional information, the only thing our adversary can do is pick any of the subset they identified, and they have only $1/p$ chance to get it right _for the next message_. --- It's worth noting two things: 1. If the adversary had multiple pairs of $(m_i, t_i)$, they can narrow it down further, assuming they can compute the subset of the family $\mathscr{H}$. Now, if the family is $(i+1)$-universal, they are back to looking at $1/p$ probability after the $i$th message. 2. The functions in the family can be [picked in a way][one-way-fn], where the adversary cannot easily identify the ones for which $h(m) = t$ given $m$ and $t$, given that $P \ne NP$. [one-way-fn]: https://en.wikipedia.org/wiki/One-way_function ================================================ FILE: other/clrs/12/01/01.dot ================================================ graph { node[shape="circle"]; a1[label="1"]; a4[label="4"]; a5[label="5"]; a10[label="10"]; a16[label="16"]; a17[label="17"]; a21[label="21"]; a10 -- a4; a10 -- a17; a4 -- a1; a4 -- a5; a17 -- a16; a17 -- a21; b1[label="1"]; b4[label="4"]; b5[label="5"]; b10[label="10"]; b16[label="16"]; b16l[shape=point]; b17[label="17"]; b17l[shape=point]; b21[label="21"]; b5r[shape=point]; b4r[shape=point]; b10 -- b5; b10 -- b16; b5 -- b4; b5 -- b5r; b16 -- b16l; b16 -- b17; b4 -- b1; b4 -- b4r; b17 -- b17l; b17 -- b21; c1[label="1"]; c4[label="4"]; c5[label="5"]; c10[label="10"]; c10r[shape=point]; c16[label="16"]; c17[label="17"]; c17l[shape=point]; c21[label="21"]; c5r[shape=point]; c4r[shape=point]; c16 -- c10; c10 -- c5; c10 -- c10r; c16 -- c17; c5 -- c4; c5 -- c5r; c4 -- c1; c4 -- c4r; c17 -- c17l; c17 -- c21; d1[label="1"]; d4[label="4"]; d5[label="5"]; d10[label="10"]; d10r[shape=point]; d16[label="16"]; d16r[shape=point]; d17[label="17"]; d21[label="21"]; d5r[shape=point]; d4r[shape=point]; d17 -- d16; d17 -- d21; d16 -- d10; d16 -- d16r; d10 -- d5; d10 -- d10r; d5 -- d4; d5 -- d5r; d4 -- d1; d4 -- d4r; e1[label="1"]; e4[label="4"]; e5[label="5"]; e10[label="10"]; e10r[shape=point]; e16[label="16"]; e16r[shape=point]; e17[label="17"]; e21[label="21"]; e5r[shape=point]; e4r[shape=point]; e21r[shape=point]; e17r[shape=point]; e21 -- e17; e21 -- e21r; e17 -- e16; e17 -- e17r; e16 -- e10; e16 -- e16r; e10 -- e5; e10 -- e10r; e5 -- e4; e5 -- e5r; e4 -- e1; e4 -- e4r; } ================================================ FILE: other/clrs/12/01/01.markdown ================================================ > For the set of $\\{1, 4, 5, 10, 16, 17, 21\\}$ of keys, draw binary search > trees of heights 2, 3, 4, 5 and 6. Graphviz is, again, unideal to visualize this, but let's try Worth noting that heigh is defined so the heigh of a leaf is 0. ================================================ FILE: other/clrs/12/01/02.markdown ================================================ > What is the difference between the binary-search-tree property and the > min-heap property (see page 153)? Can the min-heap property be used to print > out the keys of an $n$-node tree in sorted order in $\O(n)$ time? Show how, or > explain why not. The min-heap property established that each node in the tree is smaller than its children, without distinguishing between them. The binary-search tree property is somehow similar, but defines a strict relation between the node and its two children. The min-help can indeed be used to print out the keys, but not in linear time, for two reasons. First, and generally, Theorem 8.1 proves the well-established fact that sorting with comparison has a lower bound of $\Omega(n \lg n)$, and sorting in $\O(n)$ will be a contradiction. Second, and more specifically, the algorithm would require removing the minimal element from the heap on each print. Finding the element is $\O(1)$, but removing it and while maintaining the min-heap property is an $\O(\lg n)$ operation, which will in turn make it a $\O(n \lg n)$ algorithm. And basically, this is just the description of heap sort. ================================================ FILE: other/clrs/12/01/03.markdown ================================================ > Give a nonrecursive algorithm that performs an inorder tree walk. (_Hint:_ An > easy solution uses a stack as an auxiliary data structure. A more complicated, > but elegant, solution uses no stack but assumes that we can test two points of > equality.) We already implemented that in Exercise 10.4.5. The summarize: 1. We need the node to have a pointer to the parent. 2. We keep track of a current node (starting at root) and a previous node (starting at nil) 3. At each step, we use the previous node to determine which is the last element element we visited. If it's the parent, we proceed to the left child. If it's the left child, we print/mark the element and continue to the right child. If it's the right child, we move up. ================================================ FILE: other/clrs/12/01/04.c ================================================ struct tree_t { struct tree_t *left; struct tree_t *right; int key; }; typedef struct tree_t tree_t; typedef void callback_t(tree_t *node); void preorder(tree_t *tree, callback_t *callback) { if (!tree) return; callback(tree); preorder(tree->left, callback); preorder(tree->right, callback); } void postorder(tree_t *tree, callback_t *callback) { if (!tree) return; postorder(tree->left, callback); postorder(tree->right, callback); callback(tree); } ================================================ FILE: other/clrs/12/01/04.markdown ================================================ > Give recursive algorithms that perform preorder and postorder tree walks in > $\Theta(n)$ time on a tree of $n$ nodes. ================================================ FILE: other/clrs/12/01/04.test.c ================================================ #include "04.c" #include "../../build/ext/test.h" #include #define MAX_SIZE 10 int keys[MAX_SIZE]; int count = 0; void reset_storage() { count = 0; } void store(tree_t *tree) { keys[count++] = tree->key; } tree_t *s(int key, tree_t *left, tree_t *right) { tree_t *new = malloc(sizeof(tree_t)); new->key = key; new->left = left; new->right = right; return new; } TEST(preorder_walk) { tree_t *tree = s(10, s(6, s(4, s(1, NULL, NULL), s(5, NULL, NULL)), NULL), s(16, s(15, NULL, NULL), s(20, s(19, NULL, NULL), NULL))); reset_storage(); preorder(tree, store); int expected[] = {10, 6, 4, 1, 5, 16, 15, 20, 19}; ASSERT_SAME_ARRAYS_S(keys, expected, 9); } TEST(postorder_walk) { tree_t *tree = s(10, s(6, s(4, s(1, NULL, NULL), s(5, NULL, NULL)), NULL), s(16, s(15, NULL, NULL), s(20, s(19, NULL, NULL), NULL))); reset_storage(); postorder(tree, store); int expected[] = {1, 5, 4, 6, 15, 19, 20, 16, 10}; ASSERT_SAME_ARRAYS_S(keys, expected, 9); } ================================================ FILE: other/clrs/12/01/05.markdown ================================================ > Argue that since sorting $n$ elements takes $\Omega(n \lg n)$ time in the > worst case in the comparison model, any comparison-based algorithm for > constructing a binary search tree from an arbitrary list of $n$ elements takes > $\Omega(n \lg n)$ time in the worst case. Let's make a reductio ad absurdum argument. Let's assume that there exists $\o(n \lg n)$ algorithm for constructing a binary search tree of $n$ elements. We can then use it to create a tree of $n$ elements and then use an inorder walk to gather the elements in an array in $\Omega(n)$ time. This way we will produce an sorted array in $\o(n \lg n)$ worst-case time, which contradicts with the lower bound on comparison sort. ================================================ FILE: other/clrs/12/02/01.markdown ================================================ > Suppose that we have numbers between 1 and 1000 in a binary search tree, and > we want to search for the number 363. Which of the following sequences could > _not_ be the sequence of nodes examined? > > 1. 2, 252, 401, 398, 330, 344, 397, 363. > 2. 924, 220, 911, 244, 898, 258, 362, 363. > 3. 925, 202, 911, 240, 912, 245, 363. > 4. 2, 399, 387, 219, 266, 382, 381, 278, 363. > 5. 935, 278, 347, 621, 299, 392, 358, 363. Each element of the sequence asserts something for the following elements, namely, that they are greater than it if it's smaller than the searched one, or smaller than it, if it is greater. E.g. in the first sequence, the first element asserts that the following are > 2, the second that it's following are > 252, the third that they are < 401 and so on. Thus: * 3 is invalid because 912 > 911 * 5 is invalid because 229 < 347 The rest are valid. ================================================ FILE: other/clrs/12/02/02.c ================================================ struct tree_t { struct tree_t *left; struct tree_t *right; struct tree_t *parent; int key; }; typedef struct tree_t tree_t; tree_t *minimum(tree_t *tree) { return tree->left ? minimum(tree->left) : tree; } tree_t *maximum(tree_t *tree) { return tree->right ? maximum(tree->right) : tree; } ================================================ FILE: other/clrs/12/02/02.markdown ================================================ > Write recursive versions of `TREE-MINIMUM` and `TREE-MAXIMUM` ================================================ FILE: other/clrs/12/02/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" #include tree_t *s(int key, tree_t *left, tree_t *right) { tree_t *new = malloc(sizeof(tree_t)); new->parent = NULL; new->key = key; new->left = left; new->right = right; if (left) left->parent = new; if (right) right->parent = new; return new; } TEST(minumum) { tree_t *tree = s(15, s(6, s(3, s(2, NULL, NULL), s(4, NULL, NULL)), s(7, NULL, s(13, s(9, NULL, NULL), NULL))), s(18, s(17, NULL, NULL), s(20, NULL, NULL))); ASSERT_EQUALS(minimum(tree)->key, 2); } TEST(maximum) { tree_t *tree = s(15, s(6, s(3, s(2, NULL, NULL), s(4, NULL, NULL)), s(7, NULL, s(13, s(9, NULL, NULL), NULL))), s(18, s(17, NULL, NULL), s(20, NULL, NULL))); ASSERT_EQUALS(maximum(tree)->key, 20); } ================================================ FILE: other/clrs/12/02/03.c ================================================ struct tree_t { struct tree_t *left; struct tree_t *right; struct tree_t *parent; int key; }; typedef struct tree_t tree_t; tree_t *maximum(tree_t *tree) { while (tree->right) tree = tree->right; return tree; } tree_t *predecessor(tree_t *tree) { if (tree->left) { return maximum(tree->left); } tree_t *parent = tree->parent; while (parent && parent->left == tree) { tree = tree->parent; parent = tree->parent; } return parent; } ================================================ FILE: other/clrs/12/02/03.markdown ================================================ > Write the `TREE-PREDECESSOR` procedure ================================================ FILE: other/clrs/12/02/03.test.c ================================================ #include "03.c" #include "../../build/ext/test.h" #include tree_t *s(int key, tree_t *left, tree_t *right) { tree_t *new = malloc(sizeof(tree_t)); new->parent = NULL; new->key = key; new->left = left; new->right = right; if (left) left->parent = new; if (right) right->parent = new; return new; } TEST(predecessor) { tree_t *t13; tree_t *t17; tree_t *t9; tree_t *t6; // Based on figure 12.2 tree_t *tree = s(15, t6 = s(6, s(3, s(2, NULL, NULL), s(4, NULL, NULL)), s(7, NULL, t13 = s(13, t9 = s(9, NULL, NULL), NULL))), s(18, t17 = s(17, NULL, NULL), s(20, NULL, NULL))); ASSERT_EQUALS(predecessor(t13)->key, 9); ASSERT_EQUALS(predecessor(t17)->key, 15); ASSERT_EQUALS(predecessor(t9)->key, 7); ASSERT_EQUALS(predecessor(t6)->key, 4); ASSERT_EQUALS(predecessor(tree)->key, 13); } ================================================ FILE: other/clrs/12/02/04.dot ================================================ graph { node[shape=circle]; 4; 2; 1 3; null[shape=point]; 4 -- 2; 4 -- null; 2 -- 1; 2 --3; } ================================================ FILE: other/clrs/12/02/04.markdown ================================================ > Professor Bunyan thinks he has discovered a remarkable property of binary > search trees. Suppose that the search for key $k$ in a binary search tree ends > up in a leaf. Consider three sets: $A$, the keys to the left of the search > path; $B$, the keys on the search path; and $C$, the keys to the right of the > search path. Professor Bunyan claims that any three keys $a \in A$, $b \in B$, > and $c \in C$ must satisfy $a \le b \le c$. Give a smallest possible > counterexample to the professor's claim. In the tree below, $B = \\{4, 2, 1\\}$ and $C = \\{3\\}$, but for $b = 4$ and $c = 3$ we don't have $b \le c$. ================================================ FILE: other/clrs/12/02/05.markdown ================================================ > Show that if a node in a binary search tree has two children, then its > successor has no left child and its predecessor has no right child. Let's say we have a tree $T$ with left subtree $L$ and right subtree $R$ and parent $P$. Let's also assume distinct keys. Having two children implies that both the successor and the predecessor is going to be among them. To illustrate this, let's consider the successor. It can't be to the right of an ancestor $A$, because this makes $T$ on the left of $A$, therefore making $A$ a better candidate as $T < A$. It can't be that ancestor either, because $T < R$ and $R < A$, making $R$ a better candidate than $A$. Furthermore, if $R$ exists, it's going to contain the (it can't be in $L$, as those elements are smaller). Furthermore, if the successor (somewhere in $R$) had a left child, that would be a better candidate for a successor, since it's smaller than $R$ but still bigger than $T$. Same logic applies for the predecessor. ================================================ FILE: other/clrs/12/02/06.markdown ================================================ > Consider a binary search tree $T$ whose keys are distinct. Show that if the > right subtree of a node $x$ in $T$ is empty and $x$ has a successor $y$, then > $y$ is the lowest ancestor of $x$ whose left child is also an ancestor of $x$. > (Recall that every node is its own ancestor) The successor is clearly not in the left child, as those elements are smaller. We can then start examining the parents. If $x$ is on the right child of the parent, $x$ is going to be maxim element in the parent. We can continue considering parents, this way, until we reach one, $K$, that has the current tree on the left. We know that $x < K.key$. We also know that $K.right$ will contain bigger elements. So far $K.key$ is the smaller element we've encountered, bigger than $x$. If we keep going up the tree, we will either find ourselves on the left site of the parent $P$, which means $K.key < P.key$ or the right side, in which case we know that $P.key < x$. ================================================ FILE: other/clrs/12/02/07.markdown ================================================ > An alternative method of performing inorder tree walk of an $n$-node binary > search tree finds the minimum element in the tree by calling `TREE-MINIMUM` > and then making $n-1$ calls to `TREE-SUCCESSOR`. Prove that this algorithm > runs in $\Theta(n)$ time. It's a bit obvious, and it's not worth (read I'm too lazy) to create a formal argument. We simply need to observe that we visit each node twice – once on the way down (through `TREE-MINIMUM`) and once on the way up in the `while` loop of `TREE-SUCCESSOR` – and we don't do extra steps inbetween. ================================================ FILE: other/clrs/12/02/08.markdown ================================================ > Prove that no matter what node we start at in a heigh-$h$ binary search tree, > $k$ successive calls to `TREE-SUCCESSOR` take $\O(k + h)$ time. This algorithm will walk a number of full subtrees, plus at most two partial paths to the common ancestor of the first and last node. The subtrees will be $\O(k)$ (since we visit each edge twice) and the partial paths will be $\O(h)$ since we may need to skip until we find a parent on the way up and then skip until we find a minimum on the way down. Yeah, informal, I know. ================================================ FILE: other/clrs/12/02/09.markdown ================================================ > Let $T$ be a binary search tree whose keys are distinct, let $x$ be a leaf > node, and let $y$ be its parent. Show that $y.key$ is either the smallest key > in $T$ larger than $x.key$ or the largest key in $T$ smaller than $x.key$. We explored this already in the previous few exercises. Let's consider $y.left = x$. $y.right$ will not contain elements larger than $x.key$ but smaller than $y.key$ (binary search tree property). $y$'s parents will be either left of it (which means their key is smaller than $x.key$, as are those of their left subtree) or right of it (in which case their key would be bigger than $y.key$. If $y.right = x$ similar logic applies. ================================================ FILE: other/clrs/12/03/01.c ================================================ #include struct node_t { struct node_t *parent; struct node_t *left; struct node_t *right; int key; }; typedef struct node_t node_t; typedef struct { node_t *root; } tree_t; tree_t *make_tree() { tree_t *tree = malloc(sizeof(tree_t)); tree->root = NULL; return tree; } node_t *make_node(int key) { node_t *node = malloc(sizeof(node_t)); node->parent = NULL; node->left = NULL; node->right = NULL; node->key = key; return node; } node_t *insert_node(node_t *node, int key) { if (node->key < key) { if (node->right) { return insert_node(node->right, key); } else { node_t *new = make_node(key); new->parent = node; node->right = new; return new; } } else { if (node->left) { return insert_node(node->left, key); } else { node_t *new = make_node(key); new->parent = node; node->left = new; return new; } } } node_t *insert(tree_t *tree, int key) { if (tree->root) { return insert_node(tree->root, key); } else { node_t *node = make_node(key); tree->root = node; return node; } } node_t *search(tree_t *tree, int key) { node_t *node = tree->root; while (node) { if (node->key == key) { return node; } else if (node->key < key) { node = node->right; } else { node = node->left; } } return NULL; } ================================================ FILE: other/clrs/12/03/01.markdown ================================================ > Give a recursive version of the `TREE-INSERT` procedure. ================================================ FILE: other/clrs/12/03/01.test.c ================================================ #include "01.c" #include "../../build/ext/test.h" #include TEST(insert) { tree_t *tree = make_tree(); insert(tree, 7); insert(tree, 3); insert(tree, 5); insert(tree, 1); insert(tree, 9); insert(tree, 11); ASSERT_NOT_NULL(search(tree, 3)); ASSERT_NOT_NULL(search(tree, 5)); ASSERT_NOT_NULL(search(tree, 7)); ASSERT_NOT_NULL(search(tree, 9)); ASSERT_NOT_NULL(search(tree, 11)); ASSERT_NULL(search(tree, 2)); ASSERT_NULL(search(tree, 4)); ASSERT_NULL(search(tree, 6)); } ================================================ FILE: other/clrs/12/03/02.markdown ================================================ > Suppose that we construct a binary search tree by repeatedly inserting > distinct values into the tree. Argue that the number of nodes examined in > searching for a value in the tree is one plus the number of nodes examined > when the value was first inserted into the tree. With the current implementation of `TREE-INSERT` (one that does not self-balance), we are looking for a path from to root to the parent of the node we are about to insert. Let's assume that that number is $n$. When we subsequently search, we are going to walk exactly the same path (there is no other option, really) until we reach the same parent. Then we will examine one more node, which is the node we inserted previously, that is $n+1$ in total. This argument holds, since we're always inserting distinct values, and there is only one possible path to resulting to the value we're searching for. ================================================ FILE: other/clrs/12/03/03.markdown ================================================ > We can sort a given set of $n$ numbers by first building a binary search tree > containing these numbers (using `TREE-INSERT` repeatedly to insert the numbers > one by one) and then printing the numbers by an inorder tree walk. What are > the worst-case and best-case running times for this sorting algorithm? The worst case is going to be $\Theta(n^2)$, which will be achieved if we insert elements in decreasing or increasing order. On each step we will need to walk what is essentially a linked list and append at it's end. That will perform $\sum_{i=1}^{n} i = n(n + 1)/2 = \Theta(n^2)$ operations. In the best case we will insert each node at the highest level that has at least empty position. We can then insert 1 element with 1 operation, 2 elements with 2 operations, 4 elements with 3 operations, 8 elements with 4 operations and so on. This is the well-known $\Theta(n \lg n)$. If we slightly modify our algorithm to be able to insert directly at the root, we can achieve this in linear time, but only if we are already inserting the elements in sorted order. ================================================ FILE: other/clrs/12/03/04.markdown ================================================ > Is the operation of deletion "commutative" in the sense that deleting $x$ and > then $y$ from a binary search tree leaves the same tree as deleting $y$ and > then $x$? Argue why it is or give a counter example. It's not commutative. Let's explore the following tree: 2 / \ 1 4 / 3 If we first delete 1, and then 2 we get: 2 4 \ / 4 3 / 3 If we do it the other way around, deleting 2 first, we replace it with its successor (3) and then when we delete 1, we get: 3 3 / \ \ 1 4 4 ================================================ FILE: other/clrs/12/03/05.c ================================================ #include struct node_t { struct node_t *left; struct node_t *right; struct node_t *succ; int key; }; typedef struct node_t node_t; typedef struct { node_t *root; } tree_t; tree_t *make_tree() { tree_t *tree = malloc(sizeof(tree_t)); tree->root = NULL; return tree; } node_t *make_node(int key) { node_t *node = malloc(sizeof(node_t)); node->succ = NULL; node->left = NULL; node->right = NULL; node->key = key; return node; } node_t *insert(tree_t *tree, int key) { node_t *parent = NULL; node_t *current = tree->root; node_t *new = make_node(key); node_t *pred = NULL; while (current) { parent = current; if (new->key < current->key) { new->succ = current; current = current->left; } else { pred = current; current = current->right; } } if (!parent) { tree->root = new; } else if (new->key < parent->key) { parent->left = new; } else { parent->right = new; pred = parent; } if (pred) pred->succ = new; return new; } node_t *find_parent(tree_t *tree, node_t *node) { node_t *previous = NULL; node_t *current = tree->root; while (current && current->key != node->key) { if (current->key < node->key) { previous = current; current = current->right; } else { previous = current; current = current->left; } } return previous; } void find_parent_and_predecessor(tree_t *tree, node_t *node, node_t **parent, node_t **predecessor) { *parent = NULL; *predecessor = NULL; node_t *current = tree->root; while (current && current->key != node->key) { if (current->key < node->key) { *parent = current; *predecessor = current; current = current->right; } else { *parent = current; current = current->left; } } if (!current) return; current = current->left; while (current) { *predecessor = current; current = current->right; } } void transplant(tree_t *tree, node_t *parent, node_t *target, node_t *source) { if (!parent) { tree->root = source; } else if (target == parent->left) { parent->left = source; } else { parent->right = source; } } void delete_tree(tree_t *tree, node_t *node) { node_t *parent; node_t *predecessor; find_parent_and_predecessor(tree, node, &parent, &predecessor); if (!node->left) { transplant(tree, parent, node, node->right); } else if (!node->right) { transplant(tree, parent, node, node->left); } else { node_t *successor = node->succ; if (node->right != successor) { node_t *sparent = find_parent(tree, successor); transplant(tree, sparent, successor, successor->right); successor->right = node->right; } transplant(tree, parent, node, successor); successor->left = node->left; } if (predecessor) predecessor->succ = node->succ; } node_t *search(tree_t *tree, int key) { node_t *node = tree->root; while (node) { if (node->key == key) { return node; } else if (node->key < key) { node = node->right; } else { node = node->left; } } return NULL; } typedef void (*callback_t)(node_t *); void inorder_walk(node_t *node, callback_t callback) { if (!node) return; inorder_walk(node->left, callback); callback(node); inorder_walk(node->right, callback); } void successor_walk(node_t *node, callback_t callback) { while (node->left) node = node->left; while (node) { callback(node); node = node->succ; } } ================================================ FILE: other/clrs/12/03/05.debug.c ================================================ #include "05.c" #include #define W 6 #define P 2 #define MAX(a,b) (((a)>(b))?(a):(b)) int height(node_t *tree) { if (!tree) return 0; return MAX(height(tree->left), height(tree->right)) + 1; } node_t **make_array(int size) { return calloc(sizeof(node_t *), size); } int size(node_t *node) { if (!node) return 0; return size(node->left) + size(node->right) + 1; } void space(int i) { while(i-- > 0) putchar(' '); } int level_pad(int h) { int n = 1 << (h - 1); return (n - 1) * (W + P) / 2; } void print_node(node_t *tree) { if (!tree) printf(" "); else if (tree->succ) printf("%2d(%2d)", tree->key, tree->succ->key); else printf("%2d(--)", tree->key); } void print_tree(tree_t *tree) { int h = height(tree->root); int width = 1; node_t **row = make_array(width); row[0] = tree->root; for (int level = 0; level < h; level++) { int padding = level_pad(h - level); for (int i = 0; i < width; i++) { space(padding); print_node(row[i]); space(padding); space(P); } puts(""); puts(""); node_t **next = make_array(width * 2); for (int c = 0, t = 0; c < width; c++) { next[t++] = row[c] ? row[c]->left : NULL; next[t++] = row[c] ? row[c]->right : NULL; } free(row); width *= 2; row = next; } free(row); } ================================================ FILE: other/clrs/12/03/05.markdown ================================================ > Suppose that instead of each node $x$ keeping the attribute $x.p$ pointing to > $x$'s parent, it keeps $x.succ$, pointing to $x$'s successor. Give pseudocode > for `SEARCH`, `INSERT`, and `DELETE` on a binary search tree $T$ using this > representation. These procedures should operate in time $\O(h)$, where $h$ is > the height of the tree $T$. (_Hint:_ You may wish to implement a subroutine > that returns the parent of a node.) I've got to admit, I was skeptical about this one. It was quite a good exercise, however, as it forces you to internalize a lot about binary search trees and their predecessor/successor invariants. The pseudocode and the C code differ a bit, as the C code is a bit more complicated to avoid a few extra steps. It even can be optimized a bit further, but it's not worth the complexity. The asymptotic bounds are going to be the same as the pseudocode ### Some thoughts I pondered a bit about why it would be useful to keep track of the successor instead of the parent. I may be missing something, but I can find a single advantage – the tree can be walked inorder without extra space and a bit more optimally. Another benefit is that it simplifies finding the successor of the deleted node in `DELETE`. Apart from that, not keeping track of the parent introduces some overhead, especially when deleting. ### Notable differences The pseudocode needs two change in two significant ways: * As the parent is no longer findable through a pointer, we need to walk the three from the root and find it. On the flip side, we don't need to update parent pointers. * Whenever we remove a node, we need to preserve the invariant of the successor field. This means that we need to find the predecessor of the node we are deleting, and have it successor point to the deleted node's successor. ### Pseudocode `SEARCH` remains unchanged: TREE-SEARCH(x, k) if x = NIL or k == x.key return x if k < x.key return TREE-SEARCH(x.left, k) else return TREE-SEARCH(x.right, k) `INSERT` needs to allocate the correct successor of the newly inserted node and update it's predecessor. Since we're only inserting leaf nodes, both predecessor and successor are findable through their invariants: * The predecessor is going to be the last parent at which we branched right. It might be the parent of the inserted node, if we put it at the left position. * The successor is going to be the last parent at which at branched left. * Notably, we don't need to explore the new node's children, as they don't exist because it's a leaf node. TREE-INSERT(T, z) y = NIL x = T.root pred = NIL while x != NIL y = x if z.key < x.key z.succ = x x = x.left else pred = x x = x.right if y == NIL T.root = z else if z.key < y.key y.left = z else y.right = z pred = y if pred != NIL pred.succ = z The final one, `DELETE` is a bit more complicated. It needs `TREE-PARENT`, that finds the parent of a node, starting from the root, and `TREE-PREDECESSOR` that finds finds the predecessor of a node, starting from the root. It also needs a modified version of `TRANSPLANT`. Since those are pretty self-explanatory, let's start with `DELETE` and explore them afterwards. It's worth noting that we don't need to call `TREE-MINIMUM` on `z.right` in the two-children case, as we already know its successor. TREE-DELETE(T, z) pred = TREE-PREDECESSOR(z) if z.left == NIL TRANSPLANT(T, z, z.right) else if z.right == NIL TRANSPLANT(T, z, z.left) else y = z.succ if (z.right != y) TRANSPLANT(T, y, y.right) y.right = z.right TRANSPLANT(T, z, y) y.left = z.left if pred != NIL pred.succ = z.succ Node that `y.p != z` needs to be changed to `z.right != y`, which means the same thing. `TRANSPLANT` now needs to explicitly find the parent: TRANSPLANT(T, u, v) p = TREE-PARENT(T, u) if p == NIL T.root = v else if u == p.left p.left = v else p.right = v The notable change here is that we don't need to update the `v`'s parent, as we don't keep track of it. Finally, `TREE-PREDECESSOR` is fairly needs to start from the root, instead of the node: TREE-PREDECESSOR(T, x) y = NIL z = T.root while z != x if z.key < x.key y = z z = z.right else z = z.left z = z.left while z != NIL y = z z = z.right return y The first loop traverses the tree from the root to `x`, keeping track of the last right branch to mark it as a potential predecessor. When it finishes, `z` equals `x`. If there is no left child, we're done, and the ancestor is the predecessor. If there is a left child, we follow it and keep going left, until there are no no mode left children to follow. The last is essentially what `TREE-MINIMUM` does. We could change the order of the loops (find the minimum of the left child and go through the root only if it doesn't exist). While it will improve the constant, it's asymptotically the same. The C code merges `TREE-PREDECESSOR` and `TREE-PARENT` into one. It's pretty easy to illustrate that the result is $\O(h)$, so I won't bother. ================================================ FILE: other/clrs/12/03/05.test.c ================================================ #include "05.debug.c" #include "../../build/ext/test.h" #include #include #include void randomized_numbers(int seed, int max, int target[], int count) { bool used[max]; for (int i = 0; i < max; i++) used[i] = false; srand(seed); for (int i = 0; i < count; i++) { while (true) { int number = rand() % (max - 1); if (!used[number]) { used[number] = true; target[i] = number + 1; break; } } } } int cmp(const void *pa, const void *pb) { int *a = (int *) pa; int *b = (int *) pb; return *a - *b; } #define M 30 #define L 100 int buffer[M]; int count; void reset_buffer() { memset(buffer, 0, sizeof(int) * M); count = 0; } void append_to_buffer(node_t *node) { buffer[count++] = node->key; } void check_successor_invariant(tree_t *tree) { reset_buffer(); int n = size(tree->root); successor_walk(tree->root, append_to_buffer); ASSERT_EQUALS(n, count); for (int i = 1; i < n; i++) { ASSERT_TRUE(buffer[i - 1] < buffer[i]); } } TEST(inserting) { int numbers[M]; randomized_numbers(0, 100, numbers, M); tree_t *tree = make_tree(); for (int i = 0; i < M; i++) { insert(tree, numbers[i]); } for (int i = 0; i < M; i++) { ASSERT_NOT_NULL(search(tree, numbers[i])); } check_successor_invariant(tree); } TEST(inorder_walk) { int numbers[M]; randomized_numbers(0, 100, numbers, M); int sorted[M]; memcpy(sorted, numbers, M * sizeof(int)); qsort(sorted, M, sizeof(int), cmp); tree_t *tree = make_tree(); for (int i = 0; i < M; i++) { insert(tree, numbers[i]); } reset_buffer(); inorder_walk(tree->root, append_to_buffer); ASSERT_SAME_ARRAYS_S(buffer, sorted, M); } TEST(randomized_successor_walk) { int numbers[M]; int sorted[M]; for (int s = 0; s < 100; s++) { randomized_numbers(s, 100, numbers, M); memcpy(sorted, numbers, M * sizeof(int)); qsort(sorted, M, sizeof(int), cmp); tree_t *tree = make_tree(); for (int i = 0; i < M; i++) { insert(tree, numbers[i]); } reset_buffer(); successor_walk(tree->root, append_to_buffer); ASSERT_SAME_ARRAYS_S(buffer, sorted, M); } } TEST(deleting_case_a) { tree_t *tree = make_tree(); insert(tree, 5); insert(tree, 10); insert(tree, 13); insert(tree, 14); insert(tree, 12); delete_tree(tree, search(tree, 10)); ASSERT_NULL(search(tree, 10)); ASSERT_NOT_NULL(search(tree, 5)); ASSERT_NOT_NULL(search(tree, 12)); ASSERT_NOT_NULL(search(tree, 13)); ASSERT_NOT_NULL(search(tree, 14)); check_successor_invariant(tree); } TEST(deleting_case_a_2) { tree_t *tree = make_tree(); insert(tree, 5); insert(tree, 10); delete_tree(tree, search(tree, 10)); ASSERT_NULL(search(tree, 10)); ASSERT_NOT_NULL(search(tree, 5)); check_successor_invariant(tree); } TEST(deleting_case_b) { tree_t *tree = make_tree(); insert(tree, 15); insert(tree, 10); insert(tree, 7); insert(tree, 8); insert(tree, 6); delete_tree(tree, search(tree, 10)); ASSERT_NULL(search(tree, 10)); ASSERT_NOT_NULL(search(tree, 15)); ASSERT_NOT_NULL(search(tree, 7)); ASSERT_NOT_NULL(search(tree, 6)); ASSERT_NOT_NULL(search(tree, 8)); check_successor_invariant(tree); } TEST(deleting_case_c) { tree_t *tree = make_tree(); insert(tree, 5); insert(tree, 10); insert(tree, 7); insert(tree, 13); delete_tree(tree, search(tree, 10)); ASSERT_NOT_NULL(search(tree, 5)); ASSERT_NOT_NULL(search(tree, 7)); ASSERT_NOT_NULL(search(tree, 13)); check_successor_invariant(tree); } TEST(deleting_case_d) { tree_t *tree = make_tree(); insert(tree, 7); insert(tree, 5); insert(tree, 3); insert(tree, 10); insert(tree, 8); insert(tree, 15); insert(tree, 19); insert(tree, 11); insert(tree, 12); delete_tree(tree, search(tree, 10)); ASSERT_NULL(search(tree, 10)); ASSERT_NOT_NULL(search(tree, 7)); ASSERT_NOT_NULL(search(tree, 5)); ASSERT_NOT_NULL(search(tree, 3)); ASSERT_NOT_NULL(search(tree, 8)); ASSERT_NOT_NULL(search(tree, 15)); ASSERT_NOT_NULL(search(tree, 19)); ASSERT_NOT_NULL(search(tree, 11)); ASSERT_NOT_NULL(search(tree, 12)); check_successor_invariant(tree); } TEST(deleting_in_random_trees) { int numbers[M]; int to_delete = 12; for (int s = 0; s < 100; s++) { bool removed[L]; randomized_numbers(s, L, numbers, M); tree_t *tree = make_tree(); for (int i = 0; i < L; i++) removed[i] = false; for (int i = 0; i < M; i++) insert(tree, numbers[i]); for (int i = 0; i < to_delete; i++) { int index = rand() % M; int value = numbers[index]; if (!removed[value]) { removed[value] = true; ASSERT_NOT_NULL(search(tree, value)); delete_tree(tree, search(tree, value)); } } check_successor_invariant(tree); for (int i = 0; i < M; i++) { if (removed[numbers[i]]) { ASSERT_NULL(search(tree, numbers[i])); } else { ASSERT_NOT_NULL(search(tree, numbers[i])); } } } } ================================================ FILE: other/clrs/12/03/06.markdown ================================================ > When node $z$ in `TREE-DELETE` has two children, we could choose node $y$ as > its predecessor rather than its successor. What other changes to `TREE-DELETE` > would be necessary if we did so? Some have argued that a fair strategy, giving > equal priority to predecessor and successor, yields better empirical > performance. How might `TREE-DELETE` be changed to implement such a fair > strategy? We need to write a symmetrical function: TREE-DELETE(T, z) if z.left = NIL TRANSPLANT(T, z, z.right) else if z.right == NIL TRANSPLANT(T, z, z.left) else y = TREE-MAXIMUM(z.left) if y.p != z TRANSPLANT(T, y, y.left) y.left = z.left y.left.p = y TRANSPLANT(T, z, y) y.right = z.right y.right.p = y Basically, call `TREE-MAXIMUM` and swap `left` and `right`. Beware of the code above; I've not even proven it correct, let alone tested it. As for implementing a fair strategy – we can have both versions of the function and then randomly decide which node to choose. ================================================ FILE: other/clrs/12/04/01.markdown ================================================ > Prove equation (12.3). > > $$ \sum_{i=0}^{n-1} \binom{i+3}{3} = \binom{n+3}{4} $$ Let's use induction here. We'll start with $n=2$ in the base, as it will illustrate the step more clearly: $$ \sum_{i=0}^{1} \binom{i+3}{3} = \binom{3}{3} + \binom{4!}{3!} = \frac{3!}{3!} + \binom{4!}{3!} = \frac{3 \cdot 2 \cdot 1}{3!} + \frac{4 \cdot 3 \cdot 2}{3!} = \frac{(4 + 1) \cdot 3 \cdot 2 \cdot 1}{3!} = \frac{4 \cdot 5 \cdot 3 \cdot 2}{4 \cdot 3!} = \frac{5!}{4! \cdot 1!} = \binom{5}{4} = \binom{2 + 3}{4} $$ For the step, we do this: $$ \begin{aligned} \sum_{i=0}^{n} \binom{i+3}{3} &= \sum_{i=0}^{n} \binom{i+3}{3} \\\\ &= \sum_{i=0}^{n-1} \binom{i+3}{3} + \binom{n+3}{3} \\\\ &= \binom{n+2}{4} + \binom{n+3}{3} \\\\ &= \frac{(n+3)(n+2)(n+1)n}{4!} + \frac{(n+3)(n+2)(n+1)}{3!} \cdot \frac{4}{4} \\\\ &= \frac{(n+3)(n+2)(n+1)(n + 4)}{4!} \\\\ &= \binom{n+4}{4} \end{aligned} $$ ================================================ FILE: other/clrs/12/04/02.markdown ================================================ > Describe a binary search tree on $n$ nodes such that the average depth of a > node in the tree $\Theta(\lg n)$ but the height of the tree is $\omega(\lg > n)$. Give an asymptotic upper bound on the height of an $n$-node binary search > tree in which the average depth of a node is $\Theta(\lg n)$. This is a bit weird. Let's consider how to maximize the height of the tree while minimizing the average depth. One approach would be having a long right-child-only chain of $f(n)$ nodes and a perfect binary tree with the ontop with the remaining $n - f(n)$ nodes. The answer, for the upper bound, after some desperate attempts and even more desperate googling, is $O(\sqrt{n \lg n})$. Let's prove it. Let's take the average depth $D$. Let $d_i$ be the depth of the $i$-th node, and let's split the nodes into two sets - $P$ and $Q$, where $P$ are the nodes from the root to a specific node at maximal height, and $Q$ are the rest. That is, $P$ is the set of node that form a longest path in the tree. We have: $$ D = \frac{1}{n} \left( \sum_{i \in P} d_i + \sum_{i \in Q} d_i \right) \ge \frac{1}{n} \sum_{i \in P} d_i = \frac{1}{n} \sum_{i = 0}^h i = \Theta(h^2) $$ Now let's assume that $\O(\sqrt{n \lg n})$ is not an upper bound, that is, $h = \omega(\sqrt{n \lg n})$. We then have: $$ D = \frac{1}{n} \Theta(h^2) = \frac{1}{n} \omega(n \lg n) = \omega(\lg n) $$ This, however, is a contradiction, as we know the average depth is $\Omega(\lg{n})$, so we can infer that $\O(\sqrt{n \lg n})$ is an upper bound. ================================================ FILE: other/clrs/12/04/03.markdown ================================================ > Show that the notion of a randomly chosen binary search tree on $n$ keys, > where each binary search tree of $n$ keys is equally likely to be chosen, is > different from the notion of a randomly built binary search tree given in this > section. (_Hint:_ List the possibilities when $n = 3$.) With the elements 1, 2 and 3, there are only $5$ possible binary search trees: 1 1 2 3 3 \ \ / \ / / 2 3 1 3 1 2 \ / \ / 3 2 2 1 There are, however $3! = 6$ by the definition of the chapter. ================================================ FILE: other/clrs/12/04/04.markdown ================================================ > Show that the function $f(x) = 2^x$ is convex. Like $f'(x) = 2^x \ln{2}$ and $f''(x) = 2^x \ln^2 2$ which is positive for all real numbers, thus the function is convex. The again, the Instructor Manual solves this without calculus. Key point: learn calculus. ================================================ FILE: other/clrs/12/04/05.markdown ================================================ > $\star$ Consider `RANDOMIZED-QUICKSORT` operating on a sequence of $n$ > distinct input numbers. Prove that for any constant $k > 0$, all but > $\O(1/n^k)$ of the $n!$ input permutations yield an $\O(n \lg n)$ running > time. **UNSOLVED**. Yeah, this formulation is very confusing and I don't get it. Let's move on. ================================================ FILE: other/clrs/12/problems/01.markdown ================================================ ## Binary search trees with equal keys > Equal keys pose a problem for the implementation of binary search trees. > >
      >
    1. > What is the asymptotic performance of TREE-INSERT when used > to insert $n$ items with identical keys into an initially empty binary > search tree? >
      2. >
    > > We propose to improve `TREE-INSERT` by testing before line 5 to determine > whether $z.key = x.key$ and by testing before line 11 to determine whether > $z.key = x.key$. If equality holds, we implement one of the following > strategies. For each strategy, find the asymptotic performance of inserting > $n$ items with identical keys into an initially empty binary search tree. (The > strategies are described for line 5, in which we compare the keys of $z$ and > $x$. Substitute $y$ for $x$ to arrive at the strategies for line 11.) > >
      >
    1. > Keep a boolean flag $x.b$ at node $x$, and set $x$ to either $x.left$ or > $x.right$ based on the value of $x.b$, which alternates between > FALSE and TRUE each time we visit $x$ while > inserting a node with the same key as $x$. >
      2. >
    2. > Keep a list of nodes with equal keys at $x$, and insert $z$ into the list >
      3. >
    3. > Randomly set $x$ to either $x.left$ or $x.right$. (Give the worst case > performance and informally derive the expected running time. >
      4. >
    To begin with (a), the implementation in the book always insert to the right of a leaf node, which means it needs to iterate over the existing node, which means each subsequent insert will perform an additional operation, yielding $\Theta(n^2)$. ### First strategy This is interesting. If you work it out through inserting, you'll notice that it fills each level before advancing to the next one, building a perfect binary tree. The time is therefore going to be $\Theta(n \lg n)$. ### Second strategy Assuming a doubly-linked list or inserting in the beginning of the list, this will result in $\Theta(n)$ time, as each insert is going to be $\O(1)$ (constant time to find the root, and constant time to insert in the list). ### Third strategy The worst case performance is clearly $\Theta(n^2)$. Reasoning informally, we'll pick the left and right subtree roughly the same amount of time, which means the elements will roughly be equal in the two main branches. Applying this logic recursively, we end up with a roughly balanced tree, which means $\Theta(n \lg n)$ expected time. ================================================ FILE: other/clrs/12/problems/02.c ================================================ #include #include struct node_t { struct node_t *zero; struct node_t *one; const char *str; }; typedef struct node_t node_t; typedef struct { node_t *root; } radix_tree_t; typedef void (*callback_t)(const char *); node_t *make_node() { node_t *new = malloc(sizeof(node_t)); new->zero = NULL; new->one = NULL; new->str = NULL; return new; } radix_tree_t *make_radix_tree() { radix_tree_t *new = malloc(sizeof(radix_tree_t)); new->root = make_node(); return new; } void insert(radix_tree_t *tree, const char *string) { const char *s = string; node_t *current = tree->root; while (*s != '\0') { if (*s == '0') { if (!current->zero) current->zero = make_node(); current = current->zero; } else if (*s == '1') { if (!current->one) current->one = make_node(); current = current->one; } else { fprintf(stderr, "Invalid string: %s", s); exit(1); } s++; } current->str = string; } void walk(node_t *node, callback_t callback) { if (node->str) callback(node->str); if (node->zero) walk(node->zero, callback); if (node->one) walk(node->one, callback); } void walk_sorted(radix_tree_t *tree, callback_t callback) { walk(tree->root, callback); } ================================================ FILE: other/clrs/12/problems/02.markdown ================================================ ## Radix trees > Given two strings $a = a_0 a_1 \ldots a_p$ and $b = b_0 b_1 \ldots b_p$, where > each $a_i$ and each $b_j$ is in some ordered set of characters, we say that > string $a$ is **lexicographically less than** string $b$ if either: > > 1. there exists an integer $j$, where $0 \le j \le \min(p, q)$, such that $a_i > = b_i$ for all $i = 0, 1, \ldots, j - 1$ and $a_j < $b_j$, or > 2. $p < q$ and $a_i = b_i$ for all $i = 0, 1, \ldots p$. > > For example, if $a$ and $b$ are bit strings, then $10100 < 10110$ by rule 1 > (letting $j = 3$) and $10100 < 101000$ by rule 2. This ordering is similar to > that used in English-language dictionaries. > > The **radix tree** data structure shown in Figure 12.5 stores the bit strings > $1011$, $10$, $011$, $100$, and $0$. When searching for a key $a = a_0 a_1 > \ldots a_p$, we go left at node of depth $i$ if $a_i = 0$ and right if $a_i = > 1$. Let $S$ be a set of distinct bit strings whose lengths sum to $n$. Show > how to use a radix tree to sort $S$ lexicographically in $\Theta(n)$ time. For > example, in Figure 12.5, the output of the sort should be the sequence $0, > 011, 10, 100, 1011$. This is as simple as building the tree and then doing a preorder walk. Each insertion will take $m$ steps, where $m$ is the length of the string being inserted. Given that upper nodes sort lexicographically before lower nodes, and zeroes sort before ones, we need to report the parent before the children, and the left subtree before the right. ================================================ FILE: other/clrs/12/problems/02.test.c ================================================ #include "02.c" #include "../../build/ext/test.h" #include #include #define N 10 const char *actual[N]; int count = 0; void append(const char *s) { actual[count++] = s; } TEST(sort) { char *s1011 = "1011"; char *s10 = "10"; char *s011 = "011"; char *s100 = "100"; char *s0 = "0"; radix_tree_t *tree = make_radix_tree(); insert(tree, s1011); insert(tree, s10); insert(tree, s011); insert(tree, s100); insert(tree, s0); walk_sorted(tree, append); ASSERT_TRUE(strcmp(s0, actual[0]) == 0); ASSERT_TRUE(strcmp(s011, actual[1]) == 0); ASSERT_TRUE(strcmp(s10, actual[2]) == 0); ASSERT_TRUE(strcmp(s100, actual[3]) == 0); ASSERT_TRUE(strcmp(s1011, actual[4]) == 0); } ================================================ FILE: other/clrs/12/problems/03.markdown ================================================ ## Average node depth in a randomly built binary search tree > In this problem, we prove that the average depth of a node in a randomly built > binary search tree with $n$ nodes is $\O(\lg n)$. Although this result is > weaker than that of Theorem 12.4, the technique we shall use reveals a > surprising similarity between the building of a binary search tree and the > execution of `RANDOMIZED-QUICKSORT` from Section 7.3. > > We define the **total path length** $P(T)$ of a binary search tree as the sum, > over all nodes $x$ in $T$, of the depth of node $x$, which we denote by $d(x, > T)$. > >
      >
    1. > Argue that the average depth of a node in $T$ is > $$ \frac{1}{n}\sum_{x \in T}^{n-1} d(x, T) = \frac{1}{n} P(T) $$ >
      2. >
    > > Thus, we wish to show that the expected value of $P(T)$ is $O(n \lg n)$. >
      >
    1. > Let $T_L$ and $T_R$ denote the left and right subtrees of tree $T$, > respectively. Argue that if $T$ has $n$ nodes, then > > $$ P(T) = P(T_L) + P(T_R) + n - 1 $$ >
      2. >
    2. > Let $P(n)$ denote the average total path length of a randomly built binary > search tree with $n$ nodes. Show that: > > $$ P(n) = \frac{1}{n} \sum_{i=0}^{n-1}(P(i) + P(n-i-1) + n - 1) $$ >
      3. >
    3. > Show how to rewrite $P(n)$ as > $$ P(n) = \frac{2}{n} \sum_{k=1}^{n-1} P(k) + \Theta(n) $$ >
      4. >
    4. > Recalling the alternative analysis of the randomized version of quicksort > given in Problem 7.3, conclude that $P(n) = \O(n \lg n)$. >
      5. >
    > > At each recursive invocation of quicksort, we choose a random pivot element to > partition the set of elements being sorted. Each node of a binary search tree > partitions the set of elements that fall into the subtree rooted at that node. > >
      >
    1. > Describe an implementation of quicksort in which the comparisons to sort a > set of elements are exactly the same as the comparisons to insert the > elements into a binary search tree. (The order in which comparisons are made > may differ, but the same comparisons must occur.) >
      2. >
    ### Average depth of the node This is literally by definition. ### Total path length expressed through subtrees Let's say that $T_L$ contains $l$ nodes. If we add a new node above $T_L$ as a new root of the tree, each of the $l$ nodes will get one extra edge connecting it to the root. A similar argument can be made for $T_R$ with $r$ nodes. Thus, when we take two trees, $T_L$ and $T_R$ and make them the left and right subtrees of a new tree, we add $l + r$ to the total path length of both trees, as each node now has an extra edge to the root. Observe that if the new tree has $n$ elements, then $n - 1 = l + r$. Hence we have that: $$ P(T) = P(T_L) + P(T_R) + n - 1 $$ ### Average total path length of randomly built tree When we're building the tree randomly, each element of $\\{1, 2, \ldots, n\\}$ is equally likely to be the root. This follows pretty straightforwardly from the last two parts. ### Rewritten expression We need to observe that each $P(i)$ appears twice because of the sum. That is: $$ \begin{aligned} P(n) &= \frac{1}{n} \sum_{i=0}^{n-1}(P(i) + P(n-i-1) + n - 1) \\\\ &= \frac{1}{n} \sum_{i=0}^{n-1}(P(i) + P(n-i-1)) + \frac{1}{n} \sum_{i=0}^{n-1}(n - 1) \\\\ &= \frac{1}{n} \Big( P(0) + P(n - 1) + P(1) + P(n - 2) + \ldots + P(n - 2) + P(1) + P(n - 1) + P(0) \Big) + \Theta(n) \\\\ &= \frac{2}{n} \sum_{k=0}^{n-1} P(k) \\\\ &= \frac{2}{n} \sum_{k=1}^{n-1} P(k) \\\\ \end{aligned} $$ The last step holds because $P(0) = 0$. ### Upper bound Problem 7.3 established that: $$ \sum_{k=2}^{n-1}k\lg{k} \le \frac{1}{2}n^2\lg{n} - \frac{1}{8}n^2 $$ Keeping that in mind, let's use the substitution method to establish an upper bound on $P(n)$. Let's assume $O(n\lg{n})$ and plug in $an\lg{n} + b$. $$ \begin{aligned} P(n) &= \frac{2}{n} \sum_{k=1}^{n-1}P(k) + \Theta(n) \\\\ &= \frac{2}{n} \sum_{k=2}^{n-1}P(k) + \Theta(n) && \text{(because }P(1) = 0 \text{)} \\\\ &\le \frac{2}{n} \sum_{k=2}^{n-1}(ak\lg{k} + b) + \Theta(n) \\\\ &= \frac{2a}{n} \sum_{k=2}^{n-1}(k\lg{k}) + \frac{2b}{n}(n - 1) + \Theta(n) \\\\ &\le \frac{2a}{n} \sum_{k=2}^{n-1}(k\lg{k}) + 2b + \Theta(n) \\\\ &\le \frac{2a}{n} \left( \frac{1}{2} n^2 \lg{n} - \frac{1}{8} n^2 \right) + 2b + \Theta(n) \\\\ &= an \lg{n} - \frac{4}{a} n + 2b + \Theta(n) \\\\ &= an \lg{n} + b + \left(\Theta(n) + b - \frac{4}{a}n\right) \\\\ &\le an \lg{n} + b \end{aligned} $$ If we choose a large enough $a$ so $\frac{a}{4}n \ge \Theta(n) + b$. Chapter 4 advises against asymptotic notation when using the substitution method, but I like to live dangerously. ### Describe an implementation of quicksort(?) In quicksort, once a pivot is chosen, every element is compared against it. Similarly, once the root is chosen, every other element is compared against it. Applying this thinking recursively, we end up at the same number of comparisons. ================================================ FILE: other/clrs/12/problems/04.markdown ================================================ ## Number of different binary trees > Let $b_n$ denote the number of different binary trees with $n$ nodes. In this > problem you will find a formula for $b_n$, as well as an asymptotic estimate. > >
      >

    1. Show that $b = 1$ and that, for $n \ge 1$, > $$ b_n = \sum_{k=0}^{n-1} b_k b_{n-1-k} $$ >

    2. Referring to Problem 4-4 for the > definition of a generating function, let $B(x)$ be the generating function > $$ B(x) = \sum_{n=0}^{\infty} b_n x^n $$ > Show that $B(x) = xB(x)^2 + 1$, and hence one way to express $B(x)$ in > closed form is > $$ B(x) = \frac{1}{2x}(1 - \sqrt{1 - 4x}) $$ >

    > > The **Taylor expansion** of $f(x)$ around the point $x = a$ is given by > > $$ f(x) = \sum_{k=0}^{\infty} \frac{f^{(k)}(a)}{k!}(x - a)^k $$ > > where $f^{(k)}(x)$ is the $k$th derivative of $f$ evaluated at $x$. > >
      >

    1. Show that > $$ b_n = \frac{1}{n + 1} \binom{2n}{n} $$ > (the $n$th Catalan number) by using the Taylor expansion of $\sqrt{1 - > 4x}$ around $x = 0$. (If you wish, instead of using the Taylor expansion, > you may use the generalization of the binomial expansion (C.4) to > nonintegral exponents $n$, where for any real number $n$ and for any integer > $k$, we interpret $\binom{n}{k}$ to be $n(n-1)\ldots(n-k+1)/k!$ if $k \ge > 0$, and 0 otherwise). >

    2. Show that > $$ b_n = \frac{4^n}{\sqrt{\pi} n^{3/2}} (1 + O(1/n)) $$ >

    ### a. Calculating $b_0$ and $b_n$ There is exactly one tree with 0 nodes (the empty tree), therefore $b_0 = 1$. When we construct a tree with $n$ nodes, we have $n$ choices for the root, and the remaining $n - 1$ nodes will be either in the left subtree or the right subtree. This is exactly the given formula: $$ b_n = \sum_{k=0}^{n-1} b_k b_{n-1-k} $$ Where $k$ is the number of elements that are smaller than the chosen root and $n - 1 - k$ is the number of elements larger than the chosen root. ### b. Generating function This is trippy. $$ \begin{aligned} xB(x) + 1 &= 1 + x \Big( b_0 x^0 + b_1 x^1 + b_2 x^2 + \ldots \Big)^2 \\\\ &= 1 + x \Big( b_0^2 + x^0 + (b_0 b_1 + b_1 b_0) x^1 + (b_0 b_2 + b_1 b_1 + b_2 b_0) x^2 + \ldots \Big) \\\\ &= 1 + x \Big( \sum_{k=0}^{0} b_k b_{0-k} x^0 + \sum_{k=0}^{1} b_k b_{1-k} x^1 + \sum_{k=0}^{2} b_k b_{2-k} x^2 + \ldots \Big) \\\\ &= 1 + x \Big( \sum_{j=0}^{\infty} \sum_{k=0}^{j} b_k b_{j-k} x^j \Big) \\\\ &= 1 + x \Big( \sum_{j=0}^{\infty} \sum_{k=0}^{j+1-1} b_k b_{j+1-1-k} x^j \Big) \\\\ &= 1 + \sum_{j=0}^{\infty} \sum_{k=0}^{j+1-1} b_k b_{j+1-1-k} x^{j+1} \\\\ &= 1 + \sum_{j=0}^{\infty} b_{j+1} x^{j+1} && \big( \text{because of (a)} \big)\\\\ &= 1 + \sum_{k=1}^{\infty} b_{k} x^{k} && \big( \text{substituting } k = j + 1 \big)\\\\ &= b_0 x^0 + \sum_{k=1}^{\infty} b_{k} x^{k} \\\\ &= \sum_{k=0}^{\infty} b_{k} x^{k} \\\\ &= B(x) \end{aligned} $$ Then, to verify the possible solution, we just substitute: $$ \begin{aligned} xB(x)^2 + 1 &= x \Big( \frac{1}{2x}(1 - \sqrt{1 - 4x}) \Big)^2 + 1 \\\\ &= \frac{1}{4x}(1 - 2 \sqrt{1 - 4x} + 1 - 4x) + 1 \\\\ &= \frac{1}{4x}(2 - 2 \sqrt{1 - 4x}) - \frac{4x}{4x} + 1 \\\\ &= \frac{1}{2x}(1 - \sqrt{1 - 4x}) \\\\ &= B(x) \end{aligned} $$ ### c. Taylor series expansion Ugh! Alright, let's calculate some derivatives for $f(x) = \sqrt{1 - 4x} = (1 - 4x)^{1/2}$. $$ \begin{aligned} f^{(1)}(x) &= \Big[ (1 - 4x)^{1/2} \Big]' = \frac{1}{2} (1 - 4x)^{-1/2} (1 - 4x)' = -2 (1 - 4x)^{-1/2} = \frac{-2}{(1 - 4x)^{1/2}} \\\\ f^{(2)}(x) &= \Big[ -2 (1 - 4x)^{-1/2} \Big]' = (- \frac{1}{2})(-2)(1 - 4x)^{-3/2}(1 - 4x)' = -4(1 - 4x)^{-3/2} = \frac{-3}{(1 - 4x)^{3/2}} \\\\ f^{(3)}(x) &= \Big[ -4 (1 - 4x)^{-3/2} \Big]' = \frac{3 \cdot 4}{2}(1 - 4x)^{-5/2}(1 - 4x)' = -24(1 - 4x)^{-5/2} = \frac{-24}{(1 - 4x)^{5/2}} \\\\ f^{(4)}(x) &= \Big[ -24 (1 - 4x)^{-5/2} \Big]' = \frac{24 \cdot 5}{2}(1 - 4x)^{-7/2}(1 - 4x)' = -240(1 - 4x)^{-7/2} = \frac{-240}{(1 - 4x)^{7/2}} \\\\ f^{(5)}(x) &= \Big[ -24 (1 - 4x)^{-7/2} \Big]' = \frac{240 \cdot 7}{2}(1 - 4x)^{-9/2}(1 - 4x)' = -3360(1 - 4x)^{-9/2} = \frac{-3360}{(1 - 4x)^{9/2}} \\\\ \end{aligned} $$ Let's observe that for $x = 0$ the denominator is going to be $1$, so we're interested only in the numerator. Let's also notice that the numerator $n_k$ for the $k$-th derivative is: $$ n_k = - 2^k \prod_{i=0}^{k-2} (2k + 1) = - 2^k \frac{(2(k - 1))!}{2^{k-1}(k-1)!} = - \frac{2(2(k - 1))!}{(k-1)!} $$ Thus, the Taylor expansion is: $$ f(x) = \sum_{k=0}^{\infty} - \frac{n_k}{k!}x^k = \sum_{k=0}^{\infty} - \frac{2(2(k-1))!}{k!(k-1)!}x^k$$ Or $$ f(x) = 1 - 2x - 2x^2 - 4x^3 - 10x^4 - 28x^5 - \ldots $$ Substituting that into $B(x)$, we get: $$ \begin{aligned} B(x) &= \frac{1}{2x}(1 - f(x)) \\\\ &= \frac{1}{2x} (1 - 1 + 2x + 2x^2 + 4x^3 + 10x^4 + 28x^5 + \ldots) \\\\ &= 1 + x + 2x^2 + 5x^3 + 14x^4 + \ldots \\\\ &= \sum_{k=0}^{\infty} \frac{(2k)!}{(k + 1)!k!} x^k \\\\ &= \sum_{k=0}^{\infty} \frac{1}{k+1} \frac{(2k)!}{k!k!} x^k \\\\ &= \sum_{k=0}^{\infty} \frac{1}{k+1} \binom{2k}{k} x^k \end{aligned} $$ Which illustrates that: $$ b_k = \frac{1}{n+1} \binom{2k}{k} $$ ### d. Upper bound We use Stirling's approximation, $$ n! = \sqrt{2 \pi n}\Big(\frac{n}{e}\Big)^n \Bigg(1 + \Theta \Big( \frac{1}{n} \Big) \Bigg) = \sqrt{2 \pi n} n^n e^{-n} (1 + \Theta(1/n)) $$ and go on to produce some very ugly math: $$ \begin{aligned} b_n &= \frac{1}{n+1}\frac{(2n)!}{n!n!} \\\\ &= \frac{1}{n+1}\frac{ \sqrt{4 \pi n}(2n)^{2n} e^{-2n} (1 + \Theta(1/n)) }{2 \pi n n^{2n} e^{-2n} (1 + \Theta(1/n)) } \\\\ &= \frac{1}{n+1}\frac{ \sqrt{4 \pi n} 4^{n} n^{2n} (1 + \Theta(1/n)) }{2 \pi n n^{2n} (1 + \Theta(1/n)) } \\\\ &= \frac{1}{n+1}\frac{ 2 \sqrt{\pi n} 4^{n} (1 + \Theta(1/n)) }{2 \pi n (1 + \Theta(1/n)) } \\\\ &= \frac{1}{n+1}\frac{ 4^{n} (1 + \Theta(1/n)) }{\sqrt{\pi n} (1 + \Theta(1/n)) } \\\\ &= \frac{ 4^n }{\sqrt{\pi} n^{3/2} } (1 + \Theta(1/n)) \end{aligned} $$ ================================================ FILE: other/clrs/13/01/01.draw.py ================================================ import drawing B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red tree01 = B(8, R(4, B(2, R(1), R(3)), B(6, R(5), R(7))), R(12, B(10, R(9), R(11)), B(14, R(13), R(15)))).dot() tree02 = B(8, B(4, R(2, B(1), B(3)), R(6, B(5), B(7))), B(12, R(10, B(9), B(11)), R(14, B(13), B(15)))).dot() tree03 = B(8, B(4, B(2, B(1), B(3)), B(6, B(5), B(7))), B(12, B(10, B(9), B(11)), B(14, B(13), B(15)))).dot() drawings = [ {'name': 'Black-height 2', 'dot': tree01, 'display': False}, {'name': 'Black-height 3', 'dot': tree02, 'display': False}, {'name': 'Black-height 4', 'dot': tree03, 'display': False}, ] drawing.process(drawings) ================================================ FILE: other/clrs/13/01/01.markdown ================================================ > In the style of Figure 13.1(a), draw the complete binary search tree of height > 3 on the keys ${1, 2, \ldots, 15}$. Add the $\mathrm{NIL}$ leaves and color > the nodes in three different ways such that the black-heights of the resulting > red-black trees are 2, 3 and 4. Here's a tree with black-height $2$. ![](13/01/01.drawing.01.svg) This is the most "balanced" tree possible. Property 4 is the most limiting one – red nodes need to have black children. There's nothing preventing a black node to have black children. Thus, one way to reach black-height $3$ is: ![](13/01/01.drawing.02.svg) Finally, to get black-height of $4$, all the nodes need to be black: ![](13/01/01.drawing.03.svg) ================================================ FILE: other/clrs/13/01/02.draw.py ================================================ import drawing B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red G = drawing.RedBlackTrees.Gray tree = B( 26, R(17, B(14, R(10, B(7, R(3)), B(12)), B(16, R(15))), B(21, B(19, None, R(20)), B(23))), B(41, R(30, B(28), B(38, R(35, None, G(36)), R(39))), B(47))) drawings = [ {'name': 'Figure 13.1', 'dot': tree.dot(), 'display': False}, ] drawing.process(drawings) ================================================ FILE: other/clrs/13/01/02.markdown ================================================ > Draw the red-black tree that results after `TREE-INSERT` is called on the tree > in Figure 13.1 with key $36$. If the inserted node is colored red, is the > resulting tree a red-black tree? What if it is colored black? The new element is going to be the gray one: ![](13/01/02.drawing.01.svg) If we color it red, it will violate property 4, that is, red nodes need to have black children. In this case, it's parent, 35 is red, so it must be black. If we color it black, it will violate property 5. The path to the descendants of 36 from the root will have 4 black nodes, but the one to the descendants of 39 will have 3. That is, `TREE-INSERT` does not produce a valid red-black tree in this case, regardless of how we color the node. ================================================ FILE: other/clrs/13/01/03.markdown ================================================ > Let us define a **relaxed red-black tree** as a binary search tree that > satisfies red-black properties 1, 3, 4, and 5. In other words, the root may be > either red or black. Consider a relaxed red-black tree $T$ whose root is red. > If we color the root of $T$ black but make no other changes to $T$, is the > resulting tree a red-black tree? Yes. Checking the properties: 1. **Every node is either red or black**. Holds. 2. **The root is black.** Holds after coloring. 3. **Every leaf ($\mathrm{NIL}$) is black.** Holds, since the leaves were black in the relaxed tree. 4. **If a node is red, then both its children are black**. Holds. The only potential candidate to break the property is the root, which is now black, and has no parents. 5. **For each node, all simple paths from the node to descendant leaves contain the same number of black nodes**. Continues to hold, as the all paths from the root get a potential extra black node and the rest remain unchanged. ================================================ FILE: other/clrs/13/01/04.draw.py ================================================ import drawing B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red tree = B(4, R(2, B(1), B(3)), R(6, B(5), B(7))) drawings = [ {'name': 'Max degree', 'dot': tree.dot(nils=False), 'display': False}, ] drawing.process(drawings) ================================================ FILE: other/clrs/13/01/04.markdown ================================================ > Suppose that we "absorb" every red node in a red-black tree into its black > parent, so that the children of the red node become children of the black > parent. (Ignore what happens to the keys.) What are the possible degrees a of > black node after all its red children are absorbed? What can you say about the > depths of the leaves of the resulting tree? Two things are clear from the properties: 1. Red nodes have black children. 2. Red nodes have black parents. Both follow from property 4, which implies that a red node cannot be a parent of another red node. Alternatively put, each path to a leaf may go through subsequent black nodes, but no two red nodes in a row. This means that the most complicated subtree is going to look like this: ![](13/01/04.drawing.01.svg) If we "absorb" the red nodes, node 4 will end up having four children (1, 3, 5, 7), that is, a degree of $4$ and no more. The depth of the resulting leaves can at most halve. That is, if a leaf had depth $n$, it's new depth is going to be at least $\lceil n / 2 \rceil$. ================================================ FILE: other/clrs/13/01/05.markdown ================================================ > Show that the longest simple path from a node $x$ in a red-black tree to a > descendent leaf has length at most twice that of the shortest simple path from > node $x$ to a descendant leaf. Both the shortest path $s$ and the longest path $l$ will have the same number of black nodes, as per property 5. Because of property 4, each red node must have a black parent and black children. This means that the number of red nodes must be less than or equal to the number of black nodes in any path in a valid red-black tree. The biggest difference then, can be obtained if $s$ contains only black nodes and $l$ contains the same number of black nodes with the maximum possible red nodes added to it, which is $2s$. ================================================ FILE: other/clrs/13/01/06.markdown ================================================ > What is the largest possible number of internal nodes in a red-black tree with > black height $k$? What is the smallest possible number. As discussed in the previous two exercises, there can be no more red nodes than black nodes. The smallest possible number will be obtained if all the nodes are black, that is $2^k - 1$. The largest possible number will be obtained if we have a layer of red nodes, followed by a layer of black nodes, producing a tree of height $2k$, and $2^{2k} - 1$ nodes. ================================================ FILE: other/clrs/13/01/07.draw.py ================================================ import drawing B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red tree = B(8, R(4, B(2, R(1), R(3)), B(6, R(5), R(7))), R(12, B(10, R(9), R(11)), B(14, R(13), R(15)))) drawings = [ {'name': 'Biggest ratio', 'dot': tree.dot(nils=False), 'display': False}, ] drawing.process(drawings) ================================================ FILE: other/clrs/13/01/07.markdown ================================================ > Describe a red-black tree on $n$ keys that realizes the largest possible ratio > of red internal nodes to black internal nodes. What is this ratio? What tree > has the smallest possible ratio, and what is the ratio? The math can get quite complicated if $n$ is not one less than a power of $2$. Reasoning informally: The smallest possible ratio is obtained by black-only nodes and is going to be $0$. The largest possible ratio is obtained by each black node having two red children, and is going to be $2$. Here's an illustration: ![](13/01/07.drawing.01.svg) There are 5 black internal nodes and 10 red internal nodes, making a ratio of $2$. ================================================ FILE: other/clrs/13/02/01.markdown ================================================ > Write the pseudocode for `RIGHT-ROTATE`. I'm pretty sure I'll end up implementing rotations in C in the later exercises, so I'm gonna wing it with the pseudocode here: RIGHT-ROTATE(T, y) x = y.left y.left = x.right if x.right != T.nil x.right.p = y x.p = y.p if y.p == T.nil T.root = x elseif y == y.p.left y.p.left = x else y.p.right = x x.right = y y.p = x I've chosen to name the variable `y` to match the figure in the text. ================================================ FILE: other/clrs/13/02/02.markdown ================================================ > Argue that in every $n$-node binary search tree, there are exactly $n-1$ > possible rotations. There is a very simple argument to illustrate this. Each rotation is possible along an internal edge from a child to a parent. In a tree of $n$ nodes, there are at exactly $n - 1$ internal edges (each node has a parent, apart from the root). Thus, there are only $n - 1$ possible rotations. ================================================ FILE: other/clrs/13/02/03.markdown ================================================ > Let $a$, $b$, and $c$ be arbitrary nodes in subtrees $\alpha$, $\beta$ and > $\gamma$, respectively, in the left tree of Figure 13.2. How do the depths of > $a$, $b$, and $c$ change when a left rotation is performed on node $x$ in the > figure? * $b$ retains its depth. * $a$'s depth is increased by one. * $c$'s depth is decreased by one. ================================================ FILE: other/clrs/13/02/04.markdown ================================================ > Show that any arbitrary $n$-node binary search tree can be transformed into > any other arbitrary $n$-node binary search tree using $\O(n)$ rotations. > (_Hint_: First show that at most $n-1$ right rotations suffice to transform > the tree into a right-going chain.) An informal argument: Let's that the right-going chain of nodes in the tree, that is, nodes that can be reached by following only right-going edges. This right-going chain either contains the whole tree, or there are some nodes that are left children of the chain. If we perform a right rotation on such a child and its parent in the chain, the length of the chain increases by one and the number of nodes not in the chain gets reduced by one. We can keep iterating, until the tree is a right-going chain. There would be at most $n - 1$ nodes, so we can perform this in $\O(n)$ rotations. It should be noted that this operation is reversible. That is, we can apply the symmetric left rotation in reverse order to obtain the original tree from the resulting right-going chain. Since there is only one possible right-going chain (sorting the elements in increasing order), we can transform any tree to another by first transforming it to a right-going chain, and then applying the reverse transformation that the target tree will need to become a right-going chain. ================================================ FILE: other/clrs/13/02/05.markdown ================================================ > $\star$ We say that a binary search tree $T_1$ can be **right-converted** to a > binary search tree $T_2$ if it is possible to obtain $T_2$ from $T_1$ via a > series of calls to `RIGHT-ROTATE`. Give an example of two trees $T_1$ and > $T_2$ such that $T_1$ cannot be right-converted to $T_2$. Then, show that if a > tree $T_1$ can be right-converted to $T_2$, it can be right-converted using > $\O(n^2)$ calls to `RIGHT-ROTATE`. Here are two trees, the second of which can't be produced by right-rotating the right: 1 2 \ / 2 1 We need a left rotation here. More specifically, right rotations can only decrease the value of the root, but not increase it. Now, reasoning very informally, and making some unverified assumptions, we can convert $T_1$ to $T_2$ by first doing $\O(n)$ right rotations to get the roots to match, and then performing right rotations on the two sub-trees recursively to position their roots. An upper bound of this approach (assuming it works) will be $\O(n^2)$. ================================================ FILE: other/clrs/13/03/01.markdown ================================================ > In line 16 of `RB-INSERT`, we set the color of the newly inserted node $z$ to > red. Observe that if we had chosen to set $z$'s color to black, then property > 4 of a red-black tree would not be violated. Why didn't we choose to set $z$'s > color to black? If we color it black, we will violate property 5, namely that all paths have the same number of black nodes. This would be a harder invariant to reintroduce. ================================================ FILE: other/clrs/13/03/02.draw.py ================================================ import os.path as path import drawing exec(open(path.join(path.dirname(__file__), '02.py')).read()) B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red def dot(tree): def convert(node, nil): if node is nil: return None cons = R if node.color == Color.RED else B left = convert(node.left, nil) right = convert(node.right, nil) return cons(node.key, left, right) return convert(tree.root, tree.nil).dot() tree = Tree() drawings = [] for n in [41, 38, 31, 12, 19, 8]: tree.insert(n) drawings.append({'name': f'After inserting {n}', 'dot': dot(tree), 'display': True}) drawing.process(drawings) ================================================ FILE: other/clrs/13/03/02.markdown ================================================ > Show the red-black trees that result after successfully inserting the keys > $41, 38, 31, 12, 19, 8$ into an initially empty red-black tree. This was a curious exercise. It was worth doing this on a piece of paper and then writing the code to verify that it works. ================================================ FILE: other/clrs/13/03/02.py ================================================ from enum import Enum class Color(Enum): RED = 1 BLACK = 2 class Node: def __init__(self, color, key, parent, left, right): self.color = color self.key = key self.parent = parent self.left = left self.right = right class Tree: def __init__(self): self.nil = Node(Color.BLACK, None, None, None, None) self.nil.parent = self.nil self.nil.left = self.nil self.nil.right = self.nil self.root = self.nil def insert(self, key): z = Node(Color.RED, key, None, None, None) y = self.nil x = self.root while x is not self.nil: y = x if z.key < x.key: x = x.left else: x = x.right z.parent = y if y is self.nil: self.root = z elif z.key < y.key: y.left = z else: y.right = z z.left = self.nil z.right = self.nil z.color = Color.RED self.fixup(z) def fixup(self, z): while z.parent.color == Color.RED: if z.parent is z.parent.parent.left: y = z.parent.parent.right if y.color == Color.RED: z.parent.color = Color.BLACK y.color = Color.BLACK z.parent.parent.color = Color.RED z = z.parent.parent else: if z is z.parent.right: z = z.parent self.left_rotate(z) z.parent.color = Color.BLACK z.parent.parent.color = Color.RED self.right_rotate(z.parent.parent) else: y = z.parent.parent.left if y.color == Color.RED: z.parent.color = Color.BLACK y.color = Color.BLACK z.parent.parent.color = Color.RED z = z.parent.parent else: if z is z.parent.left: z = z.parent self.right_rotate(z) z.parent.color = Color.BLACK z.parent.parent.color = Color.RED self.left_rotate(z.parent.parent) self.root.color = Color.BLACK def left_rotate(self, x): y = x.right x.right = y.left if y.left is not self.nil: y.left.parent = x y.parent = x.parent if x.parent is self.nil: self.root = y elif x is x.parent.left: x.parent.left = y else: x.parent.right = y y.left = x x.parent = y def right_rotate(self, y): x = y.left y.left = x.right if x.right is not self.nil: x.right.parent = y x.parent = y.parent if y.parent is self.nil: self.root = x elif y is y.parent.left: y.parent.left = x else: y.parent.right = x x.right = y y.parent = x ================================================ FILE: other/clrs/13/03/03.markdown ================================================ > Suppose that the black-height of each of the subtrees $\alpha$, $\beta$, > $\gamma$, $\delta$, $\epsilon$ in Figures 13.5 and 13.6 is $k$. Label each > node in each figure with its black-height to verify that the indicated > transformation preserves property 5. This is kinda obvious. You can see that regardless of the transformation, there is always only one black parent above the subtree in the figure. ================================================ FILE: other/clrs/13/03/04.markdown ================================================ > Professor Teach is concerned that `RB-INSERT-FIXTUP` might set $T.nil.color$ > to `RED`, in which case the test in line 1 would not cause the loop to > terminate when $z$ is the root. Show that the professor's concern is unfounded > by arguing that `RB-INSERT-FIXUP` never sets $T.nil.color$ to `RED`. The professor worries too much. We only set the color to red of $z.p.p$ and the text goes at great lengths to establish that it always exists (because $z.p$ is `RED`, which means it can't be the root, which means $z.p.p$ is not `NIL`). ================================================ FILE: other/clrs/13/03/05.markdown ================================================ > Consider a red-black tree formed by inserting $n$ nodes with `RB-INSERT`. > Argue that if $n > 1$, the tree has at least one red node. The way `RB-INSERT` is defined, it always introduces a new node colored red. The only time it changes it's color to black is if it is the root, that is, if it's a tree with 1 node. After we have a black root, each insert will color the newly introduced element red and keep it red, regardless of how it rearranges the rest of the tree. ================================================ FILE: other/clrs/13/03/06.markdown ================================================ > Suggest how to implement `RB-INSERT` efficiently if the representation for > red-black trees include no storage for parent pointers. We can do it by allocating extra $\O(\lg n)$ memory. When inserting, we're descending the tree to the position we want to insert in. If we keep track of the stack of parents we visit (there $\O(\lg n)$ are of them), we can then calculate $z.p$ and $z.p.p$ using that stack. We will need to pass the relevant parent to `LEFT-ROTATE` and `RIGHT-ROTATE` as well. Problem 13.1 actually implements this. ================================================ FILE: other/clrs/13/04/01.markdown ================================================ > Argue that after executing `RB-DELETE-FIXUP`, the root of the tree must be > black. First, let's observe that all the cases in `RB-DELETE-FIXUP` retains the color of the root of the subtree. If the deleted node is not the root or an immediate descendent of the root, the root's color will remain the same, regardless of rotations. The only case that's not obvious is when the deleted node is the root and it has a single child. In this case, `RB-DELETE-FIXUP` will immediately color it red, and the property will be preserved. ================================================ FILE: other/clrs/13/04/02.markdown ================================================ > Argue that if in `RB-DELETE-FIXUP` both $x$ and $x.p$ are red, then property 4 > is restored by the call to `RB-DELETE-FIXUP(T, x)` Similar to the previous exercise, just observe that `RB-DELETE-FIXUP(T, x)` will immediately color x black if it was red. Thus, if both $x$ and $x.p$ are red, $x$ will become black and the property will be retained (as $x.p$ is red and it's other child was unchanged, it's bound to be black). ================================================ FILE: other/clrs/13/04/03.draw.py ================================================ import os.path as path import drawing exec(open(path.join(path.dirname(__file__), '03.py')).read()) B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red def dot(tree): def convert(node, nil): if node is nil: return None cons = R if node.color == Color.RED else B left = convert(node.left, nil) right = convert(node.right, nil) return cons(node.key, left, right) return convert(tree.root, tree.nil).dot() tree = Tree() drawings = [] for n in [41, 38, 31, 12, 19, 8]: tree.insert(n) for n in [8, 12, 19, 31, 38]: tree.delete(n) drawings.append({'name': f'After deleting {n}', 'dot': dot(tree), 'display': True}) drawing.process(drawings) ================================================ FILE: other/clrs/13/04/03.markdown ================================================ > In Exercise 13.3-2, you found the red-black tree that results from > successively inserting the keys $41, 38, 31, 12, 19, 8$ into an initially > empty tree. Now show the red-black trees that result from the successive > deletion of the keys in the order $8, 12, 19, 31, 38, 41$. I did this on paper, but in order to be certain of the results, it's worth implementing deletion and seeing whether they match when I came up with. Let's see. ================================================ FILE: other/clrs/13/04/03.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 class Node: def __init__(self, color, key, parent, left, right): self.color = color self.key = key self.parent = parent self.left = left self.right = right def sexp(self, nil): if self is nil: return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left.sexp(nil)}, {self.right.sexp(nil)})" def black_height(self, nil): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height class Tree: def __init__(self): self.nil = Node(Color.BLACK, None, None, None, None) self.nil.parent = self.nil self.nil.left = self.nil self.nil.right = self.nil self.root = self.nil def __str__(self): return self.root.sexp(self.nil) def search(self, key): node = self.root while node is not self.nil: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root is not self.nil: items.append(self.root) while items: node = items.popleft() yield node if node.left is not self.nil: items.append(node.left) if node.right is not self.nil: items.append(node.right) def insert(self, key): z = Node(Color.RED, key, None, None, None) y = self.nil x = self.root while x is not self.nil: y = x if z.key < x.key: x = x.left else: x = x.right z.parent = y if y is self.nil: self.root = z elif z.key < y.key: y.left = z else: y.right = z z.left = self.nil z.right = self.nil z.color = Color.RED self.insert_fixup(z) def insert_fixup(self, z): while z.parent.color == Color.RED: if z.parent is z.parent.parent.left: y = z.parent.parent.right if y.color == Color.RED: z.parent.color = Color.BLACK y.color = Color.BLACK z.parent.parent.color = Color.RED z = z.parent.parent else: if z is z.parent.right: z = z.parent self.left_rotate(z) z.parent.color = Color.BLACK z.parent.parent.color = Color.RED self.right_rotate(z.parent.parent) else: y = z.parent.parent.left if y.color == Color.RED: z.parent.color = Color.BLACK y.color = Color.BLACK z.parent.parent.color = Color.RED z = z.parent.parent else: if z is z.parent.left: z = z.parent self.right_rotate(z) z.parent.color = Color.BLACK z.parent.parent.color = Color.RED self.left_rotate(z.parent.parent) self.root.color = Color.BLACK def delete(self, z): z = self.search(z) y = z y_original_color = y.color if z.left is self.nil: x = z.right self.transplant(z, z.right) elif z.right is self.nil: x = z.left self.transplant(z, z.left) else: y = self.minimum(z.right) y_original_color = y.color x = y.right if y.parent is z: x.parent = y else: self.transplant(y, y.right) y.right = z.right y.right.parent = y self.transplant(z, y) y.left = z.left y.left.parent = y y.color = z.color if y_original_color == Color.BLACK: self.delete_fixup(x) def delete_fixup(self, x): while x is not self.root and x.color == Color.BLACK: if x is x.parent.left: w = x.parent.right if w.color == Color.RED: w.color = Color.BLACK x.parent.color = Color.RED self.left_rotate(x.parent) w = x.parent.right if w.left.color == Color.BLACK and w.right.color == Color.BLACK: w.color = Color.RED x = x.parent else: if w.right.color == Color.BLACK: w.left.color = Color.BLACK w.color = Color.RED self.right_rotate(w) w = x.parent.right w.color = x.parent.color x.parent.color = Color.BLACK w.right.color = Color.BLACK self.left_rotate(w.parent) x = self.root else: w = x.parent.left if w.color == Color.RED: w.color = Color.BLACK x.parent.color = Color.RED self.right_rotate(x.parent) w = x.parent.left if w.left.color == Color.BLACK and w.right.color == Color.BLACK: w.color = Color.RED x = x.parent else: if w.left.color == Color.BLACK: w.left.color = Color.BLACK w.color = Color.RED self.left_rotate(w) w = x.parent.left w.color = x.parent.color x.parent.color = Color.BLACK w.left.color = Color.BLACK self.right_rotate(w.parent) x = self.root x.color = Color.BLACK def minimum(self, node): while node.left is not self.nil: node = node.left return node def transplant(self, u, v): if u.parent is self.nil: self.root = v elif u is u.parent.left: u.parent.left = v else: u.parent.right = v v.parent = u.parent def left_rotate(self, x): y = x.right x.right = y.left if y.left is not self.nil: y.left.parent = x y.parent = x.parent if x.parent is self.nil: self.root = y elif x is x.parent.left: x.parent.left = y else: x.parent.right = y y.left = x x.parent = y def right_rotate(self, y): x = y.left y.left = x.right if x.right is not self.nil: x.right.parent = y x.parent = y.parent if y.parent is self.nil: self.root = x elif y is y.parent.left: y.parent.left = x else: y.parent.right = x x.right = y y.parent = x ================================================ FILE: other/clrs/13/04/03.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '03.py') exec(open(filename).read()) class RedBlackTest(unittest.TestCase): def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if n.left is tree.nil or n.right is tree.nil: heights.add(n.black_height(tree.nil)) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) self.assertEqual(tree.nil.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/13/04/04.markdown ================================================ > In which lines of the code for `RB-DELETE-FIXUP` might we examine or modify > the sentinel $T.nil$? $x$ can initially be the sentinel, and all the checks and modifications against it (lines 2, 3, 6, 7, 8, 11, 16, 17, 18, 20) examine the sentinel. It happens to have the right pointers, because `RB-DELETE` has set them up before calling `RB-DELETE-FIXUP`. ================================================ FILE: other/clrs/13/04/05.markdown ================================================ > In each of the cases of Figure 13.7, give the count of black nodes from the > root of the subtree shown to each of the subtrees $\alpha, \beta, \ldots, > \zeta$, and verify that each count remains the same after the transformation. > When a node has $color$ attribute $c$ or $c'$, use the notation > $\text{count}(c)$ or $\text{count}(c')$ symbolically in your count. Aah, nice. An attempt to shoehorn more math. Let's denote $A = 1$, $B = 1$ and so on, and count it when the note is black. Also, if a node has "extra black", let's denote that as $x$. Finally, let's say that the count is $2+$ if there are two certain blacks and some optional ones, expressed through $\text{count}$. Thus: ## Case 1 $$ \begin{aligned} \alpha : && A + B + x &= 3 && \Rightarrow & A + D + x &= 3 \\\\ \beta : && A + B + x &= 3 && \Rightarrow & A + D + x &= 3 \\\\ \gamma : && C + B &= 2 && \Rightarrow & C + D &= 2 \\\\ \delta : && C + B &= 2 && \Rightarrow & C + D &= 2 \\\\ \epsilon : && E + B &= 2 && \Rightarrow & E + D &= 2 \\\\ \zeta : && E + B &= 2 && \Rightarrow & E + D &= 2 \\\\ \end{aligned} $$ ## Case 2 $$ \begin{aligned} \alpha : && A + \text{count}(c) + x &= 2+ && \Rightarrow & A + \text{count}(c) + x &= 2+ \\\\ \beta : && A + \text{count}(c) + x &= 2+ && \Rightarrow & A + \text{count}(c) + x &= 2+ \\\\ \gamma : && C + D + \text{count}(c) &= 2+ && \Rightarrow & C + \text{count}(c) + x &= 2+ \\\\ \delta : && C + D + \text{count}(c) &= 2+ && \Rightarrow & C + \text{count}(c) + x &= 2+ \\\\ \epsilon : && E + D + \text{count}(c) &= 2+ && \Rightarrow & E + \text{count}(c) + x &= 2+ \\\\ \zeta : && E + D + \text{count}(c) &= 2+ && \Rightarrow & E + \text{count}(c) + x &= 2+ \\\\ \end{aligned} $$ ## Case 3 $$ \begin{aligned} \alpha : && A + \text{count}(c) + x &= 2+ && \Rightarrow & A + \text{count}(c) + x &= 2+ \\\\ \beta : && A + \text{count}(c) + x &= 2+ && \Rightarrow & A + \text{count}(c) + x &= 2+ \\\\ \gamma : && D + \text{count}(c) &= 1+ && \Rightarrow & C + \text{count}(c) &= 1+ \\\\ \delta : && D + \text{count}(c) &= 1+ && \Rightarrow & C + \text{count}(c) &= 1+ \\\\ \epsilon : && E + D + \text{count}(c) &= 2+ && \Rightarrow & E + C + \text{count}(c) &= 2+ \\\\ \zeta : && E + D + \text{count}(c) &= 2+ && \Rightarrow & E + C + \text{count}(c) &= 2+ \\\\ \end{aligned} $$ ## Case 4 $$ \begin{aligned} \alpha : && A + x + \text{count}(c) &= 2+ && \Rightarrow & A + B + \text{count}(c) &= 2+ \\\\ \beta : && A + x + \text{count}(c) &= 2+ && \Rightarrow & A + B + \text{count}(c) &= 2+ \\\\ \gamma : && \text{count}(c') + D + \text{count}(c) &= 1++ && \Rightarrow & \text{count}(c') + B + \text{count}(c) &= 1++ \\\\ \delta : && \text{count}(c') + D + \text{count}(c) &= 1++ && \Rightarrow & \text{count}(c') + B + \text{count}(c) &= 1++ \\\\ \epsilon : && D + \text{count}(c) &= 1+ && \Rightarrow & E + \text{count}(c) &= 1+ \\\\ \zeta : && D + \text{count}(c) &= 1+ && \Rightarrow & E + \text{count}(c) &= 1+ \\\\ \end{aligned} $$ ================================================ FILE: other/clrs/13/04/06.markdown ================================================ > Professors Skelton and Baron are concerned that at the start of case 1 of > `RB-DELETE-FIXUP`, the node $x.p$ might not be black. If the professors are > correct, then lines 5–6 are wrong. Show that $x.p$ must be black at the start > of case 1, so that the professors have nothing to worry about. At the start of case 1 we check that $w$, the other child of $x.p$ is red. If it is, it means that $x.p$ has to be black (if it was red, it would have a red child, which violates property 4). ================================================ FILE: other/clrs/13/04/07.draw.py ================================================ import os.path as path import drawing exec(open(path.join(path.dirname(__file__), '03.py')).read()) B = drawing.RedBlackTrees.Black R = drawing.RedBlackTrees.Red def dot(tree): def convert(node, nil): if node is nil: return None cons = R if node.color == Color.RED else B left = convert(node.left, nil) right = convert(node.right, nil) return cons(node.key, left, right) return convert(tree.root, tree.nil).dot() tree = Tree() drawings = [] tree.insert(5) tree.insert(4) tree.insert(6) drawings.append({'name': f'Before insert', 'dot': dot(tree), 'display': True}) tree.insert(3) drawings.append({'name': f'After insert', 'dot': dot(tree), 'display': True}) tree.delete(3) drawings.append({'name': f'After delete', 'dot': dot(tree), 'display': True}) drawing.process(drawings) ================================================ FILE: other/clrs/13/04/07.markdown ================================================ > Suppose that a node $x$ is inserted into a red-black tree with `RB-INSERT` and > then is immediately deleted with `RB-DELETE`. Is the resulting red-black tree > the same as the initial red-black tree? Justify your answer. It's not, necessarily. Informally, (1) there is more than one way to color the same tree and (2) nothing in the functions strives to accomplish a canonical coloring. In fact, all the functions try to do as little work as possible. Here's a counter-example: ================================================ FILE: other/clrs/13/misc/red_black_tree.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node nil = Node(Color.BLACK, NIL_KEY, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, key): new = Node(Color.RED, key, None, None, None, self) parent = nil node = self.root while node: parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/13/misc/red_black_tree_test.py ================================================ import unittest from red_black_tree import Tree, Color import random class RedBlackTest(unittest.TestCase): def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/13/problems/01.markdown ================================================ ## Persistent dynamic sets > During the course of an algorithm, we sometimes find that we need to maintain > past versions of a dynamic set as it is updated. We call such a set > **persistent**. One way to implement a persistent set is to copy the entire > set whenever it is modified, but this approach can slow down a program and > also consume much space. Sometimes, we can do much better. > > Consider a persistent set $S$ with the operations `INSERT`, `DELETE`, and > `SEARCH` which we implement using binary search trees as shown in Figure > 13.8(a). We maintain a separate root for every version of the set. In order to > insert the key 5 into the set, we create a new node with key 5. This node > becomes the left child of a new node with key 7, since we cannot modify the > existing node with key 7. Similarly, the new node with key 7 becomes the left > child of a new node with key 8 whose right child is the existing node with key > 10. The new node with key 8 become, in turn, the right child of a new root > $r'$ with key 4 whose left child is the existing node with key 3. We thus copy > only part of the tree and share some of the nodes with the original tree, as > shown in Figure 13.8(b). > > Assume that each tree node has the attributes $key$, $left$, and $right$ but > no parent (See also Exercise 13.3-6). > >
      >
    1. For a general persistent binary search tree, identify the nodes that we > need to change to insert a key $k$ or delete a node $y$. >
    2. Write a procedure PERSISTENT-TREE-INSERT that, given a > persistent tree $T$ and a key $k$ to insert, return a new persistent tree > $T'$ that is the result of inserting $k$ into $T$. >
    3. If the height of the persistent binary search tree $T$ is $h$, what are > the time and space requirements of your implementation of > PERSISTENT-TREE-INSERT? (The space requirement is proportional > to the number of new nodes allocated.) >
    4. Suppose that we had included the parent attribute in each node. In this > case, PERSISTENT-TREE-INSERT would need to perform additional > copying. Prove that PERSISTENT-TREE-INSERT would then require > $\Omega(n)$ time and space, where $n$ is the number of nodes in the tree. >
    5. Show how to use red-black trees to guarantee that the worst-case running > time and space are $\O(\lg n)$ per insertion and deletion. >
    ### What needs to change Very simply, every time we need to change a node, we have to make a copy of the node an all its ancestors. ### Including a parent attribute If we included a parent attribute, every time we make a copy of the parent, we would have to copy both of it's children, because the children need to refer to the new parent. This essentially means that the whole tree will need to be copied. By not keeping track of the parent, we can reuse the unchanged child. ### Complexity The complexity of insertion and deletion is $\O(\lg n)$, since We only modify nodes from the inserted/deleted position to the root, plus a constant number of other nodes. ### Implementation The exercise just for `PERSISTENT-TREE-INSERT`, but I decided to go for the full thing, and implement a persistent red-black tree. It was a horrible ordeal that was pretty hard to debug and get right. I shudder to imagine the agony if I attempted to do it in C, instead of Python. Anyway, here are some notes. First, both `RB-INSERT-FIXUP` and `RB-DELETE-FIXUP` repeat a lot of code in the two branches, with "left" and "right" reversed. This is too much work, so I will generalized the operations a bit so they can work with a `direction` (that can be either `left` or `right`) and flip that direction when necessary. Since we no longer keep track of parents, we need to calculate the ancestor chain when we get to a node, so we can later make copies. A few functions have been modified to keep track of the chain. Maintaining a sentinel becomes tricky as well, so the sentinel is removed and replaced with `None`, along with all the necessary checks. ================================================ FILE: other/clrs/13/problems/01.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 UNCHANGED = object() # In order to avoid duplicating symmetric code based on whether a child is left # or right, we can work with directions instead. In order to be able to, we need # to be able to flip a direction as well. def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) def isBlackOrNil(node): return not node or node.isBlack() class Node: def __init__(self, color, key, left=None, right=None): self.color = color self.key = key self.left = left self.right = right def __str__(self): return str(self.key) __repr__ = __str__ def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def child_direction(self, child): assert(child is not None) if self.left is child: return 'left' elif self.right is child: return 'right' else: assert(False) def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) def with_replaced_child(self, replacement, child): assert(child is not None) if self.left is child: return self.copy(left=replacement) elif self.right is child: return self.copy(right=replacement) else: assert(False) def replace_child(self, replacement, child): assert(child is not None) if self.left is child: self.left = replacement return replacement elif self.right is child: self.right = replacement return replacement else: assert(False) def other(self, direction): return self.child(other(direction)) def sexp(self): def sexp(node): if node: return node.sexp() else: return '_' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {sexp(self.left)}, {sexp(self.right)})" def copy(self, key=UNCHANGED, color=UNCHANGED, left=UNCHANGED, right=UNCHANGED): new = Node(self.color, self.key, self.left, self.right) if key is not UNCHANGED: new.key = key if color is not UNCHANGED: new.color = color if left is not UNCHANGED: new.left = left if right is not UNCHANGED: new.right = right return new def left_rotate(self): y = self.right return y.copy(left=self.copy(right=y.left)) def right_rotate(self): x = self.left return x.copy(right=self.copy(left=x.right)) def rotate(self, direction): if direction == 'left': return self.left_rotate() elif direction == 'right': return self.right_rotate() else: assert(False) # Returns the minimal node and the chain of ancestors that was traversed in # order to find it def minimum_with_ancestors(self): node = self ancestors = [] while node.left: ancestors.append(node) node = node.left return (node, ancestors) # Replaces a node at the bottom of an ancestor chains, and creates a new version # of the chain where each parent is copied and updated to point to a newly # created child. # # The final parent in `ancestors` should have `replaced` as a child. It creates # a copy of the parent, replacing the child with `inserted` and then proceeds up # the chain, updating every ancestor. # # At the end, it returns a new ancestor chain, where each node is a copy of the # original, with an updated child. def update_ancestor_chain(inserted, replaced, ancestors): ancestors = ancestors[:] result = [inserted] while ancestors: ancestor = ancestors.pop() inserted = ancestor.with_replaced_child(inserted, replaced) result.append(inserted) replaced = ancestor result.reverse() return result class Tree: def __init__(self, root=None): self.root = root def __str__(self): if self.root: return self.root.sexp() else: return "NIL" __repr__ = __str__ def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def black_heights(self): if not self.root: return {0} heights = set() left = deque() if self.root: left.append((self.root, 0)) while left: (node, height) = left.popleft() if node.isBlack(): height += 1 if node.left: left.append((node.left, height)) else: heights.add(height + 1) if node.right: left.append((node.right, height)) else: heights.add(height + 1) return heights def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, key): new = Node(Color.RED, key) parent = None current = self.root ancestors = [] while current: parent = current ancestors.append(parent) if new.key < current.key: current = current.left else: current = current.right if ancestors: ancestors.pop() if not parent: return Tree(root=new.copy(color=Color.BLACK)) elif new.key < parent.key: ancestors = update_ancestor_chain(parent.copy(left=new), parent, ancestors) else: ancestors = update_ancestor_chain(parent.copy(right=new), parent, ancestors) root = self.insert_fixup(new, ancestors) return Tree(root=root) def insert_fixup(self, current, ancestors): root = ancestors[0] while ancestors and ancestors[-1].isRed(): parent = ancestors[-1] direction = ancestors[-2].child_direction(parent) grandfather = ancestors[-2] uncle = grandfather.other(direction) if uncle and uncle.isRed(): parent.color = Color.BLACK grandfather.color = Color.RED grandfather.set_child(other(direction), uncle.copy(color=Color.BLACK)) current = grandfather ancestors.pop() ancestors.pop() else: if current is parent.other(direction): parent = parent.rotate(direction) grandfather.set_child(direction, parent) ancestors[-1] = parent current = parent.child(direction) parent.color = Color.BLACK grandfather.color = Color.RED grandgrandfather = ancestors[-3] if len(ancestors) >= 3 else None parent = grandfather.rotate(other(direction)) if not grandgrandfather: root = parent else: grandgrandfather.replace_child(parent, grandfather) break root.color = Color.BLACK return root def search_with_ancestors(self, key): node = self.root ancestors = [] while node: if key == node.key: return (node, ancestors) elif key < node.key: ancestors.append(node) node = node.left else: ancestors.append(node) node = node.right return (None, None) def delete(self, key): deleted, ancestors = self.search_with_ancestors(key) original_color = deleted.color if not deleted.left and not deleted.right: ancestors = update_ancestor_chain(None, deleted, ancestors) elif not deleted.left: ancestors = update_ancestor_chain(deleted.right.copy(), deleted, ancestors) elif not deleted.right: ancestors = update_ancestor_chain(deleted.left.copy(), deleted, ancestors) else: moved, moved_ancestors = deleted.right.minimum_with_ancestors() original_color = moved.color extra_black = moved.right.copy() if moved.right else None span = [] if moved_ancestors: span = update_ancestor_chain(extra_black, moved, moved_ancestors) moved = moved.copy(right=span[0]) span.pop() elif moved.right: moved = moved.copy(right=extra_black) ancestors = update_ancestor_chain( moved.copy(left=deleted.left, color=deleted.color), deleted, ancestors ) ancestors += span ancestors.append(extra_black) root = ancestors[0] if original_color == Color.BLACK: root = self.delete_fixup(ancestors) return Tree(root=root) def delete_fixup(self, ancestors): ancestors = ancestors[:] node = ancestors.pop() def replace_top(new_top): old_top = ancestors.pop() if ancestors: ancestors[-1].replace_child(new_top, old_top) ancestors.append(new_top) while ancestors and isBlackOrNil(node): if node: direction = ancestors[-1].child_direction(node) elif ancestors[-1].left: direction = 'right' else: direction = 'left' sibling = ancestors[-1].other(direction) if sibling and sibling.isRed(): new_top = ancestors[-1].rotate(direction) new_top.color = Color.BLACK new_top.child(direction).color = Color.RED replace_top(new_top) ancestors.append(new_top.child(direction)) node = new_top.child(direction).child(direction) sibling = new_top.child(direction).other(direction) if isBlackOrNil(sibling.left) and isBlackOrNil(sibling.right): ancestors[-1].replace_child(sibling.copy(color=Color.RED), sibling) node = ancestors.pop() else: if isBlackOrNil(sibling.other(direction)): new_sibling = sibling.rotate(other(direction)) new_sibling.color = Color.BLACK new_sibling.other(direction).color = Color.RED ancestors[-1].replace_child(new_sibling, sibling) sibling = new_sibling new_top = ancestors[-1].rotate(direction) new_top.color = ancestors[-1].color new_top.child(direction).color = Color.BLACK new_top.replace_child(new_top.other(direction).copy(color=Color.BLACK), new_top.other(direction)) node = None replace_top(new_top) break if node: node.color = Color.BLACK return ancestors[0] if ancestors else node ================================================ FILE: other/clrs/13/problems/01.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '01.py') exec(open(filename).read()) def Red(key, left=None, right=None): return Node(key=key, left=left, right=right, color=Color.RED) def Black(key, left=None, right=None): return Node(key=key, left=left, right=right, color=Color.BLACK) class RedBlackTest(unittest.TestCase): def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertDoesNotContain(self, tree, numbers): for n in numbers: self.assertIsNone(tree.search(n), f"should not contain {n}") def assertInAndOut(self, tree, included, excluded): self.assertContains(tree, included) self.assertDoesNotContain(tree, excluded) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if n.isRed(): if n.left: self.assertEqual(n.left.color, Color.BLACK) if n.right: self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(tree.black_heights()), 1) if tree.root: self.assertEqual(tree.root.color, Color.BLACK) def test_simple_insertion(self): tree = Tree() tree = tree.insert(4) tree = tree.insert(3) tree = tree.insert(5) modified = tree.insert(1) self.assertIsNotNone(modified.search(1)) self.assertIsNotNone(modified.search(4)) self.assertIsNotNone(modified.search(3)) self.assertIsNotNone(modified.search(5)) self.assertIsNone(tree.search(1)) self.assertIsNotNone(tree.search(4)) self.assertIsNotNone(tree.search(3)) self.assertIsNotNone(tree.search(5)) def test_exercise_insertion_properties(self): tree = Tree() tree = tree.insert(41) tree = tree.insert(38) tree = tree.insert(31) tree = tree.insert(12) tree = tree.insert(19) tree = tree.insert(8) self.assertProperties(tree) def test_insertions(self): numbers = self.generate(300, 100) sequences = [] missing = [] trees = [] sofar = [] tree = Tree() for n in numbers: sofar.append(n) sequences.append(sofar[:]) missing.append(list(set(numbers) - set(sofar))) tree = tree.insert(n) trees.append(tree) for (tree, included, excluded) in zip(trees, sequences, missing): self.assertContains(tree, included) self.assertDoesNotContain(tree, excluded) self.assertProperties(tree) nodes = [] for tree in trees: nodes += tree.nodes() self.assertTrue(len(set(nodes)) < len(nodes)) def test_delete_empty(self): tree = Tree() tree = tree.insert(1) tree = tree.delete(1) def test_exercise_deletion_properties(self): tree = Tree() tree = tree.insert(41) tree = tree.insert(38) tree = tree.insert(31) tree = tree.insert(12) tree = tree.insert(19) tree = tree.insert(8) first = tree.delete(8) second = first.delete(12) third = second.delete(19) fourth = third.delete(31) fifth = fourth.delete(38) self.assertInAndOut(first, [12, 19, 31, 38, 41], [8]) self.assertInAndOut(second, [19, 31, 38, 41], [8, 12]) self.assertInAndOut(third, [31, 38, 41], [8, 12, 19]) self.assertInAndOut(fourth, [38, 41], [8, 12, 19, 31]) self.assertInAndOut(fifth, [41], [8, 12, 19, 31, 38]) def test_delete_fixup_case_1(self): subtree = Red("B", left=Black("A"), right=Red("D", left=Black("C"), right=Black("E"))) tree = Tree(root=subtree) top = tree.delete_fixup([tree.root, tree.root.left]) self.assertEqual(top.key, "D") self.assertEqual(top.left.key, "B") self.assertEqual(top.left.left.key, "A") self.assertEqual(top.left.right.key, "C") self.assertEqual(top.right.key, "E") def test_delete_fixup_case_2(self): subtree = Red("B", left=Black("A"), right=Black("D", left=Black("C"), right=Black("E"))) tree = Tree(root=subtree) top = tree.delete_fixup([tree.root, tree.root.left]) self.assertEqual(top.key, "B") self.assertEqual(top.left.key, "A") self.assertEqual(top.right.key, "D") self.assertEqual(top.right.left.key, "C") self.assertEqual(top.right.right.key, "E") def test_delete_fixup_case_3(self): subtree = Red("B", left=Black("A"), right=Black("D", left=Red("C"), right=Black("E"))) tree = Tree(root=subtree) top = tree.delete_fixup([tree.root, tree.root.left]) self.assertEqual(top.key, "C") self.assertEqual(top.left.key, "B") self.assertEqual(top.left.left.key, "A") self.assertEqual(top.right.key, "D") self.assertEqual(top.right.right.key, "E") def test_delete_fixup_case_4(self): subtree = Red("B", left=Black("A"), right=Black("D", left=Red("C"), right=Red("E"))) tree = Tree(root=subtree) new_root = tree.delete_fixup([tree.root, tree.root.left]) top = new_root self.assertEqual(top.key, "D") self.assertEqual(top.color, Color.RED) self.assertEqual(top.left.key, "B") self.assertEqual(top.left.color, Color.BLACK) self.assertEqual(top.left.left.key, "A") self.assertEqual(top.left.left.color, Color.BLACK) self.assertEqual(top.left.right.key, "C") self.assertEqual(top.left.right.color, Color.RED) self.assertEqual(top.right.key, "E") self.assertEqual(top.right.color, Color.BLACK) def test_deletion(self): numbers = self.generate(300, 100) removed = numbers[:] tree = Tree() for n in numbers: tree = tree.insert(n) trees = [] ins = [] outs = [] k = 100 random.shuffle(numbers) removed = [] for _ in range(k): n = numbers.pop() removed.append(n) tree = tree.delete(n) self.assertProperties(tree) ins.append(numbers[:]) outs.append(removed[:]) trees.append(tree) for (tree, included, excluded) in zip(trees, ins, outs): self.assertInAndOut(tree, included, excluded) self.assertProperties(tree) nodes = [] for tree in trees: nodes += tree.nodes() self.assertTrue(len(set(nodes)) < len(nodes)) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/13/problems/02.markdown ================================================ ## Join operation on red-black trees > The **join** operation takes two dynamic sets $S_1$ and $S_2$ and an element > $x$ such that any $x_1 \in S_1$ and $x_2 \in S_2$, we have $x_1.key \le x.key > \le x_2.key$. It returns a set $S = S_1 \cup \\{x\\} \cup S_2$. In this > problem, we investigate how to implement the join operation on red-black > trees. > >
      >
    1. Given a red-black tree $T$, let us store its black-height as the new > attribute $T.bh$. Argue that RB-INSERT and > RB-DELETE can maintain the $bh$ attribute without requiring > extra storage in the nodes of the tree and without increasing the asymptotic > running times. Show that while descending through $T$, we can determine the > black-heigh of each node we visit in $\O(1)$ time per node visited. >
    > > We wish to implement the operation $\text{RB-JOIN}(T_1, x, T_2)$, which > destroys $T_1$ and $T_2$ and returns a red-black tree $T = T_1 \cup \\{x\\} > \cup T_2$. Let $n$ be the total number of nodes in $T_1$ and $T_2$. > >
      >
    1. Assume that $T_1.bh \ge T_2.bh$. Describe an $\O(\lg n)$-time algorithm > that finds a black node $y$ in $T_1$ with the largest key from among those > nodes whose black height is $T_2.bh$. >
    2. Let $T_y$ be the subtree rooted at $y$. Describe how $T_y \cup \\{x\\} > T_2$ can replace $T_y$ in $\O(1)$ time without destroying the binary search > tree property. >
    3. What color should we make $x$ so that red-black properties 1, 3, and 5 > are maintained? Describe how to enforce properties 2 and 4 in $\O(\lg n)$ > time. >
    4. Argue that no generality is lost by making the assumption in part (b). > Describe the symmetric situation that arises when $T_1.bh \le T_2.bh$. >
    5. Argue that the running time of RB-JOIN is $\O(\lg n)$. >
    ### a. Maintaining black height in constant time Technically speaking, whenever we perform the fixup operations, we can keep track of the colors we change in the path we've modified, and rely on that to know whether we have to increment or decrement the black height. But it seems to me, that there is a simpler heuristic, that I'm going to just guess here, without proving. Specifically, whenever the black height changes, it is somehow reflected in the second and third layer of the tree. When inserting, the way the black height increases is by coloring the root red (while preserving the properties with `RB-INSERT-FIXUP`) and then finally coloring it black. This is the only operation that increases the black height by one. Similarly, when deleting, the extra-black pointer eventually finds itself to the root, and that's how the black heigh gets decreased. I may be missing some cases here, but fundamentally - both left and right subtrees of the root need to lose or gain a unit of black height in order for the tree to do so as well, hence we can figure it out by observing what happens around the root. ### b. Finding a black node with the largest key with a specific black-height Quite simply, we start from the root and go right, setting $c = T.bh$. Every time we go through a black node, we decrement $c$ until we reach the $T_2.bh$. Once we do, we have the node in question. ### c. Replacing $T_y$ Quite simply, we replace the node with $x$, and we put $T_y$ as its left child, and $T_2$ as it's right child. The binary search tree invariant is preserved, as we have that $x.key$ is smaller than the keys in $T_2$ and larger than the ones in $T_1$. ### d. What color should we make $x$? We should make it red. This preserves properties 1, 3 and 5. Two problems can occur now. Either it's the new root, and it's red, in which case we can color it black and be done with it, or it can have a red parent (its left child is black, because we found a black node for $T_y$ and its right child is also black, because it's $T_2$, and the root of $T_2$ is black). We then simply need to call `RB-INSERT-FIXUP` to fix the two subsequent red nodes. ### e. Generality Pretty trivially, if $T_2$ has the greater black height, we need to find the node with the smallest key of a given black height, replace it with $x$ and put $T_1$ as it's left child. The approach is symmetrical. ### f. Running time The operation does the following: 1. Descends one of the trees to find $T_y$, and does so in $\O(\lg n)$ time. 2. Replaces it with $x$ and transplants $T_y$ and $T_2$ under it, in $\O(1)$ time. 3. Runs `RB-INSERT-FIXUP`, which takes $\O(\lg n)$ time. We get $\O(\lg n) + \O(1) + \O(\lg n) = \O(\lg n)$. ================================================ FILE: other/clrs/13/problems/03.markdown ================================================ ## AVL Trees > An **AVL tree** is a binary search tree that is **heigh balanced**: for each > node $x$, the heights of the left and right subtrees of $x$ differ by at most > 1. To implement an AVL tree, we maintain an extra attribute in each node: > $x.h$ is the height of node $x$. As for any other binary search tree $T$, we > assume that $T.root$ points to the root node. > >
      >
    1. Prove that an AVL tree with $n$ nodes has height $\O(\lg n)$. > (Hint: Prove that an AVL tree of height $h$ has at least $F_h$ nodes, > where $F_h$ is the $h$th Fibonacci number.) >
    2. To insert into an AVL tree, we first place a node into the appropriate > place in binary search tree order. Afterward, the tree might no longer be > height balanced. Specifically, the heights of the left and right children of > some node might differ by 2. Describe a procedure BALANCE(x), > which takes a subtree rooted at $x$ whose left and right children are height > balanced and have height that differ by at most 2, i.e. $|x.right.h - > x.left.h| \le 2$, and alters the subtree rooted at $x$ to be height > balanced. (Hint: Use rotations). >
    3. Using part (b), describe a recursive procedure AVL-INSERT(x, > z) that takes a node $x$ within an AVL tree and a newly created node > $z$ (whose key has already been filled in), and adds $z$ to the subtree > rooted at $x$, maintaining the property that $x$ is the root of an AVL tree. > As in TREE-INSERT from Section 12.3, assume that $z.key$ has > already been filled in and that $z.left = \mathrm{NIL}$ and $z.right = > \mathrm{NIL}$; also assume that $z.h = 0$. Thus, to insert the node $z$ into > the AVL tree $T$, we call AVL-INSERT(T.root, z). >
    4. Show that AVL-INSERT, run on an $n$-node AVL tree, takes > $\O(\lg n)$ time and performs $\O(1)$ rotations. >
    ### a. number of nodes and height Let $N_h$ be a lower bound of the number of nodes in an AVL tree with height $h$. When $h = 1$, we have that $N_1 = 1$ (there is a single root node in the tree). Let's also have $N_0 = 0$. Let's look at $N_h$ more generally. We know two facts: * The taller subtree will have height $h - 1$ (otherwise we're not calculating heights correctly). * The other subtree will have height at least $h - 2$ (otherwise the AVL invariant will be broken). This yields the following recurrence: $$ N_h \ge N_{h-1} + N_{h-2} $$ This is the well-known Fibonnaci sequence. This means, that if a tree has height $h$, then it will have at least $F_h$ nodes. Now let's use this fact to establish a bound on a tree with $n$ nodes. Let's find an $i$ such that $F_i \le n < F_{i+1}$. We know the height of the tree must be less than $i + 1$, otherwise the tree would have at least $F_{i+1} > n$ nodes. Since $F_i = \Theta(\phi^i)$, we have: $$ n = \Theta(\phi^h) $$ And taking the logarithm of both sides (and skipping some formal rigour): $$ h = \Theta(\lg n) $$ ### b. balance procedure Refer to the Python code below for some details. Here's a high-level summary. There are four different cases in which we need to perform rotations when the tree is not balanced: (A) 3 (B) 3 (C) 1 (D) 1 / / \ \ 2 1 2 3 / \ \ / 1 2 3 2 The later two are symmetrical to the former two. In both cases, the bottom node is the inserted one, and the top node is the one with the inbalance (height = 2 in one subtree, and height = 0 in the other). We need to perform one or two rotations in order to get a balanced tree. * **(A)** Performing a right rotation on the root is enough to balance the tree * **(B)** We need to perform a left-right rotation, that is, we need to rotate the middle node left, which reduced the tree to the one in (A), and then perform a left rotation * **(C)** Symmetrically, we just perform a right left rotation * **(D)** In a similar fashion, we perform a right-left rotation Note that once we make the rotation, the height of the taller subtree gets reduced by one, and the height of the shorter gets increased by one. This leaves the root of the subtree with an unchanged height. Since the root's height remains unchanged, the rest of the tree won't need any additional rotations. ### c. the `AVL-INSERT` procedure We insert a node in the standard way, and then we traverse the ancestors, updating the heights, until we find a imbalance. Then we perform one or two rebalancing rotations, and the tree is once again balanced. Refer to the Python code for more detail. ### d. Running time Insertion needs to * descend through the tree, to find where to insert the node, in $\O(\lg n)$ time; * go back the ancestors, and update the heights, in $\O(\lg n)$ time; * perform a one or two balancing rotations if it encounters an imbalance, in $\O(1) time ================================================ FILE: other/clrs/13/problems/03.py ================================================ from collections import deque class Node: def __init__(self, key, height=-1, left=None, right=None): self.key = key self.height = height self.left = left self.right = right def __str__(self): def dump(node): if not node: return "NIL" else: return f"/{node.height}/({node.key}, {dump(node.left)}, {dump(node.right)})" return dump(self) def left_rotate(self): child = self.right assert(child) self.right = child.left child.left = self self.height = 1 + max(height(self.left), height(self.right)) child.height = 1 + max(height(child.left), height(child.right)) return child def right_rotate(self): child = self.left assert(child) self.left = child.right child.right = self self.height = 1 + max(height(self.left), height(self.right)) child.height = 1 + max(height(child.left), height(child.right)) return child __repr__ = __str__ def height(node): return node.height if node else 0 class AVL: def __init__(self): self.root = None def __str__(self): if not self.root: return "NIL" else: return str(self.root) __repr__ = __str__ def nodes(self): if not self.root: return remaining = deque() remaining.append(self.root) while remaining: node = remaining.popleft() if node.left: remaining.append(node.left) if node.right: remaining.append(node.right) yield node def insert(self, key): def insert_node(subtree, node): if not subtree: return node elif node.key < subtree.key: subtree.left = insert_node(subtree.left, node) else: subtree.right = insert_node(subtree.right, node) subtree.height = 1 + max(height(subtree.left), height(subtree.right)) balance = height(subtree.left) - height(subtree.right) if balance < -1: if key < subtree.right.key: subtree.right = subtree.right.right_rotate() return subtree.left_rotate() elif balance > 1: if key > subtree.left.key: subtree.left = subtree.left.left_rotate() return subtree.right_rotate() else: return subtree new = Node(key, height=1) self.root = insert_node(self.root, new) def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None ================================================ FILE: other/clrs/13/problems/03.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '03.py') exec(open(filename).read()) class AVLTreeTest(unittest.TestCase): def assertBinarySearchTreeProperties(self, tree): for node in tree.nodes(): if node.left: self.assertTrue(node.left.key < node.key) if node.right: self.assertTrue(node.right.key > node.key) def assertAVLProperties(self, tree): def calculated_height(node): return node.calculated_height if node else 0 def height(node): return node.height if node else 0 def calculate_height(node): if node.left: calculate_height(node.left) if node.right: calculate_height(node.right) node.calculated_height = 1 + max(calculated_height(node.left), calculated_height(node.right)) calculate_height(tree.root) for node in tree.nodes(): self.assertEqual(node.height, node.calculated_height) self.assertTrue(abs(height(node.left) - height(node.right)) <= 1) def testInsertionWithLeftRotation(self): tree = AVL() tree.insert(1) tree.insert(2) tree.insert(3) self.assertEqual(tree.root.height, 2) self.assertEqual(tree.root.key, 2) self.assertAVLProperties(tree) def testInsertionWithLeftRightRotation(self): tree = AVL() tree.insert(1) tree.insert(3) tree.insert(2) self.assertEqual(tree.root.height, 2) self.assertEqual(tree.root.key, 2) self.assertAVLProperties(tree) def testInsertionWithRightRotation(self): tree = AVL() tree.insert(3) tree.insert(2) tree.insert(1) self.assertEqual(tree.root.height, 2) self.assertEqual(tree.root.key, 2) self.assertAVLProperties(tree) def testInsertionWithRightLeftRotation(self): tree = AVL() tree.insert(3) tree.insert(1) tree.insert(2) self.assertEqual(tree.root.height, 2) self.assertEqual(tree.root.key, 2) self.assertAVLProperties(tree) def testInsertion(self): tree = AVL() tree.insert(1) tree.insert(3) tree.insert(5) tree.insert(7) tree.insert(6) tree.insert(4) tree.insert(2) tree.insert(8) tree.insert(9) for i in range(1, 10): self.assertIsNotNone(tree.search(i)) self.assertIsNone(tree.search(0)) self.assertBinarySearchTreeProperties(tree) self.assertAVLProperties(tree) def testRandomInsertion(self): numbers = list(range(0, 500)) random.shuffle(numbers) numbers = numbers[:250] tree = AVL() for i in numbers: tree.insert(i) for i in numbers: self.assertIsNotNone(tree.search(i)) self.assertBinarySearchTreeProperties(tree) self.assertAVLProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/13/problems/04.markdown ================================================ ## Treaps > If we insert a set of $n$ items into a binary search tree, the resulting tree > may be horribly unbalanced, leading to long search times. As we saw in Section > 12.4, however, randomly built binary search trees tend to be balanced. > Therefore, one strategy that, on average, builds a balanced tree for a fixed > set of items would be to randomly permute the items and then insert them in > that order into the tree. > > What if we do not have all the items at once? If we receive the items one at a > time, can we still randomly build a binary search tree out of them? > > We will examine a data structure that answers this question in the > affirmative. A **treap** is a binary search tree with a modified way of > ordering the nodes. Figure 13.9 shows an example. As usual, each node $x$ in > the tree has a key value $x.key$. In addition, we assign $x.priority$, which > is a random number chosen independently for each node. The nodes of the treap > are ordered so that the keys obey the binary-search-tree property and the > priorities obey the min-heap property: > > * If $v$ is a left child of $u$, then $v.key < u.key$. > * If $v$ is a right child of $u$, then $v.key > u.key$. > * If $v$ is a child of $u$, then $v.priority > u.priority$. > > (This combination of properties is why the tree is called a "treap": it has > features of both a binary search tree and a heap.) > > It helps to think of treaps in the following way. Suppose that we insert nodes > $x_1, x_2, \ldots, x_n$, with associated keys, into a treap. Then the > resulting treap is the tree that would have been formed if the nodes had been > inserted into a normal binary search tree in the order given by their > (randomly chosen) priorities, i.e., $x_i.priority < x_j.priority$ means that > we had inserted $x_i$ before $x_j$. > >
      >
    1. Show that given a set of nodes $x_1, x_2, \ldots, x_n$, with associated > keys and priorities, all distinct, the treap associated with these nodes is > unique. >
    2. Show that the expected height of a treap is $\Theta(\lg n)$, and hence > the expected time to search for a value in the treap is $\Theta(\lg n)$. >
    > > Let use see how to insert a new node into an existing treap. The first thing > we do is assign the new node a random priority. Then we call the insertion > algorithm, which we call `TREAP-INSERT`, whose operation is illustrated in > Figure 13.10. > >
      >
    1. Explain how TREAP-INSERT works. Explan the idea in English > and give pseudocode. (Hint: Execute the usual binary-search-tree > insertion procedure and them perform rotations to restore the min-heap order > property.) >
    2. Show that the expected running time of TREAP-INSERT is > $\Theta(\lg n)$. >
    > > `TREAP-INSERT` performs a search and then a sequence of rotations. Although > these two operations have the same expected running time, they have different > costs in practice. A search reads information from the treap without modifying > it. In contrast, a rotation changes parent and child pointers within the > treap. On most computers, read operations are much faster than write > operations. Thus we would like `TREAP-INSERT` to perform few rotations. We > will show that the expected number of rotations performed is bounded by a > constant. > > In order to do so, we will need some definitions, which Figure 13.11 depicts. > The **left spine** of a binary search tree $T$ is the simple path from the > root to the node with the smallest key. In other words, the left spine is the > simple path from the root that consists of only left edges. Symmetrically, the > **right spine** of $T$ is the simple path from the root consisting of only > right edges. The **length** of a spine is the number of nodes it contains. > >
      >
    1. Consider the treap $T$ immediately after TREAP-INSERT has > inserted node $x$. Let $C$ be the length of the right spine of the left > subtree of $x$. Let $D$ be the length of the left spine of the right subtree > of $x$. Prove that the total number of rotations that were performed during > the insertion of $x$ is equal to $C + D$. >
    > > We will now calculate the expected values for $C$ and $D$. Without loss of > generality, we assume that the keys are $1, 2, \ldots, n$, since we are > comparing them only to one another. > > For nodes $x$ and $y$ in treap $T$, where $y \ne x$, let $k = x.key$ and $i = > y.key$. We define indicator random variables: > > $$ X_{ik} = I\\{y \text{ is in the right spine of the left subtree of } x\\} $$ > >
      >
    1. Show that $X_{ik} = 1$ if and only if $y.priority > x.priority$, $y.key > < x.key$, and, for every $z$ such that $y.key < z.key < x.key$, we have > $y.priority < z.priority$. >
    2. Show that > $$ > \begin{aligned} > \Pr\{X_{ik} = 1\} &= \frac{(k - i - 1)!}{(k - i + 1)!} \\\\ > &= \frac{1}{(k - i + 1)(k - i)} > \end{aligned} > $$ >
    3. Show that > $$ \E[C] = \sum_{j=1}^{k-1} \frac{1}{j(j + 1)} = 1 - \frac{1}{k} $$ >
    4. Use a symmetry argument to show that > $$ \E[D] = 1 - \frac{1}{n - k + 1} $$ >
    5. Conclude that the expected number of rotations performed when inserting > a node into a treap is less than 2. >
    ### a. unique treaps If we take any tree elements, and attempt to arrange them in a treap * their priorities will determine which element is the root (the one with the smallest priority), and * their keys will determine whether they are the left or right child of their parent Or to put it another way: 1. the element with the lowest priority will be the root 2. the elements with smaller keys will be in the left subtree 3. the elements with larger keys will be in the right subtree 4. there is only one unique way to pick the root, and the elements of each subtree 5. this argument can be applied recursively for each subtree ### b. expected height Taking the easy way out, we already know from the text that the expected height of a randomly built search tree is $\Theta(\lg n)$. The argument from Chapter 12.4 applies here full force. ### c. explain `TREAP-INSERT` It first inserts the node in the tree by finding a leaf position to put it in. After that, it compares the priority with that of the parent. If it's higher, we're done. If it's lower, we need to perform a rotation to put the newly inserted element in the place of the parent and then continue with the rest of the ancestors. Instead of pseudocode, there is a Python implementation below. ### d. expected running time The algorithm is linear to the height of the tree (it performs at most a single rotation for each ancestor), which is $\Theta(\lg n)$. ### e. number of rotations after insertion Let $l$ be the right spine of the left subtree and $r$ be the left spine of the right subtree. Observe that: 1. Both $l$ and $r$ start with zero elements. 2. Each rotation add a single element to $r$ and $l$. Specifically, left rotations increase $l$ with one element (the parent) and right rotations increase $r$ with one element (the parent) ### f. when is a node in the right spine of the left subtree Necessity: If $y$ is in the right spine of the left subtree of $x$, then: * $y$ needs to have a smaller key, that is $y.key < x.key$ * $y$ needs to have a larger priority, that is $y.priority > x.priority$ * all the elements on the spine are smaller than it, (otherwise it won't be on a right spine), and if there are larger elements than $y$ but smaller than $x$, they need to have larger priority than $y$, otherwise one of them would be its parent, and $y$ would be a left child, thus not on the right spine Sufficiency: If the following tree conditions hold: 1. $y.priority > x.priority$ 2. $y.key < x.key$ 3. for every $z$ such that $y.key < z.key < x.key$: $y.priority < z.priority$ We know that $y$ is in the left subtree of $x$ (because of (1) and (2)), and all it's ancestors up until $x$ are smaller than it (because of (3)), and therefore it is the right child of its parent, which is the right child of its parent, and so on. ### g. probability of $X_{ik} = 1$ We leverage the knowledge of the previous point, and then we apply some counting. We already know that $i < k$, but there may be some elements between $i$ and $k$. From (f) we know that (1) their priority needs to be larger than that of either $x$ or $y$, and that $x$ have to have the smaller priority than $y$. There are in total $k - i + 1$ elements to consider. We can model the probability of their priority by arranging them in order from the smallest to the largest priority. There are thus $(k - i + 1)!$ possible ways to arrange the priorities (this is the denominator). For the ones that satisfy the conditions in (f), we are looking for $x$ being the first, $y$ being the second, and $(k - i - 1)!$ possible ways to arrange the rest (the numerator). ### h. expectation of $C$ So, the expectation $\E[C]$ is $X_{12} + X_{13} + \ldots + X_{k-1,k}$, that is: $$ \begin{aligned} \E[C] &= \sum_{i=1}^{k-1} \frac{1}{(k - i + 1)(k - i)} \\\\ &= \sum_{j=1}^{k-1} \frac{1}{j(j+1)} && \text{(let } j = k - i \text{)} \\\\ &= \sum_{j=1}^{k-1} \left( \frac{1}{j(j+1)} - \frac{j}{j(j+1)} + \frac{j}{j(j+1)} \right) \\\\ &= \sum_{j=1}^{k-1} \left( \frac{j + 1}{j(j+1)} - \frac{j}{j(j+1)} \right) \\\\ &= \sum_{j=1}^{k-1} \left( \frac{1}{j} - \frac{1}{j+1} \right) \\\\ &= \sum_{j=1}^{k-1} \frac{1}{j} - \sum_{j=1}^{k-1} \frac{1}{j+1} \\\\ &= 1 + \sum_{j=2}^{k-1} \frac{1}{j} - \sum_{j=1}^{k-2} \frac{1}{j+1} - \frac{1}{k - 1 + 1} && \text{(by taking one element out each sum)} \\\\ &= 1 + \sum_{j=2}^{k-1} \frac{1}{j} - \sum_{j=2}^{k-1} \frac{1}{j} - \frac{1}{k} && \text{(by letting } j = j + 1 \text{ in the second sum)} \\\\ &= 1 - \frac{1}{k} && \text{(by letting the sums cancel each other out)} \end{aligned} $$ ### i. symmetry for $\E[D]$ The same approach holds here, symmetrically. The only thing we need to consider, is that instead of looking at $1, 2, \ldots, k$, we have to look at $k, k + 1, \ldots, n$. There are $n - k + 1$ elements in that sequence, and if we apply the same math, we get the expectation: $$ \E[D] = 1 - \frac{1}{n - k + 1} $$ ### j. conclusion The expected number of rotations, is then: $$ \E[C + D] = \E[C] + \E[D] = 1 - \frac{1}{k} + 1 - \frac{1}{n - k - 1} < 2 = \O(1) $$ ================================================ FILE: other/clrs/13/problems/04.py ================================================ from collections import deque class Node: def __init__(self, key, priority, left=None, right=None): self.key = key self.priority = priority self.left = left self.right = right def __str__(self): def dump(node): if not node: return "NIL" else: return f"{node.key}:{node.priority}({dump(node.left)}, {dump(node.right)})" return dump(self) def left_rotate(self): child = self.right assert(child) self.right = child.left child.left = self return child def right_rotate(self): child = self.left assert(child) self.left = child.right child.right = self return child __repr__ = __str__ class Treap: def __init__(self): self.root = None def __str__(self): if not self.root: return "NIL" else: return str(self.root) __repr__ = __str__ def nodes(self): if not self.root: return remaining = deque() remaining.append(self.root) while remaining: node = remaining.popleft() if node.left: remaining.append(node.left) if node.right: remaining.append(node.right) yield node def insert(self, key, priority=None): def insert_node(subtree, node): if not subtree: return node elif node.key < subtree.key: subtree.left = insert_node(subtree.left, node) if subtree.priority > subtree.left.priority: subtree = subtree.right_rotate() return subtree else: subtree.right = insert_node(subtree.right, node) if subtree.priority > subtree.right.priority: subtree = subtree.left_rotate() return subtree new = Node(key, priority=priority) self.root = insert_node(self.root, new) def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None ================================================ FILE: other/clrs/13/problems/04.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '04.py') exec(open(filename).read()) class TreapTest(unittest.TestCase): def assertBinarySearchTreeProperties(self, tree): for node in tree.nodes(): if node.left: self.assertTrue(node.left.key < node.key) if node.right: self.assertTrue(node.right.key > node.key) def assertTreapProperties(self, treap): for node in treap.nodes(): if node.left: self.assertTrue(node.priority < node.left.priority) if node.right: self.assertTrue(node.priority < node.right.priority) def testInsertion(self): treap = Treap() treap.insert('B', priority=7) treap.insert('H', priority=5) treap.insert('G', priority=4) self.assertIsNotNone(treap.search('B')) self.assertIsNotNone(treap.search('H')) self.assertIsNotNone(treap.search('G')) def testSameTreapWithExample(self): nodes = [ ('G', 4), ('B', 7), ('A', 10), ('E', 23), ('H', 5), ('K', 65), ('I', 73), ('C', 25), ('D', 9), ('F', 2) ] def make_treap(nodes): treap = Treap() for (key, priority) in nodes: treap.insert(key, priority=priority) return treap treap = make_treap(nodes) first = str(treap) for _ in range(100): random.shuffle(nodes) another = str(make_treap(nodes)) self.assertEqual(first, another) def testRandomTreap(self): k = 300 elements = list(range(k)) priorities = list(range(k)) random.shuffle(elements) random.shuffle(priorities) treap = Treap() for (key, priority) in zip(elements, priorities): treap.insert(key, priority=priority) for n in elements: self.assertIsNotNone(treap.search(n)) self.assertBinarySearchTreeProperties(treap) self.assertTreapProperties(treap) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/01/01.markdown ================================================ > Show how $\text{OS-SELECT}(T.root, 10)$ operates on the red-black tree $T$ > of Figure 14.1. It does the following: ```plain 1. k = 26; i = 10; r = 13; goes into the elseif in line 5; follows left child 2. k = 17; i = 10; r = 8; goes into the else in line 6; follows right child; 3. k = 21; i = 2; r = 3; goes into the elseif in line 5; follows left child; 4. k = 19; i = 2; r = 1; goes into the else in line 6; follows right child; 5. k = 20; i = 1; r = 1; returns 20 ``` ================================================ FILE: other/clrs/14/01/02.markdown ================================================ > Show how $\text{OS-RANK}(T, x)$ operates on the red-black tree $T$ of Figure > 14.1 and the node $x$ with $x.key = 35$. It does the following: ``` starts with y.key = 35 r = 1 then goes in the while loop: 1. y.key = 35; r = 1; goes up, adds nothing 2. y.key = 38; r = 1; goes up, adds rank of left sibling plus one 3. y.key = 30; r = 3; goes up, adds nothing 4. y.key = 41; r = 3; goes up, adds rank of left sibling plus one 5. y.key = 20; r = 16; returns 16 ``` ================================================ FILE: other/clrs/14/01/03.markdown ================================================ > Write a non-recursive version of `OS-SELECT` Here's the Python code: ```python def select(node, i): while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right ``` Below is the whole thing. ================================================ FILE: other/clrs/14/01/03.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, size): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.size = size def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child child.size = self.size self.size = self.left.size + self.right.size + 1 def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank(self): rank = self.left.size + 1 node = self while node.parent: if node == node.parent.right: rank += node.parent.left.size + 1 node = node.parent return rank nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, 0) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1) parent = nil node = self.root while node: node.size += 1 parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_sizes(node): while node: node.size -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_sizes(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_sizes(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_sizes(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.size = y.left.size + y.right.size + 1 if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/01/03.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '03.py') exec(open(filename).read()) class OrderStatisticTreeTest(unittest.TestCase): def test_rank_when_inserting(self): k = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) for n in range(1, k + 1): self.assertEqual(tree.select(n).key, n) self.assertEqual(tree.search(n).rank(), n) def test_rank_when_deleting(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): i += 1 self.assertEqual(tree.select(i).key, n) self.assertEqual(tree.search(n).rank(), i) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/01/04.markdown ================================================ > Write a recursive procedure `OS-KEY-RANK(T, k)` that takes as input an ordered > statistic tree $T$ and a key $k$ and returns the rank $k$ in the dynamic set > represented by $T$. Assume that the keys of $T$ are distinct. In order for the function to be recursive, $T$ needs to be a pointer to a node, not a tree. Otherwise, it won't be recursive. Here's the python version: ```python def key_rank(node, key): if node.key == key: return node.left.size + 1 elif key < node.key: return node.left.key_rank(key) else: return node.left.size + 1 + node.right.key_rank(key) ``` There is a full version below ================================================ FILE: other/clrs/14/01/04.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, size): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.size = size def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child child.size = self.size self.size = self.left.size + self.right.size + 1 def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank(self): rank = self.left.size + 1 node = self while node.parent: if node == node.parent.right: rank += node.parent.left.size + 1 node = node.parent return rank def key_rank(self, key): if self.key == key: return self.left.size + 1 elif key < self.key: return self.left.key_rank(key) else: return self.left.size + 1 + self.right.key_rank(key) nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, 0) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def key_rank(self, key): return self.root.key_rank(key) def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1) parent = nil node = self.root while node: node.size += 1 parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_sizes(node): while node: node.size -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_sizes(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_sizes(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_sizes(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.size = y.left.size + y.right.size + 1 if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/01/04.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '04.py') exec(open(filename).read()) class OrderStatisticTreeTest(unittest.TestCase): def test_key_rank(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): self.assertEqual(tree.key_rank(n), i + 1) def test_rank_when_inserting(self): k = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) for n in range(1, k + 1): self.assertEqual(tree.select(n).key, n) self.assertEqual(tree.search(n).rank(), n) def test_rank_when_deleting(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): i += 1 self.assertEqual(tree.select(i).key, n) self.assertEqual(tree.search(n).rank(), i) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/01/05.markdown ================================================ > Given an element $x$ in an $n$-node order-statistic tree and a natural number > $i$, how can we determine the $i$th successor of $x$ in the linear order of > the tree in $\O(\lg n)$ time? Here's the code: ```python def nth_successor(node, i): while i > node.right.size: if node.parent.left is node: i -= 1 + node.right.size node = node.parent else: i += 1 + node.left.size node = node.parent if i == 0: return node return node.right.select(i) ``` The code first determines whether the successor is in the right subtree, or whether it's somewhere along the parents. It navigates the tree up until it identifies a node, which contains the $i$-th successor in its right subtree, while updating $i$. Once it identifies one, it uses `SELECT` to find the node with the specific rank. The time is $\O(\lg n)$, because the height of the three is $\O(\lg n)$, and the algorithm traverses that length at most twice – once on the way up, and then once for `SELECT`. ================================================ FILE: other/clrs/14/01/05.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, size): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.size = size def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child child.size = self.size self.size = self.left.size + self.right.size + 1 def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank(self): rank = self.left.size + 1 node = self while node.parent: if node == node.parent.right: rank += node.parent.left.size + 1 node = node.parent return rank def key_rank(self, key): if self.key == key: return self.left.size + 1 elif key < self.key: return self.left.key_rank(key) else: return self.left.size + 1 + self.right.key_rank(key) def nth_successor(self, n): node = self while n > node.right.size: if node.parent.left is node: n -= 1 + node.right.size node = node.parent else: n += 1 + node.left.size node = node.parent if n == 0: return node return node.right.select(n) nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, 0) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def key_rank(self, key): return self.root.key_rank(key) def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1) parent = nil node = self.root while node: node.size += 1 parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_sizes(node): while node: node.size -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_sizes(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_sizes(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_sizes(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.size = y.left.size + y.right.size + 1 if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/01/05.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '05.py') exec(open(filename).read()) class OrderStatisticTreeTest(unittest.TestCase): def test_nth_successor(self): k = 200 m = 100 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): for j in range(i + 1, len(remaining) - i): self.assertEqual(tree.search(n).nth_successor(j).key, remaining[i + j]) def test_key_rank(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): self.assertEqual(tree.key_rank(n), i + 1) def test_rank_when_inserting(self): k = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) for n in range(1, k + 1): self.assertEqual(tree.select(n).key, n) self.assertEqual(tree.search(n).rank(), n) def test_rank_when_deleting(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): i += 1 self.assertEqual(tree.select(i).key, n) self.assertEqual(tree.search(n).rank(), i) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/01/06.markdown ================================================ > Observe that whenever we reference the $size$ attribute of a node in either > `OS-SELECT` or `OS-RANK`, we use it only to compute a rank. Accordingly, > suppose we store in each node its rank in the subtree of which it is the root. > Show how to maintain this information during insertion and deletion. (Remember > that those two operations can cause rotations). First, let's notice that `node.rank = node.left.size + 1`. Since one is actually a function of the other, we can use that to calculate the new rank. We need to: * Update the code doing the rotation, where a slight asymmetry gets introduced. * Update the code that goes down the tree when inserting to change rank accordingly. * Update the rank of the node that gets moved to the deleted position with the rank of the deleted node. * Update the code that goes up the tree when deleting to change rank accordingly. Specifically for rotations, referring to Figure 13.2, notice that: * On a left rotation, the rank of $y$ decreases by the rank of $x$ ($\alpha$ gets removed from $y$'s left subtree) * On a right rotation, the rank of $y$ increases by the rank of $x$ ($\alpha$ gets added to $y$'s left subtree) All the changes can be found in the code below. ================================================ FILE: other/clrs/14/01/06.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, rank=0): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.rank = rank def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, r={self.rank}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child if direction == 'left': child.rank += self.rank else: self.rank -= child.rank def depth(self): n = 0 node = self while node: n += 1 node = node.parent return n def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node.rank != i: if node.rank < i: i -= node.rank node = node.right else: node = node.left return node def rank_in_tree(self): rank = self.rank node = self while node.parent: if node.parent.right is node: rank += node.parent.rank node = node.parent return rank nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, -1) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def display(self): height = max([node.depth() for node in self.nodes()]) w = 7 p = 2 level = 0 nodes = [self.root] while level < height: cells = (height - 1) ** 2 print(" " * ((height - level) * 5), (" " * p).join((f"{node.key:>d} / {node.rank:>d}" if node else " NIL ") for node in nodes)) next_level = [] for node in nodes: next_level += [node.left, node.right] level += 1 nodes = next_level print(f"-- {height} ------") def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1) parent = nil node = self.root while node: parent = node if new.key < node.key: node.rank += 1 node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_ranks(node): while node: if node.parent and node.parent.left is node: node.parent.rank -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_ranks(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_ranks(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_ranks(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.rank = deleted.rank if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/01/06.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '06.py') exec(open(filename).read()) class OrderStatisticTreeTest(unittest.TestCase): def test_rank_when_inserting(self): k = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) for n in range(1, k + 1): self.assertEqual(tree.select(n).key, n) self.assertEqual(tree.search(n).rank_in_tree(), n) def test_rank_when_deleting(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): i += 1 self.assertEqual(tree.select(i).key, n) self.assertEqual(tree.search(n).rank_in_tree(), i) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/01/07.markdown ================================================ > Show how to use an order-statistic tree to count the number of inversions (see > Problem 2-4) in an array of size $n$ in time $\O(n \lg n)$. We can use one simple trick! We create a new tree, and insert the elements from the array in reverse; that is, we insert the last element first, then the element before the last, and so on. If the array is sorted, we expect each new node to have rank 1, as it will be the minimal node in the tree. If it doesn't, it means that there are $node.rank - 1$ elements in the array that are after $node.key$, but smaller in value. This gives the number of inversions. Here's a Python snippet: ```python def inversions(array): tree = Tree() count = 0 for n in reversed(array): count += tree.insert(n).rank() - 1 return count ``` ================================================ FILE: other/clrs/14/01/07.py ================================================ from enum import Enum from collections import deque def inversions(array): tree = Tree() count = 0 for n in reversed(array): count += tree.insert(n).rank() - 1 return count class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, size): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.size = size def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child child.size = self.size self.size = self.left.size + self.right.size + 1 def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank(self): rank = self.left.size + 1 node = self while node.parent: if node == node.parent.right: rank += node.parent.left.size + 1 node = node.parent return rank nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, 0) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def rank(self, key): return self.search(key).rank() def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1) parent = nil node = self.root while node: node.size += 1 parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) return new def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_sizes(node): while node: node.size -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_sizes(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_sizes(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_sizes(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.size = y.left.size + y.right.size + 1 if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/01/07.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '07.py') exec(open(filename).read()) def count_inversions(numbers): count = 0 for i in range(0, len(numbers)): for j in range(i + 1, len(numbers)): if numbers[i] > numbers[j]: count += 1 return count class OrderStatisticTreeTest(unittest.TestCase): def test_inversions(self): numbers = [n * 2 for n in range(0, 100)] random.shuffle(numbers) self.assertEqual(inversions(numbers), count_inversions(numbers)) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/01/08.markdown ================================================ > $\star$ Consider $n$ chords on a circle, each defined by its endpoints. > Describe an $\O(n \lg n)$-time algorithm to determine the number of pairs of > chords that intersect inside the circle. (For example, if the $n$ chords are > all diameters that meet at the center, then the correct answer is $\binom n > 2$.) Assume that no two chords share an endpoint. It's an interesting algorithm: ```python def count_chords(chords): points = [] for (start, end) in chords: if start > end: start, end = end, start points.append({'kind': 'start', 'x': start}) points.append({'kind': 'end', 'x': end, 'start': start}) points = sorted(points, key=lambda point: point['x']) tree = Tree() count = 0 for point in points: if point['kind'] == 'start': tree.insert(point['x']) else: assert point['kind'] == 'end' count += tree.size() - tree.search(point['start']).rank() tree.delete(point['start']) return count ``` First, we sort all the points, all while keeping track of whether they are the start or the end of an interval, and how to look up the start from the end point. This takes $\O(n \lg n)$ time because of the sort. We can now iterate the points in order. Next, we need to consider the following invariant: > If $a$ and $b$ are the start and end of a chord, then it intersects with all > chords that have start $s$ such that $a < s < b$ and end $e$ such that $e > > b$. That is, every chord that starts between the two endpoints of another will intersect with it, if it's endpoint is outside this range. Note that this holds true in the other direction as well ($s < a < e < b$), but this will double-count the intersection. Thus, we interested only in counting pairs $(a, b)$ and $(s, e)$, such that $a < s < b < e$. The way we can do that is by iterating over the points and doing the following: * If we encounter a start point, we insert it into the tree ($\O(\lg n)$) * If we encounter an end point, we look up the rank of the start point ($\O(\lg n)$) and use it to determine how many chords start after it, but have not ended yet, and add it up. Then we remove the start point from the tree ($\O(\lg n)$). Each step is at most an $\O(\lg n)$ operation, and since we perform $2n$ of them, the total time is $\O(n \lg n)$. ================================================ FILE: other/clrs/14/01/08.py ================================================ from enum import Enum from collections import deque def count_chords(chords): points = [] for (start, end) in chords: if start > end: start, end = end, start points.append({'kind': 'start', 'x': start}) points.append({'kind': 'end', 'x': end, 'start': start}) points = sorted(points, key=lambda point: point['x']) tree = Tree() count = 0 for point in points: if point['kind'] == 'start': tree.insert(point['x']) else: assert point['kind'] == 'end' count += tree.size() - tree.search(point['start']).rank() tree.delete(point['start']) return count class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, size): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.size = size def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child child.size = self.size self.size = self.left.size + self.right.size + 1 def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank(self): rank = self.left.size + 1 node = self while node.parent: if node == node.parent.right: rank += node.parent.left.size + 1 node = node.parent return rank nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, 0) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def size(self): return self.root.size def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1) parent = nil node = self.root while node: node.size += 1 parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_sizes(node): while node: node.size -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_sizes(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_sizes(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_sizes(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.size = y.left.size + y.right.size + 1 if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/01/08.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '08.py') exec(open(filename).read()) def naive_chord_count(chords): count = 0 for i in range(len(chords)): for j in range(i + 1, len(chords)): (ia, ib) = chords[i] (ja, jb) = chords[j] if ib < ia: ia, ib = ib, ia if jb < ja: ja, jb = jb, ja if ia <= ja <= ib <= jb or ja <= ia <= jb <= ib: count += 1 return count class OrderStatisticTreeTest(unittest.TestCase): def test_diameters(self): def generate_diameters(n): chords = None while True: chords = [] seen = set() for i in range(n): start = random.random() end = 0.5 + start if end >= 1: end -= 1.0 seen.add(start) seen.add(end) chords.append((start, end)) if len(seen) == n * 2: break return chords n = 50 chords = generate_diameters(n) self.assertEqual(naive_chord_count(chords), (n * (n - 1)) / 2) self.assertEqual(count_chords(chords), (n * (n - 1)) / 2) def test_random_circle(self): def generate_chords(n): chords = None while True: chords = [] seen = set() for i in range(n): start = random.random() end = random.random() seen.add(start) seen.add(end) chords.append((start, end)) if len(seen) == n * 2: break return chords n = 100 for _ in range(100): chords = generate_chords(n) self.assertEqual(count_chords(chords), naive_chord_count(chords)) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/02/01.markdown ================================================ > Show, by adding pointers to the nodes, how to support each of the dynamic-set > queries `MINIMUM`, `MAXIMUM`, `SUCCESSOR`, and `PREDECESSOR` in $\O(1)$ > worst-case time on an augmented order-statistic tree. The asymptotic > performance of other operations on order-statistic trees should not be > affected. There's no dark magic here. Nodes just form a doubly-linked list with successor and predecessor being the pointers in both directions, and minimum and maximum being the start end end. Every time we insert a node, it's gonna be the predecessor or successor of its parent (depending on whether it's on the left or right). We're then just doing a simple linked list insertion/deletion. The code below is not as polished as it could be, the problem is not particularly hard either. ================================================ FILE: other/clrs/14/02/01.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree, size, pred, succ): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree self.size = size self.predecessor = pred self.successor = succ def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child child.size = self.size self.size = self.left.size + self.right.size + 1 def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None, succ=None, pred=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent if succ is not None: self.successor = succ if pred is not None: self.predecessor = pred def minimum(self): node = self while node.left: node = node.left return node def select(self, i): node = self while node: rank = node.left.size + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank(self): rank = self.left.size + 1 node = self while node.parent: if node == node.parent.right: rank += node.parent.left.size + 1 node = node.parent return rank nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, 0, None, None) nil.parent = nil nil.left = nil nil.right = nil class Tree: def __init__(self): self.root = nil self.minimum = nil self.maximum = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def select(self, i): return self.root.select(i) def insert(self, key): new = Node(Color.RED, key, None, None, None, self, 1, None, None) parent = nil node = self.root while node: node.size += 1 parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) if not new.parent: self.minimum = new self.maximum = new elif new.parent.left is new: new.successor = new.parent new.predecessor = new.parent.predecessor new.successor.predecessor = new if new.predecessor: new.predecessor.successor = new if self.minimum is new.parent: self.minimum = new else: new.predecessor = new.parent new.successor = new.parent.successor new.predecessor.successor = new if new.successor: new.successor.predecessor = new if self.maximum is new.parent: self.maximum = new self.insert_fixup(new) return new def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): def decrease_ancestor_sizes(node): while node: node.size -= 1 node = node.parent deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: decrease_ancestor_sizes(deleted) extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: decrease_ancestor_sizes(deleted) extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right decrease_ancestor_sizes(y) if y.parent is deleted: extra_black.parent = y else: y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color y.size = y.left.size + y.right.size + 1 if self.minimum is deleted: self.minimum = deleted.successor if self.maximum is deleted: self.maximum = deleted.predecessor if deleted.predecessor: deleted.predecessor.successor = deleted.successor if deleted.successor: deleted.successor.predecessor = deleted.predecessor if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/02/01.test.py ================================================ import unittest import os.path as path import random filename = path.join(path.dirname(__file__), '01.py') exec(open(filename).read()) class OrderStatisticTreeTest(unittest.TestCase): def test_things(self): tree = Tree() two = tree.insert(2) self.assertEqual(tree.minimum, two) self.assertEqual(tree.maximum, two) three = tree.insert(3) self.assertEqual(tree.minimum, two) self.assertEqual(tree.maximum, three) self.assertEqual(tree.minimum.successor, three) one = tree.insert(1) self.assertEqual(tree.minimum, one) self.assertEqual(tree.minimum.successor, two) self.assertEqual(tree.minimum.successor.successor, three) def test_rank_when_inserting(self): k = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) for n in range(1, k + 1): self.assertEqual(tree.select(n).key, n) self.assertEqual(tree.search(n).rank(), n) def test_rank_when_deleting(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = Tree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): i += 1 self.assertEqual(tree.select(i).key, n) self.assertEqual(tree.search(n).rank(), i) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def assertForwardWalk(self, tree, numbers): prev = None node = tree.minimum for n in sorted(numbers): self.assertEqual(n, node.key) prev = node node = node.successor self.assertEqual(prev, tree.maximum) def assertBackwardWalk(self, tree, numbers): prev = None node = tree.maximum for n in reversed(sorted(numbers)): self.assertEqual(n, node.key) prev = node node = node.predecessor self.assertEqual(prev, tree.minimum) def test_insertions(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) self.assertForwardWalk(tree, numbers) self.assertBackwardWalk(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = Tree() for n in numbers: tree.insert(n) self.assertProperties(tree) self.assertForwardWalk(tree, numbers) self.assertBackwardWalk(tree, numbers) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = Tree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) self.assertForwardWalk(tree, remaining) self.assertBackwardWalk(tree, remaining) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/02/02.markdown ================================================ > Can we maintain the black-heights of nodes in a red-black tree as attributes > in the nodes of the tree without affecting the asymptotic performance of any > of the red-black tree operations? Show how, or argue why not. How about > maintaining the depth of nodes? We can maintain the black heights, although we need to be careful with the various recoloring that's happening when we're going up the tree on insertion and deletion. Then it's quite simple to do it when rotations happen. I'm not going to show it, as I don't think it's that interesting. Depth won't work, because if we remove the root, we may need to update the depth of all $n$ nodes. ================================================ FILE: other/clrs/14/02/03.markdown ================================================ > $\star$ Let $\otimes$ be an associative binary operator, and let $a$ be an > attribute maintained in each node of a red-black tree. Suppose that we want to > include in each node $x$ an additional attribute $f$ such that $x.f = x_1.a > \otimes x_2.a \otimes \cdots \otimes x_m.a$, where $x_1, x_2, \ldots, x_m$ is > the inorder listing of nodes in the subtree rooted at $x$. Show how to update > the $f$ attributes in $\O(1)$ times after a rotation. Modify your argument > slightly to apply it to the $size$ attribute in order-statistic trees. I'm uncertain about why the star on this exercise. Fundamentally, the problem is nicely aligned so that $$ x.f = x.left.f \otimes x.a \otimes x.right.f $$ ...for every $x$ in the tree. In order to get it to work, we need to: * Recalculate $f$ for each parent of a newly inserted node (before the fixup) * Recalculate $f$ for each parent of the newly deleted node (before the fixup) * Recalculate $f$ on each rotation, but first recalculating it for the lower node, and then the upper For tracking the size, we just have that $a = 1$ for each node other than the sentinel $nil$ (where $a = 0$) and $\otimes = +$. ================================================ FILE: other/clrs/14/02/04.markdown ================================================ > $\star$ We wish to augment red-black trees with an operation `RB-ENUMERATE(x, > a, b)` that outputs all keys $k$ such that $a \le k \le b$ in a red-black tree > rooted at $x$. Describe how to implement `RB-ENUMERATE` in $\Theta(m + \lg n)$ > time, where $m$ is the number of keys that are output and $n$ is the number of > internal nodes in the tree. (_Hint_: You do not need to add new attributes to > the red-black tree.) I'd write it in code, but I feel I've done that before. Fundamentally, there are two bits: * We find $a$ in $\O(\lg n)$ time. * We perform an in-order tree walk, but we start from $a$ instead of the minimum element, and we terminate after we find $b$. As per Exercise 12.2-7, we can do that in $m$ time. As a reminder, the in-order tree walk can be accomplished without extra storage if we keep track of where in the tree we are, and where we are coming from. Exercise 10.4-5 implements an algorithm for that. We need to modify it slightly to work in-order as opposed to depth-first. ================================================ FILE: other/clrs/14/03/01.markdown ================================================ > Write pseudocode for `LEFT-ROTATE` that operates on nodes in an interval tree > and updates the max attributes in $\O(1)$ time. This is pretty basic – we just update the `max` on the lower node and then update the `max` on the upper node. We set `max` to be `max(node.max, node.left.interval.high, node.right.interval.high)` where we need to be careful to exclude nil values. ================================================ FILE: other/clrs/14/03/01.py ================================================ from enum import Enum from collections import deque class Interval: def __init__(self, low, high): assert low <= high self.low = low self.high = high def __eq__(self, other): return isinstance(other, Interval) and self.low == other.low and \ self.high == other.high def __contains__(self, n): return self.low <= n <= self.high def __repr__(self): return f"Interval({self.low}, {self.high})" __str__ = __repr__ def overlaps(self, other): return self.low <= other.high and other.low <= self.high class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) def max_maybe(*args): return max([arg for arg in args if arg is not None]) class Node: def __init__(self, color, interval, parent, left, right, max, tree): self.color = color self.interval = interval self.parent = parent self.left = left self.right = right self.tree = tree self.max = max def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.interval}, max={self.max}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.interval is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child self.max = max_maybe( self.interval.high, self.left.max if self.left else None, self.right.max if self.right else None, ) child.max = max_maybe( child.interval.high, child.left.max if child.left else None, child.right.max if child.right else None, ) def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class IntervalTree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def find(self, interval): node = self.root while node: if node.interval == interval: return node elif interval.low < node.interval.low: node = node.left else: node = node.right return None def search(self, interval): node = self.root while node: if interval.overlaps(node.interval): return node elif node.left and node.left.max >= interval.low: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, interval): new = Node(Color.RED, interval, None, None, None, interval.high, self) parent = nil node = self.root while node: parent = node if new.interval.low < node.interval.low: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.interval.low < parent.interval.low: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.max_fixup(parent) self.insert_fixup(new) def max_fixup(self, node): while node: node.max = max_maybe( node.interval.high, node.left.max if node.left else None, node.right.max if node.right else None ) node = node.parent def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, interval): deleted = self.find(interval) y = deleted y_original_color = y.color if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) self.max_fixup(deleted) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) self.max_fixup(deleted) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right todo = None if y.parent is deleted: extra_black.parent = y else: todo = y.parent y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color self.max_fixup(todo or y) if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/03/01.test.py ================================================ import unittest import random import os.path as path filename = path.join(path.dirname(__file__), '01.py') exec(open(filename).read()) class IntervalTest(unittest.TestCase): def test_contains(self): interval = Interval(5, 10) self.assertTrue(7 in interval) self.assertTrue(5 in interval) self.assertTrue(10 in interval) self.assertTrue(4 not in interval) self.assertTrue(11 not in interval) def test_overlaps(self): self.assertTrue(Interval(5, 10).overlaps(Interval(2, 7))) self.assertTrue(Interval(5, 10).overlaps(Interval(7, 9))) self.assertTrue(Interval(5, 10).overlaps(Interval(7, 13))) self.assertFalse(Interval(5, 10).overlaps(Interval(1, 4))) self.assertFalse(Interval(5, 10).overlaps(Interval(11, 15))) class IntervalTreeTest(unittest.TestCase): def test_simple_interval_tree(self): tree = IntervalTree() three_to_five = Interval(3, 5) seven_to_nine = Interval(7, 9) eleven_to_thirteen = Interval(11, 13) def point(n): return Interval(n, n) tree.insert(three_to_five) tree.insert(seven_to_nine) tree.insert(eleven_to_thirteen) self.assertIsNone(tree.search(point(1))) self.assertIsNone(tree.search(point(2))) self.assertIs(tree.search(point(4)).interval, three_to_five) self.assertIs(tree.search(point(3)).interval, three_to_five) self.assertIs(tree.search(point(5)).interval, three_to_five) self.assertIsNone(tree.search(point(6))) self.assertIs(tree.search(point(7)).interval, seven_to_nine) self.assertIs(tree.search(point(8)).interval, seven_to_nine) self.assertIs(tree.search(point(9)).interval, seven_to_nine) self.assertIsNone(tree.search(point(10))) self.assertIs(tree.search(point(11)).interval, eleven_to_thirteen) self.assertIs(tree.search(point(12)).interval, eleven_to_thirteen) self.assertIs(tree.search(point(13)).interval, eleven_to_thirteen) self.assertIsNone(tree.search(point(14))) self.assertIsNone(tree.search(point(15))) self.assertProperties(tree) def test_overlapping(self): tree = IntervalTree() tree.insert(Interval(5, 6)) tree.insert(Interval(1, 20)) tree.insert(Interval(10, 12)) self.assertIsNotNone(tree.search(Interval(18, 19))) self.assertProperties(tree) def test_properties(self): k = 20000 n = 800 w = 50 d = 300 starts = list(range(0, k)) random.shuffle(starts) starts = starts[0:n] intervals = [] tree = IntervalTree() for low in starts: high = low + random.randint(0, min(w, k - low)) interval = Interval(low, high) intervals.append(interval) tree.insert(interval) self.assertProperties(tree) self.assertProperties(tree) random.shuffle(intervals) intervals = intervals[0:d] for interval in intervals: tree.delete(interval) self.assertProperties(tree) def assertProperties(self, tree): def check_max(node): numbers = [node.interval.high] if node.left: numbers.append(check_max(node.left)) self.assertTrue(node.left.interval.low < node.interval.low) if node.right: numbers.append(check_max(node.right)) self.assertTrue(node.interval.low < node.right.interval.low) self.assertEqual(node.max, max(numbers)) return node.max if tree.root: check_max(tree.root) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/03/02.markdown ================================================ > Rewrite the code for `INTERVAL-SEARCH` so that it works properly when all > intervals are open. This is pretty minor, and I'm not gonna bother doing the full thing. We need to do to things to the code in Exercise 14.3-1: * change the definition of `overlaps` to exclude the boundary conditions, that is, change `<=` to `<` in the comparisons; * use `>` instead of `>=` when comparing `node.left.max` and `interval.low` in `Tree.search`. ================================================ FILE: other/clrs/14/03/03.markdown ================================================ > Describe an efficient algorithm that, given an interval $i$, returns an > interval overlapping $i$ that has the minimum low endpoint, or $T.nil$ if no > such interval exists. The existing algorithm is almost there – the only addition it needs to be made is that in case the current node overlaps with the supplied interval, instead of returning immediately, we need to keep track of the match, and continue left. Matches in the left subtree will have smaller low endpoints. To keep it simple, we can just keep track of the matches, updating them only when the lower bound is smaller than the current match. ================================================ FILE: other/clrs/14/03/04.markdown ================================================ > Given an interval tree $T$ and an interval $i$, describe how to list all > intervals in $T$ that overlap $i$ in $\O(\min(n, k \lg n))$ time, where $k$ is > the number of intervals in the output list. (_Hint:_ One simple method makes > several queries, modifying the tree between queries. A slightly more > complicated method does not modify the tree). The simple method would be to remove the interval and search again, until an interval is no longer present. I struggle to formally establish an upper bound. Intuitively, if $k = n$, that is, all intervals overlap with the one that is being searched for, it will always be the root, and removing the root would be a constant operating, establishing $\O(n)$ complexity. I'm not sure how to reason about this when $k < n$ but $n < k \lg n$. Should pan out, but no idea why. An algorithm that does not modify the tree is doable, but the upper bound still evades me. Let's explore it nonetheless. Once we visit a node, we can check whether it overlaps and add its interval to the result if it does. We're then in a situation in which we may have to explore both branches of the tree. Letting $x$ be the node, we have the following constraints to work with: * $x.left$ will not contain overlapping intervals if $x.left.max < i.low$. * $x.right$ will not contain overlapping intervals unless $[x.int.low, x.right.max]$ overlaps with $i$. We can use this to avoid visiting some of the nodes in the tree. The resulting algorithm will certainly be $\O(n)$, because it does not visit a node more than once. Whether it is $\O(k \lg n)$, I have no idea. ```python def search(tree, interval): result = [] def collect(node): if node.interval.overlaps(interval): result.append(node.interval) if node.left and interval.low <= node.left.max: collect(node.left) if node.right and Interval(node.interval.low, node.right.max).overlaps(interval): collect(node.right) collect(tree.root) return result ``` ================================================ FILE: other/clrs/14/03/04.py ================================================ from enum import Enum from collections import deque class Interval: def __init__(self, low, high): assert low <= high self.low = low self.high = high def __eq__(self, other): return isinstance(other, Interval) and self.low == other.low and \ self.high == other.high def __hash__(self): return hash((self.low, self.high)) def __contains__(self, n): return self.low <= n <= self.high def __repr__(self): return f"Interval({self.low}, {self.high})" __str__ = __repr__ def overlaps(self, other): return self.low <= other.high and other.low <= self.high class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) def max_maybe(*args): return max([arg for arg in args if arg is not None]) class Node: def __init__(self, color, interval, parent, left, right, max, tree): self.color = color self.interval = interval self.parent = parent self.left = left self.right = right self.tree = tree self.max = max def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.interval}, max={self.max}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.interval is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child self.max = max_maybe( self.interval.high, self.left.max if self.left else None, self.right.max if self.right else None, ) child.max = max_maybe( child.interval.high, child.left.max if child.left else None, child.right.max if child.right else None, ) def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class IntervalTree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def find(self, interval): node = self.root while node: if node.interval == interval: return node elif interval.low < node.interval.low: node = node.left else: node = node.right return None def search(self, interval): node = self.root while node: if interval.overlaps(node.interval): return node elif node.left and node.left.max >= interval.low: node = node.left else: node = node.right return None def search_all(self, interval): result = [] def collect(node): if node.interval.overlaps(interval): result.append(node.interval) if node.left and interval.low <= node.left.max: collect(node.left) if node.right and Interval(node.interval.low, node.right.max).overlaps(interval): collect(node.right) collect(self.root) return result def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, interval): new = Node(Color.RED, interval, None, None, None, interval.high, self) parent = nil node = self.root while node: parent = node if new.interval.low < node.interval.low: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.interval.low < parent.interval.low: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.max_fixup(parent) self.insert_fixup(new) def max_fixup(self, node): while node: node.max = max_maybe( node.interval.high, node.left.max if node.left else None, node.right.max if node.right else None ) node = node.parent def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, interval): deleted = self.find(interval) y = deleted y_original_color = y.color if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) self.max_fixup(deleted) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) self.max_fixup(deleted) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right todo = None if y.parent is deleted: extra_black.parent = y else: todo = y.parent y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color self.max_fixup(todo or y) if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/03/04.test.py ================================================ import unittest import random import os.path as path filename = path.join(path.dirname(__file__), '04.py') exec(open(filename).read()) class IntervalTreeTest(unittest.TestCase): def test_search_all(self): tree = IntervalTree() three_to_five = Interval(3, 5) seven_to_nine = Interval(7, 9) eleven_to_thirteen = Interval(11, 13) tree.insert(three_to_five) tree.insert(seven_to_nine) tree.insert(eleven_to_thirteen) self.assertEqual(set(tree.search_all(Interval(3, 8))), {three_to_five, seven_to_nine}) self.assertEqual(set(tree.search_all(Interval(7, 10))), {seven_to_nine}) self.assertEqual(set(tree.search_all(Interval(7, 12))), {seven_to_nine, eleven_to_thirteen}) self.assertEqual(set(tree.search_all(Interval(1, 15))), {three_to_five, seven_to_nine, eleven_to_thirteen}) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/03/05.markdown ================================================ > Suggest modifications to the interval-tree procedures to support the new > operation `INTERVAL-SEARCH-EXACTLY(T, i)`, where $T$ is an interval tree and > $i$ is an interval. The operation should return a pointer to a node $x$ in $T$ > such that $x.int.low = i.low$ and $x.int.high = i.high$, or $T.nil$ if $T$ > contains no such code. All operations including `INTERVAL-SEARCH-EXACTLY` > should run in $\O(\lg n)$ time on a $n$-node interval tree. This only presents a problem if there are intervals with matching $low$ values – otherwise, it's just a basic binary tree search, looking at $low$ for the key. The solutions of the previous exercises assume that the low endpoints are distinct, so they even provide a function like that. Assuming that we're not creating a multiset, that is, each interval can be present only once, the trick here is to define a total order on the intervals – $i_1 < i_2$ if and only if $(i_1.low, i_1.high) < (i_2.low, i_2.high)$ where the comparison is "lexicographical". That is, as long as two intervals have different lower bounds, the one that goes more to the left is smaller. If their lower bounds match, the one that has less width is the smaller. With the ordering defined like that, we simply do a regular search in a BST. ================================================ FILE: other/clrs/14/03/06.markdown ================================================ > Show how to maintain a dynamic set $Q$ of numbers that supports the operation > `MIN-GAP`, which gives the magnitude of the difference of the two closes > numbers in $Q$. For example, if $Q = \\{ 1, 5, 9, 15, 18, 22 \\}$, then > `MIN-GAP(Q)` returns $18 - 15 = 3$, since $15$ and $18$ are the two closest > numbers in $Q$. Make the operations `INSERT`, `DELETE`, `SEARCH` and `MIN-GAP` > as efficient as possible, and analyze their running times. This should be formulaic. We store the following extra attributes in each node: * `minimum` of the subtree rooted at the node * `maximum` of the subtree rooted at the node * `gap` (minimal one) for the subtree root at the node We can calculate the extra attributes for each node in the following way: * The minimum is the left subtree's minimum if it exist, or the key of the node if it doesn't. * The maximum is the right subtree's maximum if it exists, or the key of the node if it doesn't. * There are four candidates for the min gap, whichever is smallest is fine. 1. The left subtree's min gap, if there is a left node 2. The right subtree's min gap, if there is a right node 3. `node.key - node.left.maximum`, if there is a left node 4. `node.right.minimum - node.key`, if there is a right node To maintain invariants, we need to recalculate the extras when: * We do a rotation * We insert a node, starting with the inserted node * We delete a node, starting with the lowest node we've moved This results in the code below. ================================================ FILE: other/clrs/14/03/06.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Extra: def __init__(self, minimum, maximum, gap): self.minimum = minimum self.maximum = maximum self.gap = gap class Node: def __init__(self, color, key, parent, left, right, extra, tree): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.extra = extra self.tree = tree def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child self.recalculate() child.recalculate() def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node def maximum(self): node = self while node.right: node = node.right return node def recalculate(self): self.extra.minimum = self.left.extra.minimum if self.left else self.key self.extra.maximum = self.right.extra.maximum if self.right else self.key self.extra.gap = min(n for n in [ self.left.extra.gap if self.left else None, self.right.extra.gap if self.right else None, self.key - self.left.extra.maximum if self.left else None, self.right.extra.minimum - self.key if self.right else None, float('inf') ] if n is not None) nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class MinGapTree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def min_gap(self): return self.root.extra.gap def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, key): extra = Extra(minimum=float('inf'), maximum=float('-inf'), gap=float('inf')) new = Node(Color.RED, key, None, None, None, extra, self) parent = nil node = self.root while node: parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.extras_fixup(new) self.insert_fixup(new) def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): deleted = self.search(key) y = deleted y_original_color = y.color if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) self.extras_fixup(deleted) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) self.extras_fixup(deleted) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right to_fix = y if y.parent is deleted: extra_black.parent = y else: to_fix = y.parent y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color self.extras_fixup(to_fix) if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK def extras_fixup(self, node): while node: node.recalculate() node = node.parent ================================================ FILE: other/clrs/14/03/06.test.py ================================================ import unittest import random from os import path filename = path.join(path.dirname(__file__), '06.py') exec(open(filename).read()) class MinGapTreeTest(unittest.TestCase): def test_example_from_book(self): tree = MinGapTree() numbers = [1, 5, 9, 15, 18, 22] random.shuffle(numbers) for n in numbers: tree.insert(n) self.assertEqual(tree.min_gap(), 3) tree.delete(15) self.assertEqual(tree.min_gap(), 4) tree.delete(18) self.assertEqual(tree.min_gap(), 4) tree.delete(5) self.assertEqual(tree.min_gap(), 8) tree.delete(9) self.assertEqual(tree.min_gap(), 21) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(n.minimum().key, n.extra.minimum) self.assertEqual(n.maximum().key, n.extra.maximum) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = MinGapTree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = MinGapTree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = MinGapTree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/03/07.markdown ================================================ > $\star$ VLSI databases commonly represent an integrated circuit as a list of > rectangles. Assume that each rectangle is rectilinearly oriented (sides > parallel to the x- and y-axes), so that we represent a rectangle by its > minimum and maximum x- and y-coordinates. Give an $\O(n \lg n)$-time algorithm > to decide whether or not a set of $n$ rectangles so represented contains two > rectangles that overlap. Your algorithm need not report all intersecting > pairs, but it must report that an overlap exists if one rectangle entirely > covers another, even if the boundary lines do not intersect. (_Hint:_ Move a > "sweep" line across the set of rectangles.) This bears similarity to Exercise 14.1-8, only we need an interval tree, instead of a order statistic tree. The algorithm is the following: 1. We create an array of the left and right edges of each rectangle, tracking the type of edge (left vs right), it's position and the rectangle it refers to – $\O(n)$ time 2. We sort the array, ordering left edges before right edges – $\O(n \lg n)$ time 3. We create an empty interval tree 4. We iterate the array – $\O(n)$ time 1. If we encounter a left edge, we construct an interval `[rect.top, rect.bottom]`. We search of it in the interval tree ($\O(\lg n)$). If it's present, we can return an overlap. If it's not, we insert it ($\O(\lg n)$) and continue 2. If we encounter a right edge, we remove the rectangle from the interval tree 5. If we successfully iterate the array without breaking out, we return no overlap ================================================ FILE: other/clrs/14/03/07.py ================================================ from enum import Enum from collections import deque def overlap(rectangles): tree = IntervalTree() edges = [] intervals = {} for rectangle in rectangles: edges.append({'side': 'left', 'key': rectangle.left, 'rect': rectangle}) edges.append({'side': 'right', 'key': rectangle.right, 'rect': rectangle}) edges.sort(key=lambda r: (r['key'], 0 if r['side'] == 'left' else 1)) for edge in edges: if edge['side'] == 'left': interval = Interval(edge['rect'].top, edge['rect'].bottom) if tree.search(interval): return True intervals[edge['rect']] = interval tree.insert(interval) else: assert edge['side'] == 'right' tree.delete(intervals[edge['rect']]) return False class Rectangle: def __init__(self, top, bottom, left, right): assert(top < bottom) assert(left < right) self.top = top self.bottom = bottom self.left = left self.right = right def overlaps(self, other): return self.top <= other.bottom and other.top <= self.bottom and \ self.left <= other.right and other.left <= self.right def __repr__(self): return f"Rectangle(left={self.left}, right={self.right}, top={self.top}, bottom={self.bottom})" class Interval: def __init__(self, low, high): assert low <= high self.low = low self.high = high def __eq__(self, other): return isinstance(other, Interval) and self.low == other.low and \ self.high == other.high def __contains__(self, n): return self.low <= n <= self.high def __repr__(self): return f"Interval({self.low}, {self.high})" __str__ = __repr__ def overlaps(self, other): return self.low <= other.high and other.low <= self.high class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) def max_maybe(*args): return max([arg for arg in args if arg is not None]) class Node: def __init__(self, color, interval, parent, left, right, max, tree): self.color = color self.interval = interval self.parent = parent self.left = left self.right = right self.tree = tree self.max = max def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.interval}, max={self.max}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.interval is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child self.max = max_maybe( self.interval.high, self.left.max if self.left else None, self.right.max if self.right else None, ) child.max = max_maybe( child.interval.high, child.left.max if child.left else None, child.right.max if child.right else None, ) def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class IntervalTree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def find(self, interval): node = self.root while node: if node.interval == interval: return node elif interval.low < node.interval.low: node = node.left else: node = node.right return None def search(self, interval): node = self.root while node: if interval.overlaps(node.interval): return node elif node.left and node.left.max >= interval.low: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, interval): new = Node(Color.RED, interval, None, None, None, interval.high, self) parent = nil node = self.root while node: parent = node if new.interval.low < node.interval.low: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.interval.low < parent.interval.low: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.max_fixup(parent) self.insert_fixup(new) def max_fixup(self, node): while node: node.max = max_maybe( node.interval.high, node.left.max if node.left else None, node.right.max if node.right else None ) node = node.parent def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, interval): deleted = self.find(interval) y = deleted y_original_color = y.color if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) self.max_fixup(deleted) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) self.max_fixup(deleted) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right todo = y if y.parent is deleted: extra_black.parent = y else: todo = y.parent y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color self.max_fixup(todo) if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/03/07.test.py ================================================ import unittest import random from os import path filename = path.join(path.dirname(__file__), '07.py') exec(open(filename).read()) def overlapper(rectangles): for i in range(0, len(rectangles) - 1): one, *others = rectangles[i:] for other in others: if other.overlaps(one): return one return None class OverlapingRectanglesTest(unittest.TestCase): def test_simple_cases(self): self.assertFalse( overlap([ Rectangle(left=0, right=10, top=0, bottom=10), Rectangle(left=20, right=30, top=0, bottom=10), ]) ) self.assertTrue( overlap([ Rectangle(left=0, right=10, top=0, bottom=10), Rectangle(left=5, right=15, top=5, bottom=15), ]) ) def test_randomly_generated(self): n = 100 s = 1000 m = 150 rectangles = [] for i in range(0, n): left = random.randint(0, s - 2) right = random.randint(left + 1, min(s, left + m)) top = random.randint(0, s - 2) bottom = random.randint(top + 1, min(s, top + m)) rectangle = Rectangle(left=left, right=right, top=top, bottom=bottom) rectangles.append(rectangle) while target := overlapper(rectangles): self.assertTrue(overlap(rectangles)) rectangles.remove(target) self.assertFalse(overlap(rectangles)) random.shuffle(rectangles) while len(rectangles): self.assertFalse(overlap(rectangles)) rectangles.pop() if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/misc/augmentable_tree.py ================================================ from enum import Enum from collections import deque class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) class Node: def __init__(self, color, key, parent, left, right, tree): self.color = color self.key = key self.parent = parent self.left = left self.right = right self.tree = tree def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.key}, {self.left}, {self.right})" def __str__(self): return self.sexp() def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.key is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child self.tree.recalculate_node(self) self.tree.recalculate_node(child) def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node nil = Node(Color.BLACK, NIL_KEY, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class AugmentableTree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def search(self, key): node = self.root while node: if node.key == key: return node elif key < node.key: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, key): new = Node(Color.RED, key, None, None, None, self) self.augment_node(new) parent = nil node = self.root while node: parent = node if new.key < node.key: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.key < parent.key: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.recalculate_ancestors(parent) self.insert_fixup(new) def recalculate_ancestors(self, node): while node: self.recalculate_node(node) node = node.parent def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, key): deleted = self.search(key) y = deleted y_original_color = y.color to_fix = deleted if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right to_fix = y if y.parent is deleted: extra_black.parent = y else: to_fix = y.parent y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color self.recalculate_ancestors(to_fix) if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/misc/augmentable_tree_test.py ================================================ import unittest from augmentable_tree import AugmentableTree, Color import random class Interval: def __init__(self, low, high): assert low <= high self.low = low self.high = high def __eq__(self, other): return isinstance(other, Interval) and self.low == other.low and \ self.high == other.high def __lt__(self, other): return self.low < other.low def __contains__(self, n): return self.low <= n <= self.high def __repr__(self): return f"Interval({self.low}, {self.high})" __str__ = __repr__ def overlaps(self, other): return self.low <= other.high and other.low <= self.high def max_maybe(*args): return max([arg for arg in args if arg is not None]) class IntervalTree(AugmentableTree): def augment_node(self, node): node.interval = node.key node.max = node.interval.high def recalculate_node(self, node): node.max = max_maybe( node.interval.high, node.left.max if node.left else None, node.right.max if node.right else None ) def find(self, interval): node = self.root while node: if interval.overlaps(node.interval): return node elif node.left and node.left.max >= interval.low: node = node.left else: node = node.right return None class IntervalTreeTest(unittest.TestCase): def test_simple_interval_tree(self): tree = IntervalTree() three_to_five = Interval(3, 5) seven_to_nine = Interval(7, 9) eleven_to_thirteen = Interval(11, 13) def point(n): return Interval(n, n) tree.insert(three_to_five) tree.insert(seven_to_nine) tree.insert(eleven_to_thirteen) self.assertIsNone(tree.find(point(1))) self.assertIsNone(tree.find(point(2))) self.assertIs(tree.find(point(4)).interval, three_to_five) self.assertIs(tree.find(point(3)).interval, three_to_five) self.assertIs(tree.find(point(5)).interval, three_to_five) self.assertIsNone(tree.find(point(6))) self.assertIs(tree.find(point(7)).interval, seven_to_nine) self.assertIs(tree.find(point(8)).interval, seven_to_nine) self.assertIs(tree.find(point(9)).interval, seven_to_nine) self.assertIsNone(tree.find(point(10))) self.assertIs(tree.find(point(11)).interval, eleven_to_thirteen) self.assertIs(tree.find(point(12)).interval, eleven_to_thirteen) self.assertIs(tree.find(point(13)).interval, eleven_to_thirteen) self.assertIsNone(tree.find(point(14))) self.assertIsNone(tree.find(point(15))) self.assertProperties(tree) def test_overlapping(self): tree = IntervalTree() tree.insert(Interval(5, 6)) tree.insert(Interval(1, 20)) tree.insert(Interval(10, 12)) self.assertIsNotNone(tree.find(Interval(18, 19))) self.assertProperties(tree) def test_properties(self): k = 20000 n = 800 w = 50 d = 300 starts = list(range(0, k)) random.shuffle(starts) starts = starts[0:n] intervals = [] tree = IntervalTree() for low in starts: high = low + random.randint(0, min(w, k - low)) interval = Interval(low, high) intervals.append(interval) tree.insert(interval) self.assertProperties(tree) self.assertProperties(tree) random.shuffle(intervals) intervals = intervals[0:d] for interval in intervals: tree.delete(interval) self.assertProperties(tree) def assertProperties(self, tree): def check_max(node): numbers = [node.interval.high] if node.left: numbers.append(check_max(node.left)) self.assertTrue(node.left.interval.low < node.interval.low) if node.right: numbers.append(check_max(node.right)) self.assertTrue(node.interval.low < node.right.interval.low) self.assertEqual(node.max, max(numbers)) return node.max if tree.root: check_max(tree.root) def node_size(node): return node.size if node else 0 def select_node(node, i): while node: rank = node_size(node.left) + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank_node(node): rank = node_size(node.left) + 1 while node.parent: if node == node.parent.right: rank += node_size(node.parent.left) + 1 node = node.parent return rank class OrderStatisticTree(AugmentableTree): def augment_node(self, node): node.rank = lambda: rank_node(node) node.select = lambda i: select_node(node, i) node.size = 1 def recalculate_node(self, node): node.size = 1 + node_size(node.left) + node_size(node.right) def select(self, i): return select_node(self.root, i) class OrderStatisticTreeTest(unittest.TestCase): def test_rank_when_inserting(self): k = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = OrderStatisticTree() for n in numbers: tree.insert(n) for n in range(1, k + 1): self.assertEqual(tree.select(n).key, n) self.assertEqual(tree.search(n).rank(), n) def test_rank_when_deleting(self): k = 1000 m = 500 numbers = list(range(1, k + 1)) random.shuffle(numbers) tree = OrderStatisticTree() for n in numbers: tree.insert(n) random.shuffle(numbers) remaining = numbers[0:m] for n in numbers[m:]: tree.delete(n) remaining.sort() for (i, n) in enumerate(remaining): i += 1 self.assertEqual(tree.select(i).key, n) self.assertEqual(tree.search(n).rank(), i) def generate(self, m, n): numbers = list(range(m)) random.shuffle(numbers) return numbers[0:n] def assertContains(self, tree, numbers): for n in numbers: self.assertIsNotNone(tree.search(n), f"should contain {n}") self.assertEqual(tree.search(n).key, n) def assertProperties(self, tree): heights = set() for n in tree.nodes(): if not n.left or not n.right: heights.add(n.black_height()) if n.color == Color.RED: self.assertEqual(n.left.color, Color.BLACK) self.assertEqual(n.right.color, Color.BLACK) self.assertEqual(len(heights), 1) self.assertEqual(tree.root.color, Color.BLACK) def test_insertions(self): numbers = self.generate(300, 100) tree = OrderStatisticTree() for n in numbers: tree.insert(n) self.assertContains(tree, numbers) def test_properties(self): numbers = self.generate(300, 100) tree = OrderStatisticTree() for n in numbers: tree.insert(n) self.assertProperties(tree) def test_deletion(self): numbers = self.generate(1000, 500) removed = numbers[:] random.shuffle(removed) removed = removed[0:250] remaining = list(set(numbers) - set(removed)) tree = OrderStatisticTree() for n in numbers: tree.insert(n) for n in removed: tree.delete(n) self.assertContains(tree, remaining) for n in removed: self.assertIsNone(tree.search(n)) self.assertProperties(tree) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/misc/interval_tree.py ================================================ from enum import Enum from collections import deque class Interval: def __init__(self, low, high): assert low <= high self.low = low self.high = high def __eq__(self, other): return isinstance(other, Interval) and self.low == other.low and \ self.high == other.high def __contains__(self, n): return self.low <= n <= self.high def __repr__(self): return f"Interval({self.low}, {self.high})" __str__ = __repr__ def overlaps(self, other): return self.low <= other.high and other.low <= self.high class Color(Enum): RED = 1 BLACK = 2 NIL_KEY = object() def other(direction): if direction == 'left': return 'right' elif direction == 'right': return 'left' else: assert(False) def max_maybe(*args): return max([arg for arg in args if arg is not None]) class Node: def __init__(self, color, interval, parent, left, right, max, tree): self.color = color self.interval = interval self.parent = parent self.left = left self.right = right self.tree = tree self.max = max def sexp(self): if self.isNil(): return 'NIL' color = 'R' if self.color == Color.RED else 'B' return f"{color}({self.interval}, max={self.max}, {self.left}, {self.right})" __str__ = sexp def black_height(self): node = self height = 0 while node is not nil: if node.color == Color.BLACK: height += 1 node = node.parent return height def isRed(self): return self.color == Color.RED def isBlack(self): return self.color == Color.BLACK def isNil(self): return self.interval is NIL_KEY def isNotNil(self): return not self.isNil() def __bool__(self): return self.isNotNil() def child(self, direction): if direction == 'left': return self.left elif direction == 'right': return self.right else: assert(False) def set_child(self, direction, child): if direction == 'left': self.left = child elif direction == 'right': self.right = child else: assert(False) __getitem__ = child __setitem__ = set_child def other(self, direction): return self.child(other(direction)) def rotate(self, direction): child = self.other(direction) self[other(direction)] = child[direction] if child[direction]: child[direction].parent = self child.parent = self.parent if not self.parent: self.tree.root = child elif self is self.parent[direction]: self.parent[direction] = child else: self.parent[other(direction)] = child child[direction] = self self.parent = child self.max = max_maybe( self.interval.high, self.left.max if self.left else None, self.right.max if self.right else None, ) child.max = max_maybe( child.interval.high, child.left.max if child.left else None, child.right.max if child.right else None, ) def left_rotate(self): self.rotate('left') def right_rotate(self): self.rotate('right') def transplant(self, other): if not self.parent: self.tree.root = other elif self is self.parent.left: self.parent.left = other else: self.parent.right = other other.parent = self.parent def set(self, parent=None, left=None, right=None, color=None): if color: self.color = color if left is not None: self.left = left if right is not None: self.right = right if parent is not None: self.parent = parent def minimum(self): node = self while node.left: node = node.left return node nil = Node(Color.BLACK, NIL_KEY, None, None, None, None, None) nil.parent = nil nil.left = nil nil.right = nil class IntervalTree: def __init__(self): self.root = nil def __str__(self): return self.root.sexp() def find(self, interval): node = self.root while node: if node.interval == interval: return node elif interval.low < node.interval.low: node = node.left else: node = node.right return None def search(self, interval): node = self.root while node: if interval.overlaps(node.interval): return node elif node.left and node.left.max >= interval.low: node = node.left else: node = node.right return None def nodes(self): items = deque() if self.root: items.append(self.root) while items: node = items.popleft() yield node if node.left: items.append(node.left) if node.right: items.append(node.right) def insert(self, interval): new = Node(Color.RED, interval, None, None, None, interval.high, self) parent = nil node = self.root while node: parent = node if new.interval.low < node.interval.low: node = node.left else: node = node.right new.parent = parent if not parent: self.root = new elif new.interval.low < parent.interval.low: parent.left = new else: parent.right = new new.set(left=nil, right=nil, color=Color.RED) self.max_fixup(parent) self.insert_fixup(new) def max_fixup(self, node): while node: node.max = max_maybe( node.interval.high, node.left.max if node.left else None, node.right.max if node.right else None ) node = node.parent def insert_fixup(self, node): while node.parent.isRed(): if node.parent is node.parent.parent.left: direction = 'left' else: direction = 'right' if direction == 'left' or direction == 'right': uncle = node.parent.parent[other(direction)] if uncle.isRed(): node.parent.color = Color.BLACK uncle.color = Color.BLACK node.parent.parent.color = Color.RED node = node.parent.parent else: if node is node.parent[other(direction)]: node = node.parent node.rotate(direction) node.parent.color = Color.BLACK node.parent.parent.color = Color.RED node.parent.parent.rotate(other(direction)) self.root.color = Color.BLACK def delete(self, interval): deleted = self.find(interval) y = deleted y_original_color = y.color to_fix = deleted if not deleted.left: extra_black = deleted.right deleted.transplant(deleted.right) elif not deleted.right: extra_black = deleted.left deleted.transplant(deleted.left) else: y = deleted.right.minimum() y_original_color = y.color extra_black = y.right to_fix = y if y.parent is deleted: extra_black.parent = y else: to_fix = y.parent y.transplant(y.right) y.right = deleted.right y.right.parent = y deleted.transplant(y) y.left = deleted.left y.left.parent = y y.color = deleted.color self.max_fixup(to_fix) if y_original_color == Color.BLACK: self.delete_fixup(extra_black) def delete_fixup(self, node): while node is not self.root and node.isBlack(): if node is node.parent.left: direction = 'left' else: direction = 'right' sibling = node.parent[other(direction)] if sibling.isRed(): sibling.color = Color.BLACK node.parent.color = Color.RED node.parent.rotate(direction) sibling = node.parent[other(direction)] if sibling.left.isBlack() and sibling.right.isBlack(): sibling.color = Color.RED node = node.parent else: if sibling[other(direction)].isBlack(): sibling[direction].color = Color.BLACK sibling.color = Color.RED sibling.rotate(other(direction)) sibling = node.parent[other(direction)] sibling.color = node.parent.color node.parent.color = Color.BLACK sibling[other(direction)].color = Color.BLACK sibling.parent.rotate(direction) node = self.root node.color = Color.BLACK ================================================ FILE: other/clrs/14/misc/interval_tree_test.py ================================================ import unittest from interval_tree import IntervalTree, Color, Interval import random class IntervalTest(unittest.TestCase): def test_contains(self): interval = Interval(5, 10) self.assertTrue(7 in interval) self.assertTrue(5 in interval) self.assertTrue(10 in interval) self.assertTrue(4 not in interval) self.assertTrue(11 not in interval) def test_overlaps(self): self.assertTrue(Interval(5, 10).overlaps(Interval(2, 7))) self.assertTrue(Interval(5, 10).overlaps(Interval(7, 9))) self.assertTrue(Interval(5, 10).overlaps(Interval(7, 13))) self.assertFalse(Interval(5, 10).overlaps(Interval(1, 4))) self.assertFalse(Interval(5, 10).overlaps(Interval(11, 15))) class IntervalTreeTest(unittest.TestCase): def test_simple_interval_tree(self): tree = IntervalTree() three_to_five = Interval(3, 5) seven_to_nine = Interval(7, 9) eleven_to_thirteen = Interval(11, 13) def point(n): return Interval(n, n) tree.insert(three_to_five) tree.insert(seven_to_nine) tree.insert(eleven_to_thirteen) self.assertIsNone(tree.search(point(1))) self.assertIsNone(tree.search(point(2))) self.assertIs(tree.search(point(4)).interval, three_to_five) self.assertIs(tree.search(point(3)).interval, three_to_five) self.assertIs(tree.search(point(5)).interval, three_to_five) self.assertIsNone(tree.search(point(6))) self.assertIs(tree.search(point(7)).interval, seven_to_nine) self.assertIs(tree.search(point(8)).interval, seven_to_nine) self.assertIs(tree.search(point(9)).interval, seven_to_nine) self.assertIsNone(tree.search(point(10))) self.assertIs(tree.search(point(11)).interval, eleven_to_thirteen) self.assertIs(tree.search(point(12)).interval, eleven_to_thirteen) self.assertIs(tree.search(point(13)).interval, eleven_to_thirteen) self.assertIsNone(tree.search(point(14))) self.assertIsNone(tree.search(point(15))) self.assertProperties(tree) def test_overlapping(self): tree = IntervalTree() tree.insert(Interval(5, 6)) tree.insert(Interval(1, 20)) tree.insert(Interval(10, 12)) self.assertIsNotNone(tree.search(Interval(18, 19))) self.assertProperties(tree) def test_properties(self): k = 20000 n = 800 w = 50 d = 300 starts = list(range(0, k)) random.shuffle(starts) starts = starts[0:n] intervals = [] tree = IntervalTree() for low in starts: high = low + random.randint(0, min(w, k - low)) interval = Interval(low, high) intervals.append(interval) tree.insert(interval) self.assertProperties(tree) self.assertProperties(tree) random.shuffle(intervals) intervals = intervals[0:d] for interval in intervals: tree.delete(interval) self.assertProperties(tree) def assertProperties(self, tree): def check_max(node): numbers = [node.interval.high] if node.left: numbers.append(check_max(node.left)) self.assertTrue(node.left.interval.low < node.interval.low) if node.right: numbers.append(check_max(node.right)) self.assertTrue(node.interval.low < node.right.interval.low) self.assertEqual(node.max, max(numbers)) return node.max if tree.root: check_max(tree.root) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/misc/order_statistic_tree.py ================================================ from augmentable_tree import AugmentableTree def node_size(node): return node.size if node else 0 def select_node(node, i): while node: rank = node_size(node.left) + 1 if i == rank: return node elif i < rank: node = node.left else: i -= rank node = node.right assert(False) def rank_node(node): rank = node_size(node.left) + 1 while node.parent: if node == node.parent.right: rank += node_size(node.parent.left) + 1 node = node.parent return rank class OrderStatisticTree(AugmentableTree): def augment_node(self, node): node.rank = lambda: rank_node(node) node.select = lambda i: select_node(node, i) node.size = 1 def recalculate_node(self, node): node.size = 1 + node_size(node.left) + node_size(node.right) def select(self, i): return select_node(self.root, i) ================================================ FILE: other/clrs/14/problems/01.markdown ================================================ # Point of maximum overlap > Suppose that we wish to keep track of a **point of maximum overlap** in a set > of intervals – a point with the largest number of intervals in the set that > overlaps it. > >
      >
    1. Show that there will always be a point of maximum overlap that is an > endpoint of one of the segments. >
    2. Design a data structure that efficiently supports the operations > INTERVAL-INSERT, INTERVAL-DELETE, and > FIND-POM, which returns a point of maximum overlap. > (Hint: Keep a red-black tree of all the endpoints. Associate a > value of +1 with each left endpoint, and associate a value of -1 with each > right endpoint. Augment each node of the tree with some extra information to > maintain the point of maximum overlap.) >
    ## Maximum overlap at an endpoint This is a bit obvious, so as usual, proving it is tricky. Let $x$ be a maximum overlap point and $S$ be set of the intervals that overlap around $x$. Let $I_S$ the intersection of all intervals in $S$, that is: $$ I_S = \bigcup\_{X \in S} X $$ If we let $I_S = (a, b)$, that is, for $a$ and $b$ to be the endpoints of the intersection, they are also points of maximum overlap. Furthermore, they are the endpoint of one of the intervals in $S$ (otherwise $I_S$ would not end there). ## Data structure As hinted, the data structure is a red-black tree, where each key is associated with a weight (-1 or 1) depending on whether it's the start or end of an interval. If we represent each set of intervals as a list of -1s and 1s in the order of the endpoints, then the largest number of overlapping interval is the maximum of the sums of each sublist. If there are duplicate endpoints, we need to order the 1s before the -1s. A list would not get good performance, however, so we model it as a tree: * The tree is an ordering of 1s and -1s of all the endpoints. * We're looking for a maximum sum of sequential endpoints, and an endpoint that generates it. Note that each node represent a sublist of the endpoints, that is, there are no elements between the minimum and the maximum of the subtree in the full list of endpoints that are not present in the subtree. We can calculate this efficiently by storing three properties on each node: 1. The sum of all the weights in the subtree rooted at a node. 2. The maximum weight in attainable by a prefix of the tree 3. The element that creates this maximum weight The first is obvious, and the third is calculated by the second. So the question is how we keep calculate the maximum overlap at a subtree, given that we have it for its children. There are essentially three cases: * The maximum overlap is achieved in a suffix of the left subtree * The maximum overlap is achieved by entire left subtree plus the endpoint of the node * The maximum overlap is achieved by entire left subtree plus the endpoint of the node plus a prefix in the right subtree They result in three different things we need to check, which is implemented in the code below ================================================ FILE: other/clrs/14/problems/01.py ================================================ import sys, os sys.path.append(os.path.join(os.path.dirname(__file__), '..', 'misc')) from augmentable_tree import AugmentableTree class Endpoint: def __init__(self, value, weight): self.value, self.weight = value, weight def __lt__(self, other): return (self.value, -self.weight) < (other.value, -other.weight) def __eq__(self, other): return (self.value, self.weight) == (other.value, other.weight) def isLow(self): return self.weight == 1 def weight(node): return node.weight if node else 0 def optimal(node): return node.optimal if node else (0, None) class OverlapTree(AugmentableTree): def __init__(self, intervals = []): super(OverlapTree, self).__init__() for interval in intervals: self.insert_interval(interval) def augment_node(self, node): node.optimal = (1, node.key.value) if node.key.isLow() else (0, None) node.weight = node.key.weight node.sexp = lambda: self.print_node(node) def recalculate_node(self, node): node.weight = node.key.weight + weight(node.left) + weight(node.right) right_optimal = optimal(node.right) candidates = [ optimal(node.left), (weight(node.left) + node.key.weight, node.key.value), (weight(node.left) + node.key.weight + right_optimal[0], right_optimal[1] or node.key.value), ] node.optimal = max(candidates, key=lambda t: t[0]) def max_overlap(self): return optimal(self.root)[1] def insert_interval(self, interval): self.insert(Endpoint(interval.low, 1)) self.insert(Endpoint(interval.high, -1)) def delete_interval(self, interval): self.delete(Endpoint(interval.low, 1)) self.delete(Endpoint(interval.high, -1)) ================================================ FILE: other/clrs/14/problems/01.test.py ================================================ import unittest import random from collections import defaultdict OverlapTree = __import__('01').OverlapTree class Interval: def __init__(self, low, high): self.low = low self.high = high def elements(self): return range(self.low, self.high + 1) def naive_max_overlap(intervals): counts = defaultdict(lambda: 0) for interval in intervals: for number in interval.elements(): counts[number] += 1 count = max(counts.values()) answer = min(key for key, value in counts.items() if value == count) return answer class OverlapTreeTest(unittest.TestCase): def test_simple_case(self): intervals = [ Interval(0, 6), Interval(3, 7), Interval(4, 10) ] tree = OverlapTree(intervals) self.assertEqual(naive_max_overlap(intervals), 4) self.assertEqual(tree.max_overlap(), 4) def test_random_case(self): n = 100 numbers = list(range(0, n * 2)) random.shuffle(numbers) intervals = [] tree = OverlapTree() while numbers: low, high = numbers.pop(), numbers.pop() if low > high: low, high = high, low interval = Interval(low, high) intervals.append(interval) tree.insert_interval(interval) while intervals: endpoint = naive_max_overlap(intervals) self.assertEqual(tree.max_overlap(), endpoint) interval, = [i for i in intervals if i.low == endpoint] intervals.remove(interval) tree.delete_interval(interval) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/14/problems/02.markdown ================================================ # Josephus permutation > We define the **Josephus problem** as follows. Suppose that $n$ people form a > circle and that we are given a positive integer $m \le n$. Beginning with a > designated first person, we proceed around the circle, removing every $m$th > person. After each person is removed, counting continues around the circle > that remains. This process continues until we have removed all $n$ people. The > order in which the people are removed from the circle defines the > **$(n,m)$-Josephus permutation** of integers $1, 2, \ldots, n$. For example, > the $(7, 3)$-Josephus permutation is $\langle 3, 6, 2, 7, 5, 1, 4 \rangle$. > >
      >
    1. Suppose that $m$ is a constant. Describe an $\O(n)$-time algorithm that, > given an integer $n$, outputs the $(n, m)$-Josephus permutation. >
    2. Suppose that $m$ is not a constant. Describe an $\O(n \lg n)$-time > algorithm that, given all integers $n$ and $m$, outputs the $(n, > m)$-Josephus permutation. >
    ## Constant $m$ This is a very evil way to spell "an $\O(mn)$-time algorithm". I honestly got stuck here, until I realized that the point was to have a simpler algorithm that does not take $m$ into account. Thus, it's simple: 1. Put all the numbers in a linked list and make it circular 2. Start with the first number and loop until you empty the list 3. Output the current number, remove it from the list, an advance $m$ times. At some point you end up removing the last number, which means we're done. It's not that hard to implement, so I would not bother. ## $\O(n \lg n)$ time Easy-peasy. First of all, we need to use an order statistic tree. Then, we simply start with selecting the $m$-th element, output it, delete it, and then look $m$ elements ahead, wrapping around with some modulo arithmetic and accounting for the deleted element. Python code below. Note that the index awkwardness is due to the 1-based indexing of our ranks. Note as well that we don't just need `OS-SELECT`, but also the size property of the tree/root. ================================================ FILE: other/clrs/14/problems/02.py ================================================ import sys, os sys.path.append(os.path.join(os.path.dirname(__file__), '..', 'misc')) from order_statistic_tree import OrderStatisticTree def josephus(n, m): tree = OrderStatisticTree() for i in list(range(1, n + 1)): tree.insert(i) current = 1 result = [] while tree.root: current = (current + m - 2) % tree.root.size + 1 node = tree.select(current) result.append(node.key) tree.delete(node.key) return tuple(result) ================================================ FILE: other/clrs/14/problems/02.test.py ================================================ import unittest import random from collections import defaultdict josephus = __import__('02').josephus def naive_josephus(n, m): items = list(range(1, n + 1)) current = 0 result = [] while items: current = (current + m - 1) % len(items) result.append(items[current]) del items[current] return tuple(result) class JosephusTest(unittest.TestCase): def test_simple_permutation(self): self.assertEqual(josephus(7, 3), (3, 6, 2, 7, 5, 1, 4)) def test_permutations(self): n = 50 for m in range(1, n): self.assertEqual(josephus(n, m), naive_josephus(n, m)) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/01/01.markdown ================================================ > Show that equation (15.4) follows from equation (15.3) and the initial > condition $T(0) = 1$. Let's first prove the rather obvious: $$ A(n) = \sum_{i=0}^{n} 2^i = 2^{n+1} - 1 $$ We do this by induction. It's clear that $A(0) = 2^0 = 1 = 2^1 - 1$ and even $A(1) = 2^0 + 2^1 = 1 + 2 = 3 = 2^2 - 1$. Assuming it holds for numbers up to $n$, if we look at $A(n + 1)$, we get: $$ A(n+1) = \sum_{i}^{n+1} 2^i = 2^{n+1} + A(n) = 2^{n+1} + 2^{n+1} - 1 = 2^{n+2} - 1 $$ We now use induction again. Looking then at (15.3) and (15.4), it clearly holds when $T(0) = 1$. Then let's $T(n) = 2^n$ up to an $n$, and then look at: $$ T(n+1) = 1 + \sum_{j=0}^{n} T(j) = 1 + \sum_{j=0}^{n} 2^n = 1 + 2^{n+1} - 1 = 2^{n+1} $$ ================================================ FILE: other/clrs/15/01/02.markdown ================================================ > Show, by means of counterexample, that the following "greedy" strategy does > not always determine an optimal way to cut rods. Define the **density** of a > rod of length $i$ to be $p_i / i$, that is, its value per inch. The greedy > strategy for a rod of length $n$ cuts off a first piece of length $i$, where > $1 \le i \le n$, having maximum density. It then continues by applying the > greedy strategy to the remaining piece of length $n - i$. Let us have the following options of rod length. | Length | 5 | 4 | 1 | |---------|---:|---:|--:| | Cost | 10 | 7 | 1 | | Density | 2 | 1¾ | 1 | Let's look at a rod of length 8. The greedy algorithm will choose $5 + 1 + 1 + 1$ with value $13$. In comparison, if we just cut it $4 + 4$, we are going to get value $14$. ================================================ FILE: other/clrs/15/01/03.markdown ================================================ > Consider a modification of the rod-cutting problem in which, in addition to a > price $p_i$ for each rod, each cut incurs a fixed cost $c$. The revenue > associated with a solution is now the sum of the prices of the pieces minus > the costs of making the cuts. Give a dynamic-programming algorithm to solve > this modified problem. The algorithm is pretty straightforward, and outlined below – you subtract $c$ from the calculation whenever there is a cut to be made. But more importantly, it reduces to the original problem – if we subtract $c$ from each $p_i$ and then add $c$ back to the result, we get the same value and the same cuts. ================================================ FILE: other/clrs/15/01/03.py ================================================ def cut_rod(length, prices, cut_cost=0): values = [-1] * (length + 1) choices = [-1] * (length + 1) values[0] = 0 for j in range(1, length + 1): max_cut = min(len(prices), j + 1) max_value = -1 for i in range(1, max_cut): value = prices[i] + values[j - i] - (0 if j - i == 0 else cut_cost) if max_value < value: max_value = value choices[j] = i values[j] = max_value n = length cuts = [] while n > 0: cuts.append(choices[n]) n -= choices[n] return (values[length], cuts) ================================================ FILE: other/clrs/15/01/03.test.py ================================================ import unittest cut_rod = __import__('03').cut_rod class RodCuttingTest(unittest.TestCase): def setUp(self): self.prices = [0, 1, 5, 8, 9, 10, 17, 17, 20, 24, 30] def test_cutting_without_a_cost(self): self.assertEqual(cut_rod(1, self.prices), (1, [1])) self.assertEqual(cut_rod(2, self.prices), (5, [2])) self.assertEqual(cut_rod(3, self.prices), (8, [3])) self.assertEqual(cut_rod(4, self.prices), (10, [2, 2])) self.assertEqual(cut_rod(5, self.prices), (13, [2, 3])) self.assertEqual(cut_rod(6, self.prices), (17, [6])) self.assertEqual(cut_rod(7, self.prices), (18, [1, 6])) self.assertEqual(cut_rod(8, self.prices), (22, [2, 6])) self.assertEqual(cut_rod(9, self.prices), (25, [3, 6])) self.assertEqual(cut_rod(10, self.prices), (30, [10])) self.assertEqual(cut_rod(40, self.prices), (120, [10, 10, 10, 10])) def test_cutting_with_a_cost(self): prices = [0, 3, 5, 2, 5] self.assertEqual(cut_rod(4, prices, 2), (8, [2, 2])) def test_equivalence_to_costless(self): prices = [0, 3, 5, 2, 5, 6, 9, 9, 12] cost = 2 adjusted_prices = [p - cost for p in prices] adjusted_prices[0] = 0 for i in range(1, 100): self.assertEqual( cut_rod(i, prices, cost)[0], cut_rod(i, adjusted_prices)[0] + cost ) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/01/04.markdown ================================================ > Modify `MEMOIZED-CUT-ROD` to return not only the value but the actual > solution, too. ================================================ FILE: other/clrs/15/01/04.py ================================================ def memoized_cut_rod(length, prices): values = [-1] * (length + 1) choices = [-1] * (length + 1) def cut(n): if values[n] >= 0: return values[n] if n == 0: values[0] = 0 else: cut_options = range(1, min(len(prices), n + 1)) max_value = -1 for i in cut_options: value = prices[i] + cut(n - i) if max_value < value: max_value = value choices[n] = i values[n] = max_value return values[n] value = cut(length) cuts = [] while length > 0: cuts.append(choices[length]) length -= choices[length] return (value, cuts) ================================================ FILE: other/clrs/15/01/04.test.py ================================================ import unittest cut_rod = __import__('04').memoized_cut_rod class MemoizedRodCuttingTest(unittest.TestCase): def setUp(self): self.prices = [0, 1, 5, 8, 9, 10, 17, 17, 20, 24, 30] def test_cutting_without_a_cost(self): self.assertEqual(cut_rod(1, self.prices), (1, [1])) self.assertEqual(cut_rod(2, self.prices), (5, [2])) self.assertEqual(cut_rod(3, self.prices), (8, [3])) self.assertEqual(cut_rod(4, self.prices), (10, [2, 2])) self.assertEqual(cut_rod(5, self.prices), (13, [2, 3])) self.assertEqual(cut_rod(6, self.prices), (17, [6])) self.assertEqual(cut_rod(7, self.prices), (18, [1, 6])) self.assertEqual(cut_rod(8, self.prices), (22, [2, 6])) self.assertEqual(cut_rod(9, self.prices), (25, [3, 6])) self.assertEqual(cut_rod(10, self.prices), (30, [10])) self.assertEqual(cut_rod(40, self.prices), (120, [10, 10, 10, 10])) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/01/05.dot ================================================ digraph { node[shape=circle]; subgraph { r5_5[label=5]; r4_4[label=4]; r4_3[label=3]; r3_3_1[label=3]; r3_2_1[label=2]; r3_2_2[label=2]; r3_1_2[label=1]; r2_2_1[label=2]; r2_1_1[label=1]; r2_1_2[label=1]; r2_0_2[label=0]; r2_1_3[label=1]; r2_0_3[label=0]; r1_1[label=1]; r1_0[label=0]; r5_5 -> r4_4; r5_5 -> r4_3; r4_4 -> r3_3_1; r4_4 -> r3_2_1; r4_3 -> r3_2_2; r4_3 -> r3_1_2; r3_3_1 -> r2_2_1; r3_3_1 -> r2_1_1; r3_2_1 -> r2_1_2; r3_2_1 -> r2_0_2; r3_2_2 -> r2_1_3; r3_2_2 -> r2_0_3; r2_2_1 -> r1_1; r2_2_1 -> r1_0; } subgraph { 5; 4; 3; 2; 1; 0; 5 -> 4; 5 -> 3; 4 -> 3; 4 -> 2; 3 -> 2; 3 -> 1; 2 -> 1; 2 -> 0; } } ================================================ FILE: other/clrs/15/01/05.markdown ================================================ > The Fibonacci numbers are defined by recurrence (3.22). Give a $\O(n)$-time > dynamic-programming algorithm to compute the $n$th Fibonacci number. Draw the > subproblem graph. How many vertices and edges are in the graph? We don't really need a dynamic programming approach, do we? Anyway, let's implement one. The subproblem graph is pretty trivial to draw, and I was going to skip the whole dot exercise, but then I drew it on paper, and there is a pretty interesting property. Specifically, the non-optimal version for solving $n$ has $F_n$ vertices, where $F_i$ is the $i$-th Fibonacci number. The other is pretty straightforward, although graphviz doesn't render it perfectly. ================================================ FILE: other/clrs/15/01/05.py ================================================ def fibonacci(n): results = [0] * (n + 1) results[1] = 1 for i in range(2, n + 1): results[i] = results[i - 1] + results[i - 2] return results[n] ================================================ FILE: other/clrs/15/01/05.test.py ================================================ import unittest fibonacci = __import__('05').fibonacci class FibonacciTest(unittest.TestCase): def test_cutting_without_a_cost(self): self.assertEqual(fibonacci(1), 1) self.assertEqual(fibonacci(2), 1) self.assertEqual(fibonacci(3), 2) self.assertEqual(fibonacci(4), 3) self.assertEqual(fibonacci(5), 5) self.assertEqual(fibonacci(6), 8) self.assertEqual(fibonacci(7), 13) self.assertEqual(fibonacci(8), 21) self.assertEqual(fibonacci(9), 34) self.assertEqual(fibonacci(10), 55) self.assertEqual(fibonacci(11), 89) self.assertEqual(fibonacci(12), 144) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/02/01.markdown ================================================ > Find an optimal parenthesization of a matrix-chain product whose sequence of > dimensions is $\langle 5, 10, 3, 12, 5, 50, 6 \rangle$. ================================================ FILE: other/clrs/15/02/01.py ================================================ import sys sizes = [30, 35, 15, 5, 10, 20, 25] def subscript(n): chars = "₀₁₂₃₄₅₆₇₈₉" result = [] while n: rem = n % 10 n //= 10 result.append(chars[rem]) return ''.join(reversed(result)) def order(dimensions): n = len(dimensions) - 1 memo = [[-1] * n for _ in range(n)] choices = [[-1] * n for _ in range(n)] for i in range(0, n): memo[i][i] = 0 for length in range(1, n): for start in range(0, n - length): end = start + length cheapest = sys.maxsize for split in range(start, end): cost = memo[start][split] + memo[split + 1][end] + \ dimensions[start] * dimensions[split + 1] * \ dimensions[end + 1] if cost < cheapest: cheapest = cost memo[start][end] = cost choices[start][end] = split def optimal(i, j): if i == j: return "A" + subscript(i) else: left = optimal(i, choices[i][j]) right = optimal(choices[i][j] + 1, j) return f"({left}{right})" return (memo[0][n - 1], optimal(0, n - 1)) ================================================ FILE: other/clrs/15/02/01.run.py ================================================ order = __import__('01').order dimensions = [5, 10, 3, 12, 5, 50, 6] print(order(dimensions)[1]) ================================================ FILE: other/clrs/15/02/02.markdown ================================================ > Give a recursive algorithm `MATRIX-CHAIN-MULTIPLY(A, s, i, j)` that actually > performs the optimal matrix-chain multiplication, given the sequence of > matrices $\langle A_1, A_2, \ldots, A_n \rangle$, the $s$ table computed > `MATRIX-CHAIN-ORDER`, and the indices $i$ and $j$. (The initial call would be > `MATRIX-CHAIN-MULTIPLY(A, s, 1, n)`.) Unless I'm missing something really clever, this is either super trivial, or a big annoyance in managing memory. The best way to do it is to just modify `PRINT-OPTIMAL-PARENS` to do the multiplication. The recursive structure of the algorithm is the same. ================================================ FILE: other/clrs/15/02/03.markdown ================================================ > Use the substitution method to show that the solution to the recurrence (15.6) > is $\Omega(2^n)$. The recurrence is: $$ P(n) = \begin{cases} 1 & \text{if } n = 1, \\\\ \sum_{k=1}^{n-1} P(k) P(n - k) & \text{if } n \ge 2 \end{cases} $$ Our guess is that $P(m) \ge c \cdot 2^m$. Trying to quantify $P(n)$, we get: $$ \begin{aligned} P(n) &= \sum_{k=1}^{n-1} P(k) P(n - k) \\\\ &\ge \sum_{k=1}^{n-1} c \cdot 2^k \cdot c \cdot 2^{n-k} \\\\ &= c^2 \sum_{k=1}^{n-1} 2^k 2^{n-k} \\\\ &= c^2 \sum_{k=1}^{n-1} 2^n \\\\ &= c^2 (n - 1) 2^n \\\\ &\ge c \cdot 2^{n} \end{aligned} $$ (when $c \ge 1$ and $n \ge 2$) ================================================ FILE: other/clrs/15/02/04.markdown ================================================ > Describe the subproblem graph for matrix-chain multiplication with an input > chain of length $n$. How many vertices does it have? How many edges does it > have, and which edges are they? Assuming this is the efficient algorithm, the graph has vertices $v_{ij}$ where $i \le j$. There are $1 + 2 + \ldots + n$ of them, which is $\frac{n(n+1)}{2}$, a boring old formula. As for edges, each vertex has two edges, $(v_{ij}, v_{ik})$ and $(v_{ij}, v_{k+1,j})$ for each $k$ such that $i \le k < j$. The sum is: $$ \sum_{i=1}^n \sum_{j=i}^n 2 (j - i) $$ This is probably expandable, but I'm not that hard-working. ================================================ FILE: other/clrs/15/02/05.markdown ================================================ > Let $R(i, j)$ be the number of times the table entry $m[i, j]$ is referenced > while computing other table entries in a call of `MATRIX-CHAIN-ORDER`. Show > that the total number of references for the entire table is > > $$ \sum_{i=1}^n \sum_{j=i}^n R(i, j) = \frac{n^3 - n}{3} $$ > > (_Hint:_ You may find equation (A.3) useful.) Let's observe the following about the loops: * The third loop ($k$) references $m$ twice. * The body of the third loop gets executed $j - i = l - 1$ times. * The body of the second loop gets executed $n - l + 1$ times. * The body of the first loop gets execute $n - 1$ times, with $l$ moving from $2$ to $n$. Thus, it's the following sum: $$ \sum_{l=2}^n 2(l - 1)(n - l + 1) $$ Now let's simplify: $$ \begin{aligned} \sum_{l=2}^n 2(l - 1)(n - l + 1) &= \sum_{l=1}^{n-1} 2l(n - l) \\\\ &= 2n \sum_{l=1}^{n-1} l - 2 \sum_{l=1}^{n-1} l^2 \\\\ &= 2n \frac{(n-1)n}{2} - 2\frac{(n - 1)((n - 1) + 1)(2(n - 1) + 1)}{6} \\\\ &= n^3 - n^2 - \frac{n(n - 1)(2n - 1)}{3} \\\\ &= \frac{1}{3} \left( 3n^3 - 3n^2 - 2n^3 + n^2 + 2n^2 -n \right) \\\\ &= \frac{1}{2} \left( n^3 - n \right) \\\\ &= \frac{n^3 - n}{3} \end{aligned} $$ I'm also struggling to figure out how this is different than the previous exercise. ================================================ FILE: other/clrs/15/02/06.markdown ================================================ > Show that a full parenthesization of an $n$-element expression has exactly $n > - 1$ pairs of parentheses. It clearly holds for $n = 1$ and $n = 2$. So using induction, if we have an $n$-element expression, where $n \ge 2$, that is fully parenthesized, by definition it is the product of two fully parenthesized expression of smaller length. Let $a$ be the length of the left one, and $b$ be the length of the right one. By the inductive step we know that the left has $a - 1$ pairs and the right has $b - 1$. Adding one more pair, we get $1 + a - 1 + b - 1 = a + b - 1 = n - 1$. ================================================ FILE: other/clrs/15/03/01.markdown ================================================ > Which is a more efficient way to determine the optimal number of > multiplications in a matrix-chain multiplication problem: enumerating all the > ways of parenthesizing the product and computing the number of multiplications > for each, or running `RECURSIVE-MATRIX-CHAIN`? Justify your answer. Obviously the dynamic programming approach. To keep it simple, if there is a split on $k$, the dynamic programming approach would calculate the possible parenthesizations of $A_k A_{k+1} \ldots A_j$ only once, while when enumerating, we'll calculate them once for each possible parenthesization of $A_i A_{i + 1} \ldots A_{k - 1}$. In fact, I fail to see how the original slow algorithm is not doing just that – enumerating all the ways in which the multiplication can be parenthesized. ================================================ FILE: other/clrs/15/03/02.markdown ================================================ > Draw the recursion tree for the `MERGE-SORT` procedure from Section 2.3.1 on > an array of 16 elements. Explain why memoization fails to speed up a good > divide-and-conquer algorithm such as `MERGE-SORT`. Because there is no subproblem overlap. Whenever merge sort splits an array, it produces unique partitions that don't occur anywhere else. I'm not gonna draw the tree, because it's kinda obvious once you've read the chapter. ================================================ FILE: other/clrs/15/03/03.markdown ================================================ > Consider a variant of the matrix-chain multiplication problem in which the > goal is to parenthesize the sequence of matrices so as to maximize, rather > than minimize, the number of scalar multiplications. Does this problem exhibit > optimal substructure? Yes it does. It changes the calculation, but the two important properties remain – there is an overlap of the subproblems and they are independent. ================================================ FILE: other/clrs/15/03/04.markdown ================================================ > As stated, in dynamic programming we first solve the subproblems and then > choose which of them to use in an optimal solution to the problem. Professor > Capulet clains that we do not always need to solve all the subproblems in > order to find an optimal solution. She suggests that we can find an optimal > solution to the matrix-chain multiplication problem by always choosing the > matrix $A_k$ at which to split the subproduct $A_i A_{i+1} \ldots A_j$ (by > selecting $k$ to minimize the quantity $p_{i-1} p_k p_j$) _before_ solving the > subproblems. Find an instance of the matrix-chain multiplication problem for > which this greedy approach yields a suboptimal solution. An example would be a matrix chain $10 \times 4 \times 3 \times 2$, where: $$ \begin{aligned} A_1 & \in \mathbb{R}^{10} \times \mathbb{R}^4 \\\\ A_2 & \in \mathbb{R}^4 \times \mathbb{R}^3 \\\\ A_3 & \in \mathbb{R}^3 \times \mathbb{R}^2 \\\\ \end{aligned} $$ The first choice would be whether to first multiply $A_1 A_2$ or $A_2 A_3$. Looking just at $p_{i-1} p_k p_j$, the options will be $$ \begin{aligned} C_1 &= p_1 p_2 p_4 = 10 \cdot 4 \cdot 2 &= 80 \\\\ C_2 &= p_1 p_3 p_4 = 10 \cdot 3 \cdot 2 &= 60 \\\\ \end{aligned} $$ With this information, ~~Juliet~~ Professor Capulet would opt in for the second option. Yet, this would be premature! In the second case, she will have to continue with then multiplying $A_1 A_2$ with $10 \cdot 4 \cdot 3 = 120$ additional scalar operations, bringing the tally to $180$. If she instead, chilled a bit and waited to see how things would play out, she would discover that in the other option there would be only $4 \cdot 3 \cdot 2 = 24$ more scalar operations to peform, in a total of $104$. ================================================ FILE: other/clrs/15/03/04.py ================================================ import sys sizes = [30, 35, 15, 5, 10, 20, 25] def subscript(n): chars = "₀₁₂₃₄₅₆₇₈₉" result = [] while n: rem = n % 10 n //= 10 result.append(chars[rem]) return ''.join(reversed(result)) def optimal(choices, i, j): if i == j: return "A" + subscript(i + 1) else: left = optimal(choices, i, choices[i][j]) right = optimal(choices, choices[i][j] + 1, j) return f"({left}{right})" def order(dimensions): n = len(dimensions) - 1 memo = [[-1] * n for _ in range(n)] choices = [[-1] * n for _ in range(n)] for i in range(0, n): memo[i][i] = 0 for length in range(1, n): for start in range(0, n - length): end = start + length cheapest = sys.maxsize for split in range(start, end): cost = memo[start][split] + memo[split + 1][end] + \ dimensions[start] * dimensions[split + 1] * \ dimensions[end + 1] if cost < cheapest: cheapest = cost memo[start][end] = cost choices[start][end] = split return (memo[0][n - 1], optimal(choices, 0, n - 1)) def greedy(dimensions): n = len(dimensions) - 1 memo = [[-1] * n for _ in range(n)] choices = [[-1] * n for _ in range(n)] for i in range(0, n): memo[i][i] = 0 for length in range(1, n): for start in range(0, n - length): end = start + length cheapest = sys.maxsize for split in range(start, end): cost = dimensions[start] * dimensions[split + 1] * \ dimensions[end + 1] if cost < cheapest: cheapest = cost memo[start][end] = cost + memo[start][split] + \ memo[split + 1][end] choices[start][end] = split return (memo[0][n - 1], optimal(choices, 0, n - 1)) ================================================ FILE: other/clrs/15/03/04.run.py ================================================ solution = __import__('04') example = [10, 4, 3, 2] def report(message, answers): multiplications, order = answers print(f"{message}: {order} with {multiplications} scalar multiplications") report("wise decision", solution.order(example)) report("poor decision", solution.greedy(example)) ================================================ FILE: other/clrs/15/03/05.markdown ================================================ > Suppose that in the rod-cutting problem of Section 15.1, we also had limit > $l_i$ on the number of pieces of length $i$ that we are allowed to produce, > for $i = 1, 2, \ldots, n$. Show that the optimal-substructure property > described in Section 15.1 no longer holds. A bit obviously, but the subproblems stop being independent now. When choosing a cut, we have to balance the remaining number of cuts to add up to at most a given number. I think this could be solved with tweaking the algorithm to use a table for memoization instead of an array, so we have both the rod length and the maximum number of cuts. Nobody is asking me to implement it, however, so I'll opt out not to. ================================================ FILE: other/clrs/15/03/06.markdown ================================================ > Imagine that you wish to exchange one currency for another. You realize that > instead of directly exchanging one currency for another, you might be better > of making a series of trades through other currencies, winding up with the > currency you want. Suppose that you can trade $n$ different currencies, > numbered $1, 2, \ldots, n$, where you start with currency $1$ and wish to wind > up with currency $n$. You are given, for each pair of currencies $i$ and $j$, > an exchange rate $r_{ij}$, meaning that if you start with $d$ units of > currency $i$, you can trade for $dr_{ij}$ units of currency $j$. A sequence of > trades may entail a commission, which depends on the number of trades you > make. Let $c_k$ be the commission that you are charged when you make $k$ > trades. Show that, if $c_k = 0$ for all $k = 1, 2, \ldots, n$, then the > problems of finding the best sequence of exchanges from currency $1$ to > currency $n$ exhibits optimal substructure. The show that if commissions $c_k$ > are arbitrary values, then the problem of finding the best sequence of > exchanges from currency $1$ to currency $n$ does not necessarily exhibit > optimal substructure. If $c_k = 0$, we can use the reasoning from the chapter. Let $t = 1 \rightsquigarrow a_1 \rightsquigarrow a_2 \rightsquigarrow \ldots \rightsquigarrow j$ be the optimal trade. If we pick any $a_k$, then both $p = 1 \rightsquigarrow a_1 \rightsquigarrow \ldots \rightsquigarrow a_k$ and $q = a_k \rightsquigarrow a_{k+1} \rightsquigarrow \ldots \rightsquigarrow j$ are optimal trades. If we assume otherwise, then there is a sequence $p'$ that is better than $p$, and we can use it trade $p' \rightsquigarrow q$, which would be a better trade than $t$, which is a contradiction. Now let's look at when commissions become a problem. Let's have 4 currencies, with the following trades: ```generate-dot digraph { rankdir="LR"; node[shape=circle]; edge[weight=2]; 1 -> 2 [label="x2"]; 2 -> 3 [label="x2"]; 3 -> 4 [label="x2"]; edge[weight=1]; 1 -> 3 [label="x3"]; } ``` Let's assume that unmarked trades are just not good enough. Let's also have: $$ c_0 = 0, c_1 = 1, c_2 = 2, c_3 = 50, c_4 = 50, \ldots $$ That is, the first two trades are cheap, but then it gets problematic. Let's assume we have $10$ units of currency $1$ and look at some optimal ways to trade $x \rightsquigarrow y$: $$ \begin{aligned} 1 \rightsquigarrow 4 &= 1 \rightarrow 3 \rightarrow 4 = 10 \cdot 3 \cdot 2 - c_1 - c_2 = 60 - 1 - 2 &= 57 \\\\ 1 \rightsquigarrow 3 &= 1 \rightarrow 2 \rightarrow 3 = 10 \cdot 2 \cdot 2 - c_1 - c_2 = 40 - 1 - 2 &= 37 \\\\ 3 \rightsquigarrow 4 &= 3 \rightarrow 4 = 10 \cdot 2 - c_1 = 20 - 1 &= 19 \\\\ \end{aligned} $$ The optimal way to trade $1 \rightsquigarrow 3$ would be to go through $2$ yielding $37$, instead of directly, yielding $29$. But if we combine that with the optimal way to go $3 \rightsquigarrow 4$, we get: $$ 1 \rightarrow 2 \rightarrow 3 \rightarrow 4 = 10 \cdot 2 \cdot 2 \cdot 2 - c_1 - c_2 - c_3 = 80 - 1 - 2 - 50 = 27 $$ Which is much less than $57$ if we just perform 2 trades. ================================================ FILE: other/clrs/15/04/01.markdown ================================================ > Determine an LCS of $\langle 1, 0, 0, 1, 0, 1, 0, 1 \rangle$ and $\langle 0, > 1, 0, 1, 1, 1, 0, 1, 1, 0 \rangle$. ================================================ FILE: other/clrs/15/04/01.py ================================================ def lcs(x, y): m = len(x) n = len(y) longest = [[0] * (n + 1) for _ in range(m + 1)] choices = [[' '] * (n + 1) for _ in range(m + 1)] for i in range(m): for j in range(n): if x[i] == y[j]: longest[i + 1][j + 1] = longest[i][j] + 1 choices[i + 1][j + 1] = '↖︎' elif longest[i][j + 1] >= longest[i + 1][j]: longest[i + 1][j + 1] = longest[i][j + 1] choices[i + 1][j + 1] = '↑' else: longest[i + 1][j + 1] = longest[i + 1][j] choices[i + 1][j + 1] = '←' result = [] a, b = m, n while a != 0 and b != 0: choice = choices[a][b] if choice == '↖︎': result.append(x[a - 1]) a -= 1 b -= 1 elif choice == '↑': a -= 1 elif choice == '←': b -= 1 result.reverse() return result ================================================ FILE: other/clrs/15/04/01.run.py ================================================ solution = __import__('01') a = [1, 0, 0, 1, 0, 1, 0, 1] b = [0, 1, 0, 1, 1, 1, 0, 1, 1, 0] print(solution.lcs(a, b)) ================================================ FILE: other/clrs/15/04/02.markdown ================================================ > Give pseudocode to reconstruct an LCS from the completed $c$ table and the > original sequences $X = \langle x_1, x_2, \ldots, x_m \rangle$ and $Y = > \langle y_1, y_2, \ldots, y_n \rangle$ in $O(m + n)$ time, without using the b > table. ================================================ FILE: other/clrs/15/04/02.py ================================================ def lcs(x, y): m = len(x) n = len(y) longest = [[0] * (n + 1) for _ in range(m + 1)] for i in range(m): for j in range(n): if x[i] == y[j]: longest[i + 1][j + 1] = longest[i][j] + 1 elif longest[i][j + 1] >= longest[i + 1][j]: longest[i + 1][j + 1] = longest[i][j + 1] else: longest[i + 1][j + 1] = longest[i + 1][j] result = [] a, b = m, n while a != 0 and b != 0: if longest[a - 1][b - 1] >= longest[a - 1][b] and longest[a - 1][b - 1] >= longest[a][b - 1]: result.append(x[a - 1]) a -= 1 b -= 1 elif longest[a - 1][b] >= longest[a][b - 1]: a -= 1 else: b -= 1 result.reverse() return result ================================================ FILE: other/clrs/15/04/02.test.py ================================================ import unittest lcs = __import__('02').lcs class LongestCommonSubsequenceTest(unittest.TestCase): def test_lcs(self): a = ['A', 'B', 'C', 'B', 'D', 'A', 'B'] b = ['B', 'D', 'C', 'A', 'B', 'A'] self.assertEqual(lcs(a, b), ['B', 'C', 'B', 'A']) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/04/03.markdown ================================================ > Give a memoized version of `LCS-LENGTH` that runs in $\O(mn)$ time. ================================================ FILE: other/clrs/15/04/03.py ================================================ def lcs(x, y): m = len(x) n = len(y) cache = {} def longest(a, b): if a == 0 or b == 0: return 0 if (a, b) in cache: return cache[(a, b)] result = None if x[a - 1] == y[b - 1]: result = 1 + longest(a - 1, b - 1) else: result = max(longest(a - 1, b), longest(a, b - 1)) cache[(a, b)] = result return result result = [] a, b = m, n while a != 0 and b != 0: if x[a - 1] == y[b - 1]: result.append(x[a - 1]) a -= 1 b -= 1 elif longest(a - 1, b) >= longest(a, b - 1): a -= 1 else: b -= 1 result.reverse() return result ================================================ FILE: other/clrs/15/04/03.test.py ================================================ import unittest lcs = __import__('03').lcs class LongestCommonSubsequenceTest(unittest.TestCase): def test_lcs(self): a = list("CGATAATTGAGA") b = list("GTTCCTAATA") self.assertEqual(lcs(a, b), list("CTAATA")) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/04/04.markdown ================================================ > Show how to compute the length of an LCS using only $2 \cdot \min(m, n)$ > entries in the $c$ table plus $\O(1)$ additional space. Then show how to do > the same thing, but using $\min(m, n)$ entries plus $\O(1)$ additional space. We just need to make a few observations: 1. In order to go for $\min(m, n)$, we need to make sure that $n$ is the smaller numbers, that is, exchange the strings if the second is longer. 2. Every time we calculate a row in $c$, we only consult the previous row and the current row up to the point at which we've built it. Therefore, we don't need to keep track of rows other than the previous. 3. When calculating the value in a row for index $j$, we only ever consult the previous row for index $j - 1$. Therefore, we can just keep track of a single array, with indices lower than $j$ referring to the current row, and indices higher or equal than $j$ referring to the previous row. Since we need $j - 1$ to calculate $j$, we keep track of it separately. ================================================ FILE: other/clrs/15/04/04.py ================================================ def lcs_twice(x, y): if len(x) < len(y): x, y = y, x m = len(x) n = len(y) previous = [0] * (n + 1) for i in range(m): current = [0] + [None] * n for j in range(n): if x[i] == y[j]: current[j + 1] = previous[j] + 1 elif previous[j + 1] >= current[j]: current[j + 1] = previous[j + 1] else: current[j + 1] = current[j] previous = current return previous[n] def lcs_once_plus_const(x, y): if len(x) < len(y): x, y = y, x m = len(x) n = len(y) row = [0] * (n + 1) for i in range(m): prev = 0 for j in range(n): next = row[j + 1] if x[i] == y[j]: row[j + 1] = prev + 1 elif row[j + 1] < row[j]: row[j + 1] = row[j] prev = next return row[n] ================================================ FILE: other/clrs/15/04/04.test.py ================================================ import unittest lcs = __import__('04') class LongestCommonSubsequenceTest(unittest.TestCase): def test_example_one(self): a = ['A', 'B', 'C', 'B', 'D', 'A', 'B'] b = ['B', 'D', 'C', 'A', 'B', 'A'] self.assertEqual(lcs.lcs_once_plus_const(a, b), len(['B', 'C', 'B', 'A'])) self.assertEqual(lcs.lcs_twice(a, b), len(['B', 'C', 'B', 'A'])) def test_example_two(self): a = list("CGATAATTGAGA") b = list("GTTCCTAATA") self.assertEqual(lcs.lcs_once_plus_const(a, b), len("CTAATA")) self.assertEqual(lcs.lcs_twice(a, b), len("CTAATA")) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/04/05.markdown ================================================ > Given an $\O(n^2)$-time algorithm to find the longest monotonically increasing > subsequence of a sequence of $n$ numbers. ================================================ FILE: other/clrs/15/04/05.py ================================================ def mono(items): best = [1] * len(items) choices = [None] * len(items) for j in range(1, len(items)): for i in range(0, j): if items[i] <= items[j] and best[j] <= best[i] + 1: best[j] = best[i] + 1 choices[j] = i n = max(range(0, len(items)), key=lambda x: (best[x], x)) result = [] while n is not None: result.append(items[n]) n = choices[n] result.reverse() return result ================================================ FILE: other/clrs/15/04/05.test.py ================================================ import unittest mono = __import__('05').mono class LongestMonotonicallyIncreasingSubsequenceTest(unittest.TestCase): def test_examples(self): self.assertEqual( mono([1, 2, 3, 10, 11, 4, 5, 8, 6, 7, 1]), [1, 2, 3, 4, 5, 6, 7] ) self.assertEqual( mono([8, 2, 4, 2]), [2, 2] ) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/04/06.markdown ================================================ > $\star$ Give an $\O(n \lg n)$-time algorithm to find the longest monotonically > increasing subsequence of a sequence of $n$ numbers. (_Hint:_ Observe that the > last element of a candidate subsequence of length $i$ is at least as large as > the last element of a candidate subsequence of length $i - 1$. Maintain > candidate subsequences by linking them through the input sequence.) This is a bit weird to explain. There are three parts to it. 1. We can hold an array, `longest`, that stores at position $i$ the so-far longest subsequence with length $i$. 2. Every time we process an element from the input sequence we can update `longest` with that element. If we map `longest` to the last element of each sequence, it's going to maintain an invariant of being sorted. 3. Since longest is sorted, we can use binary search to figure out where to put the next element from the input sequence. ================================================ FILE: other/clrs/15/04/06.py ================================================ def mono(items): last = 0 longest = [None] * len(items) longest[0] = dict(value=items[0], prev=None) def find_place(value): lo, hi = 0, last + 1 while lo < hi: mid = (lo + hi) // 2 if longest[mid]['value'] <= value: lo = mid + 1 else: hi = mid return (lo, longest[lo - 1] if lo > 0 else None) for i in range(1, len(items)): (index, prev) = find_place(items[i]) longest[index] = dict(value=items[i], prev=prev) last = max(last, index) result = [] node = longest[last] while node: result.append(node['value']) node = node['prev'] result.reverse() return result ================================================ FILE: other/clrs/15/04/06.test.py ================================================ import unittest import random mono = __import__('06').mono def quadratic(items): best = [1] * len(items) choices = [None] * len(items) for j in range(1, len(items)): for i in range(0, j): if items[i] <= items[j] and best[j] <= best[i] + 1: best[j] = best[i] + 1 choices[j] = i n = max(range(0, len(items)), key=lambda x: (best[x], x)) result = [] while n is not None: result.append(items[n]) n = choices[n] result.reverse() return result class FasterLongestMonotonicallyIncreasingSubsequenceTest(unittest.TestCase): def test_examples(self): self.assertEqual( mono([1, 2, 8, 9, 3, 4, 5]), [1, 2, 3, 4, 5] ) self.assertEqual( mono([1, 2, 3, 10, 11, 4, 5, 8, 6, 7, 1]), [1, 2, 3, 4, 5, 6, 7] ) self.assertEqual(mono([6, 6, 0, 4]), [0, 4]) self.assertEqual(mono([1, 2, 3, 4]), [1, 2, 3, 4]) def test_comparison(self): k = 500 n = 20 random.seed(0) for a in range(n): sequence = list(map(lambda _: random.randint(0, 9), range(k))) self.assertEqual(len(quadratic(sequence)), len(mono(sequence))) if __name__ == '__main__': unittest.main() ================================================ FILE: other/clrs/15/05/01.markdown ================================================ > Write pseudocode for the procedure `CONSTRUCT-OPTIMAL-BST(root)` which, given > the table $root$, outputs the structure of an optimal binary search tree. For > the example in Figure 15.10, your procedure should print the structure > > * $k_2$ is the root > * $k_1$ is the left child of $k_2$ > * $d_0$ is the left child of $k_1$ > * $d_1$ is the right child of $k_1$ > * $k_5$ is the right child of $k_2$ > * $k_4$ is the left child of $k_5$ > * $k_3$ is the left child of $k_4$ > * $d_2$ is the left child of $k_3$ > * $d_3$ is the right child of $k_3$ > * $d_4$ is the right child of $k_4$ > * $d_5$ is the right child of $k_5$ > > corresponding to the optimal binary search tree shown in Figure 15.9(b). This problem is not very compatible with my brain. The code is a bit messy, but it is what it is. ================================================ FILE: other/clrs/15/05/01.py ================================================ import math def table(h, w): return [[None] * (w + 1) for _ in range(h + 1)] def optimal(p, q): n = len(q) - 1 e = table(n + 1, n) w = table(n + 1, n) root = table(n, n) for i in range(1, n + 2): e[i][i - 1] = q[i - 1] w[i][i - 1] = q[i - 1] for l in range(1, n + 1): for i in range(1, n - l + 2): j = i + l - 1 e[i][j] = math.inf w[i][j] = w[i][j - 1] + p[j] + q[j] for r in range(i, j + 1): t = e[i][r - 1] + e[r + 1][j] + w[i][j] if t < e[i][j]: e[i][j] = t root[i][j] = r return (e, root) def dump_tree(root): next_d = -1 def d(): nonlocal next_d next_d += 1 return f"d{next_d}" def is_empty(start, end): return start == 0 or end == 0 or start == end + 1 def collect(start, end): split = root[start][end] if is_empty(start, split - 1): print(f"{d()} is the left child of k{split}") else: print(f'k{root[start][split - 1]} if left child of k{split}') collect(start, split - 1) if is_empty(split + 1, end): print(f"{d()} is the right child of k{split}") else: print(f'k{root[split + 1][end]} is right child of k{split}') collect(split + 1, end) print(f"k{root[1][len(root) - 1]} is the root") collect(1, len(root) - 1) ================================================ FILE: other/clrs/15/05/01.run.py ================================================ module = __import__('01') p = [None, 0.15, 0.10, 0.05, 0.10, 0.20] q = [0.05, 0.10, 0.05, 0.05, 0.05, 0.10] a, root = module.optimal(p, q) module.dump_tree(root) ================================================ FILE: other/clrs/15/05/02.markdown ================================================ > Determine the cost and structure of an optimal binary search tree for a set of > $n = 7$ keys with the following probabilities: > > | $i$ | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | > |:------|:-----|:-----|:-----|:-----|:-----|:-----|:-----|:-----| > | $p_i$ | | 0.04 | 0.06 | 0.08 | 0.02 | 0.10 | 0.12 | 0.14 | > | $q_i$ | 0.06 | 0.06 | 0.06 | 0.06 | 0.05 | 0.05 | 0.05 | 0.05 | ================================================ FILE: other/clrs/15/05/02.py ================================================ import math def table(h, w): return [[None] * (w + 1) for _ in range(h + 1)] def optimal(p, q): n = len(q) - 1 e = table(n + 1, n) w = table(n + 1, n) root = table(n, n) for i in range(1, n + 2): e[i][i - 1] = q[i - 1] w[i][i - 1] = q[i - 1] for l in range(1, n + 1): for i in range(1, n - l + 2): j = i + l - 1 e[i][j] = math.inf w[i][j] = w[i][j - 1] + p[j] + q[j] for r in range(i, j + 1): t = e[i][r - 1] + e[r + 1][j] + w[i][j] if t < e[i][j]: e[i][j] = t root[i][j] = r return (e, root) def dump_tree(root): next_d = -1 def d(): nonlocal next_d next_d += 1 return f"d{next_d}" def is_empty(start, end): return start == 0 or end == 0 or start == end + 1 def collect(start, end): split = root[start][end] if is_empty(start, split - 1): print(f"{d()} is the left child of k{split}") else: print(f'k{root[start][split - 1]} if left child of k{split}') collect(start, split - 1) if is_empty(split + 1, end): print(f"{d()} is the right child of k{split}") else: print(f'k{root[split + 1][end]} is right child of k{split}') collect(split + 1, end) print(f"k{root[1][len(root) - 1]} is the root") collect(1, len(root) - 1) ================================================ FILE: other/clrs/15/05/02.run.py ================================================ module = __import__('02') p = [None, 0.04, 0.06, 0.08, 0.02, 0.10, 0.12, 0.14] q = [0.06, 0.06, 0.06, 0.06, 0.05, 0.05, 0.05, 0.05] _, root = module.optimal(p, q) module.dump_tree(root) ================================================ FILE: other/clrs/15/05/03.markdown ================================================ > Suppose that instead of maintaining the table $w[i, j]$, we computed the value > of $w(i, j)$ directly from equation (15.12) in line 9 of `OPTIMAL-BST` and > used this computed value in line 11. How would this change affect the > asymptotic running time of `OPTIMAL-BST`? It will make line 9 linear instead of constant, but it will not increase the overall asymptotic time, since it's not in the innermost loop. Thus, it will remain $O(n^3)$. ================================================ FILE: other/clrs/15/05/04.markdown ================================================ > $\star$ Knuth [212] has shown that there are always roots of optimal subtrees > such that $root[i, j - 1] \le root[i, j] \le [root[i + 1, j]$ for all $1 \le i > < j \le n$. Use this fact to modify the `OPTIMAL-BST` procedure to run in > $\Theta(n^2)$ time. I'm not sure that is completely true, and I find this problem quite boring. Thus, I'm going to only leave [this Stack Overflow link][link]. [link]: https://stackoverflow.com/questions/16987670/dynamic-programming-why-knuths-improvement-to-optimal-binary-search-tree-on2 ================================================ FILE: other/clrs/C/01/01.markdown ================================================ > How many $k$-substrings does an $n$-string have? (Consider identical > $k$-substrings at different positions to be different.) How many substrings > does and $n$-string have in total? There are $S_k = n - k + 1$ possible substrings of length $k$ (one starting at the first position, one and the second, etc.) In total there are: $$ \begin{aligned} S &= S_1 + S_2 + \ldots + S_n \\\\ &= \sum_{i=1}^{n}S_i \\\\ &= \sum_{i=1}^{n}(n - i + 1) \\\\ &= \sum_{i=1}^{n}n - \sum_{i=1}^{n}i + \sum_{i=1}^{n}1 \\\\ &= n^2 - n(n + 1)/2 + n \\\\ &= n^2 - n^2/2 - n/2 + n \\\\ &= n(n + 1)/2 \qquad \text{(Duh!)} \end{aligned}$$ Obvious proof is obvious. ================================================ FILE: other/clrs/C/01/02.markdown ================================================ > An $n$-input, $m$-output **boolean function** is a function from > $\\{TRUE,FALSE\\}^n$ to $\\{TRUE,FALSE\\}^m$. How many $n$-input 1-output > boolean functions are there? How many $n$-input, $m$-output boolean functions > are there? There are $2^n$ possible inputs. We can represent the possible binary functions completely as binary numbers of $2^n$ digits. There $2^{2^n}$ of those. If there are $2^m$ possible outputs, we can represent the functions as numbers of $2^n$ digits in base $2^m$. This makes the answer of the second question: $$ (2^m)^{2^n} $$ ================================================ FILE: other/clrs/C/01/03.markdown ================================================ > In how many ways can $n$ professors sit around a circular conference table? > Consider two seatings to be the same if one can be rotated to form the other. If we pick a chair as the first one and a direction, in which the chairs are increasing, there are $n!$ ways to seat the professors. However, an arrangement $\\{1, 2, \ldots, n\\}$ is identical to $\\{2, 3, \ldots, n, 1\\}$ and there are $n$ of those identical arrangements (one starting on each professor). Since identical arrangements are in groups of size $n$, the total number of seatings is $n!/n = (n-1)!$. ================================================ FILE: other/clrs/C/01/04.markdown ================================================ > In how many ways can we choose three distinct numbers from the set > $\\{1,2,\ldots,99\\}$ so that their sum is even? There are 49 even numbers and 50 odd in that set. To get an even number, we either need two odd and one even or three even. $$ \langle \text{2 odd, 1 even} \rangle = 49\frac{50!}{2! \cdot 48!} = \frac{50 \cdot 49^2}{2} \\\\ \langle \text{3 even} \rangle = \frac{49!}{3! \cdot 46!} = \frac{49 \cdot 48 \cdot 47}{6} \\\\ \langle \text{even sum} \rangle = \frac{49 \cdot 48 \cdot 47}{6} + \frac{50 \cdot 49^2}{2} = 78449 $$ ================================================ FILE: other/clrs/C/01/05.markdown ================================================ > Prove the identity > > $$ \binom{n}{k} = \frac{n}{k}\binom{n-1}{k-1}$$ > > for $0 < k \le n$. $$ \binom{n}{k} = \frac{n!}{k!(n-k)!} = \frac{n}{k}\frac{(n-1)!}{(k-1)!(n-1-(k-1))!} = \frac{n}{k}\binom{n-1}{k-1}$$ ================================================ FILE: other/clrs/C/01/06.markdown ================================================ > Prove the identity > > $$ \binom{n}{k} = \frac{n}{n-k}\binom{n-1}{k} $$ > > for $0 \le k < n$. $$ \binom{n}{k} = \frac{n!}{k!(n-k)!} = \frac{n}{n-k}\frac{(n-1)!}{k!(n-1-k)!} = \frac{n}{n-k}\binom{n-1}{k} $$ ================================================ FILE: other/clrs/C/01/07.markdown ================================================ > To choose $k$ objects from $n$, you can make one of the objects distinguished > and consider whether the distinguished object is chosen. Use this approach to > prove that: > > $$ \binom{n}{k} = \binom{n-1}{k} + \binom{n-1}{k-1} $$ Given the distinguished object is chosen, there are $\binom{n-1}{k-1}$ ways to choose the others. If it is not chosen, there are $\binom{n-1}{k}$ ways to choose the objects. Adding those together yields the equality above. $$ \begin{aligned} \binom{n-1}{k} + \binom{n-1}{k-1} &= \frac{(n-1)!}{k!(n-1-k)!} + \frac{(n-1)!}{(k-1)!(n-1-k+1)!} \\\\ &= \frac{(n-1-k+1)(n-1)!}{k!(n-1-k+1)!} + \frac{k(n-1)!}{k!(n-1-k+1)!} \\\\ &= \frac{(n-1-k+1+k)(n-1)!}{k!(n-1-k+1)!} \\\\ &= \frac{n!}{k!(n-k)!} \\\\ &= \binom{n}{k} \end{aligned} $$ ================================================ FILE: other/clrs/C/01/08.markdown ================================================ > Using the result of exercise C.1-7, make a table for $n = 0, 1, \ldots, 6$ > and $0 \le k \le n$ of the binomial coefficients $\binom{n}{k}$ with > $\binom{0}{0}$ at the top, $\binom{1}{0}$ and $\binom{1}{1}$ on the next line, > and so forth. Such a table of binomial coefficients is called **Pascal's > triangle**. $$ 1 \\\\ 1 \quad 1 \\\\ 1 \quad 2 \quad 1 \\\\ 1 \quad 3 \quad 3 \quad 1 \\\\ 1 \quad 4 \quad 6 \quad 4 \quad 1 \\\\ 1 \quad 5 \quad 10 \quad 10 \quad 5 \quad 1 \\\\ 1 \quad 6 \quad 15 \quad 20 \quad 15 \quad 6 \quad 1 \\\\ 1 \quad 7 \quad 21 \quad 35 \quad 35 \quad 21 \quad 7 \quad 1 $$ ================================================ FILE: other/clrs/C/01/09.markdown ================================================ > Prove that > > $$ \sum_{i=1}^ni = \binom{n+1}{2} $$ $$ \sum_{i=1}^n = \frac{n(n+1)}{2} = \frac{(n+1)!}{2!(n+1-2)!} = \binom{n+1}{2} $$ Interesting. The second diagonals of Pascal's triangle appear to be the arithmetic series. ================================================ FILE: other/clrs/C/01/10.markdown ================================================ > Show that for any $n \ge 0$ and $0 \le k \le m$, the expression > $\binom{n}{k}$ achieves its maximum value when $k = \lfloor n/2 \rfloor$ or > $k = \lceil n/2 \rceil$. It's evident in Pascal's triangle, yet anyway. There are $k$ multipliers in the denominator of: $$ \binom{n}{k} = \frac{n!}{k!(n-k)!} $$ It's a question of minizing them. For $n/2 - k < i < n/2$, there would be $i$ pairs of the type $i(n-i)$. Those pairs are strictly greater than $i^2$. They are minized when $i$ is $n/2$ or the nearest integer. It's not bullet-proof, but it works. ================================================ FILE: other/clrs/C/01/11.markdown ================================================ > $\star$ Argue that for any integers $n \ge 0, j \ge 0, k \ge 0$ and $j + k \le n$, > > $$ \binom{n}{j+k} \le \binom{n}{j}\binom{n-j}{k} $$ > > Provide both an algebraic proof and an argument based on a method for > choosing $j + k$ items out of $n$. Give an example in which equality does not > hold. First, let's establish that, $j!k! \le (j+k)!$. Both sides have the same number of terms, but the right side has $k$ terms more - $(j+1)(j+2)\ldots(j+k)$ - that are greater than the corresponding terms on the left side $1\cdot2\cdot\ldots k$. Thus: $$ \binom{n}{j} \binom{n-j}{k} = \frac{n!}{j!(n-j)!} \frac{(n-j)!}{k!(n-j-k)!} = \frac{n!}{j!k!(n-j-k)!} \ge \frac{n!}{(j+k)!(n-j-k)!} = \binom{n}{j+k} $$ As for the argument, the right side is the number of ways in which we can: 1. Choose $j$ elements out of $n$ 2. Choose $k$ elements out of the remaining $n-j$ elements There are more ways to do that than just choosing $j+k$ elements out of $n$, because this implies some ordering in the choice. For example, if $j = k = 1$, there are two ways to pick two elements (each one first) with this approach, but only one otherwise. If $n = 4, j = k = 1$, then equality does not hold. ================================================ FILE: other/clrs/C/01/12.markdown ================================================ > $\star$ Use induction on all integers $k$ such that $0 \le k \le n/2$ to > prove inequality (C.6) and use equation (C.3) to extend it to all integers > $k$ such that $0 \le k \le n$. Thanks to [this answer](http://math.stackexchange.com/questions/533170/prove-an-upper-bound-for-the-binomials/533258?noredirect=1#533258), first we rearrange the inequality: $$ \binom{n}{k} \le \frac{n^n}{k^k(n-k)^{n-k}} \\\\ \Downarrow \\\\ \frac{k^k}{k!} \cdot \frac{(n-k)^{n-k}}{(n-k)!} \le \frac{n^n}{n!} \\\\ \Downarrow \\\\ \frac{k^k}{k!} \cdot \frac{m^m}{m!} \le \frac{(k+m)^{k+m}}{(k+m)!}$$ Where $m = n-k$. Then we need to know that $\Big(1 + \frac{1}{n}\Big)^n$ is monotonous. This is not that surprising, because: $$\lim_{x \to +\infty}\Big(1 + \frac{1}{n}\Big)^n = e$$ Finally, we go like this: $$ \begin{aligned} \frac{k^k}{k!} \cdot \frac{(m+1)^{m+1}}{(m+1)!} &= \frac{k^k}{k!} \cdot \frac{(m+1)^m}{m!} \\\\ &= \frac{k^k}{k!} \cdot \frac{m^m}{m!} \Bigg(1+\frac{1}{m}\Bigg)^m \\\\ &\le \frac{(k+m)^{k+m}}{(k+m)!}\Bigg(1+\frac{1}{m}\Bigg)^m & \text{(inductive hypothesis)} \\\\ &\le \frac{(k+m)^{k+m}}{(k+m)!}\Bigg(1+\frac{1}{k+m}\Bigg)^{k+m} & \text{(monotonicity)} \\\\ &= \frac{(k+m+1)^{k+m}}{(k+m)!} &= \frac{(k+m+1)^{k+m+1}}{(k+m+1)!} \end{aligned} $$ ================================================ FILE: other/clrs/C/01/13.markdown ================================================ > $\star$ Use Stirling's approximation to prove that > > $$ \binom{2n}{n} = \frac{2^{2n}}{\sqrt{\pi n}}(1 + \mathcal{O}(1/n)) $$ So: $$ \begin{aligned} \binom{2n}{n} &= \frac{(2n)!}{n!(2n-n)!} = \frac{(2n)!}{(n!)^2} \\\\ &= \frac{\sqrt{2 \pi 2 n}\big(\frac{2n}{e}\big)^{2n}\Big(1 + \Theta(\frac{1}{n})\Big)} {2 \pi n \big(\frac{n}{e}\big)^{2n}\Big(1 + \Theta(\frac{1}{n})\Big)^2} \\\\ &= \frac{1}{\sqrt{\pi n}} \frac{2^{2n}n^{2n}}{n^{2n}}(1 + \mathcal{O}(1/n)) \\\\ &= \frac{2^{2n}}{\sqrt{\pi n}}(1 + \mathcal{O}(1/n)) \end{aligned} $$ There is a little hand-waving at the end, but it is good enough. ================================================ FILE: other/clrs/C/01/14.markdown ================================================ > $\star$ By differentiating the entropy function $H(\lambda)$, show that it > achieves its maximum value at $\lambda = 1/2$. What is $H(1/2)$? Phew, it took me a while to figure out that I've forgotten calculus: $$ H(\lambda) = -\lambda\lg{\lambda} - (1 - \lambda)\lg(1 - \lambda) \\\\ \begin{aligned} H'(\lambda) &= -\lg{\lambda} - \frac{\lambda 1}{\lambda \ln2} + \lg(1 - \lambda) - \frac{(1-\lambda)}{(1-\lambda)(-1)\ln2} \\\\ &= \lg\frac{1 - \lambda}{\lambda} - \lg{e} + \lg{e} \\\\ &= \lg\frac{1 - \lambda}{\lambda} \end{aligned} $$ Let's find a critical point: $$ H'(\lambda) = 0 \\\\ \Downarrow \\\\ \lg\frac{1 - \lambda}{\lambda} = 0 \\\\ \Downarrow \\\\ \frac{1-\lambda}{\lambda} = 1 \\\\ \Downarrow \\\\ \lambda = 1/2 $$ Because $H'(1/4) = \lg{3} > 0$ and $H'(3/4) = \lg(1/3) < 0$, we know that it is a maxima. $$ H(1/2) = - \lg(1/2)/2 -\lg(1/2)/2 = - \lg{1/2} = 1 $$ ================================================ FILE: other/clrs/C/01/15.markdown ================================================ > $\star$ Show that for any integer $n \ge 0$, > > $$ \sum_{k=0}^n\binom{n}{k}k = n2^{n-1} $$ $$ \sum_{k=0}^n\binom{n}{k}k = \sum_{k=1}^n\binom{n}{k}k = \sum_{k=1}^n\frac{nk}{k}\binom{n-1}{k-1} = n\sum_{k=1}^n\binom{n-1}{k-1} = n\sum_{k=0}^n\binom{n-1}{k} = n2^{n-1} $$ ================================================ FILE: other/clrs/C/02/01.markdown ================================================ > Professor Rosencrantz flips a fair coin. Professor Guildenstern flips a fair > coin twice. What is the probability that Professor Rosencrantz obtains more > heads than professor Guildenstern? Let us call $G_n$ and $R_n$ the number of heads each professor has. The answer is: $$ \Pr\\{R_n = 1\\}.\Pr\\{G_n = 0\\} = \frac{1}{2}.\frac{1}{4} = \frac{1}{8} $$ ================================================ FILE: other/clrs/C/02/02.markdown ================================================ > Prove **Boole's inequality**: For any finite or countably infinte sequence of > events $A_1, A_2, \ldots$, > > $$ \Pr\\{A_1 \cup A_2 \cup \ldots \\} \le \Pr\\{A_1\\} + \Pr\\{A_2\\} + \ldots $$ $$ \begin{aligned} \Pr\\{A_1 \cup A_2 \cup \cdots\\} &= \Pr\\{A_1\\} + \Pr\\{A_2 \cup A_3 \cup \cdots\\} - \Pr\\{A_1 \cap (A_2 \cup A_3 \cup \cdots)\\} \\\\ & \le \Pr\\{A_1\\} + \Pr\\{A_2 \cup A_3 \cup \cdots\\} \\\\ & \le \Pr\\{A_1\\} + \Pr\\{A_2\\} + \Pr\\{A_3 \cup A_4 \cup \cdots\\} \end{aligned} $$ Strictly speaking, we should use some induction, but you get the idea. ================================================ FILE: other/clrs/C/02/03.markdown ================================================ > Suppose we shuffle a deck of 10 cards, each bearing a distinct number from 1 > to 10, to mix the cards thoroughly. We then remove three cards, one at a > time, from the deck. What is the probability that we select the three cards > in sorted (increasing) order? There are $n!/(n-k)!$ ways to pick $k$ cards. Out of those, only $\binom{n}{k}$ are ascending. Thus the probability is: $$ \binom{n}{k} \div \frac{n!}{(n-k)!} = \frac{n!(n-k)!}{k!(n-k)!n!} = \frac{1}{k!} $$ For three cards, this is $1/6$. I tried approaching this with probabilities, but it was way harder than just counting. Also, I wrote a small ruby program to verify my result ;) ================================================ FILE: other/clrs/C/02/04.markdown ================================================ > Prove that > > $$ \Pr\\{A | B\\} + \Pr\\{\overline A | B\\} = 1 $$ Very obvious if you think about it, but anyway: $$ \begin{aligned} \Pr\\{A|B\\} + \Pr\\{\overline A | B\\} &= \frac{\Pr\\{A \cap B\\}}{\Pr\\{B\\}} + \frac{\Pr\\{\overline A \cap B\\}}{\Pr\\{B\\}} \\\\ &= \frac{\Pr\\{A \cap B\\} + \Pr\\{\overline A \cap B\\}}{\Pr\\{B\\}} \\\\ &= \frac{\Pr\\{(\overline A \cap B) \cup (A \cap B)\\}}{\Pr\\{B\\}} \\\\ &= \frac{\Pr\\{(A \cup \overline A) \cap B)}{\Pr\\{B\\}} \\\\ &= \frac{\Pr\\{B\\}}{\Pr\\{B\\}} \\\\ &= 1 \end{aligned} $$ ================================================ FILE: other/clrs/C/02/05.markdown ================================================ > Prove that for any collection of events $A_1,A_2,\ldots,A_n$ > > $$ \Pr\\{A_1 \cap A_2 \cap \cdots \cap A_n\\} = \Pr\\{A_1\\} \cdot \Pr\\{A_2 | A_1\\} \cdot > \Pr\\{A_3 | A_1 \cap A_2\\} \cdots \Pr\\{A_n | A_1 \cap A_2 \cap \cdots \cap A_{n-1}\\} $$ This is nice $$ \begin{aligned} \Pr\\{A_1 \cap A_2 \cap \cdots\\} &= \Pr\\{A_n | A_1 \cap \cdots \cap A_{n-1}\\} \cdot \Pr\\{A_1 \cap \cdots \cap A_{n-1}\\} \\\\ &= \Pr\\{A_n | A_1 \cap \cdots \cap A_{n-1}\\} \cdot \Pr\\{A_{n-1} | A_1 \cap \cdots \cap A_{n-2}\\} \cdot \Pr\\{A_1 \cap \cdots \cap A_{n-2}\\} \\\\ &= \ldots \\\\ &= \Pr\\{A_n | A_1 \cap \cdots \cap A_{n-1}\\} \cdots \Pr\\{A_3 | A_1 \cap A_2\\} \cdot \Pr\\{A_2 | A_1\\} \cdot \Pr\\{A_1\\} \end{aligned} $$ ================================================ FILE: other/clrs/C/02/06.markdown ================================================ > $\star$ Describe a procedure that takes as input two integers $a$ and $b$ > such that $0 < a < b$ and, using fair coin flips, produces as output heads > with probability $a/b$ and tails with probability $(b-a)/b$. Give a bound on > the expected number of coin flips, which should be $\mathcal{O}(1)$. (Hint: > represent $a/b$ in binary.) This is actually tricky. Fortunatelly, [this answer][answer] helper me. [answer]: http://math.stackexchange.com/questions/63207/produce-output-with-certain-probability-using-fair-coin-flips You represent $a/b$ as binary. Then you start flipping coins and expect each flip to match a digit (0 for heads, 1 for tails). If you expect a 0, but get 1, you return tail. If you expect 1 and get a 0, you return heads. Otherwise, you keep doing it. To put it otherwise, just the flips produce a random number in binary. If you expect 0, but get 1, then you have produced a number greated than $a/b$. Otherwise, you have produced a number less than it. The probability of terminating is $1/2$ at each flip. The expected number of throws is: $$ \sum_{r=1}^{\infty}\frac{r}{2^r} = \frac{1/2}{1/4} = 2 $$ Don't know when this came from? Well, for $k < 1$: $$ \sum_{k=0}^{\infty}kx^k = \frac{x}{(1 - x)^2} $$ How do you get that, you ask? You just integrate this sum: $$ \sum_{k=0}^{\infty}x^k = \frac{1}{1-x} $$ Mindblowing. ================================================ FILE: other/clrs/C/02/07.markdown ================================================ > $\star$ Show how to construct a set of $n$ events that are pairwise > independent but such that no subset of $k > 2$ of them is mutually > independent. Get a dice with $n^2$ sides (you can actually construct one of those). Assign the numbers $1 \ldots n$ to $n$ colors, non of which is black. Use each color to paint $n-1$ sides, paint one side striped with all colors, and paint the rest black. Here's a table: | | 1 | 2 | 3 | ... | n | |:-------:|:---:|:---:|:---:|:---:|:-:| | **1** | 1 | 2 | 3 | ... | n | | **2** | 1 | 2 | 3 | ... | n | | **3** | 1 | 2 | 3 | ... | n | | ... | ... | ... | ... | ... | n | | **n-1** | 1 | 2 | 3 | ... | n | | **n** | all | - | - | ... | - | Counting the side painted with all colors, there are $(n-1 + 1)/n^2 = 1/n$ ways to get each color. For any two colors, there are $1/n^2$ ways, which satisfies the equation for independence. However, for $k$ colors, the chances are too $1/n^2$, where they should be $1/n^k$ if that event was independent. Thus, each pair is independent, but each subset with three or more elements is not. I'm actually quite proud of this solution. There is an [interesting article](http://www.pme-math.org/journal/issues/PMEJ.Vol.9.No.9.pdf) in the Pi Mu Epsilon Journal, vol 9, 1993 ================================================ FILE: other/clrs/C/02/08.markdown ================================================ > $\star$ Two events $A$ and $B$ are **conditionally independent**, given $C$, > if > > $$ \Pr\\{A \cap B | C\\} = \Pr\\{A | C\\} \cdot \Pr\\{B | C\\} $$ > > Give a simple but nontrivial example of two events that are not independent > but are conditionally independent given a third event. Two people use the same coin. * **A** - person 1 tosses heads * **B** - person 2 tosses heads * **C** - the coin is biased (falls heads only) - happens one in three times Thus: $$ \Pr\\{A\\} = \frac 1 3 \cdot 1 + \frac 2 3 \cdot \frac 1 2 = \frac 2 3 \\\\ \Pr\\{B\\} = \frac 1 3 \cdot 1 + \frac 2 3 \cdot \frac 1 2 = \frac 2 3 \\\\ \Pr\\{A \cap B\\} = \frac 1 3 \cdot 1 + \frac 2 3 \cdot \frac 1 4 = \frac 1 2 $$ The two events are not independent, because: $$ \frac 2 3 = \Pr\\{A \cap B\\} \neq \Pr\\{A\\} \cdot \Pr\\{B\\} = \frac 4 9 $$ However, they are conditionally independent, because: $$ 1 = \Pr\\{A \cap B | C \\} = \Pr\\{A | C\\} \cdot \Pr\\{B | C\\} = 1 $$ ================================================ FILE: other/clrs/C/02/09.markdown ================================================ > $\star$ You are a contestant in a game show in which a prize is hidden behind > one of three curtains. You will win the prize if you select the correct > curtain. After you have picked one curtain but before the curtain is lifted, > the emcee lifts one of the other curtains, knowing that it will reveal an > empty stage, and asks if you would like to switch from your current selection > to the remaining curtain. How would your chances change if you switch? (This > question is the celebrated **Monty Hall problem**, named after a game-show > host who often presented contestants with just this dilemma.) This is [very popular](http://en.wikipedia.org/wiki/Monty_Hall_problem). If you are always given this choice and take it: * If you picked the right curtain (probability $1/3$), you will switch to an empty stage * If you picked a wrong curtain (probability $2/3$), you will switch to the prize (that's the only option, since the other empty stage is shown) Effectively, you interchange success and failure. That way, the probability to win is $2/3$ and you should always take it (if the choice is given to you in an unbiased fashion). ================================================ FILE: other/clrs/C/02/10.markdown ================================================ > $\star$ A prison warden has randomly picked one prisoner among three to go > free. The other two will be executed. The guard knows which one will go free > but is forbidden to give any prisoner information regarding his status. Let > us call the prisoners X, Y and Z. Prisoner X asks the guard privately which > of Y or Z will be executed, arguing that since he already knows that at least > one of them must die, the guard won't be revealing any information about his > own status. The guard tells X that Y is to be executed. Prisoner X feels > happier now, since he figures that either he or prisoner Z will go free, > which means that his probability of going free is now $1/2$. Is he right, or > are his chances still $1/3$? Explain. Obviously the event took place before prisoner X obtained that knowledge and this should not impact his chances in anyway. But words are cheap, let's use math: * **y** is the event of the guard saying prisoner Y will be executed * **X**, **Y** and **Z** are the events of each prisoner going free * If X is going free, the guard has a 50% of saying Y is executed $$ \Pr\\{y|X\\} = \frac 1 2 \\\\ \Pr\\{y\\} = \Pr\\{y \cap X\\} + \Pr\\{y \cap Y\\} + \Pr\\{y \cap Z\\} = \frac 1 3 \cdot \frac 1 2 + \frac 1 3 \cdot 0 + \frac 1 3 \cdot 1 = \frac 1 6 + \frac 1 3 = \frac 1 2 \\\\ \Pr\\{X|y\\} = \frac{\Pr\\{y|X\\} \cdot \Pr\\{X\\}}{\Pr\\{y\\}} = \frac{\frac 1 2 \cdot \frac 1 3}{\frac 1 2} = \frac 1 3 $$ This one is also [very popular](http://en.wikipedia.org/wiki/Three_Prisoners_problem) ================================================ FILE: other/clrs/C/03/01.markdown ================================================ > Suppose we roll two ordinary, 6-sided dice. What is the expectation of the > sum of two values showing? What is the expectation of the maximum of two > values showing? The expectation of the sum is: $$ \begin{aligned} \E[X] &= \sum_{x=2}^{12}x\Pr\\{X = x\\} \\\\ &= 2 \cdot \frac 1 36 + 3 \cdot \frac 2 36 + 4 \cdot \frac 3 36 + 5 \cdot \frac 4 36 + 6 \cdot \frac 5 36 + 7 \cdot \frac 6 36 + 8 \cdot \frac 5 36 + 9 \cdot \frac 4 36 + 10 \cdot \frac 3 36 + 11 \cdot \frac 2 36 + 12 \cdot \frac 1 36 \\\\ &= 7 \end{aligned}$$ The result is as expected, the probabilities are obtained by just counting them. As for the maximum, a table helps illustrate the probabilities: | | 1 | 2 | 3 | 4 | 5 | 6 | |:-----:|:-:|:-:|:-:|:-:|:-:|:-:| | **1** | 1 | 2 | 3 | 4 | 5 | 6 | | **2** | 2 | 2 | 3 | 4 | 5 | 6 | | **3** | 3 | 3 | 3 | 4 | 5 | 6 | | **4** | 4 | 4 | 4 | 4 | 5 | 6 | | **5** | 5 | 5 | 5 | 5 | 5 | 6 | | **6** | 6 | 6 | 6 | 6 | 6 | 6 | There is a nice geometrical interpretation here. In any case, the chance of $n$ being the maximum of two dice is $(2n-1)/36$. Thus: $$ \E[Y] = \sum_{i=1}^{6}i\Pr\\{Y = i\\} = \sum_{i=1}^{6}\Bigg(i \cdot \frac{2i - 1}{36}\Bigg) = \frac{2\sum{i^2} - \sum{i}}{36} = \frac{(6 \cdot 7 \cdot 13)/6 - (6 \cdot 7)/2}{36} = \frac{161}{36} = 4.47\ldots $$ ================================================ FILE: other/clrs/C/03/02.markdown ================================================ > An array $A[1\ldots n]$ contains $n$ distinct numbers that are randomly > ordered, with each permutation of the $n$ numbers equally likely. What is the > expectation of the index of the maximum element in the array? What is the > expectation of the minimum element of the array? The expectation of the max element having an index $i$ is $\Pr\\{X = i\\} = \frac 1 n$. $$ \E[X] = \sum_{i=1}^n i \cdot \Pr\\{X = i\\} = \sum_{i=1}^n i \cdot \frac 1 n = \frac 1 n \sum_{i=1}^n i = \frac 1 n \frac{n(n+1)}{2} = \frac{n+1}{2} $$ Not a surprising result. Curious: the same logic applies for the minimum element. Thus, the expectation for the index of the minimum element is the same. ================================================ FILE: other/clrs/C/03/03.markdown ================================================ > A carnival game consists of three dice in a cage. A player can be a dollar on > any of the numbers 1 through 6. The cage is shaken, and the payoff is as > follows. If the player's number doesn't appear on any of the dice, he loses > his dollar. Otherwise, if his number appears on exactly $k$ of the three > dice, for $k = 1, 2, 3$, he keeps his dollar and wins $k$ more dollars. What > is the expected gain from playing the carnival game once? Here are the probabilities: $$ \Pr\\{X = 3\\} = 1/216 \\\\ \Pr\\{X = 2\\} = 3(6/216) - 3(1/126) = 5/216 \\\\ \Pr\\{X = 1\\} = 3(36/216) - 3(11/216) = 75/216 \\\\ \Pr\\{X = 1\\} = 125/216 $$ (There are 36 ways that a specific die is $k$, but in 10 of them one of the other die is also $k$ and in one of them both are). Here's the calculation: $$ \begin{aligned} \E[X] &= -1 \cdot \Pr\\{X = 0\\} + 1 \cdot \Pr\\{X = 1\\} + 2 \cdot \Pr\\{X = 2\\} + 3 \cdot \Pr\\{X = 3\\} \\\\ &= - 1 \cdot \frac{125}{216} + 1 \cdot \frac{75}{216} + 2 \cdot \frac{15}{216} + 3 \cdot \frac{1}{216} \\\\ &= - \frac{17}{216} \\\\ &= -0.07\ldots \end{aligned} $$ Turns out you loose ever so slightly. This did not match my intuition. ================================================ FILE: other/clrs/C/03/04.markdown ================================================ > Argue that if $X$ and $Y$ are nonnegative random variables, then > > $$ \E[\max(X, Y)] \le \E[X] + \E[Y] $$ There is a hidden assumption that $X$ and $Y$ are on the same domain (otherwise, you can't define $\max(X, Y)$). The expectations can be expanded as this: $$ \E[\max(X, Y)] = \sum n \cdot \max(\Pr\\{X = n\\}, \Pr\\{Y = n\\}) \\\\ \E[X] = \sum n \Pr\\{X = n\\} \qquad \E[X] = \sum n \Pr\\{Y = n\\} $$ Each of the summands in the first formula appears in either $\E[X]$ or $\E[Y]$. Their sum contains twice as many, all nonnegative. That makes it equal or greater. ================================================ FILE: other/clrs/C/03/05.markdown ================================================ > $\star$ Let $X$ and $Y$ be independent random variables. Prove that $f(X)$ > and $g(Y)$ are independent for any choice of functions $f$ and $g$. **(UNSOLVED)** This is so intuitively obvious, that I have a hard time wanting to do it. On the other hand, intuition disagrees with many things in probability thoery. Either way, I have no clue what to do with $\Pr\\{f(X)\\}$, so I don't know how to prove it. ================================================ FILE: other/clrs/C/03/06.markdown ================================================ > $\star$ Let $X$ be a nonnegative random variable, and suppose that $E[Y]$ is > well defined. Prove **Markov's inequality**: > > $$ \Pr\\{X \ge t\\} \le \E[X]/t $$ > > for all $t > 0$. $$ \begin{aligned} \E[X] &= \sum_{x}x \cdot \Pr\\{X \ge t\\} \\\\ &= \sum_{x < t}x \cdot \Pr\\{X = x\\} + \sum_{x \ge t} x \cdot \Pr\\{X = x\\} \\\\ & \ge \sum_{x < t}x \cdot \Pr\\{X = x\\} + \sum_{x \ge t} t \cdot \Pr\\{X = x\\} \\\\ & \ge t \sum_{x \ge t} \Pr\\{X = x\\} \\\\ &= t \cdot \Pr\\{X \ge t\\} \end{aligned} $$ Chaning $x$ with $t$ in one of the sum works, since that is the sum where $x \ge t$. Thus follows: $$ \E[X] \ge t \cdot \Pr\\{X \ge t\\} \\\\ \Downarrow \\\\ \Pr\\{X \ge t\\} \le \E[X]/t $$ ================================================ FILE: other/clrs/C/03/07.markdown ================================================ > Let $S$ be a sample space, and let $X$ and $X'$ be random variables such that > $X(s) \ge X'(s)$ for all $s \in S$. Prove that for any real constant $t$, > > $$ \Pr\\{X \ge t\\} \ge \Pr\\{X' \ge t\\} $$ Both of them, expanded, are: $$ \Pr\\{X \ge t\\} = \sum_{s \in S:X(s) \ge t}\Pr\\{s\\} \\\\ \Pr\\{X' \ge t\\} = \sum_{s \in S:X'(s) \ge t}\Pr\\{s\\} $$ Each term of the second sum is present in the first sum, because $X(s) \ge X'(s)$. This makes them at least equal. There might be additional terms in the first sum (when $X(s) \ge t > X'(s)$. Thus it can also be greater. ================================================ FILE: other/clrs/C/03/08.markdown ================================================ > Which is larger: The expectation of the square of a random variable, or the > square of its expectation? We know that: $$ \E[f(X)] \ge f(\E[X]) $$ If $f(x) = x^2$: $$ \E[X^2] \ge \E^2[X] $$ The expectation of the square is larger. ================================================ FILE: other/clrs/C/03/09.markdown ================================================ > Show that for any random variable $X$ that takes on only the values $0$ and > $1$, we have $\Var[X] = \E[X]\E[1-X]$. Let's first calculate the expectations: $$ \E[X] = 0 \cdot \Pr\\{X = 0\\} + 1 \cdot \Pr\\{X = 1\\} = \Pr\\{X = 1\\} \\\\ \E[1-X] = \Pr\\{X = 0\\} \\\\ \E[X]\E[1-X] = \Pr\\{X = 0\\} \cdot \Pr\\{X = 1\\} $$ Now - the variance: $$ \Var[X] = \E[X^2] - \E^2[X] = \Pr\\{X = 1\\} - (\Pr\\{X = 1\\})^2 = \Pr\\{X = 1\\} (1 - \Pr\\{X = 1\\}) = \Pr\\{X = 0\\} \cdot Pr\\{X = 1\\} $$ ================================================ FILE: other/clrs/C/03/10.markdown ================================================ > Prove that $\Var[\alpha X] = \alpha^2 \Var[X]$ from the definition (C.27) of > variance. Easy. We just use the linearity of expectation: $$ \Var[\alpha X] = \E[\alpha^2 X^2] - \E^2[\alpha X] = \alpha^2 \E[X^2] - \alpha^2\E[X] = \alpha^2 (\E[X^2] - \E^2[X]) = \alpha^2 \Var[X] $$ ================================================ FILE: other/clrs/C/04/01.markdown ================================================ > Verify axiom 2 of the probability axioms for the geometric distribution. $$ \sum_{k=1}^{\infty} \Pr\\{X = k\\} = \sum_{k=1}^{\infty} q^{k-1}p = p \sum_{k=0}^{\infty} q^k = p \frac{1}{1-q} = \frac{p}{p} = 1 $$ ================================================ FILE: other/clrs/C/04/02.markdown ================================================ > How many times on average must we flip 6 fair coins before we obtain 3 heads > and 3 tails? The $\binom{6}{3}$ ways to have three heads and three tails. Thus: $$ \Pr\\{\text{3H3T}\\} = \binom{6}{3} / 2^6 = 5/16 $$ As for the expectation: $$ \E[\text{3H3T}] = \frac{1}{\Pr\\{\text{3H3T}\\}} = \frac{16}{5} = 3.2 $$ This can be verified by the following line of Ruby: 1_000_000.times.map { 1.upto(2**32).take_while { 6.times.map { rand(2) }.count(1) != 3 }.last.to_i.succ }.inject(:+) / 1_000_000.to_f ================================================ FILE: other/clrs/C/04/03.markdown ================================================ > Show that $b(k;n,p) = b(n-k;n,q)$, where $q = 1 - p$. $$ b(k;n,p) = \binom{n}{k} p^k q^{n-k} = \binom{n}{n-k} p^k q^{n-k} = \binom{n}{n-k} q^{n-k} p^k = b(n-k;n,q) $$ ================================================ FILE: other/clrs/C/04/04.markdown ================================================ > Show that value of the maximum of the binomial distribution $b(k;n,p)$ is > approximately $1/\sqrt{2 \pi n p q}$ where $q = 1 - p$. There is a lot of calculation to be performed here, but this is essentially an application of the [de Moivre-Laplace theorem][de-moivre-laplace]. It's too complex for me to want to bother to write it down. [de-moivre-laplace]: http://en.wikipedia.org/wiki/De_Moivre%E2%80%93Laplace_theorem ================================================ FILE: other/clrs/C/04/05.markdown ================================================ > $\star$ Show that the probability of no successes in $n$ Bernoulli trials, > each with probability $p = 1/n$, is approximately $1/e$. Show that the > probability of exactly one success is also $1/e$ The probability of no successes of $n$ trials is: $$ b(0;n,p) = \binom{n}{k} p^k q^{n-k} = \binom{n}{0} q^n = (1-p)^n = \Big(1 - \frac{1}{n}\Big)^n = \frac{1}{\Big(1-\frac{1}{n}\Big)^{-n}} $$ The probability of one success of $n$ trials is: $$ b(1;n,p) = \binom{n}{1} \frac{1}{n} \bigg(1 - \frac{1}{n}\bigg)^{n-1} = \frac{1}{\Big(1-\frac{1}{n}\Big)^{-(n-1)}} $$ We know that: $$ e = \lim_{n \to \infty}\bigg(1 + \frac{1}{n}\bigg)^n = \lim_{n \to \infty}\bigg(1 - \frac{1}{n}\bigg)^{-n} $$ We can just substitute in the examples above and get approximately $1/e$. ================================================ FILE: other/clrs/C/04/06.markdown ================================================ > $\star$ Professor Rosencrantz flips a fair coin $n$ times, and so does > Professor Guildenstern. Show that the probability that they get the same > number of heads is $\binom{2n}{n}/4^n$. (Hint: For Professor Rosencrantz, > call a head a success; for Professor Guildenstern, call a tail a success.) > Use your argument to verify the identity > > $$ \sum_{k=0}^n\binom{n}{k}^2 = \binom{2n}{n} $$ Let's do what the hint says: call tails for Professor Guildenstern a success and heads - failure. They have the same numbers of heads when they have $k + (n - k) = n$ successes out of $2n$ trials. $$ \Pr\\{R=G\\} = b(n;2n;1/2) = \binom{2n}{n} \frac{1}{2^n} \frac{1}{2^n} = \binom{2}{n}/4^n $$ Alternatively, we can just calculate the probability and see what happens: $$ \begin{aligned} \Pr\\{R=G\\} &= \sum_{k=0}^n \Pr\\{R=k\\}\Pr\\{G=n-k\\} \\\\ &= \sum_{k=0}^n \binom{n}{k} \cdot \frac{1}{2^n} \cdot \binom{n}{n-k} \cdot \frac{1}{2^n} \\\\ &= \frac{1}{4^n} \sum_{k=0}^n \binom{n}{k} \binom{n}{n-k} \\\\ &= \frac{1}{4^n} \sum_{k=0}^n \binom{n}{k}^2 \end{aligned} $$ Those are two ways we can express the same value. This let's us verify the identity. ================================================ FILE: other/clrs/C/04/07.markdown ================================================ > $\star$ Show that for $0 \le k \le n$, > > $$ b(k;n,1/2) \le 2^{nH(k/n)-n} $$ > > where $H(x)$ is the entropy function (C.7) $$ b(k;n,1/2) = \binom{n}{k}\frac{1}{2^n} = \binom{n}{n\frac{k}{n}}\frac{1}{2^n} \le \frac{2^{nH(k/n)}}{2^n} = 2^{nH(k/n) - n} $$ ================================================ FILE: other/clrs/C/04/08.markdown ================================================ > $\star$ Consider $n$ Bernoulli trials, where $i = 1, 2, \ldots, n$, the $i$th > trial has probability $p_i$ of success, and let $X$ be the random variable > denoting the total number of successes. Let $p \ge p_i$ for all $i = 1, 2, > \ldots, n$. Prove that $1 \le k \le n$, > > $$ \Pr\\{X < k\\} \ge \sum_{i=0}^{k-1}b(i;n,p) $$ Let's create another set of Bernoulli trials $Y$, each with probability $p$. $$ \Pr\\{Y < k\\} = 1 - \Pr\\{Y \ge k\\} \le 1 - \Pr\\{X \ge k\\} = \Pr\\{X < k\\} $$ The inequality follows from exercise C.4-9. That's right. We haven't done it yet, but we're using it. That's because I'm the Doctor! ================================================ FILE: other/clrs/C/04/09.markdown ================================================ > $\star$ Let $X$ be the random variable for the total number of successes, in > a set $A$ of $n$ Bernoulli trials, where the $i$th trial has a probability > $p_i$ of success, and let $X'$ be the random variable for the total number of > successes in a second set $A'$ of $n$ Bernoulli trials, where the $i$th trial > has a probability $p_i' \ge p_i$ of success. Prove that $o \le k \le n$, > > $$ \Pr\\{X' \ge k\\} \ge \Pr\\{X \ge k\\} $$ > > (Hint: Show how to obtain the Bernoulli trials in $A'$ by an experiment > involving the trials of $A$, and use the result of exercise C.3-7) Let $Y_1, Y_2, \ldots Y_n$ be indicator random variables for the events in $A$. Let $Z_1, Z_2, \ldots Z_n$ be new random variables, such that: * If $Y_i = 1$ then $Z_i = 1$ * If $Y_i = 0$ then $Z_i = 1$ with probability $\frac{p_i' - p_i}{1-p_i}$ Let's calculate $\Pr\\{Z_i\\}$: $$ \Pr\\{Z_i\\} = p_i \Pr\\{Y_i = 1\\} + (1 - p_i) \cdot \frac{p_i' - p_i}{1-p_i} = p_i + p_i' - p_i = p_i' $$ Since we know that $p_i' \ge p_i$, we can do the following: $$ \Pr\\{X' \ge k\\} = \Pr\\{Z_1 + Z_2 + \ldots + Z_n\\} \ge \Pr\\{Y_1 + Y_2 + \ldots + Y_n\\} = \Pr\\{X \ge k\\} $$ The last part can also be proven by exercise C.3-7. ================================================ FILE: other/clrs/C/05/01.markdown ================================================ > $\star$ Which is less likely: obtaining no heads when you flip a coin $n$ > times, or obtaining fewer than $n$ heads when you flip the coin $4n$ times? **(UNSOLVED)** I can't figure out how to compare them, but testing with Ruby yields that it is less likely to get less than $n$ heads in $4n$ flips. ================================================ FILE: other/clrs/C/05/02.markdown ================================================ > $\star$ Prove corollaries C.6 and C.7 Let $Y$ be a random variable, indicating the number of failures. For C.6 (using C.4): $$ \Pr\\{X > k\\} = \Pr\\{Y < n-k\\} < \frac{(n-k)p}{nq - n + k}b(n-k;n,q) = \frac{(n-k)p}{k-np}\binom{n}{n-k}q^{n-k}p^k = \frac{(n-k)p}{k-np}b(k;n,p) $$ For C.7 (using C.5): $$ \Pr\\{Y < n - k\\} < \frac{1}{2} \Pr\\{Y < n - k + 1\\} \\\\ \Downarrow \\\\ \Pr\\{X > k\\} < \frac{1}{2} \Pr\\{X > k - 1\\} $$ ================================================ FILE: other/clrs/C/05/03.markdown ================================================ > $\star$ Show that > > $$ \sum_{i=0}^{k-1}\binom{n}{i}a^i < (a+1)^n \frac{k}{na - k(a+1)}b(k;n,a/(a+1)) $$ > > for all $a > 0$ and all $k$ such that $0 < k < na/(a+1)$. $$ \begin{aligned} (a+1)^n \frac{k}{na - k(a+1)}b(k;n,a/(a+1)) &= (a+1)^n \frac{k \frac{1}{a+1}}{\frac{na-ak-a}{a+1}} b(k;n,a/(a+1)) & \text{(C.4)} \\\\ &> (a+1)^n \sum_{i=0}^{k-1}b(i;n,a/(a+1)) \\\\ &= (a+1)^n \sum_{i=0}^{k-1}\binom{n}{i}\frac{a^i}{(a+1)^i}\frac{1}{(a+i)^{n-i}} \\\\ &= (a+1)^n \frac{1}{(a+1)^n} \sum_{i=0}^{k-1}\binom{n}{i}a^i \\\\ &= \sum_{i=0}^{k-1}\binom{n}{i}a^i \end{aligned} $$ ================================================ FILE: other/clrs/C/05/04.markdown ================================================ > $\star$ Prove that if $0 < k < np$, where $0 < p < 1$ and $q = 1 - p$, then > > $$ \sum_{i=0}^{k-1}p^iq^{n-i} < \frac{kq}{np-k} > \bigg(\frac{np}{k}\bigg)^k > \bigg(\frac{nq}{n-k}\bigg)^{n-k} $$ $$ \begin{aligned} \sum_{i=0}^{k-1}p^iq^{n-i} &= \Pr\\{X < k\\} & \text{(C.4)} \\\\ &< \frac{kq}{np - k} b(k;n,p) & \text{(C.1)} \\\\ &< \frac{kq}{np - k} \bigg(\frac{np}{k}\bigg)^k \bigg(\frac{nq}{n-k}\bigg)^{n-k} \end{aligned} $$ ================================================ FILE: other/clrs/C/05/05.markdown ================================================ > $\star$ Show that the conditions of theorem C.8 imply that > > $$ \Pr\\{\mu - X \ge r\\} \le \bigg(\frac{(n - \mu)e}{r}\bigg)^r $$ > > Similarly, show that the conditions of corollary C.9 imply that > > $$ \Pr\\{np - X \ge r\\} \le \bigg(\frac{nqe}{r}\bigg)^r $$ This is tricky. Let's introduce a new random variable $Y = n - X$. $$ \nu = E[Y] = E[n - X] = n - E[x] = n - \mu $$ Using theorem C.8, we get: $$ \Pr\\{Y - \nu > r\\} \le \bigg(\frac{\nu e}{r}\bigg)^r \\\\ \Downarrow \\\\ \Pr\\{\mu - X \ge r\\} \le \bigg(\frac{(n - \mu)e}{r}\bigg)^r $$ It's similar with the other one, where $qn = (1-p)n = n - np$: $$ \Pr\\{np - X\\} = \Pr\\{n - X - n + np\\} = \Pr\\{Y - qn > r\\} \le \bigg(\frac{nqe}{r}\bigg)^r $$ ================================================ FILE: other/clrs/C/05/06.markdown ================================================ > $\star$ Consider a sequence of $n$ Bernoulli trials, where in the $i$th > trial, for $i = 1, 2, \ldots, n$, success occurs with probability $p_i$ and > failure occurs with probability $q_i = 1 - p_i$. Let $X$ be the random > variable describing the total number of successes, and let $\mu = \E[X]$. > Show that for $r \ge 0$, > > $$ \Pr\\{X - \mu \ge r\\} \le e^{-r^2/2n} $$ > > (Hint: Prove that $p_i e^{\alpha q_i} + q_i e^{-\alpha p_i} \le e^{\alpha^2/2}$. > Then follow the outline of the proof of Theorem C.8, using this inequality in > place of inequality (C.45).) This is tricky. I spent quite a while and I don't like it. Anyway, let's first prove the hint. Let: $$ f(x) = e^{x^2/2} - (pe^{qx} + qe^{-px}) $$ We want to prove that it is monotoneously increasing when $x \ge 0$. It is not very easy to show that $f'(x) > 0$, so let's show that $f'(x)$ is also monotoneously increasing by solving $f''(x) > 0$. $$ f'(x) = xe^{x^2/2} - pq(qe^{qx} - pe^{-px}) \\\\ f''(x) = e^{x^2/2} + x^2 e^{x^2/2} - pq(qe^{qx} + pe^{-px}) > 0 \\\\ \Downarrow \\\\ \text{(} x^2 e^{x^2/2} \text{ is positive)} \\\\ \Downarrow \\\\ e^{x^2/2} > pq(qe^{qx} + pe^{-px}) \\\\ \Downarrow \\\\ \text{(} pq < \frac{1}{4} \text{ from } x(1-x) - 1/4 < 0 \text{)} \\\\ \Downarrow \\\\ e^{x^2/2} > \frac{1}{4}(qe^{qx} + pe^{-px}) \\\\ \Downarrow \\\\ \text{(} p < 1, q < 1 \text{)} \\\\ \Downarrow \\\\ 4e^{x^2/2} > e^{qx} + e^{-px} \\\\ \Downarrow \\\\ \text{(} e^{qx} + e^{-px} = e^{-px} (e^x + 1) < e^x + 1 \text{)} \\\\ \Downarrow \\\\ 4e^{x^2/2} > e^x + 1 \\\\ \Downarrow \\\\ (e^{x^2/2} > 1) \\\\ \Downarrow \\\\ 3e^{x^2/2} > e^x \\\\ \Downarrow \\\\ 3e^{x^2/2 - x} > 1 \\\\ \Downarrow \\\\ 3e^{\frac{(x-1)^2}{2} - \frac{1}{2}} > 1 \\\\ \Downarrow \\\\ 3 > \sqrt{e} $$ Since $f''(0) = 0$, then $f'(x)$ is increasing for $x \ge 0$. Since $f'(0) = 0$, then $f(x)$ is increasing for $x \ge 0$. Since $f(0) = 0$, then $f(x) \ge 0$, hence the inequality holds. We can just substitute it in the expectation: $$ \begin{aligned} \E[e^{\alpha (X_i - p_i)}] &= e^{\alpha(1-p_i)}p_i + e^{\alpha(0-p_i)}q_i \\\\ &= p_i e^{\alpha q_i} + q_i e^{- \alpha p_i} \\\\ &\le e^{\alpha^2/2} \end{aligned} $$ Then: $$ \begin{aligned} \E[e^{\alpha(X - \mu)}] &= \prod_{i=1}^n \E[e^{\alpha(X_i - p_i)}] \\\\ &\le \prod_{i=1}^n \exp(\alpha^2 / 2) \\\\ &= \exp(n \alpha^2/2) \end{aligned} $$ And: $$ \begin{aligned} \Pr\\{X - \mu \ge r\\} &\le \exp(n \alpha^2/2)/\exp(- \alpha r) \\\\ &= \exp(n\alpha^2/2 - \alpha r) \\\\ &= \exp\bigg(\frac{n r^2}{2 n^2} - \frac{r^2}{n}\bigg) \\\\ &= \exp\bigg(-\frac{r^2}{2n}\bigg) \end{aligned} $$ ================================================ FILE: other/clrs/C/05/07.markdown ================================================ > $\star$ Show that choosing $\alpha = \ln(r/\mu)$ minimizes the right-hand > side of inequality (C.47). This is simple. Let: $$ f(x) = \exp(mu e^{\alpha} - r) $$ Let's explore it's critical points: $$ f'(x) = \exp(\mu e^{\alpha} - r)(\mu e^{\alpha} - r) = 0$$ This has a solution for $\alpha = \ln(r/\mu)$. It's easy to see that left of this point $f'(x)$ is negative and right of it it is positive. Thus, it is a local minima. ================================================ FILE: other/clrs/C/problems/01.markdown ================================================ ## Balls and bins > In this problem, we investigate the effect of various assumptions on the > number of ways of placing $n$ balls into $b$ distinct bins. > > 1. Suppose that the $n$ balls are distinct and their order within a bin does > not matter. Argue that the number of ways of placing the balls in the bins > is $b^n$. > 2. Suppose that the balls are distinct and that the balls in each bin are > ordered. Prove that there are exactly $(b + n - 1)!/(b - 1)!$ ways to > place the balls in the bins. (Hint: Consider the number of ways of > arranging $n$ distinct balls and $b-1$ indistinguishable stricks in a > row). > 3. Suppose that the balls are identical, and hence their order within a bin > does not matter. Show that the number of ways of placing the balls in the > bins is $\binom{b+n-1}{n}$. (Hint: Of the arrangements in part (b), how > many are repeated if the balls are made identical?) > 4. Suppose that the balls are identical and that no bin may contain more than > one balls, so that $n \le b$. Show that the number of ways of placing the > balls is $\binom{b}{n}$. > 5. Suppose that the balls are identical and that no bin may be left empty. > Assuming that $n \ge b$, show that the number of ways of placing the balls > is $\binom{n-1}{b-1}$. ### Distinct balls, unordered There are $b$ ways to place the first ball, then $b$ ways to place the second and so on. There are $n$ balls, so the total number of ways is $b^n$. ### Distinct balls, ordered As the hint indicates, this is isomporhic to arranging $n + b - 1$ items, out of which $b - 1$ are separators. The balls before the first separator go in the first bin, those between the first and the second go in the second bin, etc. There are $(n + b - 1)!$ ways to do that, but since the order of the separators does not matter, $(b - 1)!$ out of those are duplicated. Thus the answer is $(b + n - 1)!/(b - 1)!$. ### Identical balls, unordered There are $(b + n - 1)!/(b - 1)!$ ways if the balls are distinct. If they are made identical, $n!$ of the arrangements are repeated for each position of the separators. We get $\frac{(b + n - 1)!}{n!(b - 1)!} = \binom{b + n - 1}{n}$ arrangements. ### Identical balls, max 1 per bin This is reduced to selecting $n$ of the $b$ bins to put balls in, which is the definition of binomial coefficients - $\binom{b}{n}$. ### Identical balls, no bin left empty This is fun. First, we put a ball in each bin and we're left with $n - b$ balls to put in $b$ bins. Now lets use part (c) - substituting $n - b$ for $n$, we get: $$ \binom{b + n - b - 1}{n - b} = \binom{n - 1}{n - b} = \binom{n - 1}{n - 1 - n + b} = \binom{n - 1}{b - 1} $$ ================================================ FILE: other/clrs/Gemfile ================================================ source 'https://rubygems.org' gem 'coderay' gem 'nokogiri' gem 'rake' gem 'redcarpet' gem 'sassc' gem 'shotgun' gem 'sinatra' gem 'tilt' ================================================ FILE: other/clrs/Rakefile ================================================ require_relative 'build/build' desc 'Build all the static files' task :build do Generator.generate end desc 'Clean all the compiled things' task :clean do Pathname(__FILE__).dirname.join('target/compiled').rmtree Pathname(__FILE__).dirname.join('target/bin').rmtree end desc 'Start a local server for files' task :server do system 'rackup' end desc 'Copies all the files to ita.skanev.com' task :deploy => :build do system 'scp -r target/compiled/* ita.skanev.com:~/www' end namespace :test do desc 'Run the tests for an exercise' task :exercise, :chapter, :section, :number do |t, args| exercise = Exercise.new ChapterNumber.new(args[:chapter]), args[:section], args[:number] exercise.run_tests end desc 'Run the tests of a problem' task :problem, :chapter, :number do |t, args| problem = Problem.new ChapterNumber.new(args[:chapter]), args[:number] problem.run_tests end end namespace :run do desc 'Run the code of an exercise' task :exercise, :chapter, :section, :number do |t, args| exercise = Exercise.new ChapterNumber.new(args[:chapter]), args[:section], args[:number] exercise.run_all end desc 'Run the code of a problem' task :problem, :chapter, :number do |t, args| problem = Problem.new ChapterNumber.new(args[:chapter]), args[:number] problem.run_all end end ================================================ FILE: other/clrs/build/app.rb ================================================ require 'sinatra' require 'pathname' require_relative 'build' set :root, File.dirname(__FILE__) set :public_folder, Proc.new { File.join(root, 'public') } set :views, Proc.new { File.join(root, 'views') } get '/' do catalog = Catalog.new SOLUTION_ROOT Renderer.render_catalog catalog end get '/index.?:format?' do catalog = Catalog.new SOLUTION_ROOT Renderer.render_catalog catalog end get '/:chapter/problems/:number.png' do problem = Problem.new ChapterNumber.new(params[:chapter]), params[:number] content_type 'image/png' Graph.render_png problem.graph_path end get '/:chapter/problems/:number.svg' do problem = Problem.new ChapterNumber.new(params[:chapter]), params[:number] content_type 'image/svg+xml' Graph.render_svg problem.graph_path end get '/:chapter/problems/:number.?:format?' do catalog = Catalog.new SOLUTION_ROOT problem = Problem.new ChapterNumber.new(params[:chapter]), params[:number] Renderer.render_problem problem, catalog end get '/:chapter/:section/:number.png' do exercise = Exercise.new ChapterNumber.new(params[:chapter]), params[:section], params[:number] content_type 'image/png' Graph.render_png exercise.graph_path end get '/:chapter/:section/:number.drawing.:index.svg' do exercise = Exercise.new ChapterNumber.new(params[:chapter]), params[:section], params[:number] content_type 'image/svg+xml' Graph.render_drawing exercise.draw_path, params[:index] end get '/:chapter/:section/:number.svg' do exercise = Exercise.new ChapterNumber.new(params[:chapter]), params[:section], params[:number] content_type 'image/svg+xml' Graph.render_svg exercise.graph_path end get '/:chapter/:section/:number.?:format?' do catalog = Catalog.new SOLUTION_ROOT exercise = Exercise.new ChapterNumber.new(params[:chapter]), params[:section], params[:number] Renderer.render_exercise exercise, catalog end get '/css/clrs.css' do content_type 'text/css' Renderer.render_css end ================================================ FILE: other/clrs/build/build.rb ================================================ require 'pathname' require 'fileutils' require 'open3' require 'tilt' require 'redcarpet' require 'sassc' require 'nokogiri' require 'coderay' require_relative 'lib/chapter_number' require_relative 'lib/catalog' require_relative 'lib/solution' require_relative 'lib/exercise' require_relative 'lib/problem' require_relative 'lib/renderer' require_relative 'lib/generator' require_relative 'lib/graph' require_relative 'lib/runtimes' require_relative 'lib/runtimes/c' require_relative 'lib/runtimes/python' SOLUTION_ROOT = Pathname(__FILE__).dirname.join('..').expand_path VIEWS_ROOT = Pathname(__FILE__).dirname.join('views/').expand_path PUBLIC_ROOT = Pathname(__FILE__).dirname.join('public/').expand_path EXT_ROOT = Pathname(__FILE__).dirname.join('ext').expand_path ================================================ FILE: other/clrs/build/ext/debug_helpers.h ================================================ #include void fprint_array(FILE *stream, int array[], int length) { fprintf(stream, "["); for (int i = 0; i < length; i++) { fprintf(stream, "%d", array[i]); if (i < length - 1) { fprintf(stream, ", "); } } fprintf(stream, "]"); } ================================================ FILE: other/clrs/build/ext/drawing.py ================================================ import sys import re from collections import deque from subprocess import Popen, PIPE, STDOUT unique = 0 def unique_number(): global unique unique += 1 return unique class RedBlackTrees: class Node: def __init__(self, value, left=None, right=None, label=None, extra=[]): self.id = unique_number() self.value = value self.label = label or value self.left = left self.right = right self.extra = extra def dot(self, nils=True): def nil_node(n): return f'nil{n}[shape=point];' nodes = [] edges = [] lines = [] lines.append("graph {") lines.append(" node[shape=circle, style=filled];") lines.append("") nodes.append(self.node()) for item in self.bfs(): if item.left: nodes.append(item.left.node()) edges.append(f"{item.name()} -- {item.left.name()};") elif nils: n = unique_number() nodes.append(nil_node(n)) edges.append(f"{item.name()} -- nil{n};") if item.right: nodes.append(item.right.node()) edges.append(f"{item.name()} -- {item.right.name()};") elif nils: n = unique_number() nodes.append(nil_node(n)) edges.append(f"{item.name()} -- nil{n};") for node in nodes: lines.append(f" {node}") lines.append("") for edge in edges: lines.append(f" {edge}") lines.append("}") lines.append("") return "\n".join(lines) def name(self): return f"n{self.id}" def node(self): attrs = ", ".join([f"label=\"{self.label}\"", *self.attributes(), *self.extra]) return f"{self.name()}[{attrs}];" def bfs(self): queue = deque() queue.append(self) while queue: item = queue.popleft() yield item if item.left: queue.append(item.left) if item.right: queue.append(item.right) class Red(Node): def attributes(self): return ['fillcolor=red', 'fontcolor=white'] class Black(Node): def attributes(self): return ['fillcolor=black', 'fontcolor=white'] class Gray(Node): def attributes(self): return ['fillcolor=gray', 'fontcolor=white'] def svg(dot): with Popen(['dot', '-Tsvg'], stdin=PIPE, stdout=PIPE, stderr=STDOUT) as p: output = p.communicate(bytes(dot, 'utf-8'))[0] return output.decode() def process(drawings): command = sys.argv[1] if command == 'list': for (i, drawing) in enumerate(drawings): number = '{:02d}'.format(i + 1) name = re.sub('^.*?(\d+)/(\d+|problems)/(\d+)\.draw.py', f'\\1/\\2/\\3.drawing.{number}.svg', sys.argv[0]) print("{} {} {} {}".format(number, name, 'true' if drawing['display'] else 'false', drawing['name'])) elif command == 'draw': index = int(sys.argv[2]) - 1 dot = drawings[index]['dot'] print(svg(dot)) elif command == 'debug': index = int(sys.argv[2]) - 1 dot = drawings[index]['dot'] print(dot) else: raise f"Uknown commands: {repr(sys.argv)}" ================================================ FILE: other/clrs/build/ext/test.h ================================================ #include #include #include #include "debug_helpers.h" /* * A small testing library I'm writing for the Introduction to Algorithms * study group. It will probably be expanded as we go. */ /* * State and initialization. */ const char *test_current_name; const char *test_last_assert_file; int test_last_assert_line; int test_failures; int test_runs; jmp_buf test_on_fail; void test_initialize() { test_current_name = ""; test_last_assert_file = ""; test_last_assert_line = -1; test_runs = 0; test_failures = 0; } /* * Reporting test runs */ void test_report_assertion_error(const char *assertion_name) { fprintf(stderr, "%s:%d: %s (%s)\n", test_current_name, test_last_assert_line, assertion_name, test_last_assert_file ); } int test_report_results() { if (test_runs == 0) { fprintf(stderr, "No tests were ran ;(\n"); return -1; } if (test_failures) { fprintf(stderr, "\n"); printf("FAILURE %d test(s), %d failure(s)\n", test_runs, test_failures); return 1; } printf("OK %d test(s)\n", test_runs); return 0; } /* * Running a test */ void run_test(const char *name, void (*code)()) { test_current_name = name; test_last_assert_file = ""; test_last_assert_line = -1; test_runs++; if (setjmp(test_on_fail)) { test_failures++; } else { code(); } } void abort_test() { longjmp(test_on_fail, 1); } /* * Assertions */ #define ASSERT_SAME_ARRAYS(a, b) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_same_arrays(a, b, sizeof(a) / sizeof(a[1]), sizeof(b) / sizeof(b[1])) #define ASSERT_SAME_ARRAYS_S(a, b, s) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_same_arrays(a, b, s, s) void assert_same_arrays(int a[], int b[], int l1, int l2) { if (l1 != l2) goto report_failure; for (int i = 0; i < l1; i++) if (a[i] != b[i]) goto report_failure; return; report_failure: test_report_assertion_error("assert_same_arrays"); fprintf(stderr, " expected "); fprint_array(stderr, a, l1); fprintf(stderr, "\n to equal "); fprint_array(stderr, b, l2); fprintf(stderr, "\n"); abort_test(); } #define ASSERT_EQUALS(a, b) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_equals(a, b) void assert_equals(int a, int b) { if (a != b) { test_report_assertion_error("assert_equals"); fprintf(stderr, " expected %d\n", a); fprintf(stderr, " to equal %d\n", b); fprintf(stderr, "\n"); abort_test(); } } #define ASSERT_EQUALS(a, b) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_equals(a, b) void assert_true(int v) { if (!v) { test_report_assertion_error("assert_true"); fprintf(stderr, "expected a truth\n"); fprintf(stderr, "\n"); abort_test(); } } void assert_false(int v) { if (v) { test_report_assertion_error("assert_false"); fprintf(stderr, "expected a falsity\n"); fprintf(stderr, "\n"); abort_test(); } } #define ASSERT_TRUE(a) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_true(a) #define ASSERT_FALSE(a) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_false(a) void assert_null(void *v) { if (v) { test_report_assertion_error("assert_null"); fprintf(stderr, "expected null\n"); fprintf(stderr, "\n"); abort_test(); } } void assert_not_null(void *v) { if (!v) { test_report_assertion_error("assert_not_null"); fprintf(stderr, "expected not null\n"); fprintf(stderr, "\n"); abort_test(); } } #define ASSERT_NULL(a) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_null(a) #define ASSERT_NOT_NULL(a) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ assert_not_null(a) void fail(const char *message, ...) { va_list args; va_start(args, message); test_report_assertion_error("fail"); fprintf(stderr, "Failure:\n "); vfprintf(stderr, message, args); fprintf(stderr, "\n"); abort_test(); } #define FAIL(...) \ test_last_assert_file = __FILE__; \ test_last_assert_line = __LINE__; \ fail(__VA_ARGS__) /* * Defining tests */ #define TEST(NAME) \ void NAME##_test_code(); \ void run_##NAME() { run_test(#NAME, &NAME##_test_code); } \ void NAME##_test_code() ================================================ FILE: other/clrs/build/lib/catalog.rb ================================================ class Catalog Chapter = Struct.new(:number, :sections, :problems) Section = Struct.new(:number, :exercises) Position = Struct.new(:before, :after) class << self def locate new Pathname(__FILE__).join('../../..') end end def initialize(root_dir) @root = root_dir end def chapters @chapters ||= find_chapters end def solutions load_solutions_and_positions @solutions end def positions load_solutions_and_positions @positions end def previous(solution) positions[solution.name].before end def next(solution) positions[solution.name].after end private def load_solutions_and_positions return if @solutions && @positions @solutions = {} @positions = {} solutions = chapters.flat_map { |chapter| chapter.sections.flat_map(&:exercises) + chapter.problems } before = nil solutions.each do |solution| name = solution.name @positions[before.name].after = solution if before @solutions[name] = solution @positions[name] = Position.new before, nil before = solution end @solutions end def find_chapters Dir.chdir @root do dirs = glob('.', '[0-9][0-9]').to_a + glob('.', '[ABCD]').to_a dirs.map do |dir| number = ChapterNumber.new dir sections = find_sections number problems = find_problems number Chapter.new number, sections, problems end end end def find_sections(chapter) glob chapter, '[0-9][0-9]' do |number| exercises = find_exercises chapter, number Section.new number.to_i, exercises end end def find_exercises(chapter, section) glob "#{chapter}/#{section}", '[0-9][0-9]', 'markdown' do |number| Exercise.new chapter, section, number end end def find_problems(chapter) dir = Pathname("#{chapter}/problems") return [] unless dir.exist? glob dir, '[0-9][0-9]', 'markdown' do |number| Problem.new chapter, number end end def glob(dir, pattern, extension = nil, &block) pattern = "#{pattern}.#{extension}" if extension matches = Dir.chdir(dir) { Dir.glob(pattern) } matches = matches.map { |name| name.gsub(/\.#{extension}$/, '') } if extension matches.sort.map(&block) end end ================================================ FILE: other/clrs/build/lib/chapter_number.rb ================================================ class ChapterNumber def initialize(name) @name = case name when /^(\d+)$/ then name.to_i when /^[ABCD]$/ then name else raise "Invalid chapter name: #{name}" end end def name case @name when Integer then '%02d' % @name when String then @name else raise '???' end end def short_name @name.to_s end def inspect "#" end alias to_s name alias to_str to_s end ================================================ FILE: other/clrs/build/lib/exercise.rb ================================================ class Exercise include Solution def initialize(chapter, section, number) @chapter = chapter @section = section.to_i @number = number.to_i end def components [@chapter, @section, @number] end def name "#{@chapter.short_name}.#@section.#@number" end def title "Exercise #{name}" end def location '%s/%02d/%02d' % components end end ================================================ FILE: other/clrs/build/lib/generator.rb ================================================ module Generator extend self def generate catalog = Catalog.new SOLUTION_ROOT FileUtils.rm_rf 'target/compiled' FileUtils.mkdir_p 'target/compiled' Dir.chdir 'target/compiled' do copy_static_files generate_css generate_catalog catalog generate_solutions catalog end end private def copy_static_files FileUtils.cp_r '../../build/public/css', 'css' FileUtils.cp_r '../../build/public/img', 'img' end def generate_css write_file 'css/clrs.css', Renderer.render_css end def generate_solutions(catalog) catalog.chapters.each do |chapter| chapter.sections.each do |section| section.exercises.each do |exercise| generate_exercise exercise, catalog generate_graph exercise if exercise.graph? generate_drawings exercise if exercise.drawings? end end chapter.problems.each do |problem| generate_problem problem, catalog generate_graph problem if problem.graph? end end end def generate_catalog(catalog) write_file 'index.html', Renderer.render_catalog(catalog) end def generate_exercise(exercise, catalog) write_file "#{exercise.location}.html", Renderer.render_exercise(exercise, catalog) end def generate_problem(problem, catalog) write_file "#{problem.location}.html", Renderer.render_problem(problem, catalog) end def generate_drawings(solution) Graph.list_drawings(solution.draw_path).each do |number, file, display| write_file file, Graph.render_drawing(solution.draw_path, number) end end def generate_graph(solution) write_file "#{solution.location}.png", Graph.render_png(solution.graph_path) write_file "#{solution.location}.svg", Graph.render_svg(solution.graph_path) end def write_file(filename, content) path = Pathname(filename).dirname FileUtils.mkdir_p path unless path.exist? File.open(filename, 'w') { |file| file.write content } end end ================================================ FILE: other/clrs/build/lib/graph.rb ================================================ module Graph extend self def render_png(pathname) %x[dot -Tpng -Gdpi=144 #{pathname.expand_path.to_s}] end def render_svg(pathname) %x[dot -Tsvg #{pathname.expand_path.to_s}] end def compile_to_svg(code) input, output, error = Open3.popen3('dot -Tsvg') input.write(code) input.close output.read end def list_drawings(pathname) run_draw(pathname, 'list').lines.map { |line| line.split(/\s+/, 4) } end def render_drawing(pathname, number) run_draw pathname, 'draw', number end private def run_draw(pathname, *args) %x[PYTHONPATH="#{EXT_ROOT}" PYTHONDONTWRITEBYTECODE=x python3 #{pathname} #{args.join(' ')}] end end ================================================ FILE: other/clrs/build/lib/problem.rb ================================================ class Problem include Solution def initialize(chapter, number) @chapter = chapter @number = number.to_i end def components [@chapter, @number] end def name "#{@chapter.short_name}.#@number" end def title "Problem #{name}" end def location '%s/problems/%02d' % components end end ================================================ FILE: other/clrs/build/lib/renderer.rb ================================================ module Renderer extend self def render_catalog(catalog) context = make_context catalog: catalog render_view 'layout', context do render_view 'catalog', context end end def render_exercise(exercise, catalog = nil) exercise_markdown = File.read exercise.markdown_path context = make_context catalog: catalog, solution: exercise, exercise: exercise, base: '../../' render_view 'layout', context do render_view 'exercise', context do process exercise_markdown end end end def render_problem(problem, catalog = nil) problem_markdown = File.read problem.markdown_path context = make_context catalog: catalog, solution: problem, problem: problem, base: '../../' render_view 'layout', context do render_view 'problem', context do process problem_markdown end end end def render_code(path, language) code = File.read path CodeRay.scan(code, language).div end def render_css scss = File.read PUBLIC_ROOT.join('css/clrs.scss') SassC::Engine.new(scss).render end private def render_view(name, context, &block) filename = VIEWS_ROOT.join("#{name}.erb").to_s Tilt::ERBTemplate.new(filename).render(context, &block) end def make_context(hash = {}) Object.new.tap do |context| hash.each do |key, value| context.instance_variable_set :"@#{key}", value end end end def markdown @markdown ||= Redcarpet::Markdown.new Markdown, tables: true, no_intra_emphasis: true, fenced_code_blocks: true, strikethrough: true end def process(markdown_code) markdown_code = markdown_code.gsub(/exercise\s+([A-D]|\d+).(\d+)[-.](\d+)(?!<\/a>)/i) { |text| "[#{text}](/%s/%02d/%02d.html)" % [ChapterNumber.new($1), $2, $3] } markdown_code = markdown_code.gsub(/problem\s+([A-D]|\d+).(\d+)(?!<\/a>)/i) { |text| "[#{text}](/%s/problems/%02d.html)" % [ChapterNumber.new($1), $2] } markdown.render markdown_code end class Markdown < Redcarpet::Render::HTML def postprocess(html) doc = Nokogiri::HTML(html) doc.search('table').each do |node| node[:class] = 'table table-bordered table-striped table-compact' end doc.search('pre > code.generate-dot').each do |node| node.parent.replace "

    #{Graph.compile_to_svg node.inner_text}

    " end doc.search('body').first.inner_html end end end ================================================ FILE: other/clrs/build/lib/runtimes/c.rb ================================================ module Runtimes module C extend self def run_test(location, capture_output = false) test_path = SOLUTION_ROOT.join(location).sub_ext('.test.c') target_path = SOLUTION_ROOT.join('target/bin').join(location).sub_ext('.test') runner_path = target_path.sub_ext('.c') write_test_file test_path, runner_path compile runner_path, target_path execute target_path, capture_output end def run(location, capture_output = false) runner_path = SOLUTION_ROOT.join(location).sub_ext('.run.c') target_path = SOLUTION_ROOT.join('target/bin').join(location) compile runner_path, target_path execute target_path, capture_output end private def write_test_file(test_path, runner_path) test_names = File.read(test_path).scan(/^\W*TEST\((\w+)/).flatten runner_path.dirname.mkpath File.open runner_path, 'w' do |file| file.write <<-END #include "#{test_path.expand_path.to_s}" int main() { test_initialize(); END test_names.each do |name| file.write " run_#{name}();" end file.write <<-END return test_report_results(); } END end end def compile(code_path, target_path) target_path.dirname.mkpath opts = %W[cc -std=c99 #{code_path.to_s} -o #{target_path.to_s}] success = system(*opts) raise "Failed to compile #{code_path.to_s}" unless success end def execute(executable_path, capture_output) if capture_output `#{executable_path.to_s} 2>&1` else system executable_path.to_s end end end end ================================================ FILE: other/clrs/build/lib/runtimes/python.rb ================================================ module Runtimes module Python extend self def run(location, capture_output = false) path = SOLUTION_ROOT.join(location).sub_ext '.run.py' execute path, capture_output end def run_test(location, capture_output = false) path = SOLUTION_ROOT.join(location).sub_ext '.test.py' execute path, capture_output end private def execute(path, capture_output = false) if capture_output `python3 #{path.to_s} 2>&1` else system 'python3', path.to_s end end end end ================================================ FILE: other/clrs/build/lib/runtimes.rb ================================================ module Runtimes extend self def for(language) case language when :c then Runtimes::C when :python then Runtimes::Python else raise "Unknown language #{language}" end end end ================================================ FILE: other/clrs/build/lib/solution.rb ================================================ module Solution EXTENSIONS = {c: '.c', python: '.py'} def location_path SOLUTION_ROOT.join(location) end def extension_exists?(extension) location_path.sub_ext(extension).exist? end def markdown_path location_path.sub_ext '.markdown' end def graph_path location_path.sub_ext '.dot' end def draw_path location_path.sub_ext '.draw.py' end def html_url "#{location}.html" end def languages @languages ||= EXTENSIONS. select { |_, ext| extension_exists? ext }. map { |language, _| language } end def test_languages @test_languages ||= EXTENSIONS. select { |_, ext| extension_exists? '.test' + ext }. map { |language, _| language } end def run_languages @test_languages ||= EXTENSIONS. select { |_, ext| extension_exists? '.run' + ext }. map { |language, _| language } end def code? not languages.empty? end def tested? not test_languages.empty? end def graph? graph_path.exist? end def drawings? draw_path.exist? end def code_path(language) location_path.sub_ext EXTENSIONS.fetch(language) end def test_path(language) location_path.sub_ext '.test' + EXTENSIONS.fetch(language) end def runner_path(language) location_path.sub_ext '.run' + EXTENSIONS.fetch(language) end def displayed_drawings Graph.list_drawings(draw_path).select { |_, _, display| display == 'true' }.map { |_, file, _, name| [file, name] } end def run(language) Runtimes.for(language).run location end def run_test(language) Runtimes.for(language).run_test location end def run_and_capture_output(language) Runtimes.for(language).run location, true end def run_tests test_languages.each do |language| run_test language end end def run_all annotate = run_languages.size > 1 run_languages.each do |language| puts "#{language.to_s.upcase}:" if annotate run language puts if annotate end end end ================================================ FILE: other/clrs/build/public/css/clrs.scss ================================================ @import url('https://fonts.googleapis.com/css2?family=Fira+Code:wght@300;400;700&family=Merriweather:ital,wght@0,300;0,400;0,700;1,300;1,400;1,700&display=swap'); $text-color-l: #333; $text-color-d: #eee; $link-color-l: #4c94b7; $link-color-d: #5d9ec1; $blockquote-color-l: #e0e0e0; $blockquote-color-d: #333; $background-l: #fff; $background-d: #000; $border-color: #c0c0c0; $column-width: 960px; @mixin mode-dependent($property, $light, $dark) { #{$property}: $light; //@media (prefers-color-scheme: dark) { & { #{$property}: $dark; } } } @mixin color($light, $dark) { @include mode-dependent(color, $light, $dark); } @mixin background-color($light, $dark) { @include mode-dependent(background-color, $light, $dark); } html { @include color($text-color-l, $text-color-d); @include background-color($background-l, $background-d); font-family: Merriweather, serif; font-size: 17px; line-height: 1.8; } .katex-display { margin: 2em 0; } .katex-display .katex { line-height: 2.7 !important; } a, a:visited, a:hover, a:active { @include color($link-color-l, $link-color-d); text-decoration: none; } a:hover { text-decoration: underline; } nav.header { border-bottom: 1px solid #aaa; ul.solution-nav { max-width: $column-width; margin: 0 auto; padding: 1ex; li { margin: 0; padding: 0; list-style: none; display: inline-block; } li.before { float: left; margin-right: 1em; } li.after { float: right; } } } .container { padding: 0 1em; margin: 0 auto 2em; max-width: $column-width; } .container { blockquote { margin: 0; padding: 0 0 0 1em; border-left: 7px solid transparent; @include mode-dependent(border-left-color, $blockquote-color-l, $blockquote-color-d); } } pre, code, kbd, samp { font-family: 'Fira Code', monospace; font-size: 15px; line-height: 1.2; } pre { margin: 1em 0; line-height: 1.4em; } article.solution { text-align: justify; p { margin: 1.5em 0; } img { display: block; margin: 1em auto; max-width: $column-width; } ol { padding-left: 30px; } ol li { padding-left: 10px; } ol ::marker { font-weight: bold; text-align: left; } } hr { border: 0; border-bottom: 1px dashed $border-color; margin: 2em 0; } table { border-collapse: collapse; td, th { padding: 5px 7px; border: 1px solid $border-color; } } p.generated-dot svg { display: block; margin-left: auto; margin-right: auto; } ================================================ FILE: other/clrs/build/views/catalog.erb ================================================

    Introduction to Algorithms solutions

    Hi!

    Welcome to my solutions to the exercises and problems of Introduction to Algorithms, 3rd edition, lovingly abbreviated as CLRS.

    Introduction to Algorithms cover

    Don't trust a single word! While mistakes were not intended, they were surely made. I'm doing this for fun – I have neither the energy nor the patience to double-check everything. If you find an error, please don't contact me to fix it.

    This is a journey in progress. I'm neither in a hurry, not hell-bent on getting there. I'll add new solutions over time, but am not adhering to a schedule.

    <% @catalog.chapters.each do |chapter| %>

    Chapter <%= chapter.number %>

    <% max_width = chapter.sections.map(&:exercises).map(&:size).+([chapter.problems.size]).max %> <% chapter.sections.each do |section| %> <% section.exercises.each do |exercise| %> <% end %> <% if section.exercises.size < max_width %> <% end %> <% end %> <% unless chapter.problems.empty? %> <% chapter.problems.each do |problem| %> <% end %> <% if chapter.problems.size < max_width %> <% end %> <% end %>
    Section <%= section.number %> <%= exercise.name %>
    Problems <%= problem.name %>
    <% end %> ================================================ FILE: other/clrs/build/views/exercise.erb ================================================

    Exercise <%= @exercise.name %>

    <%= yield %> <% if @exercise.graph? %>
    " /> <% end %> <% if @exercise.drawings? %> <% displayed = @exercise.displayed_drawings %> <% if displayed.size > 0 %> <% displayed.each do |file, name| %>

    <%= name %>

    <% end %> <% end %> <% end %> <% @exercise.run_languages.each do |language| %>

    <%= language.to_s.capitalize %> runner output

    <%= @exercise.run_and_capture_output(language) %>
    <% end %> <% @exercise.languages.each do |language| %>

    <%= language.to_s.capitalize %> code

    <%= Renderer.render_code @exercise.code_path(language), language %> <% end %>
    ================================================ FILE: other/clrs/build/views/layout.erb ================================================ <%= @exercise && @exercise.title || @problem && @problem.title || 'Introduction to Algorithms solutions' %> <% if @base %> <% end %> <% if @solution && @catalog %> <% end %>
    <%= yield %>
    ================================================ FILE: other/clrs/build/views/problem.erb ================================================

    Problem <%= @problem.name %>

    <%= yield %> <% if @problem.graph? %>
    " /> <% end %> <% @problem.run_languages.each do |language| %>

    <%= language.to_s.capitalize %> runner output

    <%= @problem.run_and_capture_output(language) %>
    <% end %> <% @problem.languages.each do |language| %>

    <%= language.to_s.capitalize %> code

    <%= Renderer.render_code @problem.code_path(language), language %> <% end %>
    ================================================ FILE: other/clrs/config.ru ================================================ require './build/app' run Sinatra::Application ================================================ FILE: other/clrs/notes/week-01.markdown ================================================ # Week 01 (2013-07-09 - 2013-07-16) ## Array indexing Array indexing in C is 1-based, but in ItA it starts from 1. Translating pseudocode to C is hell. ## Style I can't figure out the style I want to follow. Apart from the number of spaces, I'm not sure whether to go with descriptive names (like I would normally) or terse names (like the ones in the book). I err on the side of the later, since this is unusual for me. I find it fascinating, that a lot of my C coding habits are still the ones I had in high school. I'm not particularly hygenic when it comes to writing it. ## Graphviz I spend a lot of time playing with graphviz and it is a love-hate relationship. You can get a lot of thins draw, but unfortunatelly, you cannot get them drawn beautifully. It's very awkward at times and depends on weird conventions in the language (like catalog_ in the subgraphs). Finally, I managed to segfault it on multiple occasions. ## This needs care When solving problem 2.1, I wrote a buggy version of the solution and it took me a while to figure out where the problem was. It ended up being wrong implementation of insertion sort. I need to write more tests and need to be way more careful when implementing those algorithms. ================================================ FILE: other/clrs/notes/week-02.markdown ================================================ # Week 02 (2013-07-16 - 2013-07-23) This week had VarnaConf, so I barely had time to do anything. We met, discussed some stuff and went to the protest. There is not much to add. ================================================ FILE: other/clrs/notes/week-03.markdown ================================================ # Week 03 (2013-07-23 - 2013-07-30) ## Questions * What is the advantage of the "omega infinity" notation? ## Making errors I keep making errors that result into a lot of debugging. Most of the errors I've had so far have been off-by-ones. I'm just rediscovering that I need to be very careful when writing this code, in order to avoid both errors and spending too much time down the rabbit hole. ================================================ FILE: other/clrs/notes/week-04.markdown ================================================ # Week 04 (2013-10-16 - 2013-10-23) ## On week numbers We were very bad on keeping it regular in the summer. I had some remarks about chapter 4, but I am going to skip them and just jump ahead in my notes. ## Various remarks * I had to solve exercise C.4-9 before having an idea about solving C.4-8. I spent an hour on the later. At least I learned about [coupling][coupling] * Exercise C.1.9 gives an interesting interpretation of the second diagonal of Pascal's triangle * I'm starting to reflect on how much of mathematics is not intuition about logical laws, but symbol manipulation. It is a very interesting distinction. * I was mindblown by the sum used to prove exercise C.2.6 [coupling]: http://en.wikipedia.org/wiki/Coupling_%28probability%29 ## Doing it twice For Appendix C, I first solved everything with pen and paper and then went through the long and tedious process of entering everything into Markdown and LaTeX. The second part was not so much fun, but I got to revisit the exercises a couple of days after I did them, which helper reinforce my knowledge. Revisiting what you learned is important. ## Probability I'm having tons of fun doing probability. Especially things like verifying the results of exercise C.4-2 with the following Ruby script: n = 1_000_000 def try [1].cycle.take_while { rand(2**6).to_s(2).count("1") != 3 }.count + 1 end p n.times.map { try }.inject(:+) / n.to_f And surprise - the results match! ================================================ FILE: other/clrs/notes/week-05.markdown ================================================ # Week 05 (2013-10-23 - 2013-10-30) The chapter was simple enough. It was easy to solve and there were not many surprises, apart from the analysis of the streaks expectation. I had a (few) unsolved exercise(s), but apart from that everything made sense and was not that hard. I spent the whole week afterwards just entering the solutions. It was not that easy, especially because it concided with OpenFest. ================================================ FILE: other/clrs/notes/week-06.markdown ================================================ # Week 06 (2013-11-06 - 2013-11-13) Last week was OpenFest, so I skipped one week. This week it is heap-sort time! ## Questions * I'm not really sure why `BUILD-MAX-HEAP` is linear. I understand the math in section 6.3, but it is the weirdest approach ever. I wonder how people come up with that stuff. ## Various remarks * I really need to learn gdb. While I don't find debugging all that necessary in Ruby, all the minute details appear important in this context. Unit tests are not enough to give you a good tangent. * An example of the previous point is exercise 6.2-5. It took me a while to figure out that I was passing `expected` instead of `actual` to `MAX-HEAPIFY` in the unit test. * The exercises in this book are extremely well-designed. They complement the material very well and doing them expands your knowledge. For example, the heap sort bounds are explored in exercises. * The lower bound of heap-sort was tricky. It was found some 30 years after the algorithms was discovered. Exercise 6.4.5 dwells on it. ================================================ FILE: other/clrs/notes/week-07.markdown ================================================ # Week 07 (2013-11-13 - 2013-11-20) ## Various remarks * It should have been obvious, but I never considered that a reverse-sorted array also produces the worst-case performance in quicksort. * Quicksort is quadratic whenever one of the partitions has a constant size. * There is a [killer adversary][killer-adversary] comparison algorithm for quicksort - it turns it quadratic in almost any implementation. [killer-adversary]: http://www.cs.dartmouth.edu/~doug/mdmspe.pdf ================================================ FILE: other/clrs/notes/week-08.markdown ================================================ # Week 08 (2013-11-20 - 2013-11-27) ## Various remarks * The technique for splitting a summation as in exercise 8.1.2 seems to be useful for finding lower bounds * Exercises where you have to illustrate the algorithm are actually useful. * Nikolay appears to be very fast at solving mathematical problems ================================================ FILE: other/clrs/target/.gitignore ================================================ compiled bin ================================================ FILE: ruby/understanding-computation/.gitignore ================================================ tmp ================================================ FILE: ruby/understanding-computation/03/03.rb ================================================ require 'set' require 'treetop' $:.unshift File.dirname(__FILE__) + '/lib' autoload :FARule, 'fa_rule' autoload :DFARulebook, 'dfa_rulebook' autoload :DFA, 'dfa' autoload :DFADesign, 'dfa_design' autoload :NFARulebook, 'nfa_rulebook' autoload :NFA, 'nfa' autoload :NFADesign, 'nfa_design' autoload :NFASimulation, 'nfa_simulation' autoload :Dot, 'dot' autoload :Pattern, 'pattern' autoload :Empty, 'pattern' autoload :Literal, 'pattern' autoload :Concatenate, 'pattern' autoload :Choose, 'pattern' autoload :Repeat, 'pattern' Treetop.load(File.dirname(__FILE__) + '/lib/grammar') ================================================ FILE: ruby/understanding-computation/03/example.rb ================================================ require_relative '03' require 'fileutils' module Chapter03 extend self def generate_example(base_path) nfa1 = Pattern.parse('ab(ab)*').to_ast.to_nfa_design dfa1 = nfa1.to_dfa_design nfa2 = Pattern.parse('a(ba)*b').to_ast.to_nfa_design dfa2 = nfa2.to_dfa_design dfa1min = dfa1.minimize dfa2min = dfa2.minimize Dir.chdir(base_path) do Dot.draw nfa1, 'nfa1' Dot.draw dfa1, 'dfa1' Dot.draw nfa2, 'nfa2' Dot.draw dfa2, 'dfa2' Dot.draw dfa1min, 'dfa1min' Dot.draw dfa2min, 'dfa2min' end FileUtils.cp File.dirname(__FILE__) + '/lib/index.html', base_path.join('index.html') end end ================================================ FILE: ruby/understanding-computation/03/lib/dfa.rb ================================================ class DFA < Struct.new(:current_state, :accept_states, :rulebook) def accepting? accept_states.include?(current_state) end def read_character(character) self.current_state = rulebook.next_state(current_state, character) end def read_string(string) string.chars.each do |character| read_character character end end end ================================================ FILE: ruby/understanding-computation/03/lib/dfa_design.rb ================================================ class DFADesign < Struct.new(:start_state, :accept_states, :rulebook) include Dot::Design def to_dfa DFA.new(start_state, accept_states, rulebook) end def accepts?(string) to_dfa.tap { |dfa| dfa.read_string(string) }.accepting? end def reverse new_accept_states = [start_state] new_start_state = Object.new start_free_moves = accept_states.map do |state| FARule.new(new_start_state, nil, state) end reversed_rules = rulebook.rules.map do |rule| FARule.new(rule.next_state, rule.character, rule.state) end new_rulebook = NFARulebook.new(start_free_moves + reversed_rules) NFADesign.new(new_start_state, new_accept_states, new_rulebook) end def minimize reverse.to_dfa_design.reverse.to_dfa_design end end ================================================ FILE: ruby/understanding-computation/03/lib/dfa_rulebook.rb ================================================ class DFARulebook < Struct.new(:rules) def next_state(state, character) rule_for(state, character).follow end def rule_for(state, character) rules.detect { |rule| rule.applies_to?(state, character) } end end ================================================ FILE: ruby/understanding-computation/03/lib/dot.rb ================================================ module Dot module Design def to_dot states = rulebook.rules.flat_map(&:states).uniq dot = 'digraph NFA {' states.each do |state| style = if start_state == state ' [style=filled]' elsif accept_states.include?(state) ' [peripheries=2]' else '' end dot << "#{Dot.repr(state)}#{style};" end rulebook.rules.each do |rule| dot << rule.to_dot dot << ';' end dot << '}' end end module Rule def states [state, next_state] end def to_dot edge_style = if character "label=#{character}" else 'style=dashed' end "#{state_repr} -> #{next_state_repr} [#{edge_style}]" end def state_repr repr state end def next_state_repr repr next_state end private def repr(state) Dot.repr(state) end end def self.draw(design, file_base, open=false) File.open("#{file_base}.dot", 'w') do |file| file.write design.to_dot end system "dot -Tgif #{file_base}.dot > #{file_base}.gif" system "open #{file_base}.gif" if open end def self.repr(state) case state when Integer then state.to_s when Set[], nil then 'None' else gensym(state) end end def self.reset_gensym @states = {} @current = 'A' end def self.shorten_set(set_of_sets) @sets ||= {} @current_set_name ||= 'AA' if @sets.has_key? set_of_sets @sets[set_of_sets] else @sets[set_of_sets] = @current_set_name @current_set_name = @current_set_name.succ @sets[set_of_sets] end end def self.gensym(state) if state.is_a?(Set) and state.none? { |i| i.is_a? Set } return '"' + state.to_a.map { |i| gensym(i) }.sort.join('/') + '"' end key = case state when Set then state else state.object_id end @states ||= {} @current ||= 'A' if @states[key] @states[key] else @states[key] = @current @current = @current.succ @states[key] end end end ================================================ FILE: ruby/understanding-computation/03/lib/fa_rule.rb ================================================ class FARule < Struct.new(:state, :character, :next_state) include Dot::Rule def applies_to?(state, character) self.state == state and self.character == character end def follow next_state end def inspect "# #{next_state.inspect}>" end end ================================================ FILE: ruby/understanding-computation/03/lib/grammar.treetop ================================================ grammar Pattern rule choose first:concatenate_or_empty '|' rest:choose { def to_ast Choose.new(first.to_ast, rest.to_ast) end } / concatenate_or_empty end rule concatenate_or_empty concatenate / empty end rule concatenate first:repeat rest:concatenate { def to_ast Concatenate.new(first.to_ast, rest.to_ast) end } / repeat end rule empty '' { def to_ast Empty.new end } end rule repeat brackets '*' { def to_ast Repeat.new(brackets.to_ast) end } / brackets end rule brackets '(' choose ')' { def to_ast choose.to_ast end } / literal end rule literal [a-z] { def to_ast Literal.new(text_value) end } end end ================================================ FILE: ruby/understanding-computation/03/lib/index.html ================================================ Understanding Computation - Chapter 03 example

    Minimizaiton of finite automata

    I found Brzozowski's algorithm so unbelievable, that I had actually to run it to be sure that it actually works (spoiler alert: it does). This is what it produces:

    Type ab(ab)* a(ba)*b
    NFA Nondeterministice Finite Automaton for ab(ab)* Nondeterministice Finite Automaton for a(ba)*b
    DFA Deterministice Finite Automaton for a(ba)*b Deterministice Finite Automaton for ab(ab)*
    Minimized DFA Minimized Finite Automaton for ab(ab)* Minimized Finite Automaton for a(ba)*b

    I trully find this shocking ;)

    ================================================ FILE: ruby/understanding-computation/03/lib/nfa.rb ================================================ class NFA < Struct.new(:current_states, :accept_states, :rulebook) def accepting? (current_states & accept_states).any? end def read_character(character) self.current_states = rulebook.next_states(current_states, character) end def read_string(string) string.chars.each do |character| read_character(character) end end def current_states rulebook.follow_free_moves(super) end end ================================================ FILE: ruby/understanding-computation/03/lib/nfa_design.rb ================================================ class NFADesign < Struct.new(:start_state, :accept_states, :rulebook) include Dot::Design def accepts?(string) to_nfa.tap { |nfa| nfa.read_string(string) }.accepting? end def to_nfa(current_states = Set[start_state]) NFA.new(current_states, accept_states, rulebook) end def to_dfa_design NFASimulation.new(self).to_dfa_design end end ================================================ FILE: ruby/understanding-computation/03/lib/nfa_rulebook.rb ================================================ class NFARulebook < Struct.new(:rules) def next_states(states, character) states.flat_map { |state| follow_rules_for(state, character) }.to_set end def follow_rules_for(state, character) rules_for(state, character).map(&:follow) end def rules_for(state, character) rules.select { |rule| rule.applies_to?(state, character) } end def follow_free_moves(states) more_states = next_states(states, nil) if more_states.subset?(states) states else follow_free_moves(states + more_states) end end def alphabet rules.map(&:character).compact.uniq end end ================================================ FILE: ruby/understanding-computation/03/lib/nfa_simulation.rb ================================================ class NFASimulation < Struct.new(:nfa_design) def next_state(state, character) nfa_design.to_nfa(state).tap do |nfa| nfa.read_character(character) end.current_states end def rules_for(state) nfa_design.rulebook.alphabet.map do |character| FARule.new(state, character, next_state(state, character)) end end def discover_states_and_rules(states) rules = states.flat_map { |state| rules_for(state) } more_states = rules.map(&:follow).to_set if more_states.subset?(states) [states, rules] else discover_states_and_rules(states + more_states) end end def to_dfa_design start_state = nfa_design.to_nfa.current_states states, rules = discover_states_and_rules(Set[start_state]) accept_states = states.select { |state| nfa_design.to_nfa(state).accepting? } DFADesign.new(start_state, accept_states, DFARulebook.new(rules)) end end ================================================ FILE: ruby/understanding-computation/03/lib/pattern.rb ================================================ module Pattern def self.parse(string) PatternParser.new.parse(string) end def bracket(outer_precendence) if precendence < outer_precendence '(' + to_s + ')' else to_s end end def inspect "/#{self}/" end def matches?(string) to_nfa_design.accepts?(string) end end class Empty include Pattern def to_s '' end def precendence 3 end def to_nfa_design start_state = Object.new accept_states = [start_state] rulebook = NFARulebook.new([]) NFADesign.new(start_state, accept_states, rulebook) end end class Literal < Struct.new(:character) include Pattern def to_s character end def precendence 3 end def to_nfa_design start_state = Object.new accept_state = Object.new rule = FARule.new(start_state, character, accept_state) rulebook = NFARulebook.new([rule]) NFADesign.new(start_state, [accept_state], rulebook) end end class Concatenate < Struct.new(:first, :second) include Pattern def to_s [first, second].map { |pattern| pattern.bracket(precendence) }.join end def precendence 1 end def to_nfa_design first_nfa_design = first.to_nfa_design second_nfa_design = second.to_nfa_design start_state = first_nfa_design.start_state accept_states = second_nfa_design.accept_states rules = first_nfa_design.rulebook.rules + second_nfa_design.rulebook.rules extra_rules = first_nfa_design.accept_states.map do |state| FARule.new(state, nil, second_nfa_design.start_state) end rulebook = NFARulebook.new(rules + extra_rules) NFADesign.new(start_state, accept_states, rulebook) end end class Choose < Struct.new(:first, :second) include Pattern def to_s [first, second].map { |pattern| pattern.bracket(precendence) }.join('|') end def precendence 0 end def to_nfa_design first_nfa_design = first.to_nfa_design second_nfa_design = second.to_nfa_design start_state = Object.new accept_states = first_nfa_design.accept_states + second_nfa_design.accept_states rules = first_nfa_design.rulebook.rules + second_nfa_design.rulebook.rules extra_rules = [ FARule.new(start_state, nil, first_nfa_design.start_state), FARule.new(start_state, nil, second_nfa_design.start_state) ] rulebook = NFARulebook.new(rules + extra_rules) NFADesign.new(start_state, accept_states, rulebook) end end class Repeat < Struct.new(:pattern) include Pattern def to_s pattern.bracket(precendence) + '*' end def precendence 2 end def to_nfa_design pattern_nfa_design = pattern.to_nfa_design start_state = Object.new accept_states = pattern_nfa_design.accept_states + [start_state] rules = pattern_nfa_design.rulebook.rules extra_rules = pattern_nfa_design.accept_states.map { |state| FARule.new(state, nil, pattern_nfa_design.start_state) } + [FARule.new(start_state, nil, pattern_nfa_design.start_state)] rulebook = NFARulebook.new(rules + extra_rules) NFADesign.new(start_state, accept_states, rulebook) end end ================================================ FILE: ruby/understanding-computation/03/rulebooks.rb ================================================ require './03' RULEBOOK_1 = DFARulebook.new([ FARule.new(1, 'a', 2), FARule.new(1, 'b', 1), FARule.new(2, 'a', 2), FARule.new(2, 'b', 3), FARule.new(3, 'a', 3), FARule.new(3, 'b', 3) ]) DFA1 = DFADesign.new(1, [3], RULEBOOK_1) RULEBOOK_2 = NFARulebook.new([ FARule.new(1, 'a', 1), FARule.new(1, 'b', 1), FARule.new(1, 'b', 2), FARule.new(2, 'a', 3), FARule.new(2, 'b', 3), FARule.new(3, 'a', 4), FARule.new(3, 'b', 4) ]) NFA1 = NFADesign.new(1, [4], RULEBOOK_2) RULEBOOK_3 = NFARulebook.new([ FARule.new(1, nil, 2), FARule.new(1, nil, 4), FARule.new(2, 'a', 3), FARule.new(3, 'a', 2), FARule.new(4, 'a', 5), FARule.new(5, 'a', 6), FARule.new(6, 'a', 4) ]) NFA2 = NFADesign.new(1, [2, 4], RULEBOOK_3) PATTERN = Repeat.new( Choose.new( Concatenate.new(Literal.new('a'), Literal.new('b')), Literal.new('a') ) ) RULEBOOK_4 = NFARulebook.new([ FARule.new(1, 'a', 1), FARule.new(1, 'a', 2), FARule.new(1, nil, 2), FARule.new(2, 'b', 3), FARule.new(3, 'b', 1), FARule.new(3, nil, 2) ]) NFA3 = NFADesign.new(1, [3], RULEBOOK_4) DFA2 = NFASimulation.new(NFA3).to_dfa_design ================================================ FILE: ruby/understanding-computation/04/04.rb ================================================ require 'set' $:.unshift File.dirname(__FILE__) + '/lib' autoload :Stack, 'stack' autoload :PDARule, 'pda_rule' autoload :PDAConfiguration, 'pda_configuration' autoload :DPDA, 'dpda' autoload :DPDADesign, 'dpda_design' autoload :DPDARulebook, 'dpda_rulebook' autoload :NPDA, 'npda' autoload :NPDADesign, 'npda_design' autoload :NPDARulebook, 'npda_rulebook' autoload :LexicalAnalyzer, 'lexical_analyzer' autoload :SimpleParser, 'simple_parser' ================================================ FILE: ruby/understanding-computation/04/lib/dpda.rb ================================================ class DPDA < Struct.new(:current_configuration, :accept_states, :rulebook) def accepting? accept_states.include?(current_configuration.state) end def next_configuration(character) if rulebook.applies_to?(current_configuration, character) rulebook.next_configuration(current_configuration, character) else current_configuration.stuck end end def stuck? current_configuration.stuck? end def read_character(character) self.current_configuration = next_configuration(character) end def read_string(string) string.chars.each do |character| read_character(character) unless stuck? end end def current_configuration rulebook.follow_free_moves(super) end end ================================================ FILE: ruby/understanding-computation/04/lib/dpda_design.rb ================================================ class DPDADesign < Struct.new(:start_state, :bottom_character, :accept_states, :rulebook) def accepts?(string) to_dpda.tap { |dpda| dpda.read_string(string) }.accepting? end def to_dpda start_stack = Stack.new([bottom_character]) start_configuration = PDAConfiguration.new(start_state, start_stack) DPDA.new(start_configuration, accept_states, rulebook) end end ================================================ FILE: ruby/understanding-computation/04/lib/dpda_rulebook.rb ================================================ class DPDARulebook < Struct.new(:rules) def next_configuration(configuration, character) rule_for(configuration, character).follow(configuration) end def rule_for(configuration, character) rules.detect { |rule| rule.applies_to?(configuration, character) } end def applies_to?(configuration, character) !rule_for(configuration, character).nil? end def follow_free_moves(configuration) if applies_to?(configuration, nil) follow_free_moves(next_configuration(configuration, nil)) else configuration end end end ================================================ FILE: ruby/understanding-computation/04/lib/lexical_analyzer.rb ================================================ class LexicalAnalyzer < Struct.new(:string) GRAMMAR = [ {token: 'i', pattern: /if/ }, {token: 'e', pattern: /else/ }, {token: 'w', pattern: /while/ }, {token: 'd', pattern: /do-nothing/ }, {token: '(', pattern: /\(/ }, {token: ')', pattern: /\)/ }, {token: '{', pattern: /\{/ }, {token: '}', pattern: /\}/ }, {token: ';', pattern: /;/ }, {token: '=', pattern: /=/ }, {token: '+', pattern: /\+/ }, {token: '*', pattern: /\*/ }, {token: '<', pattern: / ::= | PDARule.new(2, nil, 2, 'S', %w[W]), PDARule.new(2, nil, 2, 'S', %w[A]), # ::= 'w' '(' ')' '{' '}' PDARule.new(2, nil, 2, 'W', %w[w ( E ) { S }]), # ::= 'v' '=' PDARule.new(2, nil, 2, 'A', %w[v = E]), # ::= PDARule.new(2, nil, 2, 'E', %w[L]), # ::= '<' | PDARule.new(2, nil, 2, 'L', %w[M < L]), PDARule.new(2, nil, 2, 'L', %w[M]), # ::= '*' | PDARule.new(2, nil, 2, 'M', %w[T * M]), PDARule.new(2, nil, 2, 'M', %w[T]), # ::= 'n' | 'v' PDARule.new(2, nil, 2, 'T', %w[n]), PDARule.new(2, nil, 2, 'T', %w[v]), ] TOKEN_RULES = LexicalAnalyzer::GRAMMAR.map do |rule| PDARule.new(2, rule[:token], 2, rule[:token], []) end STOP_RULE = PDARule.new(2, nil, 3, '$', %w[$]) RULES = [START_RULE, STOP_RULE] + SYMBOL_RULES + TOKEN_RULES RULEBOOK = NPDARulebook.new(RULES) DESIGN = NPDADesign.new(1, '$', [3], RULEBOOK) def self.accepts?(string) token_string = LexicalAnalyzer.new(string).analyze.join puts token_string DESIGN.accepts?(token_string) end end ================================================ FILE: ruby/understanding-computation/04/lib/stack.rb ================================================ class Stack < Struct.new(:contents) def push(character) Stack.new([character] + contents) end def pop Stack.new(contents.drop(1)) end def top contents.first end def inspect "#" end end ================================================ FILE: ruby/understanding-computation/04/rulebooks.rb ================================================ require_relative '04' RULEBOOK_1 = DPDARulebook.new([ PDARule.new(1, '(', 2, '$', ['b', '$']), PDARule.new(2, '(', 2, 'b', ['b', 'b']), PDARule.new(2, ')', 2, 'b', []), PDARule.new(2, nil, 1, '$', ['$']), ]) DPA1 = DPDADesign.new(1, '$', [1], RULEBOOK_1) RULEBOOK_2 = DPDARulebook.new([ PDARule.new(1, 'a', 2, '$', ['a', '$']), PDARule.new(1, 'b', 2, '$', ['b', '$']), PDARule.new(2, 'a', 2, 'a', ['a', 'a']), PDARule.new(2, 'b', 2, 'b', ['b', 'b']), PDARule.new(2, 'a', 2, 'b', []), PDARule.new(2, 'b', 2, 'a', []), PDARule.new(2, nil, 1, '$', ['$']) ]) DPDA2 = DPDADesign.new(1, '$', [1], RULEBOOK_2) RULEBOOK_3 = DPDARulebook.new([ PDARule.new(1, 'a', 1, '$', ['a', '$']), PDARule.new(1, 'a', 1, 'a', ['a', 'a']), PDARule.new(1, 'a', 1, 'b', ['a', 'b']), PDARule.new(1, 'b', 1, '$', ['b', '$']), PDARule.new(1, 'b', 1, 'a', ['b', 'a']), PDARule.new(1, 'b', 1, 'b', ['b', 'b']), PDARule.new(1, 'm', 2, '$', ['$']), PDARule.new(1, 'm', 2, 'a', ['a']), PDARule.new(1, 'm', 2, 'b', ['b']), PDARule.new(2, 'a', 2, 'a', []), PDARule.new(2, 'b', 2, 'b', []), PDARule.new(2, nil, 3, '$', ['$']) ]) DPDA3 = DPDADesign.new(1, '$', [3], RULEBOOK_3) RULEBOOK_4 = NPDARulebook.new([ PDARule.new(1, 'a', 1, '$', ['a', '$']), PDARule.new(1, 'a', 1, 'a', ['a', 'a']), PDARule.new(1, 'a', 1, 'b', ['a', 'b']), PDARule.new(1, 'b', 1, '$', ['b', '$']), PDARule.new(1, 'b', 1, 'a', ['b', 'a']), PDARule.new(1, 'b', 1, 'b', ['b', 'b']), PDARule.new(1, nil, 2, '$', ['$']), PDARule.new(1, nil, 2, 'a', ['a']), PDARule.new(1, nil, 2, 'b', ['b']), PDARule.new(2, 'a', 2, 'a', []), PDARule.new(2, 'b', 2, 'b', []), PDARule.new(2, nil, 3, '$', ['$']) ]) NPDA1 = NPDADesign.new(1, '$', [3], RULEBOOK_4) ================================================ FILE: ruby/understanding-computation/Rakefile ================================================ require 'fileutils' require 'pathname' CURRENT_DIR = Pathname(File.dirname(__FILE__)) desc "Generates output for chapter 03" task '03' do require './03/example' mkdir_p CURRENT_DIR.join('tmp/03') Chapter03.generate_example CURRENT_DIR.join('tmp/03') end ================================================ FILE: scala/expr/.gitignore ================================================ *.class *.log # sbt specific dist/* target/ lib_managed/ src_managed/ project/boot/ project/plugins/project/ ================================================ FILE: scala/expr/README.markdown ================================================ # Expression evaluator A tiny interpreter for simple arithmetic expressions. ## Description I wrote this project in order to learn Scala. I enjoy writing this interpreter in different languages, because it has a few interesting learning opportunities. It contains the following: * AST structure for expressions (using case classes) * A parser for expressions (using `scala.parser.combinators`) * An interactive interpreter for arithmetic expressions * Expressions can be evaluated concurrently (using `scala.actors`) * Functions can be defined in terms of other expressions * Functions can be defined in Scala ## Firing it up It's as simple as: → sbt run Type 'help' for help. > forty_five_degrees = 0.25 * PI > tangent = lambda(x) { sin(x) / cos(x) } > tangent(forty_five_degrees) = 0.9999999999999999 It almost got it right. You can ask for `help` too: > help Usage instructions: * write any expression in order to evaluate it: 1 + 2 + 3 + 5 + 7 + 11 + 13 X + add(2, 4) 1 + 2 - 3 * 4 / 5 ^ 6 * assign variables or define functions with = ANSWER = 42 add = lambda(X, Y) { X + Y } * other available commands names -- show all defined names exit -- quit the interpreter help -- you are looking at it ## How did it go? While reading [Seven Languages in Seven Weeks][1], I realized I cannot reach a good enough understanding of Scala just from the examples. Therefore, I read [Programming in Scala][2] and went through some of the code. After that I thought it will be fun to write a tiny interpreter, so I can experiment with few features of Scala (pattern matching with extractors and case classes, parser combinators and ScalaCheck, to name a few). All went fine, until I attempted to evaluate expressions concurrently with actors. It took me two days get it working and the activities included plowing through the `scala.actors` documentation, purchasing a beta version of [Actors in Scala][3], reading the papers ([first][4] and [second][5]) on the Actor implementation and going through most of the code in `scala.actors`. I finally got it right, but I'm not convinced that it is the best way to do it. ## Things I learned In no specific order: * Writing tests when learning a language is **very** good idea. I usually end up doing a lot of experiments and having feedback on a key press (as opposed to rerunning) is a huge time-saver. * Furthermore, tweaking the environment to shave off a few seconds out of the common activities is priceless. I spent too much time typing stuff in sbt before I automated it in my Vim. * Knowledge of the tools surrounding a language is as important as knowledge of the language itself. If I knew more about the Scala incremental compiler, ScalaTest and sbt, I would have been a lot more effective in learning the language. I should take the time to study to whole toolchain involved. * Vim is not the best fit for a complex, static typed language like Scala. I was craving for IDE features. Seeing the type of an expression or the available methods would be priceless. * Applying an incremental approach to writing code in a new language pays off. I've spent most of the time refactoring code I've gotten to work. It is a great learning opportinuty, since it allows finding out small tricks for DRYing up code in the safety net of tests. [1]: http://pragprog.com/titles/btlang/seven-languages-in-seven-weeks [2]: http://www.artima.com/shop/programming_in_scala [3]: http://www.artima.com/shop/actors_in_scala [4]: http://lampwww.epfl.ch/~odersky/papers/jmlc06.pdf [5]: http://lamp.epfl.ch/~phaller/doc/haller07coord.pdf ================================================ FILE: scala/expr/project/build/Expressions.scala ================================================ import sbt._ class ExpressionsProject(info: ProjectInfo) extends DefaultProject(info) { val scalatest = "org.scalatest" % "scalatest" % "1.1" val scalacheck = "org.scala-tools.testing" % "scalacheck_2.7.7" % "1.6" val jline = "jline" % "jline" % "0.9.94" } ================================================ FILE: scala/expr/project/build.properties ================================================ #Project properties #Tue Dec 07 20:35:34 CET 2010 project.organization=skanev.com project.name=expressions sbt.version=0.7.4 project.version=1.0 build.scala.versions=2.7.7 project.initialize=false ================================================ FILE: scala/expr/src/main/scala/expr/ActorEvaluation.scala ================================================ package expr import scala.actors.Actor import scala.actors.Actor.{actor, react, reply, loopWhile, mkBody} import BinOp._ object ActorEvaluation { def eval(expr: Expr, env: Env) = new ActorEvaluation(env).eval(expr) } class ActorEvaluation(env: Env) { case class PartialResult(index: Int, num: Double) def mapReduce(exprs: List[Expr], index: Int, target: Actor)(reduce: Array[Double] => Double): Unit = { val mapper = actor { val evaluated: Array[Double] = Array.make(exprs.length, 0.0) times(exprs.length) { react { case PartialResult(n, value) => evaluated(n) = value } } andThen { target ! PartialResult(index, reduce(evaluated)) } } for ((e, i) <- exprs.zipWithIndex) evalTo(e, i, mapper) } def evalTo(expr: Expr, index: Int, target: Actor): Unit = { def respond(answer: => Double) = actor { target ! PartialResult(index, answer) } def binOp(x: Expr, y: Expr)(op: (Double, Double) => Double) = mapReduce(List(x, y), index, target)(xs => op(xs(0), xs(1))) def function(name: String, args: Seq[Expr]) = mapReduce(args.toList, index, target) { xs => env.function(name).eval(env, xs.toList) } expr match { case Num(num) => respond { num } case Name(name) => respond { env.variable(name) } case Call(name, args) => function(name, args) case x + y => binOp(x, y) { _ + _ } case x - y => binOp(x, y) { _ - _ } case x * y => binOp(x, y) { _ * _ } case x / y => binOp(x, y) { _ / _ } case x ^ y => binOp(x, y) { Math.pow(_, _) } } } def eval(expr: Expr): Double = { val waiter = actor { var result = 0.0 mkBody { react { case PartialResult(-1, num) => result = num } } andThen { react { case 'Eval => reply(result) } } } evalTo(expr, -1, waiter) (waiter !? 'Eval) match { case result: Double => result } } private def times(n: Int)(body: => Unit) = { var counter = n loopWhile(counter > 0) { counter -= 1; body } } } ================================================ FILE: scala/expr/src/main/scala/expr/BadInputException.scala ================================================ package expr class BadInputException(message: String) extends Exception(message) ================================================ FILE: scala/expr/src/main/scala/expr/Callable.scala ================================================ package expr trait Callable { def eval(env: Env, params: Seq[Double]): Double } ================================================ FILE: scala/expr/src/main/scala/expr/Env.scala ================================================ package expr object Env { sealed abstract class Value { def repr: String } case class Variable(val number: Double) extends Value { def repr = number.toString } case class Function(val code: Callable) extends Value { def repr = code.toString } def empty = new Env(Map()) } class Env(val mapping: Map[String, Env.Value]) { import Env.{Value, Variable, Function} def apply(name: String): Value = mapping(name) def extend(name: String, value: Env.Value): Env = new Env(mapping + (name -> value)) def extend(name: String, number: Double): Env = extend(name, Variable(number)) def extend(name: String, code: Callable): Env = extend(name, Function(code)) def extend(pairs: Seq[(String, Double)]): Env = new Env(mapping ++ pairs.map { p => (p._1, Variable(p._2)) }) def names: Set[String] = Set() ++ mapping.keys def variable(name: String): Double = { mapping.get(name) match { case Some(Variable(x)) => x case _ => throw new ExprException("Undefined variable: " + name) } } def function(name: String): Callable = { mapping.get(name) match { case Some(Function(lambda)) => lambda case _ => throw new ExprException("Undefined function: " + name) } } } ================================================ FILE: scala/expr/src/main/scala/expr/Evaluation.scala ================================================ package expr import scala.actors.Futures.future import Math.pow import BinOp._ object Evaluation { def eval(expression: Expr, env: Env): Double = { def e(expr: Expr) = eval(expr, env) expression match { case Num(x) => x case Name(x) => env.variable(x) case Call(name, args) => env.function(name).eval(env, args.map(e)) case x + y => e(x) + e(y) case x - y => e(x) - e(y) case x * y => e(x) * e(y) case x / y => e(x) / e(y) case x ^ y => pow(e(x), e(y)) case _ => error("Cannot evaluate expression: " + expression) } } } ================================================ FILE: scala/expr/src/main/scala/expr/Expr.scala ================================================ package expr object Expr { def parse(input: String) = Parser.parse(input) } sealed abstract class Expr { def +(other: Expr) = BinOp(BinOp.+, this, other) def -(other: Expr) = BinOp(BinOp.-, this, other) def *(other: Expr) = BinOp(BinOp.*, this, other) def ^(other: Expr) = BinOp(BinOp.^, this, other) def eval(env: Env) = Evaluation.eval(this, env) def aeval(env: Env) = ActorEvaluation.eval(this, env) override def toString = Printer.asString(this) } case class Num(number: Double) extends Expr case class Name(name: String) extends Expr case class BinOp(op: BinOp.Operator, left: Expr, right: Expr) extends Expr case class Call(name: String, arguments: Seq[Expr]) extends Expr object BinOp { sealed abstract class Operator(symbol: String, val precendance: Int) { val operator = this def unapply(expr: Expr): Option[(Expr, Expr)] = { expr match { case BinOp(`operator`, left, right) => Some((left, right)) case _ => None } } override def toString = symbol } object ^ extends Operator("^", 1) object / extends Operator("/", 2) object * extends Operator("*", 3) object - extends Operator("-", 4) object + extends Operator("+", 5) } ================================================ FILE: scala/expr/src/main/scala/expr/ExprException.scala ================================================ package expr class ExprException(val message: String) extends Exception(message) ================================================ FILE: scala/expr/src/main/scala/expr/Lambda.scala ================================================ package expr case class Lambda(args: List[String], expr: Expr) extends Callable { verifyNoFreeVariables() override def toString = "lambda(%s) { %s }".format(args.mkString(", "), expr.toString) override def eval(env: Env, params: Seq[Double]): Double = { verifyArity(params.length) val extended = env.extend(args zip params.toList) expr.eval(extended) } private def freeVariables(expr: Expr): Seq[String] = { expr match { case BinOp(_, left, right) => freeVariables(left) ++ freeVariables(right) case Call(_, params) => params.flatMap(freeVariables) case Name(name) if !args.contains(name) => List(name) case _ => List() } } private def verifyArity(paramCount: Int) { if (paramCount != args.length) throw new ExprException("Lambda expects " + args.length + " argument(s), " + "but was called with " + paramCount) } private def verifyNoFreeVariables() = { val vars = freeVariables(expr) if (vars.length != 0) throw new ExprException("Lambda contains free variables: " + vars.mkString(",")) } } ================================================ FILE: scala/expr/src/main/scala/expr/Parser.scala ================================================ package expr import scala.util.parsing.combinator.JavaTokenParsers object Parser { def parse(input: String): Expr = { val parser = new Parser() val result = parser.parseAll(parser.expr, input) result.getOrElse { throw new BadInputException(input) } } } class Parser extends JavaTokenParsers { def expr = addition def addition = binaryOp(BinOp.+, subtraction) def subtraction = binaryOp(BinOp.-, multiplication) def multiplication = binaryOp(BinOp.*, division) def division = binaryOp(BinOp./, exp) def exp = binaryOp(BinOp.^, factor) def factor: Parser[Expr] = "(" ~> expr <~ ")" | number | call | name; def call: Parser[Expr] = ident ~ "(" ~ repsep(expr, ",") ~ ")" ^^ { case name ~ "(" ~ args ~ ")" => Call(name, args) } def number: Parser[Num] = floatingPointNumber ^^ (x => Num(x.toDouble)) def name: Parser[Name] = ident ^^ Name private def binaryOp(operator: BinOp.Operator, operand: Parser[Expr]): Parser[Expr] = { val symbol = operator.toString; operand ~ rep(symbol ~> operand) ^^ { case first ~ operands => (first /: operands) { (binOp, operand) => BinOp(operator, binOp, operand) } } } } ================================================ FILE: scala/expr/src/main/scala/expr/Printer.scala ================================================ package expr object Printer { private def parenthesize(expr: Expr, enclosingPrecendence: Int): String = { val str = asString(expr) expr match { case BinOp(operator, _, _) if operator.precendance > enclosingPrecendence => "(" + str + ")" case _ => str } } def asString(expr: Expr): String = { expr match { case Num(number) => number.toString.replaceAll(".0$", "") case Name(name) => name case Call(name, args) => "%s(%s)".format(name, args.map(asString).mkString(", ")) case BinOp(operator, left, right) => val enclosing = operator.precendance parenthesize(left, enclosing) + " " + operator + " " + parenthesize(right, enclosing) } } } ================================================ FILE: scala/expr/src/main/scala/expr/ScalaCode.scala ================================================ package expr object ScalaCode { def define0(doc: String)(code: => Double): ScalaCode = define(doc) { case Nil => code } def define1(doc: String)(code: (Double) => Double): ScalaCode = define(doc) { case List(a) => code(a) } def define2(doc: String)(code: (Double, Double) => Double): ScalaCode = define(doc) { case List(a, b) => code(a, b) } def define3(doc: String)(code: (Double, Double, Double) => Double): ScalaCode = define(doc) { case List(a, b, c) => code(a, b, c) } private def define(doc: String)(code: PartialFunction[List[Double], Double]): ScalaCode = { def codeWithVerification(params: List[Double]): Double = { if (!code.isDefinedAt(params)) throw new ExprException("Function called with an unexpected number of arguments") code(params) } new ScalaCode(doc, codeWithVerification) } } class ScalaCode(doc: String, code: List[Double] => Double) extends Callable { override def eval(env: Env, params: Seq[Double]): Double = code(params.toList) override def toString = "".format(doc) } ================================================ FILE: scala/expr/src/main/scala/expr/repl/Command.scala ================================================ package expr.repl abstract sealed class Command object Command { case class Exit() extends Command case class ShowEnv() extends Command case class Help() extends Command case class Eval(expr: Expr) extends Command case class Assign(variable: String, expr: Expr) extends Command case class Define(name: String, lambda: Lambda) extends Command def parse(input: String): Command = { val parser = new CommandParser val result = parser.parseAll(parser.command, input) result.getOrElse { throw new BadInputException("Cannot be parsed") } } class CommandParser extends expr.Parser { def command = exit | help | showEnv | define | assign | eval def define = ident ~ "=" ~ "lambda" ~ "(" ~ repsep(ident, ",") ~ ")" ~ "{" ~ expr ~ "}" ^^ { case name ~ "=" ~ "lambda" ~ "(" ~ args ~ ")" ~ "{" ~ expr ~ "}" => Define(name, Lambda(args, expr)) } def assign = ident ~ "=" ~ expr ^^ { case variable ~ "=" ~ expr => Assign(variable, expr) } def help = "help" ^^ { case _ => Help() } def exit = "exit" ^^ { case _ => Exit() } def showEnv = "names" ^^ { case _ => ShowEnv() } def eval = expr ^^ { case expr => Eval(expr) } } } ================================================ FILE: scala/expr/src/main/scala/expr/repl/ConsoleShell.scala ================================================ package expr.repl object ConsoleShell extends Shell { override def read(): String = { print("> ") Console.readLine } override def write(output: String) = print(output) } ================================================ FILE: scala/expr/src/main/scala/expr/repl/InteractiveInterpreter.scala ================================================ package expr.repl import Expr.parse object InteractiveInterpreter extends Application { val env = Env.empty .extend("PI", Math.Pi) .extend("E", Math.E) .extend("sin", ScalaCode.define1("sin(x) in radians") { x => Math.sin(x) }) .extend("cos", ScalaCode.define1("cos(x) in radians") { x => Math.cos(x) }) .extend("ln", ScalaCode.define1("ln(x) -- log with base e") { x => Math.log(x) }) .extend("one", Lambda(List("x"), parse("sin(x) ^ 2 + cos(x) ^ 2"))) .extend("log", Lambda(List("base", "number"), parse("ln(number) / ln(base)"))) println("Type 'help' for help.") new REPL(JLineShell, env).start() } ================================================ FILE: scala/expr/src/main/scala/expr/repl/JLineShell.scala ================================================ package expr.repl object JLineShell extends Shell { val reader = new jline.ConsoleReader() override def read(): String = reader.readLine("> ") override def write(output: String) = print(output) } ================================================ FILE: scala/expr/src/main/scala/expr/repl/REPL.scala ================================================ package expr.repl import expr.BadInputException import Command._ class REPL(shell: Shell, private var env: Env) { def this(shell: Shell) { this(shell, Env.empty) } def start() = processNextLine() private def processNextLine() { try { parse(shell.read) match { case Eval(expr) => shell.writeln("= " + expr.eval(env)) case Assign(name, expr) => env = env.extend(name, expr.eval(env)) case Define(name, lambda) => env = env.extend(name, lambda) case ShowEnv() => listNames() case Help() => showHelp() case Exit() => return } } catch { case ex: BadInputException => shell.writeln("ERROR: Unparsable input") case ex: ExprException => shell.writeln("ERROR: " + ex.message) } processNextLine() } private def listNames() { if (env.names.isEmpty) return val width = env.names.toList.map(_.length).sort(_ > _).first def pad(name: String) = name + " " * (width - name.length) for (name <- env.names) { shell.writeln("%s = %s".format(pad(name), env(name).repr)) } } private def showHelp() { shell.writeln("""|Usage instructions: | * write any expression in order to evaluate it: | | 1 + 2 + 3 + 5 + 7 + 11 + 13 | X + add(2, 4) | 1 + 2 - 3 * 4 / 5 ^ 6 | | * assign variables or define functions with = | | ANSWER = 42 | add = lambda(X, Y) { X + Y } | | * other available commands | | names -- show all defined names | exit -- quit the interpreter | help -- you are looking at it""".stripMargin) } } ================================================ FILE: scala/expr/src/main/scala/expr/repl/Shell.scala ================================================ package expr.repl trait Shell { def read(): String def write(output: String) def writeln(output: String) = write(output + "\n") } ================================================ FILE: scala/expr/src/test/scala/expr/EnvSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class EnvSpec extends Spec with ShouldMatchers { it("can be extended with a variable") { val env = Env.empty.extend("X", 1.0) expect(1.0) { env.variable("X") } } it("can be extended with multiple variables") { val env = Env.empty.extend(Array("X" -> 1.0, "Y" -> 2.0)) expect(1.0) { env.variable("X") } expect(2.0) { env.variable("Y") } } it("overrides existing variables") { val env = Env.empty.extend("X", 1) expect(2) { env.extend("X", 2).variable("X") } expect(2) { env.extend(Array("X" -> 2)).variable("X") } } it("can be extended with a functions") { val add = Lambda(List("X", "Y"), Name("X") + Name("Y")) val env = Env.empty.extend("add", add) expect(add) { env.function("add") } } it("raises an error when queried for an unexisting name") { intercept[ExprException] { Env.empty.variable("X") } intercept[ExprException] { Env.empty.function("X") } } it("can tell its own bound names") { val env = Env.empty.extend("X", 1).extend("foo", Lambda(List(), Num(1))) expect(Set("X", "foo")) { env.names } } } ================================================ FILE: scala/expr/src/test/scala/expr/EvaluationSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import Expr.parse class EvaluationSpec extends Spec with ShouldMatchers { val add = Lambda(List("X", "Y"), Name("X") + Name("Y")) val twice = Lambda(List("X"), Call("add", List(Name("X"), Name("X")))) val negate = ScalaCode.define1("negate") { x => -x } val env = Env.empty .extend("X", 1) .extend("Y", 2) .extend("add", add) .extend("twice", twice) .extend("negate", negate) val examples = Array( "1" -> 1 , "2 + 3" -> 5 , "X + Y" -> 3 , "Y ^ (X * 4)" -> 16 , "4 - Y" -> 2 , "9 / 3" -> 3 , "add(1, 2)" -> 3 , "twice(2)" -> 4 , "negate(42)" -> -42 ) for((input, expectation) <- examples) { it("evaluates " + input + " to " + expectation) { expect(expectation) { parse(input).eval(env) } } it("can evaluate with actors " + input + " to " + expectation) { expect(expectation) { parse(input).aeval(env) } } } } ================================================ FILE: scala/expr/src/test/scala/expr/ExprGen.scala ================================================ package expr import org.scalacheck._ import org.scalacheck.Prop._ import org.scalacheck.Gen._ import org.scalacheck.Arbitrary.arbitrary import expr.BinOp._ object ExprGen { def eval(e: Expr) = e.eval(env) val env = Env.empty .extend("x", 1.44) .extend("e", 2.71) .extend("add", Lambda(List("x", "y"), Name("x") + Name("y"))) .extend("twice", Lambda(List("x"), Name("x") + Name("x"))) .extend("pi", ScalaCode.define0("pi()") { Math.Pi }) val number = arbitrary[Double].map(Num(_)) val name = oneOf("x", "e").map(Name(_)) def binOp: Gen[Expr] = (for { op <- oneOf(BinOp.+, BinOp.-, BinOp.*, BinOp./, BinOp.^) left <- oneOf(binOp, call, number, name) right <- oneOf(binOp, call, number, name) } yield BinOp(op, left, right)) suchThat { case BinOp(op1, _, BinOp(op2, _, _)) if op1 == op2 => false case _ => true } def call: Gen[Expr] = for { a <- oneOf(binOp, number, name) b <- oneOf(binOp, number, name) fun <- oneOf("pi", "twice", "add") } yield (fun match { case "pi" => Call("pi", List()) case "twice" => Call("twice", List(a)) case "add" => Call("add", List(a, b)) }) def expr: Gen[Expr] = binOp } ================================================ FILE: scala/expr/src/test/scala/expr/ExpressionSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class ExpressionSpec extends Spec with ShouldMatchers { it("allows creating a binary operation with +") { expect(BinOp(BinOp.+, Num(1), Num(2))) { Num(1) + Num(2) } } it("allows creating a binary operation with *") { expect(BinOp(BinOp.*, Num(1), Num(2))) { Num(1) * Num(2) } } it("allows creating a BinOp with ^") { expect(BinOp(BinOp.^, Num(1), Num(2))) { Num(1) ^ Num(2) } } it("allows creating a BinOp with -") { expect(BinOp(BinOp.-, Num(1), Num(2))) { Num(1) - Num(2) } } } ================================================ FILE: scala/expr/src/test/scala/expr/LambdaSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import BinOp.{Operator => O} class LambdaSpec extends Spec with ShouldMatchers { val env = Env.empty val add = Lambda(List("X", "Y"), Name("X") + Name("Y")) it("can be evaluated with given parameters") { expect(3) { add.eval(env, List(1, 2)) } } it("can be printed as a string") { expect("lambda(X, Y) { X + Y }") { add.toString } } it("raises an error when invoked with the wrong number of arguments") { intercept[ExprException] { add.eval(env, List(1, 2, 3)) } } it("cannot be constructed with free variables") { intercept[ExprException] { Lambda(List("X"), Name("X") + Name("Y")) } intercept[ExprException] { Lambda(List("X"), Call("foo", List(Name("X"), Name("Y")))) } } } ================================================ FILE: scala/expr/src/test/scala/expr/ParsingSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import Expr.parse import BinOp._ import expr.{BinOp => O} class ParsingSpec extends Spec with ShouldMatchers { val examples = Array( "1" -> Num(1) , "X" -> Name("X") , "1 + X" -> BinOp(O.+, Num(1), Name("X")) , "1 - 2" -> BinOp(O.-, Num(1), Num(2)) , "X * 2" -> BinOp(*, Name("X"), Num(2)) , "X / Y" -> BinOp(/, Name("X"), Name("Y")) , "2 ^ X" -> BinOp(^, Num(2), Name("X")) , "1 + 2 + 3" -> BinOp(O.+, BinOp(O.+, Num(1), Num(2)), Num(3)) , "1 + 2 + 3 + 4" -> BinOp(O.+, BinOp(O.+, BinOp(O.+, Num(1), Num(2)), Num(3)), Num(4)) , "1 - 2 + 3" -> BinOp(O.+, BinOp(O.-, Num(1), Num(2)), Num(3)) , "1 + 2 - 3" -> BinOp(O.+, Num(1), BinOp(O.-, Num(2), Num(3))) , "1 ^ 2 + 3 * 4" -> BinOp(O.+, BinOp(^, Num(1), Num(2)), BinOp(*, Num(3), Num(4))) , "2 / 3 ^ 4" -> BinOp(O./, Num(2), BinOp(O.^, Num(3), Num(4))) , "2 ^ 3 / 4" -> BinOp(O./, BinOp(O.^, Num(2), Num(3)), Num(4)) , "foo(1, 2)" -> Call("foo", List(Num(1), Num(2))) , "foo(X + Y)" -> Call("foo", List(BinOp(O.+, Name("X"), Name("Y")))) , "a(b(), 3 + c())" -> Call("a", List(Call("b", List()), BinOp(O.+, Num(3), Call("c", List())))) ) for ((input, ast) <- examples) { it("parses " + input) { expect(ast) { parse(input) } } } it("throws an exception on invalid input") { val invalidInput = "+ + +" intercept[BadInputException] { parse(invalidInput) } } } ================================================ FILE: scala/expr/src/test/scala/expr/PrintingExpressionsSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class PrintingExpressionsSpec extends Spec with ShouldMatchers { val examples = Array( Num(1) + Num(2) -> "1 + 2" , (Name("x") ^ Num(2)) + Num(2) * Name("x") + Num(1) -> "x ^ 2 + 2 * x + 1" , (Name("x") + Num(2)) * Num(3) -> "(x + 2) * 3" , (Num(1) - Num(2)) + (Num(3) - Num(4)) -> "1 - 2 + 3 - 4" , (Call("add", Array(Num(1), Num(2)))) -> "add(1, 2)" , (Num(1) - (Num(2) + Num(3))) -> "1 - (2 + 3)" ) for ((expr, string) <- examples) { it("prints " + string) { expect(string) { expr.toString } } } } ================================================ FILE: scala/expr/src/test/scala/expr/PropertiesSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.prop.Checkers import org.scalatest.matchers.ShouldMatchers import org.scalacheck.Prop._ import Expr.parse class PropertiesSpec extends Spec with Checkers { def sameResult(left: Double, right: Double): Boolean = (left == right) || (left.isNaN && right.isNaN) describe("An expression") { it("is equal to its parsed toString") { check(forAll(ExprGen.expr) { expr => expr == parse(expr.toString) }) } it("is evaluated to the same value as its parse . toString") { check(forAll(ExprGen.expr) { expr => sameResult(expr.eval(ExprGen.env), parse(expr.toString).eval(ExprGen.env)) }) } it("evaluates to the same value with eval() and aeval()") { check(forAll(ExprGen.expr) { expr => sameResult(expr.eval(ExprGen.env), expr.aeval(ExprGen.env)) }) } } } ================================================ FILE: scala/expr/src/test/scala/expr/ScalaCodeSpec.scala ================================================ package expr import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class ScalaCodeSpec extends Spec with ShouldMatchers { it("allows easy construction of functions of no arguments") { val code = ScalaCode.define0("") { 42 } expect(42) { code.eval(Env.empty, List()) } } it("allows easy construction of functions of one argument") { val code = ScalaCode.define1("") { a => a * 2 } expect(4) { code.eval(Env.empty, List(2)) } } it("allows easy construction of functions of two arguments") { val code = ScalaCode.define2("") { (a, b) => a + b } expect(3) { code.eval(Env.empty, List(1, 2)) } } it("allows easy construction of functions of three arguments") { val code = ScalaCode.define3("") { (a, b, c) => a + b * c } expect(7) { code.eval(Env.empty, List(1, 2, 3)) } } it("can be converted to a string that contains its docstring") { val code = ScalaCode.define0("fun()") { 42 } expect("") { code.toString } } it("raises an error when not invoked with the right number of arguments") { val code = ScalaCode.define2("") { (a, b) => a + b } intercept[ExprException] { code.eval(Env.empty, List(1, 2, 3)) } } } ================================================ FILE: scala/expr/src/test/scala/expr/repl/CommandSpec.scala ================================================ package expr.repl import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import Command._ class CommandSpec extends Spec with ShouldMatchers { it("parses 'exit' as the Exit() command") { expect(Exit()) { Command.parse("exit") } } it("parses 'names' as the ShowEnv() command") { expect(ShowEnv()) { Command.parse("names") } } it("parses '1 + 2' as an Eval(1 + 2)") { expect(Eval(Num(1) + Num(2))) { Command.parse("1 + 2") } } it("parses 'X = 1 + 2' as an Assign(X, 1 + 2)") { expect(Assign("X", Num(1) + Num(2))) { Command.parse("X = 1 + 2") } } it("parses 'add = lambda(X, Y) { X + Y }' add Define(add, Lambda(..))") { val lambda = Lambda(List("X", "Y"), Name("X") + Name("Y")) expect(Define("add", lambda)) { Command.parse("add = lambda(X, Y) { X + Y }") } } it("throws an exception when command cannot be parsed") { intercept[BadInputException] { Command.parse("+++") } } } ================================================ FILE: scala/expr/src/test/scala/expr/repl/REPLSpec.scala ================================================ package expr.repl import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class REPLSpec extends Spec with ShouldMatchers { def lastMessageInSession(inputs: String*): String = { val shell = new RecordedShell(inputs ++ List("exit"): _*) new REPL(shell).start() shell.lastMessage } it("evaluates an expression if given") { expect("= 3.0") { lastMessageInSession("1 + 2") } } it("evaluates expressions in the defined context") { expect("= 3.0") { lastMessageInSession("X = 1", "Y = 2", "X + Y") } } it("evaluates function definitions") { expect("= 3.0") { lastMessageInSession("add = lambda(X, Y) { X + Y }", "add(1, 2)") } } it("lists the environment when requested") { expect("X = 1.0") { lastMessageInSession("X = 1", "names") } } it("displays an error when given an unparsable expression") { expect("ERROR: Unparsable input") { lastMessageInSession("+++") } } it("displays an error when refering to an unknown variable") { expect("ERROR: Undefined variable: X") { lastMessageInSession("X + 1") } } it("displays an error when calling an unknown function") { expect("ERROR: Undefined function: foo") { lastMessageInSession("foo()") } } it("displays an error when trying to define a function with free variables") { expect("ERROR: Lambda contains free variables: Y") { lastMessageInSession("foo = lambda(X) { X + Y }") } } it("displays an error when a function is called with the wrong number of arguments") { expect("ERROR: Lambda expects 1 argument(s), but was called with 0") { lastMessageInSession("x = lambda(X) { X }", "x()") } } } ================================================ FILE: scala/expr/src/test/scala/expr/repl/RecordingShell.scala ================================================ package expr.repl class RecordedShell(playback: String*) extends Shell { var inputs = playback.toArray var outputBuffer = "" def read(): String = { if (inputs.isEmpty) throw new IllegalStateException("Inputs already consumed") val result = inputs(0) inputs = inputs.drop(1) return result } def write(output: String) = outputBuffer += output def messages = outputBuffer.split("\n") def lastMessage = messages.last } ================================================ FILE: scala/programming_in_scala/.gitignore ================================================ *.class *.log # sbt specific dist/* target/ lib_managed/ src_managed/ project/boot/ project/plugins/project/ ================================================ FILE: scala/programming_in_scala/README ================================================ A playground for the code in "Programming in Scala" Runs on scala 2.7.7 with sbt ================================================ FILE: scala/programming_in_scala/project/build/ProgrammingInScala.scala ================================================ import sbt._ class ProgrammingInScalaProject(info: ProjectInfo) extends DefaultProject(info) { val scalatest = "org.scalatest" % "scalatest" % "1.1" } ================================================ FILE: scala/programming_in_scala/project/build.properties ================================================ #Project properties #Tue Nov 30 21:57:58 CET 2010 project.organization=skanev.com project.name=Programming in Scala playground sbt.version=0.7.4 project.version=1.0 build.scala.versions=2.7.7 project.initialize=false ================================================ FILE: scala/programming_in_scala/src/main/scala/actorsimulation/Adders.scala ================================================ package actorsimulation trait Adders extends Circuit { def halfAdder(a: Wire, b: Wire, s: Wire, c: Wire) { val d, e = new Wire orGate(a, b, d) andGate(a, b, c) inverter(c, e) andGate(d, e, s) } def fullAdder(a: Wire, b: Wire, cin: Wire, sum: Wire, cout: Wire) { val s, c1, c2 = new Wire halfAdder(a, cin, s, c1) halfAdder(b, s, sum, c2) orGate(c1, c2, cout) } } ================================================ FILE: scala/programming_in_scala/src/main/scala/actorsimulation/Circuit.scala ================================================ package actorsimulation import scala.actors.Actor class Circuit { val clock = new Clock val WireDelay = 1 val InvertedDelay = 2 val OrGateDelay = 3 val AndGateDelay = 3 case class SetSignal(sig: Boolean) case class SignalChanged(wire: Wire, sig: Boolean) class Wire(name: String, init: Boolean) extends Simulant { def this(name: String) { this(name, false) } def this() { this("unnamed") } val clock = Circuit.this.clock clock.add(this) private var sigVal = init private var observers: List[Actor] = List() def handleSimMessage(msg: Any) { msg match { case SetSignal(s) => if (s != sigVal) { sigVal = s signalObservers() } } } def signalObservers() { for (observer <- observers) clock ! AfterDelay(WireDelay, SignalChanged(this, sigVal), observer) } override def simStarting() { signalObservers() } def addObserver(observer: Actor) { observers = observer :: observers } override def toString = "Wire(" + name + ")" } private object DummyWire extends Wire("dummy") abstract class Gate(in1: Wire, in2: Wire, out: Wire) extends Simulant { def computeOutput(s1: Boolean, s2: Boolean): Boolean val delay: Int val clock = Circuit.this.clock clock.add(this) in1.addObserver(this) in2.addObserver(this) var s1, s2 = false def handleSimMessage(msg: Any) { msg match { case SignalChanged(w, sig) => if (w == in1) s1 = sig if (w == in2) s2 = sig clock ! AfterDelay(delay, SetSignal(computeOutput(s1, s2)), out) } } } def orGate(in1: Wire, in2: Wire, output: Wire) = new Gate(in1, in2, output) { val delay = OrGateDelay def computeOutput(s1: Boolean, s2: Boolean) = s1 || s2 } def andGate(in1: Wire, in2: Wire, output: Wire) = new Gate(in1, in2, output) { val delay = AndGateDelay def computeOutput(s1: Boolean, s2: Boolean) = s1 && s2 } def inverter(input: Wire, output: Wire) = new Gate(input, DummyWire, output) { val delay = InvertedDelay def computeOutput(s1: Boolean, s2: Boolean) = !s1 } def probe(wire: Wire) = new Simulant { val clock = Circuit.this.clock clock.add(this) wire.addObserver(this) def handleSimMessage(msg: Any) { msg match { case SignalChanged(wire, signalValue) => println("singal " + wire + " changed to " + signalValue) } } } def start() { clock ! Start } } ================================================ FILE: scala/programming_in_scala/src/main/scala/actorsimulation/Clock.scala ================================================ package actorsimulation import scala.actors.Actor import scala.actors.Actor._ case class Ping(time: Int) case class Pong(time: Int, from: Actor) case class WorkItem(time: Int, msg: Any, target: Actor) case class AfterDelay(delay: Int, msg: Any, targe: Actor) case object Start case object Stop class Clock extends Actor { private var running = false private var currentTime = 0 private var agenda: List[WorkItem] = List() private var allSimulants: List[Actor] = List() private var busySimulants: Set[Actor] = Set.empty start() def add(simulant: Actor) { allSimulants = simulant :: allSimulants } def act() { loop { if (running && busySimulants.isEmpty) advance() reactToOneMessage() } } private def advance() { if (agenda.isEmpty && currentTime > 0) { println("** Agenda empty. Clock time exiting at time " + currentTime + ".") self ! Stop return } currentTime += 1 println("Advancing to time " + currentTime) processCurrentEvents() for (sim <- allSimulants) sim ! Ping(currentTime) busySimulants = Set.empty ++ allSimulants } private def processCurrentEvents() { val todoNow = agenda.takeWhile(_.time <= currentTime) agenda = agenda.drop(todoNow.length) for(WorkItem(time, msg, target) <- todoNow) { assert(time == currentTime) target ! msg } } private def reactToOneMessage() { react { case AfterDelay(delay, msg, target) => val item = WorkItem(currentTime + delay, msg, target) agenda = insert(agenda, item) case Pong(time, sim) => assert(time == currentTime) assert(busySimulants contains sim) busySimulants -= sim case Start => running = true case Stop => for (sim <- allSimulants) sim ! Stop exit() } } private def insert(agenda: List[WorkItem], item: WorkItem): List[WorkItem] = { if (agenda.isEmpty || item.time < agenda.head.time) item :: agenda else agenda.head :: insert(agenda.tail, item) } } ================================================ FILE: scala/programming_in_scala/src/main/scala/actorsimulation/Demo.scala ================================================ package actorsimulation object Demo { def main(args: Array[String]) { val circuit = new Circuit with Adders import circuit._ val ain = new Wire("ain", true) val bin = new Wire("bin", false) val cin = new Wire("cin", true) val sout = new Wire("sout") val cout = new Wire("cout") probe(ain) probe(bin) probe(cin) probe(sout) probe(cout) fullAdder(ain, bin, cin, sout, cout) circuit.start() } } ================================================ FILE: scala/programming_in_scala/src/main/scala/actorsimulation/Simulant.scala ================================================ package actorsimulation import scala.actors.Actor import scala.actors.Actor._ trait Simulant extends Actor { val clock: Clock start() def handleSimMessage(msg: Any) def simStarting() { } def act() { loop { react { case Stop => exit() case Ping(time) => if (time == 1) simStarting() clock ! Pong(time, self) case msg => handleSimMessage(msg) } } } } ================================================ FILE: scala/programming_in_scala/src/main/scala/arithmetic/Expr.scala ================================================ package arithmetic import layout.Element import layout.Element.elem sealed abstract class Expr case class Var(name: String) extends Expr case class Number(num: Double) extends Expr case class UnOp(operator: String, arg: Expr) extends Expr case class BinOp(operator: String, left: Expr, right: Expr) extends Expr object Expr { def simplify: (Expr => Expr) = { case UnOp("-", UnOp("-", e)) => e case BinOp("+", e, Number(0)) => e case BinOp("*", e, Number(1)) => e case BinOp("*", e, Number(0)) => Number(0) case BinOp("+", x, y) if x == y => BinOp("*", x, Number(2)) case UnOp(o, e) => UnOp(o, simplify(e)) case BinOp(o, l, r) => BinOp(o, simplify(l), simplify(r)) case e => e } } class ExprFormatter { private val opGroups = Array( Set("|", "||"), Set("&", "&&"), Set("^"), Set("==", "!="), Set("<", "<=", ">", ">="), Set("+", "-"), Set("*", "%") ) private val precendence = { val assocs = for { i <- 0 until opGroups.length op <- opGroups(i) } yield op -> i Map() ++ assocs } private val unaryPrecendence = opGroups.length private val fractionPrecendence = -1 private def format(e: Expr, enclPrec: Int): Element = e match { case Var(name) => elem(name) case Number(num) => elem(num.toString.replaceAll(".0$", "")) case UnOp(op, arg) => elem(op) beside format(arg, unaryPrecendence) case BinOp("/", left, right) => val top = format(left, fractionPrecendence) val bottom = format(right, fractionPrecendence) val line = elem('-', top.width max bottom.width, 1) val frac = top above line above bottom if (enclPrec != fractionPrecendence) frac else elem(" ") beside frac beside elem(" ") case BinOp(op, left, right) => val opPrec = precendence(op) val l = format(left, opPrec) val r = format(right, opPrec) val oper = l beside elem(" " + op + " ") beside r if (enclPrec <= opPrec) oper else elem("(") beside oper beside elem(")") } def format(e: Expr): Element = format(e, 0) } ================================================ FILE: scala/programming_in_scala/src/main/scala/layout/Element.scala ================================================ package layout object Element { private class ArrayElement( val contents: Array[String] ) extends Element private class LineElement(line: String) extends Element { def contents = Array(line) } private class UniformElement( val fill: Char, override val width: Int, override val height: Int ) extends Element { def contents = Array.make(height, fill.toString * width) } def elem(lines: Array[String]): Element = new ArrayElement(lines) def elem(line: String): Element = new LineElement(line) def elem(fill: Char, width: Int, height: Int): Element = new UniformElement(fill, width, height) } import Element.elem abstract class Element { def contents: Array[String] def width = if (contents.isEmpty) 0 else contents(0).length def height = contents.size override def toString = contents.mkString("\n") def above(that: Element): Element = { val adjustedThis = this widen that.width val adjustedThat = that widen this.width elem(adjustedThis.contents ++ adjustedThat.contents) } def beside(that: Element): Element = { val adjustedThis = this heighten that.height val adjustedThat = that heighten this.height elem( for ( (line1, line2) <- adjustedThis.contents zip adjustedThat.contents ) yield line1 + line2 ) } def widen(w: Int): Element = { if (w <= width) this else { val left = elem(' ', (w - width) / 2, height) val right = elem(' ', w - width - left.width, height) left beside this beside right } } def heighten(h: Int): Element = { if (h <= height) this else { val top = elem(' ', width, (h - height) / 2) val bottom = elem(' ', width, h - height - top.height) top above this above bottom } } } ================================================ FILE: scala/programming_in_scala/src/main/scala/layout/Spiral.scala ================================================ package layout import Element.elem object Spiral { val space = elem(" ") val corner = elem("+") def spiral(edges: Int): Element = spiral(edges, 0) def spiral(edges: Int, direction: Int): Element = { if (edges == 1) elem("+") else { val innerSpiral = spiral(edges - 1, (direction + 3) % 4) def verticalBar = elem('|', 1, innerSpiral.height) def horizontalBar = elem('-', innerSpiral.width, 1) direction match { case 0 => (corner beside horizontalBar) above (innerSpiral beside space) case 1 => (innerSpiral above space) beside (corner above verticalBar) case 2 => (space beside innerSpiral) above (horizontalBar beside corner) case _ => (verticalBar above corner) beside (space above innerSpiral) } } } def main(args: Array[String]) { val sides = args(0).toInt println(spiral(sides)) } } ================================================ FILE: scala/programming_in_scala/src/main/scala/simulation/BasicCircuitSimulation.scala ================================================ package simulation abstract class BasicCircuitSimulation extends Simulation { def InverterDelay: Int def AndGateDelay: Int def OrGateDelay: Int class Wire { private var sigVal = false private var actions: List[Action] = List() def getSignal = sigVal def setSignal(s: Boolean) = if (s != sigVal) { sigVal = s actions foreach (_ ()) } def addAction(a: Action) = { actions = a ::actions a() } } def inverter(input: Wire, output: Wire) = { def inverterAction() { val inputSig = input.getSignal afterDelay(InverterDelay) { output setSignal !inputSig } } input addAction inverterAction } def andGate(a1: Wire, a2: Wire, output: Wire) = { def andGateAction() { val a1Sig = a1.getSignal val a2Sig = a2.getSignal afterDelay(AndGateDelay) { output setSignal (a1Sig & a2Sig) } } a1 addAction andGateAction a2 addAction andGateAction } def orGate(o1: Wire, o2: Wire, output: Wire) = { def orGateAction() { val o1Sig = o1.getSignal val o2Sig = o2.getSignal afterDelay(OrGateDelay) { output setSignal (o1Sig | o2Sig) } } o1 addAction orGateAction o2 addAction orGateAction } def probe(name: String, wire: Wire) { def probeAction() { println(name + " " + currentTime + " new-value = " + wire.getSignal) } wire addAction probeAction } } ================================================ FILE: scala/programming_in_scala/src/main/scala/simulation/CircuitSimulation.scala ================================================ package simulation abstract class CircuitSimulation extends BasicCircuitSimulation { def halfAdder(a: Wire, b: Wire, s: Wire, c: Wire) { val d, e = new Wire orGate(a, b, d) andGate(a, b, c) inverter(c, e) andGate(d, e, s) } def fullAdder(a: Wire, b: Wire, cin: Wire, sum: Wire, cout: Wire) { val s, c1, c2 = new Wire halfAdder(a, cin, s, c1) halfAdder(b, s, sum, c2) orGate(c1, c2, cout) } } ================================================ FILE: scala/programming_in_scala/src/main/scala/simulation/Simulation.scala ================================================ package simulation abstract class Simulation { type Action = () => Unit case class WorkItem(time: Int, action: Action) private var curtime = 0 def currentTime: Int = curtime private var agenda: List[WorkItem] = List() private def insert(agenda: List[WorkItem], item:WorkItem): List[WorkItem] = { if (agenda.isEmpty || item.time < agenda.head.time) item :: agenda else agenda.head :: insert(agenda.tail, item) } def afterDelay(delay: Int)(block: => Unit) { var item = WorkItem(currentTime + delay, () => block) agenda = insert(agenda, item) } private def next() { (agenda: @unchecked) match { case item :: rest => agenda = rest curtime = item.time item.action() } } def run() { afterDelay(0) { println("*** simulation started, time = " + currentTime + "***") } while (!agenda.isEmpty) next() } } ================================================ FILE: scala/programming_in_scala/src/main/scala/simulation/StairwayBookSimulation.scala ================================================ package simulation object StairwayBookSimulation extends CircuitSimulation { def InverterDelay = 1 def AndGateDelay = 3 def OrGateDelay = 5 def main(args: Array[String]) = { var input1, input2, sum, carry = new Wire probe("sum", sum) probe("carry", carry) halfAdder(input1, input2, sum, carry) input1 setSignal true run() input2 setSignal true run() } } ================================================ FILE: scala/programming_in_scala/src/test/scala/arithmetic/ExprFormatterSpec.scala ================================================ package arithmetic import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class ExprFormatterSpec extends Spec with ShouldMatchers { describe("ExprFormatter.format") { def draw(e: Expr): String = new ExprFormatter().format(e).toString it("can draw a + (b + c)") { draw(BinOp("+", Var("a"), BinOp("+", Var("b"), Var("c")))) should equal ("a + b + c") } it("can draw (a / b) / c") { draw(BinOp("/", BinOp("/", Var("a"), Var("b")), Var("c"))) should equal ( """| a | - | b |--- | c """.stripMargin ) } it("can draw x / x + 1") { draw(BinOp("/", Var("x"), BinOp("+", Var("x"), Number(1)))) should equal ( """| x |----- |x + 1""".stripMargin ) } it("can draw ((a / (b * c) + 1 / n) / 3)") { draw(BinOp("/", BinOp("+", BinOp("/", Var("a"), BinOp("*", Var("b"), Var("c"))), BinOp("/", Number(1), Var("n"))), Number(3)) ) should equal ( """| a 1 |----- + - |b * c n |--------- | 3 """.stripMargin ) } it("can draw ((1 / 2) * (x + 1)) / ((x / 2) + (1.5 / x))") { draw(BinOp("/", BinOp("*", BinOp("/", Number(1), Number(2)), BinOp("+", Var("x"), Number(1))), BinOp("+", BinOp("/", Var("x"), Number(2)), BinOp("/", Number(1.5), Var("x")))) ) should equal ( """|1 |- * (x + 1) |2 |----------- | x 1.5 | - + --- | 2 x """.stripMargin ) } } } ================================================ FILE: scala/programming_in_scala/src/test/scala/arithmetic/SimplificationSpec.scala ================================================ package arithmetic import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import Expr.simplify class SimplificationSpec extends Spec with ShouldMatchers { describe("Expr.simplify(expr)") { it("simplifies -(-1)) to 1") { simplify(UnOp("-", UnOp("-", Number(1)))) should equal (Number(1)) } it("simplifies e+0 to e") { simplify(BinOp("+", Var("e"), Number(0))) should equal (Var("e")) } it("simplifies e*1 to e") { simplify(BinOp("*", Var("e"), Number(1))) should equal (Var("e")) } it("simplifies e*0 to 0") { simplify(BinOp("*", Var("e"), Number(0))) should equal (Number(0)) } it("'simplifies' (a+b)+(a+b) to (a+b)*2") { simplify(BinOp("+", BinOp("+", Var("a"), Var("b")), BinOp("+", Var("a"), Var("b")) )) should equal (BinOp("*", BinOp("+", Var("a"), Var("b")), Number(2))) } it("simplifies log((-(-1)) + (x+0)) to log(1)") { simplify(UnOp("log", BinOp("+", UnOp("-", UnOp("-", Number(1))), BinOp("+", Var("x"), Number(0)))) ) should equal (UnOp("log", BinOp("+", Number(1), Var("x")))) } } } ================================================ FILE: scala/programming_in_scala/src/test/scala/layout/CompositionSpec.scala ================================================ package layout import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import Element.elem class CompositionSpec extends Spec with ShouldMatchers { it(".widen(w: Int) pads the element with spaces until it reaches width w") { elem("x").widen(3).toString should equal (" x ") elem("x").widen(4).toString should equal (" x ") elem(Array("1", "2")).widen(3).toString should equal(" 1 \n 2 ") } it(".heighten(h: Int) pads the element with spaces until it reaches height h") { elem("x").heighten(3).toString should equal (" \nx\n ") elem("x").heighten(2).toString should equal ("x\n ") elem("12345").heighten(2).toString should equal ("""|12345 | """.stripMargin) } describe(".above") { it("put one element above the other") { (elem("12") above elem("34")).toString should equal ("12\n34") } it("allows for elements of different size") { val composition = elem("1234").above(elem("12")).toString composition should equal ("""|1234 | 12 """.stripMargin) } } describe(".beside") { it("puts two elements next to each other") { (elem(Array("1", "2")) beside elem(Array("3", "4"))).toString should equal ("13\n24") } it("allows for elements of different sizes") { val composition = elem("one ").beside(elem(Array("one", "two"))).toString composition should equal ("""|one one | two""".stripMargin) } } } ================================================ FILE: scala/programming_in_scala/src/test/scala/layout/FactoryMethodsSpec.scala ================================================ package layout import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers import Element.elem class FactoryMethodsSpec extends Spec with ShouldMatchers { describe("Element.elem(lines: Array[String]") { it("constructs an element from multiple lines of text") { elem(Array("aaa", "bbb", "ccc")).toString should equal ("aaa\nbbb\nccc") } it("constructs an element as wide as the first string in lines") { elem(Array("12345", "54321")).width should equal (5) } it("constructs an element with width equal to 0 if lines is empty") { elem(Array[String]()).width should equal (0) } it("constructs an element with height equal to the length of lines") { elem(Array("1", "2", "3")).height should equal (3) } } describe("Element.elem(line: String") { it("constructs a one-row element from line") { elem("12345").toString should equal ("12345") } it("constructs an element as wide as line") { elem("12345").width should equal (5) } it("constructs an element with height 1") { elem("something").height should equal (1) } } describe("Element.elem(fill: Char, width: Int, height: Int)") { it("constructs a width x height block, filled uniformly with fill") { elem('o', 3, 2).toString should equal ("ooo\nooo") } it("constructs an element with the given width") { elem('o', 3, 2).width should equal (3) } it("constructs an element with the given height") { elem('o', 3, 2).height should equal (2) } } } ================================================ FILE: scala/programming_in_scala/src/test/scala/layout/SpiralSpec.scala ================================================ package layout import org.scalatest.Spec import org.scalatest.matchers.ShouldMatchers class SpiralSpec extends Spec with ShouldMatchers { def spiral(edges: Int) = Spiral.spiral(edges).toString it("renders spirals with 6 edges") { spiral(6) should equal (""":+----- :| :| +-+ :| + | :| | :+---+ """.stripMargin(':')) } it("renders a spiral with 11 edges") { spiral(11) should equal (""":+---------- :| :| +------+ :| | | :| | +--+ | :| | | | | :| | ++ | | :| | | | :| +----+ | :| | :+--------+ """.stripMargin(':')) } it("renders a spiral with 17 edges") { spiral(17) should equal (""":+---------------- :| :| +------------+ :| | | :| | +--------+ | :| | | | | :| | | +----+ | | :| | | | | | | :| | | | ++ | | | :| | | | | | | | :| | | +--+ | | | :| | | | | | :| | +------+ | | :| | | | :| +----------+ | :| | :+--------------+ """.stripMargin(':')) } } ================================================ FILE: scheme/eopl/.gitignore ================================================ Gemfile.lock ================================================ FILE: scheme/eopl/.ruby-version ================================================ 2.3.3 ================================================ FILE: scheme/eopl/.rvmrc ================================================ rvm --create 1.9.3@eopl ================================================ FILE: scheme/eopl/01/01.scm ================================================ ; EOPL exercise 1.01 ; ; Write inductive definitions of the following sets. Write each definition in ; all tree styles (top-down, bottom-up, and rules of inference). Using your ; rules, show the derivation of some sample elements of each set. ; ; 1. {3n + 2 | n ∈ N} ; 2. {2n + 3m + 1 | m, n ∈ N} ; 3. {(n, 2n + 1) | n ∈ N} ; 4. {(n, n²) | n ∈ N} Do not mention squaring in your rules. As a hint, ; remember the equation (n + 1)² = n² + 2n + 1 ; 1. {3n + 2 | m ∈ N} ; ; top-down: ; ; A natural number k is in S if and only if ; 1. k = 2, or ; 2. k - 3 ∈ S. ; ; bottom-up: ; ; Define the set S to be the smallest set contained in N and satisfying ; the following two properties: ; 1. 2 ∈ S, and ; 3. if k ∈ S, then k + 3 ∈ S. ; ; rules of inference: ; ; ───── ; 2 ∈ S ; ; k ∈ S ; ─────────── ; (k + 3) ∈ S ; ; sample derivation: ; ; 2 ∈ S ; ───── ; 5 ∈ S ; ───── ; 8 ∈ S ; ; 2. {2n + 3m + 1 | m, n ∈ N} ; ; top-down: ; ; A natural number k is in S if and only if ; 1. k = 1, or ; 2. k - 2 ∈ S, or ; 3. k - 3 ∈ S. ; ; bottom-up: ; ; Define the set S to be the smallest set contained in N and satisfying ; the following three properties: ; 1. 1 ∈ S, or ; 2. if k ∈ S, then k + 2 ∈ S, or ; 3. if k ∈ S, then k + 3 ∈ S. ; ; rules of inference: ; ; ───── ; 1 ∈ S ; ; k ∈ S ; ─────────── ; (k + 2) ∈ S ; ; k ∈ S ; ─────────── ; (k + 3) ∈ S ; ; sample derivation: ; ; 1 ∈ S ; ───── ; 3 ∈ S ; ───── ; 6 ∈ S ; ───── ; 8 ∈ S ; ────── ; 11 ∈ S ; ; 3. {(n, 2n + 1) | n ∈ N} ; ; top-down: ; ; A two-element list (a, b) is in S if and only if ; 1. a = 0, b = 1, or ; 2. (a - 1, b - 2) ∈ S. ; ; bottom-up: ; ; The set S is the smallest set of Scheme lists with two elements ; satisfying the following two properties: ; 1. (0, 1) ∈ S ; 2. if (a, b) ∈ S, then (a + 1, b + 2) ∈ S ; ; rules of inference: ; ; ────────── ; (0, 1) ∈ S ; ; (a, b) ∈ S ; ────────────────── ; (a + 1, b + 2) ∈ S ; ; sample derivation: ; ; (0, 1) ∈ S ; ────────── ; (1, 3) ∈ S ; ────────── ; (2, 5) ∈ S ; ────────── ; (3, 8) ∈ S ; ; 4. {(n, n²) | n ∈ N} ; ; top-down: ; ; A two-element list (a, b) is in S if and only if ; 1. a = 0, b = 0, or ; 2. (a - 1, b - 2a - 1) ∈ S. ; ; bottom-up: ; ; The set S is the smallest set of Scheme lists with two elements ; satisfying the following two properties: ; 1. (0, 1) ∈ S ; 2. if (a, b) ∈ S, then (a + 1, b + 2a + 1) ∈ S ; ; rules of inference: ; ; ────────── ; (0, 0) ∈ S ; ; (a, b) ∈ S ; ─────────────────────── ; (a + 1, b + 2a + 1) ∈ S ; ; sample derivation: ; ; (0, 0) ∈ S ; ────────── ; (1, 1) ∈ S ; ────────── ; (2, 4) ∈ S ; ────────── ; (3, 9) ∈ S ================================================ FILE: scheme/eopl/01/02.scm ================================================ ; EOPL exercise 1.02 ; ; What sets are defined by the following pairs of rules? Explain why. ; ; (n, k) ∈ S ; 1. (0, 1) ∈ S ────────────────── ; (n + 1, k + 7) ∈ S ; ; (n, k) ∈ S ; 2. (0, 1) ∈ S ─────────────── ; (n + 1, 2k) ∈ S ; ; (n, i, j) ∈ S ; 3. (0, 0, 1) ∈ S ───────────────────── ; (n + 1, j, i + j) ∈ S ; ; (n, i, j) ∈ S ; 4. (0, 1, 0) ∈ S ───────────────────────── ; (n + 1, i + 2, i + j) ∈ S ; 1. This is the set of (n, 7n + 1) for n ∈ N. It is rather obvious why. ; ; 2. This is the set (n, 2ⁿ). You can tell that the first element grows in ; increments of (like f(n) = n) and the second gets multiplied by two on ; every iteration (like f(n) = 2ⁿ). ; ; 3. This set represents the Fibonacci numbers. If they are zero-indexed and ; the first fibonaci number is 0, then this is (n, fib(n), fib(n + 1)). ; This is easy to see, because the first element grows linearly, ; independent from the other two. The second becomes the third from the ; previous iteration and the third is the sum of the second and third from ; the previous iteration, which is essentially the definition of Fibonacci. ; ; 4. This is an interesting one. It results to (n, 2n + 1, n²). It's easy to ; see that the first one grows linearly, independent of the other two. The ; second starts with 1 and grows by 2 on every iteration, thus 2n + 1. The ; third one grows by 2n + 1 on every iteration, where n is the iteration ; count. Thus, if the third element is calculated by g(n): ; ; g(0) = 0 = n⁰ ; g(1) = 1 + 0 = 1 = n¹ ; g(2) = 3 + 1 = 4 = n² ; ... ; g(n + 1) = i + j = 2n + 1 + n² = n² + 2n + 1 = (n + 1)² ================================================ FILE: scheme/eopl/01/03.scm ================================================ ; EOPL exercise 1.03 ; ; Find a set T of natural numbers such that 0 ∈ T, and whenever n ∈ T, then ; n + 3 ∈ T, but T ≠ S, where S is the set defined in definition 1.1.2. ; I really don't get the point of this exercise, since it looks simple enough, ; but if we add that 1 ∈ T, then T would be a subset of S and therefore ; different than it. Note that it will be the union of S and {n + 1 | n ∈ N}. ================================================ FILE: scheme/eopl/01/04.scm ================================================ ; EOPL exercise 1.04 ; ; Write a derivation from List-of-Int to (-7 . (3 . (14 . ()))) ; List-of-Int ; ⇒ (-7 . List-of-Int) ; ⇒ (-7 . (3 . List-of-Int)) ; ⇒ (-7 . (3 . (14 . List-of-Int))) ; ⇒ (-7 . (3 . (14 . ()))) ================================================ FILE: scheme/eopl/01/05.scm ================================================ ; EOPL exercise 1.05 ; ; Prove that if e ∈ LcExp, then there are the same number of left and right ; parenthesis in e. ; The lambda expression grammar is: ; ; LcExp ::= Identifier ; ::= (lambda (Identifier) LcExp) ; ::= (LcExp LcExp) ; ; I don't think I need induction here, but let's try to put it in. ; ; Proof: The proof is by induction on the size of e, where we take the size of ; e to be the number of productions in the grammar. The induction hypothesis ; IH(k), is that any expression with number of productions ≤ k has the same ; number of left and right parenthesis. ; ; 1. There is only one expression with 1 production and this is Identifier. ; All other have a LcExp non-terminal, thus requiring more productions. By ; definition, identifiers don't include parenthesis, so IH(1) holds. ; 2. Let k be an integer such that IH(k) holds. We will show that IH(k + 1) ; holds as well. If e requires ≤ k + 1 productions, there are three ; possibilities in the grammar: ; ; (a) e can be of the form Identifer. There are no parenthesis, so this ; holds trivially. ; (b) e can be of the form (lambda (Identifier) e₁). The number of left ; parenthesis is 2 + left-parens(e₁). The number of right parenthesis ; is 2 + right-parens(e₁). Since e requires ≤ k + 1 productions, we ; can infer that e₁ requires ≤ k productions. From the hypothesis, we ; know that e₁ has the same number of left and right parenthesis, ; thus IH(k + 1) holds. ; (c) e can be of the form (e₁ e₂), where e₁ and e₂ are of the form ; LcExp. Since e requires ≤ k + 1 productions, both require ≤ k ; productions and we know that each has the same number of ; parenthesis. Thus if p₁ = left-parens(e₁) = right-parens(e₁) and ; p₂ = left-parens(e₂) = right-parens(e₂), then we see that: ; ; left-parens(e) = 1 + left-parens(e₁) + left-parens(e₂ ) = 1 + p₁ + p₂ ; right-parens(e) = 1 + right-parens(e₁) + right-parens(e₂) = 1 + p₁ + p₂ ; ; and thus ; ; left-parens(e) = right-parens(2) ; ; which proves that IH(k + 1) holds. ; ; This completes the proof of the claim that IH(k + 1) holds and therefore ; completes the induction.∎ ================================================ FILE: scheme/eopl/01/06.scm ================================================ ; EOPL exercise 1.06 ; ; If we reversed the order of the tests in nth-element, what would go wrong? ; The code will look like this: (define nth-element (lambda (lst n) (if (zero? n) (car lst) (if (null? lst) (report-list-too-short n) (nth-element (cdr lst) (- n 1)))))) ; We will loose the error message in one specific case - that is, when we call ; (nth-elemen lst n) when n is (length lst), that is, when we try to access ; one more elements than the list has. In that case, the computation will ; eventually be reduced to a call (nth-element '() 0). Since n is zero, the ; computation will attempt to return the car of '(), which will result to an ; error. This is not the error we had in mind, though. ================================================ FILE: scheme/eopl/01/07.scm ================================================ ; EOPL exercise 1.07 ; ; The error message form nth-element is uninformative. Rewrite nth-element so ; that it produces a more informative error message such as "(a b c) does not ; have 8 elements" ; I don't know how much Scheme can I use in this exercise, so I will just go ; with an internal definition. (define (nth-element lst n) (define (iter items counter) (if (null? items) (eopl:error 'nth-element "~s does not have ~s elements." lst n) (if (zero? counter) (car items) (iter (cdr items) (- counter 1))))) (iter lst n)) ================================================ FILE: scheme/eopl/01/08.scm ================================================ ; EOPL exercise 1.08 ; ; In the definition of remove-first, if the last line were replaced by ; (remove-first s (cdr los)), what function would the resulting procedure ; compute? Give the contract, including the usage statement, for the revised ; procedure. ; drop-until: Sym ╳ Listof(Sym) → Listof(Sym) ; usage: (drop-until s los) returns the suffix of the list los that starts ; after the first occurence of the symbol s. (define drop-until (lambda (s los) (if (null? los) '() (if (eqv? (car los) s) (cdr los) (drop-until s (cdr los)))))) ================================================ FILE: scheme/eopl/01/09.scm ================================================ ; EOPL exercise 1.09 ; ; Define remove, which is like remove-first, except that it removes all ; occurences of a given symbol form a list of symbols, not just the first. ; Of course, remove is already defined in Scheme, so I'm going to define ; another function, remove-all, to allow the function body to see itself in ; the enclosing environment. (define remove-all (lambda (s los) (cond ((null? los) '()) ((eq? (car los) s) (remove-all s (cdr los))) (#t (cons (car los) (remove-all s (cdr los))))))) (define remove remove-all) ================================================ FILE: scheme/eopl/01/10.scm ================================================ ; EOPL exercise 1.10 ; ; We typically use "or" to mean "inclusive or". What other meanings can "or" ; have? ; Of course, it can be "exclusive or", as in the expression "Coffee or tea?". ; It implies that you have to chose either coffee or tea, but not both. This ; is known as the XOR operation. ================================================ FILE: scheme/eopl/01/11.scm ================================================ ; EOPL exercise 1.11 ; ; In the last line of subts-in-s-exp, the recursion is on sexp and not a ; smaller substructure. Why is the recursion guaranteed to halt? ; The recursion might be on sexp, but it calls subst instead. The substs ; procedure will reduce the problem to a smaller problem, which would ; guarantee that it will halt. ================================================ FILE: scheme/eopl/01/12.scm ================================================ ; EOPL exercise 1.12 ; ; Eliminate the one call to subst-in-s-exp in subst, by replacing it by its ; definition and simplifying the resulting procedure. The result will be a ; version of substs that does not need subst-in-s-exp. This technique is ; called inlining, and is used by optimizing compilers. (define subst (lambda (new old slist) (if (null? slist) '() (cons (if (symbol? (car slist)) (if (eqv? (car slist) old) new (car slist)) (subst new old (car slist))) (subst new old (cdr slist)))))) ================================================ FILE: scheme/eopl/01/13.scm ================================================ ; EOPL exercise 1.13 ; ; In our example, we began by eliminating the Kleene star in the grammar of ; S-list. Write subst following the original grammar by using map. (define subst (lambda (new old slist) (map (lambda (sexp) (subst-in-s-exp new old sexp)) slist))) (define subst-in-s-exp (lambda (new old sexp) (if (symbol? sexp) (if (eqv? sexp old) new sexp) (subst new old sexp)))) ================================================ FILE: scheme/eopl/01/14.scm ================================================ ; EOPL exercise 1.14 ; ; Given the assumption 0 ≤ n < length(v), prove that partial-vector-sum is ; correct. ; I don't grok this. It's extremely straightforward. Let's try using induction. ; ; 1. (partial-vector-sum v 0) returns the sum of indices in [0, 0]. This is ; trivially obvious. ; 2. Let's assume that it is correct for k. For k + 1, partial-vector-sum ; returns (vector-ref v k+1) + (partial-vector-sum v k). This is the sum of ; this is the value of the partial sum from 0 to k + 1. ================================================ FILE: scheme/eopl/01/15.scm ================================================ ; EOPL exercise 1.15 ; ; (duple n x) returns a list containing n copies of x. ; ; > (duple 2 3) ; (3 3) ; > (duple 4 '(ha ha)) ; ((ha ha) (ha ha) (ha ha) (ha ha)) ; > (duple 0 '(blah)) ; '() ; duple: Int × Any → Listof(Any) ; usage: takes an argument item and returns a list of containing n copies of ; item. (define duple (lambda (count item) (if (zero? count) '() (cons item (duple (- count 1) item))))) ================================================ FILE: scheme/eopl/01/16.scm ================================================ ; EOPL exercise 1.16 ; ; (invert lst), where lst is a list of 2-lists (lists of length two), returns ; a list with each 2-list reversed. ; ; > (invert '((a 1) (a 2) (1 b) (2 b))) ; ((1 a) (2 a) (b 1) (b 2)) (define invert (lambda (pairs) (if (null? pairs) '() (cons (list (cadar pairs) (caar pairs)) (invert (cdr pairs)))))) ================================================ FILE: scheme/eopl/01/17.scm ================================================ ; EOPL exercise 1.17 ; ; (down lst) wraps parenthesis aroudn each top-level elements of lst. ; ; > (down '(1 2 3)) ; ((1) (2) (3)) ; > (down '((a) (fine) (idea))) ; (((a)) ((fine)) ((idea))) ; > (down '(a (more (complicated)) object)) ; ((a) ((more (complicated))) (object)) (define down (lambda (lst) (map list lst))) ================================================ FILE: scheme/eopl/01/18.scm ================================================ ; EOPL exercise 1.18 ; ; (swapper s1 s2 slist) returns a list the same as slist, but with all ; occurences of s1 replaced by s2 and all occurences of s2 replaced by s1. ; ; > (swapper 'a 'd '(a b c d)) ; (d b c a) ; > (swapper 'a 'd '(a d () c d)) ; (d a () c a) ; > (swapper 'x 'y '((x) y (z (x)))) ; ((y) x (z (y))) (define (swapper s1 s2 slist) (cond ((null? slist) '()) ((eqv? s1 slist) s2) ((eqv? s2 slist) s1) ((symbol? slist) slist) (#t (map (curry swapper s1 s2) slist)))) ================================================ FILE: scheme/eopl/01/19.scm ================================================ ; EOPL exercise 1.19 ; ; (list-set lst n x) returns a list like lst, except that the n-th element, ; using zero-based indexing, is x. ; ; > (list-set '(a b c d) 2 '(1 2)) ; (a b (1 2) d) ; > (list-ref (list-set '(a b c d) 3 '(1 5 10)) 3) ; (1 5 10) (define (list-set lst n x) (if (zero? n) (cons x (cdr lst)) (cons (car lst) (list-set (cdr lst) (- n 1) x)))) ================================================ FILE: scheme/eopl/01/20.scm ================================================ ; EOPL exercise 1.20 ; ; (count-occurences s slist) returns the number of occurences of s in slist. ; ; > (count-occurences 'x '((f x) y (((x z) x)))) ; 3 ; > (count-occurences 'x '((f x) y (((x z) () x)))) ; 3 ; > (count-occurences 'w '((f x) y (((x z) x)))) ; 0 (define (count-occurences s slist) (cond ((null? slist) 0) ((symbol? slist) (if (eqv? s slist) 1 0)) (#t (+ (count-occurences s (car slist)) (count-occurences s (cdr slist)))))) ================================================ FILE: scheme/eopl/01/21.scm ================================================ ; EOPL exercise 1.21 ; ; (product sos1 sos2), where sos1 and sos2 are each a list of symbols without ; repetitions, returns a list of 2-lists that represents a Cartesian product ; of sos1 and sos2. The 2-lists can appear in any order. ; ; > (product '(a b c) '(x y)) ; ((a x) (a y) (b x) (b y) (c x) (c y)) (define (product sos1 sos2) (if (null? sos1) '() (append (map (lambda (s) (list (car sos1) s)) sos2) (product (cdr sos1) sos2)))) ================================================ FILE: scheme/eopl/01/22.scm ================================================ ; EOPL exercise 1.22 ; ; (filter-in pred lst) returns the list of those elements in lst that satisfy ; the predicate pred. ; ; > (filter-in number? '(a 2 (1 3) b 7)) ; (2 7) ; > (filter-in symbol? '(a (b c) 17 foo)) ; (a foo) (define (filter-in pred lst) (if (null? lst) '() (if (pred (car lst)) (cons (car lst) (filter-in pred (cdr lst))) (filter-in pred (cdr lst))))) ================================================ FILE: scheme/eopl/01/23.scm ================================================ ; EOPL exercise 1.23 ; ; (list-index pred lst) returns the 0-based position of the first element of ; lst that satisfies the predicate pred. If no element of lst satisfies the ; predicate, then list-index returns #f. ; ; > (list-index number? '(a 2 (1 3) b 7)) ; 1 ; > (list-index symbol? '(a (b c) 17 foo)) ; 0 ; > (list-index symbol? '(1 2 (a b) 3)) ; #f (define (list-index pred lst) (define (iter counter items) (cond ((null? items) #f) ((pred (car items)) counter) (#t (iter (+ counter 1) (cdr items))))) (iter 0 lst)) ================================================ FILE: scheme/eopl/01/24.scm ================================================ ; EOPL exercise 1.24 ; ; (every? pred lst) returns #f if any element of lst fails to satisfy pred, ; and returns #t otherwise. ; ; > (every? number? '(a b c 3 e)) ; #f ; > (every? number? '(1 2 3 5 4)) ; #t (define (every? pred lst) (cond ((null? lst) #t) ((pred (car lst)) (every? pred (cdr lst))) (#t #f))) ================================================ FILE: scheme/eopl/01/25.scm ================================================ ; EOPL exercise 1.25 ; ; (exists? number? '(a b c 3 e)) returns #t if any element of lst satisfies ; pred, and returns #f otherwise. ; ; > (exists? number? '(a b c 3 e)) ; #t ; > (exists? number? '(a b c d e)) ; #f (define (exists? pred lst) (cond ((null? lst) #f) ((pred (car lst)) #t) (#t (exists? pred (cdr lst))))) ================================================ FILE: scheme/eopl/01/26.scm ================================================ ; EOPL exercise 1.26 ; ; (up lst) removes a pair of parentheses from each top-level element of lst. ; If a top-level element is not a list, it is included in result, as is. The ; value of (up (down lst)) is equivalent to lst, but (down (up lst)) is not ; necessarily lst. (See exercise 1.17). ; ; > (up '((1 2) (3 4))) ; (1 2 3 4) ; > (up '((x (y)) z)) ; (x (y) z) (define (up lst) (if (null? lst) '() (append (if (pair? (car lst)) (car lst) (list (car lst))) (up (cdr lst))))) ================================================ FILE: scheme/eopl/01/27.scm ================================================ ; EOPL exercise 1.27 ; ; (flatten slist) returns a list of the symbols contained in slist in the ; order in which they occur when slist is printed. Intuitively, flatten ; removes all the inner parentheses from its arguments. ; ; > (flatten '(a b c)) ; (a b c) ; > (flatten '((a) () (b ()) () (c))) ; (a b c) ; > (flatten '((a b) c (((d)) e))) ; (a b c d e) ; > (flatten '(a b (() (c)))) ; (a b c) (define (flatten slist) (cond ((null? slist) '()) ((pair? slist) (append (flatten (car slist)) (flatten (cdr slist)))) (#t (list slist)))) ================================================ FILE: scheme/eopl/01/28.scm ================================================ ; EOPL exercise 1.28 ; ; (merge loi1 loi2), where loi1 and loi2 are lists of integers that are sorted ; in ascending order, returns a sorted list of all integers in loi1 and loi2. ; ; > (merge '(1 4) '(1 2 8)) ; (1 1 2 4 8) ; > (merge '(35 62 81 90 91) '(3 83 85 90)) ; (3 35 62 81 83 85 90 90 91) (define (merge loi1 loi2) (cond ((null? loi1) loi2) ((null? loi2) loi1) ((< (car loi1) (car loi2)) (cons (car loi1) (merge (cdr loi1) loi2))) (#t (cons (car loi2) (merge loi1 (cdr loi2)))))) ================================================ FILE: scheme/eopl/01/29.scm ================================================ ; EOPL exercise 1.29 ; ; (sort loi) returns a list of the elements of loi in ascending order. ; ; > (sort '(8 2 5 2 3)) ; (2 2 3 5 8) (define (merge loi1 loi2) (cond ((null? loi1) loi2) ((null? loi2) loi1) ((< (car loi1) (car loi2)) (cons (car loi1) (merge (cdr loi1) loi2))) (#t (cons (car loi2) (merge loi1 (cdr loi2)))))) (define (split loi) (define (iter first second n) (if (zero? n) (list first second) (iter (cdr first) (cons (car first) second) (- n 1)))) (iter loi '() (quotient (length loi) 2))) (define (merge-sort loi) (if (<= (length loi) 1) loi (let* ((lists (split loi)) (first (car lists)) (second (cadr lists))) (merge (merge-sort first) (merge-sort second))))) (define (sort loi) (merge-sort loi)) ================================================ FILE: scheme/eopl/01/30.scm ================================================ ; EOPL exercise 1.30 ; ; (sort/predicate pred loi) returns a list of elements sorted by the ; predicate. ; ; > (sort/predicate < '(8 2 5 2 3)) ; (2 2 3 5 8) ; > (sort/predicate > '(8 2 5 2 3)) ; (8 5 3 2 2) (define (sort/predicate pred loi) (define (split loi) (define (iter first second n) (if (zero? n) (list first second) (iter (cdr first) (cons (car first) second) (- n 1)))) (iter loi '() (quotient (length loi) 2))) (define (merge loi1 loi2) (cond ((null? loi1) loi2) ((null? loi2) loi1) ((pred (car loi1) (car loi2)) (cons (car loi1) (merge (cdr loi1) loi2))) (#t (cons (car loi2) (merge loi1 (cdr loi2)))))) (define (merge-sort loi) (if (<= (length loi) 1) loi (let* ((lists (split loi)) (first (car lists)) (second (cadr lists))) (merge (merge-sort first) (merge-sort second))))) (merge-sort loi)) ================================================ FILE: scheme/eopl/01/31.scm ================================================ ; EOPL exercise 1.31 ; ; Write the following procedures for calculating on a bintree (definition ; 1.1.7): leaf and interior-node, which builds bintrees, leaf?, which tests ; whether a bintree is a leaf, and lson, rson and contents-of, which extract ; components of a node. contents-of should work on both leaves end interior ; nodes. (define (leaf? tree) (number? tree)) (define (leaf number) (if (number? number) number (eopl:error 'leaf "Leaf argument must be a number. Got ~s instead." number))) (define (interior-node data left-son right-son) (if (symbol? data) (list data left-son right-son) (eopl:error 'interior-node "Data must be a symbol. Got ~s instead." data))) (define (lson tree) (cadr tree)) (define (rson tree) (caddr tree)) (define (contents-of tree) (if (leaf? tree) tree (car tree))) ================================================ FILE: scheme/eopl/01/32.scm ================================================ ; EOPL exercise 1.32 ; ; Write a procedure double-tree that takes a bintree, as represented in ; definition 1.1.7, and produces another bintree like the original, but with ; all the integers in the leaves doubled. ; We base this on the previous exercise (load-relative "31.scm") (define (double-tree tree) (if (leaf? tree) (* (contents-of tree) 2) (interior-node (contents-of tree) (double-tree (lson tree)) (double-tree (rson tree))))) ================================================ FILE: scheme/eopl/01/33.scm ================================================ ; EOPL exercise 1.33 ; ; Write a procedure mark-leaves-with-red-depth that takes a bintree ; (definition 1.1.7), and produces a bintree of the same shape as the ; original, except that in the new tree, each leaf contains the integer of ; nodes between it and the root that contain the symbol red. For example, the ; expression ; ; (mark-leaves-with-red-depth ; (interior-node 'bar ; (interior-node 'bar ; (leaf 26) ; (leaf 12)) ; (interior-node 'red ; (leaf 11) ; (interior-node 'quux ; (leaf 117) ; (leaf 14))))) ; ; which is written using the procedures defined in exercise 1.31, should ; return the bintree ; ; (red ; (bar 1 1) ; (red 2 (quux 2 2))) (load-relative "31.scm") (define (mark-leaves-with-red-depth tree) (define (traverse tree count) (if (leaf? tree) (leaf count) (let ((new-count (if (eqv? (contents-of tree) 'red) (+ count 1) count))) (interior-node (contents-of tree) (traverse (lson tree) new-count) (traverse (rson tree) new-count))))) (traverse tree 0)) ================================================ FILE: scheme/eopl/01/34.scm ================================================ ; EOPL exercise 1.34 ; ; Write a procedure path that takes an integer n and a binary search tree bst ; (page 10) that contains the integer n, and returns a list of lefts and ; rights showing how to find the node containing n. If n is found at the root, ; it returns the empty list. ; ; > (path 17 '(14 (7 () (12 () ())) ; (26 (20 (17 () ()) ; ()) ; (31 () ())))) ; (right left left) (define (path n bst) (if (eqv? n (car bst)) '() (if (< n (car bst)) (cons 'left (path n (cadr bst))) (cons 'right (path n (caddr bst)))))) ================================================ FILE: scheme/eopl/01/35.scm ================================================ ; EOPL exercise 1.35 ; ; Write a procedure number-leaves that takes a bintree, and produces a bintree ; like the original, except the contents of the leaves are numbered starting ; from 0. For example, ; ; (number-leaves ; (interior-node 'foo ; (interior-node 'bar ; (leaf 26) ; (leaf 12)) ; (interior-node 'baz ; (leaf 11) ; (interior-node 'quux ; (leaf 117) ; (leaf 14))))) ; ; should return ; ; (foo ; (bar 0 1) ; (baz ; 2 ; (quux 3 4))) (load-relative "31.scm") (define (number-leaves tree) (define (traverse tree counter) (if (leaf? tree) (cons (+ counter 1) (leaf counter)) (let* ((node-data (contents-of tree)) (lson-result (traverse (lson tree) counter)) (counter-after-lson (car lson-result)) (result-lson (cdr lson-result)) (rson-result (traverse (rson tree) counter-after-lson)) (result-counter (car rson-result)) (result-rson (cdr rson-result)) (result-tree (interior-node node-data result-lson result-rson))) (cons result-counter result-tree)))) (cdr (traverse tree 0))) ================================================ FILE: scheme/eopl/01/36.scm ================================================ ; EOPL exercise 1.36 ; ; Write a procedure g such that number-elements from page 23 could be defined ; as ; ; (define number-elements ; (lambda (lst) ; (if (null? lst) '() ; (g (list 0 (car lst)) (number-elements (cdr lst)))))) (define g (lambda (head tail) (cons head (map (lambda (elem) (list (+ 1 (car elem)) (cadr elem))) tail)))) (define number-elements (lambda (lst) (if (null? lst) '() (g (list 0 (car lst)) (number-elements (cdr lst)))))) ================================================ FILE: scheme/eopl/01/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../07.scm") (define eopl-1.07-tests (test-suite "Tests for EOPL exercise 1.07" (check-equal? (nth-element '(a b c) 0) 'a) (check-equal? (nth-element '(a b c) 1) 'b) (check-equal? (nth-element '(a b c) 2) 'c) (check-exn (regexp "\\(a b c\\) does not have 8 elements.") (lambda () (nth-element '(a b c) 8))) )) (exit (run-tests eopl-1.07-tests)) ================================================ FILE: scheme/eopl/01/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../08.scm") (define eopl-1.08-tests (test-suite "Tests for EOPL exercise 1.08" (check-equal? (drop-until 'c '(a b c d e f)) '(d e f)) )) (exit (run-tests eopl-1.08-tests)) ================================================ FILE: scheme/eopl/01/tests/09-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../09.scm") (define eopl-1.09-tests (test-suite "Tests for EOPL exercise 1.09" (check-equal? (remove 'a '(a b a c a d a)) '(b c d)) )) (exit (run-tests eopl-1.09-tests)) ================================================ FILE: scheme/eopl/01/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../12.scm") (define eopl-1.12-tests (test-suite "Tests for EOPL exercise 1.12" (check-equal? (subst 'z 'a '(a b a ((c a) d a (f a)) g a)) '(z b z ((c z) d z (f z)) g z)) )) (exit (run-tests eopl-1.12-tests)) ================================================ FILE: scheme/eopl/01/tests/13-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../13.scm") (define eopl-1.13-tests (test-suite "Tests for EOPL exercise 1.13" (check-equal? (subst 'z 'a '(a b a ((c a) d a (f a)) g a)) '(z b z ((c z) d z (f z)) g z)) )) (exit (run-tests eopl-1.13-tests)) ================================================ FILE: scheme/eopl/01/tests/15-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../15.scm") (define eopl-1.15-tests (test-suite "Tests for EOPL exercise 1.15" (check-equal? (duple 2 3) '(3 3)) (check-equal? (duple 4 '(ha ha)) '((ha ha) (ha ha) (ha ha) (ha ha))) (check-equal? (duple 0 '(blah)) '()) )) (exit (run-tests eopl-1.15-tests)) ================================================ FILE: scheme/eopl/01/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../16.scm") (define eopl-1.16-tests (test-suite "Tests for EOPL exercise 1.16" (check-equal? (invert '((a 1) (a 2) (1 b) (2 b))) '((1 a) (2 a) (b 1) (b 2))) )) (exit (run-tests eopl-1.16-tests)) ================================================ FILE: scheme/eopl/01/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../17.scm") (define eopl-1.17-tests (test-suite "Tests for EOPL exercise 1.17" (check-equal? (down '(1 2 3)) '((1) (2) (3))) (check-equal? (down '((a) (fine) (idea))) '(((a)) ((fine)) ((idea)))) (check-equal? (down '(a (more (complicated)) object)) '((a) ((more (complicated))) (object))) )) (exit (run-tests eopl-1.17-tests)) ================================================ FILE: scheme/eopl/01/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../18.scm") (define eopl-1.18-tests (test-suite "Tests for EOPL exercise 1.18" (check-equal? (swapper 'a 'd '(a b c d)) '(d b c a)) (check-equal? (swapper 'a 'd '(a d () c d)) '(d a () c a)) (check-equal? (swapper 'x 'y '((x) y (z (x)))) '((y) x (z (y)))) )) (exit (run-tests eopl-1.18-tests)) ================================================ FILE: scheme/eopl/01/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../19.scm") (define eopl-1.19-tests (test-suite "Tests for EOPL exercise 1.19" (check-equal? (list-set '(a b c d) 2 '(1 2)) '(a b (1 2) d)) (check-equal? (list-ref (list-set '(a b c d) 3 '(1 5 10)) 3) '(1 5 10)) )) (exit (run-tests eopl-1.19-tests)) ================================================ FILE: scheme/eopl/01/tests/20-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../20.scm") (define eopl-1.20-tests (test-suite "Tests for EOPL exercise 1.20" (check-equal? (count-occurences 'x '((f x) y (((x z) x)))) 3) (check-equal? (count-occurences 'x '((f x) y (((x z) () x)))) 3) (check-equal? (count-occurences 'w '((f x) y (((x z) x)))) 0) )) (exit (run-tests eopl-1.20-tests)) ================================================ FILE: scheme/eopl/01/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../21.scm") (define eopl-1.21-tests (test-suite "Tests for EOPL exercise 1.21" (check-equal? (product '(a b c) '(x y)) '((a x) (a y) (b x) (b y) (c x) (c y))) )) (exit (run-tests eopl-1.21-tests)) ================================================ FILE: scheme/eopl/01/tests/22-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../22.scm") (define eopl-1.22-tests (test-suite "Tests for EOPL exercise 1.22" (check-equal? (filter-in number? '(a 2 (1 3) b 7)) '(2 7)) (check-equal? (filter-in symbol? '(a (b c) 17 foo)) '(a foo)) )) (exit (run-tests eopl-1.22-tests)) ================================================ FILE: scheme/eopl/01/tests/23-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../23.scm") (define eopl-1.23-tests (test-suite "Tests for EOPL exercise 1.23" (check-equal? (list-index number? '(a 2 (1 3) b 7)) 1) (check-equal? (list-index symbol? '(a (b c) 17 foo)) 0) (check-equal? (list-index symbol? '(1 2 (a b) 3)) #f) )) (exit (run-tests eopl-1.23-tests)) ================================================ FILE: scheme/eopl/01/tests/24-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../24.scm") (define eopl-1.24-tests (test-suite "Tests for EOPL exercise 1.24" (check-equal? (every? number? '(a b c 3 e)) #f) (check-equal? (every? number? '(1 2 3 5 4)) #t) (check-equal? (every? number? '()) #t) )) (exit (run-tests eopl-1.24-tests)) ================================================ FILE: scheme/eopl/01/tests/25-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../25.scm") (define eopl-1.25-tests (test-suite "Tests for EOPL exercise 1.25" (check-equal? (exists? number? '(a b c 3 e)) #t) (check-equal? (exists? number? '(a b c d e)) #f) (check-equal? (exists? number? '()) #f) )) (exit (run-tests eopl-1.25-tests)) ================================================ FILE: scheme/eopl/01/tests/26-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../26.scm") (define eopl-1.26-tests (test-suite "Tests for EOPL exercise 1.26" (check-equal? (up '((1 2) (3 4))) '(1 2 3 4)) (check-equal? (up '((x (y)) z)) '(x (y) z)) )) (exit (run-tests eopl-1.26-tests)) ================================================ FILE: scheme/eopl/01/tests/27-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../27.scm") (define eopl-1.27-tests (test-suite "Tests for EOPL exercise 1.27" (check-equal? (flatten '(a b c)) '(a b c)) (check-equal? (flatten '((a) () (b ()) () (c))) '(a b c)) (check-equal? (flatten '((a b) c (((d)) e))) '(a b c d e)) (check-equal? (flatten '(a b (() (c)))) '(a b c)) )) (exit (run-tests eopl-1.27-tests)) ================================================ FILE: scheme/eopl/01/tests/28-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../28.scm") (define eopl-1.28-tests (test-suite "Tests for EOPL exercise 1.28" (check-equal? (merge '(1 4) '(1 2 8)) '(1 1 2 4 8)) (check-equal? (merge '(35 62 81 90 91) '(3 83 85 90)) '(3 35 62 81 83 85 90 90 91)) )) (exit (run-tests eopl-1.28-tests)) ================================================ FILE: scheme/eopl/01/tests/29-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../29.scm") (define eopl-1.29-tests (test-suite "Tests for EOPL exercise 1.29" (check-equal? (sort '(8 2 5 2 3)) '(2 2 3 5 8)) )) (exit (run-tests eopl-1.29-tests)) ================================================ FILE: scheme/eopl/01/tests/30-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../30.scm") (define eopl-1.30-tests (test-suite "Tests for EOPL exercise 1.30" (check-equal? (sort/predicate < '(8 2 5 2 3)) '(2 2 3 5 8)) (check-equal? (sort/predicate > '(8 2 5 2 3)) '(8 5 3 2 2)) )) (exit (run-tests eopl-1.30-tests)) ================================================ FILE: scheme/eopl/01/tests/31-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../31.scm") (define eopl-1.31-tests (test-suite "Tests for EOPL exercise 1.31" (check-equal? (leaf 10) 10) (check-exn exn? (lambda () (leaf 'symbol))) (check-true (leaf? 10)) (check-false (leaf? '(a 1 2))) (check-equal? (interior-node 'a (leaf 1) (leaf 2)) '(a 1 2)) (check-exn exn? (lambda () (interior-node 1 (leaf 1) (leaf 2)))) (check-equal? (lson (interior-node 'node (leaf 1) (leaf 2))) (leaf 1)) (check-equal? (rson (interior-node 'node (leaf 1) (leaf 2))) (leaf 2)) (check-equal? (contents-of (interior-node 'node (leaf 1) (leaf 2))) 'node) (check-equal? (contents-of (leaf 1)) 1) )) (exit (run-tests eopl-1.31-tests)) ================================================ FILE: scheme/eopl/01/tests/32-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../32.scm") (define eopl-1.32-tests (test-suite "Tests for EOPL exercise 1.32" (check-equal? (double-tree (interior-node 'root (interior-node 'left (leaf 1) (leaf 2)) (interior-node 'right (leaf 3) (interior-node 'right2 (leaf 4) (leaf 5))))) (interior-node 'root (interior-node 'left (leaf 2) (leaf 4)) (interior-node 'right (leaf 6) (interior-node 'right2 (leaf 8) (leaf 10))))) )) (exit (run-tests eopl-1.32-tests)) ================================================ FILE: scheme/eopl/01/tests/33-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../33.scm") (define eopl-1.33-tests (test-suite "Tests for EOPL exercise 1.33" (check-equal? (mark-leaves-with-red-depth (interior-node 'red (interior-node 'bar (leaf 26) (leaf 12)) (interior-node 'red (leaf 11) (interior-node 'quux (leaf 117) (leaf 14))))) '(red (bar 1 1) (red 2 (quux 2 2)))) )) (exit (run-tests eopl-1.33-tests)) ================================================ FILE: scheme/eopl/01/tests/34-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../34.scm") (define eopl-1.34-tests (test-suite "Tests for EOPL exercise 1.34" (check-equal? (path 17 '(14 (7 () (12 () ())) (26 (20 (17 () ()) ()) (31 () ())))) '(right left left)) )) (exit (run-tests eopl-1.34-tests)) ================================================ FILE: scheme/eopl/01/tests/35-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../35.scm") (define eopl-1.35-tests (test-suite "Tests for EOPL exercise 1.35" (check-equal? (number-leaves (interior-node 'foo (interior-node 'bar (leaf 26) (leaf 12)) (interior-node 'baz (leaf 11) (interior-node 'quux (leaf 117) (leaf 14))))) '(foo (bar 0 1) (baz 2 (quux 3 4)))) )) (exit (run-tests eopl-1.35-tests)) ================================================ FILE: scheme/eopl/01/tests/36-tests.scm ================================================ (require rackunit rackunit/text-ui) (require eopl) (load-relative "../36.scm") (define eopl-1.36-tests (test-suite "Tests for EOPL exercise 1.36" (check-equal? (number-elements '(a b c d)) '((0 a) (1 b) (2 c) (3 d))) )) (exit (run-tests eopl-1.36-tests)) ================================================ FILE: scheme/eopl/02/01.scm ================================================ ; EOPL exercise 2.01 ; ; Implement the four required operations for bigits. Then use your ; implementation to calculate the factorial of 10. How does the execution time ; vary as this argument changes? How does the execution time vary as the base ; changes? Explain why. ; And this has only one star? Anyway. The results of execution time is in the ; end of the file. ; Let's use Racket parameters to simplify testing and benchmarking: (define base (make-parameter 10)) ; Some observers that will be used: (define (first-bigit bignum) (car bignum)) (define (rest-bigits bignum) (cdr bignum)) ; The four required operations: (define (zero) '()) (define (is-zero? bignum) (null? bignum)) (define (successor bignum) (cond ((null? bignum) '(1)) ((eqv? (first-bigit bignum) (- (base) 1)) (cons 0 (successor (rest-bigits bignum)))) (else (cons (+ (first-bigit bignum) 1) (rest-bigits bignum))))) (define (predecessor bignum) (cond ((null? bignum) (eopl:error 'predecessor "We don't support negative numbers")) ((equal? bignum '(1)) '()) ((zero? (first-bigit bignum)) (cons (- (base) 1) (predecessor (rest-bigits bignum)))) (else (cons (- (first-bigit bignum) 1) (rest-bigits bignum))))) ; Converting a bignum to int: (define (bignum->int bignum) (if (is-zero? bignum) 0 (+ (first-bigit bignum) (* (base) (bignum->int (rest-bigits bignum)))))) (define (int->bignum n) (define (iter n result) (if (zero? n) result (iter (- n 1) (successor result)))) (iter n (zero))) ; Some additional operations in order to have a nicer factorial: (define (add bignum1 bignum2) (if (is-zero? bignum1) bignum2 (add (predecessor bignum1) (successor bignum2)))) (define (multiply bignum1 bignum2) (define (iter n result) (if (is-zero? n) result (iter (predecessor n) (add bignum1 result)))) (iter bignum2 (zero))) ; Factorial with bignums (define (factorial bignum) (if (is-zero? bignum) (successor (zero)) (multiply bignum (factorial (predecessor bignum))))) ; Benchmarking (define (benchmark-in-base base-to-use) (parameterize ((base base-to-use)) (printf "Running factorial in base ~s:\n" (base)) (for ([n (in-range 6 11)]) (benchmark-factorial n)))) (define (benchmark-factorial n) (printf " ~s! (base ~s): " n (base)) (time (factorial (int->bignum n)))) (define (run-benchmarks) (benchmark-in-base 2) (benchmark-in-base 4) (benchmark-in-base 10) (benchmark-in-base 1000) (benchmark-in-base 100000)) ; Finally, the results: ; ; Running factorial in base 2: ; 6! (base 2): cpu time: 0 real time: 1 gc time: 0 ; 7! (base 2): cpu time: 4 real time: 3 gc time: 0 ; 8! (base 2): cpu time: 30 real time: 30 gc time: 0 ; 9! (base 2): cpu time: 267 real time: 268 gc time: 11 ; 10! (base 2): cpu time: 2530 real time: 2532 gc time: 24 ; Running factorial in base 4: ; 6! (base 4): cpu time: 0 real time: 0 gc time: 0 ; 7! (base 4): cpu time: 3 real time: 3 gc time: 0 ; 8! (base 4): cpu time: 19 real time: 18 gc time: 0 ; 9! (base 4): cpu time: 161 real time: 161 gc time: 3 ; 10! (base 4): cpu time: 1561 real time: 1563 gc time: 14 ; Running factorial in base 10: ; 6! (base 10): cpu time: 0 real time: 1 gc time: 0 ; 7! (base 10): cpu time: 2 real time: 1 gc time: 0 ; 8! (base 10): cpu time: 14 real time: 15 gc time: 1 ; 9! (base 10): cpu time: 133 real time: 133 gc time: 0 ; 10! (base 10): cpu time: 1268 real time: 1269 gc time: 13 ; Running factorial in base 1000: ; 6! (base 1000): cpu time: 0 real time: 1 gc time: 0 ; 7! (base 1000): cpu time: 2 real time: 1 gc time: 0 ; 8! (base 1000): cpu time: 12 real time: 13 gc time: 0 ; 9! (base 1000): cpu time: 114 real time: 113 gc time: 2 ; 10! (base 1000): cpu time: 1114 real time: 1115 gc time: 15 ; Running factorial in base 100000: ; 6! (base 100000): cpu time: 0 real time: 0 gc time: 0 ; 7! (base 100000): cpu time: 3 real time: 2 gc time: 0 ; 8! (base 100000): cpu time: 13 real time: 14 gc time: 0 ; 9! (base 100000): cpu time: 113 real time: 113 gc time: 2 ; 10! (base 100000): cpu time: 1116 real time: 1119 gc time: 14 ; ; There is just too much recursion happening in order for me to be willing to ; analyze why those are the results. successor and predecessor don't work in ; constant time, which makes me unwilling to analyze how multiple and add ; interact with them. ; ; If you want to reproduce the results, just uncomment the following line: ; ; (run-benchmarks) ================================================ FILE: scheme/eopl/02/02.scm ================================================ ; EOPL exercise 2.02 ; ; Analyze each of these proposed representations critically. To what extent do ; they succeed or fail in satisfying the specification of the datatype? ; All of the representations satisfy the specification fully. ; ; 1. Unary representation ; ; This is extremely memory hungry. It is also equivalent to using bignums with ; base 1. It does not allow us to create very large numbers, but all the ; operations are performed in constant time. If the memory is limitless, this ; representation will allow us to create arbitrary large numbers. ; ; 2. Scheme number representation: ; ; Depending on whether the Scheme numbers are seamlessly converted to bignums ; (which they usually are), this representation might not allow us to ; ; 3. Bignum representation: ; ; This representation is more memory-efficient than the first, but operations ; are not in constant time. That is, calling successor on a n-sized list of ; base - 1 will take O(n) time. It is, of course, the most sensible way to ; implement numbers, provided that we implement the arithmetic operations by ; depending on the representation, instead of the four observers. ================================================ FILE: scheme/eopl/02/03.scm ================================================ ; EOPL exercise 2.03 ; ; Define a representation of all the integers (negative and nonnegative) as ; diff-trees, where a diff-tree is a list defined by the grammar ; ; Diff-tree ::= (one) | (diff Diff-tree Diff-tree) ; ; The list (one) represents 1. If t₁ represents n₁ and t₂ represents n₂, then ; (diff t₁ t₂) is a representation of n₁ - n₂. ; ; So both (one) and (diff (one) (diff (one) (one))) are representations of 1; ; (diff (diff (one) (one)) (one)) is a representation of -1. ; ; 1. Show that every number has infinitely many representations in this ; system. ; 2. Turn this representation of the integers into an implementation by ; writing zero, is-zero?, successor and predecessor, as specified on ; page 32, except that now the negative integers are also represented. Your ; procedures should take as input any of the multiple legal representations ; of an integer in this scheme. For example, if your successor procedure is ; given any of the infinitely many legal representations of 1, it should ; produce one of the legal representations of 2. It is permissible for ; different legal representations of 1 to yield different representations ; of 2. ; 3. Write a proedure diff-tree-plus that does addition in this ; representation. Your procedure should be optimized for the diff-tree ; representation, and should do its work in a constant amount of time ; (independent of the size of its inputs). In particular, it should not be ; recursive. ; 1. It's rather obvious that a number has infinitelly many representations. ; ; Anyway, if n is represented as (diff M S), then we can also represent it as ; (diff (diff M (one)) (diff S (one))). It will be the same number. We can ; apply this infinitely many times. This is not the only way to modify the ; representation of the number, but it is the simplest. ; ; 2. Let's take a nice layered approach. ; ; First, here are constructors for the representation: (define (one) '(one)) (define (diff left right) `(diff ,left ,right)) ; Here are some observers: (define (one? diff-tree) (eqv? (car diff-tree) 'one)) (define (diff? diff-tree) (eqv? (car diff-tree) 'diff)) (define (diff-first diff-tree) (cadr diff-tree)) (define (diff-second diff-tree) (caddr diff-tree)) ; Here are a few higher-level observers minuend and subtrahend tread (one) ; as (diff (one) (diff (one) (one))). (define (minuend diff-tree) (if (one? diff-tree) (one) (diff-first diff-tree))) (define (subtrahend diff-tree) (if (one? diff-tree) (diff (one) (one)) (diff-second diff-tree))) ; Here are the four operations we have to implement. Note that is-zero? ; explicitly converts the diff-tree to an integer and compares it with 0. ; Since we know how successor and predecessor work, there is probably a more ; interesting way to check (without conversion), but I don't care enough to ; figure it out. (define (zero) (diff (one) (one))) (define (is-zero? n) (define (to-int n) (if (one? n) 1 (- (to-int (minuend n)) (to-int (subtrahend n))))) (zero? (to-int n))) (define (successor n) (diff (minuend n) (diff (subtrahend n) (one)))) (define (predecessor n) (diff n (one))) ; 3. diff-tree-plus (define (diff-tree-plus diff-tree-1 diff-tree-2) (diff diff-tree-1 (diff (subtrahend diff-tree-2) (minuend diff-tree-2)))) ================================================ FILE: scheme/eopl/02/04.scm ================================================ ; EOPL exercise 2.04 ; ; Consider the data type of stacks of values, with an interface consisting of ; the procedures empty-stack, push, pop, and empty-stack?. Write a ; specification for these operations in the style of the example above. Which ; operations are constructors and which are observers? ; (empty-stack) = [∅] ; (push [stack] val) = [val|stack] ; (pop [stack]) = { error if stack is ∅ ; { [tail], if stack is [head|tail] ; (empty-stack? [stack]) = { #t if stack is ∅ ; { #f otherwise ; ; empty-stack? is a obsever, all others are constructors. ; ; Note that this is really missing an observer top in order to be useful. ================================================ FILE: scheme/eopl/02/05.scm ================================================ ; EOPL exercise 2.05 ; ; We can use any data structure for representing environments, if we can ; distinguish empty environments from non-empty ones, and in which one can ; extract the pieces of a non-empty environment. Implement environments using ; a representation in which the empty environment is represented as the empty ; list, and in which extend-env builds an environment that looks like ; ; +---+---+ ; | o | o ---> saved-env ; +-|-+---+ ; | ; V ; +---+---+ ; | o | o ---> saved-val ; +-|-+---+ ; | ; V ; saved-var ; ; This is called an a-list or association-list representation. (define (empty-env) '()) (define (extend-env var val env) (cons (cons var val) env)) (define (apply-env env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (cdar env)) (else (apply-env (cdr env) var)))) ================================================ FILE: scheme/eopl/02/06.scm ================================================ ; EOPL exercise 2.06 ; ; Invent at least three different representations of the environment interface ; and implement them. ; 1. 2-list representation ; ((a 1) (b 2) (c 3) ...) (define empty-env '()) (define extend-env '()) (define apply-env '()) (define (use-2-list) (set! empty-env (lambda () '())) (set! extend-env (lambda (var val env) (cons (list var val) env))) (set! apply-env (lambda (env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (cadar env)) (else (apply-env (cdr env) var)))))) ; 2. two lists representation ; ((a b c ...) (1 2 3 ...)) (define (use-two-lists) (set! empty-env (lambda () '(() ()))) (set! extend-env (lambda (var val env) (list (cons var (car env)) (cons val (cadr env))))) (set! apply-env (lambda (env var) (cond ((null? (car env)) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (caadr env)) (else (apply-env (list (cdar env) (cdadr env)) var)))))) ; 2. var-val list ; (a 1 b 2 c 3 ...) (define (use-var-val-list) (set! empty-env (lambda () '())) (set! extend-env (lambda (var val env) (cons var (cons val env)))) (set! apply-env (lambda (env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (car env) var) (cadr env)) (else (apply-env (cddr env) var)))))) ================================================ FILE: scheme/eopl/02/07.scm ================================================ ; EOPL exercise 2.07 ; ; Rewrite apply-env in figure 2.1 to give a more informative error message. ; This is the original code: (define empty-env (lambda () (list 'empty-env))) (define extend-env (lambda (var val env) (list 'extend-env var val env))) (define apply-env (lambda (env search-var) (cond ((eqv? (car env) 'empty-env) (report-no-binding-found search-var)) ((eqv? (car env) 'extend-env) (let ((saved-var (cadr env)) (saved-val (caddr env)) (saved-env (cadddr env))) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var)))) (else (report-invalid-env env))))) (define report-no-binding-found (lambda (search-var) (eopl:error 'apply-env "No binding for ~s" search-var))) (define report-invalid-env (lambda (env) (eopl:error 'apply-env "Bad environment: ~s" env))) ; Here's the rewritten apply-env (define (apply-env search-env search-var) (define (search env) (cond ((eqv? (car env) 'empty-env) (eopl:error 'apply-env "Variable ~s not found in environment: ~s" search-var search-env)) ((eqv? (car env) 'extend-env) (let ((saved-var (cadr env)) (saved-val (caddr env)) (saved-env (cadddr env))) (if (eqv? search-var saved-var) saved-val (search saved-env)))) (else (report-invalid-env env)))) (search search-env)) ================================================ FILE: scheme/eopl/02/08.scm ================================================ ; EOPL exercise 2.08 ; ; Add to the environment interface an observer called empty-env? and implement ; it using the a-list representation. (load-relative "05.scm") (define (empty-env? env) (null? env)) ================================================ FILE: scheme/eopl/02/09.scm ================================================ ; EOPL exercise 2.09 ; ; Add to the environment interface an observer called has-binding? that takes ; an environment env and a variable s and tests to see if s has an associated ; value in env. Implement using the a-list representation. (load-relative "05.scm") (define (has-binding? env var) (cond ((null? env) #f) ((eqv? (caar env) var) #t) (else (has-binding? (cdr env) var)))) ================================================ FILE: scheme/eopl/02/10.scm ================================================ ; EOPL exercise 2.10 ; ; Add to the environment interface a constructor extend-env*, and implement it ; using the a-list representation. This constructor takes a list of variables, ; a list of values of the same length, and an environment, and is specified by ; ; (extend-env* (varᵤ ... varᵤ) (valᵤ ... valᵤ) [f]) = [g], ; where g(var) = { valᵢ if var = varᵢ for some i such that 1 ≤ i ≤ u ; { f(val) otherwise (load-relative "05.scm") (define (extend-env* vars vals env) (if (null? vars) env (extend-env (car vars) (car vals) (extend-env* (cdr vars) (cdr vals) env)))) ================================================ FILE: scheme/eopl/02/11.scm ================================================ ; EOPL exercise 2.11 ; ; A naive implementation of extend-env* from the preceding exercise requires ; time proportional to k to run. It is possible to represent environments so ; that extend-env* requires only constant time: represent the empty ; environment by the empty list, and represent a non-empty environment by the ; data structure ; ; +---+---+ ; | o | o ---> saved-env ; +-|-+---+ ; | ; V ; +---+---+ ; | o | o ---> saved-vals ; +-|-+---+ ; | ; V ; saved-vars ; ; Such an environment might look like ; ; backbone ; +---+---+ V +---+---+ +---+---+ ; | o | o ---------------->| o | o ------------->| o | o ------> rest of environment ; +-|-+---+ +-|-+---+ +-|-+---+ ; | | | ; V V V ; +---+---+ +---+---+ +---+---+ ; | o | o ---> (11 12 13) | o | o ---> (66 77) | o | o ---> (88 99) ; +-|-+---+ +-|-+---+ +-|-+---+ ; | | | ; V V V ; (a b c) (x z) (x y) ; ; This is called the ribcage representation. The environment is represented as ; a list of pairs called ribs; each left rib is a list of variables and each ; right rib is the corresponding list of values. ; ; Implement the environment interface, including extend-env*, in this ; representation. (define (empty-env) '()) (define (extend-env var val env) (extend-env* (list var) (list val) env)) (define (extend-env* vars vals env) (cons (cons vars vals) env)) (define (apply-env env var) (define (scan vars vals) (cond ((null? vars) (apply-env (cdr env) var)) ((eq? (car vars) var) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (null? env) (eopl:error 'apply-env "Variable not found: ~s" var) (scan (caar env) (cdar env)))) ================================================ FILE: scheme/eopl/02/12.scm ================================================ ; EOPL exercise 2.12 ; ; Implement the stack data type of exercise 2.4 using a procedural ; representation. ; I just don't get this. Anyway. (define (empty-stack? stack) (stack (lambda (top rest) (null? rest)))) (define (empty-stack) (lambda (proc) (proc #f '()))) (define (push val stack) (lambda (proc) (proc val stack))) (define (pop stack) (stack (lambda (top rest) rest))) ================================================ FILE: scheme/eopl/02/13.scm ================================================ ; EOPL exercise 2.13 ; ; Extend the procedural representation to implement empty-env? by representing ; the environment by a list of two procedures: one that returns the value ; associated with a variable, as before, and one that returns whether or not ; the environment is empty. (define empty-env (lambda () (list (lambda (search-var) (report-no-binding-found search-var)) (lambda () #t)))) (define extend-env (lambda (saved-var saved-val saved-env) (list (lambda (search-var) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var))) (lambda () #f)))) (define apply-env (lambda (env search-var) ((car env) search-var))) (define empty-env? (lambda (env) ((cadr env)))) ================================================ FILE: scheme/eopl/02/14.scm ================================================ ; EOPL exercise 2.14 ; ; Extend the representation of the preceding exercise to include a third ; procedure that implements has-binding? (see exercise 2.9). (define empty-env (lambda () (list (lambda (search-var) (report-no-binding-found search-var)) (lambda () #t) (lambda (search-var) #f)))) (define extend-env (lambda (saved-var saved-val saved-env) (list (lambda (search-var) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var))) (lambda () #f) (lambda (search-var) (if (eqv? search-var saved-var) #t (has-binding? saved-env search-var)))))) (define apply-env (lambda (env search-var) ((car env) search-var))) (define empty-env? (lambda (env) ((cadr env)))) (define has-binding? (lambda (env search-var) ((caddr env) search-var))) ================================================ FILE: scheme/eopl/02/15.scm ================================================ ; EOPL exercise 2.15 ; ; Implement the lambda-calculus interface for the representations specified by ; the grammar above. (define (var-exp var) var) (define (var-exp? exp) (symbol? exp)) (define (var-exp->var exp) exp) (define (lambda-exp var body) `(lambda (,var) ,body)) (define (lambda-exp? exp) (and (pair? exp) (eqv? (car exp) 'lambda))) (define (lambda-exp->bound-var exp) (caadr exp)) (define (lambda-exp->body exp) (caddr exp)) (define (app-exp rator rand) (list rator rand)) (define (app-exp? exp) (and (pair? exp) (not (eqv? (car exp) 'lambda)))) (define (app-exp->rator exp) (car exp)) (define (app-exp->rand exp) (cadr exp)) ================================================ FILE: scheme/eopl/02/16.scm ================================================ ; EOPL exercise 2.16 ; ; Modify the implementation to use a representation in which there are no ; parentheses around the bound variable in a lambda expression. (define (var-exp var) var) (define (var-exp? exp) (symbol? exp)) (define (var-exp->var exp) exp) (define (lambda-exp var body) (list 'lambda var body)) (define (lambda-exp? exp) (and (pair? exp) (eqv? (car exp) 'lambda))) (define (lambda-exp->bound-var exp) (cadr exp)) (define (lambda-exp->body exp) (caddr exp)) (define (app-exp rator rand) (list rator rand)) (define (app-exp? exp) (and (pair? exp) (not (eqv? (car exp) 'lambda)))) (define (app-exp->rator exp) (car exp)) (define (app-exp->rand exp) (cadr exp)) ================================================ FILE: scheme/eopl/02/17.scm ================================================ ; EOPL exercise 2.17 ; ; Invent at least two other representations of the data type of ; lambda-calculus expressions and implement them. (define var-exp (void)) (define var-exp? (void)) (define var-exp->var (void)) (define lambda-exp (void)) (define lambda-exp? (void)) (define lambda-exp->bound-var (void)) (define lambda-exp->body (void)) (define app-exp (void)) (define app-exp? (void)) (define app-exp->rator (void)) (define app-exp->rand (void)) ; 1. Lc-exp ::= Identifier ; ::= (Identifier -> Lc-exp) ; ::= (Lc-exp (Lc-exp)) (define (use-representation-1) (set! var-exp (lambda (var) var)) (set! var-exp? symbol?) (set! var-exp->var (lambda (var-exp) var-exp)) (set! lambda-exp (lambda (var body) (list var '-> body))) (set! lambda-exp? (lambda (exp) (and (pair? exp) (pair? (cdr exp)) (eqv? (cadr exp) '->)))) (set! lambda-exp->bound-var car) (set! lambda-exp->body caddr) (set! app-exp (lambda (rator rand) `(,rator (,rand)))) (set! app-exp? (lambda (exp) (and (pair? exp) (pair? (cdr exp)) (pair? (cadr exp))))) (set! app-exp->rator car) (set! app-exp->rand caadr)) ; 2. Lc-exp ::= (var-exp Identifier) ; ::= (lambda-exp Identifier Lc-exp) ; ::= (app-exp Lc-exp Lc-exp) (define (use-representation-2) (define (tagged-list? exp tag) (and (pair? exp) (eqv? (car exp) tag))) (set! var-exp (curry list 'var-exp)) (set! var-exp? (curryr tagged-list? 'var-exp)) (set! var-exp->var cadr) (set! lambda-exp (curry list 'lambda-exp)) (set! lambda-exp? (curryr tagged-list? 'lambda-exp)) (set! lambda-exp->bound-var cadr) (set! lambda-exp->body caddr) (set! app-exp (curry list 'app-exp)) (set! app-exp? (curryr tagged-list? 'app-exp)) (set! app-exp->rator cadr) (set! app-exp->rand caddr)) ================================================ FILE: scheme/eopl/02/18.scm ================================================ ; EOPL exercise 2.18 ; ; We usually represent a sequence of values as a list. In this representation, ; it is easy to move from one element in a sequence to the next, but it is ; hard to move form one element to the preceding one without the help of ; context arguments. Implement non-empty bidirectional sequences of integers, ; as suggested by the grammar ; ; NodeInSequence ::= (Int Listof(Int) Listof(Int)) ; ; The first list of numbers is the elements of the sequence preceding the ; current one, in reverse order, and the second list is the elements of the ; sequence after the current one. For example, (6 (5 4 3 2 1) (7 8 9)) ; represents the list (1 2 3 4 5 6 7 8 9), with the focus on the element 6. ; ; In this representation, implement the procedure number->sequence, which ; takes a number and produces a sequence consisting of exactly that number. ; Also implement current-element, move-to-left, move-to-right, insert-to-left, ; insert-to-right, at-left-end?, and at-right-end? ; ; For example: ; ; > (number->sequence 7) ; (7 () ()) ; > (current-element '(6 (5 4 3 2 1) (7 8 9))) ; 6 ; > (move-to-left '(6 (5 4 3 2 1) (7 8 9))) ; (5 (4 3 2 1) (6 7 8 9)) ; > (move-to-right '(6 (5 4 3 2 1) (7 8 9))) ; (7 (6 5 4 3 2 1) (8 9)) ; > (insert-to-left 13 '(6 (5 4 3 2 1) (7 8 9))) ; (6 (13 5 4 3 2 1) (7 8 9)) ; > (insert-to-right 13 '(6 (5 4 3 2 1) (7 8 9))) ; (6 (5 4 3 2 1) (13 7 8 9)) ; ; The procedure move-to-right should fail if its arguments is at the right end ; of the sequence, and the procedure move-to-left should fail if its argument ; is at the left end of the sequence. (define (number->sequence num) `(,num () ())) (define (current-element seq) (car seq)) (define (move-to-left seq) (if (null? (cadr seq)) (eopl:error 'move-to-left "Left sequence is empty: ~s" seq) (list (caadr seq) (cdadr seq) (cons (car seq) (caddr seq))))) (define (move-to-right seq) (if (null? (caddr seq)) (eopl:error 'move-to-left "Right sequence is empty: ~s" seq) (list (caaddr seq) (cons (car seq) (cadr seq)) (cdaddr seq)))) (define (insert-to-left num seq) (list (car seq) (cons num (cadr seq)) (caddr seq))) (define (insert-to-right num seq) (list (car seq) (cadr seq) (cons num (caddr seq)))) (define (at-left-end? seq) (null? (cadr seq))) (define (at-right-end? seq) (null? (caddr seq))) ================================================ FILE: scheme/eopl/02/19.scm ================================================ ; EOPL exercise 2.19 ; ; A binary tree with empty leaves and with interior nodes labeled with ; integers could be represented using the grammar ; ; Bintree ::= () | (Int Bintree Bintree) ; ; In this representation, implement the procedure number->bintree, which takes ; a number and produces a binary tree consisting of a single node, containing ; that number. Also implement current-element, move-to-left-son, ; move-to-right-son, at-leaf?, insert-to-left, and insert-to-right. For ; example, ; ; > (number->bintree 13) ; (13 () ()) ; > (define t1 (insert-to-right 14 ; (insert-to-left 12) ; (number->bintree 13))) ; > t1 ; (13 ; (12 () ()) ; (14 () ())) ; > (move-to-left t1) ; (12 () ()) ; > (current-element (move-to-left-son t1)) ; 12 ; > (at-leaf? (move-to-right-son (move-to-left-son t1))) ; #t ; > (insert-to-left 15 t1) ; (13 ; (15 ; (12 () ()) ; ()) ; (14 () ())) (define (number->bintree n) `(,n () ())) (define (current-element tree) (car tree)) (define (move-to-left-son tree) (cadr tree)) (define (move-to-right-son tree) (caddr tree)) (define (at-leaf? tree) (null? tree)) (define (insert-to-left n tree) (list (car tree) (list n (cadr tree) '()) (caddr tree))) (define (insert-to-right n tree) (list (car tree) (cadr tree) (list n '() (caddr tree)))) ================================================ FILE: scheme/eopl/02/20.scm ================================================ ; EOPL exercise 2.20 ; ; In the representation of binary trees in exercise 2.19 it is easy to move ; from a parent node to one of its sons, but it is impossible to move form a ; son to its parent without the help of context arguments. Extend the ; representation of lists in exercise 2.18 to represent nodes in a binary ; tree. As a hint, consider representing the portion of the tree above the ; current node by a reversed list, as in exercise 2.18. ; ; In this representation, implement the procedures from exercise 2.19. Also ; implement move-up, at-root? and at-leaf?. ; (define (number->bintree n) `(,n () () ())) (define (current-element tree) (car tree)) (define (move-to-left-son tree) (let ((son (cadr tree))) (if (null? son) (list '() '() '() tree) (list (car son) (cadr son) (caddr son) tree)))) (define (move-to-right-son tree) (let ((son (caddr tree))) (if (null? son) (list '() '() '() tree) (list (car son) (cadr son) (caddr son) tree)))) (define (move-up tree) (cadddr tree)) (define (at-leaf? tree) (null? (car tree))) (define (at-root? tree) (null? (cadddr tree))) (define (insert-to-left n tree) (list (car tree) (list n (cadr tree) '() '()) (caddr tree) (cadddr tree))) (define (insert-to-right n tree) (list (car tree) (cadr tree) (list n '() (caddr tree) '()) (cadddr tree))) ================================================ FILE: scheme/eopl/02/21.scm ================================================ ; EOPL exercise 2.21 ; ; Implement the data type of environments, as in section 2.2.2, using ; define-datatype. Then include has-binding? of exercise 2.9. (define (any? obj) #t) (define-datatype env env? (empty-env) (extend-env (var symbol?) (val any?) (enclosing env?))) (define (has-binding? search-env search-var) (cases env search-env (empty-env () #f) (extend-env (var val enclosing) (or (eqv? var search-var) (has-binding? enclosing search-var))))) ================================================ FILE: scheme/eopl/02/22.scm ================================================ ; EOPL exercise 2.22 ; ; Using define-datatype, implement the stack data type of exercise 2.4. (define-datatype stack stack? (empty-stack) (push (var (lambda (x) #t)) (frame stack?))) (define (empty-stack? st) (cases stack st (empty-stack () #t) (push (var frame) #f))) (define (pop st) (cases stack st (empty-stack () (eopl:error 'pop "Empty stack.")) (push (var frame) frame))) ================================================ FILE: scheme/eopl/02/23.scm ================================================ ; EOPL exercise 2.23 ; ; The define of lc-exp ignores the condition in definition 1.1.8 that says ; "Identifier is any symbol other than lambda." Modify the definition of ; identifier? to capture this condition. As a hint, remember that any ; predicate can be used in define datatype, even ones you define. (define (id? sym) (and (symbol? sym) (not (eqv? sym 'lambda)))) (define-datatype lc-exp lc-exp? (var-exp (var id?)) (lambda-exp (bound-var id?) (body lc-exp?)) (app-exp (rator lc-exp?) (rand lc-exp?))) ================================================ FILE: scheme/eopl/02/24.scm ================================================ ; EOPL exercise 2.24 ; ; Here is a definition of binary trees using define-datatype. ; ; (define-datatype bintree bintree? ; (leaf-node ; (num integer?)) ; (interior-node ; (key symbol?) ; (left bintree?) ; (right bintree?))) ; ; Implement a bintree-to-list procedure for binary trees, so that ; (bintree-to-list (interior-node 'a (leaf-node 3) (leaf-node 4))) returns the ; list ; ; (interior-node ; a ; (leaf-node 3) ; (leaf-node 4)) (define-datatype bintree bintree? (leaf-node (num integer?)) (interior-node (key symbol?) (left bintree?) (right bintree?))) (define (bintree-to-list tree) (cases bintree tree (leaf-node (n) (list 'leaf-node n)) (interior-node (key left right) (list 'interior-node key (bintree-to-list left) (bintree-to-list right))))) ================================================ FILE: scheme/eopl/02/25.scm ================================================ ; EOPL exercise 2.25 ; ; Use cases to write max-interior, which takes a binary tree of integers (as ; in the preceding exercise) with at least one interior node and returns the ; symbol associated with an interior node with a maximal leaf sum. ; ; > (define tree-1 ; (interior-node 'foo (leaf-node 2) (leaf-node 3))) ; > (define tree-2 ; (interior-node 'bar (leaf-node -1) tree-1)) ; > (define tree-3 ; (interior-node 'baz tree-2 (leaf-node 1))) ; > (max-interior tree-2) ; foo ; > (max-interior tree-3) ; baz ; ; The last invocation of max-interior might also have returned foo, since both ; the foo and baz nodes have a leaf sum of 5. (define-datatype bintree bintree? (leaf-node (num integer?)) (interior-node (key symbol?) (left bintree?) (right bintree?))) (define (key-of tree) (cases bintree tree (leaf-node (num) (eopl:error 'key-of "Leaf node ~s" num)) (interior-node (key left right) key))) (define (tree-sum tree) (cases bintree tree (leaf-node (num) num) (interior-node (key left right) (+ (tree-sum left) (tree-sum right))))) (define (interior? tree) (cases bintree tree (leaf-node (num) #f) (interior-node (key left right) #t))) (define (max-node tree) (cases bintree tree (leaf-node (num) #f) (interior-node (key left right) (let ((max-child (cond ((and (interior? left) (interior? right)) (if (< (tree-sum left) (tree-sum right)) right left)) ((and (interior? left)) left) ((and (interior? right)) right) (else #f)))) (cond ((not max-child) tree) ((< (tree-sum max-child) (tree-sum tree)) tree) (else max-child)))))) (define (max-interior tree) (key-of (max-node tree))) ================================================ FILE: scheme/eopl/02/26.scm ================================================ ; EOPL exercise 2.26 ; ; Here is another version of exercise 1.33. Consider a set of trees given by ; the following grammar: ; ; Red-blue-tree ::= Red-blue-subtree ; Red-blue-subtree ::= (red-node Red-blue-subtree Red-blue-subtree) ; (blue-node {Red-blue-subtree}*) ; (leaf-node Int) ; ; Write an equivalent definition using define-datatype, and use the resulting ; interface to write a procedure that takes a tree and builds a tree of the ; same shape, except that each leaf node is replaced by a leaf node that ; contains the number of red nodes on the path between it and the root. (define-datatype red-blue-tree red-blue-tree? (red-node (left red-blue-tree?) (right red-blue-tree?)) (blue-node (trees (list-of red-blue-tree?))) (leaf-node (num integer?))) (define (list-of predicate) (lambda (object) (or (null? object) (and (pair? object) (predicate (car object)) ((list-of predicate) (cdr object)))))) (define (mark-with-red-depth tree) (define (iter tree counter) (cases red-blue-tree tree (red-node (left right) (red-node (iter left (+ counter 1)) (iter right (+ counter 1)))) (blue-node (nodes) (blue-node (map (curryr iter counter) nodes))) (leaf-node (num) (leaf-node counter)))) (iter tree 0)) ================================================ FILE: scheme/eopl/02/27.scm ================================================ ; EOPL exercise 2.27 ; ; Draw the abstract syntax tree for the lambda calculus expressions ; ; ((lambda (a) (a b)) c) ; ; (lambda (x) ; (lambda (y) ; ((lambda (x) ; (x y)) ; x))) ; Expression: ((lambda (a) (a b)) c) ; ; +---------+ ; | app-exp | ; +---------+ ; / \ ; rator rand ; / \ ; +------------+ +---------+ ; | lambda-exp | | var-exp | ; +------------+ +---------+ ; / \ | ; bound-var body var ; / \ | ; +---+ +---------+ +---+ ; | a | | app-exp | | c | ; +---+ +---------+ +---+ ; / \ ; rator rand ; / \ ; +---------+ +---------+ ; | var-exp | | var-exp | ; +---------+ +---------+ ; | | ; var var ; | | ; +---+ +---+ ; | a | | b | ; +---+ +---+ ; ; ; ; Expression: (lambda (x) ; (lambda (y) ; ((lambda (x) ; (x y)) ; x))) ; ; +------------+ ; | lambda-exp | ; +------------+ ; / \ ; bound-var body ; / \ ; +---+ +------------+ ; | x | | lambda-exp | ; +---+ +------------+ ; / \ ; bound-var body ; / \ ; +---+ +---------+ ; | y | | app-exp | ; +---+ +---------+ ; / \ ; rator rand ; / \ ; +------------+ +---------+ ; | lambda-exp | | var-exp | ; +------------+ +---------+ ; / \ | ; bound-var body var ; / \ | ; +---+ +---------+ +---+ ; | x | | app-exp | | x | ; +---+ +---------+ +---+ ; / \ ; rator rand ; / \ ; +---------+ +---------+ ; | var-exp | | var-exp | ; +---------+ +---------+ ; | | ; var var ; | | ; +---+ +---+ ; | x | | y | ; +---+ +---+ ================================================ FILE: scheme/eopl/02/28.scm ================================================ ; EOPL exercise 2.28 ; ; Write an unparser that converts the abstract syntax of an lc-exp into a ; string that matches the second grammar in this section (page 52). (define (id? sym) (and (symbol? sym) (not (eqv? sym 'lambda)))) (define-datatype lc-exp lc-exp? (var-exp (var id?)) (lambda-exp (bound-var id?) (body lc-exp?)) (app-exp (rator lc-exp?) (rand lc-exp?))) (define (unparse exp) (cases lc-exp exp (var-exp (name) (symbol->string name)) (lambda-exp (bound-var body) (format "(lambda (~a) ~a)" bound-var (unparse body))) (app-exp (rator rand) (format "(~a ~a)" (unparse rator) (unparse rand))))) ================================================ FILE: scheme/eopl/02/29.scm ================================================ ; EOPL exercise 2.29 ; ; Where a Kleene star or plus (page 7) is used in concrete syntax, it is most ; convenient to use a list of associated subtrees when constructing an ; abstract syntax tree. For example, if the grammar for lambda-calculus ; expressions had been ; ; Lc-exp ::= Identifier ; +---------------+ ; | var-exp (var) | ; +---------------+ ; ; ::= (lambda ({Identifier}*) Lc-exp) ; +------------------------------+ ; | lambda-exp (bound-vars body) | ; +------------------------------+ ; ; ::= (Lc-exp {Lc-exp}*) ; +-----------------------+ ; | app-exp (rator rands) | ; +-----------------------+ ; ; then the predicate for the bound-vars field could be (list-of identifier?), ; and the predicate for the rands fields could be (list-of lc-exp?). Write a ; define-datatype and a parser for this grammar that works in this way. (define (id? sym) (and (symbol? sym) (not (eqv? sym 'lambda)))) (define-datatype lc-exp lc-exp? (var-exp (var id?)) (lambda-exp (args (list-of id?)) (body lc-exp?)) (app-exp (rator lc-exp?) (rands (list-of lc-exp?)))) (define (parse sexp) (cond ((eqv? sexp 'lambda) (eopl:error 'parse "lambda is not a valid identifier")) ((symbol? sexp) (var-exp sexp)) ((and (pair? sexp) (eqv? (car sexp) 'lambda)) (lambda-exp (cadr sexp) (parse (caddr sexp)))) ((and (pair? sexp)) (app-exp (parse (car sexp)) (map parse (cdr sexp)))) (else (eopl:error 'parse "Don't know how to parse ~s" sexp)))) ================================================ FILE: scheme/eopl/02/30.scm ================================================ ; EOPL exercise 2.30 ; ; The procedure parse-expression as defined above is fragile: it does not ; detect several possible syntactic errors, such as (a b c), and aborts with ; inappropriate error messages for other expressions, such as (lambda). Modify ; it so that it is robust, accepting any s-exp and issuing an appropriate ; error message if the s-exp does not represent a lambda-calculus expression. (load-relative "23.scm") (define (parse datum) (cond ((symbol? datum) (when (eqv? datum 'lambda) (eopl:error 'parse "lambda is not a valid identifier")) (var-exp datum)) ((and (pair? datum) (eqv? (car datum) 'lambda)) (unless (= (length datum) 3) (eopl:error 'parse "lambda requires two components. given: ~s" datum)) (when (symbol? (cadr datum)) (eopl:error 'parse "lambda requires an arglist. given: ~s" (cadr datum))) (unless (= (length (cadr datum)) 1) (eopl:error 'parse "lambda requires exactly one argument. given: ~s" (cadr datum))) (lambda-exp (car (cadr datum)) (parse (caddr datum)))) ((pair? datum) (unless (= (length datum) 2) (eopl:error 'parse "application requires two components. given: ~s" datum)) (app-exp (parse (car datum)) (parse (cadr datum)))) (else (eopl:error 'parse "Invalid syntax: ~s" datum)))) ================================================ FILE: scheme/eopl/02/31.scm ================================================ ; EOPL exercise 2.31 ; ; Sometimes it is useful to specify a concrete syntax as a sequence of symbols ; and integers, surrounded by parentheses. For example, one might define the ; set of prefix lists by ; ; Prefix-list ::= (Prefix-exp) ; Prefix-exp ::= Int ; ::= - Prefix-exp Prefix-exp ; ; so that (- - 3 2 - 4 - 12 7) is a legal prefix list. This is sometimes ; called Polish prefix notation, after its inventor, Jan Łukasiewicz. Write a ; parser to convert a prefix-list of the abstract syntax ; ; (define-datatype prefix-exp prefix-exp? ; (const-exp ; (num integer?)) ; (diff-exp ; (operand1 prefix-exp?) ; (operand2 prefix-exp?))) ; ; so that the example above produces the same abstract syntax tree as the ; sequence of constructors ; ; (diff-exp ; (diff-exp ; (const-exp 3) ; (const-exp 2)) ; (diff-exp ; (const-exp 4) ; (diff-exp ; (const-exp 12) ; (const-exp 7)))) ; ; As a hit, consider writing a procedure that takes a list and produces a ; prefix-exp and the list of leftover list elements. (define-datatype prefix-exp prefix-exp? (const-exp (num integer?)) (diff-exp (operand1 prefix-exp?) (operand2 prefix-exp?))) (define (read-prefix-exp datum) (cond ((null? datum) (eopl:error 'parse "Unexpected end of input")) ((number? (car datum)) (cons (const-exp (car datum)) (cdr datum))) ((eqv? (car datum) '-) (let* ((result-1 (read-prefix-exp (cdr datum))) (operand-1 (car result-1)) (suffix-1 (cdr result-1)) (result-2 (read-prefix-exp suffix-1)) (operand-2 (car result-2)) (suffix-2 (cdr result-2))) (cons (diff-exp operand-1 operand-2) suffix-2))) (else (eopl:error 'read-prefix-exp "Unrecognized input: ~s" (car datum))))) (define (parse datum) (let* ((result (read-prefix-exp datum)) (prefix-exp (car result)) (remaining (cdr result))) (if (null? remaining) prefix-exp (eopl:error 'parse "Trailing output: ~s" remaining)))) ================================================ FILE: scheme/eopl/02/tests/01-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../01.scm") (define eopl-2.01-tests (test-suite "Tests for EOPL exercise 2.01" (check-equal? (zero) '()) (test-suite "successor" (parameterize ((base 4)) (check-equal? (successor (zero)) '(1)) (check-equal? (successor '(2 1)) '(3 1)) (check-equal? (successor '(3 1 1)) '(0 2 1)) (check-equal? (successor '(3 3 3)) '(0 0 0 1)) (check-equal? (successor '(3 3 3 1)) '(0 0 0 2)))) (test-suite "predecessor" (parameterize ((base 4)) (check-equal? (predecessor '(1)) '()) (check-equal? (predecessor '(3 1)) '(2 1)) (check-equal? (predecessor '(0 2 1)) '(3 1 1)) (check-equal? (predecessor '(0 0 0 1)) '(3 3 3)) (check-equal? (predecessor '(0 0 0 2)) '(3 3 3 1)))) (test-suite "bignum->int" (parameterize ((base 10)) (check-equal? (bignum->int '()) 0) (check-equal? (bignum->int '(0 0 1)) 100) (check-equal? (bignum->int '(3 2 1)) 123))) (test-suite "int->bignum" (parameterize ((base 10)) (check-equal? (int->bignum 0) '()) (check-equal? (int->bignum 100) '(0 0 1)) (check-equal? (int->bignum 321) '(1 2 3)))) (test-suite "multiply" (parameterize ((base 10)) (check-equal? (multiply (zero) '(6 2 3)) (zero)) (check-equal? (bignum->int (multiply '(8 5 7) '(6 2 3))) (* 758 326)))) (test-suite "factorial" (check-equal? (factorial (int->bignum 5)) (int->bignum 120))) )) (exit (run-tests eopl-2.01-tests)) ================================================ FILE: scheme/eopl/02/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../03.scm") (define eopl-2.03-tests (test-suite "Tests for EOPL exercise 2.03" (check-equal? (zero) '(diff (one) (one))) (check-equal? (successor '(one)) '(diff (one) (diff (diff (one) (one)) (one)))) (check-equal? (predecessor '(one)) '(diff (one) (one))) (check-equal? (predecessor '(diff (one) (one))) '(diff (diff (one) (one)) (one))) (check-equal? (diff-tree-plus '(diff (one) (one)) '(one)) '(diff (diff (one) (one)) (diff (diff (one) (one)) (one)))) (check-equal? (diff-tree-plus '(diff (one) (one)) '(diff (diff (one) (one)) (one))) '(diff (diff (one) (one)) (diff (one) (diff (one) (one))))) (check-true (is-zero? (zero))) (check-true (is-zero? '(diff (diff (one) (diff (one) (one))) (diff (one) (diff (one) (one)))))) (check-true (is-zero? '(diff (diff (one) (diff (one) (one))) (one)))) (check-false (is-zero? '(diff (one) (diff (one) (one))))) (check-true (is-zero? ((compose successor predecessor) (zero)))) (check-true (is-zero? ((compose predecessor successor) (zero)))) (check-true (is-zero? ((compose successor successor predecessor predecessor) (zero)))) (check-true (is-zero? ((compose successor predecessor successor predecessor) (zero)))) (check-true (is-zero? ((compose successor predecessor predecessor successor) (zero)))) (check-true (is-zero? ((compose predecessor predecessor successor successor) (zero)))) (check-true (is-zero? ((compose predecessor successor predecessor successor) (zero)))) (check-true (is-zero? ((compose predecessor successor successor predecessor) (zero)))) (check-false (is-zero? (predecessor (zero)))) (check-false (is-zero? (successor (zero)))) (check-false (is-zero? ((compose predecessor predecessor) (zero)))) (check-false (is-zero? ((compose predecessor predecessor predecessor) (zero)))) (check-false (is-zero? ((compose predecessor predecessor successor) (zero)))) (check-false (is-zero? ((compose predecessor successor predecessor) (zero)))) (check-false (is-zero? ((compose predecessor successor successor) (zero)))) (check-false (is-zero? ((compose successor successor) (zero)))) (check-false (is-zero? ((compose successor successor successor) (zero)))) (check-false (is-zero? ((compose successor successor predecessor) (zero)))) (check-false (is-zero? ((compose successor predecessor successor) (zero)))) (check-false (is-zero? ((compose successor predecessor predecessor) (zero)))) )) (exit (run-tests eopl-2.03-tests)) ================================================ FILE: scheme/eopl/02/tests/05-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../05.scm") (define eopl-2.05-tests (test-suite "Tests for EOPL exercise 2.05" (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) )) (exit (run-tests eopl-2.05-tests)) ================================================ FILE: scheme/eopl/02/tests/06-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../06.scm") (define eopl-2.06-tests (test-suite "Tests for EOPL exercise 2.06" (test-suite "1. 2-list" (use-2-list) (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3)) (test-suite "2. two lists" (use-two-lists) (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3)) (test-suite "3. var-val list" (use-var-val-list) (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3)) )) (exit (run-tests eopl-2.06-tests)) ================================================ FILE: scheme/eopl/02/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../07.scm") (define eopl-2.07-tests (test-suite "Tests for EOPL exercise 2.07" (check-exn (regexp "Variable b not found in environment: \\(extend-env a 1 \\(empty-env\\)\\)") (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) )) (exit (run-tests eopl-2.07-tests)) ================================================ FILE: scheme/eopl/02/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../08.scm") (define eopl-2.08-tests (test-suite "Tests for EOPL exercise 2.08" (check-true (empty-env? (empty-env))) (check-false (empty-env? (extend-env 'a 1 (empty-env)))) )) (exit (run-tests eopl-2.08-tests)) ================================================ FILE: scheme/eopl/02/tests/09-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../09.scm") (define eopl-2.09-tests (test-suite "Tests for EOPL exercise 2.09" (check-true (has-binding? (extend-env 'a 1 (empty-env)) 'a)) (check-true (has-binding? (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b)) (check-false (has-binding? (empty-env) 'a)) (check-false (has-binding? (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'c)) )) (exit (run-tests eopl-2.09-tests)) ================================================ FILE: scheme/eopl/02/tests/10-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../10.scm") (define eopl-2.10-tests (test-suite "Tests for EOPL exercise 2.10" (check-equal? (apply-env (extend-env* '(a b c) '(1 2 3) (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env* '(a b c) '(1 2 3) (empty-env)) 'b) 2) (check-equal? (apply-env (extend-env* '(a b c) '(1 2 3) (empty-env)) 'c) 3) )) (exit (run-tests eopl-2.10-tests)) ================================================ FILE: scheme/eopl/02/tests/11-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../11.scm") (define eopl-2.11-tests (test-suite "Tests for EOPL exercise 2.11" (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) (check-equal? (apply-env (extend-env* '(a b c) '(1 2 3) (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env* '(a b c) '(1 2 3) (empty-env)) 'b) 2) (check-equal? (apply-env (extend-env* '(a b c) '(1 2 3) (empty-env)) 'c) 3) )) (exit (run-tests eopl-2.11-tests)) ================================================ FILE: scheme/eopl/02/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../12.scm") (define eopl-2.12-tests (test-suite "Tests for EOPL exercise 2.12" (check-true (empty-stack? (empty-stack))) (check-true (empty-stack? (pop (push 1 (empty-stack))))) (check-false (empty-stack? (push 1 (empty-stack)))) (check-false (empty-stack? (pop (push 2 (push 1 (empty-stack)))))) )) (exit (run-tests eopl-2.12-tests)) ================================================ FILE: scheme/eopl/02/tests/13-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../13.scm") (define eopl-2.13-tests (test-suite "Tests for EOPL exercise 2.13" (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) (check-false (empty-env? (extend-env 'a 1 (empty-env)))) (check-true (empty-env? (empty-env))) )) (exit (run-tests eopl-2.13-tests)) ================================================ FILE: scheme/eopl/02/tests/14-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../14.scm") (define eopl-2.14-tests (test-suite "Tests for EOPL exercise 2.14" (check-exn exn? (lambda () (apply-env (empty-env) 'a))) (check-exn exn? (lambda () (apply-env (extend-env 'a 1 (empty-env)) 'b))) (check-equal? (apply-env (extend-env 'a 1 (empty-env)) 'a) 1) (check-equal? (apply-env (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b) 2) (check-equal? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) (check-false (empty-env? (extend-env 'a 1 (empty-env)))) (check-true (empty-env? (empty-env))) (check-false (has-binding? (empty-env) 'a)) (check-false (has-binding? (extend-env 'a 1 (empty-env)) 'b)) (check-true (has-binding? (extend-env 'a 1 (empty-env)) 'a)) (check-true (has-binding? (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b)) )) (exit (run-tests eopl-2.14-tests)) ================================================ FILE: scheme/eopl/02/tests/15-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../15.scm") (define eopl-2.15-tests (test-suite "Tests for EOPL exercise 2.15" (check-true (var-exp? (var-exp 'a))) (check-equal? (var-exp->var (var-exp 'a)) 'a) (check-true (lambda-exp? (lambda-exp 'a (var-exp 'b)))) (check-equal? (lambda-exp->bound-var (lambda-exp 'a (var-exp 'b))) 'a) (check-equal? (lambda-exp->body (lambda-exp 'a (var-exp 'b))) (var-exp 'b)) (check-true (app-exp? (app-exp (var-exp 'a) (var-exp 'b)))) (check-equal? (app-exp->rator (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'a)) (check-equal? (app-exp->rand (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'b)) (check-false (app-exp? (lambda-exp 'a (var-exp 'b)))) (check-false (lambda-exp? (app-exp (var-exp 'a) (var-exp 'b)))) )) (exit (run-tests eopl-2.15-tests)) ================================================ FILE: scheme/eopl/02/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../16.scm") (define eopl-2.16-tests (test-suite "Tests for EOPL exercise 2.16" (check-equal? (lambda-exp 'a (var-exp 'b)) '(lambda a b)) (check-true (var-exp? (var-exp 'a))) (check-equal? (var-exp->var (var-exp 'a)) 'a) (check-true (lambda-exp? (lambda-exp 'a (var-exp 'b)))) (check-equal? (lambda-exp->bound-var (lambda-exp 'a (var-exp 'b))) 'a) (check-equal? (lambda-exp->body (lambda-exp 'a (var-exp 'b))) (var-exp 'b)) (check-true (app-exp? (app-exp (var-exp 'a) (var-exp 'b)))) (check-equal? (app-exp->rator (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'a)) (check-equal? (app-exp->rand (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'b)) (check-false (app-exp? (lambda-exp 'a (var-exp 'b)))) (check-false (lambda-exp? (app-exp (var-exp 'a) (var-exp 'b)))) )) (exit (run-tests eopl-2.16-tests)) ================================================ FILE: scheme/eopl/02/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../17.scm") (define eopl-2.17-tests (test-suite "Tests for EOPL exercise 2.17" (test-suite "Representation 1" (use-representation-1) (check-true (var-exp? (var-exp 'a))) (check-equal? (var-exp->var (var-exp 'a)) 'a) (check-true (lambda-exp? (lambda-exp 'a (var-exp 'b)))) (check-equal? (lambda-exp->bound-var (lambda-exp 'a (var-exp 'b))) 'a) (check-equal? (lambda-exp->body (lambda-exp 'a (var-exp 'b))) (var-exp 'b)) (check-true (app-exp? (app-exp (var-exp 'a) (var-exp 'b)))) (check-equal? (app-exp->rator (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'a)) (check-equal? (app-exp->rand (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'b)) (check-false (app-exp? (lambda-exp 'a (var-exp 'b)))) (check-false (lambda-exp? (app-exp (var-exp 'a) (var-exp 'b))))) (test-suite "Representation 2" (use-representation-2) (check-true (var-exp? (var-exp 'a))) (check-equal? (var-exp->var (var-exp 'a)) 'a) (check-true (lambda-exp? (lambda-exp 'a (var-exp 'b)))) (check-equal? (lambda-exp->bound-var (lambda-exp 'a (var-exp 'b))) 'a) (check-equal? (lambda-exp->body (lambda-exp 'a (var-exp 'b))) (var-exp 'b)) (check-true (app-exp? (app-exp (var-exp 'a) (var-exp 'b)))) (check-equal? (app-exp->rator (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'a)) (check-equal? (app-exp->rand (app-exp (var-exp 'a) (var-exp 'b))) (var-exp 'b)) (check-false (app-exp? (lambda-exp 'a (var-exp 'b)))) (check-false (lambda-exp? (app-exp (var-exp 'a) (var-exp 'b))))) )) (exit (run-tests eopl-2.17-tests)) ================================================ FILE: scheme/eopl/02/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../18.scm") (define eopl-2.18-tests (test-suite "Tests for EOPL exercise 2.18" (check-equal? (number->sequence 7) '(7 () ())) (check-equal? (current-element '(6 (5 4 3 2 1) (7 8 9))) '6) (check-equal? (move-to-left '(6 (5 4 3 2 1) (7 8 9))) '(5 (4 3 2 1) (6 7 8 9))) (check-equal? (move-to-right '(6 (5 4 3 2 1) (7 8 9))) '(7 (6 5 4 3 2 1) (8 9))) (check-equal? (insert-to-left 13 '(6 (5 4 3 2 1) (7 8 9))) '(6 (13 5 4 3 2 1) (7 8 9))) (check-equal? (insert-to-right 13 '(6 (5 4 3 2 1) (7 8 9))) '(6 (5 4 3 2 1) (13 7 8 9))) (check-exn exn? (lambda () (move-to-right '(2 (1) ())))) (check-exn exn? (lambda () (move-to-left '(2 () (3))))) (check-true (at-left-end? '(2 () (3)))) (check-false (at-left-end? '(2 (1) (3)))) (check-true (at-right-end? '(2 (1) ()))) (check-false (at-right-end? '(2 (1) (3)))) )) (exit (run-tests eopl-2.18-tests)) ================================================ FILE: scheme/eopl/02/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../19.scm") (define eopl-2.19-tests (test-suite "Tests for EOPL exercise 2.19" (check-equal? (number->bintree 13) '(13 () ())) (check-equal? (insert-to-left 4 '(1 (2 () ()) (3 () ()))) '(1 (4 (2 () ()) ()) (3 () ()))) (check-equal? (insert-to-right 4 '(1 (2 () ()) (3 () ()))) '(1 (2 () ()) (4 () (3 () ())))) (let ((t1 (insert-to-right 14 (insert-to-left 12 (number->bintree 13))))) (check-equal? t1 '(13 (12 () ()) (14 () ()))) (check-equal? (move-to-left-son t1) '(12 () ())) (check-equal? (current-element (move-to-left-son t1)) 12) (check-equal? (at-leaf? (move-to-right-son (move-to-left-son t1))) #t) (check-equal? (insert-to-left 15 t1) '(13 (15 (12 () ()) ()) (14 () ())))) )) (exit (run-tests eopl-2.19-tests)) ================================================ FILE: scheme/eopl/02/tests/20-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../20.scm") (define eopl-2.20-tests (test-suite "Tests for EOPL exercise 2.20" (check-equal? (move-to-left-son (insert-to-left 2 (number->bintree 1))) '(2 () () (1 (2 () () ()) () ()))) (check-equal? (move-to-right-son (insert-to-right 2 (number->bintree 1))) '(2 () () (1 () (2 () () ()) ()))) (check-equal? (move-up (move-to-left-son (insert-to-left 2 (number->bintree 1)))) (insert-to-left 2 (number->bintree 1))) (check-equal? (move-up (move-to-right-son (insert-to-right 2 (number->bintree 1)))) (insert-to-right 2 (number->bintree 1))) (check-true (at-leaf? (move-to-left-son (move-to-left-son (insert-to-left 2 (number->bintree 1)))))) (check-true (at-leaf? (move-to-right-son (move-to-right-son (insert-to-right 2 (number->bintree 1)))))) (check-equal? (move-up (move-up (move-to-left-son (move-to-left-son (insert-to-left 2 (number->bintree 1)))))) (insert-to-left 2 (number->bintree 1))) (check-equal? (move-up (move-up (move-to-right-son (move-to-right-son (insert-to-right 2 (number->bintree 1)))))) (insert-to-right 2 (number->bintree 1))) (check-true (at-root? (number->bintree 1))) (check-false (at-root? (move-to-right-son (insert-to-right 2 (number->bintree 1))))) )) (exit (run-tests eopl-2.20-tests)) ================================================ FILE: scheme/eopl/02/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../21.scm") (define eopl-2.21-tests (test-suite "Tests for EOPL exercise 2.21" (check-true (has-binding? (extend-env 'a 1 (empty-env)) 'a)) (check-true (has-binding? (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'b)) (check-false (has-binding? (empty-env) 'a)) (check-false (has-binding? (extend-env 'a 1 (extend-env 'b 2 (empty-env))) 'c)) )) (exit (run-tests eopl-2.21-tests)) ================================================ FILE: scheme/eopl/02/tests/22-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../22.scm") (define eopl-2.22-tests (test-suite "Tests for EOPL exercise 2.22" (check-true (empty-stack? (empty-stack))) (check-true (empty-stack? (pop (push 1 (empty-stack))))) (check-false (empty-stack? (push 1 (empty-stack)))) (check-false (empty-stack? (pop (push 2 (push 1 (empty-stack)))))) )) (exit (run-tests eopl-2.22-tests)) ================================================ FILE: scheme/eopl/02/tests/23-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../23.scm") (define eopl-2.23-tests (test-suite "Tests for EOPL exercise 2.23" (check-exn exn? (lambda () (app-exp (var-exp 'lambda) (var-exp 'lambda)))) (check-exn exn? (lambda () (app-exp (var-exp 'a) (var-exp 'lambda)))) (check-exn exn? (lambda () (app-exp (var-exp 'lambda) (var-exp 'a)))) (check-exn exn? (lambda () (lambda-exp 'lambda (var-exp 'lambda)))) (check-exn exn? (lambda () (lambda-exp 'a (var-exp 'lambda)))) (check-exn exn? (lambda () (lambda-exp 'lambda (var-exp 'a)))) )) (exit (run-tests eopl-2.23-tests)) ================================================ FILE: scheme/eopl/02/tests/24-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../24.scm") (define eopl-2.24-tests (test-suite "Tests for EOPL exercise 2.24" (check-equal? (bintree-to-list (interior-node 'a (leaf-node 3) (leaf-node 4))) '(interior-node a (leaf-node 3) (leaf-node 4))) )) (exit (run-tests eopl-2.24-tests)) ================================================ FILE: scheme/eopl/02/tests/25-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../25.scm") (define eopl-2.25-tests (test-suite "Tests for EOPL exercise 2.25" (let* ((tree-1 (interior-node 'foo (leaf-node 2) (leaf-node 3))) (tree-2 (interior-node 'bar (leaf-node -1) tree-1)) (tree-3 (interior-node 'baz tree-2 (leaf-node 1)))) (check-equal? 'foo (max-interior tree-2)) (check-equal? 'baz (max-interior tree-3))) )) (exit (run-tests eopl-2.25-tests)) ================================================ FILE: scheme/eopl/02/tests/26-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../26.scm") (define eopl-2.26-tests (test-suite "Tests for EOPL exercise 2.26" (check-equal? (mark-with-red-depth (red-node (blue-node (list (red-node (leaf-node 0) (leaf-node 0)) (leaf-node 0) (blue-node (list (leaf-node 0) (red-node (leaf-node 0) (leaf-node 0)))))) (leaf-node 0))) (red-node (blue-node (list (red-node (leaf-node 2) (leaf-node 2)) (leaf-node 1) (blue-node (list (leaf-node 1) (red-node (leaf-node 2) (leaf-node 2)))))) (leaf-node 1))) )) (exit (run-tests eopl-2.26-tests)) ================================================ FILE: scheme/eopl/02/tests/28-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../28.scm") (define eopl-2.28-tests (test-suite "Tests for EOPL exercise 2.28" (check-equal? (unparse (var-exp 'a)) "a") (check-equal? (unparse (lambda-exp 'x (app-exp (var-exp 'x) (var-exp 'y)))) "(lambda (x) (x y))") (check-equal? (unparse (app-exp (lambda-exp 'x (var-exp 'x)) (app-exp (var-exp 'a) (var-exp 'b)))) "((lambda (x) x) (a b))") )) (exit (run-tests eopl-2.28-tests)) ================================================ FILE: scheme/eopl/02/tests/29-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../29.scm") (define eopl-2.29-tests (test-suite "Tests for EOPL exercise 2.29" (check-equal? (parse 'x) (var-exp 'x)) (check-equal? (parse '(lambda (a b c) a)) (lambda-exp '(a b c) (var-exp 'a))) (check-equal? (parse '((lambda (a b) a) x y)) (app-exp (lambda-exp '(a b) (var-exp 'a)) (list (var-exp 'x) (var-exp 'y)))) )) (exit (run-tests eopl-2.29-tests)) ================================================ FILE: scheme/eopl/02/tests/30-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../30.scm") (define eopl-2.30-tests (test-suite "Tests for EOPL exercise 2.30" (check-equal? (parse 'a) (var-exp 'a)) (check-equal? (parse '(lambda (a) a)) (lambda-exp 'a (var-exp 'a))) (check-equal? (parse '(a b)) (app-exp (var-exp 'a) (var-exp 'b))) (check-exn (regexp "lambda is not a valid identifier") (lambda () (parse 'lambda))) (check-exn (regexp "lambda requires two components. given: \\(lambda\\)") (lambda () (parse '(lambda)))) (check-exn (regexp "lambda requires two components. given: \\(lambda a\\)") (lambda () (parse '(lambda a)))) (check-exn (regexp "lambda requires two components. given: \\(lambda a b c\\)") (lambda () (parse '(lambda a b c)))) (check-exn (regexp "lambda requires an arglist. given: a") (lambda () (parse '(lambda a b)))) (check-exn (regexp "lambda requires exactly one argument. given: \\(\\)") (lambda () (parse '(lambda () a)))) (check-exn (regexp "lambda requires exactly one argument. given: \\(a b\\)") (lambda () (parse '(lambda (a b) a)))) (check-exn (regexp "application requires two components. given: \\(a\\)") (lambda () (parse '(a)))) (check-exn (regexp "application requires two components. given: \\(a b c\\)") (lambda () (parse '(a b c)))) )) (exit (run-tests eopl-2.30-tests)) ================================================ FILE: scheme/eopl/02/tests/31-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../31.scm") (define eopl-2.31-tests (test-suite "Tests for EOPL exercise 2.31" (check-equal? (parse '(- - 3 2 - 4 - 12 7)) (diff-exp (diff-exp (const-exp 3) (const-exp 2)) (diff-exp (const-exp 4) (diff-exp (const-exp 12) (const-exp 7))))) )) (exit (run-tests eopl-2.31-tests)) ================================================ FILE: scheme/eopl/03/01.scm ================================================ ; EOPL exercise 3.01 ; ; In figure 3.3, list all the places where we used the fact that ; ⎣ ⎡ n⎤ ⎦ = n. ; I will use {} for ⎣ and ⎦ and [] for ⎡ and ⎤. I will annotate the code below: ; ; Let p = [i = 1, v = 5, x = 10]. ; ; (value-of ; <<-(-(x, 3), -(v, i))>> ; p) ; ; = [(- ; {(value-of <<-(x, 3)>> p)} ; {(value-of <<-(v, i)>> p)})] ; ; = [(- ; (- ; {(value-of <> p)} ; {(value-of <<3>> p)}) ; {(value-of <<-(v, i)>>)})] ; ; = [(- ; (- ; 10 ; HERE ; {(value-of <<3>> p)}) ; {(value-of <<-(v, i)>>)})] ; ; = [(- ; (- ; 10 ; 3) ; HERE ; {(value-of <<-(v, i)>>)})] ; ; = [(- ; 7 ; {(value-of <<-(v, i)>>)})] ; ; = [(- ; 7 ; (- ; {(value-of <> p)} ; {(value-of <> p)}))] ; ; = [(- ; 7 ; (- ; 5 ; HERE ; {(value-of <> p)}))] ; ; = [(- ; 7 ; (- ; 5 ; 1))] ; HERE ; = [(- ; 7 ; 4)] ; ; = [4] ================================================ FILE: scheme/eopl/03/02.scm ================================================ ; EOPL exercise 3.02 ; ; Give an expressed value val ∈ ExpVal for which ⎡ ⎣ val⎦ ⎤ ≠ val. ; This is tricky. We don't have it in the LET language. let's explore a ; language has rational numbers in ExpVal, but the implementation language ; does not have that notion. Instad, expval->num converts the rational number ; to a float. In that language ; ; (num-val (expval->num ⎡ 1/3⎤)) ; ; would not return one third, but a rational number that is close to it. ================================================ FILE: scheme/eopl/03/03.scm ================================================ ; EOPL exercise 3.03 ; ; Why is subtraction a better choice than addition for our single arithmetic ; operation? ; Because we don't have negative numbers in our syntax. Thus, we cannot parse ; -x, but we can still represent it as -(0, x). This would not have been true ; if we used addition instead. ; ; Furthermore, we can represent x + y as -(x, -(0, y)) if we have subtraction. ; If we only have addition, there is on way to represent subtraction - (unless ; we had negation, but that is a second arithmetic operation). ================================================ FILE: scheme/eopl/03/04.scm ================================================ ; EOPL exercise 3.04 ; ; Write out the derivation of figure 3.4 as a derivation tree in the style of ; one on page 5. ; I cannot figure this exercise out. Figure 3.4 is: ; ; (value-of (if-exp exp₁ exp₂ exp₃) p) ; ; = (if (expval->bool (value-of exp₁ p)) ; (value-of exp₂ p) ; (value-of exp₃ p)) ; ; I have no clue how to represent this as a derivation tree. Next! ================================================ FILE: scheme/eopl/03/05.scm ================================================ ; EOPL exercise 3.05 ; ; Write out the derivation of figure 3.5 as a derivation tree in the style of ; the one on page 5. ; This is the same of the previous and I still can't figure out what I'm ; supposed to do. I can write a derivation tree, if I had a concrete ; expression, but it uses exp₁ and exp₂ instead. I can come up with a concrete ; expression and write the tree, but I just don't think it is worth it. ================================================ FILE: scheme/eopl/03/06.scm ================================================ ; EOPL exercise 3.06 ; ; Extend the language by adding a new operator minus that takes one argument, ; n, and returns -n. For example, the value of minus(-(minus(5), 9)) should be ; 14. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (minus-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))))) ================================================ FILE: scheme/eopl/03/07.scm ================================================ ; EOPL exercise 3.07 ; ; Extend the language by adding operators for addition, multiplication, and ; integer quotient. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))))) ================================================ FILE: scheme/eopl/03/08.scm ================================================ ; EOPL exercise 3.08 ; ; Add a numeric equality predicate equal? and numeric order predicates ; greater? and less? to the set of operations in the defined language. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) )) ================================================ FILE: scheme/eopl/03/09.scm ================================================ ; EOPL exercise 3.09 ; ; Add a list processing operations to the language, including cons, car, cdr, ; null? and emptylist. A list should be able to contain any expressed value, ; including another list. Give the definitions of the expressed and denoted ; values of the languages, as in section 3.2.2. For example, ; ; let x = 4 ; in cons(x, ; cons(cons(-(x, 1), ; emptylist), ; emptylist)) (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))))) ================================================ FILE: scheme/eopl/03/10.scm ================================================ ; EOPL exercise 3.10 ; ; Add an operation list to the language. This operation should take any number ; of arguments, and return an expressed value containing the list of their ; values. For example, ; ; let x = 4 ; in list(x, -(x, 1), -(x, 3)) (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) )) ================================================ FILE: scheme/eopl/03/11.scm ================================================ ; EOPL exercise 3.11 ; ; In a real language, one might have many operators such as those in the ; preceding exercises. Rearrange the code in the interpreter so that it is easy ; to add new operators. ; This is annoyingly tricky because of SLLGEN. I can't figure out why, but I ; can't get it to either dynamically define the grammar with a predefined list ; of operators (when the list is not specified as a literal) and I can't get ; the scanner to treat some words as operators. Instead, I'm going to simplify ; everything. I'm just going to implement the four arithmetic operators. If ; more operators are added, the grammar needs to be modifying accordingly. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (op-exp (operator symbol?) (operands (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (operator ((or "+" "-" "*" "/")) symbol) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression (operator "(" (separated-list expression "," ) ")") op-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) ; The new stuff. Operators are defined in a table and value-of dispatches ; accordingly. (define operators-table (make-hash)) (define (apply-op rator rands) (apply (hash-ref operators-table rator) rands)) (define (lift op) (lambda args (num-val (apply op (map expval->num args))))) (define operators (list (list '+ (lift +)) (list '- (lift -)) (list '* (lift *)) (list '/ (lift quotient)))) (for ([olist operators]) (hash-set! operators-table (car olist) (cadr olist))) ; The new value-of (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (op-exp (rator rands) (apply-op rator (map (lambda (e) (value-of e env)) rands))))) ================================================ FILE: scheme/eopl/03/12.scm ================================================ ; EOPL exercise 3.12 ; ; Add to the defined language a facility that adds a cond expression. Use the ; grammar ; ; Expression ::= cond {Expression ==> Expression}* end ; ; In this expression, the expressions on the left-hand sides of the ==>'s are ; evaluated in order until one of them returns a true value. The the value of ; the entire expression is the value of the corresponding right-hand ; expression. If none of the tests succeeds, the expression should report an ; error. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (eval-cond conditions actions env) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) env)) (value-of (car actions) env)) (else (eval-cond (cdr conditions) (cdr actions) env)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) (cond-exp (conditions actions) (eval-cond conditions actions env)) )) ================================================ FILE: scheme/eopl/03/13.scm ================================================ ; EOPL exercise 3.13 ; ; Change the values of the language so that integers are the only expressed ; values. Modify if so that the value 0 is treated as false and all other ; values are treated as true. Modify the predicates accordingly. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define (eval-cond conditions actions env) (cond ((null? conditions) 0) ((zero? (value-of (car conditions) env)) (eval-cond (cdr conditions) (cdr actions) env)) (else (value-of (car actions) env)))) (define (value-of expr env) (cases expression expr (const-exp (num) num) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (+ left-val right-val))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (- minuend-val subtrahend-val))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (* left-val right-val))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (quotient left-val right-val))) (minus-exp (arg) (- (value-of arg env))) (zero?-exp (arg) (let ((value (value-of arg env))) (if (zero? value) 1 0))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (not (zero? value)) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (if (= left-val right-val) 1 0))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (if (< left-val right-val) 1 0))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (if (> left-val right-val) 1 0))) (cond-exp (conditions actions) (eval-cond conditions actions env)))) ================================================ FILE: scheme/eopl/03/14.scm ================================================ ; EOPL exercise 3.14 ; ; As an alternative to the previous exercise, add a new nonterminal Bool-exp ; of boolean expressions to the language. Change the production for ; conditional expressions to say ; ; Expression ::= if Bool-exp then Expression else Expression ; ; Write suitable productions for Bool-exp and implement value-of-bool-exp. ; Where do the predicates of exercise 3.8 wind up in this organization? (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("cond" (arbno boolean "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" boolean "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (boolean ("null?" "(" expression ")") null?-exp) (boolean ("equal?" "(" expression "," expression ")") equal?-exp) (boolean ("less?" "(" expression "," expression ")") less?-exp) (boolean ("greater?" "(" expression "," expression ")") greater?-exp) (boolean ("zero?" "(" expression ")") zero?-exp) )) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (eval-cond conditions actions env) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) env)) (value-of (car actions) env)) (else (eval-cond (cdr conditions) (cdr actions) env)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) (cond-exp (conditions actions) (eval-cond conditions actions env)) )) ================================================ FILE: scheme/eopl/03/15.scm ================================================ ; EOPL exercise 3.15 ; ; Extend the language by adding a new operation print that takes one argument, ; print its, and returns the integer 1. Why is this operation not expressible ; in our specification framework? ; The implementation is below. ; ; We cannot express it in our specification framework, because it has ; side-effect (printing out STDOUT) and we don't have a way to express ; side-effects. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (print-exp (expr expression?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("print" expression) print-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (eval-cond conditions actions env) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) env)) (value-of (car actions) env)) (else (eval-cond (cdr conditions) (cdr actions) env)))) (define (print-out value) (cases expval value (num-val (n) (display n)) (bool-val (b) (display b)) (emptylist-val () (display "emptylist")) (pair-val (head tail) (display "cons(") (print-out head) (display ", ") (print-out tail) (display ")")))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) (print-exp (expr) (print-out (value-of expr env)) (num-val 1)) (cond-exp (conditions actions) (eval-cond conditions actions env)) )) ================================================ FILE: scheme/eopl/03/16.scm ================================================ ; EOPL exercise 3.16 ; ; Extend the language so that a let declaration can declare an arbitrary ; number of variables, using the grammar ; ; Expression ::= let {Identifier = Expression}* in Expression ; ; As in Scheme's let, each of the right-hand sides is evaluated in the current ; environment, and the body is evaluated with each new variable bound to the ; value of its associated right-hand side. For example, ; ; let x = 30 ; in let x = -(x, 1) ; y = -(x, 2) ; in -(x, y) ; ; should evaluate to 1. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (print-exp (expr expression?)) (let-exp (vars (list-of symbol?)) (vals (list-of expression?)) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("print" expression) print-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" (arbno identifier "=" expression) "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (eval-cond conditions actions env) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) env)) (value-of (car actions) env)) (else (eval-cond (cdr conditions) (cdr actions) env)))) (define (print-out value) (cases expval value (num-val (n) (display n)) (bool-val (b) (display b)) (emptylist-val () (display "emptylist")) (pair-val (head tail) (display "cons(") (print-out head) (display ", ") (print-out tail) (display ")")))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (vars vals body) (value-of body (extend-env* vars (map (curryr value-of env) vals) env))) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) (print-exp (expr) (print-out (value-of expr env)) (num-val 1)) (cond-exp (conditions actions) (eval-cond conditions actions env)))) ================================================ FILE: scheme/eopl/03/17.scm ================================================ ; EOPL exercise 3.17 ; ; Extend the language with a let* expression that works like Scheme's let*, so ; that ; ; let x = 30 ; in let* x = -(x, 1) y = -(x, 2) ; in -(x, y) ; ; should evaluate to 2. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (print-exp (expr expression?)) (let-exp (vars (list-of symbol?)) (vals (list-of expression?)) (body expression?)) (let*-exp (vars (list-of symbol?)) (vals (list-of expression?)) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("print" expression) print-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" (arbno identifier "=" expression) "in" expression) let-exp) (expression ("let*" (arbno identifier "=" expression) "in" expression) let*-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (eval-cond conditions actions env) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) env)) (value-of (car actions) env)) (else (eval-cond (cdr conditions) (cdr actions) env)))) (define (print-out value) (cases expval value (num-val (n) (display n)) (bool-val (b) (display b)) (emptylist-val () (display "emptylist")) (pair-val (head tail) (display "cons(") (print-out head) (display ", ") (print-out tail) (display ")")))) (define (eval-let* vars vals body env) (if (null? vars) (value-of body env) (eval-let* (cdr vars) (cdr vals) body (extend-env (car vars) (value-of (car vals) env) env)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (vars vals body) (value-of body (extend-env* vars (map (curryr value-of env) vals) env))) (let*-exp (vars vals body) (eval-let* vars vals body env)) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) (print-exp (expr) (print-out (value-of expr env)) (num-val 1)) (cond-exp (conditions actions) (eval-cond conditions actions env)))) ================================================ FILE: scheme/eopl/03/18.scm ================================================ ; EOPL exercise 3.18 ; ; Add an expression to the defined language ; ; Expression ::= unpack {Identifier}* = Expression in Expression ; ; so that unpack x y z = lst in ... binds x, y, and z to the elements of lst ; if lst is a list of exactly three elements, and reports an error otherwise. ; For example, the value of ; ; let u = 7 ; in unpack x y = cons(u, cons(3, emptylist)) ; in -(x, y) ; ; should be 4. (load-relative "cases/let/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (minus-exp (expr expression?)) (add-exp (left expression?) (right expression?)) (diff-exp (left expression?) (right expression?)) (mult-exp (left expression?) (right expression?)) (div-exp (left expression?) (right expression?)) (zero?-exp (expr expression?)) (equal?-exp (left expression?) (right expression?)) (less?-exp (left expression?) (right expression?)) (greater?-exp (left expression?) (right expression?)) (cons-exp (car expression?) (cdr expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (print-exp (expr expression?)) (let-exp (vars (list-of symbol?)) (vals (list-of expression?)) (body expression?)) (let*-exp (vars (list-of symbol?)) (vals (list-of expression?)) (body expression?)) (unpack-exp (names (list-of symbol?)) (lst expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("print" expression) print-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("+" "(" expression "," expression ")") add-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("*" "(" expression "," expression ")") mult-exp) (expression ("/" "(" expression "," expression ")") div-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("equal?" "(" expression "," expression ")") equal?-exp) (expression ("less?" "(" expression "," expression ")") less?-exp) (expression ("greater?" "(" expression "," expression ")") greater?-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("minus" "(" expression ")") minus-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" (arbno identifier "=" expression) "in" expression) let-exp) (expression ("let*" (arbno identifier "=" expression) "in" expression) let*-exp) (expression ("unpack" (arbno identifier) "=" expression "in" expression) unpack-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val)) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->pair val) (cases expval val (pair-val (car cdr) (cons car cdr)) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (emptylist? val) (cases expval val (emptylist-val () #t) (else #f))) (define (pair-null? val) (cases expval val (emptylist-val () (bool-val #t)) (else (bool-val #f)))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (eval-cond conditions actions env) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) env)) (value-of (car actions) env)) (else (eval-cond (cdr conditions) (cdr actions) env)))) (define (print-out value) (cases expval value (num-val (n) (display n)) (bool-val (b) (display b)) (emptylist-val () (display "emptylist")) (pair-val (head tail) (display "cons(") (print-out head) (display ", ") (print-out tail) (display ")")))) (define (eval-let* vars vals body env) (if (null? vars) (value-of body env) (eval-let* (cdr vars) (cdr vals) body (extend-env (car vars) (value-of (car vals) env) env)))) (define (eval-unpack names lst-exp body env) (define lst (value-of lst-exp env)) (define (bind-names vars vals new-env) (cond ((and (null? vars) (pair-null? vals)) new-env) ((or (null? vars) (emptylist? vals)) (eopl:error 'eval-unpack "List size mismatch ~a, ~a" names lst)) (else (bind-names (cdr vars) (pair-cdr vals) (extend-env (car vars) (pair-car vals) new-env))))) (value-of body (bind-names names lst env))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (add-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (+ left-num right-num))))) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (mult-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (* left-num right-num))))) (div-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (let ((left-num (expval->num left-val)) (right-num (expval->num right-val))) (num-val (quotient left-num right-num))))) (minus-exp (arg) (num-val (- (expval->num (value-of arg env))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (vars vals body) (value-of body (extend-env* vars (map (curryr value-of env) vals) env))) (let*-exp (vars vals body) (eval-let* vars vals body env)) (equal?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (= (expval->num left-val) (expval->num right-val))))) (less?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (< (expval->num left-val) (expval->num right-val))))) (greater?-exp (left right) (let ((left-val (value-of left env)) (right-val (value-of right env))) (bool-val (> (expval->num left-val) (expval->num right-val))))) (emptylist-exp () (emptylist-val)) (cons-exp (car cdr) (let ((car-val (value-of car env)) (cdr-val (value-of cdr env))) (pair-val car-val cdr-val))) (car-exp (expr) (pair-car (value-of expr env))) (cdr-exp (expr) (pair-cdr (value-of expr env))) (null?-exp (expr) (pair-null? (value-of expr env))) (list-exp (exprs) (list-val (map (curryr value-of env) exprs))) (print-exp (expr) (print-out (value-of expr env)) (num-val 1)) (unpack-exp (names lst body) (eval-unpack names lst body env)) (cond-exp (conditions actions) (eval-cond conditions actions env)))) ================================================ FILE: scheme/eopl/03/19.scm ================================================ ; EOPL exercise 3.19 ; ; In many languages, procedures must be created and named at the same time. ; Modify the language of this section to have this property by replacing the ; proc expression with a letproc expression. (load-relative "cases/proc/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (letproc-exp (name symbol?) (var symbol?) (body expression?) (expr expression?)) (call-exp (rator expression?) (rand expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("letproc" identifier "(" identifier ")" "=" expression "in" expression) letproc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; Eval (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (letproc-exp (name var body expr) (value-of expr (extend-env name (proc-val (procedure var body env)) env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))))) ================================================ FILE: scheme/eopl/03/20.scm ================================================ ; EOPL exercise 3.20 ; ; In PROC, procedures have only one argument, but one can get the effect of ; multiple argument procedures by using procedures that return other ; procedures. For example, one might write code like ; ; let f = proc (x) proc (y) ... ; in ((f 3) 4) ; ; The trick is called currying, and the procedure is said to be curried. Write ; a curried procedure that takes two arguments and returns their sum. You can ; write x + y in our language by writing -(x, -(0, y)). (load-relative "cases/proc/all.scm") (define two-plus-three "let add = proc (x) proc (y) -(x, -(0, y)) in ((add 2) 3)") ================================================ FILE: scheme/eopl/03/21.scm ================================================ ; EOPL exercise 3.21 ; ; Extend the language of this section to include procedures with multiple ; arguments and class with multiple operands, as suggested by the grammar ; ; Expression ::= proc ({Identifier}*(,)) Expression ; Expression ::= (Expression {Expression}*) (load-relative "cases/proc/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var (list-of symbol?)) (body expression?)) (call-exp (rator expression?) (rand (list-of expression?)))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" (separated-list identifier ",") ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression (arbno expression) ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (var (list-of symbol?)) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 vals) (cases proc proc1 (procedure (vars body saved-env) (value-of body (extend-env* vars vals saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (vars body) (proc-val (procedure vars body env))) (call-exp (rator rands) (let ((proc (expval->proc (value-of rator env))) (args (map (lambda (rand) (value-of rand env)) rands))) (apply-procedure proc args))))) ================================================ FILE: scheme/eopl/03/22.scm ================================================ ; EOPL exercise 3.22 ; ; The concrete syntax of this section uses different syntax for a built-in ; operation, such as difference, from a procedure call. Modify the concrete ; syntax so that the user of this language need not know which operations are ; built-in and which are defined procedures. The exercise may range from very ; easy to hard, depending on the parsing technology being used. ; This is quite annoying using SLLGEN. I'm doing it with a particularly nasty ; function var-or-call that takes an ugly parse result and classifies it as a ; var-exp or a call-exp. ; ; If I was less lazy, I could get foo(1)(2) to work. I'm not. (load-relative "cases/proc/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var (list-of symbol?)) (body expression?)) (call-exp (rator expression?) (rand (list-of expression?)))) (define (var-or-call id args) (cond ((null? args) (var-exp id)) ((= (length args) 1) (call-exp (var-exp id) (car args))) (else (eopl:error 'parse "Can't parse this")))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression (identifier (arbno "(" (separated-list expression ",") ")")) var-or-call) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression ("proc" "(" (separated-list identifier ",") ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (var (list-of symbol?)) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 vals) (cases proc proc1 (procedure (vars body saved-env) (value-of body (extend-env* vars vals saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (vars body) (proc-val (procedure vars body env))) (call-exp (rator rands) (let ((proc (expval->proc (value-of rator env))) (args (map (lambda (rand) (value-of rand env)) rands))) (apply-procedure proc args))))) ================================================ FILE: scheme/eopl/03/23.scm ================================================ ; EOPL exercise 3.23 ; ; What is the value of the following PROC program? ; ; let makemult = proc (maker) ; proc (x) ; if zero?(x) ; then 0 ; else -(((maker maker) -(x, 1)), -4) ; in let times4 = proc (x) ((makemult makemult) x) ; in (times4 3) ; ; Use tricks of this program to write a procedure for factorial in PROC. As a ; hint, remember that you can use currying (exercise 3.20) to define a ; two-argument procedure times. ; This smells of the Y combinator. Cool. The program returns 12, as the names ; of its procedures suggest. (load-relative "cases/proc/all.scm") (define the-given-program "let makemult = proc (maker) proc (x) if zero?(x) then 0 else -(((maker maker) -(x, 1)), -(0, 4)) in let times4 = proc (x) ((makemult makemult) x) in (times4 3)") (define factorial-5-program "let makemult = proc (maker) proc (x) proc (y) if zero?(y) then 0 else -((((maker maker) x) -(y, 1)), -(0, x)) in let times = proc (x) proc (y) (((makemult makemult) x) y) in let makefact = proc (fact) proc (n) if zero?(n) then 1 else ((times n) ((fact fact) -(n, 1))) in let factorial = proc (n) ((makefact makefact) n) in (factorial 5)") ================================================ FILE: scheme/eopl/03/24.scm ================================================ ; EOPL exercise 3.24 ; ; Use the tricks of the program above to write the pair of mutually recursive ; procedures, odd and even, as in exercise 3.32. (load-relative "cases/proc/all.scm") (define the-program "let of = proc (o) proc (e) proc (n) if zero?(n) then 0 else (((e o) e) -(n, 1)) in let ef = proc (o) proc (e) proc (n) if zero? (n) then 1 else (((o o) e) -(n, 1)) in let odd = proc(n) (((of of) ef) n) in let even = proc(n) (((ef of) ef) n) in -(-((even 10), (odd 10)), -((odd 11), (even 11)))") ================================================ FILE: scheme/eopl/03/25.scm ================================================ ; EOPL exercise 3.25 ; ; The tricks of the previous exercises can be generalized to show that we can ; define any recursive procedure in PROC. Consider the following bit of code: ; ; let makerec = proc (f) ; let d = proc (x) ; proc (z) ((f (x x)) z) ; in proc (n) ((f (d d)) n) ; in let maketimes4 = proc (f) ; proc (x) ; if zero?(x) ; then 0 ; else -((f -(x, 1)), -(0, 4)) ; in let times4 = (makerec maketimes4) ; in (times4 3) ; ; Show that it returns 12. ; This is the Y-combinator. I'm showing that it returns 12 by running it in ; the tests. (load-relative "cases/proc/all.scm") (define the-example-program "let makerec = proc (f) let d = proc (x) proc (z) ((f (x x)) z) in proc (n) ((f (d d)) n) in let maketimes4 = proc (f) proc (x) if zero?(x) then 0 else -((f -(x, 1)), -(0, 4)) in let times4 = (makerec maketimes4) in (times4 3)") ================================================ FILE: scheme/eopl/03/26.scm ================================================ ; EOPL exercise 3.26 ; ; In our data-structure representation of procedures, we have kept the entire ; environment in the closure. But of course all we need are the bindings of ; the free variables. Modify the representation of procedures to retain only ; the free variables. (load-relative "cases/proc/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))))) ; The required optimization (define (free-variables expr bound) (remove-duplicates (let recur ((expr expr) (bound bound)) (cases expression expr (const-exp (num) '()) (var-exp (var) (if (memq var bound) '() (list var))) (diff-exp (minuend subtrahend) (append (recur minuend bound) (recur subtrahend bound))) (zero?-exp (arg) (recur arg bound)) (if-exp (predicate consequent alternative) (append (recur predicate bound) (recur consequent bound) (recur alternative bound))) (let-exp (var value-exp body) (append (recur value-exp bound) (recur body (cons var bound)))) (proc-exp (var body) (recur body (cons var bound))) (call-exp (rator rand) (append (recur rator bound) (recur rand bound))))))) (define (slice-env vars env) (filter (lambda (binding) (memq (car binding) vars)) env)) (define (make-procedure var body saved-env) (let* ((free-vars (free-variables body (list var))) (simpler-env (slice-env free-vars saved-env))) (procedure var body simpler-env))) ================================================ FILE: scheme/eopl/03/27.scm ================================================ ; EOPL exercise 3.27 ; ; Add a new kind of procedure called a traceproc to the language. A traceproc ; works exactly like a proc, except that it prints a trace message on entry ; and exit. (load-relative "cases/proc/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (traceproc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("traceproc" "(" identifier ")" expression) traceproc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?) (trace? boolean?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env trace?) (when trace? (printf "enter: ~a = ~v\n" var val)) (let ((result (value-of body (extend-env var val saved-env)))) (when trace? (printf "exit: ~a\n" var)) result)))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env #f))) (traceproc-exp (var body) (proc-val (procedure var body env #t))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))))) ================================================ FILE: scheme/eopl/03/28.scm ================================================ ; EOPL exercise 3.28 ; ; Dynamic binding (or dynamic scoping) is an alternative design for ; procedures, in which the procedure body is evaluated in an environment ; obtained by extending the environment at the point of call. For example, in ; ; let a = 3 ; in let p = proc (x) -(x, a) ; a = 5 ; in -(a, (p 2)) ; ; the a in the procedure body would be bound to 5, not 3. Modify the language ; to use dynamic binding. Do this twice, one using procedural representation ; for procedures, and once using a data-structure representation. ; I'll do it just once, with the existing (data-structure) representation. It ; is simple enough with the other one. (load-relative "cases/proc/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (var symbol?) (body expression?))) (define (apply-procedure proc1 val env) (cases proc proc1 (procedure (var body) (value-of body (extend-env var val env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg env))))) ================================================ FILE: scheme/eopl/03/29.scm ================================================ ; EOPL exercise 3.29 ; ; Unfortunatelly, programs that use dynamic binding may be exceptionally ; difficult to understand. For example, undex lexical binding, consistently ; renaming the bound variables of a procedure can never change the behavior of ; a program: we can even remove all variables and replace them by their ; lexical addresses, as in section 3.6. But under dynamic binding, this ; transformation is unsafe. ; ; For example, under dynamic binding, the procedure proc (z) a returns the ; value of the variable a in the caller's environment. Thus, the program ; ; let a = 3 ; in let p = proc (z) a ; in let f = proc (x) (p 0) ; in let a = 5 ; in (f 2) ; ; returns 5, since a's value at the call site is 5. What if f's formal ; parameter were a? ; It would return 2. The test demonstrates it. (load-relative "28.scm") (define the-hypothetical-program "let a = 3 in let p = proc (z) a in let f = proc (a) (p 0) in let a = 5 in (f 2)") ================================================ FILE: scheme/eopl/03/30.scm ================================================ ; EOPL exercise 3.30 ; ; What is the purpose of the call to proc-val on the next-to-last line of ; apply-env? ; It's a really simple question. Applying environments return expvals, not ; procedures. If there is no call to proc-val, then the procedure gets passed ; to expval->proc, which yields an error. ================================================ FILE: scheme/eopl/03/31.scm ================================================ ; EOPL exercise 3.31 ; ; Extend the language above to allow the declaration of a recursive procedure ; of possibly many arguments, as in exercise 3.21. ; The environment (define-datatype environment environment? (empty-env) (extend-env (var symbol?) (val expval?) (env environment?)) (extend-env-rec (p-name symbol?) (b-vars (list-of symbol?)) (body expression?) (env environment?))) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env search-var) (cases environment env (empty-env () (eopl:error 'apply-env "Variable not found: ~s" search-var)) (extend-env (saved-var saved-val saved-env) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var))) (extend-env-rec (p-name b-vars p-body saved-env) (if (eqv? search-var p-name) (proc-val (procedure b-vars p-body env)) (apply-env saved-env search-var))))) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var (list-of symbol?)) (body expression?)) (call-exp (rator expression?) (rand (list-of expression?))) (letrec-exp (p-name symbol?) (b-vars (list-of symbol?)) (p-body expression?) (letrec-body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" (separated-list identifier ",") ")" expression) proc-exp) (expression ("letrec" identifier "(" (separated-list identifier ",") ")" "=" expression "in" expression) letrec-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression (arbno expression) ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (vars (list-of symbol?)) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 vals) (cases proc proc1 (procedure (vars body saved-env) (value-of body (extend-env* vars vals saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (vars body) (proc-val (procedure vars body env))) (call-exp (rator rands) (let ((proc (expval->proc (value-of rator env))) (args (map (lambda (rand) (value-of rand env)) rands))) (apply-procedure proc args))) (letrec-exp (p-name b-vars p-body letrec-body) (value-of letrec-body (extend-env-rec p-name b-vars p-body env))))) ================================================ FILE: scheme/eopl/03/32.scm ================================================ ; EOPL exercise 3.32 ; ; Extend the language above to allow the declaration of any number of mutually ; recursive unary procedures, for example: ; ; letrec ; even(x) = if zero?(x) then 1 else (odd -(x, 1)) ; odd(x) = if zero?(x) then 0 else (even -(x, 1)) ; in (odd 13) ; The environment (define-datatype environment environment? (empty-env) (extend-env (var symbol?) (val expval?) (env environment?)) (extend-env-rec (p-name (list-of symbol?)) (b-var (list-of symbol?)) (body (list-of expression?)) (env environment?))) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env search-var) (cases environment env (empty-env () (eopl:error 'apply-env "Variable not found: ~s" search-var)) (extend-env (saved-var saved-val saved-env) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var))) (extend-env-rec (p-names b-vars p-bodies saved-env) (let recur ((p-names p-names) (b-vars b-vars) (p-bodies p-bodies)) (cond ((null? p-names) (apply-env saved-env search-var)) ((eqv? search-var (car p-names)) (proc-val (procedure (car b-vars) (car p-bodies) env))) (else (recur (cdr p-names) (cdr b-vars) (cdr p-bodies)))))))) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (letrec-exp (p-names (list-of symbol?)) (b-vars (list-of symbol?)) (p-bodies (list-of expression?)) (letrec-body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("letrec" (arbno identifier "(" identifier ")" "=" expression) "in" expression) letrec-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The Evaluator (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))) (letrec-exp (p-names b-vars p-bodies letrec-body) (value-of letrec-body (extend-env-rec p-names b-vars p-bodies env))))) ================================================ FILE: scheme/eopl/03/33.scm ================================================ ; EOPL exercise 3.33 ; ; Extend the language above to allow the declaration of any number of mutually ; recursive procedures, each of possibly many arguments, as in exercise 3.21. ; The environment (define-datatype environment environment? (empty-env) (extend-env (var symbol?) (val expval?) (env environment?)) (extend-env-rec (p-names (list-of symbol?)) (b-vars (list-of (list-of symbol?))) (body (list-of expression?)) (env environment?))) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env search-var) (cases environment env (empty-env () (eopl:error 'apply-env "Variable not found: ~s" search-var)) (extend-env (saved-var saved-val saved-env) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var))) (extend-env-rec (p-names b-sigs p-bodies saved-env) (let recur ((p-names p-names) (b-sigs b-sigs) (p-bodies p-bodies)) (cond ((null? p-names) (apply-env saved-env search-var)) ((eqv? search-var (car p-names)) (proc-val (procedure (car b-sigs) (car p-bodies) env))) (else (recur (cdr p-names) (cdr b-sigs) (cdr p-bodies)))))))) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (vars (list-of symbol?)) (body expression?)) (call-exp (rator expression?) (rands (list-of expression?))) (letrec-exp (p-names (list-of symbol?)) (b-vars (list-of (list-of symbol?))) (p-bodies (list-of expression?)) (letrec-body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" (separated-list identifier ",") ")" expression) proc-exp) (expression ("letrec" (arbno identifier "(" (separated-list identifier ",") ")" "=" expression) "in" expression) letrec-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression (arbno expression) ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The Evaluator (define-datatype proc proc? (procedure (vars (list-of symbol?)) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 vals) (cases proc proc1 (procedure (vars body saved-env) (value-of body (extend-env* vars vals saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (vars body) (proc-val (procedure vars body env))) (call-exp (rator rands) (let ((proc (expval->proc (value-of rator env))) (arg (map (lambda (rand) (value-of rand env)) rands))) (apply-procedure proc arg))) (letrec-exp (p-names b-vars p-bodies letrec-body) (value-of letrec-body (extend-env-rec p-names b-vars p-bodies env))))) ================================================ FILE: scheme/eopl/03/34.scm ================================================ ; EOPL exercise 3.34 ; ; Implement extend-env-rec in the procedural representation of environment ; from section 2.2.3. (load-relative "cases/letrec/parser.scm") (load-relative "cases/letrec/eval.scm") (define (environment? env) (procedure? env)) (define (empty-env) (lambda (search-var) (eopl:error 'apply-env "Variable not found: ~s" var))) (define (extend-env var val env) (lambda (search-var) (if (eqv? search-var var) val (env search-var)))) (define (extend-env-rec name var body env) (lambda (search-var) (if (eqv? search-var name) (proc-val (procedure var body (extend-env-rec name var body env))) (env search-var)))) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env search-var) (env search-var)) ================================================ FILE: scheme/eopl/03/35.scm ================================================ ; EOPL exercise 3.35 ; ; Thre representation we have seen so far are inefficient, becuase they build ; a new closure every time the procedure is retrieved. But the closure is the ; same every time. We can build the closures only once, by putting the value ; in a vector of length 1 and building an explicit circular structure, like: ; ; +------------+---+---+---+ ; | extend-env | . | . | o----> saved-env ; +------------+-|-+-|-+---+ ; ^ | | ; | V V ; | x +------------------------------------------------------------------------------------------+ ; | | +-----------+---+-----------------------------------------------------+---+ | ; | | proc-val | procedure | x | <> | . | | ; | | +-----------+---+-----------------------------------------------------+-|-+ | ; | +-------------------------------------------------------------------------------------|----+ ; | | ; +------------------------------------------------------------------------------------------------+ ; ; Here's the code to build the data structure. ; ; (define extend-env-rec ; (lambda (p-name b-var body saved-env) ; (let ((vec (make-vector 1))) ; (let ((new-env (extend-env p-name vec saved-env))) ; (vector-set! vec 0 (proc-val (procedure b-var body new-env))) ; new-env)))) ; ; Complete the implementation of this representation by modifying the ; definitions of the environment data type and apply-env accordingly. Be sure ; that apply-env alwasy returns an expressed value. (load-relative "cases/letrec/parser.scm") (load-relative "cases/letrec/eval.scm") (define environment? (or/c pair? null?)) (define (empty-env) '()) (define (extend-env var val env) (cons (list var val) env)) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (extend-env-rec p-name b-var body saved-env) (let* ((vec (make-vector 1)) (new-env (extend-env p-name vec saved-env))) (vector-set! vec 0 (proc-val (procedure b-var body new-env))) new-env)) (define (apply-env env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (let ((val (cadar env))) (if (vector? val) (vector-ref val 0) val))) (#t (apply-env (cdr env) var)))) ================================================ FILE: scheme/eopl/03/36.scm ================================================ ; EOPL exercise 3.36 ; ; Extend this implementation to handle the language from exercise 3.32. (define environment? (or/c pair? null?)) (define (empty-env) '()) (define (extend-env var val env) (cons (list var val) env)) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (extend-env-rec p-names b-vars bodies saved-env) (let* ((vecs (map (lambda (_) (make-vector 1)) p-names)) (new-env (foldl (lambda (p-name vec env) (extend-env p-name vec env)) saved-env p-names vecs))) (for-each (lambda (vec b-var body) (vector-set! vec 0 (proc-val (procedure b-var body new-env)))) vecs b-vars bodies) new-env)) (define (apply-env env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (let ((val (cadar env))) (if (vector? val) (vector-ref val 0) val))) (#t (apply-env (cdr env) var)))) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (letrec-exp (p-names (list-of symbol?)) (b-vars (list-of symbol?)) (p-bodies (list-of expression?)) (letrec-body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("letrec" (arbno identifier "(" identifier ")" "=" expression) "in" expression) letrec-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The Evaluator (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))) (letrec-exp (p-names b-vars p-bodies letrec-body) (value-of letrec-body (extend-env-rec p-names b-vars p-bodies env))))) ================================================ FILE: scheme/eopl/03/37.scm ================================================ ; EOPL exercise 3.37 ; ; With dynamic binding (exercise 3.28), recursive procedures may be bound by ; let; no special mechanism is necessary for recursion. This is of historical ; interest; in the early years of programming language design other approaches ; to recursion, such as those discussed in section 3.4, were not widely ; understood. To demonstrate recursion via dynamic binding, test the program ; ; let fact = proc (n) add(1) ; in let fact = proc (n) ; if zero?(n) ; then 1 ; else *(n, (fact -(n, 1))) ; in (fact 5) ; ; using both lexical and dynamic binding. Write the mutually recursive ; procedures even and odd as in section 3.4 in the defined language with ; dynamic binding. (load-relative "28.scm") (define the-program "let odd = proc (n) if zero?(n) then 0 else (even -(n, 1)) in let even = proc (n) if zero?(n) then 1 else (odd -(n, 1)) in (odd 11)") ================================================ FILE: scheme/eopl/03/38.scm ================================================ ; EOPL exercise 3.38 ; ; Extend the lexical address translator and interpreter to handle cond from ; exercise 3.12. (load-relative "cases/nameless/env.scm") ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-proc-exp (body expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?)))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv) (translation-of subtrahend senv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv) (translation-of consequent senv) (translation-of alternative senv))) (var-exp (var) (nameless-var-exp (apply-senv senv var))) (let-exp (var value-exp body) (nameless-let-exp (translation-of value-exp senv) (translation-of body (extend-senv var senv)))) (proc-exp (var body) (nameless-proc-exp (translation-of body (extend-senv var senv)))) (call-exp (rator rand) (call-exp (translation-of rator senv) (translation-of rand senv))) (cond-exp (conditions actions) (cond-exp (map (lambda (e) (translation-of e senv)) conditions) (map (lambda (e) (translation-of e senv)) actions))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (eval-cond conditions actions nenv) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) nenv)) (value-of (car actions) nenv)) (else (eval-cond (cdr conditions) (cdr actions) nenv)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-proc-exp (body) (proc-val (procedure body nenv))) (cond-exp (conditions actions) (eval-cond conditions actions nenv)) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ================================================ FILE: scheme/eopl/03/39.scm ================================================ ; EOPL exercise 3.39 ; ; Extend the lexical address translator and interpreter to handle pack and ; unpack from exercise 3.18. ; The environments (load-relative "cases/nameless/env.scm") (define (extend-senv* vars senv) (append vars senv)) (define (extend-nenv* vals nenv) (append vals nenv)) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-proc-exp (body expression?)) (cond-exp (conditions (list-of expression?)) (actions (list-of expression?))) (cons-exp (car expression?) (cdr expression?)) (car-exp (expr expression?)) (cdr-exp (expr expression?)) (null?-exp (expr expression?)) (emptylist-exp) (list-exp (exprs (list-of expression?))) (unpack-exp (names (list-of symbol?)) (lst expression?) (body expression?)) (nameless-unpack-exp (size integer?) (lst expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("cond" (arbno expression "==>" expression) "end") cond-exp) (expression ("cons" "(" expression "," expression ")") cons-exp) (expression ("car" "(" expression ")") car-exp) (expression ("cdr" "(" expression ")") cdr-exp) (expression ("null?" "(" expression ")") null?-exp) (expression ("emptylist") emptylist-exp) (expression ("list" "(" (separated-list expression ",") ")") list-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("unpack" (arbno identifier) "=" expression "in" expression) unpack-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (pair-val (car expval?) (cdr expval?)) (emptylist-val) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (expval->pair val) (cases expval val (emptylist-val () '()) (pair-val (car cdr) (cons car (expval->pair cdr))) (else (eopl:error 'expval->pair "Invalid pair: ~s" val)))) (define (pair-car val) (cases expval val (pair-val (car cdr) car) (else (eopl:error 'pair-car "Expected a pair: ~s" val)))) (define (pair-cdr val) (cases expval val (pair-val (car cdr) cdr) (else (eopl:error 'pair-cdr "Expected a pair: ~s" val)))) (define (emptylist? val) (cases expval val (emptylist-val () #t) (else #f))) (define (list-val pair) (if (null? pair) (emptylist-val) (pair-val (car pair) (list-val (cdr pair))))) (define (translation-of expr senv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv) (translation-of subtrahend senv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv) (translation-of consequent senv) (translation-of alternative senv))) (var-exp (var) (nameless-var-exp (apply-senv senv var))) (let-exp (var value-exp body) (nameless-let-exp (translation-of value-exp senv) (translation-of body (extend-senv var senv)))) (proc-exp (var body) (nameless-proc-exp (translation-of body (extend-senv var senv)))) (call-exp (rator rand) (call-exp (translation-of rator senv) (translation-of rand senv))) (cond-exp (conditions actions) (cond-exp (map (lambda (e) (translation-of e senv)) conditions) (map (lambda (e) (translation-of e senv)) actions))) (emptylist-exp () (emptylist-exp)) (null?-exp (arg) (null?-exp (translation-of arg senv))) (cons-exp (car cdr) (cons-exp (translation-of car senv) (translation-of cdr senv))) (car-exp (lst) (car-exp (translation-of lst senv))) (cdr-exp (lst) (cdr-exp (translation-of lst senv))) (list-exp (exprs) (list-exp (map (lambda (e) (translation-of e senv)) exprs))) (unpack-exp (vars lst body) (nameless-unpack-exp (length vars) (translation-of lst senv) (translation-of body (extend-senv* vars senv)))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (eval-cond conditions actions nenv) (cond ((null? conditions) (bool-val #f)) ((expval->bool (value-of (car conditions) nenv)) (value-of (car actions) nenv)) (else (eval-cond (cdr conditions) (cdr actions) nenv)))) (define (eval-unpack size list-exp body nenv) (let ((vals (expval->pair (value-of list-exp nenv)))) (if (eqv? (length vals) size) (value-of body (extend-nenv* vals nenv)) (eopl:error 'eval-unpack "Size mismatch: ~a ~a" size vals)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-proc-exp (body) (proc-val (procedure body nenv))) (cond-exp (conditions actions) (eval-cond conditions actions nenv)) (emptylist-exp () (emptylist-val)) (null?-exp (arg) (bool-val (emptylist? (value-of arg nenv)))) (cons-exp (car cdr) (pair-val (value-of car nenv) (value-of cdr nenv))) (car-exp (lst-exp) (pair-car (value-of lst-exp nenv))) (cdr-exp (lst-exp) (pair-cdr (value-of lst-exp nenv))) (list-exp (exprs) (list-val (map (curryr value-of nenv) exprs))) (nameless-unpack-exp (size lst body) (eval-unpack size lst body nenv)) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ================================================ FILE: scheme/eopl/03/40.scm ================================================ ; EOPL exercise 3.40 ; ; Extend the lexical address translator and interpreter to handle letrec. Do ; this by modifying the context argument of to translation-of so that it keeps ; track of not only the name of each bound variable, but also whether it was ; bound by letrec or not. For a reference to a variable that was bound by a ; letrec, generate a new kind of reference, called a nameless-letrec-var-exp. ; You can then continue to use the nameless environment representation above, ; and the interpreter can do the right thing with a nameless-letrec-var-exp. ; This is slightly awkward. I'm certain that I would have produced better ; results if I could tweak the nameless environment a little bit. ; ; The most annoying thing is that I need to box the procedure body into a ; proc, nested in a proc-val, so I can maintain the constraint on ; nameless-environment. ; The environment (define environment? (or/c pair? null?)) (define (empty-senv) '()) (define (extend-senv type var senv) (cons (list type var) senv)) (define (extend-senv-lambda var senv) (extend-senv 'lambda var senv)) (define (extend-senv-letrec var senv) (extend-senv 'letrec var senv)) (define (apply-senv senv var) (let recur ((index 0) (senv senv)) (cond ((null? senv) (eopl:error 'apply-senv "Unbound variable: ~a" var)) ((eqv? var (cadar senv)) (values (caar senv) index)) (else (recur (+ index 1) (cdr senv)))))) (define (nameless-environment? x) ((list-of expval?) x)) (define (empty-nameless-env) '()) (define (extend-nameless-env val nameless-env) (cons val nameless-env)) (define (apply-nameless-env nameless-env n) (list-ref nameless-env n)) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (letrec-exp (p-name symbol?) (b-var symbol?) (p-body expression?) (letrec-body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-letrec-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-letrec-exp (p-body expression?) (letrec-body expression?)) (nameless-proc-exp (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("letrec" identifier "(" identifier ")" "=" expression "in" expression) letrec-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv) (translation-of subtrahend senv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv) (translation-of consequent senv) (translation-of alternative senv))) (var-exp (var) (let-values (((type index) (apply-senv senv var))) (case type ((lambda) (nameless-var-exp index)) ((letrec) (nameless-letrec-var-exp index)) (else (eopl:error 'value-of "Unknown variable type: ~a" type))))) (let-exp (var value-exp body) (nameless-let-exp (translation-of value-exp senv) (translation-of body (extend-senv-lambda var senv)))) (letrec-exp (p-name b-var p-body letrec-body) (nameless-letrec-exp (translation-of p-body (extend-senv-lambda b-var (extend-senv-letrec p-name senv))) (translation-of letrec-body (extend-senv-letrec p-name senv)))) (proc-exp (var body) (nameless-proc-exp (translation-of body (extend-senv-lambda var senv)))) (call-exp (rator rand) (call-exp (translation-of rator senv) (translation-of rand senv))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-letrec-var-exp (n) (let* ((new-nenv (drop nenv n)) (proc-obj (expval->proc (car new-nenv)))) (cases proc proc-obj (procedure (body saved-env) (proc-val (procedure body new-nenv))) (else (eopl:error 'value-of "Expected a procedure"))))) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-letrec-exp (proc-body letrec-body) (let ((the-proc (proc-val (procedure proc-body nenv)))) (value-of letrec-body (extend-nameless-env the-proc nenv)))) (nameless-proc-exp (body) (proc-val (procedure body nenv))) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ================================================ FILE: scheme/eopl/03/41.scm ================================================ ; EOPL exercise 3.41 ; ; Modify the lexical address translator and interpreter to handle let ; expressions, procedures and procedure calls with multiple arguments, as in ; exercise 3.21. Do this using a nameless version of the ribcage ; representation of environments (exercise 2.11). For this representation, the ; lexical address will consist of two nonnegative integers: the lexical depth, ; to indicate the number of contours crossed, as before; and a position, to ; indicate the position of the variable in the declaration. ; The environments (define environment? (or/c pair? null?)) (define (empty-senv) '()) (define (extend-senv vars senv) (cons vars senv)) (define (apply-senv senv var) (let recur ((depth 0) (position 0) (frames (cdr senv)) (vars (car senv))) (cond ((and (null? vars) (null? frames)) (eopl:error 'apply-senv "Unbound variable: ~a" var)) ((null? vars) (recur (+ depth 1) 0 (cdr frames) (car frames))) ((eq? var (car vars)) (list depth position)) (else (recur depth (+ position 1) frames (cdr vars)))))) (define (nameless-environment? x) ((list-of (list-of expval?)) x)) (define (empty-nameless-env) '()) (define (extend-nameless-env vals nameless-env) (cons vals nameless-env)) (define (apply-nameless-env nameless-env depth position) (list-ref (list-ref nameless-env depth) position)) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (vars (list-of symbol?)) (vals (list-of expression?)) (body expression?)) (proc-exp (vars (list-of symbol?)) (body expression?)) (call-exp (rator expression?) (rands (list-of expression?))) (nameless-var-exp (depth integer?) (position integer?)) (nameless-let-exp (exps (list-of expression?)) (body expression?)) (nameless-proc-exp (arity integer?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" (arbno identifier) ")" expression) proc-exp) (expression ("let" (arbno identifier "=" expression) "in" expression) let-exp) (expression ("(" expression (arbno expression) ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (arity integer?) (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 vals) (cases proc proc1 (procedure (arity body saved-nameless-env) (if (= (length vals) arity) (value-of body (extend-nameless-env vals saved-nameless-env)) (eopl:error 'apply-procedure "Wrong arity"))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv) (translation-of subtrahend senv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv) (translation-of consequent senv) (translation-of alternative senv))) (var-exp (var) (apply nameless-var-exp (apply-senv senv var))) (let-exp (vars vals-exps body) (nameless-let-exp (map (curryr translation-of senv) vals-exps) (translation-of body (extend-senv vars senv)))) (proc-exp (vars body) (nameless-proc-exp (length vars) (translation-of body (extend-senv vars senv)))) (call-exp (rator rands) (call-exp (translation-of rator senv) (map (curryr translation-of senv) rands))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rands) (let ((proc (expval->proc (value-of rator nenv))) (args (map (curryr value-of nenv) rands))) (apply-procedure proc args))) (nameless-var-exp (depth position) (apply-nameless-env nenv depth position)) (nameless-let-exp (val-exps body) (let ((vals (map (curryr value-of nenv) val-exps))) (value-of body (extend-nameless-env vals nenv)))) (nameless-proc-exp (arity body) (proc-val (procedure arity body nenv))) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ================================================ FILE: scheme/eopl/03/42.scm ================================================ ; EOPL exercise 3.42 ; ; Modify the lexical address translator and intrepreter to used the trimmed ; representation of procedures from exercise 3.26. For this, you will need to ; translate the body of the procedure not (extend-senv var senv), but in a new ; static environment that tells exactly where each variable will be kept in ; the trimmed representation. ; The environment (define environment? (or/c pair? null?)) (define (empty-senv) '()) (define (extend-senv var senv) (cons var senv)) (define (apply-senv senv var) (cond ((null? senv) (eopl:error 'apply-senv "Unbound variable: ~a" var)) ((eqv? var (car senv)) 0) (else (+ 1 (apply-senv (cdr senv) var))))) (define (nameless-environment? x) ((list-of expval?) x)) (define (empty-nameless-env) '()) (define (extend-nameless-env val nameless-env) (cons val nameless-env)) (define (apply-nameless-env nameless-env n) (list-ref nameless-env n)) ; The parser (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-proc-exp (body expression?) (indices (list-of integer?)))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The interpreter (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv) (translation-of subtrahend senv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv) (translation-of consequent senv) (translation-of alternative senv))) (var-exp (var) (nameless-var-exp (apply-senv senv var))) (let-exp (var value-exp body) (nameless-let-exp (translation-of value-exp senv) (translation-of body (extend-senv var senv)))) (proc-exp (var body) (let* ((vars (free-variables body (list var))) (indices (map (curry position senv) vars))) (nameless-proc-exp (translation-of body (extend-senv var vars)) indices))) (call-exp (rator rand) (call-exp (translation-of rator senv) (translation-of rand senv))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-proc-exp (body indices) (proc-val (procedure body (slice-nenv nenv indices)))) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ; The new code (define (slice-nenv nenv indices) (map (curry apply-nameless-env nenv) indices)) (define (position lst elem) (cond ((null? lst) (eopl:error 'position "Empty list")) ((eqv? (car lst) elem) 0) (else (+ 1 (position (cdr lst) elem))))) (define (free-variables expr bound) (remove-duplicates (let recur ((expr expr) (bound bound)) (cases expression expr (const-exp (num) '()) (var-exp (var) (if (memq var bound) '() (list var))) (diff-exp (minuend subtrahend) (append (recur minuend bound) (recur subtrahend bound))) (zero?-exp (arg) (recur arg bound)) (if-exp (predicate consequent alternative) (append (recur predicate bound) (recur consequent bound) (recur alternative bound))) (let-exp (var value-exp body) (append (recur value-exp bound) (recur body (cons var bound)))) (proc-exp (var body) (recur body (cons var bound))) (call-exp (rator rand) (append (recur rator bound) (recur rand bound))) (else (eopl:error 'free-variables "Can't find variables in: ~a" expr)))))) ================================================ FILE: scheme/eopl/03/43.scm ================================================ ; EOPL exercise 3.43 ; ; The translator can do more than keep track of the names of variables. For ; example, consider the program: ; ; let x = 3 ; in let f = proc (y) -(y, x) ; in (f 13) ; ; Here we can tell statically that at the procedure call, f will be bound to a ; procedure whose body is -(y, x), where x has the same value that it had at ; the procedure-creation site. Therefore we could avoid looking up f in the ; environment entirely. Extend the translator to keep track of "known ; procedures" and generate code that avoids an environment lookup at the call ; of such a procedure. ; Let's start with a "known environment". It will store all values that can be ; statically determined. Whenever we have a call with an operator that can be ; determined via the known environment, we will translate it to a ; known-proc-call (which is a new variant in the expression datatype). (define (empty-kenv) '()) (define (apply-kenv kenv var) (let ((pair (assoc var kenv))) (if pair (cadr pair) (eopl:error 'apply-kenv "Unknown variable: ~a" var)))) (define (extend-kenv kenv var value) (cons (list var value) kenv)) (define (kenv-names kenv) (map car kenv)) ; The data type needs to be pulled up, because of, marcos (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-proc-exp (body expression?)) (known-proc-call (procedure expval?) (argument expression?))) ; Some functions to work with known environments (define (construct-nenv senv kenv) (map (curry apply-kenv kenv) senv)) (define (constant? expr kenv) (null? (free-variables expr (kenv-names kenv)))) (define (eval-const expr senv kenv) (value-of (translation-of expr senv (empty-kenv)) (construct-nenv senv kenv))) (define (known-procedure-ref kenv expr) (cases expression expr (var-exp (name) (let ((pair (assoc name kenv))) (if pair (cadr pair) #f))) (else #f))) ; The environment (define environment? (or/c pair? null?)) (define (empty-senv) '()) (define (extend-senv var senv) (cons var senv)) (define (apply-senv senv var) (cond ((null? senv) (eopl:error 'apply-senv "Unbound variable: ~a" var)) ((eqv? var (car senv)) 0) (else (+ 1 (apply-senv (cdr senv) var))))) (define (nameless-environment? x) ((list-of expval?) x)) (define (empty-nameless-env) '()) (define (extend-nameless-env val nameless-env) (cons val nameless-env)) (define (apply-nameless-env nameless-env n) (list-ref nameless-env n)) ; The parser (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv kenv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv kenv) (translation-of subtrahend senv kenv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv kenv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv kenv) (translation-of consequent senv kenv) (translation-of alternative senv kenv))) (var-exp (var) (nameless-var-exp (apply-senv senv var))) (let-exp (var value-exp body) (nameless-let-exp (translation-of value-exp senv kenv) (translation-of body (extend-senv var senv) (if (constant? value-exp kenv) (extend-kenv kenv var (eval-const value-exp senv kenv)) kenv)))) (proc-exp (var body) (nameless-proc-exp (translation-of body (extend-senv var senv) kenv))) (call-exp (rator rand) (let ((proc (known-procedure-ref kenv rator))) (if proc (known-proc-call proc (translation-of rand senv kenv)) (call-exp (translation-of rator senv kenv) (translation-of rand senv kenv))))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-proc-exp (body) (proc-val (procedure body nenv))) (known-proc-call (proc rand) (apply-procedure (expval->proc proc) (value-of rand nenv))) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ; Free-variables (define (free-variables expr bound) (remove-duplicates (let recur ((expr expr) (bound bound)) (cases expression expr (const-exp (num) '()) (var-exp (var) (if (memq var bound) '() (list var))) (diff-exp (minuend subtrahend) (append (recur minuend bound) (recur subtrahend bound))) (zero?-exp (arg) (recur arg bound)) (if-exp (predicate consequent alternative) (append (recur predicate bound) (recur consequent bound) (recur alternative bound))) (let-exp (var value-exp body) (append (recur value-exp bound) (recur body (cons var bound)))) (proc-exp (var body) (recur body (cons var bound))) (call-exp (rator rand) (append (recur rator bound) (recur rand bound))) (else (eopl:error 'free-variables "Can't find variables in: ~a" expr)))))) ================================================ FILE: scheme/eopl/03/44.scm ================================================ ; EOPL exercise 3.44 ; ; In the preceding example, the only use of f is as a known procedure. ; Therefore the procedure built by the expression proc (y) -(y, x) is never ; used. Modify the translator so that such a procedure is never constructred. ; We base this on the previous exercise. We just need to modify how let treats ; its value-exp. If value-exp is a procedure and the var is used only in ; operator position within the let body, then instead of translating the right ; side of the let, we put a sentinel value (unused-proc-exp) in there. ; We can, of course, interpret the exercise as having to inline the procedure, ; but I don't want to go as far. ; The known environment (define (empty-kenv) '()) (define (apply-kenv kenv var) (let ((pair (assoc var kenv))) (if pair (cadr pair) (eopl:error 'apply-kenv "Unknown variable: ~a" var)))) (define (kenv-defines? kenv var) (if (assoc var kenv) #t #f)) (define (extend-kenv kenv var value) (cons (list var value) kenv)) (define (kenv-names kenv) (map car kenv)) ; The data type needs to be pulled up, because of, marcos (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-proc-exp (body expression?)) (known-proc-exp (procedure expval?)) (known-proc-call-exp (procedure expval?) (argument expression?)) (unused-proc-exp)) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) ; Some functions to work with known environments (define (construct-nenv senv kenv) (map (curry apply-kenv kenv) senv)) (define (constant? expr kenv) (null? (free-variables expr (kenv-names kenv)))) (define (eval-const expr senv kenv) (value-of (translation-of expr senv (empty-kenv)) (construct-nenv senv kenv))) (define (known-procedure-ref kenv expr) (cases expression expr (var-exp (name) (let ((pair (assoc name kenv))) (if pair (cadr pair) #f))) (else #f))) ; The new code (define (var-exp? expr) (cases expression expr (var-exp (name) #t) (else #f))) (define (proc-val? val) (cases expval val (proc-val (proc) #t) (else #f))) (define (procedure-safe-to-remove? body var kenv) (and (kenv-defines? kenv var) (proc-val? (apply-kenv kenv var)) (used-only-as-operator? body var))) (define (used-only-as-operator? expr var) (cases expression expr (const-exp (num) #t) (var-exp (name) (not (eqv? var name))) (diff-exp (minuend subtrahend) (and (used-only-as-operator? minuend var) (used-only-as-operator? subtrahend var))) (zero?-exp (arg) (used-only-as-operator? arg var)) (if-exp (predicate consequent alternative) (and (used-only-as-operator? predicate var) (used-only-as-operator? consequent var) (used-only-as-operator? alternative var))) (let-exp (let-name value-exp body) (and (used-only-as-operator? value-exp var) (or (eqv? let-name var) (used-only-as-operator? value-exp var)))) (proc-exp (param body) (or (eqv? param var) (used-only-as-operator? body var))) (call-exp (rator rand) (and (or (var-exp? rator) (used-only-as-operator? rator var)) (used-only-as-operator? rand var))) (else (eopl:error 'used-only-as-operator? "Unexpected expression: ~a" expr)))) ; The environment (define environment? (or/c pair? null?)) (define (empty-senv) '()) (define (extend-senv var senv) (cons var senv)) (define (apply-senv senv var) (cond ((null? senv) (eopl:error 'apply-senv "Unbound variable: ~a" var)) ((eqv? var (car senv)) 0) (else (+ 1 (apply-senv (cdr senv) var))))) (define (nameless-environment? x) ((list-of expval?) x)) (define (empty-nameless-env) '()) (define (extend-nameless-env val nameless-env) (cons val nameless-env)) (define (apply-nameless-env nameless-env n) (list-ref nameless-env n)) ; The parser (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ; The evaluator (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv kenv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv kenv) (translation-of subtrahend senv kenv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv kenv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv kenv) (translation-of consequent senv kenv) (translation-of alternative senv kenv))) (var-exp (var) (nameless-var-exp (apply-senv senv var))) (let-exp (var value-exp body) (if (constant? value-exp kenv) (let* ((value (eval-const value-exp senv kenv)) (body-kenv (extend-kenv kenv var value)) (body-senv (extend-senv var senv))) (nameless-let-exp (if (procedure-safe-to-remove? body var body-kenv) (unused-proc-exp) (known-proc-exp value)) (translation-of body body-senv body-kenv))) (nameless-let-exp (translation-of value-exp senv kenv) (translation-of body (extend-senv var senv) kenv)))) (proc-exp (var body) (nameless-proc-exp (translation-of body (extend-senv var senv) kenv))) (call-exp (rator rand) (let ((proc (known-procedure-ref kenv rator))) (if proc (known-proc-call-exp proc (translation-of rand senv kenv)) (call-exp (translation-of rator senv kenv) (translation-of rand senv kenv))))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-proc-exp (body) (proc-val (procedure body nenv))) (known-proc-exp (proc) proc) (known-proc-call-exp (proc rand) (apply-procedure (expval->proc proc) (value-of rand nenv))) (unused-proc-exp () 'unused-procedure) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ; Free-variables (define (free-variables expr bound) (remove-duplicates (let recur ((expr expr) (bound bound)) (cases expression expr (const-exp (num) '()) (var-exp (var) (if (memq var bound) '() (list var))) (diff-exp (minuend subtrahend) (append (recur minuend bound) (recur subtrahend bound))) (zero?-exp (arg) (recur arg bound)) (if-exp (predicate consequent alternative) (append (recur predicate bound) (recur consequent bound) (recur alternative bound))) (let-exp (var value-exp body) (append (recur value-exp bound) (recur body (cons var bound)))) (proc-exp (var body) (recur body (cons var bound))) (call-exp (rator rand) (append (recur rator bound) (recur rand bound))) (else (eopl:error 'free-variables "Can't find variables in: ~a" expr)))))) ================================================ FILE: scheme/eopl/03/cases/let/all.scm ================================================ (require eopl) (load-relative "parser.scm") (load-relative "env.scm") (load-relative "eval.scm") ================================================ FILE: scheme/eopl/03/cases/let/env.scm ================================================ (define (empty-env) '()) (define (extend-env var val env) (cons (list var val) env)) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (cadar env)) (#t (apply-env (cdr env) var)))) ================================================ FILE: scheme/eopl/03/cases/let/eval.scm ================================================ (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))))) ================================================ FILE: scheme/eopl/03/cases/let/parser.scm ================================================ (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("let" identifier "=" expression "in" expression) let-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ================================================ FILE: scheme/eopl/03/cases/let/test-helpers.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool)))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/03/cases/let/tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "all.scm") (load-relative "test-helpers.scm") (define let-language-tests (test-suite "Tests for the LET language" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests let-language-tests)) ================================================ FILE: scheme/eopl/03/cases/letrec/all.scm ================================================ (require eopl) (load-relative "parser.scm") (load-relative "env.scm") (load-relative "eval.scm") ================================================ FILE: scheme/eopl/03/cases/letrec/env.scm ================================================ (define-datatype environment environment? (empty-env) (extend-env (var symbol?) (val expval?) (env environment?)) (extend-env-rec (p-name symbol?) (b-var symbol?) (body expression?) (env environment?))) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env search-var) (cases environment env (empty-env () (eopl:error 'apply-env "Variable not found: ~s" search-var)) (extend-env (saved-var saved-val saved-env) (if (eqv? search-var saved-var) saved-val (apply-env saved-env search-var))) (extend-env-rec (p-name b-var p-body saved-env) (if (eqv? search-var p-name) (proc-val (procedure b-var p-body env)) (apply-env saved-env search-var))))) ================================================ FILE: scheme/eopl/03/cases/letrec/eval.scm ================================================ (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))) (letrec-exp (p-name b-var p-body letrec-body) (value-of letrec-body (extend-env-rec p-name b-var p-body env))))) ================================================ FILE: scheme/eopl/03/cases/letrec/parser.scm ================================================ (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (letrec-exp (p-name symbol?) (b-var symbol?) (p-body expression?) (letrec-body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("letrec" identifier "(" identifier ")" "=" expression "in" expression) letrec-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ================================================ FILE: scheme/eopl/03/cases/letrec/test-helpers.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc)))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/03/cases/letrec/tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "all.scm") (load-relative "test-helpers.scm") (define letrec-language-tests (test-suite "Tests for the LETREC language" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "letrec double(x) = if zero?(x) then 0 else -((double -(x, 1)), -(0, 2)) in (double 6)") 12) )) (exit (run-tests letrec-language-tests)) ================================================ FILE: scheme/eopl/03/cases/nameless/all.scm ================================================ (require eopl) (load-relative "../../../support/eopl.scm") (load-relative "parser.scm") (load-relative "env.scm") (load-relative "eval.scm") ================================================ FILE: scheme/eopl/03/cases/nameless/env.scm ================================================ (define environment? (or/c pair? null?)) (define (empty-senv) '()) (define (extend-senv var senv) (cons var senv)) (define (apply-senv senv var) (cond ((null? senv) (eopl:error 'apply-senv "Unbound variable: ~a" var)) ((eqv? var (car senv)) 0) (else (+ 1 (apply-senv (cdr senv) var))))) (define (nameless-environment? x) ((list-of expval?) x)) (define (empty-nameless-env) '()) (define (extend-nameless-env val nameless-env) (cons val nameless-env)) (define (apply-nameless-env nameless-env n) (list-ref nameless-env n)) ================================================ FILE: scheme/eopl/03/cases/nameless/eval.scm ================================================ (define-datatype proc proc? (procedure (body expression?) (saved-nameless-env nameless-environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (body saved-nameless-env) (value-of body (extend-nameless-env val saved-nameless-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (translation-of expr senv) (cases expression expr (const-exp (num) (const-exp num)) (diff-exp (minuend subtrahend) (diff-exp (translation-of minuend senv) (translation-of subtrahend senv))) (zero?-exp (arg) (zero?-exp (translation-of arg senv))) (if-exp (predicate consequent alternative) (if-exp (translation-of predicate senv) (translation-of consequent senv) (translation-of alternative senv))) (var-exp (var) (nameless-var-exp (apply-senv senv var))) (let-exp (var value-exp body) (nameless-let-exp (translation-of value-exp senv) (translation-of body (extend-senv var senv)))) (proc-exp (var body) (nameless-proc-exp (translation-of body (extend-senv var senv)))) (call-exp (rator rand) (call-exp (translation-of rator senv) (translation-of rand senv))) (else (eopl:error 'translation-of "Cannot translate ~a" expr)))) (define (value-of expr nenv) (cases expression expr (const-exp (num) (num-val num)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend nenv)) (subtrahend-val (value-of subtrahend nenv))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg nenv))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate nenv))) (if (expval->bool value) (value-of consequent nenv) (value-of alternative nenv)))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator nenv))) (arg (value-of rand nenv))) (apply-procedure proc arg))) (nameless-var-exp (n) (apply-nameless-env nenv n)) (nameless-let-exp (value-exp body) (let ((val (value-of value-exp nenv))) (value-of body (extend-nameless-env val nenv)))) (nameless-proc-exp (body) (proc-val (procedure body nenv))) (else (eopl:error 'value-of "Cannot evaluate ~a" expr)))) ================================================ FILE: scheme/eopl/03/cases/nameless/parser.scm ================================================ (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (nameless-var-exp (num integer?)) (nameless-let-exp (exp1 expression?) (body expression?)) (nameless-proc-exp (body expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ================================================ FILE: scheme/eopl/03/cases/nameless/test-helpers.scm ================================================ (define (run code) (eval* code (empty-nameless-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (expr (translation-of expr (empty-senv))) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc)))) ================================================ FILE: scheme/eopl/03/cases/nameless/tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "all.scm") (load-relative "test-helpers.scm") (define nameless-interpreter-tests (test-suite "Tests for the nameless interpreter" (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) )) (exit (run-tests nameless-interpreter-tests)) ================================================ FILE: scheme/eopl/03/cases/proc/all.scm ================================================ (require eopl) (load-relative "parser.scm") (load-relative "env.scm") (load-relative "eval.scm") ================================================ FILE: scheme/eopl/03/cases/proc/env.scm ================================================ (define environment? (or/c pair? null?)) (define (empty-env) '()) (define (extend-env var val env) (cons (list var val) env)) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (cadar env)) (#t (apply-env (cdr env) var)))) ================================================ FILE: scheme/eopl/03/cases/proc/eval.scm ================================================ (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))))) ================================================ FILE: scheme/eopl/03/cases/proc/parser.scm ================================================ (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ================================================ FILE: scheme/eopl/03/cases/proc/test-helpers.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc)))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/03/cases/proc/tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "all.scm") (load-relative "test-helpers.scm") (define proc-language-tests (test-suite "Tests for the PROC language" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) )) (exit (run-tests proc-language-tests)) ================================================ FILE: scheme/eopl/03/tests/06-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../06.scm") (load-relative "helpers/let.scm") (define eopl-3.06-tests (test-suite "Tests for EOPL exercise 3.06" (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.06-tests)) ================================================ FILE: scheme/eopl/03/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../07.scm") (load-relative "helpers/let.scm") (define eopl-3.07-tests (test-suite "Tests for EOPL exercise 3.07" (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.07-tests)) ================================================ FILE: scheme/eopl/03/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../08.scm") (load-relative "helpers/let.scm") (define eopl-3.08-tests (test-suite "Tests for EOPL exercise 3.08" (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.08-tests)) ================================================ FILE: scheme/eopl/03/tests/09-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../09.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.09-tests (test-suite "Tests for EOPL exercise 3.09" (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.09-tests)) ================================================ FILE: scheme/eopl/03/tests/10-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../10.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.10-tests (test-suite "Tests for EOPL exercise 3.10" (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.10-tests)) ================================================ FILE: scheme/eopl/03/tests/11-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../11.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool))) (define (schemeval->expval val) (cond ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.11-tests (test-suite "Tests for EOPL exercise 3.11" (check-equal? (run "+(1, +(2, 3))") 6) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.11-tests)) ================================================ FILE: scheme/eopl/03/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../12.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.12-tests (test-suite "Tests for EOPL exercise 3.12" (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.12-tests)) ================================================ FILE: scheme/eopl/03/tests/13-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../13.scm") (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) result)) (define (env vars vals) (extend-env* vars vals (empty-env))) (define eopl-3.13-tests (test-suite "Tests for EOPL exercise 3.13" (check-equal? (run "cond zero?(0) ==> 1 zero?(1) ==> 2 zero?(1) ==> 3 end") 1) (check-equal? (run "cond zero?(1) ==> 1 zero?(0) ==> 2 zero?(1) ==> 3 end") 2) (check-equal? (run "cond zero?(1) ==> 1 zero?(1) ==> 2 zero?(0) ==> 3 end") 3) (check-equal? (run "cond zero?(1) ==> 1 zero?(1) ==> 2 zero?(1) ==> 3 end") 0) (check-equal? (run "equal?(1, 1)") 1) (check-equal? (run "equal?(1, 2)") 0) (check-equal? (run "less?(1, 2)") 1) (check-equal? (run "less?(1, 1)") 0) (check-equal? (run "less?(1, 0)") 0) (check-equal? (run "greater?(1, 0)") 1) (check-equal? (run "greater?(1, 1)") 0) (check-equal? (run "greater?(1, 2)") 0) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") 1) (check-equal? (run "zero?(1)") 0) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.13-tests)) ================================================ FILE: scheme/eopl/03/tests/14-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../14.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.14-tests (test-suite "Tests for EOPL exercise 3.14" (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-equal? (run "if null?(emptylist) then 1 else 0") 1) (check-equal? (run "if null?(cons(1, 2)) then 1 else 0") 0) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-equal? (run "if equal?(1, 1) then 1 else 0") 1) (check-equal? (run "if equal?(1, 2) then 1 else 0") 0) (check-equal? (run "if less?(1, 2) then 1 else 0") 1) (check-equal? (run "if less?(1, 1) then 1 else 0") 0) (check-equal? (run "if less?(1, 0) then 1 else 0") 0) (check-equal? (run "if greater?(1, 0) then 1 else 0") 1) (check-equal? (run "if greater?(1, 1) then 1 else 0") 0) (check-equal? (run "if greater?(1, 2) then 1 else 0") 0) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "if zero?(0) then 1 else 0") 1) (check-equal? (run "if zero?(3) then 1 else 0") 0) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.14-tests)) ================================================ FILE: scheme/eopl/03/tests/15-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../15.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.15-tests (test-suite "Tests for EOPL exercise 3.15" (check-equal? (with-output-to-string (lambda () (run "print 42"))) "42") (check-equal? (with-output-to-string (lambda () (run "print zero?(1)"))) "#f") (check-equal? (with-output-to-string (lambda () (run "print emptylist"))) "emptylist") (check-equal? (with-output-to-string (lambda () (run "print cons(1, emptylist)"))) "cons(1, emptylist)") (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.15-tests)) ================================================ FILE: scheme/eopl/03/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../16.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.16-tests (test-suite "Tests for EOPL exercise 3.16" (check-equal? (run "let x = 10 y = 20 in +(x, y)") 30) (check-equal? (with-output-to-string (lambda () (run "print 42"))) "42") (check-equal? (with-output-to-string (lambda () (run "print zero?(1)"))) "#f") (check-equal? (with-output-to-string (lambda () (run "print emptylist"))) "emptylist") (check-equal? (with-output-to-string (lambda () (run "print cons(1, emptylist)"))) "cons(1, emptylist)") (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.16-tests)) ================================================ FILE: scheme/eopl/03/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../17.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.17-tests (test-suite "Tests for EOPL exercise 3.17" (check-equal? (run "let x = 30 in let* x = -(x, 1) y = -(x, 2) in -(x, y)") 2) (check-equal? (run "let x = 10 y = 20 in +(x, y)") 30) (check-equal? (with-output-to-string (lambda () (run "print 42"))) "42") (check-equal? (with-output-to-string (lambda () (run "print zero?(1)"))) "#f") (check-equal? (with-output-to-string (lambda () (run "print emptylist"))) "emptylist") (check-equal? (with-output-to-string (lambda () (run "print cons(1, emptylist)"))) "cons(1, emptylist)") (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.17-tests)) ================================================ FILE: scheme/eopl/03/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../18.scm") (define (run code) (eval* code (empty-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define (schemeval->expval val) (cond ((null? val) (emptylist-val)) ((pair? val) (pair-val (schemeval->expval (car val)) (schemeval->expval (cdr val)))) ((number? val) (num-val val)) ((boolean? val) (bool-val val)) (else (error 'schemeval->expval "Don't know how to convert ~s" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (expval->schemeval result))) (define (env vars vals) (extend-env* vars (map schemeval->expval vals) (empty-env))) (define eopl-3.18-tests (test-suite "Tests for EOPL exercise 3.18" (check-equal? (run "let u = 7 in unpack x y = cons(u, cons(3, emptylist)) in -(x, y)") 4) (check-equal? (run "let x = 30 in let* x = -(x, 1) y = -(x, 2) in -(x, y)") 2) (check-equal? (run "let x = 10 y = 20 in +(x, y)") 30) (check-equal? (with-output-to-string (lambda () (run "print 42"))) "42") (check-equal? (with-output-to-string (lambda () (run "print zero?(1)"))) "#f") (check-equal? (with-output-to-string (lambda () (run "print emptylist"))) "emptylist") (check-equal? (with-output-to-string (lambda () (run "print cons(1, emptylist)"))) "cons(1, emptylist)") (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-true (run "equal?(1, 1)")) (check-false (run "equal?(1, 2)")) (check-true (run "less?(1, 2)")) (check-false (run "less?(1, 1)")) (check-false (run "less?(1, 0)")) (check-true (run "greater?(1, 0)")) (check-false (run "greater?(1, 1)")) (check-false (run "greater?(1, 2)")) (check-equal? (run "+(4, 5)") 9) (check-equal? (run "*(7, 4)") 28) (check-equal? (run "/(10, 3)") 3) (check-equal? (run "minus(-(minus(5), 9))") 14) (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) )) (exit (run-tests eopl-3.18-tests)) ================================================ FILE: scheme/eopl/03/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../19.scm") (load-relative "helpers/proc.scm") (define eopl-3.19-tests (test-suite "Tests for EOPL exercise 3.19" (check-equal? (run "letproc dec (x) = -(x, 1) in (dec 2)") 1) (check-equal? (run "let a = 10 in letproc augment (x) = -(x, a) in let a = 20 in (augment a)") 10) )) (exit (run-tests eopl-3.19-tests)) ================================================ FILE: scheme/eopl/03/tests/20-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../20.scm") (load-relative "helpers/proc.scm") (define eopl-3.20-tests (test-suite "Tests for EOPL exercise 3.20" (check-equal? (run two-plus-three) 5) )) (exit (run-tests eopl-3.20-tests)) ================================================ FILE: scheme/eopl/03/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../21.scm") (load-relative "helpers/proc.scm") (define eopl-3.21-tests (test-suite "Tests for EOPL exercise 3.21" (check-equal? (run "let one = proc () 1 in (one)") 1) (check-equal? (run "let minus = proc (x, y) -(x, y) in (minus 7 2)") 5) )) (exit (run-tests eopl-3.21-tests)) ================================================ FILE: scheme/eopl/03/tests/22-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../22.scm") (load-relative "helpers/proc.scm") (define eopl-3.22-tests (test-suite "Tests for EOPL exercise 3.22" (check-equal? (run "let add = proc (x, y) -(x, -(0, y)) in add(2, 3)") 5) )) (exit (run-tests eopl-3.22-tests)) ================================================ FILE: scheme/eopl/03/tests/23-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../23.scm") (load-relative "helpers/proc.scm") (define eopl-3.23-tests (test-suite "Tests for EOPL exercise 3.23" (check-equal? (run the-given-program) 12) (check-equal? (run factorial-5-program) 120) )) (exit (run-tests eopl-3.23-tests)) ================================================ FILE: scheme/eopl/03/tests/24-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../24.scm") (load-relative "helpers/proc.scm") (define eopl-3.24-tests (test-suite "Tests for EOPL exercise 3.24" (check-equal? (run the-program) 0) )) (exit (run-tests eopl-3.24-tests)) ================================================ FILE: scheme/eopl/03/tests/25-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../25.scm") (load-relative "helpers/proc.scm") (define eopl-3.25-tests (test-suite "Tests for EOPL exercise 3.25" (check-equal? (run the-example-program) 12) )) (exit (run-tests eopl-3.25-tests)) ================================================ FILE: scheme/eopl/03/tests/26-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../26.scm") (load-relative "helpers/proc.scm") (define (free-vars code) (free-variables (scan&parse code) '())) (define eopl-3.26-tests (test-suite "Tests for EOPL exercise 3.26" (test-suite "Free-variables" (check-equal? (free-vars "zero?(a)") '(a)) (check-equal? (free-vars "if a then b else c") '(a b c)) (check-equal? (free-vars "let a = b in -(a, c)") '(b c)) (check-equal? (free-vars "proc (x) -(a, x)") '(a)) (check-equal? (free-vars "(a b)") '(a b)) (check-equal? (free-vars "proc (x) proc (y) (y x)") '())) (test-suite "Simplifying environments" (check-equal? (slice-env '(b c) '((a 1) (b 2) (c 3) (d 4))) '((b 2) (c 3))) (check-equal? (slice-env '(c b) '((a 1) (b 2) (c 3) (d 4))) '((b 2) (c 3)))) (test-suite "The evaluator" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100)) )) (exit (run-tests eopl-3.26-tests)) ================================================ FILE: scheme/eopl/03/tests/27-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../27.scm") (load-relative "helpers/proc.scm") (define (result-of code) (parameterize ((current-output-port (open-output-string))) (run code))) (define (output-of code) (with-output-to-string (lambda () (run code)))) (define eopl-3.27-tests (test-suite "Tests for EOPL exercise 3.27" (check-equal? (output-of "let f = traceproc(x) x in let g = traceproc(y) (f -(y, 1)) in (g 7)") (string-join '("enter: y = (num-val 7)" "enter: x = (num-val 6)" "exit: x" "exit: y" "") "\n")) (check-equal? (result-of "let f = traceproc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (result-of "(traceproc (f) (f (f 77)) traceproc (x) -(x, 11))") 55) (check-equal? (result-of "let x = 200 in let f = traceproc (z) -(z, x) in let x = 100 in let g = traceproc (z) -(z, x) in -((f 1), (g 1))") -100) )) (exit (run-tests eopl-3.27-tests)) ================================================ FILE: scheme/eopl/03/tests/28-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../28.scm") (load-relative "helpers/proc.scm") (define eopl-3.28-tests (test-suite "Tests for EOPL exercise 3.28" (check-equal? (run "let a = 3 in let p = proc (x) -(x, a) in let a = 5 in -(a, (p 2))") 8))) (exit (run-tests eopl-3.28-tests)) ================================================ FILE: scheme/eopl/03/tests/29-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../29.scm") (load-relative "helpers/proc.scm") (define eopl-3.29-tests (test-suite "Tests for EOPL exercise 3.29" (check-equal? (run the-hypothetical-program) 2) )) (exit (run-tests eopl-3.29-tests)) ================================================ FILE: scheme/eopl/03/tests/31-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../31.scm") (load-relative "helpers/letrec.scm") (define eopl-3.31-tests (test-suite "Tests for EOPL exercise 3.31" (check-equal? (run "let one = proc () 1 in (one)") 1) (check-equal? (run "let minus = proc (x, y) -(x, y) in (minus 7 2)") 5) (check-equal? (run "letrec double(x) = if zero?(x) then 0 else -((double -(x, 1)), -(0, 2)) in (double 6)") 12) (check-equal? (run "let fib = proc (n) letrec iter(n, a, b) = if zero?(-(n, 1)) then a else (iter -(n, 1) -(a, -(0, b)) a) in (iter n 1 0) in (fib 10)") 55) )) (exit (run-tests eopl-3.31-tests)) ================================================ FILE: scheme/eopl/03/tests/32-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../32.scm") (load-relative "helpers/letrec.scm") (define eopl-3.32-tests (test-suite "Tests for EOPL exercise 3.32" (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) odd(x) = if zero?(x) then 0 else (even -(x, 1)) in (odd 13)") 1) )) (exit (run-tests eopl-3.32-tests)) ================================================ FILE: scheme/eopl/03/tests/33-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../33.scm") (load-relative "helpers/letrec.scm") (define eopl-3.33-tests (test-suite "Tests for EOPL exercise 3.33" (check-equal? (run "letrec even(x, t, f) = if zero?(x) then t else (odd -(x, 1) t f) odd(x, t, f) = if zero?(x) then f else (even -(x, 1) t f) in (odd 13 101 100)") 101) )) (exit (run-tests eopl-3.33-tests)) ================================================ FILE: scheme/eopl/03/tests/34-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../34.scm") (load-relative "helpers/letrec.scm") (define eopl-3.34-tests (test-suite "Tests for EOPL exercise 3.34" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "letrec double(x) = if zero?(x) then 0 else -((double -(x, 1)), -(0, 2)) in (double 6)") 12) )) (exit (run-tests eopl-3.34-tests)) ================================================ FILE: scheme/eopl/03/tests/35-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../35.scm") (load-relative "helpers/letrec.scm") (define eopl-3.35-tests (test-suite "Tests for EOPL exercise 3.35" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "letrec double(x) = if zero?(x) then 0 else -((double -(x, 1)), -(0, 2)) in (double 6)") 12) )) (exit (run-tests eopl-3.35-tests)) ================================================ FILE: scheme/eopl/03/tests/36-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../36.scm") (load-relative "helpers/letrec.scm") (define eopl-3.36-tests (test-suite "Tests for EOPL exercise 3.36" (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) odd(x) = if zero?(x) then 0 else (even -(x, 1)) in (odd 13)") 1) )) (exit (run-tests eopl-3.36-tests)) ================================================ FILE: scheme/eopl/03/tests/37-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../37.scm") (load-relative "helpers/proc.scm") (define eopl-3.37-tests (test-suite "Tests for EOPL exercise 3.37" (check-equal? (run the-program) 1) )) (exit (run-tests eopl-3.37-tests)) ================================================ FILE: scheme/eopl/03/tests/38-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../38.scm") (load-relative "helpers/nameless.scm") (define eopl-3.38-tests (test-suite "Tests for EOPL exercise 3.38" (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(0) ==> one zero?(1) ==> two zero?(1) ==> three end") 1) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(0) ==> two zero?(1) ==> three end") 2) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(1) ==> two zero?(0) ==> three end") 3) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(zero) ==> two zero?(1) ==> three end") 2) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(1) ==> two zero?(1) ==> three end") #f) (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) )) (exit (run-tests eopl-3.38-tests)) ================================================ FILE: scheme/eopl/03/tests/39-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../39.scm") (load-relative "helpers/nameless.scm") (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc) (emptylist-val () '()) (pair-val (car cdr) (cons (expval->schemeval car) (expval->schemeval cdr))))) (define eopl-3.39-tests (test-suite "Tests for EOPL exercise 3.39" (check-equal? (run "let u = 7 in unpack x y = cons(u, cons(3, emptylist)) in -(x, y)") 4) (check-equal? (run "let u = 7 in unpack x y z = list(u, 3, 42) in -(x, y)") 4) (check-equal? (run "list(1)") '(1)) (check-equal? (run "list(1, 2, 3)") '(1 2 3)) (check-equal? (run "let x = 4 in list(x, -(x, 1), -(x, 3))") '(4 3 1)) (check-equal? (run "emptylist") '()) (check-equal? (run "cons(1, 2)") '(1 . 2)) (check-equal? (run "car(cons(1, 2))") 1) (check-equal? (run "cdr(cons(1, 2))") 2) (check-true (run "null?(emptylist)")) (check-false (run "null?(cons(1, 2))")) (check-equal? (run "let x = 4 in cons(x, cons(cons(-(x, 1), emptylist), emptylist))") '(4 (3))) (check-equal? (run "cond zero?(0) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") 0) (check-equal? (run "cond zero?(1) ==> 0 zero?(0) ==> 1 zero?(1) ==> 2 end") 1) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(0) ==> 2 end") 2) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "cond zero?(1) ==> 0 zero?(1) ==> 1 zero?(1) ==> 2 end") #f) (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(0) ==> one zero?(1) ==> two zero?(1) ==> three end") 1) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(0) ==> two zero?(1) ==> three end") 2) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(1) ==> two zero?(0) ==> three end") 3) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(zero) ==> two zero?(1) ==> three end") 2) (check-equal? (run "let zero = 0 in let one = 1 in let two = 2 in let three = 3 in cond zero?(1) ==> one zero?(1) ==> two zero?(1) ==> three end") #f) )) (exit (run-tests eopl-3.39-tests)) ================================================ FILE: scheme/eopl/03/tests/40-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../40.scm") (load-relative "helpers/nameless.scm") (define eopl-3.40-tests (test-suite "Tests for EOPL exercise 3.40" (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "letrec double(x) = if zero?(x) then 0 else -((double -(x, 1)), -(0, 2)) in (double 6)") 12) (check-equal? (run "letrec double(x) = let one = 1 in let two = 2 in if zero?(x) then 0 else -((double -(x, one)), -(0, two)) in (double 6)") 12) )) (exit (run-tests eopl-3.40-tests)) ================================================ FILE: scheme/eopl/03/tests/41-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../41.scm") (load-relative "helpers/nameless.scm") (define eopl-3.41-tests (test-suite "Tests for EOPL exercise 3.41" (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "let one = 1 six = 6 in -(six, one)") 5) (check-equal? (run "let one = proc () 1 in (one)") 1) (check-equal? (run "let minus = proc (x y) -(x, y) in (minus 7 2)") 5) )) (exit (run-tests eopl-3.41-tests)) ================================================ FILE: scheme/eopl/03/tests/42-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../42.scm") (load-relative "helpers/nameless.scm") (define eopl-3.42-tests (test-suite "Tests for EOPL exercise 3.42" (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) )) (exit (run-tests eopl-3.42-tests)) ================================================ FILE: scheme/eopl/03/tests/43-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../43.scm") (load-relative "helpers/nameless.scm") (define (eval* code env) (let* ((expr (scan&parse code)) (expr (translation-of expr (empty-senv) (empty-kenv))) (result (value-of expr env))) (expval->schemeval result))) (define eopl-3.43-tests (test-suite "Tests for EOPL exercise 3.43" (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "let x = 3 in let f = proc (y) -(y, x) in (f 13)") 10) (check-equal? (run "let apply10 = proc (y) (y 10) in let minus1 = proc (y) -(y, 1) in (apply10 minus1)") 9) )) (exit (run-tests eopl-3.43-tests)) ================================================ FILE: scheme/eopl/03/tests/44-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../44.scm") (load-relative "helpers/nameless.scm") (define (eval* code env) (let* ((expr (scan&parse code)) (expr (translation-of expr (empty-senv) (empty-kenv))) (result (value-of expr env))) (expval->schemeval result))) (define eopl-3.44-tests (test-suite "Tests for EOPL exercise 3.44" (check-equal? (run "42") 42) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "let x = 3 in let f = proc (y) -(y, x) in (f 13)") 10) (check-equal? (run "let apply10 = proc (y) (y 10) in let minus1 = proc (y) -(y, 1) in (apply10 minus1)") 9) (check-equal? (run "let minus1 = let f = proc (x) -(x, 1) in f in (minus1 10)") 9) )) (exit (run-tests eopl-3.44-tests)) ================================================ FILE: scheme/eopl/03/tests/helpers/let.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool)))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/03/tests/helpers/letrec.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc)))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/03/tests/helpers/nameless.scm ================================================ (define (run code) (eval* code (empty-nameless-env))) (define (expval->schemeval val) (cases expval val (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc) (else (eopl:error 'eval* "Don't know how to handle expval ~a" val)))) (define (eval* code env) (let* ((expr (scan&parse code)) (expr (translation-of expr (empty-senv))) (result (value-of expr env))) (expval->schemeval result))) ================================================ FILE: scheme/eopl/03/tests/helpers/proc.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc)))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/04/01.scm ================================================ ; EOPL exercise 4.01 ; What would have happened had the program been instead ; ; let g = proc (dummy) ; let counter = newref (0) ; in begin ; setref(counter, -(deref(counter), -1)); ; deref(counter) ; end ; in let a = (g 11) ; in let b = (g 11) ; in -(a, b) ; Each invocation of g will create a new location in memory, initialize it to ; 0, increment it and return it. The result of the whole program will be 0. ================================================ FILE: scheme/eopl/04/02.scm ================================================ ; EOPL exercise 4.02 ; Write down the specification for a zero?-exp ; (value-of exp₁ ρ σ₀) = (val₁, σ₁) ; ------------------------------- ; (value-of (zero?-exp val₁) ρ σ₀) ; = { ((bool-val #t), σ₁) if (expval->num val₁) = 0 ; { ((bool-val #f), σ₁) if (expval->num val₁) ≠ 0 ================================================ FILE: scheme/eopl/04/03.scm ================================================ ; EOPL exercise 4.03 ; Write down the specification for a call-exp ; (value-of exp₁ ρ σ₀) = (val₁, σ₁) ; (value-of exp₂ ρ σ₁) = (val₂, σ₂) ; (apply val₁ val₂ σ₂) = (val₃, σ₃) ; ------------------------------------------------- ; (value-of (call-exp exp₁ exp₂) ρ σ₀) = (val₃, σ₃) ================================================ FILE: scheme/eopl/04/04.scm ================================================ ; EOPL exercise 4.04 ; ; Write down the specification for a begin expression. ; ; Expression ::= begin Expression {; Expression}* end ; ; A begin expression may contain one or more subexpressions separated by ; semicolons. These are evaluated in order and the value of the last is ; returned. ; (value-of exp₁ ρ σ₀) = (val₁, σ₁) ; (value-of exp₂ ρ σ₁) = (val₂, σ₂) ; ... ; (value-of expᵢ ρ σ{i-1}) = (valᵢ, σᵢ) ; ─────────────────────────────────────────────────────── ; (value-of (begin exp₁ exp₂ ... expᵢ) ρ σ₀) = (valᵢ, σᵢ) ================================================ FILE: scheme/eopl/04/05.scm ================================================ ; EOPL exercise 4.05 ; ; Write down the specification for list (exercise 3.10). ; (value-of exp₁ ρ σ₀) = (val₁, σ₁) ; (value-of exp₂ ρ σ₁) = (val₂, σ₂) ; ... ; (value-of expᵢ ρ σ{i-1}) = (valᵢ, σᵢ) ; ────────────────────────────────────────────────────────────────────── ; (value-of (list exp₁ exp₂ ... expᵢ) ρ σ₀) = ([val₁ val₂ ... valᵢ], σᵢ) ================================================ FILE: scheme/eopl/04/06.scm ================================================ ; EOPL exercise 4.06 ; ; Modify the rule given above so that setref-exp returns the value of the ; right-hand side. ; (value-of exp₁ ρ σ₀) = (l, σ₁) ; (value-of exp₂ ρ σ₁) = (val, σ₂) ; ───────────────────────────────────────────────────────── ; (value-of (setref-exp exp₁ exp₂) ρ σ₀) = (val, [l=val]σ₂) ================================================ FILE: scheme/eopl/04/07.scm ================================================ ; EOPL exercise 4.07 ; ; Modify the rule given above so that setref-exp returns the old contents of ; the location. ; (value-of exp₁ ρ σ₀) = (l, σ₁) ; (value-of exp₂ ρ σ₁) = (val, σ₂) ; ────────────────────────────────────────────────────────── ; (value-of (setref-exp exp₁ exp₂) ρ σ₀) = (σ₁(l), [l=val]σ₂) ================================================ FILE: scheme/eopl/04/08.scm ================================================ ; EOPL exercise 4.08 ; ; Show exactly where in our implementation of the store these operations take ; linear time rather than constant time. ; In newref, calculating the next reference takes linear time. Furthermore, ; appending a new element to a list is also linear, since append needs to copy ; the list. (define (newref val) (let ((next-ref (length the-store))) ; length is linear to the-store (set! the-store (append the-store (list val))) ; append is linear to the-store next-ref)) ; When dereferencing, scanning the list with list-ref is also linear (define (deref ref) (list-ref the-store ref)) ; Finally, setref! needs to construct a new list with one element changed. ; Since the element can be the last element in the array, this operation is ; also linear. (define (setref! ref val) (set! the-store (let recur ((store1 the-store) (ref1 ref)) (cond ((null? store1) (eopl:error 'setref! "Invalid reference ~s in ~s" ref the-store)) ((zero? ref1) (cons val (cdr store1))) (else (cons (car store1) (recur (cdr store1) (- ref1 1)))))))) ================================================ FILE: scheme/eopl/04/cases/explicit-refs/all.scm ================================================ (load-relative "../../../support/eopl.scm") (load-relative "parser.scm") (load-relative "env.scm") (load-relative "eval.scm") ================================================ FILE: scheme/eopl/04/cases/explicit-refs/env.scm ================================================ (define environment? (or/c pair? null?)) (define (empty-env) '()) (define (extend-env var val env) (cons (list var val) env)) (define (extend-env* vars vals env) (if (null? vars) env (extend-env* (cdr vars) (cdr vals) (extend-env (car vars) (car vals) env)))) (define (apply-env env var) (cond ((null? env) (eopl:error 'apply-env "Variable not found")) ((eqv? (caar env) var) (cadar env)) (#t (apply-env (cdr env) var)))) ================================================ FILE: scheme/eopl/04/cases/explicit-refs/eval.scm ================================================ (define-datatype proc proc? (procedure (var symbol?) (body expression?) (saved-env environment?))) (define (apply-procedure proc1 val) (cases proc proc1 (procedure (var body saved-env) (value-of body (extend-env var val saved-env))))) (define-datatype expval expval? (num-val (num number?)) (bool-val (bool boolean?)) (proc-val (proc proc?)) (ref-val (ref integer?))) (define (expval->num val) (cases expval val (num-val (num) num) (else (eopl:error 'expval->num "Invalid number: ~s" val)))) (define (expval->bool val) (cases expval val (bool-val (bool) bool) (else (eopl:error 'expval->bool "Invalid boolean: ~s" val)))) (define (expval->proc val) (cases expval val (proc-val (proc) proc) (else (eopl:error 'expval->proc "Invalid procedure: ~s" val)))) (define (expval->ref val) (cases expval val (ref-val (num) num) (else (eopl:error 'expval->ref "Invalid reference ~s" val)))) (define (value-of expr env) (cases expression expr (const-exp (num) (num-val num)) (var-exp (var) (apply-env env var)) (diff-exp (minuend subtrahend) (let ((minuend-val (value-of minuend env)) (subtrahend-val (value-of subtrahend env))) (let ((minuend-num (expval->num minuend-val)) (subtrahend-num (expval->num subtrahend-val))) (num-val (- minuend-num subtrahend-num))))) (zero?-exp (arg) (let ((value (value-of arg env))) (let ((number (expval->num value))) (if (zero? number) (bool-val #t) (bool-val #f))))) (if-exp (predicate consequent alternative) (let ((value (value-of predicate env))) (if (expval->bool value) (value-of consequent env) (value-of alternative env)))) (let-exp (var value-exp body) (let ((value (value-of value-exp env))) (value-of body (extend-env var value env)))) (proc-exp (var body) (proc-val (procedure var body env))) (call-exp (rator rand) (let ((proc (expval->proc (value-of rator env))) (arg (value-of rand env))) (apply-procedure proc arg))) (begin-exp (body) (let* ((first (car body)) (rest (cdr body)) (value (value-of first env))) (if (null? rest) value (value-of (begin-exp rest) env)))) (newref-exp (arg) (ref-val (newref (value-of arg env)))) (deref-exp (arg) (deref (expval->ref (value-of arg env)))) (setref-exp (ref-exp value-exp) (let ((ref (value-of ref-exp env))) (let ((value (value-of value-exp env))) (setref! (expval->ref ref) value) (num-val 42)))))) ; The store (define the-store 'uninitialized) (define (empty-store) '()) (define (get-store) the-store) (define (initialize-store!) (set! the-store (empty-store))) (define (reference? v) (integer? v)) (define (newref val) (let ((next-ref (length the-store))) (set! the-store (append the-store (list val))) next-ref)) (define (deref ref) (list-ref the-store ref)) (define (setref! ref val) (set! the-store (let recur ((store1 the-store) (ref1 ref)) (cond ((null? store1) (eopl:error 'setref! "Invalid reference ~s in ~s" ref the-store)) ((zero? ref1) (cons val (cdr store1))) (else (cons (car store1) (recur (cdr store1) (- ref1 1)))))))) ================================================ FILE: scheme/eopl/04/cases/explicit-refs/parser.scm ================================================ (define-datatype expression expression? (const-exp (num number?)) (diff-exp (minuend expression?) (subtrahend expression?)) (zero?-exp (expr expression?)) (if-exp (predicate expression?) (consequent expression?) (alternative expression?)) (var-exp (var symbol?)) (let-exp (var symbol?) (value expression?) (body expression?)) (proc-exp (var symbol?) (body expression?)) (call-exp (rator expression?) (rand expression?)) (begin-exp (body (list-of expression?))) (newref-exp (value expression?)) (setref-exp (target expression?) (value expression?)) (deref-exp (target expression?))) (define scanner-spec '((white-sp (whitespace) skip) (comment ("%" (arbno (not #\newline))) skip) (identifier (letter (arbno (or letter digit))) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (number) const-exp) (expression ("-" "(" expression "," expression ")") diff-exp) (expression ("zero?" "(" expression ")") zero?-exp) (expression ("if" expression "then" expression "else" expression) if-exp) (expression (identifier) var-exp) (expression ("proc" "(" identifier ")" expression) proc-exp) (expression ("newref" "(" expression ")") newref-exp) (expression ("setref" "(" expression "," expression ")") setref-exp) (expression ("deref" "(" expression ")") deref-exp) (expression ("let" identifier "=" expression "in" expression) let-exp) (expression ("begin" (separated-list expression ";") "end") begin-exp) (expression ("(" expression expression ")") call-exp))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ================================================ FILE: scheme/eopl/04/cases/explicit-refs/test-helpers.scm ================================================ (define (run code) (eval* code (empty-env))) (define (eval* code env) (let* ((expr (scan&parse code)) (result (value-of expr env))) (cases expval result (num-val (num) num) (bool-val (bool) bool) (proc-val (proc) proc) (ref-val (num) (format "" num))))) (define (env vars vals) (extend-env* vars (map (lambda (val) (if (boolean? val) (bool-val val) (num-val val))) vals) (empty-env))) ================================================ FILE: scheme/eopl/04/cases/explicit-refs/tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "all.scm") (load-relative "test-helpers.scm") (define explicit-refs-language-tests (test-suite "Tests for the EXPLICIT-REFS language" (check-equal? (run "42") 42) (check-equal? (eval* "x" (env '(x) '(10))) 10) (check-equal? (eval* "-(x, 7)" (env '(x) '(10))) 3) (check-equal? (run "% Comment\n 1") 1) (check-equal? (run "zero?(0)") #t) (check-equal? (run "zero?(1)") #f) (check-equal? (run "if zero?(0) then 1 else 2") 1) (check-equal? (run "if zero?(3) then 1 else 2") 2) (check-equal? (run "let x = 1 in x") 1) (check-equal? (run "let x = 1 in let x = 2 in x") 2) (check-equal? (run "let x = 1 in let y = 2 in x") 1) (check-equal? (run "let x = 7 % This is a comment in let y = 2 % This is another comment in let y = let x = -(x, 1) in -(x, y) in -(-(x, 8),y)") -5) (check-equal? (run "let f = proc (x) -(x, 11) in (f (f 77))") 55) (check-equal? (run "(proc (f) (f (f 77)) proc (x) -(x, 11))") 55) (check-equal? (run "let x = 200 in let f = proc (z) -(z, x) in let x = 100 in let g = proc (z) -(z, x) in -((f 1), (g 1))") -100) (check-equal? (run "begin 1; 2 end") 2) (initialize-store!) (check-equal? (run "let g = let counter = newref(0) in proc (dummy) begin setref(counter, -(deref(counter), -(0, 1))); deref(counter) end in let a = (g 11) in let b = (g 11) in -(a, b)") -1) )) (exit (run-tests explicit-refs-language-tests)) ================================================ FILE: scheme/eopl/B/01.scm ================================================ ; EOPL exercise B.01 ; ; The following grammar for ordinary arithmetic expressions builds in the ; usual precendence in the usual rules for arithmetic operations: ; ; Arith-expr ::= Arith-term {Additive-op Arith-term}* ; Arith-term ::= Arith-factor {Multiplicative-op Arith-factor}* ; Arith-factor ::= Number ; ::= (Arith-expr) ; Additive-op ::= + | - ; Multiplicative-op ::= * | / ; ; This grammar says that every arithmetic expression is the sum of a non-empty ; sequence of terms; every term is the product of a non-empty sequence of ; factors; and every factor is either a constant or a parenthesized ; expression. ; ; Write a lexical specification and a grammar in SLLGEN that will scan and ; parse strings according to this grammar. Verify that this grammar handles ; precendence correctly, so that, for example 3+2*66-5 gets grouped correctly, ; as 3 + (2 × 66) - 5. (define scanner-spec '((white-sp (whitespace) skip) (additive-op ((or "+" "-")) symbol) (multiplicative-op ((or "*" "/")) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (term (arbno additive-op term)) op) (term (factor (arbno multiplicative-op factor)) op) (factor (number) number) (factor ("(" expression ")") factor))) (define-datatype ast ast? (op (first-operand ast?) (operators (list-of symbol?)) (rest-operands (list-of ast?))) (factor (value ast?)) (number (value integer?))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) ================================================ FILE: scheme/eopl/B/02.scm ================================================ ; EOPL exercise B.02 ; ; Why can't the grammar above be written with separated-list? ; There are at least a few reasons. For one, it would allow empty expressions ; which is something we don't want. Second, the separator needs to be a ; terminal, otherwise SLLGEN just chokes. We can rewrite it if we introduce ; add-exp, sub-exp, mul-exp and div-exp. ================================================ FILE: scheme/eopl/B/03.scm ================================================ ; EOPL exercise B.03 ; ; Define an interpreter that takes the syntax tree produced by the parser of ; exercise B.1 and evaluates it as an arithmetic expression. The parser takes ; care of the usual arithmetic precendence operations, but the interpreter ; will have to take care of associativity, that is, making sure that the ; operations at the same precendence level (e.g. additions and subtractions) ; are performed from left to right. Since there are no variables in these ; expressions, this interpreter need not take an environment parameter. (load-relative "01.scm") (define (eval* tree) (cases ast tree (op (first ops rest) (apply-ops (eval* first) ops (map eval* rest))) (number (val) val) (factor (expr) (eval* expr)))) (define (apply-ops first ops rest) (if (null? ops) first (apply-ops ((eval (car ops)) first (car rest)) (cdr ops) (cdr rest)))) (define (value-of code) ((compose eval* scan&parse) code)) ================================================ FILE: scheme/eopl/B/04.scm ================================================ ; EOPL exercise B.04 ; ; Extend the language and interpreter of the preceding exercise to include ; variables. This new interpreter will require an environment parameter. (define scanner-spec '((white-sp (whitespace) skip) (identifier (letter (arbno (or letter digit))) symbol) (additive-op ((or "+" "-")) symbol) (multiplicative-op ((or "*" "/")) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (term (arbno additive-op term)) op) (term (factor (arbno multiplicative-op factor)) op) (factor (number) number) (factor (identifier) ref) (factor ("(" expression ")") factor))) (define-datatype ast ast? (op (first-operand ast?) (operators (list-of symbol?)) (rest-operands (list-of ast?))) (factor (value ast?)) (ref (name symbol?)) (number (value integer?))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) (define (eval* tree env) (cases ast tree (op (first ops rest) (apply-ops (eval* first env) ops (map (curryr eval* env) rest))) (number (val) val) (ref (var) (lookup var env)) (factor (expr) (eval* expr env)))) (define (apply-ops first ops rest) (if (null? ops) first (apply-ops ((eval (car ops)) first (car rest)) (cdr ops) (cdr rest)))) (define (lookup var env) (cond ((null? env) (eopl:error 'lookup "Variable not found: ~s" var)) ((eqv? var (caar env)) (cadar env)) (else (lookup var (cdr env))))) (define (value-of code env) (eval* (scan&parse code) env)) ================================================ FILE: scheme/eopl/B/05.scm ================================================ ; EOPL exercise B.05 ; ; Add unary minus to the language and interpreter, so that inputs like 3*-2 ; are handled correctly. (define scanner-spec '((white-sp (whitespace) skip) (identifier (letter (arbno (or letter digit))) symbol) (additive-op ((or "+" "-")) symbol) (multiplicative-op ((or "*" "/")) symbol) (number (digit (arbno digit)) number))) (define grammar '((expression (term (arbno additive-op term)) op) (term (factor (arbno multiplicative-op factor)) op) (factor (number) number) (factor (identifier) ref) (factor ("-" factor) neg) (factor ("(" expression ")") factor))) (define-datatype ast ast? (op (first-operand ast?) (operators (list-of symbol?)) (rest-operands (list-of ast?))) (factor (value ast?)) (neg (value ast?)) (ref (name symbol?)) (number (value integer?))) (define scan&parse (sllgen:make-string-parser scanner-spec grammar)) (define (eval* tree env) (cases ast tree (op (first ops rest) (apply-ops (eval* first env) ops (map (curryr eval* env) rest))) (number (val) val) (ref (var) (lookup var env)) (neg (expr) (- (eval* expr env))) (factor (expr) (eval* expr env)))) (define (apply-ops first ops rest) (if (null? ops) first (apply-ops ((eval (car ops)) first (car rest)) (cdr ops) (cdr rest)))) (define (lookup var env) (cond ((null? env) (eopl:error 'lookup "Variable not found: ~s" var)) ((eqv? var (caar env)) (cadar env)) (else (lookup var (cdr env))))) (define (value-of code env) (eval* (scan&parse code) env)) ================================================ FILE: scheme/eopl/B/tests/01-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../01.scm") (define eopl-B.01-tests (test-suite "Tests for EOPL exercise B.01" (check-equal? (scan&parse "3 + 2 * 66 - 5") (op (op (number 3) '() '()) '(+ -) (list (op (number 2) '(*) (list (number 66))) (op (number 5) '() '())))) )) (exit (run-tests eopl-B.01-tests)) ================================================ FILE: scheme/eopl/B/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../03.scm") (define eopl-B.03-tests (test-suite "Tests for EOPL exercise B.03" (check-equal? (value-of "1 + 2") 3) (check-equal? (value-of "3 - 2") 1) (check-equal? (value-of "3 - 2 - 1") 0) (check-equal? (value-of "3 - 2 - 1 + 7") 7) (check-equal? (value-of "3 * 4 / 2 * 5") 30) (check-equal? (value-of "3 * 4 / 2 * 5 + 1") 31) )) (exit (run-tests eopl-B.03-tests)) ================================================ FILE: scheme/eopl/B/tests/04-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../04.scm") (define eopl-B.04-tests (test-suite "Tests for EOPL exercise B.04" (check-equal? (value-of "1 + x" '((x 1))) 2) (check-equal? (value-of "x * y + z" '((x 2) (y 3) (z 5))) 11) (check-equal? (value-of "x * (y + z)" '((x 2) (y 3) (z 5))) 16) )) (exit (run-tests eopl-B.04-tests)) ================================================ FILE: scheme/eopl/B/tests/05-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "../05.scm") (define eopl-B.05-tests (test-suite "Tests for EOPL exercise B.05" (check-equal? (value-of "-1" '()) -1) (check-equal? (value-of "3*-2" '()) -6) (check-equal? (value-of "-(x + y)" '((x 2) (y 3))) -5) )) (exit (run-tests eopl-B.05-tests)) ================================================ FILE: scheme/eopl/Gemfile ================================================ source :rubygems gem 'guard' gem 'guard-shell' gem 'thor' gem 'term-ansicolor' gem 'rb-fsevent', require: false gem 'rb-inotify', require: false ================================================ FILE: scheme/eopl/Guardfile ================================================ interactor :off guard :shell do watch(%r{^(\d+|B)/(\d+).scm$}) { |m| system "clear && thor run exercise #{m[1]} #{m[2]}" } watch(%r{^(\d+|B)/tests/(\d+)-tests.scm$}) { |m| system "clear && thor run exercise #{m[1]} #{m[2]}" } watch(%r{^(\d+)/cases/(\w+)/[^/]+.scm$}) { |m| system "clear && racket -r #{m[1]}/cases/#{m[2]}/tests.scm" } end ================================================ FILE: scheme/eopl/Thorfile ================================================ require './build/exercise' require 'term/ansicolor' class Default < Thor include Thor::Actions def self.source_root File.dirname(__FILE__) end method_option :chapter, type: :numeric, desc: 'The chapter number' method_option :number, type: :numeric, desc: 'The exercise number' option :skip_test, type: :boolean, desc: 'Skip generating a test case' desc :exercise, 'Generates an exercise and a test' def exercise(chapter, number) exercise = Exercise.new chapter, number config = { name: exercise.name, exercise_require_path: exercise.exercise_require_path } template 'build/templates/exercise.scm', exercise.file_path, config unless options[:skip_test] template 'build/templates/test.scm', exercise.test_path, config end end desc :next, 'Generates the next exercise' option :skip_test, type: :boolean, desc: 'Skip generating a test case' def next exercise = Exercise.next invoke :exercise, [exercise.chapter, exercise.number], options system "mvim --remote-silent #{exercise.file_path}" system "mvim --remote-tab-silent #{exercise.test_path}" if exercise.has_test? exec 'guard' end end class Run < Thor include Term::ANSIColor desc :exercise, 'Runs an exercise or its tests' method_option :chapter, type: :numeric, desc: 'The chapter number' method_option :number, type: :numeric, desc: 'The exercise number' def exercise(chapter, number) exercise = Exercise.new chapter, number if exercise.has_test? system "racket -r #{exercise.test_path}" else system "racket -r #{exercise.file_path}" end end desc :test, 'Runs the tests of an exercise' method_option :chapter, type: :numeric, desc: 'The chapter number' method_option :number, type: :numeric, desc: 'The exercise number' def test(chapter, number) exercise = Exercise.new chapter, number system "racket -r #{exercise.test_path}" end desc :all, 'Runs all the tests' def all Exercise.each_with_test do |exercise| print bold("#{exercise.name}: ") success = system "racket -r #{exercise.test_path}" unless success puts red("FAILURE AT #{exercise.name}") exit(1) unless success end end puts green("OK") end end ================================================ FILE: scheme/eopl/build/exercise.rb ================================================ class Exercise attr_reader :chapter, :number def initialize(chapter, number) @chapter = case chapter when Integer then chapter when /^\d+$/ then chapter.to_i when /^B$/ then 'B' else raise "Invalid chapter: #{chapter}" end @number = number.to_i end class << self def next current_chapter = chapters(false).last last_exercise = exercises_in_chapter(current_chapter).last next_exercise = last_exercise.to_i + 1 new current_chapter, next_exercise end def each chapters.each do |chapter| exercises_in_chapter(chapter).each do |number| yield new chapter, number end end end def each_with_test each do |exercise| next unless exercise.has_test? yield exercise end end private def chapters(include_appendices = true) chapters = Dir['*'].grep(/^(\d+|B)$/) chapters -= %w[A B] unless include_appendices chapters.sort end def exercises_in_chapter(chapter) Dir["#{chapter}/*"].grep(%r{^(?:\d+|B)/(\d+).scm$}) { $1 }.sort end end def name "%s.%02d" % [@chapter, @number] end def file_path "%s/%02d.scm" % [formatted_chapter, @number] end def test_path "%s/tests/%02d-tests.scm" % [formatted_chapter, @number] end def exercise_require_path "../%02d.scm" % @number end def has_test? File.exist? test_path end private def formatted_chapter case @chapter when Integer then "%02d" % @chapter else @chapter end end end ================================================ FILE: scheme/eopl/build/templates/exercise.scm ================================================ ; EOPL exercise <%= config[:name] %> ================================================ FILE: scheme/eopl/build/templates/test.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "../../support/eopl.scm") (load-relative "<%= config[:exercise_require_path] %>") (define eopl-<%= config[:name] %>-tests (test-suite "Tests for EOPL exercise <%= config[:name] %>" )) (exit (run-tests eopl-<%= config[:name] %>-tests)) ================================================ FILE: scheme/eopl/notes/week-01.markdown ================================================ # Week 1 (2013-01-01 - 2013-01-06) ## The `let*` pattern I just love using `let*` like in the solution of exercise 1.35: (let* ((node-data (contents-of tree)) (lson-result (traverse (lson tree) counter)) (counter-after-lson (car lson-result)) (result-lson (cdr lson-result)) (rson-result (traverse (rson tree) counter-after-lson)) (result-counter (car rson-result)) (result-rson (cdr rson-result)) (result-tree (interior-node node-data result-lson result-rson))) (cons result-counter result-tree)))) It builds long computation, giving names to the intermediate values involved. In this particular computation, the algorithm might not be as clear as it would if I use a procedure to determine the count in the last node of lson, but it is still a great way to write it. I end up doing that quite often in JavaScript, where I would have code like this: var oldBag = $('div[data-bag]'), newBag = $(response), sizeError = $('#size-required'), title = newBag.find('.title'), contents = newBag.find('.contents'); I find this very readable, because all the right-hand sides of the assignment are short and use specific names defined earlier. It makes me focus on the code (instead of quickly scanning it), but I still find it very useful. ## Multiple levels of interface I love this idea of multiple levels of interface that can be seen in exercise 2.03. There are four levels of abstraction. 1. The constructors and the observers that are a very thin wrap over the representation. 2. `minuend` and `subtrahend` that work with the previous layer to provide an uniform view of the two possible representations in the grammar. 3. The four operations for numbers that use minuend and subtrahend. Note that they also can be viewed as an interface implementation. 4. Operations built ontop of those four procedures like `plus`. In an object-oriented language, all those layers are easily lost since they end up being in the same class. ================================================ FILE: scheme/eopl/notes/week-02.markdown ================================================ # Week 2 (2013-01-06 - 2013-01-13) Nothing noteworthy this week. SLLGEN was fun, but it is kinda simplistic. ================================================ FILE: scheme/eopl/notes/week-03.markdown ================================================ # Week 3 (2013-05-19 - 2013-05-25) I dropped the book for quite a while. Now I am picking it up again. This is not really the third week, but I will consider it so for the record keeping. ## Recursion without the Y-combinator Exercises 3.23 - 3.25 show recursion in a language that can only bind variables with `let`. I knew that you can use the Y-combinator to accomoplish this, but I was not aware that there was a way to write a recursive function without it. ## Recursion with dynamic binding It appears that recursion with dynamic binding is pretty straightforward - the interpreter did not need any modification in order to run. ================================================ FILE: scheme/eopl/support/eopl.scm ================================================ (require eopl) ================================================ FILE: scheme/sicp/.gitignore ================================================ .rvmrc ================================================ FILE: scheme/sicp/01/01.scm ================================================ ; SICP exercise 1.01 ; ; Below is a sequence of expressions. What is the result printed by the ; interpreter in response to each expression? Assume that the sequence is to be ; evaluated in the order in which it is presented ; 10 10 ; (+ 5 3 4) 12 ; (- 9 1) 8 ; (/ 6 2) 3 ; (+ (* 2 4) (- 4 6)) 6 ; (define a 3) ; (define b (+ a 1)) ; (+ a b (* a b)) 19 ; (= a b) #t ; (if (and (> b a) (< b (* a b))) ; b ; a) 4 ; (cond ((= a 4) 6) ; ((= b 4) (+ 6 7 a)) ; (else 25)) 16 ; (+ 2 (if (> b a) b a)) 6 ; (* (cond ((> a b) a) ; ((< a b) b) ; (else -1)) ; (+ a 1) 16 ================================================ FILE: scheme/sicp/01/02.scm ================================================ ; SICP exercise 1.02 ; ; Translate the following expression into prefix form: ; ; http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-10.html#%_thm_1.2 (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) (* 3 (- 6 2) (- 2 7))) ================================================ FILE: scheme/sicp/01/03.scm ================================================ ; SICP exercise 1.03 ; ; Define a procedure that takes three numbers as arguments and returns the sum ; of the squares of the two larger numbers. (define (sum-of-squares a b) (+ (* a a) (* b b))) (define (sum-of-two-largest-squares a b c) (cond ((and (<= a b) (<= a c)) (sum-of-squares b c)) ((and (<= b a) (<= b c)) (sum-of-squares a c)) (else (sum-of-squares a b)))) ================================================ FILE: scheme/sicp/01/04.scm ================================================ ; SICP exercise 1.04 ; ; Observe that our model of evaluation allows for combinations whose operators ; are compound expressions. Use this observation to describe the behavior of ; the following procedure ; ; (define (a-plus-abs-b a b) ; ((if (> b 0) + -) a b)) ; The procedure adds a to the absolute value of b, pretty much as it name ; suggests. Instead of calculating the absolute value of b and adding it ; directly to a, we use the fact that: ; ; a + |b| = { a + b if b is positive ; { a - b if b is negative ; ; In both cases we have an expression with similar structure, but a different ; operator: ( a b). We can determine which operator to use by ; comparing b to 0, which is what (if (> b 0) + -) does. In the former case ; it evaluates to +, while in the later it evaluates to -. ================================================ FILE: scheme/sicp/01/05.scm ================================================ ; SICP exercise 1.05 ; ; Ben Bitdiddle has invented a test to determine whether the interpreter he is ; faced with is using applicative-order evaluation or normal-order evaluation. ; He defines the following two procedures: ; ; (define (p) (p)) ; ; (define (test x y) ; (if (= x 0) ; 0 ; y)) ; ; Then he evaluates he expression ; ; (test 0 (p)) ; ; What behavior will Ben observe with an interpreter that uses ; applicative-order evaluation? What behavior will he observe with an ; interpreter that users normal-order evaluation? Explain your answer. (Assume ; that the evaluation rule of the special form if is the same whether the ; interpreter is using normal or applicative order: The predicate expression is ; evaluated first, and the result determines whether to evaluate the consequent ; or the alternative expression.) ; p does not depend on the type of evaluation, while test does. ; ; (p) is an infinite loop - the interpreter will never stop evaluating it, ; since on every evaluation it has to evaluate it again. ; ; If the first argument of x equals 0, it does not use the second. Within ; normal-order evaluation, the second argument will never be evaluated. Within ; applicative-order evaluation, the second argument gets evaluated before test ; is evaluated. Thus, we can tell the type of evaluation by observing if the ; second argument gets evaluated. ; ; Within applicative-order evaluation the second argument will be evaluated ; before test and the interpreter will get stuck in an infinite loop. Within ; normal-order evaluation the second argument will never get evaluated and the ; interpreter will finish successfully. We can use that to tell which ; evaluation type we are using. ================================================ FILE: scheme/sicp/01/06.scm ================================================ ; SICP exercise 1.06 ; ; Alyssa P. Hacker doesn't see why if needs to be provided as a special form. ; "Why can't I just define it as an ordinary procedure in terms of cond?" she ; asks. Alyssa's friend Eva Lu Ator claims this can indeed be done, and she ; defines a new version of if: ; ; (define (new-if predicate then-clause else-clause) ; (cond (predicate then-clause) ; (else else-clause))) ; ; Eva demonstrates the program for Alyssa: ; ; (new-if (= 2 3) 0 5) ; 5 ; ; (new-if (= 1 1) 0 5) ; 0 ; ; Delighted, Alyssa uses new-if to rewrite the square-root program: ; ; (define (sqrt-iter guess x) ; (new-if (good-enough? guess x) ; guess ; (sqrt-iter (improve guess x) ; x))) ; ; What happens when Alyssa attempts to use this to compute square roots? ; Explain. ; The interpreter gets stuck in an infinite loop. ; ; There is a crucial difference between if and new-if - the former does not ; evaluate both of its clauses, while the later does. This means, that despite ; whether the guess is good enough, sqrt-iter will call itself with an improved ; guess, ending up in an infinite recursion. ; ; Suffice to say, Eva was wrong. ================================================ FILE: scheme/sicp/01/07.scm ================================================ ; SICP exercise 1.07 ; ; The good-enough? test used in computing square roots will not be very ; effective for finding the square roots of very small numbers. Also, in real ; computers, arithmetic operations are almost always performed with limited ; precision. This makes our test inadequate for very large numbers. Explain ; these statements, with examples showing how the tests fails for small and ; large numbers. An alternative strategy for implementing good-enough? is to ; watch how guess changes from one iteration to the next and to stop when the ; change is a very small fraction of the guess. Design a square-root procedure ; that uses this kind of end test. Does this work better for small and large ; numbers? ; It is very easy to demonstrate how this version of good-enough? fails with ; small numbers. Let's try finding the squre of 0.00000004. The result we ; expect is 0.0002. ; ; On the third iteration the guess will be 0.0312. The square of the guess is ; 0.0009, which is just below 0.001. Thus good-enough concludes that 0.0312 is ; the correct answer, if if it is two orders of magnitude apart from the ; desired answer, 0.0002. ; ; Simply put, when the number we are square rooting is below the precision, ; there error is quite big. ; ; As for large numbers, we can demonstrate it by attempting to find the square ; root of 10e+48. On my machine, this simply gets stuck in an infinite loop. ; ; Eventually, (improve guess x) starts getting evaluated to x. While ; (/ x guess) is different from guess, there is not enough precision to ; accurately calculate their average, causing the interpreter to end up ; rounding towards guess. The guess never gets good enough, since it stops ; improving. Infinite loop follows. ; ; Finally, here is the suggested improvement. It works fine in both cases: (define (sqrt x) (sqrt-iter 1.0 x)) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (define (good-enough? guess x) (< (/ (abs (- (improve guess x) guess)) guess) 1e-15)) (define (improve guess x) (average guess (/ x guess))) (define (average x y) (/ (+ x y) 2)) ================================================ FILE: scheme/sicp/01/08.scm ================================================ ; SICP exercise 1.08 ; ; Newton's method for cube roots is based on the fact that if y is an ; approximation to the cube root of x, then a better approximation is given by ; the value: ; ; x/y² + 2y ; ───────── ; 3 ; ; Use this formula to implement a cube-root procedure analogous to the ; square-root procedure. (In section 1.3.4 we will see how to implement ; Newton's method in general as an abstraction of these square-root and ; cube-root procedures). (define (cube-root x) (cube-root-iter 1.0 x)) (define (cube-root-iter guess x) (if (good-enough? guess x) guess (cube-root-iter (improve guess x) x))) (define (good-enough? guess x) (< (abs (- (cube guess) x)) 0.001)) (define (cube x) (* x x x)) (define (improve guess x) (/ (+ (/ x (* guess guess)) (* 2 guess)) 3)) ================================================ FILE: scheme/sicp/01/09.scm ================================================ ; SICP exercise 1.09 ; ; Each of the following two procedures defines a method for adding two positive ; integers in terms of the procedures inc, which increments its argument by 1, ; and dec, which decrements its argument by 1. ; ; (define (+ a b) ; (if (= a 0) ; b ; (inc (+ (dec a) b)))) ; ; (define (+ a b) ; (if (= a 0) ; b ; (+ (dec a) (inc b)))) ; ; Using the substitution model, illustrate the process generated by each ; procedure in evaluating (+ 4 5). Are these processes iterative or recursive? ; The first one expans as follows: ; ; (+ 4 5) ; (inc (+ 3 5)) ; (inc (inc (+ 2 5))) ; (inc (inc (inc (+ 1 5)))) ; (inc (inc (inc (inc (+ 0 5))))) ; (inc (inc (inc (inc 5)))) ; (inc (inc (inc 6))) ; (inc (inc 7)) ; (inc 8) ; 9 ; ; This is obviously a recursive process. ; ; The seconds expands as follows: ; ; (+ 4 5) ; (+ 3 6) ; (+ 2 7) ; (+ 1 8) ; (+ 0 9) ; 9 ; ; This, in in turn, is obviously an iterative process. ================================================ FILE: scheme/sicp/01/10.scm ================================================ ; SICP exercise 1.10 ; ; The following procedure computes a mathematical function called Ackermann's ; function: ; ; (define (A x y) ; (cond ((= y 0) 0) ; ((= x 0) (* 2 y)) ; ((= y 1) 2) ; (else (A (- x 1) ; (A x (- y 1)))))) ; ; What are the values of the following expressions? ; ; (A 1 10) ; ; (A 2 4) ; ; (A 3 3) ; ; Consider the following procedures, where A is the procedure defined above: ; ; (define (f n) (A 0 n)) ; ; (define (g n) (A 1 n)) ; ; (define (h n) (A 2 n)) ; ; (define (k n) (* 5 n n)) ; ; Give consice mathematical definition for the functions computed by the procedures f, g and h ; for positive integer values of n. For example, (k n) computes 5n². ; (A 1 10) ; (A 0 (A 1 9)) ; (A 0 (A 0 (A 1 8))) ; (A 0 (A 0 (A 0 (A 1 7)))) ; (A 0 (A 0 (A 0 (A 0 (A 1 6))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 5)))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 4))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 3)))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 2))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 1)))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 2))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 4)))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 8))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 16)))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 32))))) ; (A 0 (A 0 (A 0 (A 0 64)))) ; (A 0 (A 0 (A 0 128))) ; (A 0 (A 0 256)) ; (A 0 512) ; 1024 ; ; (A 2 4) ; (A 1 (A 2 3)) ; (A 1 (A 1 (A 2 2))) ; (A 1 (A 1 (A 1 (A 2 1)))) ; (A 1 (A 1 (A 1 2))) ; (A 1 (A 1 (A 0 (A 1 1)))) ; (A 1 (A 1 (A 0 2))) ; (A 1 (A 1 4)) ; (A 1 (A 0 (A 1 3))) ; (A 1 (A 0 (A 0 (A 1 2)))) ; (A 1 (A 0 (A 0 (A 0 (A 1 1))))) ; (A 1 (A 0 (A 0 (A 0 2)))) ; (A 1 (A 0 (A 0 4))) ; (A 1 (A 0 8)) ; (A 1 16) ; (A 0 (A 1 15)) ; (A 0 (A 0 (A 1 14))) ; (A 0 (A 0 (A 0 (A 1 13)))) ; (A 0 (A 0 (A 0 (A 0 (A 1 12))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 11)))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 10))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 9)))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 8))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 7)))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 6))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 5)))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 4))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 3)))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 2))))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 1)))))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 2))))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 4)))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 8))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 16)))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 32))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 64)))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 128))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 256)))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 512))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 1024)))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 2048))))) ; (A 0 (A 0 (A 0 (A 0 4096)))) ; (A 0 (A 0 (A 0 8192))) ; (A 0 (A 0 16384)) ; (A 0 32768) ; 65536 ; ; (A 3 3) ; (A 2 (A 3 2)) ; (A 2 (A 2 (A 3 1))) ; (A 2 (A 2 2)) ; (A 2 (A 1 (A 2 1))) ; (A 2 (A 1 2)) ; (A 2 (A 0 (A 1 1))) ; (A 2 (A 0 2)) ; (A 2 4) ; (A 1 (A 2 3)) ; (A 1 (A 1 (A 2 2))) ; (A 1 (A 1 (A 1 (A 2 1)))) ; (A 1 (A 1 (A 1 2))) ; (A 1 (A 1 (A 0 (A 1 1)))) ; (A 1 (A 1 (A 0 2))) ; (A 1 (A 1 4)) ; (A 1 (A 0 (A 1 3))) ; (A 1 (A 0 (A 0 (A 1 2)))) ; (A 1 (A 0 (A 0 (A 0 (A 1 1))))) ; (A 1 (A 0 (A 0 (A 0 2)))) ; (A 1 (A 0 (A 0 4))) ; (A 1 (A 0 8)) ; (A 1 16) ; (A 0 (A 1 15)) ; (A 0 (A 0 (A 1 14))) ; (A 0 (A 0 (A 0 (A 1 13)))) ; (A 0 (A 0 (A 0 (A 0 (A 1 12))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 11)))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 10))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 9)))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 8))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 7)))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 6))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 5)))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 4))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 3)))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 2))))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 1)))))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 2))))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 4)))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 8))))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 16)))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 32))))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 64)))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 128))))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 256)))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 512))))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 1024)))))) ; (A 0 (A 0 (A 0 (A 0 (A 0 2048))))) ; (A 0 (A 0 (A 0 (A 0 4096)))) ; (A 0 (A 0 (A 0 8192))) ; (A 0 (A 0 16384)) ; (A 0 32768) ; 65536 ; ; As for the defined functions. ; ; (define (f n) (A 0 n)) ; (define (g n) (A 1 n)) ; (define (h n) (A 2 n)) ; ; (f n) is 2 * n ; (g n) is 2 ^ n ; (h n) is 2 ^ 2 ^ .. ^ 2 (n times) ================================================ FILE: scheme/sicp/01/11.scm ================================================ ; SICP exercise 1.11 ; ; A function f is defined by the rule that: ; ; f(n) = n if n < 3 ; f(n) = f(n-1) + 2f(n-2) + 3f(n-3) if n ≥ 3 ; ; Write a procedure that computes f by means of a recursive process. Write a ; procedure that computes f by means of an iterative process. (define (f n) (if (< n 3) n (+ (f (- n 1)) (* 2 (f (- n 2))) (* 3 (f (- n 3)))))) (define (f-iter n) (define (iter a b c count) (if (= count 0) c (iter (+ a (* 2 b) (* 3 c)) a b (- count 1)))) (iter 2 1 0 n)) ================================================ FILE: scheme/sicp/01/12.scm ================================================ ; SICP exercise 1.12 ; ; The following pattern of numbers is called Pascal's triangle. ; ; 1 ; 1 1 ; 1 2 1 ; 1 3 3 1 ; 1 4 6 4 1 ; ... ; ; The numbers at the edge of the triange are all 1, and each number inside the ; triangle is the sum of the two numbers above it. Write a procedure that ; computes the elements of Pascal's triangle by means of recursive process. (define (binom row index) (cond ((= index 1) 1) ((= index row) 1) (else (+ (binom (- row 1) (- index 1)) (binom (- row 1) index))))) ================================================ FILE: scheme/sicp/01/13.scm ================================================ ; SICP exercise 1.13 ; ; Prove that Fib(n) is the closest integer to 𝜙ⁿ/√5, where 𝜙 = (1 + √5)/2. ; ; Hint: Let 𝜓 = (1 - √5)/2. Use induction and the definition of Fibonacci numbers ; (see section 1.2.2) to prove that Fib(n) = (𝜙ⁿ - 𝜓ⁿ)/√5 ; Seriously? Anyway... ; ; First, let's establish that |𝜓ⁿ| < ½ for n > 1. It holds, because: ; ; 𝜓 ≈ -0.61803 ; 𝜓² ≈ 0.38196 ; ; As n grows, it converges to 0. ; ; Next, let's illustrate that 𝜓² = 𝜓 + 1: ; ; 𝜓² = (1 - √5)²/2² = (6 - 2√5)/4 = (3 - √5)/2 = 2/2 + (1 - √5)/2 = 1 + 𝜓 ; ; Afterwards let's prove Fib(n) = (𝜙ⁿ - 𝜓ⁿ)/√5, using induction. ; ; Basis. We will show it holds true for n = 0 and n = 1. ; ; (𝜙⁰ - 𝜓⁰)/√5 = (1 - 1)/√5 = 0/√5 = 0 = Fib(0) ; (𝜙 - 𝜓)/√5 = (1 + √5 - 1 + √5)/2√5 = 2√5/2√5 = 1 = Fib(1) ; ; Inductive step. We can assume that the following hold: ; ; (𝜙ⁿ - 𝜓ⁿ)/√5 = Fib(n) ; (𝜙ⁿ⁺¹ - 𝜓ⁿ⁺¹)/√5 = Fib(n + 1) ; ; Let's prove that (𝜙ⁿ⁺² - 𝜓ⁿ⁺²)/√5 = Fib(n + 2). ; ; Fib(n + 2) = Fib(n + 1) + Fib(n) = (𝜙ⁿ⁺¹ - 𝜓ⁿ⁺¹)/√5 + (𝜙ⁿ - 𝜓ⁿ)/√5 = ; = (𝜙ⁿ⁺¹ + 𝜙ⁿ - 𝜓ⁿ⁺¹ - 𝜓ⁿ)/√5 = (𝜙ⁿ(𝜙 + 1) - 𝜓ⁿ(𝜓 + 1))/√5 = ; = (𝜙ⁿ⁺² - 𝜓ⁿ⁺²)/√5 ; ; The only thing left is to relate (𝜙ⁿ - 𝜓ⁿ)/√5 to the statement we are ; proving - Fib(n) is the closest integer to 𝜙ⁿ/√5. ; ; Fib(n) - 𝜙ⁿ/√5 = 𝜓ⁿ/√5 ; ; We already know that 𝜓ⁿ/√5 is less than ½, which makes Fib(n) the closest ; integer to 𝜙ⁿ/√5. ================================================ FILE: scheme/sicp/01/14.scm ================================================ ; SICP exercise 1.14 ; ; Draw the tree illustrating the process generated by the count-change ; procedure of section 1.2.2 in making charge for 11 cents. What are the orders ; of growth of the space and number of steps used by this process as the amount ; to be changed increases. ; The spaces grows in Θ(n), since the maximum depth of the tree is a function ; of n (number-of-denominations + n / smallest-denomination + 1). ; ; I believe the time is Θ(aˣ), but I'm not certain. The amount of nodes seem to ; roughly double every time we add 5 to n, but this is oversimplifying it (it ; gets more complex when we start adding 50 in increments. ; ; And about draing a tree? In ASCII? Seriously? Meh, sure: ; ; (count-change 11 5) ; | ; ._____(cc 11 5)_____. ; ._____/ \_____. ; .___________(cc 11 4)__________. (cc -39 5) ; .___________/ \____________. | ; ._______________________(cc 11 3)_______________________. (cc -14 4) 0 ; .____________________________/ \________________________. | ; .__________(cc 11 2)____________. (cc 1 3) 0 ; .________________/ \___________________. / \ ; (cc 11 1) ._________(cc 6 2)________. (cc 1 2) (cc -9 3) ; / \ ._________/ \_________. / \ | ; (cc 11 0) (cc 10 1) (cc 6 1) (cc 1 2) (cc 1 1) (cc -4 2) 0 ; | / \ / \ / \ / \ | ; 0 (cc 10 0) (cc 9 1) (cc 6 0) (cc 5 1) (cc 1 1) (cc -4 2) (cc 0 1) (cc 1 0) 0 ; | / \ | / \ / \ | | | ; 0 (cc 9 0) (cc 8 1) 0 (cc 5 0) (cc 4 1) (cc 1 0) (cc 0 1) 0 0 1 ; | / \ | / \ | | ; 0 (cc 8 0) (cc 7 1) 0 (cc 4 0) (cc 3 1) 0 1 ; | / \ | / \ ; 0 (cc 7 0) (cc 6 1) 0 (cc 3 0) (cc 2 1) ; | / \ | / \ ; 0 (cc 6 0) (cc 5 1) 0 (cc 2 0) (cc 1 1) ; | / \ | / \ ; 0 (cc 5 0) (cc 4 1) 0 (cc 1 0) (cc 0 1) ; | / \ | | ; 0 (cc 4 0) (cc 3 1) 0 1 ; | / \ ; 0 (cc 3 0) (cc 2 1) ; | / \ ; 0 (cc 2 0) (cc 1 1) ; | / \ ; 0 (cc 1 0) (cc 0 1) ; | | ; 0 1 ; ; It fits my MacBook Pro screen like a boss ================================================ FILE: scheme/sicp/01/15.scm ================================================ ; SICP exercise 1.15 ; ; The sine of an angle (specified in radians) can be computed by making use of ; the approximation sin(x) ≈ x if x is sufficiently small, and the ; trigonometric identity ; ; sin(r) = 3sin(r/3) - 4sin³(r/3) ; ; to reduce the size of the argument of sin. (For purposes of this exercise an ; angle is considered "sufficiently small" if its magnitude is not greater than ; 0.1 radians.) These ideas are incorporated in the following procedures: ; ; (define (cube x) (* x x x)) ; (define (p x) (- (* 3 x) (* 4 (cube x)))) ; (define (sine angle) ; (if (not (> (abs angle) 0.1)) ; angle ; (p (sine (/ angle 3.0))))) ; ; a. How many times is the procedure p applied when (sine 12.15) is evaluted? ; ; b. What is the order of growth in space and number of steps (as a function ; of a) used by the process generated by the sine procedure when (sine a) ; is evaluated? ; This is how the function expands. ; ; (sine 12.15) ; (p (sine 4.05)) ; (p (p (sine 1.35))) ; (p (p (p (sine 0.45)))) ; (p (p (p (p (sine 0.15))))) ; (p (p (p (p (p (sine 0.05)))))) ; (p (p (p (p (p 0.05))))) ; (p (p (p (p 0.1495)))) ; (p (p (p 0.4351345505))) ; (p (p 0.975846533167877)) ; (p -0.789563114470823) ; -0.39980345741334 ; ; As for the questions: ; ; a. p is applied 5 times for (sine 12.15), which also happens to be n / 3, ; rounded up. ; ; b. The space of (sine n) is n / 3. Its order of growth is Θ(n). The number of ; steps is (n / 3)C, where C is the number of steps it takes to calculate p ; once. The number of steps (time taken) has order of growth Θ(logn). ================================================ FILE: scheme/sicp/01/16.scm ================================================ ; SICP exercise 1.16 ; ; Design a procedure that evolves an iterative exponentiation process that uses ; successive squaring and uses a logarithmic number of steps, as does ; fast-expt. ; ; Hint: Using the observation that (b^(n/2))^2 = (b^2)^(n/2), keep along with ; the exponent n and the base b, an additional state variable a, and define the ; state transformation in such a way that the product ab^n is unchanged from ; state to state. At the beginning of the process a is taken to be 1, and the ; answer is given by the value of a at the end of the process. In general, the ; technique of defining an invariant quantity that remains unchanged from state ; to state is a powerful way to think about the design of iterative algorithms. (define (fast-expt base power) (define (iter a b n) (cond ((= n 0) a) ((even? n) (iter a (* b b) (/ n 2))) (else (iter (* a b) b (- n 1))))) (iter 1 base power)) ================================================ FILE: scheme/sicp/01/17.scm ================================================ ; SICP exercise 1.17 ; ; The exponentiation algorithms in this section are based on performing ; exponentiation by means of repeated multiplication. In a similar way, one can ; perform integer multiplication by means of repeated addition. The following ; multiplication procedure (in which it is assumed that our language can only ; add, not multiply) is analogous to the expt procedure. ; ; (define (* a b) ; (if (= b 0) ; 0 ; (+ add (* a (- b 1))))) ; ; This algorithm takes a number of steps that is linear in b. Now suppose we ; include together with addition, operations double, which doubles an integer, ; and halve, which divides an (even) integer by 2. Using these, design a ; multiplication procedure analogous to fast-expt that uses a logarithmic ; number of steps. (define (double a) (+ a a)) (define (halve a) (/ a 2)) (define (** a b) (cond ((= b 0) 0) ((even? b) (** (double a) (halve b))) (else (+ a (** a (- b 1)))))) ================================================ FILE: scheme/sicp/01/18.scm ================================================ ; SICP exercise 1.18 ; ; Using the results of exercises 1.16 and 1.17, devise a procedure that ; generates an iterative process for multiplying two integers in terms of ; adding, doubling and halving and uses a logarithmic number of steps. ; Say we want to multiply a by b. We are going to do this iteratively and our ; invariant quantitiy will be ab + c, with c initially being 0. We iteratively ; apply the following transformations: ; ; ab + c = { 2a(b/2) + c if b is even ; { a(b-1) + a + c if b is odd ; ; We conclude the result is c when b is zero. (define (double a) (+ a a)) (define (halve a) (/ a 2)) (define (** a b) (define (iter a b c) (cond ((= b 0) c) ((even? b) (iter (double a) (halve b) c)) (else (iter a (- b 1) (+ a c))))) (iter a b 0)) ================================================ FILE: scheme/sicp/01/19.scm ================================================ ; SICP exercise 1.19 ; ; There is a clever algorithm for computing the Fibonacci numbers in a ; logarithmic number of steps. Recall the transformation of the state variables ; a and b in the fib-iter process of section 1.2.2: a ← a + b and b ← a. Call ; this transformation T, and observe that applying T over and over again n ; times, starting with 1 and 0, produces the pair Fib(n+1) and Fib(n). In other ; words, the Fibonacci numbers are produced by applying Tⁿ, the nth power of ; the transformation T, starting with the pair (1, 0). Now consider T to be the ; special case of p = 0 and q = 1 in a family of transformations T(p,q), where ; T(p,q) transforms the pair (a,b) according to a ← bq + aq + ap and ; b ← bp + aq. Show that if we apply such a transformation T(p,q) twice, the ; effect is the same as using a single transformation T(p',q') of the same ; form, and compute p' and q' in terms of p and q. ; ; This gives us an explicit way to square these transformations, and thus we ; can compute Tⁿ using successive squaring, as in the fast-expt procedure. Put ; this all together to complete the following procedure, which runs in a ; logarithmic number of steps. ; ; (define (fib n) ; (fib-iter 1 0 0 1 n)) ; ; (define (fib-iter a b p q count) ; (cond ((= count 0) b) ; ((even? count) (fib-iter a ; b ; ; compute p' ; ; compute q' ; (/ count 2))) ; (else (fib-iter (+ (* b q) (* a q) (* a p)) ; (+ (* b p) (* a q)) ; p ; q ; (- count 1))))) ; Here are some inferences: ; ; After T(p,q) ; ; a = bq + aq + ap ; b = bp + aq ; ; If we apply T(p,q) again, we get: ; ; a = bpq + aqq + bqq + aqq + apq + bpq + apq + app ; b = bpp + apq + bqq + aqq + apq ; ; If we normalize it: ; ; a = 2bpq + bq² + 2aq² + 2apq + ap² ; b = bp² + bq² + 2apq + aq² ; ; If we group it: ; ; a = b(q² + 2pq) + a(q² + 2pq) + a(p² + q²) ; b = b(p² + q²) + a(q² + 2pq) ; ; Clearly: ; ; p' = p² + q² ; q' = q² + 2pq (define (fib n) (fib-iter 1 0 0 1 n)) (define (fib-iter a b p q count) (cond ((= count 0) b) ((even? count) (fib-iter a b (+ (* p p) (* q q)) (+ (* q q) (* 2 p q)) (/ count 2))) (else (fib-iter (+ (* b q) (* a q) (* a p)) (+ (* b p) (* a q)) p q (- count 1))))) ================================================ FILE: scheme/sicp/01/20.scm ================================================ ; SICP exercise 1.20 ; ; The process that a procedures generates is of course dependent on the rules ; used by the interpreter. As an example, consider the iterative gcd procedure ; given above. Suppose we were to interpret this procedure using normal-order ; evaluation, as discussed in section 1.1.5. (The normal-order-evaluation rule ; for if is described in exercise 1.5.) Using the substitution method (for ; normal order), illustrate the process generated in evaluating (gcd 206 40) ; and indicate the remainder operations that are actually performed. How many ; remainder operations are actually performed in the normal-order evaluation of ; (gcd 206 40)? In the applicative-order evaluation? ; The procedure is: ; ; (define (gcd a b) ; (if (= b 0) ; a ; (gcd b (remainder a b)))) ; ; I am going to abbreviate (remainder a b) to (r a b) to keep things managable. ; ; Using normal-order evaluation, we take the following steps: ; ; (gcd 206 40) ; (if (= 40 0) 206 (gcd 40 (r 206 40))) ; (gcd 40 (r 206 40)) ; (if (= (r 206 40) 0) 40 (gcd (r 206 40) (r 40 (r 206 40)))) ; (if (= 6 0) 40 (gcd (r 206 40) (r 40 (r 206 40)))) ; (gcd (r 206 40) (r 40 (r 206 40))) ; (if (= (r 40 (r 206 40)) 0) (r 206 40) (gcd (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40))))) ; (if (= (r 40 6) 0) (r 206 40) (gcd (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40))))) ; (if (= 4 0) (r 206 40) (gcd (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40))))) ; (gcd (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40)))) ; (if (= (r (r 206 40) (r 40 (r 206 40))) 0) (r 40 (r 206 40)) (gcd (r (r 206 40) (r 40 (r 206 40))) (r (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40)))) ; ... ; ; If we just take a look at each iteration, we see: ; ; (gcd 206 40) ; (gcd 40 (r 206 40)) ; (gcd (r 206 40) (r 40 (r 206 40))) ; (gcd (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40)))) ; (gcd (r (r 206 40) (r 40 (r 206 40))) (r (r 40 (r 206 40)) (r (r 206 40) (r 40 (r 206 40))))) ; (r (r 206 40) (r 40 (r 206 40))) ; ; On each step we calculate b and then we calculate the final a. Thus, we use ; 18 remainder operations. ; ; Using applicative order-evaluation, we take the following steps ; ; (gcd 206 40) ; (gcd 40 (r 206 40)) ; (gcd 6 (r 40 6)) ; (gcd 4 (r 6 4)) ; (gcd 2 (r 4 2)) ; 2 ; ; We end up using 4 remainder operations. ================================================ FILE: scheme/sicp/01/21.scm ================================================ ; SICP exercise 1.21 ; ; Use the smallest-divisor procedure to find the smallest divisor of each of ; the following numbers: 199, 1999, 19999. (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1))))) (define (square a) (* a a)) (define (divides? a b) (= (remainder b a) 0)) (printf "(smallest divisor of 199) is ~a\n" (smallest-divisor 199)) ; 199 (printf "(smallest divisor of 1999 is ~a\n" (smallest-divisor 1999)) ; 1999 (printf "(smallest divisor of 19999) is ~a\n" (smallest-divisor 19999)) ; 7 ================================================ FILE: scheme/sicp/01/22.scm ================================================ ; SICP exercise 1.22 ; ; Most Lisp implementations include a primitve called runtime that returns an ; integer that specifies the amount of time the system has been running ; (measured, for example, in microseconds). The following timed-prime-test ; procedures, when called with an integer n, prints n and checks to see if n is ; prime. If n is prime, the procedure prints three asterisks followed by the ; amount of time used in performing the test. ; ; (define (timed-prime-test n) ; (newline) ; (display n) ; (start-prime-test n (runtime))) ; ; (define (start-prime-test n start-time) ; (if (prime? n) ; (report-prime (- (runtime) start-time)))) ; ; (define (report-prime elapsed-time) ; (display " *** ") ; (display elapsed-time) ; ; Using this procedure, write a procedure search-for-primes that checks the ; primality of consecutive odd integers in a specified range. Use your ; procedure to find the three smallest primes larger than 1000; larger than ; 10,000; larger than 100,000; larger than 1,000,000. Note the time neeed to ; test each prime. Since the testing algorithm has order of growth Θ(√n), you ; should expect that testing for primes around 10,000 should take about √10 ; times as long as testing for primes around 1000. Do your timing data bear ; this out? How well do the data for testing for 100,000 and 1,000,000 support ; the √n prediction? Is your result compatible with the notion that programs on ; your machine run in time proportional to the number of steps required in the ; computation? ; Here are the numbers: ; ; 1009, 1013, 1019, 10007, 10009, 10037, 100003, 100019, 100043, 1000003, ; 1000033, 1000037 ; ; Here is the time it takes to see if they are prime on my computer: ; ; 1009 *** 0.001953125 ; 1013 *** 0.001953125 ; 1019 *** 0.0029296875 ; 10007 *** 0.0068359375 ; 10009 *** 0.007080078125 ; 10037 *** 0.007080078125 ; 100003 *** 0.018798828125 ; 100019 *** 0.01806640625 ; 100043 *** 0.01904296875 ; 1000003 *** 0.055908203125 ; 1000033 *** 0.055908203125 ; 1000037 *** 0.055908203125 ; ; Even with numbers as 1,000,000, it is easily illustrated that the √n ; prediction is true. Programs do run in time proportional to the number of ; steps required in the computation, at least on this machine. Just run the ; program to verify. ; ; I wonder if some day I will run this on a machine, that will show different ; results. (define (timed-prime-test n) (newline) (display n) (start-prime-test n (runtime))) (define (start-prime-test n start-time) (if (prime? n) (report-prime (- (runtime) start-time)) (void))) (define (runtime) (current-inexact-milliseconds)) (define (report-prime elapsed-time) (display " *** ") (display elapsed-time)) (define (prime? n) (= n (smallest-divisor n))) (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1))))) (define (square a) (* a a)) (define (divides? a b) (= (remainder b a) 0)) (define (search-for-primes lower-limit) (newline) (define (iter n number) (cond ((= n 0) 0) ((prime? number) (display number) (newline) (iter (- n 1) (+ number 1))) (else (iter n (+ number 1))))) (iter 3 lower-limit)) (search-for-primes 1000) (search-for-primes 10000) (search-for-primes 100000) (search-for-primes 1000000) (timed-prime-test 1009) (timed-prime-test 1013) (timed-prime-test 1019) (timed-prime-test 10007) (timed-prime-test 10009) (timed-prime-test 10037) (timed-prime-test 100003) (timed-prime-test 100019) (timed-prime-test 100043) (timed-prime-test 1000003) (timed-prime-test 1000033) (timed-prime-test 1000037) ================================================ FILE: scheme/sicp/01/23.scm ================================================ ; SICP exercise 1.23 ; ; The smallest-divisor procedure shown at the start of this section does lots ; of needless testing: After it checks to see if the number is divisible by 2 ; there is no pint in checking to see if it is divisible by any larger even ; numbers. This suggests that the values used for test-divisor should not be ; 2, 3, 4, 5, 6, ..., but rather 2, 3, 5, 7, 9, .... To implement this change, ; define a procedure next that returns 3 if its input is equal to 2 and ; otherwise returns its input plus 2. Modify the smallest-divisor procedure to ; use (next test-divisor) instead of (+ test-divisor 1). With timed-prime-test ; incorporating this modified version of smallest-divisor, run the test for ; each of the 11 primes found in exercise 1.22. Since this modification halves ; the number of test steps, you should expect it to run about twice as fast. Is ; this expectation confirmed? If not, what is the observed ratio of the speeds ; of the two algorithms and how do you explain the fact that it is different ; from 2? ; Let's compare the numbers: ; ; +---------+----------------+----------------+ ; | Number | (+ divisor 1) | (next divisor) | ; +---------+----------------+----------------+ ; | 1009 | 0.001953125000 | 0.001953125000 | ; | 1013 | 0.001953125000 | 0.001953125000 | ; | 1019 | 0.002929687500 | 0.001953125000 | ; | 10007 | 0.006835937500 | 0.004150390625 | ; | 10009 | 0.007080078125 | 0.005126953125 | ; | 10037 | 0.007080078125 | 0.004150390625 | ; | 100003 | 0.018798828125 | 0.012939453125 | ; | 100019 | 0.018066406250 | 0.011962890625 | ; | 100043 | 0.019042968750 | 0.011962890625 | ; | 1000003 | 0.055908203125 | 0.035888671875 | ; | 1000033 | 0.055908203125 | 0.035888671875 | ; | 1000037 | 0.055908203125 | 0.036132812500 | ; +---------+----------------+----------------+ ; ; The ratio is between 3/2 and 2. We can approximate it to 3/2. We get less ; than 2, because even if we halve the steps, we add an additional overhead for ; each step - testing whether the number is 2. (define (next test-divisor) (if (= test-divisor 2) 3 (+ test-divisor 2))) (define (prime? n) (= n (smallest-divisor n))) (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (next test-divisor))))) (define (square a) (* a a)) (define (divides? a b) (= (remainder b a) 0)) (define (timed-prime-test n) (newline) (display n) (start-prime-test n (runtime))) (define (start-prime-test n start-time) (if (prime? n) (report-prime (- (runtime) start-time)) (void))) (define (runtime) (current-inexact-milliseconds)) (define (report-prime elapsed-time) (display " *** ") (display elapsed-time)) (timed-prime-test 1009) (timed-prime-test 1013) (timed-prime-test 1019) (timed-prime-test 10007) (timed-prime-test 10009) (timed-prime-test 10037) (timed-prime-test 100003) (timed-prime-test 100019) (timed-prime-test 100043) (timed-prime-test 1000003) (timed-prime-test 1000033) (timed-prime-test 1000037) ================================================ FILE: scheme/sicp/01/24.scm ================================================ ; SICP exercise 1.24 ; ; Modify the timed-prime-test procedure of exercise 1.22 to use fast-prime? ; (the Fermat method), and test each of the 12 primes you found in that ; exercise. Since the Fermat test has Θ(logn) growth, how would you expect the ; time to test primes near 1,000,000 to compare with the time needed to test ; primes near 1000? Do your data bear this out? Can you explain any discrepancy ; you find? ; Let's elaborate on the numbers we already have: ; ; +---------+----------------+----------------+----------------+ ; | Number | (+ divisor 1) | (next divisor) | fermat test | ; +---------+----------------+----------------+----------------+ ; | 1009 | 0.001953125000 | 0.001953125000 | 0.010009765625 | ; | 1013 | 0.001953125000 | 0.001953125000 | 0.010009765625 | ; | 1019 | 0.002929687500 | 0.001953125000 | 0.010009765625 | ; | 10007 | 0.006835937500 | 0.004150390625 | 0.012207031250 | ; | 10009 | 0.007080078125 | 0.005126953125 | 0.011962890625 | ; | 10037 | 0.007080078125 | 0.004150390625 | 0.011962890625 | ; | 100003 | 0.018798828125 | 0.012939453125 | 0.014160156250 | ; | 100019 | 0.018066406250 | 0.011962890625 | 0.013916015625 | ; | 100043 | 0.019042968750 | 0.011962890625 | 0.013916015625 | ; | 1000003 | 0.055908203125 | 0.035888671875 | 0.015869140625 | ; | 1000033 | 0.055908203125 | 0.035888671875 | 0.015869140625 | ; | 1000037 | 0.055908203125 | 0.036132812500 | 0.015869140620 | ; +---------+----------------+----------------+----------------+ ; ; I expect fast-prime? to be faster. The growth is as I expected. I am ; surprised that it is slower for smaller numbers. ; ; I have two problems with this exercise: (1) they complete too quickly on ; modern architectures and (2) (random) is limited to integers, which we ; quickly run out of before the execution times start getting interesting. (define (expmod base exp m) (cond ((= exp 0) 1) ((even? exp) (remainder (square (expmod base (/ exp 2) m)) m)) (else (remainder (* base (expmod base (- exp 1) m)) m)))) (define (square n) (* n n)) (define (fermat-test n) (define (try-it a) (= (expmod a n n) a)) (try-it (+ 1 (random (- n 1))))) (define (fast-prime? n times) (cond ((= times 0) true) ((fermat-test n) (fast-prime? n (- times 1))) (else false))) (define (timed-prime-test n) (newline) (display n) (start-prime-test n (runtime))) (define (start-prime-test n start-time) (if (fast-prime? n 1) (report-prime (- (runtime) start-time)) (void))) (define (runtime) (current-inexact-milliseconds)) (define (report-prime elapsed-time) (display " *** ") (display elapsed-time)) (timed-prime-test 1009) (timed-prime-test 1013) (timed-prime-test 1019) (timed-prime-test 10007) (timed-prime-test 10009) (timed-prime-test 10037) (timed-prime-test 100003) (timed-prime-test 100019) (timed-prime-test 100043) (timed-prime-test 1000003) (timed-prime-test 1000033) (timed-prime-test 1000037) ================================================ FILE: scheme/sicp/01/25.scm ================================================ ; SICP exercise 1.25 ; ; Allysa P. Hacker complains that we went to a lot of extra work in writing ; expmod. After all, she says, since we already know how to compute exponents, ; we could have simply written ; ; (define (expmod base exp m) ; (remainder (fast-expt base exp) m)) ; ; Is she correct? Would this procedure serve as well for our fast prime tester? ; Explain. ; She is correct. We can define expmod that way and it would certainly return ; correct results. However, it will not deserve being called "fast-prime?", ; since it quickly becomes dramatically slower. Here is a comparison: ; ; +----------------+--------------------+ ; | exercise 24 | exercise 25 | ; +----------------+--------------------+ ; | 0.101074218750 | 0.751953125000 | ; | 0.004150390625 | 0.282958984375 | ; | 0.002929687500 | 0.229980468750 | ; | 0.003173828125 | 7.984863281250 | ; | 0.004150390625 | 10.800781250000 | ; | 0.003173828125 | 5.987060546875 | ; | 0.077880859375 | 419.326904296875 | ; | 0.024169921875 | 460.801025390625 | ; | 0.022949218750 | 401.984130859375 | ; | 0.028076171875 | 12811.398193359375 | ; | 0.020019531250 | 15219.705078125000 | ; | 0.028076171870 | 18424.709228515620 | ; +----------------+--------------------+ ; ; This happens, because we end up calculating exponents with very large numbers ; Multiplication and division is particularly slow with those. Allysa's expmod ; quickly starts multiplying them, while the one we wrote goes into great ; lengths of avoiding it. (define (fast-expt base power) (define (iter a b n) (cond ((= n 0) a) ((even? n) (iter a (* b b) (/ n 2))) (else (iter (* a b) b (- n 1))))) (iter 1 base power)) (define (expmod base exp m) (remainder (fast-expt base exp) m)) (define (square n) (* n n)) (define (fermat-test n) (define (try-it a) (= (expmod a n n) a)) (try-it (+ 1 (random (- n 1))))) (define (fast-prime? n times) (cond ((= times 0) true) ((fermat-test n) (fast-prime? n (- times 1))) (else false))) (define (timed-prime-test n) (newline) (display n) (start-prime-test n (runtime))) (define (start-prime-test n start-time) (if (fast-prime? n 1) (report-prime (- (runtime) start-time)) (void))) (define (runtime) (current-inexact-milliseconds)) (define (report-prime elapsed-time) (display " *** ") (display elapsed-time)) (timed-prime-test 1009) (timed-prime-test 1013) (timed-prime-test 1019) (timed-prime-test 10007) (timed-prime-test 10009) (timed-prime-test 10037) (timed-prime-test 100003) (timed-prime-test 100019) (timed-prime-test 100043) (timed-prime-test 1000003) (timed-prime-test 1000033) (timed-prime-test 1000037) ================================================ FILE: scheme/sicp/01/26.scm ================================================ ; SICP exercise 1.26 ; ; Louis Reasoner is having great difficulty doing exercise 1.24. His ; fast-prime? test seems to run more slowly than his prime? test. Louis calls ; his friend Eva Lu Ator over to help. When they examine Louis's code, they ; find that he has rewritten the expmod procedure to use an explicit ; multiplication, rather than calling square: ; ; (define (expmod base exp m) ; (cond ((= exp 0) 1) ; ((even? exp) ; (remainder (* (expmod base (/ exp 2) m) ; (expmod base (/ exp 2) m)) ; m)) ; (else ; (remainder (* base (expmod base ; (- exp 1) ; m)) ; m)))) ; ; "I don't see what difference that could make", says Louis. "I do." says Eva. ; "By writing the procedure like that, you have transformed the Θ(logn) process ; into a Θ(n) process." Explain. ; It is quite similar to the recursive fibonacci. The expmod function halves m ; on every iteration, which would lead to Θ(logn). However, it does perform ; expmod twice, which in turn doubles the work on every step. This leads to ; an Θ(n) order of growth. ================================================ FILE: scheme/sicp/01/27.scm ================================================ ; SICP exercise 1.27 ; ; Demonstrate that the Carmichael numbers listed in footnote 1.17 really do ; fool the Fermat test. That is, write a procedure that takes an integer n and ; tests whether aⁿ is congruent to a modulo n for every a < n, and try your ; procedure on the given Carmichael numbers. ; Just use the function carmichael?, although do note, that it should be named ; carmichael-or-prime? (define (carmichael? number) (define (congruent-to-number-below a) (cond ((= a 1) #t) ((= (expmod a number number) (remainder a number)) (congruent-to-number-below (- a 1))) (else #f))) (congruent-to-number-below (- number 1))) (define (expmod base exp m) (cond ((= exp 0) 1) ((even? exp) (remainder (square (expmod base (/ exp 2) m)) m)) (else (remainder (* base (expmod base (- exp 1) m)) m)))) (define (square n) (* n n)) ================================================ FILE: scheme/sicp/01/28.scm ================================================ ; SICP exercise 1.28 ; ; One variant of the Fermat test that cannot be fooled is called the ; Miller-Rabin test. This starts from an alternate form of Fermat's Little ; Theorem, which states that if n is a prime number and a is any positive ; integer less than n, then a raised to the (n - 1)-st power is congruent to 1 ; modulo n. To test the primality of a number n by the Miller-Rabin test, we ; pick a random number a < n and raise a to the (n - 1)-st power module n using ; the expmod procedure. However, whenever we perform the squaring step in ; expmod, we check to see if we have discovered a "nontrivial square root of 1 ; modulo n," that is, a number not equal to 1 or n - 1 whose square is equal to ; 1 modulo n. It is possible to prove that if such a nontrivial square root of ; 1 exists, then n is not prime. It is also possible to prove that if n is an ; odd number that is not prime, then, for at least half of the numbers a < n, ; computing aⁿ⁻¹ in this way will reveal a nontrivial square root of 1 modulo ; n. (This is why the Miller-Rabin test cannot be fooled.) Modify the expmod ; procedure to signal if it discovers a nontrivial square root of 1, and use ; this to implement the Miller-Rabin test with a procedure analogous to ; fermat-test. Check your procedure by testing various known primes and ; non-primes. Hint: One convenient way to make expmod singal is to have it ; return 0. ; Changing the algorithm produces produces results I did not expect. ; ; Let's take a look at the amount of numbers a, such that a < n, for which aⁿ⁻¹ ; is congruent to 1 modulo n. If n is prime, this is true for all numbers ; 1 < a < n. I expected that to be true for Carmichael numbers, but I turned ; out to be wrong - it's not all numbers, but a fairly large percent of them. ; For example, if n = 66011, for approximatelly 80% of the numbers a < n, aⁿ⁻¹ ; is congruent to 1 modulo n. The large the percentage, the more likely the ; test will be fooled. ; ; However, if we introduce the check for non-trivial square root of 1 modulo n, ; the amount of numbers that fool the test drops dramatically. Here's a table ; for the Carmichael numbers in said footnote: ; ; +------+-----------+----------+ ; | n | w/o sqrt1 | w/ sqrt1 | ; +------+-----------+----------+ ; | 561 | 57% | 2% | ; | 1105 | 70% | 3% | ; | 1729 | 75% | 9% | ; | 2465 | 73% | 3% | ; | 2821 | 77% | 10% | ; | 6601 | 80% | 5% | ; +------+-----------+----------+ ; ; Anyway, here's the code. I cannot shake the feeling that I am getting ; something wrong. (define (fast-prime? n times) (cond ((= times 0) true) ((miller-rabin-test n) (fast-prime? n (- times 1))) (else false))) (define (miller-rabin-test n) (define (try-it a) (= (miller-rabin-expmod a (- n 1) n) 1)) (try-it (+ 1 (random (- n 1))))) (define (miller-rabin-expmod base exp m) (cond ((= exp 0) 1) ((even? exp) (remainder (square (zero-if-non-trivial-sqrt (miller-rabin-expmod base (/ exp 2) m) m)) m)) (else (remainder (* base (miller-rabin-expmod base (- exp 1) m)) m)))) (define (square n) (* n n)) (define (zero-if-non-trivial-sqrt x n) (if (and (not (= x 1)) (not (= x (- n 1))) (= (remainder (square x) n) 1)) 0 x)) ================================================ FILE: scheme/sicp/01/29.scm ================================================ ; SICP exercise 1.29 ; ; Simpson's Rule is a more accurate method of numerical integration than the ; method illustrated above. Using Simpson's Rule, the integral of a function f ; between a and b is approximated as ; ; h ; ─(y₀ + 4y₁ + 2y₂ + 4y₃ + 2y₄ + ... + 2yₙ₋₂ + 4yₙ₋₁ + yₙ) ; 3 ; ; where h = (b - a)/n, for some even integer n, and yₖ = f(a + kh). (Increasing ; n increases the accuracy of the approximation.) Define a procedure that takes ; as arguments f, a, b and n and returns the value of the integral, computed ; using Simpson's Rule. Use your procedure to integrate cube between 0 and 1 ; (with n = 100 and n = 1000), and compare the results to those of the integral ; procedure shown above. ; Implementing the integral with Simpson's Rule is easy. Check it out below. ; Comparing the results to integral, however, appears way harder. The results ; do not match my expectation, at least. Here's what I get from integral: ; ; +----------------+---------------------+---------------------+ ; | Iterations | integral | simpson-integral | ; +----------------+---------------------+---------------------+ ; | 100 (0.01) | 0.24998750000000042 | 0.24671666666666678 | ; | 1000 (0.001) | 0.24999987500000100 | 0.24966716666666610 | ; | 10000 (0.0001) | 0.24999999874993412 | 0.24996667166666647 | ; +----------------+---------------------+---------------------+ ; ; I have no idea why it doesn't match my expectation. (define (simpson-integral f a b n) (define h (/ (- b a) n)) (define (next k) (+ 1 k)) (define (coefficient k) (cond ((= k 0) 1) ((= k n) 1) ((odd? k) 2) (else 4))) (define (term k) (* (coefficient k) (f (+ a (* k h))))) (* (/ h 3) (sum term 0 next n))) (define (sum term a next b) (if (> a b) 0 (+ (term a) (sum term (next a) next b)))) (define (integral f a b dx) (define (add-dx x) (+ x dx)) (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) (define (cube x) (* x x x)) ================================================ FILE: scheme/sicp/01/30.scm ================================================ ; SICP exercise 1.30 ; ; The sum procedure above generates a linear recursion. The procedure can be ; rewritten so that the sum is performed iteratively. Show how to do this ; by filling in the missing expressions in the following definition: ; ; (define (sum term a next b) ; (define (iter a result) ; (if ; ; (iter ))) ; (iter )) (define (sum term a next b) (define (iter a result) (if (> a b) result (iter (next a) (+ (term a) result)))) (iter a 0)) ================================================ FILE: scheme/sicp/01/31.scm ================================================ ; SICP exercise 1.31 ; ; a. The sum procedure is only the simplest of a vast number of similar ; abstractions that can be captured as higher-order procedures. Write an ; analogous procedure called product that returns the product of the values of ; a function at points over a given range. Show how to define factorial in ; terms of product. Also use product to compute approximations of π using the ; formula: ; ; π 2·4·4·6·6·8… ; ─ = ──────────── ; 4 3·3·5·5·7·7… ; ; b. If your product procedure generates a recursive process, write one that ; generates an iterative process. If it generates an iterative process, write ; one that generates a recursive process. (define (product term a next b) (if (> a b) 1 (* (term a) (product term (next a) next b)))) (define (factorial n) (define (term n) n) (define (next n) (+ 1 n)) (product term 1 next n)) (define (approximated-pi precision) (define (term n) (/ (* 2 (quotient (+ n 2) 2)) (+ 1 (* 2 (quotient (+ n 1) 2))))) (define (next n) (+ n 1)) (product term 1.0 next precision)) (define (iterative-product term a next b) (define (iter a result) (if (> a b) result (iter (next a) (* (term a) result)))) (iter 1 a)) (define (i-factorial n) (define (term n) n) (define (next n) (+ 1 n)) (iterative-product term 1 next n)) (define (i-approximated-pi precision) (define (term n) (/ (* 2 (quotient (+ n 2) 2)) (+ 1 (* 2 (quotient (+ n 1) 2))))) (define (next n) (+ n 1)) (iterative-product term 1.0 next precision)) ================================================ FILE: scheme/sicp/01/32.scm ================================================ ; SICP exercise 1.32 ; ; a. Show that sum and product (exercise 1.31) are both special cases of a ; still more general notion called accumulate that combines a collection of ; terms, using some general accumulation function: ; ; (accumulate combiner null-value term a next b) ; ; accumulate takes as arguments the same term and range specifications as sum ; and product, together with a combiner procedure (of two arguments) that ; specifies how the current term is to be combined with the accumulation of the ; preceding terms and a null-value that specifies the base value to use when ; the terms run out. Write accumulate and show how both sum and product can be ; defined as simple calls to accumulate. ; ; b. If your accumulate procedure generates a recursive process, write one that ; generates an iterative. If it generates an iterative process, run one that ; generates a recursive process. (define (accumulate combiner null-value term a next b) (if (> a b) null-value (combiner (term a) (accumulate combiner null-value term (next a) next b)))) (define (product term a next b) (accumulate * 1 term a next b)) (define (sum term a next b) (accumulate + 0 term a next b)) (define (i-accumulate combiner null-value term a next b) (define (iter a result) (if (> a b) result (iter (next a) (combiner (term a) result)))) (iter a null-value)) (define (i-product term a next b) (i-accumulate * 1 term a next b)) (define (i-sum term a next b) (i-accumulate + 0 term a next b)) ================================================ FILE: scheme/sicp/01/33.scm ================================================ ; SICP exercise 1.33 ; ; You can obtain an even more general version of accumulate (exercise 1.32) by ; introducing the notion of a filter on the terms to be combined. That is, ; combine only those terms derived from values in the range that satisfy a ; specified condition. The resulting filtered-accumulate abstraction takes the ; same arguments as accumulate, together with an additional predicate of one ; argument that specifies the filter. Write filtered-accumulate as a procedure. ; Show how to express the following using filtered-accumulate: ; ; a. the sum of the squares of the prime numbers in the interval a to b ; (assuming that you have a prime? predicate already written) ; ; b. the product of all the positive integers less than n that are relatively ; prime to n (i.e. all positive integer i < n such that GCD(i,n) = 1). ; I shall implemented filtered-accumulate both recursively and iteratively, ; just for the fun of it. (define (filtered-accumulate combiner null-value term a next b use?) (define (iter a result) (cond ((> a b) result) ((use? a) (iter (next a) (combiner (term a) result))) (else (iter (next a) result)))) (iter a null-value)) (define (filtered-accumulate-rec combiner null-value term a next b use?) (cond ((> a b) null-value) ((use? a) (combiner (term a) (filtered-accumulate-rec combiner null-value term (next a) next b use?))) (else (filtered-accumulate-rec combiner null-value term (next a) next b use?)))) (define (sum-of-prime-squares a b) (filtered-accumulate + 0 square a increment b prime?)) (define (square a) (* a a)) (define (increment n) (+ n 1)) (define (prime? n) (= n (smallest-divisor n))) (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ 1 test-divisor))))) (define (divides? a b) (= (remainder b a) 0)) (define (product-of-relative-primes-to n) (define (relatively-prime-to-n? x) (= (gcd n x) 1)) (filtered-accumulate * 1 identity 1 increment n relatively-prime-to-n?)) (define (identity n) n) (define (gcd a b) (if (= b 0) a (gcd b (remainder a b)))) ================================================ FILE: scheme/sicp/01/34.scm ================================================ ; SICP exercise 1.34 ; ; Suppose we define the procedure ; ; (define (f g) ; (g 2)) ; ; Then we have ; ; (f square) ; 4 ; ; (f (lambda (z) (* z (+ z 1)))) ; 6 ; ; What happens if we (perversely) ask the interpreter to evaluate the ; combination (f f)? Explain. ; We get an error. In Racket it looks like this: ; ; procedure application: expected procedure, given: 2; arguments were: 2 ; ; It is fairly obvious why it happens. Let's expand it: ; ; (f f) ; (f 2) ; (2 2) ; ; It ends up invoking 2 as a procedure, when it is not really a procedure. ================================================ FILE: scheme/sicp/01/35.scm ================================================ ; SICP exercise 1.35 ; ; Show that the golden ratio 𝜙 (section 1.2.2) is a fixed point of the ; transformation x ↦ 1 + 1/x, and use this fact to compute 𝜙 by means of the ; fixed-point procedure. ; Showing that 𝜙 is a fixed point is trivial. We have that: ; ; 𝜙 = (1 + √5)/2 ; ; When we apply the transformation, we get ; ; 1 𝜙 + 1 (1 + √5)/2 + 2/2 3 + √5 (3 + √5)(1 - √5) ; 1 + ─ = ───── = ──────────────── = ────── = ──────────────── = ; 𝜙 𝜙 (1 + √5)/2 1 + √5 (1 + √5)(1 - √5) ; ; 3 - 3√5 + √5 - 5 -2 - 2√5 1 + √5 ; = ──────────────── = ──────── = ────── = 𝜙 ; -4 -4 2 ; ; Clearly, it is a fixed point. ; ; As for computing it: (define tolerance 0.00001) (define (fixed-point f first-guess) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) (try first-guess)) (define golden-ratio (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0)) ================================================ FILE: scheme/sicp/01/36.scm ================================================ ; SICP exercise 1.36 ; ; Modify the fixed-point so that it prints the sequence of approximations it ; generates, using the newline and display primitives shown in exercise 1.22. ; Then find a solution to xˣ = 1000 by finding a fixed point of ; x ↦ log(1000)/log(x). (Use Scheme's primitive log procedure, which computes ; natural logarithms.) Compare the number of step this takes with and without ; average damping. (Note that you cannot start fixed-point with a guess of 1, ; as this ould cause divisino by log(1) = 0.) ; Curiously enough, the version with average damping takes significantly less ; steps. I expected it to be the other way around. I believe the reason is that ; without average damping, the guesses oscillate around the answer, while with ; it, the guesses approaches steadily from one direction. (define tolerance 0.00001) (define (fixed-point f first-guess) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess iteration) (let ((next (f guess))) (display iteration) (display ". ") (display next) (newline) (if (close-enough? guess next) next (try next (+ iteration 1))))) (try first-guess 1)) (define (average x y) (/ (+ x y) 2)) (display "Without average damping:") (newline) (fixed-point (lambda (x) (/ (log 1000) (log x))) 2.0) (newline) (display "With average damping:") (newline) (fixed-point (lambda (x) (average x (/ (log 1000) (log x)))) 2.0) ================================================ FILE: scheme/sicp/01/37.scm ================================================ ; SICP exercise 1.37 ; ; a. An infinite continued fraction is an expression of the form: ; ; N₁ ; f = ──────────────── ; N₂ ; D₁ + ─────────── ; N₃ ; D₂ + ────── ; D₃ + … ; ; As an example, one can show that the infinite continued fraction expansion ; with the Nᵢ and the Dᵢ all equal to 1 produces 1/𝜙, where 𝜙 is the golden ; ratio (described in section 1.2.2). One way to approximate an infinite ; continued fraction is to truncate the expansion after a given number of ; terms. Such a truncation — a so called k-term finite continued fraction — has ; the form ; ; N₁ ; ────────── ; N₂ ; D₁ + ───── ; ⋱ Nᵢ ; + ── ; Dᵢ ; ; Suppose that n and d are procedures of one argument (the term index i) that ; return the Nᵢ and the Dᵢ of the terms of the continued fraction. Defined a ; procedure cont-frac such that evaluating (cont-frac n d k) computes the value ; of the k-term finite continued fraction. Check your procedure by ; approximating 1/𝜙 using ; ; (cont-frac (lambda (i) 1.0) ; (lambda (i) 1.0) ; k) ; ; for successive values of k. How large must you make k in order to get an ; approximation that is accurate to 4 decimal places? ; ; b. If your cont-frac procedure generates a recursive process, write one that ; generates an iterative process. If it generates an iterative process, write ; one that generates a recursive process. ; k must be 11 in order to get an approximation, accurate to 4 decimal places ; ; Here are the functions: (define (cont-frac n d k) (define (frac i) (if (= k i) (/ (n i) (d i)) (/ (n i) (+ (d i) (frac (+ i 1)))))) (frac 1)) (define (cont-frac-i n d k) (define (iter i result) (if (= i 0) result (iter (- i 1) (/ (n i) (+ (d i) result))))) (iter k 0)) ================================================ FILE: scheme/sicp/01/38.scm ================================================ ; SICP exercise 1.38 ; ; In 1737, the Swiss mathematician Leonhard Euler published a memoir De ; Fractionibus Continuis, which included a continued fraction expansion of e-2, ; where e is the base of the natural logarithms. In this fraction, Nᵢ are all ; 1, and the Dᵢ are successively 1, 2, 1, 1, 4, 1, 1, 6, 1, 1, 8,…. Write a ; program that uses your cont-frac procedure from exercise 1.37 to approximate ; e, based on Euler's expansion. (define (cont-frac n d k) (define (iter i result) (if (= i 0) result (iter (- i 1) (/ (n i) (+ (d i) result))))) (iter k 0)) (define (approximate-e) (define (term n) (if (= (remainder (+ n 1) 3) 0) (* 2 (/ (+ n 1) 3)) 1.0)) (+ (cont-frac (lambda (x) 1.0) term 20) 2)) ================================================ FILE: scheme/sicp/01/39.scm ================================================ ; SICP exercise 1.39 ; ; A continued fraction representation of tangent function was published in ; 1770 by the German mathematician J. H. Lambert: ; ; x ; tan(x) = ───────────── ; x² ; 1 - ───────── ; x² ; 3 - ───── ; 5 - ⋱ ; ; where x is in radians. Define a procedure (tan-cf x k) that computes an ; approximation to the tangent function based on Lambert's formula. x specifies ; the number of terms to compute, as in exercise 1.37. (define (cont-frac n d k) (define (iter i result) (if (= i 0) result (iter (- i 1) (/ (n i) (+ (d i) result))))) (iter k 0)) (define (tan-cf x k) (let ((neg-x-squared (- (* x x)))) (cont-frac (lambda (n) (if (= n 1) x neg-x-squared)) (lambda (n) (- (* n 2) 1)) k))) ================================================ FILE: scheme/sicp/01/40.scm ================================================ ; SICP exercise 1.40 ; ; Define a procedure cubic that can be used together with newtons-method ; procedure in expressions of the form ; ; (newtons-method (cubic a b c) 1) ; ; to approximate zeroes of the cubic x³ + ax² + bx + c ; It is simpler than it sounds - we just define a lambda, that computes ; x³ + ax² + bx + c (define (cubic a b c) (lambda (x) (+ (* x x x) (* a x x) (* b x) c))) (define (newtons-method g guess) (fixed-point (newton-transform g) guess)) (define (newton-transform g) (lambda (x) (- x (/ (g x) ((deriv g) x))))) (define (deriv g) (lambda (x) (/ (- (g (+ x dx)) (g x)) dx))) (define (fixed-point f first-guess) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) (try first-guess)) (define dx 0.00001) (define tolerance 0.00001) ================================================ FILE: scheme/sicp/01/41.scm ================================================ ; SICP exercise 1.41 ; ; Define a procedure double that takes a procedure of one argument as argument ; and returns a procedure that applies the original procedure twice. For ; example, if inc is a procedure that adds 1 to its argument, then (double inc) ; should be a procedure that adds 2. What value is returned by ; (((double (double double)) inc) 5) ; ; (double double) returns (lambda (f) (double (double x))), which in turn ; returns a procedure, that applies f four times. ; ; (double (double double)) returns: ; ; (lambda (f) (double (double (double (double f))))) ; ; When we apply double to inc numerous times, we get: ; ; (double inc) +2 ; (double (double inc)) +4 ; (double (double (double inc))) +8 ; (double (double (double (double inc)))) +16 ; ; Thus, returns 21 (define (double function) (lambda (x) (function (function x)))) (define (inc x) (+ x 1)) ================================================ FILE: scheme/sicp/01/42.scm ================================================ ; SICP exercise 1.42 ; ; Let f and g be two one-argument functions. The composition f after g is defined to be ; the function x ↦ f(g(x)). Define a procedure compose that implements composition. For ; example, if inc is a procedure that adds 1 to its argument, ; ; ((compose square inc) 6) ; 49 (define (compose f g) (lambda (x) (f (g x)))) ================================================ FILE: scheme/sicp/01/43.scm ================================================ ; SICP exercise 1.43 ; ; If f is a numerical function and n is a positive integer, then we can form ; the nth repeated application of f, which is defined to be the function whose ; value at x is f(f(…(f(x))…)). For example, if f is the function x ↦ x + 1, ; then the nth repeated application of f is the function x ↦ x + n. If f is the ; operation of squaring a number, then the nth repeated application of f is the ; function that raises its argument to the 2ⁿth power. Write a procedure that ; takes as inputs a procedure that computes f and a positive integer n and ; returns the procedures that computes the nth repeated application of f. Your ; procedure should be able to be used as follows: ; ; ((repeated square 2) 5) ; 625 ; ; Hint: You may find it convenient to use compose from exercise 1.42 (define (repeated f n) (if (= n 1) f (compose f (repeated f (- n 1))))) (define (compose f g) (lambda (x) (f (g x)))) ================================================ FILE: scheme/sicp/01/44.scm ================================================ ; SICP exercise 1.44 ; ; The idea of smoothing a function is an important concept in signal ; processing. If f is a function and dx is some small number, then the ; smoothed version of f is the function whose value at a point x is the average ; f(x - dx), f(x) and f(x + dx). Write a procedure smooth that takes as input a ; procedure that computes f and returns a procedure that computes the smoothed ; f. It is sometimes valuable to repeatedly smooth a function (that is, smooth ; the smoothed function, and so on) to obtain the n-fold smoothed function. ; Show how to generate the n-fold smoothed function of any given function using ; smooth and repeated from exercise 1.43. (define (smoothed f) (lambda (x) (/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3))) (define (n-fold-smoothed f n) ((repeated smoothed n) f)) (define (repeated f n) (if (= n 1) f (compose f (repeated f (- n 1))))) (define (compose f g) (lambda (x) (f (g x)))) (define dx 0.0000001) ================================================ FILE: scheme/sicp/01/45.scm ================================================ ; SICP exercise 1.45 ; ; We saw in section 1.3.3 that attempting to compute square roots by naively ; finding a fixed point of x ↦ x/y does not converge, and that this can be ; fixed by average damping. The same method works for finding cube roots as ; fixed points of the average-damped y ↦ x/y². Unfortunatelly, the process does ; not work for fourth roots — a single average damp is not enough to make a ; fixed-point search for y ↦ x/y³ converge. On the other hand, if we average ; damp twice (i.e., use the average damp of the average damp of y ↦ x/y³) the ; fixed-point search does converge. Do some experiments to determine how many ; average damps are required to compute nth roots as a fixed-point search based ; upon repeated average damping of y ↦ x/yⁿ⁻¹. Use this to implement a simple ; procedure for computing nth roots using fixed-point, average-damp, and the ; repeated procedure of exercise 1.43. Assume that any arithmetic operations ; you need are available as primitives. ; After a few experiments, I found out that we need to do log₂n avergage damps ; to approximate the nth root. So, here's the function (define (nth-root n x) (fixed-point-of-transform (lambda (y) (/ x (expt y (- n 1)))) (repeated average-damp (ceiling (/ (log n) (log 2)))) 1.0)) ; And here is all the code we need to get it to run (define (fixed-point-of-transform g transform guess) (fixed-point (transform g) guess)) (define (fixed-point f first-guess) (define (close-enough? v1 v2) (< (abs (- v1 v2)) tolerance)) (define (try guess) (let ((next (f guess))) (if (close-enough? guess next) next (try next)))) (try first-guess)) (define (average-damp f) (lambda (x) (/ (+ (f x) x) 2))) (define (repeated f n) (if (= n 1) f (compose f (repeated f (- n 1))))) (define (compose f g) (lambda (x) (f (g x)))) (define tolerance 0.000001) ================================================ FILE: scheme/sicp/01/46.scm ================================================ ; SICP exercise 1.46 ; ; Several of the numerical methods described in this chapter are instances of ; an extremely general computational strategy known as iterative improvement. ; Iterative improvement says that, to compute something, we start with an ; initial guess for the answer, test if the guess is good enough, and otherwise ; improve the guess and continue the process using the improved guess as the ; new guess. Write a procedure iterative-improve that takes two procedures as ; arguments: a method for telling whether a guess is good enough and a method ; for improving a guess. iterative-improve should return as its value a ; procedure that takes a guess as argument and keeps improving the guess until ; it is good enough. Rwerite the sqrt procedure of section 1.1.7 and the ; fixed-point procedure of section 1.3.3 in terms of iterative-improve. (define (iterative-improve good-enough? improve) (define (iter guess) (if (good-enough? guess) guess (iter (improve guess)))) iter) (define (sqrt x) ((iterative-improve (lambda (guess) (< (abs (- (* guess guess) x)) 0.000001)) (lambda (guess) (/ (+ guess (/ x guess)) 2))) 1.0)) (define (fixed-point f first-guess) ((iterative-improve (lambda (guess) (< (abs (- guess (f guess))) 0.000001)) f) first-guess)) ================================================ FILE: scheme/sicp/01/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../03.scm") (define sicp-1.03-tests (test-suite "Tests for SICP exercise 1.03" (check-equal? (sum-of-two-largest-squares 2 3 4) 25) (check-equal? (sum-of-two-largest-squares 2 4 3) 25) (check-equal? (sum-of-two-largest-squares 3 4 2) 25) (check-equal? (sum-of-two-largest-squares 3 2 4) 25) (check-equal? (sum-of-two-largest-squares 4 2 3) 25) (check-equal? (sum-of-two-largest-squares 4 3 2) 25) (check-equal? (sum-of-two-largest-squares 3 3 4) 25) (check-equal? (sum-of-two-largest-squares 3 4 3) 25) (check-equal? (sum-of-two-largest-squares 4 3 3) 25) (check-equal? (sum-of-two-largest-squares 3 3 3) 18) )) (run-tests sicp-1.03-tests) ================================================ FILE: scheme/sicp/01/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../07.scm") (define sicp-1.07-tests (test-suite "Tests for SICP exercise 1.07" (check-= (sqrt 4e-8) 2e-4 1e-16) (check-= (* (sqrt 10e+48) (sqrt 10e+48)) 10e+48 10e+33) )) (run-tests sicp-1.07-tests) ================================================ FILE: scheme/sicp/01/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../08.scm") (define sicp-1.08-tests (test-suite "Tests for SICP exercise 1.08" (check-= (cube-root 8) 2 0.00001) (check-= (cube-root 27) 3 0.00001) (check-= (cube-root 1000) 10 0.00001) )) (run-tests sicp-1.08-tests) ================================================ FILE: scheme/sicp/01/tests/11-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../11.scm") (define sicp-1.11-tests (test-suite "Tests for SICP exercise 1.11" (check-equal? (f 0) 0) (check-equal? (f 1) 1) (check-equal? (f 2) 2) (check-equal? (f 3) 4) (check-equal? (f 4) 11) (check-equal? (f 5) 25) (check-equal? (f 6) 59) (check-equal? (f-iter 0) 0) (check-equal? (f-iter 1) 1) (check-equal? (f-iter 2) 2) (check-equal? (f-iter 3) 4) (check-equal? (f-iter 4) 11) (check-equal? (f-iter 5) 25) (check-equal? (f-iter 6) 59) )) (run-tests sicp-1.11-tests) ================================================ FILE: scheme/sicp/01/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../12.scm") (define sicp-1.12-tests (test-suite "Tests for SICP exercise 1.12" (check-equal? (binom 1 1) 1) (check-equal? (binom 2 1) 1) (check-equal? (binom 2 2) 1) (check-equal? (binom 3 1) 1) (check-equal? (binom 3 2) 2) (check-equal? (binom 3 3) 1) (check-equal? (binom 4 1) 1) (check-equal? (binom 4 2) 3) (check-equal? (binom 4 3) 3) (check-equal? (binom 4 4) 1) (check-equal? (binom 5 1) 1) (check-equal? (binom 5 2) 4) (check-equal? (binom 5 3) 6) (check-equal? (binom 5 4) 4) (check-equal? (binom 5 5) 1) )) (run-tests sicp-1.12-tests) ================================================ FILE: scheme/sicp/01/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../16.scm") (define sicp-1.16-tests (test-suite "Tests for SICP exercise 1.16" (check-equal? (fast-expt 2 0) 1) (check-equal? (fast-expt 2 1) 2) (check-equal? (fast-expt 2 2) 4) (check-equal? (fast-expt 2 3) 8) (check-equal? (fast-expt 2 4) 16) (check-equal? (fast-expt 2 5) 32) (check-equal? (fast-expt 2 6) 64) (check-equal? (fast-expt 2 7) 128) (check-equal? (fast-expt 2 8) 256) (check-equal? (fast-expt 3 0) 1) (check-equal? (fast-expt 3 1) 3) (check-equal? (fast-expt 3 2) 9) (check-equal? (fast-expt 3 3) 27) (check-equal? (fast-expt 3 4) 81) (check-equal? (fast-expt 3 5) 243) )) (run-tests sicp-1.16-tests) ================================================ FILE: scheme/sicp/01/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../17.scm") (define sicp-1.17-tests (test-suite "Tests for SICP exercise 1.17" (check-equal? (** 5 1) 5) (check-equal? (** 5 2) 10) (check-equal? (** 5 3) 15) (check-equal? (** 5 4) 20) (check-equal? (** 5 5) 25) (check-equal? (** 1 2) 2) (check-equal? (** 2 2) 4) (check-equal? (** 3 2) 6) (check-equal? (** 4 2) 8) (check-equal? (** 5 2) 10) )) (run-tests sicp-1.17-tests) ================================================ FILE: scheme/sicp/01/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../18.scm") (define sicp-1.18-tests (test-suite "Tests for SICP exercise 1.18" (check-equal? (** 5 1) 5) (check-equal? (** 5 2) 10) (check-equal? (** 5 3) 15) (check-equal? (** 5 4) 20) (check-equal? (** 5 5) 25) (check-equal? (** 1 2) 2) (check-equal? (** 2 2) 4) (check-equal? (** 3 2) 6) (check-equal? (** 4 2) 8) (check-equal? (** 5 2) 10) )) (run-tests sicp-1.18-tests) ================================================ FILE: scheme/sicp/01/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../19.scm") (define sicp-1.19-tests (test-suite "Tests for SICP exercise 1.19" (check-equal? (fib 0) 0) (check-equal? (fib 1) 1) (check-equal? (fib 2) 1) (check-equal? (fib 3) 2) (check-equal? (fib 4) 3) (check-equal? (fib 5) 5) (check-equal? (fib 6) 8) (check-equal? (fib 7) 13) (check-equal? (fib 8) 21) (check-equal? (fib 9) 34) (check-equal? (fib 10) 55) (check-equal? (fib 11) 89) (check-equal? (fib 12) 144) )) (run-tests sicp-1.19-tests) ================================================ FILE: scheme/sicp/01/tests/27-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../27.scm") (define sicp-1.27-tests (test-suite "Tests for SICP exercise 1.27" (check-true (carmichael? 561)) (check-true (carmichael? 1105)) (check-true (carmichael? 1729)) (check-true (carmichael? 2465)) (check-true (carmichael? 2821)) (check-true (carmichael? 6601)) (check-false (carmichael? 27)) (check-false (carmichael? 1001)) )) (run-tests sicp-1.27-tests) ================================================ FILE: scheme/sicp/01/tests/28-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../28.scm") (define sicp-1.28-tests (test-suite "Tests for SICP exercise 1.28" (check-true (fast-prime? 11 3)) (check-true (fast-prime? 101 3)) (check-true (fast-prime? 1009 3)) (check-true (fast-prime? 1013 3)) (check-true (fast-prime? 1019 3)) (check-true (fast-prime? 10007 3)) (check-true (fast-prime? 10009 3)) (check-true (fast-prime? 10037 3)) (check-true (fast-prime? 10037 3)) (check-false (fast-prime? 561 3)) (check-false (fast-prime? 1105 3)) (check-false (fast-prime? 1729 3)) (check-false (fast-prime? 2465 3)) (check-false (fast-prime? 2821 3)) (check-false (fast-prime? 6601 3)) )) (run-tests sicp-1.28-tests) ================================================ FILE: scheme/sicp/01/tests/29-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../29.scm") (define sicp-1.29-tests (test-suite "Tests for SICP exercise 1.29" (check-= (integral cube 0 1 0.001) 0.25 0.001) (check-= (integral (lambda (x) x) 0 1 0.001) 0.5 0.001) (check-= (simpson-integral cube 0 1 100) 0.25 0.01) (check-= (simpson-integral (lambda (x) x) 0 1 100) 0.5 0.01) (check-= (simpson-integral (lambda (x) x) 0 1 1000) 0.5 0.001) )) (run-tests sicp-1.29-tests) ================================================ FILE: scheme/sicp/01/tests/30-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../30.scm") (define sicp-1.30-tests (test-suite "Tests for SICP exercise 1.30" (check-equal? (sum (lambda (x) x) 1 (lambda (x) (+ 1 x)) 100) 5050) (check-equal? (sum (lambda (x) x) 0 (lambda (x) (+ 1 x)) 1) 1) (check-equal? (sum (lambda (x) x) 0 (lambda (x) (+ 1 x)) 0) 0) (check-equal? (sum (lambda (x) x) 0 (lambda (x) (+ 2 x)) 10) 30) (check-= (sum (lambda (x) (/ 1 (expt 2 x))) 1.0 (lambda (x) (+ 1 x)) 100) 1.0 0.01) )) (run-tests sicp-1.30-tests) ================================================ FILE: scheme/sicp/01/tests/31-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../31.scm") (define sicp-1.31-tests (test-suite "Tests for SICP exercise 1.31" (check-equal? (factorial 1) 1) (check-equal? (factorial 5) 120) (check-= (approximated-pi 1000) (/ 3.14 4) 0.001) (check-equal? (i-factorial 1) 1) (check-equal? (i-factorial 5) 120) (check-= (i-approximated-pi 1000) (/ 3.14 4) 0.001) )) (run-tests sicp-1.31-tests) ================================================ FILE: scheme/sicp/01/tests/32-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../32.scm") (define (increment n) (+ n 1)) (define (one-over-pow-of-2 n) (/ 1 (expt 2 n))) (define sicp-1.32-tests (test-suite "Tests for SICP exercise 1.32" (check-equal? (accumulate * 1 identity 1 increment 5) 120) (check-equal? (product identity 1 increment 5) 120) (check-equal? (sum identity 1 increment 10) 55) (check-= (accumulate + 0 one-over-pow-of-2 0 increment 1000) 2 0.001) (check-equal? (i-accumulate * 1 identity 1 increment 5) 120) (check-equal? (i-product identity 1 increment 5) 120) (check-equal? (i-sum identity 1 increment 10) 55) (check-= (i-accumulate + 0 one-over-pow-of-2 0 increment 1000) 2 0.001) )) (run-tests sicp-1.32-tests) ================================================ FILE: scheme/sicp/01/tests/33-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../33.scm") (define sicp-1.33-tests (test-suite "Tests for SICP exercise 1.33" (check-equal? (sum-of-prime-squares 2 10) 87) (check-equal? (sum-of-prime-squares 10 15) 290) (check-equal? (product-of-relative-primes-to 10) 189) (check-equal? (product-of-relative-primes-to 12) 385) )) (run-tests sicp-1.33-tests) ================================================ FILE: scheme/sicp/01/tests/35-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../35.scm") (define sicp-1.35-tests (test-suite "Tests for SICP exercise 1.35" (check-= (* golden-ratio golden-ratio) (+ 1 golden-ratio) 0.00001) )) (run-tests sicp-1.35-tests) ================================================ FILE: scheme/sicp/01/tests/37-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../37.scm") (define one (lambda (i) 1.0)) (define two (lambda (i) 2.0)) (define sicp-1.37-tests (test-suite "Tests for SICP exercise 1.37" (check-equal? (cont-frac one one 1) 1.0) (check-equal? (cont-frac one two 1) 0.5) (check-equal? (cont-frac two one 1) 2.0) (check-= (cont-frac one one 11) 0.6180 0.00006) (check-equal? (cont-frac-i one one 1) 1.0) (check-equal? (cont-frac-i one two 1) 0.5) (check-equal? (cont-frac-i two one 1) 2.0) (check-= (cont-frac-i one one 11) 0.6180 0.00006) )) (run-tests sicp-1.37-tests) ================================================ FILE: scheme/sicp/01/tests/38-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../38.scm") (define sicp-1.38-tests (test-suite "Tests for SICP exercise 1.38" (check-= (approximate-e) 2.71828183 0.00000001) )) (run-tests sicp-1.38-tests) ================================================ FILE: scheme/sicp/01/tests/39-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../39.scm") (define sicp-1.39-tests (test-suite "Tests for SICP exercise 1.39" (check-= (tan-cf 0 100) 0 0.00001) (check-= (tan-cf 1.0 100) 1.55740 0.00001) (check-= (tan-cf 2.0 100) -2.18503 0.00001) (check-= (tan-cf 3.141592 100) 0.0 0.00001) )) (run-tests sicp-1.39-tests) ================================================ FILE: scheme/sicp/01/tests/40-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../40.scm") (define sicp-1.40-tests (test-suite "Tests for SICP exercise 1.40" (check-= (newtons-method (cubic 0 0 -1) 2.0) 1.0 0.00001) (check-= (newtons-method (cubic 0 0 -27) 2.0) 3.0 0.00001) )) (run-tests sicp-1.40-tests) ================================================ FILE: scheme/sicp/01/tests/41-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../41.scm") (define sicp-1.41-tests (test-suite "Tests for SICP exercise 1.41" (check-equal? (((double (double double)) inc) 5) 21) )) (run-tests sicp-1.41-tests) ================================================ FILE: scheme/sicp/01/tests/42-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../42.scm") (define (square x) (* x x)) (define (inc x) (+ x 1)) (define sicp-1.42-tests (test-suite "Tests for SICP exercise 1.42" (check-equal? ((compose square inc) 6) 49) )) (run-tests sicp-1.42-tests) ================================================ FILE: scheme/sicp/01/tests/43-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../43.scm") (define (square x) (* x x)) (define sicp-1.43-tests (test-suite "Tests for SICP exercise 1.43" (check-equal? ((repeated square 2) 5) 625) )) (run-tests sicp-1.43-tests) ================================================ FILE: scheme/sicp/01/tests/44-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../44.scm") (define sicp-1.44-tests (test-suite "Tests for SICP exercise 1.44" ; A rather flaky way of testing it (check-not-equal? ((smoothed abs) 0) 0) (check-= ((smoothed abs) 0) 0 0.00001) (check-not-equal? ((n-fold-smoothed abs 4) 0) 0) (check-= ((n-fold-smoothed abs 4) 0) 0 0.00001) )) (run-tests sicp-1.44-tests) ================================================ FILE: scheme/sicp/01/tests/45-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../45.scm") (define sicp-1.45-tests (test-suite "Tests for SICP exercise 1.45" (check-= (nth-root 2 4) 2 0.000001) (check-= (nth-root 3 8) 2 0.000001) (check-= (nth-root 4 16) 2 0.000001) (check-= (nth-root 5 32) 2 0.000001) (check-= (nth-root 8 256) 2 0.000001) (check-= (nth-root 9 512) 2 0.000001) )) (run-tests sicp-1.45-tests) ================================================ FILE: scheme/sicp/01/tests/46-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../46.scm") (define sicp-1.46-tests (test-suite "Tests for SICP exercise 1.46" (check-= (sqrt 9) 3 0.0000001) (check-= (sqrt 256) 16 0.0000001) (check-= (fixed-point cos 1.0) 0.739084 0.00001) )) (run-tests sicp-1.46-tests) ================================================ FILE: scheme/sicp/02/01.scm ================================================ ; SICP exercise 2.01 ; ; Define a better version of make-rat that handles both positive and negative ; arguments. make-rat should normalize the sign so that if the rational number ; is positive, both the numerator and denominator are positive, and if the ; rational number is negative, only the numerator is negative. (define (make-rat n d) (let ((g (gcd n d))) (let ((n (/ n g)) (d (/ d g))) (if (< d 0) (cons (- n) (- d)) (cons n d))))) (define (numer x) (car x)) (define (denom x) (cdr x)) ================================================ FILE: scheme/sicp/02/02.scm ================================================ ; SICP exercise 2.02 ; ; Consider the problem of representing line segments in a plane. Each segment ; is represented as a pair of points: a starting point and an ending point. ; Define a constructor make-segment and selectors start-segment and end-segment ; that define the representation of segments in terms of points. Furthermore, a ; point can be represented as a pair of numbers: the x coordinate and the y ; coordinate. Accordingly, specify a constructor make-point and selectors ; x-point and y-point that define this representation. Finally, using your ; selectors and constructors, define a procedure midpoint-segment that takes a ; line segment as argument and returns its midpoint (the point whose ; coordinates are the average of the coordinates of the endpoints). To try your ; procedures, you'll need a way to print points: ; ; (define (print-point p) ; (newline) ; (display "(") ; (display (x-point p)) ; (display ",") ; (display (y-point p)) ; (display ")")) (define (make-point x y) (cons x y)) (define (x-point point) (car point)) (define (y-point point) (cdr point)) (define (make-segment start-point end-point) (cons start-point end-point)) (define (start-segment segment) (car segment)) (define (end-segment segment) (cdr segment)) (define (midpoint-segment segment) (let ((start (start-segment segment)) (end (end-segment segment))) (make-point (average (x-point start) (x-point end)) (average (y-point start) (y-point end))))) (define (average a b) (/ (+ a b) 2)) (define (print-point p) (newline) (display "(") (display (x-point p)) (display ",") (display (y-point p)) (display ")")) ================================================ FILE: scheme/sicp/02/03.scm ================================================ ; SICP exercise 2.03 ; ; Implement a representation for rectangles in a plane. (Hint: You may want to ; make use of exercise 2.2.) In terms of your constructors and selectors, ; create procedures that compute the perimeter and the area of a given ; rectangle. Now implement a different representation of rectangles. Can you ; design your system with suitable abstraction barriers, so that the same ; perimeter and area procedures will work using either representation? ; Of course I can! Here it is: (define (perimeter rectangle) (let ((top-left (top-left-rectangle rectangle)) (bottom-right (bottom-right-rectangle rectangle))) (* (+ (abs (- (x-point bottom-right) (x-point top-left))) (abs (- (y-point bottom-right) (y-point top-left)))) 2))) (define (area rectangle) (let ((top-left (top-left-rectangle rectangle)) (bottom-right (bottom-right-rectangle rectangle))) (abs (* (- (x-point bottom-right) (x-point top-left)) (- (y-point bottom-right) (y-point top-left)))))) ; This is the first representation of rectangles I used: (define (make-rectangle top-left bottom-right) (cons top-left bottom-right)) (define (top-left-rectangle rectangle) (car rectangle)) (define (bottom-right-rectangle rectangle) (cdr rectangle)) ; This is the second: (define (make-rectangle top-left bottom-right) (let ((width (abs (- (x-point bottom-right) (x-point top-left)))) (height (abs (- (y-point bottom-right) (y-point top-left))))) (cons top-left (cons width height)))) (define (top-left-rectangle rectangle) (car rectangle)) (define (bottom-right-rectangle rectangle) (let ((top-left (car rectangle)) (width (car (cdr rectangle))) (height (cdr (cdr rectangle)))) (make-point (+ (x-point top-left) width) (+ (y-point top-left) height)))) ; And this is the point: (define (make-point x y) (cons x y)) (define (x-point point) (car point)) (define (y-point point) (cdr point)) ================================================ FILE: scheme/sicp/02/04.scm ================================================ ; SICP exercise 2.04 ; ; Here is an alternative procedural representation of pairs. For this ; representation, verify that (car (cons x y)) yields x for any objects x and ; y. ; ; (define (cons x y) ; (lambda (m) (m x y))) ; ; (define (car z) ; (z (lambda (p q) p))) ; ; What is the corresponding definition of cdr? (Hint: To verify that this ; works, make use of the substitution model of section 1.1.5.) ; Let's first expand it: ; ; (car (cons x y)) ; (car (lambda (m) (m x y))) ; ((lambda (m) (m x y)) (lambda (p q) p)) ; ((lambda (p q) p) x y) ; x ; ; Duh. ; ; As for cdr: ; ; (define (cdr z) ; (z (lambda (p q) q))) ================================================ FILE: scheme/sicp/02/05.scm ================================================ ; SICP exercise 2.05 ; ; Show that we can represent pairs of nonnegative integers using only numbers ; and arithmetic operations if we represent the pair a and b as the integer ; that is the product 2ª3ᵇ. Give the corresponding definitions of the ; procedures cons, car and cdr. (define (cons a b) (* (expt 2 a) (expt 3 b))) (define (car pair) (count-divisor pair 2)) (define (cdr pair) (count-divisor pair 3)) (define (count-divisor number divisor) (define (iter number result) (if (= (remainder number divisor) 0) (iter (quotient number divisor) (+ result 1)) result)) (iter number 0)) ================================================ FILE: scheme/sicp/02/06.scm ================================================ ; SICP exercise 2.06 ; ; In case representing pairs as procedures wasn't mind-boggling enough, ; consider that, in a language that can manipulate procedures, we can get by ; without numbers (at least insofar as nonnegative integers are concerned) by ; implementing 0 and the operation of adding 1 as ; ; (define zero (lambda (f) (lambda (x) x))) ; ; (define (add-1 n) ; (lambda (f) (lambda (x) (f ((n f) x))))) ; ; This representation is known as Church numerals, after its inventor, Alonzo ; Church, the logician who invented the λ calculus. ; ; Define one and two directly (not in terms of zero and add-1). (Hint: Use ; substitution to evaluate (add-1 zero)). Give a direct definition of the ; addition procedure (not in terms of repeated application of add-1). ; It was mind-boggling enough, but I am going to do the exercise anyway. ; ; This is one: ; ; (add-1 zero) ; (add-1 (lambda (f) (lambda (x) x))) ; (lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) x)) f) x)))) ; ...which essentially is... ; (lambda (f) (lambda (x) (f x))) (define one (lambda (f) (lambda (x) (f x)))) ; And this is two: ; ; (add-1 one) ; (add-1 (lambda (f) (lambda (x) (f x)))) ; (lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) (f x))) f) x)))) ; ...which essentially is... ; (lambda (f) (lambda (x) (f (f x)))) (define two (lambda (f) (lambda (x) (f (f x))))) ; Therefore, to add a to b, we have to apply f a + b times. (define (add a b) (lambda (f) (lambda (x) ((a f) ((b f) x))))) ================================================ FILE: scheme/sicp/02/07.scm ================================================ ; SICP exercise 2.07 ; ; Alyssa's program is incomplete because she has not specified the ; implementation of the interval abstraction. Here is a definition of the ; interval constructor: ; ; (define (make-interval a b) (cons a b)) ; ; Define selectors upper-bound and lower-bound to complete the implementation. (define (make-interval a b) (cons a b)) (define (upper-bound interval) (cdr interval)) (define (lower-bound interval) (car interval)) ================================================ FILE: scheme/sicp/02/08.scm ================================================ ; SICP exercise 2.08 ; ; Using reasoning analogous to Alyssa's, describe how the difference of two ; intervals may be computed. Define a corresponding subtraction procedure, ; called sub-interval. ; We can be extremely elaborate here, but I don't really want to go there. ; Simply, the minimum is the lower bound of the minuend minus the upper bound ; of the subtrahend and vica-versa. ; ; Here's the code. (define (sub-interval x y) (make-interval (- (lower-bound x) (upper-bound y)) (- (upper-bound x) (lower-bound y)))) (define (make-interval a b) (cons a b)) (define (upper-bound interval) (cdr interval)) (define (lower-bound interval) (car interval)) ================================================ FILE: scheme/sicp/02/09.scm ================================================ ; SICP exercise 2.09 ; ; The width of an interval is half of the difference between its upper and ; lower bounds. The width is a measure of the uncertainty of the number ; specified by the interval. For some arithmetic operations the width of the ; result of combining two intervals is a function only of the widths of the ; argument intervals, whereas for others the width of the combination is not a ; function of the widths of the argument intervals. Show that the width of the ; sum (or difference) of two intervals is a function only of the widths of the ; intervals being added (or subtracted). Give examples to show that this is not ; true for multiplication or division. ; Let's have two intervals: ; ; i₁ = (l₁, u₁) ; i₂ = (l₂, u₂) ; ; With respective widths: ; ; w₁ = (u₁ - l₁)/2 ; w₂ = (u₂ - l₂)/2 ; ; When adding i₁ to i₂, we get: ; ; i₃ = i₂ + i₁ = (l₁ + l₂, u₁ + u₂) ; w₃ = (u₁ + u₂)/2 - (l₁ + l₂)/2 = (u₁ - l₁)/2 + (u₂ - l₂)/2 = (w₁ + w₂)/2 ; ; When subtracting, we get: ; ; i₃ = i₂ - i₁ = (l₂ - u₁, u₂ - l₁) ; w₃ = (u₂ - l₁)/2 - (l₂ - u₁)/2 = (u₁ + u₂)/2 - (l₁ + l₂)/2 = (w₁ + w₂)/2 ; ; Now, let's take a look at multiplication. Let's take two pairs: ; ; (1, 2) x (3, 4) = (3, 8) ; (3, 4) x (5, 6) = (15, 24) ; ; Both pairs have intervals with the same width, but the the resulting ; intervals have different widths. ; ; Let's take a look at division: ; ; (1, 2) ÷ (3, 4) = (1/4, 2/3) ; (3, 4) ÷ (5, 6) = (1/2, 4/5) ; ; Again, the intervals have different widths. ================================================ FILE: scheme/sicp/02/10.scm ================================================ ; SICP exercise 2.10 ; ; Ben Bitdiddle, an expert systems programmer, looks over Alyssa's shoulder and ; comments that it is not clear what it means to divide by an interval that ; spans zero. Modify Alyssa's code to check for this condition and to signal an ; error if it occurs. (define (div-interval x y) (if (and (<= (lower-bound y) 0) (<= 0 (upper-bound y))) (error "Cannot divide by an interval that spans zero") (mul-interval x (make-interval (/ 1.0 (upper-bound y)) (/ 1.0 (lower-bound y)))))) (define (mul-interval x y) (let ((p1 (* (lower-bound x) (lower-bound y))) (p2 (* (lower-bound x) (upper-bound y))) (p3 (* (upper-bound x) (lower-bound y))) (p4 (* (upper-bound x) (upper-bound y)))) (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4)))) (define (make-interval a b) (cons a b)) (define (upper-bound interval) (cdr interval)) (define (lower-bound interval) (car interval)) ================================================ FILE: scheme/sicp/02/11.scm ================================================ ; SICP exercise 2.11 ; ; In passing, Ben also cryptically comments: "By testing the signs of the ; endpoints of the intervals, it is possible to break mul-interval into nine ; cases, only one of which requires more than two multiplications." Rewrite ; this procedure using Ben's suggestion. ; Let's have (a, b) x (c, d). ; ; We know that a ≤ b and c ≤ d. Thus, we have the following cases: ; ; +---+---+---+---+----------------------------+ ; | a | b | c | d | result | ; +---+---+---+---+----------------------------+ ; | + | + | + | + | (ac, bd) | ; +---+---+---+---+----------------------------+ ; | + | + | - | + | (bc, bd) | ; +---+---+---+---+----------------------------+ ; | + | + | - | - | (bc, ad) | ; +---+---+---+---+----------------------------+ ; | - | + | + | + | (ad, bd) | ; +---+---+---+---+----------------------------+ ; | - | + | - | + | (min(ad, bc), max(ac, bd)) | ; +---+---+---+---+----------------------------+ ; | - | + | - | - | (bc, ac) | ; +---+---+---+---+----------------------------+ ; | - | - | + | + | (ad, bc) | ; +---+---+---+---+----------------------------+ ; | - | - | - | + | (ad, ac) | ; +---+---+---+---+----------------------------+ ; | - | - | - | - | (bd, ac) | ; +---+---+---+---+----------------------------+ ; ; Hence, the code (define (mul-interval x y) (define (pos? number) (<= 0 number)) (define (neg? number) (<= number 0)) (let ((a (lower-bound x)) (b (upper-bound x)) (c (lower-bound y)) (d (upper-bound y))) (cond ((and (pos? a) (pos? b) (pos? c) (pos? d)) (make-interval (* a c) (* b d))) ((and (pos? a) (pos? b) (neg? c) (pos? d)) (make-interval (* b c) (* b d))) ((and (pos? a) (pos? b) (neg? c) (neg? d)) (make-interval (* b c) (* a d))) ((and (neg? a) (pos? b) (pos? c) (pos? d)) (make-interval (* a d) (* b d))) ((and (neg? a) (pos? b) (neg? c) (pos? d)) (make-interval (min (* a d) (* b c)) (max (* a c) (* b d)))) ((and (neg? a) (pos? b) (neg? c) (neg? d)) (make-interval (* b c) (* a c))) ((and (neg? a) (neg? b) (pos? c) (pos? d)) (make-interval (* a d) (* b c))) ((and (neg? a) (neg? b) (neg? c) (pos? d)) (make-interval (* a d) (* a c))) ((and (neg? a) (neg? b) (neg? c) (neg? d)) (make-interval (* b d) (* a c)))))) (define (make-interval a b) (cons a b)) (define (upper-bound interval) (cdr interval)) (define (lower-bound interval) (car interval)) ================================================ FILE: scheme/sicp/02/12.scm ================================================ ; SICP exercise 2.12 ; ; Define a constructor make-center-percent that takes a center and a percentage ; tolerance and produces the desired interval. You must also define a selector ; percent that produces the percentage tolerance for a given interval. The ; center selector is the same as the one shown above. (define (make-center-percent value tolerance) (let ((width (* value (/ tolerance 100)))) (make-interval (- value tolerance) (+ value tolerance)))) (define (percent i) (* (/ (width i) (center i)) 100)) (define (center i) (/ (+ (lower-bound i) (upper-bound i)) 2)) (define (width i) (/ (- (upper-bound i) (lower-bound i)) 2)) (define (make-interval x y) (cons x y)) (define (upper-bound i) (cdr i)) (define (lower-bound i) (car i)) ================================================ FILE: scheme/sicp/02/13.scm ================================================ ; SICP exercise 2.13 ; ; Show that under the assumption of small percentage tolerances there is a ; simple formula for the approximate percentage tolerance of the product of two ; intevals in terms of the tolerances of the factors. You may simplify the ; problem by assuming that all numbers are positive. ; Let's assume have the following intervals ; ; i₁ = ((1 - 0.5t₁)x, (1 + 0.5t₁)x) ; i₂ = ((1 - 0.5t₂)y, (1 + 0.5t₂)y) ; ; If we multiply them, we get ; ; i₃ = i₁i₂ = (l, u), where ; ; l = (1 - 0.5t₁)(1 - 0.5t₂)xy = 1 - 0.5t₁ - 0.5t₂ + 0.25t₁t₂ ; u = (1 + 0.5t₁)(1 + 0.5t₂)xy = 1 + 0.5t₁ + 0.5t₂ + 0.25t₁t₂ ; ; We know that t₁ and t₂ are very small, which means that t₁t₂ is neglectable. ; If we ignore it, we get the interval: ; ; i₃ = ((1 - 0.5(t₁ + t₂))xy, (1 + 0.5(t₁ + t₂))xy) ; ; Thus, the formula is: ; ; t₃ = t₁ + t₂ ================================================ FILE: scheme/sicp/02/14.scm ================================================ ; SICP exercise 2.14 ; ; Demonstrate that Lem is right. Investigate the behavior of the system on a ; variety of arithmetic expressions. Make some intervals A and B, and use them ; in computing the expressions A/A and A/B. You will get the most insight by ; using intervals whose width is a small percentage of the center value. ; Examine the results of the computation in center-percent form (see exercise ; 2.12). ; Here is all the code we will need: (define (par1 r1 r2) (div-interval (mul-interval r1 r2) (add-interval r1 r2))) (define (par2 r1 r2) (let ((one (make-interval 1 1))) (div-interval one (add-interval (div-interval one r1) (div-interval one r2))))) (define (add-interval x y) (make-interval (+ (lower-bound x) (lower-bound y)) (+ (upper-bound x) (upper-bound y)))) (define (mul-interval x y) (let ((p1 (* (lower-bound x) (lower-bound y))) (p2 (* (lower-bound x) (upper-bound y))) (p3 (* (upper-bound x) (lower-bound y))) (p4 (* (upper-bound x) (upper-bound y)))) (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4)))) (define (div-interval x y) (mul-interval x (make-interval (/ 1.0 (upper-bound y)) (/ 1.0 (lower-bound y))))) (define (make-interval x y) (cons x y)) (define (lower-bound x) (car x)) (define (upper-bound x) (cdr x)) (define (percent i) (* (/ (width i) (center i)) 100)) (define (center i) (/ (+ (lower-bound i) (upper-bound i)) 2)) (define (width i) (/ (- (upper-bound i) (lower-bound i)) 2)) (define (display-interval leading-text interval) (display leading-text) (display ": center = ") (display (center interval)) (display ", percent = ") (display (percent interval)) (newline)) ; Here are the A and B intervals (define A (make-interval 99.9 100.1)) (define B (make-interval 199.9 200.1)) (define one (make-interval 1.0 1.0)) (define parallel-resistance (/ 1.0 (+ (/ 1.0 (center A)) (/ 1.0 (center B))))) (display-interval "A" A) (display-interval "B" B) (display-interval "par1" (par1 A B)) (display-interval "par2" (par2 A B)) (display "The parallel resistance of the two is ") (display parallel-resistance) (newline) (newline) ; So far we have the following output ; ; A: center = 100.0, percent = 0.09999999999999432 ; B: center = 200.0, percent = 0.04999999999999716 ; par1: center = 66.66679629635391, percent = 0.2166663750004245 ; par2: center = 66.66666296296133, percent = 0.08333334166667185 ; ; The parallel resistance of the two is 66.66666666666667 ; ; We can see that par2 has smaller width and more accurate center. Let's check ; out A/A and A/B (display-interval "A/A" (div-interval A A)) (display-interval "A/B" (div-interval A B)) (display-interval "A+A" (add-interval A A)) (newline) ; This time we get: ; ; A/A: center = 1.000002000002, percent = 0.19999980000019435 ; A/B: center = 0.5000003750000938, percent = 0.14999992500003134 ; A+A: center = 200.0, percent = 0.09999999999999432 ; ; We see that addition preserves the tolerance in percentage, but ; multiplication and division add them together. Let's take a look at the ; parts of par1 and par2 (display "Let's do par1 first:\n") (display-interval "AB" (mul-interval A B)) (display-interval "A + B" (add-interval A B)) (display-interval "AB/(A + B)" (div-interval (mul-interval A B) (add-interval A B))) (newline) (display "Now par2:\n") (display-interval "1/A" (div-interval one A)) (display-interval "1/B" (div-interval one B)) (display-interval "1/A + 1/B" (add-interval (div-interval one A) (div-interval one B))) (display-interval "1/(1/A + 1/B)" (par2 A B)) (newline) ; This is the output: ; ; Let's do par1 first: ; AB: center = 20000.010000000002, percent = 0.14999992500002837 ; A + B: center = 300.0, percent = 0.06666666666666288 ; AB/(A + B): center = 66.66679629635391, percent = 0.2166663750004245 ; ; Now par2: ; 1/A: center = 0.010000010000009999, percent = 0.09999999999999962 ; 1/B: center = 0.0050000012500003126, percent = 0.04999999999999587 ; 1/A + 1/B: center = 0.015000011250010312, percent = 0.08333334166666921 ; 1/(1/A + 1/B): center = 66.66666296296133, percent = 0.08333334166667185 ; ; We can see that we loose precision on every multiplication and division - the ; tolerance in percentage is of both factors is added together. Generally, ; addition decreases the tolerance in percentage whe adding positive numbers ; (that's not entirely true). ; ; In par2 we just do one addition, which decreases the tolerance under 0.01%, ; while in par1 we first do a multiplication and then a division, that gets the ; tolerance up to 0.21%. ; ; And just for a final illustration: (display-interval "A*A/A" (div-interval (mul-interval A A) A)) ; This resuls to: ; ; A*A/A: center = 100.00040000039999, percent = 0.29999920000237845 ; ; The real answer he is A, but the arithmetic gymnastics triple the tolerance. ================================================ FILE: scheme/sicp/02/15.scm ================================================ ; SICP exercise 2.15 ; ; Eva Lu Ator, another user, has also noticed the different intervals computed ; by different but algebraically equivalent expressions. She says that a ; formula to compute with intervals using Alyssa's system will produce tighter ; error bounds if it can be written in such a form that no variable that ; represents an uncertain number is repeated. Thus, she says, par2 is a ; "better" program for parallel resistances than par1. Is she right? Why? ; She is definitelly right. ; ; It is easy to see from the results of exercise 2.14 that the more we perform ; operations with uncertain quantities, the bigger error we get. It is ; important to note, that this applies mainly to multiplication and division. ; 2A is exactly the same as AA. ================================================ FILE: scheme/sicp/02/16.scm ================================================ ; SICP exercise 2.16 ; ; Explain, in general, why equivalent algebraic expressions may lead to ; different answers. Can you devise an interval-arithmetic package that does ; not have this shortcoming, or is this task impossible? (Warning: This problem ; is very difficult.) ; After doing exercise 2.14, it is very easy to see that multiplying and ; dividing uncertain quantities increases the uncertainty. AA/A is equivalent ; to A, but the error margin is three times bigger. The less we use an ; uncertain quantity in an operation, the smaller tolerance we get. ; ; As for addressing the shortcoming, the only way I can figure out is to ; have the program simplify the expression as much as possible before ; calculating it. I assume that this requires some serious mathematical ; and computer science foundations, that I currently lack. ; ; One idea is to calculate this the expressions lazily. We can collect a tree ; that represents the expression, until the result needs to be calculated. At ; that point, we can simplify the expression and return the result. This won't ; reduce the error margin, but may provide a nicer API. ================================================ FILE: scheme/sicp/02/17.scm ================================================ ; SICP exercise 2.17 ; ; Define a procedure last-pair that returns the list that contains only the last ; element of a given (nonempty) list: ; ; (list-pair (list 23 72 149 34)) ; (34) (define (last-pair items) (if (null? (cdr items)) items (last-pair (cdr items)))) ================================================ FILE: scheme/sicp/02/18.scm ================================================ ; SICP exercise 2.18 ; ; Define a procedure reverse that takes a list as argument and returns a list ; of the same elements in reverse order: ; ; (reverse (list 1 4 9 16 25)) ; (25 16 9 4 1) ; Here is a lame version: (define (reverse items) (if (null? items) items (append (reverse (cdr items)) (list (car items))))) ; Here's an alternative that's way better: (define (reverse items) (define (iter items result) (if (null? items) result (iter (cdr items) (cons (car items) result)))) (iter items (list))) ================================================ FILE: scheme/sicp/02/19.scm ================================================ ; SICP exercise 2.19 ; ; Consider the change-counting program of Section 1.2.2. It would be nice to be ; able to easily change the currency used by the program, so that we could ; compute the number of ways to change a British pound, for example. As the ; program is written, the knowledge of the currency is distributed partly into ; the procedure first-denomination and partly into the procedure count-change ; (which knows that there are five kinds of U.S. coins). It would be nicer to ; be able to supply a list of coins to be used for making change. ; ; We want to rewrite the procedure cc so that its second argument is a list ; of the values of the coins to use rather than an integer specifying which ; coins to use. We could then have lists that defined each kind of currency: ; ; (define us-coins (list 50 25 10 5 1)) ; (define uk-coins (list 100 50 20 10 5 2 1 0.5)) ; ; We could then call cc as follows: ; ; (cc 100 us-coins) ; 292 ; ; To do this will require changing the program cc somewhat. It will still have ; the same form, but it will access its second argument differently, as follows: ; ; (define (cc amount coin-values) ; (cond ((= amount 0) 1) ; ((or (< amount 0) (no-more? coin-values)) 0) ; (else ; (+ (cc amount ; (except-first-denomination ; coin-values)) ; (cc (- amount ; (first-denomination coin-values)) ; coin-values))))) ; ; Define the procedures first-denomination, except-first-denomination and ; no-more? in terms of primitive operations on list structures. Does the order ; of the list coin-values affect the answer produced by cc? Why or why not? ; The definitions are below. ; ; The order does not affect the value produced by cc. The procedure does not ; depend on it in any way. There can be a difference in the time takes to ; calculate the result, though. (define (cc amount coin-values) (cond ((= amount 0) 1) ((or (< amount 0) (no-more? coin-values)) 0) (else (+ (cc amount (except-first-denomination coin-values)) (cc (- amount (first-denomination coin-values)) coin-values))))) (define (no-more? coins) (null? coins)) (define (first-denomination coins) (car coins)) (define (except-first-denomination coins) (cdr coins)) ================================================ FILE: scheme/sicp/02/20.scm ================================================ ; SICP exercise 2.20 ; ; The procedures +, * and list take arbitrary number of arguments. One way to ; define such procedures is to use define with dotted-tail notation. In a ; procedure definition, a parameter list that has a dot before the last ; parameter name indicates that, when a procedure is called, the initial ; parameters (if any) will have as values the initial arguments, as usual, but ; the final parameter's value will be a list of any remaining arguments. For ; instance, given the definition ; ; (define (f x y . z) ) ; ; the procedure f can be called with two or more arguments. If we evaluate ; ; (f 1 2 3 4 5 6) ; ; then in the body of f, x will be 1, y will be 2, and z will be the list (3 4 5 6). ; Given the definition ; ; (define (g . w) ) ; ; the procedure g can be called with zero or more arguments. If we evaluate ; ; (g 1 2 3 4 5 6) ; ; then in the body of g, w will be the list (1 2 3 4 5 6). ; ; Use this notation to write a procedure same-parity that takes one or more ; integers and returns a list of all the arguments that have the same even-odd ; parity as the first argument. For example: ; ; (same-parity 1 2 3 4 5 6 7) ; (1 3 5 7) ; ; (same-parity 2 3 4 5 6 7) ; (2 4 6) (define (same-parity number . numbers) (define (same-parity? n) (= (remainder number 2) (remainder n 2))) (define (filter-list numbers) (cond ((null? numbers) (list)) ((same-parity? (car numbers)) (cons (car numbers) (filter-list (cdr numbers)))) (else (filter-list (cdr numbers))))) (cons number (filter-list numbers))) ================================================ FILE: scheme/sicp/02/21.scm ================================================ ; SICP exercise 2.21 ; ; The procedure square-list takes a list of numbers as arguments and returns a ; list of the squares of those numbers. ; ; (square-list (list 1 2 3 4)) ; (1 4 9 16) ; ; Here are two different definitions of square-list. Complete both of the by ; filling in the missing expressions: ; ; (define (square-list items) ; (if (null? items) ; nil ; (cons ))) ; ; (define (square-list items) ; (map )) (define (square-list-1 items) (if (null? items) '() (cons (square (car items)) (square-list-1 (cdr items))))) (define (square-list-2 items) (map square items)) (define (square x) (* x x)) ================================================ FILE: scheme/sicp/02/22.scm ================================================ ; SICP exercise 2.22 ; ; Louis Reasoner tries to rewrite the first square-list procedure on Exercise 2.21 ; so that it evolves an iterative process: ; ; (define (square-list items) ; (define (iter things answer) ; (if (null? things) ; answer ; (iter (cdr things) ; (cons (square (car things)) ; answer)))) ; (iter items nil)) ; ; Unfortunatelly, defining square-list this way produces the answer list in the ; reverse order of the one desired. Why? ; ; Louis then tries to fix his bug by interchanging the arguments to cons: ; ; (define (square-list items) ; (define (iter things answer) ; (if (null? things) ; answer ; (iter (cdr things) ; (cons answer ; (square (car things)))))) ; (iter items nil)) ; ; This doesn't work either. Explain. ; In the first program, we are accumulating the answer by adding the square of ; each item to the front of the list. It is easy to see that (car items) ; becomes the last element of answer, (cadr items) becomes the second to last ; and so on. ; ; As for the second version, the result is not a list. It is a pair, where the ; cdr in the squared item and the car is a pair with the next square (stored in ; the cadr of result). Furthermore, it is still in the wrong order. ================================================ FILE: scheme/sicp/02/23.scm ================================================ ; SICP exercise 2.23 ; ; The procedure for-each is similar to map. It takes as arguments a procedure ; and a list of elements. However, rather than forming a list of the results, ; for-each just applies the procedure to each of the elements in turn, from ; left to right. The values returned by applying the procedure to the elements ; are not used at all - for-each is used with procedures that perform an action ; such as printing. For example, ; ; (for-each (lambda (x) (newline) (display x)) ; (list 57 321 88)) ; ; The value returned by the call to for-each (not illustrated above) can be ; something arbitrary, such as true. Give an implementation of for-each. (define (for-each function items) (cond ((null? items) true) (else (function (car items)) (for-each function (cdr items))))) ================================================ FILE: scheme/sicp/02/24.scm ================================================ ; SICP exercise 2.24 ; ; Suppose we evaluate the expression (list 1 (list 2 (list 3 4))). Give the ; result printed by the interpreter, the corresponding box-and-pointer ; structure, and the interpretation of this as a tree (as in Figure 2.6). ; The interpreter will print: ; ; (1 (2 (3 4))) ; ; This is the "box-and-pointer" structure. I quote it because of the ASCII. ; ; +---+---+ +---+---+ ; --> | o | o-+----> | o | / | ; +-|-+---+ +-|-+---+ ; | | ; | | ; +---+ +---+---+ +---+---+ ; | 1 | | o | o------> | o | / | ; +---+ +-|-+---+ +-|-+---+ ; | | ; | | ; +---+ +---+---+ +---+---+ ; | 2 | | o | o------> | o | / | ; +---+ +-|-+---+ +-|-+---+ ; | | ; | | ; +---+ +---+ ; | 3 | | 4 | ; +---+ +---+ ; ; Here's the tree: ; ; o (1 (2 (3 4))) ; / \ ; / \ ; 1 o (2 (3 4) ; / \ ; / \ ; 2 o (3 4) ; / \ ; / \ ; 3 4 ================================================ FILE: scheme/sicp/02/25.scm ================================================ ; SICP exercise 2.25 ; ; Give combinations of cars and cdrs that will pick 7 from each of the ; following lists: ; ; (1 3 (5 7) 9) ; ((7)) ; (1 (2 (3 (4 (5 (6 7)))))) ; Simple: ; ; (car (cdr (car (cdr (cdr '(1 3 (5 7) 9)))))) ; 7 ; (car (car '((7)))) ; 7 ; (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr '(1 (2 (3 (4 (5 (6 7)))))))))))))))))) ; 7 ================================================ FILE: scheme/sicp/02/26.scm ================================================ ; SICP exercise 2.26 ; ; Suppose we define x and y to be two lists: ; ; (define x (list 1 2 3)) ; ; (define y (list 4 5 6)) ; ; What result is printed by the interpreter in response evaluating each of the ; following expressions: ; ; (append x y) ; ; (cons x y) ; ; (list x y) ; Another simple one: ; ; (append x y) ; (1 2 3 4 5 6) ; ; (cons x y) ; ((1 2 3) 4 5 6) ; ; (list x y) ; ((1 2 3) (4 5 6)) ================================================ FILE: scheme/sicp/02/27.scm ================================================ ; SICP exercise 2.27 ; ; Modify your reverse procedure in exercise 2.18 to produce a deep-reverse ; procedure that takes a list as argument and returns as its value the list ; with its elements reversed and with all sublists deep-reversed as well. For ; example, ; ; (define x (list (list 1 2) (list 3 4))) ; ; x ; ((1 2) (3 4)) ; ; (reverse x) ; ((3 4) (1 2)) ; ; (deep-reverse x) ; ((4 3) (2 1)) (define (deep-reverse items) (define (iter items result) (cond ((null? items) result) ((pair? (car items)) (iter (cdr items) (cons (deep-reverse (car items)) result))) (else (iter (cdr items) (cons (car items) result))))) (iter items (list))) ================================================ FILE: scheme/sicp/02/28.scm ================================================ ; SICP exercise 2.28 ; ; Write a procedure fringe that takes as argument a tree (represented as a ; list) and returns a list whose elements are all the leaves of the tree ; arranged in left-to-right order. For example, ; ; (define x (list (list 1 2) (list 3 4))) ; ; (fringe x) ; (1 2 3 4) ; ; (fringe (list x x)) ; (1 2 3 4 1 2 3 4) ; Here's a recursive version: (define (fringe tree) (cond ((null? tree) tree) ((pair? tree) (append (fringe (car tree)) (fringe (cdr tree)))) (else (list tree)))) ; I'm not too happy about it, so I am also going to make an iterative version ; that does not use append or reverse. (define (fringe tree) (define (iter left bottom result) (cond ((and (null? left) (null? bottom)) result) ((null? bottom) (iter (cdr left) (car left) result)) ((pair? bottom) (iter (cons (car bottom) left) (cdr bottom) result)) (else (iter left '() (cons bottom result))))) (iter '() tree '())) ================================================ FILE: scheme/sicp/02/29.scm ================================================ ; SICP exercise 2.29 ; ; A binary mobile consists of two branches, a left branch and a right branch. ; Each branch is a rod of certain length, from which hangs either a weight or ; another binary mobile. We can represent a binary mobile using compund data by ; constructing it from two branches (for example, using list): ; ; (define (make-mobile left right) ; (list left right)) ; ; A branch is constructed from a length (which must be a number) together with ; a structure, which may be either a number (representing a simple weight) or ; another mobile: ; ; (define (make-branch length structure) ; (list length structure)) ; ; a. Write the corresponding selectors left-branch and right-branch, which ; return the branches of a mobile, and branch-length and branch-structure, ; which return the components of a branch. ; ; b. Using your selectors, define a procedure total-weight that returns the ; total weight of a mobile. ; ; c. A mobile is said to be balanced if the torque applied by its top-left ; branch is equal to that applied by its top-right branch (that is, if the ; length of the left rod multiplied by the weight hanging from that rod is ; equal to the corresponding product of the right side) and if each of the ; submobiles hanging off its branches is balanced. Design a predicate that ; tests whether a binary mobile is balanced. ; ; d. Suppose we change the representation of mobiles so that the constructors ; are ; ; (define (make-mobile left right) ; (cons left right)) ; ; (define (make-branch length structure) ; (cons length structure)) ; ; How much do you need to change your programs to convert to the new ; representation? (define (make-mobile left right) (list left right)) (define (make-branch length structure) (list length structure)) ; a. ; ; Here are the selectors, with a little extra: (define (left-branch mobile) (car mobile)) (define (right-branch mobile) (cadr mobile)) (define (branch-length branch) (car branch)) (define (branch-structure branch) (cadr branch)) (define (weight? structure) (not (pair? structure))) ; b. ; ; This is total-weight. It depends on an additional selector. (define (total-weight structure) (if (weight? structure) structure (+ (total-weight (branch-structure (left-branch structure))) (total-weight (branch-structure (right-branch structure)))))) ; c. ; ; Testing whether a mobile is balanced is a bit messy. It also makes use of ; weight? (define (balanced? mobile) (define (torque branch) (* (branch-length branch) (total-weight (branch-structure branch)))) (define (balanced-submobile? branch) (or (weight? (branch-structure branch)) (balanced? (branch-structure branch)))) (let ((left (left-branch mobile)) (right (right-branch mobile))) (and (= (torque left) (torque right)) (balanced-submobile? left) (balanced-submobile? right)))) ; d. ; ; Let's just do it: (define (make-mobile left right) (cons left right)) (define (make-branch length structure) (cons length structure)) ; This is what has to change (define (right-branch mobile) (cdr mobile)) (define (branch-structure branch) (cdr branch)) ; That way we accomplish a neat abstraction barrier. If we delete the last four ; definitions, the tests will continue to pass. ================================================ FILE: scheme/sicp/02/30.scm ================================================ ; SICP exercise 2.30 ; ; Define a procedure square-tree analogous to the square-list procedure of ; exercise 2.21. Thas is, square-tree should behave as follows: ; ; (square-tree ; (list 1 ; (list 2 (list 3 4) 5) ; (list 6 7))) ; (1 (4 (9 16) 25) (36 49))) ; ; Define square-tree both directly (i.e., without using any higher-order ; procedures) and also by using map and recursion. (define (square-tree tree) (cond ((null? tree) '()) ((not (pair? tree)) (* tree tree)) (else (cons (square-tree (car tree)) (square-tree (cdr tree)))))) (define (square-tree tree) (map (lambda (tree) (if (pair? tree) (square-tree tree) (* tree tree))) tree)) ================================================ FILE: scheme/sicp/02/31.scm ================================================ ; SICP exercise 2.31 ; ; Abstract your answers to exercise 2.30 to produce a procedure tree-map with ; the property that square-tree could be defined as ; ; (define (square-tree tree) (tree-map square tree)) (define (tree-map function tree) (cond ((null? tree) (list)) ((not (pair? tree)) (function tree)) (else (cons (tree-map function (car tree)) (tree-map function (cdr tree)))))) (define (square-tree tree) (tree-map square tree)) (define (square x) (* x x)) ================================================ FILE: scheme/sicp/02/32.scm ================================================ ; SICP exercise 2.32 ; ; We can represent a set as a list of distinct elements, and we can represent ; the set of all subsets of the set as a list of lists. For example, if the set ; is (1 2 3), then the set of all subsets is (() (3) (2) (2 3) (1) (1 3) (1 2) ; (1 2 3)). Complete the following definition of a procedure that generates the ; set of subsets of a set and give a clear explanation of why it works: ; ; (define (subsets s) ; (if (null? s) ; (list (list)) ; (let ((rest (subsets (cdr s)))) ; (append rest (map rest))))) ; Easy (define (subsets s) (if (null? s) (list (list)) (let ((rest (subsets (cdr s)))) (append rest (map (lambda (subset) (cons (car s) subset)) rest))))) ; It works, because the subsets of a set are all the subsets that don't contain ; the first element plus all the subsets that do. ================================================ FILE: scheme/sicp/02/33.scm ================================================ ; SICP exercise 2.33 ; ; Fill in the missing expressions to complete the following definitions of some ; basic list-manipulation operations as accumulations: ; ; (define (map p sequence) ; (accumulate (lambda (x y) ) nil sequence)) ; ; (define (append seq1 seq2) ; (accumulate cons )) ; ; (define (length sequence) ; (accumulate 0 sequence)) (define (map p sequence) (accumulate (lambda (x y) (cons (p x) y)) nil sequence)) (define (append seq1 seq2) (accumulate cons seq2 seq1)) (define (length sequence) (accumulate (lambda (_ result) (+ result 1)) 0 sequence)) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define nil '()) ================================================ FILE: scheme/sicp/02/34.scm ================================================ ; SICP exercise 2.34 ; ; Evaluating a polynomial in x at a given value of x can be formulated as an ; accumulation. We evaluate the polynomial ; ; aᵢxⁱ + aᵢ₋₁xⁱ⁻¹ + … + a₁x + a₀ ; ; using a well-known algorithm called Horner's rule, which structures the ; computation as ; ; (…(aᵢx + aᵢ₋₁)x + … + a₁)x + a₀ ; ; In other words, we start with aᵢ, multiply by x, add aᵢ₋₁, multiply by x, and ; so on, until we reach a₀. ; ; Fill in the following template to produce a procedure that evaluates a ; polynomial using Horner's rule. Assume that the coefficients of the ; polynomial are arranged in a sequence, from a₀ through aᵢ. ; ; (define (horner-eval x coefficient-sequence) ; (accumulate (lambda (this-coeff higher-terms) ) ; 0 ; coefficient-sequence) ; ; For example, to compute 1 + 3x + 5x³ + x⁵ at x = 2 you would evaluate ; ; (horner-eval 2 (list 1 3 0 5 0 1)) (define (horner-eval x coefficient-sequence) (accumulate (lambda (this-coeff higher-terms) (+ (* higher-terms x) this-coeff)) 0 coefficient-sequence)) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) ================================================ FILE: scheme/sicp/02/35.scm ================================================ ; SICP exercise 2.35 ; ; Redefine count-leaves from section 2.2.2 as an accumulation: ; ; (define (count-leaves t) ; (accumulate (map ))) (define (count-leaves tree) (accumulate + 0 (map (lambda (x) (if (pair? x) (count-leaves x) 1)) tree))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) ================================================ FILE: scheme/sicp/02/36.scm ================================================ ; SICP exercise 2.36 ; ; The procedure accumulate-n is similar to accumulate except that it takes as ; its third argument a sequence of sequences, which are all assumed to have the ; same number of elements. It applies the designated accumulation procedure to ; combine all the first elements of the sequences, all the second elements of ; the sequences, and so on, and returns a sequence of the results. For ; instance, if s is a sequence containing four sequences, ; ((1 2 3) (4 5 6) (7 8 9) (10 11 12)), then the value of (accumulate-n + 0 s) ; should be the sequences (22 26 30). Fill in the missing expressions in the ; following definition of accumulate-n: ; ; (define (accumulate-n op init seqs) ; (if (null? (car seqs)) ; nil ; (cons (accumulate op init ) ; (accumulate-n op init )))) (define (accumulate-n op init seqs) (if (null? (car seqs)) nil (cons (accumulate op init (map car seqs)) (accumulate-n op init (map cdr seqs))))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define nil '()) ================================================ FILE: scheme/sicp/02/37.scm ================================================ ; SICP exercise 2.37 ; ; Suppose we represent vectors v = (vᵢⱼ) as sequences of numbers, and matrices ; m = (mᵢⱼ) as sequences of vectors (rows of the matrix). For example, the ; matrix ; ; 1 2 3 4 ; 4 5 6 6 ; 6 7 8 9 ; ; is represented as the sequence ((1 2 3 4) (4 5 6 6) (6 7 8 9)). With this ; representation, we can use sequence operations to concisely express the basic ; matrix and vector operations. These operations (which are described in any ; book on matrix algebra) are the following: ; ; (dot-product v w) returns the sum Σᵢvᵢwᵢ ; (matrix-*-vector m v) returns the vector t, where tᵢ = Σⱼmᵢⱼvⱼ ; (matrix-*-matrix m n) returns the matrix p, where pᵢⱼ = Σᵤmᵢᵤvᵤⱼ ; (transpose m) returns the matrix n, where nᵢⱼ = mⱼᵢ ; ; We can define the dot product as ; ; (define (dot-product v w) ; (accumulate + 0 (map * v w))) ; ; Fill in the missing expressions in the following procedures for computing the ; other matrix operations. (The procedure accumulate-n is defined exercise 2.36.) ; ; (define (matrix-*-vector m v) ; (map m)) ; ; (define (transpose mat) ; (accumulate-n mat)) ; ; (define (matrix-*-matrix m n) ; (let ((cols (transpose n))) ; (map m))) (define (dot-product v w) (accumulate + 0 (map * v w))) (define (matrix-*-vector m v) (map (lambda (x) (dot-product x v)) m)) (define (transpose mat) (accumulate-n cons nil mat)) (define (matrix-*-matrix m n) (let ((cols (transpose n))) (map (lambda (row) (matrix-*-vector cols row)) m))) (define (accumulate-n op init seqs) (if (null? (car seqs)) nil (cons (accumulate op init (map car seqs)) (accumulate-n op init (map cdr seqs))))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define nil '()) ================================================ FILE: scheme/sicp/02/38.scm ================================================ ; SICP exercise 2.38 ; ; The accumulate procedure is also knows as fold-right, because it combines the ; first element of the sequence with the result of combining all the elements ; to the right. There is also a fold-left, which is similar to fold-right, ; except that it combines elements working in the opposite direction: ; ; (define (fold-left op initial sequence) ; (define (iter result rest) ; (if (null? rest) ; result ; (iter (op result (car rest)) ; (cdr rest)))) ; (iter initial sequence)) ; ; What are the values of ; ; (fold-right / 1 (list 1 2 3)) ; (1 / (2 / (3 / 1))) ; (1 / (2 / 3)) ; 3 / 2 ; ; (fold-left / 1 (list 1 2 3)) ; (((1 / 1) / 2) / 3) ; (1 / 2) / 3 ; 3 / 2 ; ; (fold-right list nil (list 1 2 3)) ; '(1 (2 (3 '()))) ; ; (fold-left list nil (list 1 2 3)) ; ((('() 1) 2) 3) ; ; Give a property that op should satisfy to guarantee that fold-right and ; fold-left will produce the same values for any sequence. ; Here are the answers: ; ; (fold-right / 1 (list 1 2 3)) ; (/ 1 (/ 2 (/ 3 1))) ; (/ 1 (/ 2 3)) ; (/ 1 2/3) ; 3/2 ; ; (fold-left / 1 (list 1 2 3)) ; (/ (/ (/ 1 1) 2) 3) ; (/ (/ 1 2) 3) ; (/ 1/2 3) ; 1/6 ; ; (fold-right list nil (list 1 2 3)) ; (1 (2 (3 ()))) ; ; (fold-left list nil (list 1 2 3)) ; (((() 1) 2) 3) ; ; The property is associativity, that is: ; ; a * (b * c) = (a * b) * c ; ; where * denotes the operation ================================================ FILE: scheme/sicp/02/39.scm ================================================ ; SICP exercise 2.39 ; ; Complete the following definitions of reverse (exercise 2.18) in terms of ; fold-right and fold-left from exercise 2.38: ; ; (define (reverse sequence) ; (fold-right (lambda (x y) ) nil sequence)) ; ; (define (reverse sequence) ; (fold-left (lambda (x y) ) nil sequence)) (define (reverse-r sequence) (fold-right (lambda (x y) (append y (list x))) nil sequence)) (define (reverse-l sequence) (fold-left (lambda (x y) (cons y x)) nil sequence)) (define (fold-left op initial sequence) (define (iter result rest) (if (null? rest) result (iter (op result (car rest)) (cdr rest)))) (iter initial sequence)) (define (fold-right op initial sequence) (if (null? sequence) initial (op (car sequence) (fold-right op initial (cdr sequence))))) (define nil '()) ================================================ FILE: scheme/sicp/02/40.scm ================================================ ; SICP exercise 2.40 ; ; Define a procedure unique-pairs that, given an integer n, generates the ; sequence of pairs (i, j) with 1 ≤ j < i ≤ n. Use unique-pairs to simplify the ; definition of prime-sum-pairs given above. (define (unique-pairs n) (flatmap (lambda (a) (map (lambda (b) (list a b)) (enumerate-interval (+ a 1) n))) (enumerate-interval 1 n))) (define (prime-sum-pairs n) (filter (lambda (pair) (prime? (+ (car pair) (cadr pair)))) (unique-pairs n))) (define (enumerate-interval a b) (if (> a b) (list) (cons a (enumerate-interval (+ a 1) b)))) (define (flatmap proc seq) (accumulate append nil (map proc seq))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (prime? n) (null? (filter (lambda (x) (= 0 (remainder n x))) (enumerate-interval 2 (- n 1))))) (define nil '()) ================================================ FILE: scheme/sicp/02/41.scm ================================================ ; SICP exercise 2.41 ; ; Write a procedure to find all ordered priples of distinct positive integers ; i, j, and k less than or equal to a given integer n that sums to a given ; integer s. (define (triples-sum n s) (filter (lambda (triple) (= s (sum triple))) (enumerate-triples n))) (define (enumerate-triples n) (flatmap (lambda (a) (flatmap (lambda (b) (map (lambda (c) (list a b c)) (enumerate-interval (+ b 1) n))) (enumerate-interval (+ a 1) n))) (enumerate-interval 1 n))) (define (sum numbers) (accumulate + 0 numbers)) (define (enumerate-interval a b) (if (> a b) (list) (cons a (enumerate-interval (+ a 1) b)))) (define (flatmap proc seq) (accumulate append nil (map proc seq))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define nil '()) ================================================ FILE: scheme/sicp/02/42.scm ================================================ ; SICP exercise 2.42 ; ; The "eight-queens puzzle" asks how to place eight queens on a chessboard so ; that no queen is in check from any other (i.e., no two queens are in the same ; row, column, or diagonal). One possible solution is shown in Figure 2.8. One ; way to solve the puzzle is to work accross the board, placing a queen in each ; column. Once we have placed k - 1 queens, we must place the kth queen in a ; position where it does not check any of the queens already on the board. We ; can formulate this approach recursively: Assume that we have already ; generated the sequence of all possible ways to place k - 1 queens in the ; first k - 1 columns of the board. For each of these ways, generate an ; extended set of positions by placing a queen in each row of the kth column. ; Now filter these, keeping only the positions for which the queen in the kth ; column is safe with respect to other queens. This produces the sequence of ; all ways to place k queens in the first k columns. By continuation of this ; process, we will produce not only one solution, but all solutions to the ; puzzle. ; ; We implement this solution as a procedure queens, which returns a sequence ; of all solutions to the problem of placing n queens on n ╳ n chessboard. ; queens has an internal procedure queen-cols that returns the sequence of all ; ways to place queens in the first k columns of the board. ; ; (define (queens board-size) ; (define (queen-cols k) ; (if (= k 0) ; (list empty-board) ; (filter ; (lambda (positions) (safe? k positions)) ; (flatmap ; (lambda (rest-of-queens) ; (map (lambda (new-row) ; (adjoin-position new-row ; k ; rest-of-queens)) ; (enumerate-interval 1 board-size))) ; (queen-cols (- k 1)))))) ; (queen-cols board-size)) ; ; In this procedure rest-of-queens is a way to place k - 1 queens in the first ; k - 1 columns, and new-row is a proposed row in which to place the queen for ; the kth column. Complete the program by implementing the representation for ; sets of board positions, including the procedure adjoin-position, which ; adjoins a new row-column position to a set of positions, and empty-board, ; which represents an empty set of positions. You must also write the procedure ; safe?, which determines for a set of positions whether the queen in the kth ; column is safe with respect to the others. (Note that we need only check ; whether the new queen is safe - the other queens are already guaranteed safe ; with respet to each other). (define (queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size)) (define empty-board '()) (define (adjoin-position new-row k rest-of-queens) (cons (list new-row k) rest-of-queens)) (define (safe? k positions) (define queen-position (queen-at k positions)) (let ((q1r (car queen-position)) (q1c (cadr queen-position))) (all? (lambda (position) (let ((q2r (car position)) (q2c (cadr position))) (or (and (= q1r q2r) (= q1c q2c)) (and (not (= q1r q2r)) (not (= q1c q2c)) (not (= (+ q1r q1c) (+ q2r q2c))) (not (= (- q1r q1c) (- q2r q2c))))))) positions))) (define (queen-at column positions) (if (= column (cadar positions)) (car positions) (queen-at column (cdr positions)))) (define (all? proc seq) (cond ((null? seq) #t) ((proc (car seq)) (all? proc (cdr seq))) (else #f))) (define (enumerate-interval a b) (if (> a b) (list) (cons a (enumerate-interval (+ a 1) b)))) (define (flatmap proc seq) (accumulate append '() (map proc seq))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) ================================================ FILE: scheme/sicp/02/43.scm ================================================ ; SICP exercise 2.43 ; ; Louis Reasoner is having a terrible time doing Exercise 2.42. His queens ; procedure seems to work, but it runs extremely slow. (Louis never does manage ; to wait long enough for it to solve even the 6x6 case.) When Louis asks Eva ; Lu Ator for help, she points out that he has interchanged the order of the ; nested mappings in the flatmap, writing it as ; ; (flatmap ; (lambda (new-row) ; (map (lambda (rest-of-queens) ; (adjoin-position new-row k rest-of-queens)) ; (queen-cols (- k 1)))) ; (enumerate-interval 1 board-size)) ; ; Explain why this interchange makes the program run slowly. Estimate how long ; it will take Louis's program to solve the eight-queens puzzle, assuming that ; the program in Exercise 2.42 solves the puzzle in time T. ; It appears Mr. Reasoner has a lot to learn - he keeps fumbling. Anyhow: ; ; In 2.42 we generated a valid nxn board with (queen-cols) and then extended it ; with n + 1 queens. In Louis's program, when generating a nxn board, we ; calculate the (n-1)x(n-1) boards n times. This means, that we end up doing ; the full calculation 1 time for the 2x2 board, 2 times for the 3x3 board, 3 ; times for the 4x4 board and so forth. In the end, we end up doing it 7! ; times. So if the program in 2.42 solves the puzzle in time T, Louis's would ; do it in 7!T. Pretty bad. ; ; Let's see what the numbers tell us. ; ; Slow queens: 24892.343017578125 ; Fast queens: 5.5859375 ; ; The result I expected is ~28152 milliseconds, which is 13% off. Oh well. ; At least I can wait for it :) (define (slow-queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (new-row) (map (lambda (rest-of-queens) (adjoin-position new-row k rest-of-queens)) (queen-cols (- k 1)))) (enumerate-interval 1 board-size))))) (queen-cols board-size)) (define (fast-queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size)) (define empty-board '()) (define (adjoin-position new-row k rest-of-queens) (cons (list new-row k) rest-of-queens)) (define (safe? k positions) (define queen-position (queen-at k positions)) (let ((q1r (car queen-position)) (q1c (cadr queen-position))) (all? (lambda (position) (let ((q2r (car position)) (q2c (cadr position))) (or (and (= q1r q2r) (= q1c q2c)) (and (not (= q1r q2r)) (not (= q1c q2c)) (not (= (+ q1r q1c) (+ q2r q2c))) (not (= (- q1r q1c) (- q2r q2c))))))) positions))) (define (queen-at column positions) (if (= column (cadar positions)) (car positions) (queen-at column (cdr positions)))) (define (all? proc seq) (cond ((null? seq) #t) ((proc (car seq)) (all? proc (cdr seq))) (else #f))) (define (enumerate-interval a b) (if (> a b) (list) (cons a (enumerate-interval (+ a 1) b)))) (define (flatmap proc seq) (accumulate append '() (map proc seq))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (time message proc) (let ((start (current-inexact-milliseconds))) (proc) (let ((time-taken (- (current-inexact-milliseconds) start))) (printf "~a: ~a\n" message time-taken)))) ; Warm up (slow-queens 2) (fast-queens 2) ; Timing (time "Slow queens" (lambda () (slow-queens 8))) (time "Fast queens" (lambda () (fast-queens 8))) ================================================ FILE: scheme/sicp/02/44.scm ================================================ ; SICP exercise 2.44 ; ; Define the procedure up-split used by corner-split. It is similar to ; right-split, except that it switches the roles of below and beside. (define (up-split painter n) (if (= n 0) painter (let ((smaller (up-split painter (- n 1)))) (below painter (beside smaller smaller))))) ================================================ FILE: scheme/sicp/02/45.scm ================================================ ; SICP exercise 2.45 ; ; right-split and up-split can be expressed as instances of a general splitting ; operation. Define a procedure split with the property that evaluating ; ; (define right-split (split beside below)) ; (define up-split (split below beside)) ; ; produces right-split and up-split with the same behaviors as the ones already ; defined. (define (split op1 op2) (define (split-proc painter n) (if (= n 0) painter (let ((smaller (split-proc painter (- n 1)))) (op1 painter (op2 smaller smaller))))) split-proc) (define right-split (split beside below)) (define up-split (split below beside)) ================================================ FILE: scheme/sicp/02/46.scm ================================================ ; SICP exercise 2.46 ; ; A two-dimensional vector v running from the origin to a point can be ; represented as a pair consisting of an x-coordinate and a y-coordinate. ; Implement a data abstraction for vectors by giving a constructor make-vect ; and corresponding selectors xcor-vect and ycor-vect. In terms of your ; selectors and constructor, implement procedures add-vect, sub-vect, and ; scale-vect that perform the operations vector addition, vector subtraction, ; and multiplying a vector by a scalar. ; ; (x₁,y₁) + (x₂,y₂) = (x₁ + x₂,y₁ + y₂) ; (x₁,y₁) - (x₂,y₂) = (x₁ - x₂,y₁ - y₂) ; s(x,y) = (sx,sy) (define (make-vect x y) (list x y)) (define (xcor-vect vect) (car vect)) (define (ycor-vect vect) (cadr vect)) (define (add-vect v1 v2) (make-vect (+ (xcor-vect v1) (xcor-vect v2)) (+ (ycor-vect v1) (ycor-vect v2)))) (define (sub-vect v1 v2) (make-vect (- (xcor-vect v1) (xcor-vect v2)) (- (ycor-vect v1) (ycor-vect v2)))) (define (scale-vect s v) (make-vect (* s (xcor-vect v)) (* s (ycor-vect v)))) ================================================ FILE: scheme/sicp/02/47.scm ================================================ ; SICP exercise 2.47 ; ; Here are two possible constructors for frames: ; ; (define (make-frame origin edge1 edge2) ; (list origin edge1 edge2)) ; ; (define (make-frame origin edge1 edge2) ; (cons origin (cons edge1 edge2))) ; ; For each constructor supply the appropriate selectors to produce ; an implementation for frames. (define (make-frame1 origin edge1 edge2) (list origin edge1 edge2)) (define (origin-frame1 frame) (car frame)) (define (edge1-frame1 frame) (cadr frame)) (define (edge2-frame1 frame) (caddr frame)) (define (make-frame2 origin edge1 edge2) (cons origin (cons edge1 edge2))) (define (origin-frame2 frame) (car frame)) (define (edge1-frame2 frame) (cadr frame)) (define (edge2-frame2 frame) (cddr frame)) ================================================ FILE: scheme/sicp/02/48.scm ================================================ ; SICP exercise 2.48 ; ; A directed line segment in the plane can be represented as a pair of ; vectors - the vector running from the origin to the start-point of the ; segment, and the vector running from the origin to the end-point of the ; segment. Use your vector representation from Exercise 2.46 to define a ; representation for segments with a constructor make-segment and selectors ; start-segment and end-segment. (define (make-segment start end) (list start end)) (define (start-segment segment) (car segment)) (define (end-segment segment) (cadr segment)) (define (make-vect x y) (list x y)) ================================================ FILE: scheme/sicp/02/49.scm ================================================ ; SICP exercise 2.49 ; ; Use segments->painter to define the following primitive painters: ; ; a. The painter that draws the outline of the designated frame. ; b. The painter that draws an "X" by connecting the opposite corners of the ; frame ; c. The painter that draws a diamond shape by connecting the mid-points of ; the sides of the frame. ; d. The wave painter. ; Here you go. ; ; Note, that I wrote a program that takes a bunch of path coordinates and ; generates make-segment calls for each line segment in the path in order to ; implement wave. ; a. The painter that draws the outline of the designated frame. (define outline (segments->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 0.0 1.0)) (make-segment (make-vect 0.0 1.0) (make-vect 1.0 1.0)) (make-segment (make-vect 1.0 1.0) (make-vect 1.0 0.0)) (make-segment (make-vect 1.0 0.0) (make-vect 0.0 0.0))))) ; b. The painter that draws an "X" by connecting the opposite corners of the ; frame (define cross (segments->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0)) (make-segment (make-vect 1.0 0.0) (make-vect 0.0 1.0))))) ; c. The painter that draws a diamond shape by connecting the mid-points of ; the sides of the frame. (define diamond (segments->painter (list (make-segment (make-vect 0.5 0.0) (make-vect 1.0 0.5)) (make-segment (make-vect 1.0 0.5) (make-vect 0.5 1.0)) (make-segment (make-vect 0.5 1.0) (make-vect 0.0 0.5)) (make-segment (make-vect 0.0 0.5) (make-vect 0.5 0.0))))) ; d. The wave painter. (define wave (segments->painter (list (make-segment (make-vect 0.00 0.70) (make-vect 0.16 0.57)) (make-segment (make-vect 0.16 0.57) (make-vect 0.30 0.67)) (make-segment (make-vect 0.30 0.67) (make-vect 0.37 0.67)) (make-segment (make-vect 0.37 0.67) (make-vect 0.40 0.64)) (make-segment (make-vect 0.40 0.64) (make-vect 0.42 0.68)) (make-segment (make-vect 0.42 0.68) (make-vect 0.32 0.80)) (make-segment (make-vect 0.32 0.80) (make-vect 0.33 0.85)) (make-segment (make-vect 0.33 0.85) (make-vect 0.36 1.00)) (make-segment (make-vect 0.60 1.00) (make-vect 0.62 0.84)) (make-segment (make-vect 0.62 0.84) (make-vect 0.62 0.78)) (make-segment (make-vect 0.62 0.78) (make-vect 0.53 0.70)) (make-segment (make-vect 0.53 0.70) (make-vect 0.57 0.64)) (make-segment (make-vect 0.57 0.64) (make-vect 0.63 0.67)) (make-segment (make-vect 0.63 0.67) (make-vect 0.68 0.66)) (make-segment (make-vect 0.68 0.66) (make-vect 0.87 0.51)) (make-segment (make-vect 0.87 0.51) (make-vect 1.00 0.40)) (make-segment (make-vect 1.00 0.30) (make-vect 0.73 0.52)) (make-segment (make-vect 0.73 0.52) (make-vect 0.61 0.53)) (make-segment (make-vect 0.61 0.53) (make-vect 0.67 0.25)) (make-segment (make-vect 0.67 0.25) (make-vect 0.71 0.00)) (make-segment (make-vect 0.60 0.00) (make-vect 0.56 0.23)) (make-segment (make-vect 0.56 0.23) (make-vect 0.51 0.28)) (make-segment (make-vect 0.51 0.28) (make-vect 0.46 0.28)) (make-segment (make-vect 0.46 0.28) (make-vect 0.40 0.12)) (make-segment (make-vect 0.40 0.12) (make-vect 0.36 0.00)) (make-segment (make-vect 0.23 0.00) (make-vect 0.34 0.30)) (make-segment (make-vect 0.34 0.30) (make-vect 0.36 0.52)) (make-segment (make-vect 0.36 0.52) (make-vect 0.32 0.55)) (make-segment (make-vect 0.32 0.55) (make-vect 0.28 0.55)) (make-segment (make-vect 0.28 0.55) (make-vect 0.17 0.45)) (make-segment (make-vect 0.17 0.45) (make-vect 0.00 0.60))))) ================================================ FILE: scheme/sicp/02/50.scm ================================================ ; SICP exercise 2.50 ; ; Define the transformation flip-horiz, which flips painters horizontally, and ; transformations that rotate painters counterclockwise by 180 degrees and 270 ; degrees. (define (flip-horiz painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) (define (rotate180 painter) (transform-painter painter (make-vect 1.0 1.0) (make-vect 0.0 1.0) (make-vect 1.0 0.0))) (define (rotate270 painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) ================================================ FILE: scheme/sicp/02/51.scm ================================================ ; SICP exercise 2.51 ; ; Define the below operations for painters. below takes two painters as ; arguments. The resulting painter, given the frame, draws the first painter in ; the bottom of the frame and with the second painter on the top. Define below ; in two different ways - first by writing a procedure that is analogous to the ; beside procedure given above, and again in terms of beside and suitable ; rotation operations. (define (below painter1 painter2) (let ((split-point (make-vect 0.0 0.5))) (let ((paint-bottom (transform-painter painter1 (make-vect 0.0 0.0) (make-vect 1.0 0.0) split-point)) (paint-top (transform-painter painter2 split-point (make-vect 1.0 0.5) (make-vect 0.0 1.0)))) (lambda (frame) (paint-bottom frame) (paint-top frame))))) (define (below2 painter1 painter2) (rotate270 (beside (rotate90 painter1) (rotate90 painter2)))) ================================================ FILE: scheme/sicp/02/52.scm ================================================ ; SICP exercise 2.52 ; ; Make changes to the square limit of wave show in Figure 2.9 by working at ; each of the levels described above. In particular: ; ; a. Add some segments to the primitive wave painter of Exercise 2.49 (to add a ; smile, for example). ; b. Change the pattern constructed by corner-split (for example, by using one ; copy of the up-split and right-split images instead of two). ; c. Modify the version of square-limit that uses square-of-four as to assemble ; the corners in a different pattern. (For example, you might make the big ; Mr. Rogers look outward from each corner of the square) ; a. Add some segments to the primitive wave painter of Exercise 2.49 (to add a ; smile, for example). (define smiling-wave (segments->painter (list (make-segment (make-vect 0.00 0.70) (make-vect 0.16 0.57)) (make-segment (make-vect 0.16 0.57) (make-vect 0.30 0.67)) (make-segment (make-vect 0.30 0.67) (make-vect 0.37 0.67)) (make-segment (make-vect 0.37 0.67) (make-vect 0.40 0.64)) (make-segment (make-vect 0.40 0.64) (make-vect 0.42 0.68)) (make-segment (make-vect 0.42 0.68) (make-vect 0.32 0.80)) (make-segment (make-vect 0.32 0.80) (make-vect 0.33 0.85)) (make-segment (make-vect 0.33 0.85) (make-vect 0.36 1.00)) (make-segment (make-vect 0.60 1.00) (make-vect 0.62 0.84)) (make-segment (make-vect 0.62 0.84) (make-vect 0.62 0.78)) (make-segment (make-vect 0.62 0.78) (make-vect 0.53 0.70)) (make-segment (make-vect 0.53 0.70) (make-vect 0.57 0.64)) (make-segment (make-vect 0.57 0.64) (make-vect 0.63 0.67)) (make-segment (make-vect 0.63 0.67) (make-vect 0.68 0.66)) (make-segment (make-vect 0.68 0.66) (make-vect 0.87 0.51)) (make-segment (make-vect 0.87 0.51) (make-vect 1.00 0.40)) (make-segment (make-vect 1.00 0.30) (make-vect 0.73 0.52)) (make-segment (make-vect 0.73 0.52) (make-vect 0.61 0.53)) (make-segment (make-vect 0.61 0.53) (make-vect 0.67 0.25)) (make-segment (make-vect 0.67 0.25) (make-vect 0.71 0.00)) (make-segment (make-vect 0.60 0.00) (make-vect 0.56 0.23)) (make-segment (make-vect 0.56 0.23) (make-vect 0.51 0.28)) (make-segment (make-vect 0.51 0.28) (make-vect 0.46 0.28)) (make-segment (make-vect 0.46 0.28) (make-vect 0.40 0.12)) (make-segment (make-vect 0.40 0.12) (make-vect 0.36 0.00)) (make-segment (make-vect 0.23 0.00) (make-vect 0.34 0.30)) (make-segment (make-vect 0.34 0.30) (make-vect 0.36 0.52)) (make-segment (make-vect 0.36 0.52) (make-vect 0.32 0.55)) (make-segment (make-vect 0.32 0.55) (make-vect 0.28 0.55)) (make-segment (make-vect 0.28 0.55) (make-vect 0.17 0.45)) (make-segment (make-vect 0.17 0.45) (make-vect 0.00 0.60)) (make-segment (make-vect 0.41 0.78) (make-vect 0.54 0.78)) (make-segment (make-vect 0.54 0.78) (make-vect 0.52 0.76)) (make-segment (make-vect 0.52 0.76) (make-vect 0.43 0.76)) (make-segment (make-vect 0.43 0.76) (make-vect 0.41 0.78))))) ; b. Change the pattern constructed by corner-split (for example, by using one ; copy of the up-split and right-split images instead of two). (define (simpler-corner-split painter n) (if (= n 0) painter (let ((up (up-split painter (- n 1))) (right (right-split painter (- n 1)))) (beside (below painter up) (below right (corner-split painter (- n 1))))))) ; c. Modify the version of square-limit that uses square-of-four as to assemble ; the corners in a different pattern. (For example, you might make the big ; Mr. Rogers look outward from each corner of the square) (define (inverted-square-limit painter n) (let ((combine4 (square-of-four flip-vert rotate180 identity flip-horiz))) (combine4 (corner-split painter n)))) ================================================ FILE: scheme/sicp/02/53.scm ================================================ ; SICP exercise 2.53 ; ; What would be the interpreter print in response to evaluating each of the ; following expressions? ; ; (list 'a 'b 'c) ; (list (list 'george)) ; (cdr '((x1 x2) (y1 y2))) ; (cadr '((x1 x2) (y1 y2))) ; (pair? (car '(a short list))) ; (memq 'red '((red shoes) (blue socks))) ; (memq 'red '(red shoes blue coks)) ; (list 'a 'b 'c) ; '(a b c) ; ; (list (list 'george)) ; '((george)) ; ; (cdr '((x1 x2) (y1 y2))) ; '((y1 y2)) ; ; (cadr '((x1 x2) (y1 y2))) ; '(y1 y2) ; ; (pair? (car '(a short list))) ; #f ; ; (memq 'red '((red shoes) (blue socks))) ; #f ; ; (memq 'red '(red shoes blue socks)) ; '(red shoes blue socks) ================================================ FILE: scheme/sicp/02/54.scm ================================================ ; SICP exercise 2.54 ; ; Two lists are said to be equal? if they contain equal elements arranged in ; the same order. For example, ; ; (equal? '(this is a list) '(this is a list)) ; ; is there, but ; ; (equal? '(this is a list) '(this (is a) list)) ; ; is false. To be more precise, we can define equal? recursively in terms of ; the basic eq? equality of symbols by saying that a and b are eq?, or if they ; are both lists such that (car a) is equal? to (car b) and (cdr a) is equal? ; to (cdr b). Using this idea, implement equal? as a procedure. (define (equal2? a b) (cond ((and (null? a) (null? b)) #t) ((and (pair? a) (pair? b)) (and (equal2? (car a) (car b)) (equal2? (cdr a) (cdr b)))) (else (eq? a b)))) ================================================ FILE: scheme/sicp/02/55.scm ================================================ ; SICP exercise 2.55 ; ; Eva Lu Ator types to the interpreter the expression ; ; (car ''abracadabra) ; ; To her surprise, the interpreter prints back quote. Explain. ; Simple. ; ; 'foo is short for (quote foo) ; ''foo is short for (quote (quote foo)) ; ; When you (car (quote (quote foo))) you get 'quote. ================================================ FILE: scheme/sicp/02/56.scm ================================================ ; SICP exercise 2.56 ; ; Show how to extend the basic differentiator to handle more kinds of ; expressions. For instance, implement the differentiation rule ; ; d(uⁿ) du ; ───── = nuⁿ⁻¹── ; dx dx ; ; by adding a new clause to the deriv program and defining appropriate ; procedures exponentiation?, base, exponent, and make-exponentiation. (You may ; use the symbol ** to denote exponentiation.) Build in the rules that anything ; raised to the power 0 is 1 and anything raised to the power 1 is the thing ; itself. (define (deriv expr var) (cond ((number? expr) 0) ((variable? expr) (if (same-variable? expr var) 1 0)) ((sum? expr) (make-sum (deriv (addend expr) var) (deriv (augend expr) var))) ((product? expr) (make-sum (make-product (multiplier expr) (deriv (multiplicand expr) var)) (make-product (deriv (multiplier expr) var) (multiplicand expr)))) ((exponentiation? expr) (make-product (make-product (power expr) (make-exponentiation (base expr) (- (power expr) 1))) (deriv (base expr) var))) (else (error "unknown expression type - DERIV" expr)))) (define (variable? x) (symbol? x)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (make-sum a1 a2) (cond ((=number? a1 0) a2) ((=number? a2 0) a1) ((and (number? a1) (number? a2)) (+ a1 a2)) (else (list '+ a1 a2)))) (define (make-product m1 m2) (cond ((or (=number? m1 0) (=number? m2 0)) 0) ((=number? m1 1) m2) ((=number? m2 1) m1) ((and (number? m1) (number? m2)) (* m1 m2)) (else (list '* m1 m2)))) (define (make-exponentiation base power) (cond ((=number? power 0) 1) ((=number? power 1) base) (else (list '** base power)))) (define (sum? x) (and (pair? x) (eq? (car x) '+))) (define (addend s) (cadr s)) (define (augend s) (caddr s)) (define (product? x) (and (pair? x) (eq? (car x) '*))) (define (multiplier p) (cadr p)) (define (multiplicand p) (caddr p)) (define (exponentiation? expr) (and (pair? expr) (eq? (car expr) '**))) (define (base expr) (cadr expr)) (define (power expr) (caddr expr)) (define (=number? expr num) (and (number? expr) (= expr num))) ================================================ FILE: scheme/sicp/02/57.scm ================================================ ; SICP exercise 2.57 ; ; Extend the differentiation program to handle sums and products of ; arbitrary numbers of (two or more) terms. Then the last example above ; could be expressed as ; ; (deriv '(* x y (+ x 3)) 'x) ; ; Try to do this by changing only the representation for sums and products, ; without changing the deriv procedure at all. For example, the addend of ; a sum would be the first term, and the augend would be the sum of the ; rest of the terms (define (deriv expr var) (cond ((number? expr) 0) ((variable? expr) (if (same-variable? expr var) 1 0)) ((sum? expr) (make-sum (deriv (addend expr) var) (deriv (augend expr) var))) ((product? expr) (make-sum (make-product (multiplier expr) (deriv (multiplicand expr) var)) (make-product (deriv (multiplier expr) var) (multiplicand expr)))) (else (error "unknown expression type - DERIV" expr)))) (define (variable? x) (symbol? x)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (make-sum a1 a2) (cond ((=number? a1 0) a2) ((=number? a2 0) a1) ((and (number? a1) (number? a2)) (+ a1 a2)) (else (list '+ a1 a2)))) (define (make-product m1 m2) (cond ((or (=number? m1 0) (=number? m2 0)) 0) ((=number? m1 1) m2) ((=number? m2 1) m1) ((and (number? m1) (number? m2)) (* m1 m2)) (else (list '* m1 m2)))) (define (sum? x) (and (pair? x) (eq? (car x) '+))) (define (addend s) (cadr s)) (define (augend s) (if (null? (cdddr s)) (caddr s) (cons '+ (cddr s)))) (define (product? x) (and (pair? x) (eq? (car x) '*))) (define (multiplier p) (cadr p)) (define (multiplicand p) (if (null? (cdddr p)) (caddr p) (cons '* (cddr p)))) (define (=number? expr num) (and (number? expr) (= expr num))) ================================================ FILE: scheme/sicp/02/58.scm ================================================ ; SICP exercise 2.58 ; ; Suppose we want to modify the differentiation program so that it works with ; ordinary mathematical notation, in which + and * are infix rather than prefix ; operators. Since the differentiation program is defined in terms of abstract ; data, we can modify it to work with different representations of expressions ; solely by changing the predicates, selectors and constructors that define the ; representation of algebraic expressions on which the differentiator is to ; operate. ; ; a. Show how to do this in order to differentiate algebraic expressions ; presented in infix form, such as (x + (3 * (x + (y + 2)))). To simplify ; the task, assume that + and * always take two arguments and that ; expressions are fully parenthesized. ; b. The problem becomes substantially harder if we allow standard algebraic ; notation, such as (x + 3 * (x + y + 2)), which drops unnecessary ; parentheses and assumes that multiplication is done before addition. Can ; you design appropriate predicates, selectors, and constructors for this ; notation such that our derivative program still works? ; a. Sure enough. See code below ; b. Yup. I'm just going to sketch it (too lazy to write it down) - we need ; to parse the sexp and put parentheses where they should be. Afterwards, ; it is just as easy as calling a. Parsing the code is not that hard, but ; I'm not in the mood for a parsing exercise at this point. (define (deriv expr var) (cond ((number? expr) 0) ((variable? expr) (if (same-variable? expr var) 1 0)) ((sum? expr) (make-sum (deriv (addend expr) var) (deriv (augend expr) var))) ((product? expr) (make-sum (make-product (multiplier expr) (deriv (multiplicand expr) var)) (make-product (deriv (multiplier expr) var) (multiplicand expr)))) (else (error "unknown expression type - DERIV" expr)))) (define (variable? x) (symbol? x)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (make-sum a1 a2) (cond ((=number? a1 0) a2) ((=number? a2 0) a1) ((and (number? a1) (number? a2)) (+ a1 a2)) (else (list a1 '+ a2)))) (define (make-product m1 m2) (cond ((or (=number? m1 0) (=number? m2 0)) 0) ((=number? m1 1) m2) ((=number? m2 1) m1) ((and (number? m1) (number? m2)) (* m1 m2)) (else (list m1 '* m2)))) (define (sum? x) (and (pair? x) (eq? (cadr x) '+))) (define (addend s) (car s)) (define (augend s) (caddr s)) (define (product? x) (and (pair? x) (eq? (cadr x) '*))) (define (multiplier p) (car p)) (define (multiplicand p) (caddr p)) (define (=number? expr num) (and (number? expr) (= expr num))) ================================================ FILE: scheme/sicp/02/59.scm ================================================ ; SICP exercise 2.59 ; ; Implement the union-set operation for the unordered list representation of ; sets. (define (element-of-set? x set) (cond ((null? set) false) ((equal? x (car set)) true) (else (element-of-set? x (cdr set))))) (define (adjoin-set x set) (if (element-of-set? x set) set (cons x set))) (define (union-set set1 set2) (cond ((null? set1) set2) ((element-of-set? (car set1) set2) (union-set (cdr set1) set2)) (else (cons (car set1) (union-set (cdr set1) set2))))) ================================================ FILE: scheme/sicp/02/60.scm ================================================ ; SICP exercise 2.60 ; ; We specified that a set would be represented as a list with no duplicates. ; Now suppose we allow duplicates. For instance, the set {1, 2, 3} could be ; represented as the list (2 3 2 1 3 2 2). Design procedures element-of-set?, ; adjoin-set, union-set, and intersection-set that operate on this ; representation. How does the efficiency of each compare with the ; corresponding procedure for the non-duplicate representation? Are there any ; applications for which you would use this representation in preference to the ; non-duplicate one? ; The procedures are below. ; ; In comparison, the set representation in this exercise allows implementing ; adjoin-set and union-set in constant time. In that sense, the implementation ; is way faster than when having no duplicates. ; ; On the down side, element-of-set? can be way slower. Its complexity is Θ(n), ; where n is the number of times and element was added to the set, not the ; number of elements in the set. intersection-set is potentially slower for the ; same reason. ; ; I would prefer using the duplicate version when I have a lot of unions and ; adjoins and a lot fewer tests and intersections. I would probably try to ; normalize the set after all the unions, though. (define (element-of-set? x set) (and (not (null? set)) (or (eq? (car set) x) (element-of-set? x (cdr set))))) (define (adjoin-set x set) (cons x set)) (define (union-set set1 set2) (append set1 set2)) (define (intersection-set set1 set2) (cond ((null? set1) '()) ((element-of-set? (car set1) set2) (cons (car set1) (intersection-set (cdr set1) set2))) (else (intersection-set (cdr set1) set2)))) ================================================ FILE: scheme/sicp/02/61.scm ================================================ ; SICP exercise 2.61 ; ; Give an implementation of adjoin-set using the ordered representation. By ; analogy with element-of-set? show how to take advantage of the ordering to ; produce a procedure that requires on the average about half as many steps as ; with the unordered representation. (define (adjoin-set x set) (cond ((null? set) (list x)) ((= x (car set)) set) ((> x (car set)) (cons (car set) (adjoin-set x (cdr set)))) ((< x (car set)) (cons x set)))) ================================================ FILE: scheme/sicp/02/62.scm ================================================ ; SICP exercise 2.62 ; ; Given an Θ(n) implementation of union-set for the sets represented as ordered ; lists. (define (union-set set1 set2) (cond ((null? set1) set2) ((null? set2) set1) ((= (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) (cdr set2)))) ((< (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) set2))) ((> (car set1) (car set2)) (cons (car set2) (union-set set1 (cdr set2)))))) ================================================ FILE: scheme/sicp/02/63.scm ================================================ ; SICP exercise 2.63 ; ; Each of the following two procedures converts a binary tree to a list. ; ; (define (tree->list-1 tree) ; (if (null? tree) ; '() ; (append (tree->list-1 (left-branch tree)) ; (cons (entry tree) ; (tree->list-1 (right-branch tree)))))) ; ; (define (tree->list-2 tree) ; (define (copy-to-list tree result-list) ; (if (null? tree) ; result-list ; (copy-to-list (left-branch tree) ; (cons (entry tree) ; (copy-to-list (right-branch tree) result-list))))) ; (copy-to-list tree '())) ; ; a. Do the two procedures produce the same result for every tree? If not, how ; do the results differ? What lists do the two procedures produce for the ; trees in Figure 2.16? ; b. Do the two procedures have the same order of growth in the number of steps ; required to convert a balanced tree with n elements to a list? If not, ; which one grows more slowly? ; a. Yes. They don't. All six variants generate (1 3 5 7 9 11) ; ; b. No. tree->list-2 tends to grow slower, both in space and time. ; ; First of all, it is recursive only on the right branches, but iterative on ; the left ones, and second, it does not invlove any calls to append (which is ; linear to the size of the first list). In all cases tree->list-2 finishes in ; Θ(n). ================================================ FILE: scheme/sicp/02/64.scm ================================================ ; SICP exercise 2.64 ; ; The following procedure list->tree converts an ordered list to a balanced ; binary tree. The helper procedure partial-tree takes as arguments an integer n ; and a list of at least n elements and constructs a balanced tree containing ; the first n elements of the list. The result returned by partial-tree is a pair ; (formed with cons) whose car is the constructed tree and whose cdr is the list ; of elements not included in the tree. ; ; (define (list->tree elements) ; (car (partial-tree elements (length elements)))) ; ; (define (partial-tree elts n) ; (if (= n 0) ; (cons '() elts) ; (let* ((left-size (quotient (- n 1) 2)) ; (left-result (partial-tree elts left-size)) ; (left-tree (car left-result)) ; (non-left-elts (cdr left-result)) ; (right-size (- n (+ left-size 1))) ; (this-entry (car non-left-elts)) ; (right-result (partial-tree (cdr non-left-elts) right-size)) ; (right-tree (car right-result)) ; (remaining-elts (cdr right-result))) ; (cons (make-tree this-entry left-tree right-tree) remaining-elts)))) ; ; a. Write a short paragraph explaining as clearly as you can how partial-tree ; works. Draw the tree produced by list->tree for the list (1 3 5 7 9 11) ; b. What is the order of growth in the number of steps required by list->tree ; to convert a list of n elements? ; a. The procedure works in a fairly simple fashion. ; ; It splits the list in three parts - a left sub-list, a right sub-list and the ; element between them. The parts are roughly equal in size. The result is a ; tree whose entry is the middle element and whose branches are the sub-lists ; transformed to trees with the same procedure (recursively). ; ; Once the procedure arrives to a list with size <= 3, it is trivial to ; visualize how the tree would look like. Lists of sizes > 3 get reduced to ; those cases with recursion. ; ; The final tree is binary, because the left branch contains elements that are ; smaller than the middle element and the right branch contains only elements ; that are greater than the middle element. It is balanced, because the ; algorithm halves the list size on each step, which means that the maximum ; depth of the tree will be log(n). ; ; FYI, (list->tree '(1 3 5 7 9 11)) produces: ; ; 5 ; / \ ; 1 9 ; \ / \ ; 3 7 11 ; ; b. Θ(n) ; ; Each list item is visited only once and each visit performs a single cons. ================================================ FILE: scheme/sicp/02/65.scm ================================================ ; SICP exercise 2.65 ; ; Use the results of exercise 2.63 and 2.64 to give Θ(n) implementations of ; union-set and intersection-set for sets implemented as (balanced) binary ; trees. (define (intersection-set set1 set2) (list->tree (intersection-set-list (tree->list set1) (tree->list set2)))) (define (union-set set1 set2) (list->tree (union-set-list (tree->list set1) (tree->list set2)))) (define (make-tree entry left right) (list entry left right)) (define (entry tree) (car tree)) (define (left-branch tree) (cadr tree)) (define (right-branch tree) (caddr tree)) (define (tree->list tree) (define (copy-to-list tree result-list) (if (null? tree) result-list (copy-to-list (left-branch tree) (cons (entry tree) (copy-to-list (right-branch tree) result-list))))) (copy-to-list tree '())) (define (list->tree elements) (define (partial-tree elts n) (if (= n 0) (cons '() elts) (let* ((left-size (quotient (- n 1) 2)) (left-result (partial-tree elts left-size)) (left-tree (car left-result)) (non-left-elts (cdr left-result)) (right-size (- n (+ left-size 1))) (this-entry (car non-left-elts)) (right-result (partial-tree (cdr non-left-elts) right-size)) (right-tree (car right-result)) (remaining-elts (cdr right-result))) (cons (make-tree this-entry left-tree right-tree) remaining-elts)))) (car (partial-tree elements (length elements)))) (define (union-set-list list1 list2) (cond ((null? list1) list2) ((null? list2) list1) ((= (car list1) (car list2)) (cons (car list1) (union-set-list (cdr list1) (cdr list2)))) ((< (car list1) (car list2)) (cons (car list1) (union-set-list (cdr list1) list2))) ((> (car list1) (car list2)) (cons (car list2) (union-set-list list1 (cdr list2)))))) (define (intersection-set-list list1 list2) (if (or (null? list1) (null? list2)) '() (let ((x1 (car list1)) (x2 (car list2))) (cond ((= x1 x2) (cons x1 (intersection-set-list (cdr list1) (cdr list2)))) ((< x1 x2) (intersection-set-list (cdr list1) list2)) ((> x1 x2) (intersection-set-list list1 (cdr list2))))))) ================================================ FILE: scheme/sicp/02/66.scm ================================================ ; SICP exercise 2.66 ; ; Implement the lookup procedure for the case where the set of records is ; structured as a binary tree, ordered by the numerical values of the keys. (define (lookup given-key set-of-records) (if (null? set-of-records) #f (let* ((record (entry set-of-records)) (record-key (key record))) (cond ((= given-key record-key) record) ((< given-key record-key) (lookup given-key (left-branch set-of-records))) ((> given-key record-key) (lookup given-key (right-branch set-of-records))))))) (define (entry tree) (car tree)) (define (left-branch tree) (cadr tree)) (define (right-branch tree) (caddr tree)) (define (key record) (car record)) (define (name record) (cadr record)) ================================================ FILE: scheme/sicp/02/67.scm ================================================ ; SICP exercise 2.67 ; ; Define an encoding tree and a sample message: ; ; (define sample-tree ; (make-code-tree (make-leaf 'A 4) ; (make-code-tree ; (make-leaf 'B 2) ; (make-code-tree (make-leaf 'D 1) ; (make-leaf 'C 1))))) ; ; (define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0)) ; ; Use the decode procedure to decode the message, and give the result. (define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? object) (eq? (car object) 'leaf)) (define (symbol-leaf x) (cadr x)) (define (weight-leaf x) (caddr x)) (define (symbols tree) (if (leaf? tree) (list (symbol-leaf tree)) (caddr tree))) (define (left-branch tree) (car tree)) (define (right-branch tree) (cadr tree)) (define (weight tree) (if (leaf? tree) (weight-leaf tree) (cadddr tree))) (define (make-code-tree left right) (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right)))) (define (decode bits tree) (define (decode-1 bits current-branch) (if (null? bits) '() (let ((next-branch (choose-branch (car bits) current-branch))) (if (leaf? next-branch) (cons (symbol-leaf next-branch) (decode-1 (cdr bits) tree)) (decode-1 (cdr bits) next-branch))))) (decode-1 bits tree)) (define (choose-branch bit branch) (cond ((= bit 0) (left-branch branch)) ((= bit 1) (right-branch branch)) (else (error "bad bit - CHOOSE-BRANCH" bit)))) (define (adjoin-set x set) (cond ((null? set) (list x)) ((< (weight x) (weight (car set))) (cons x set)) (else (cons (car set) (adjoin-set x (cdr set)))))) (define (make-leaf-set pairs) (if (null? pairs) '() (let ((pair (car pairs))) (adjoin-set (make-leaf (cdr pair) (cadr pair)) (make-leaf-set (cdr pairs)))))) (define sample-tree (make-code-tree (make-leaf 'A 4) (make-code-tree (make-leaf 'B 2) (make-code-tree (make-leaf 'D 1) (make-leaf 'C 1))))) (define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0)) ================================================ FILE: scheme/sicp/02/68.scm ================================================ ; SICP exercise 2.68 ; ; The encode procedure takes as arguments a message and a tree and produces the ; list of bits that gives the encoded message. ; ; (define (encode message tree) ; (if (null? message) ; '() ; (append (encode-symbol (car message) tree) ; (encode (cdr message) tree)))) ; ; encode-symbol is a procedure, which you must write, that returns the lists of ; bits that encodes a given symbol according to a given tree. You should design ; encode-symbol so that it signals an error if the symbol is not in the tree at ; all. The your procedure by encoding the result you obtained in exercise 2.67 ; with the sample tree and seeing whether it is the same as the original sample ; message. (define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? object) (eq? (car object) 'leaf)) (define (symbol-leaf x) (cadr x)) (define (weight-leaf x) (caddr x)) (define (symbols tree) (if (leaf? tree) (list (symbol-leaf tree)) (caddr tree))) (define (left-branch tree) (car tree)) (define (right-branch tree) (cadr tree)) (define (weight tree) (if (leaf? tree) (weight-leaf tree) (cadddr tree))) (define (make-code-tree left right) (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right)))) (define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) (define (encode-symbol symbol tree) (let ((left (left-branch tree)) (right (right-branch tree))) (cond ((leaf? tree) '()) ((member symbol (symbols left)) (cons 0 (encode-symbol symbol left))) ((member symbol (symbols right)) (cons 1 (encode-symbol symbol right))) (else (error "bad symbol - ENCODE-SYMBOL" symbol))))) ================================================ FILE: scheme/sicp/02/69.scm ================================================ ; SICP exercise 2.69 ; ; The following procedure as its arguments a list of symbol-frequency pairs ; (where no symbol appears in more than one pair) and generates a Huffman ; encoding tree according to the Huffman algorithm. ; ; (define (generate-huffman-tree pairs) ; (successive-merge (make-leaf-set pairs))) ; ; make-leaf-set is the procedure given above that transforms the list of pairs ; into an ordered set of leaves. successive-merge is the procedure you must ; write, using make-code-tree to successively merge the smallest-weight ; elements of the set until there is only one element left, which is the ; desired Huffman tree. (This procedure is slightly tricky; but not really ; complicated. If you find yourself designing a complex procedure, then you ; are almost certainly doing something wrong. You can take significant ; advantage of the fact that we are using ordered set representation). (define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? object) (eq? (car object) 'leaf)) (define (symbol-leaf x) (cadr x)) (define (weight-leaf x) (caddr x)) (define (symbols tree) (if (leaf? tree) (list (symbol-leaf tree)) (caddr tree))) (define (left-branch tree) (car tree)) (define (right-branch tree) (cadr tree)) (define (weight tree) (if (leaf? tree) (weight-leaf tree) (cadddr tree))) (define (make-code-tree left right) (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right)))) (define (adjoin-set x set) (cond ((null? set) (list x)) ((< (weight x) (weight (car set))) (cons x set)) (else (cons (car set) (adjoin-set x (cdr set)))))) (define (make-leaf-set pairs) (if (null? pairs) '() (let ((pair (car pairs))) (adjoin-set (make-leaf (car pair) (cadr pair)) (make-leaf-set (cdr pairs)))))) (define (generate-huffman-tree pairs) (successive-merge (make-leaf-set pairs))) (define (successive-merge leaf-set) (if (null? (cdr leaf-set)) (car leaf-set) (let ((first (car leaf-set)) (second (cadr leaf-set)) (rest (cddr leaf-set))) (successive-merge (adjoin-set (make-code-tree first second) rest))))) ================================================ FILE: scheme/sicp/02/70.scm ================================================ ; SICP exercise 2.70 ; ; The following eight-symbol alphabet with associated relative frequencies was ; designed to efficiently encode the lyrics of 1950s rock songs. (Note that ; "symbols" of an "alphabet" need not be individual letters.) ; ; A 2 NA 16 ; BOOM 1 SHA 3 ; GET 2 YIP 9 ; JOB 2 WAH 1 ; ; Use generate-huffman-tree (exercise 2.69) to generate a corresponding ; Huffman-tree, and use encode (exercise 2.68) to encode the following ; message: ; ; Get a job ; Sha na na na na na na na na ; Get a job ; Sha na na na na na na na na ; Wah yip yip yip yip yip yip yip yip yip ; Sha boom ; ; How many bits are required for the encoding? What is the smallest number of ; bits that would be needed to encode this song if we used a fix-length code ; for the eight symbol alphabet? ; The encoded message has 84 bits. If we used a fixed-length code, each symbol ; would require at least 3 bits (because there are 8 symbols). The message has ; 36 symbols, which makes the smallest number of bits that would be needed to ; encode the message equal to 108. ; ; You can run this file to verify. (define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? object) (eq? (car object) 'leaf)) (define (symbol-leaf x) (cadr x)) (define (weight-leaf x) (caddr x)) (define (symbols tree) (if (leaf? tree) (list (symbol-leaf tree)) (caddr tree))) (define (left-branch tree) (car tree)) (define (right-branch tree) (cadr tree)) (define (weight tree) (if (leaf? tree) (weight-leaf tree) (cadddr tree))) (define (make-code-tree left right) (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right)))) (define (adjoin-set x set) (cond ((null? set) (list x)) ((< (weight x) (weight (car set))) (cons x set)) (else (cons (car set) (adjoin-set x (cdr set)))))) (define (make-leaf-set pairs) (if (null? pairs) '() (let ((pair (car pairs))) (adjoin-set (make-leaf (car pair) (cadr pair)) (make-leaf-set (cdr pairs)))))) (define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) (define (encode-symbol symbol tree) (let ((left (left-branch tree)) (right (right-branch tree))) (cond ((leaf? tree) '()) ((member symbol (symbols left)) (cons 0 (encode-symbol symbol left))) ((member symbol (symbols right)) (cons 1 (encode-symbol symbol right))) (else (error "bad symbol - ENCODE-SYMBOL" symbol))))) (define (generate-huffman-tree pairs) (successive-merge (make-leaf-set pairs))) (define (successive-merge leaf-set) (if (null? (cdr leaf-set)) (car leaf-set) (let ((first (car leaf-set)) (second (cadr leaf-set)) (rest (cddr leaf-set))) (successive-merge (adjoin-set (make-code-tree first second) rest))))) (define tree (generate-huffman-tree '((a 2) (na 16) (boom 1) (sha 3) (get 2) (yip 9) (job 2) (wah 1)))) (define message '(get a job sha na na na na na na na na get a job sha na na na na na na na na wah yip yip yip yip yip yip yip yip yip sha boom)) (define encoded-message (encode message tree)) (printf "The encoded message is ~a\n" encoded-message) (printf "It has ~a bits\n" (length encoded-message)) (printf "The message has ~a symbols\n" (length message)) (printf "This means, that a fixed-length code would take ~a bits\n" (* (length message) 3)) ================================================ FILE: scheme/sicp/02/71.scm ================================================ ; SICP exercise 2.71 ; ; Suppose we have a Huffman tree for an alphabet of n symbols, and the ; relative frequencies of the symbols are 1, 2, 4,..., 2ⁿ⁻¹. Sketch the tree ; for n = 5; for n = 10. In such a tree (for general n) how many bits are ; required to encode the most frequent symbol? The least frequent symbol? ; Here's the tree for n = 5: ; ; . ; / \ ; . 16 ; / \ ; . 8 ; / \ ; . 4 ; / \ ; 1 2 ; ; The tree for n = 10 is quite similar. ; ; Obviously, the most frequent symbol takes 1 bit and the least frequent ; symbol takes n - 1 (since the depth of the tree is n - 1) ================================================ FILE: scheme/sicp/02/72.scm ================================================ ; SICP exercise 2.72 ; ; Consider the encoding procedure that you designed in exercise 2.68. What is ; the order of growth in the number of steps needed to encode a symbol? Be ; sure to include the number of steps needed to search the symbol list at each ; node encountered. To answer this question in general is difficult. Consider ; the special case where the relative frequencies of the n symbols are as ; described in exercise 2.71, and give the order of growth (as a function of ; n) of the number of steps needed to encode the most frequent and the least ; frequent symbols in the alphabet. ; The most frequent symbol is obviously O(1). As for the least frequent, in ; the worst case, we need to search a list of size n on the first step, a list ; of size n - 1 on the second and so forth until only two leaf nodes remain. ; Thus, the complexity is 1 + 2 + 3 + … + n ≈ O(n²). ================================================ FILE: scheme/sicp/02/73.scm ================================================ ; SICP exercise 2.73 ; ; Section 2.3.2 described a program that performs symbolic differentiation: ; ; (define (deriv exp var) ; (cond ((number? exp) 0) ; ((variable? exp) (if (same-variable? exp var) 1 0)) ; ((sum? exp) ; (make-sum (deriv (addend exp) var) ; (deriv (augend exp) var))) ; ((product? exp) ; (make-sum ; (make-product (multiplier exp) ; (deriv (multiplicand exp) var)) ; (make-product (deriv (multiplicand exp) var) ; (multiplier exp)))) ; ; ...more rules can be added here ; (else (error "unknown expression type - DERIV" exp)))) ; ; We can regard this program as performing a dispatch on the type of the ; expression to be differentiated. In this situation the "type tag" of the ; datum is the algebraic operator symbol (such as +) and the operation being ; performed is deriv. We can transform this program into data-directed style by ; rewriting the basic derivative procedure as ; ; (define (deriv exp var) ; (cond ((number? exp) 0) ; ((variable? exp) ; (if (same-variable? exp var) 1 0)) ; (else ; ((get 'deriv (operator exp)) ; (operands exp) ; var)))) ; ; (define (operator exp) (car exp)) ; ; (define (operands exp) (cdr exp)) ; ; a. Explain what was done above. Why can't we assimilate the predicates ; number? and variable? into the data-directed dispatch? ; ; b. Write the procedures for derivatives of sums and products, and the ; auxiliary code required to install them in the table used by the program ; above. ; ; c. Choose any additional differentiation rule that you like, such as the one ; for exponents (exercise 2.56), and install it in this data-directed ; system. ; ; d. In this simple algebraic manipulator the type of an expression is the ; algebraic operator that binds it together. Suppose, however, we indexed ; the procedures in the opposite way, so that the dispatch line in deriv ; looked like ; ; ((get (operator exp) 'deriv) (operands exp) var) ; ; What corresponding changes to the derivative system are required? ; a. It's rather trivial what was done. ; ; Anyway, we can't assimilate number? and variable? because they don't have ; a type tag that can be indexed in the table. ; ; b. Check out below. ; ; c. Ditto. ; ; d. Simple. We just need to flip the op and type args to put. ; The whole shebang (define (install-deriv-package) (define (make-sum a1 a2) (cond ((=number? a1 0) a2) ((=number? a2 0) a1) ((and (number? a1) (number? a2)) (+ a1 a2)) (else (list '+ a1 a2)))) (define (deriv-sum args var) (make-sum (deriv (addend args) var) (deriv (augend args) var))) (define (addend opers) (car opers)) (define (augend opers) (cadr opers)) (define (make-product m1 m2) (cond ((or (=number? m1 0) (=number? m2 0)) 0) ((=number? m1 1) m2) ((=number? m2 1) m1) ((and (number? m1) (number? m2)) (* m1 m2)) (else (list '* m1 m2)))) (define (deriv-product args var) (make-sum (make-product (multiplier args) (deriv (multiplicand args) var)) (make-product (deriv (multiplier args) var) (multiplicand args)))) (define (multiplier opers) (car opers)) (define (multiplicand opers) (cadr opers)) (define (make-exponentiation base power) (cond ((=number? power 0) 1) ((=number? power 1) base) (else (list '** base power)))) (define (deriv-exponentiation args var) (make-product (make-product (power args) (make-exponentiation (base args) (- (power args) 1))) (deriv (base args) var))) (define (base opers) (car opers)) (define (power opers) (cadr opers)) (define (=number? expr num) (and (number? expr) (= expr num))) (put 'deriv '+ deriv-sum) (put 'deriv '* deriv-product) (put 'deriv '** deriv-exponentiation)) ; The code you gave me (define (deriv expr var) (cond ((number? expr) 0) ((variable? expr) (if (same-variable? expr var) 1 0)) (else ((get 'deriv (operator expr)) (operands expr) var)))) (define (operator expr) (car expr)) (define (operands expr) (cdr expr)) ; The auxiliary stuff (define (variable? x) (symbol? x)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) ; The table that we assumed is built-in. Don't peek. (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type))) (install-deriv-package) ================================================ FILE: scheme/sicp/02/74.scm ================================================ ; SICP exercise 2.74 ; ; Insatiable Enterprises, Inc. is a highly decentralized conglomerate ; consisting of a large number of independent divisions located all over the ; world. The company's computer facilities have just been interconnected by ; means of a clever network-interfacing scheme that makes the entire network ; appear to any user to be a single computer. Insatiable's president, in her ; first attempt to exploit the ability of the network to extract ; administrative information from division files, is dismayed to discover ; that, alhough all the division files have been implemeted as data structures ; in Scheme, the particular data structure used varies from division to ; division. A meeting of division managers is hastily called to search for a ; strategy to integrate the files that will satisfy headquarters' needs while ; preserving the existing autonomy of the divisions. ; ; Show how such a strategy can be implemeted with data-directed programming. ; As an example, suppose that each division personnel records consist of a ; single file, which contains a set of records keyed on employees' names. ; Furthermore, each employee's record is itself a set (structured differently ; from division to division) that contains information keyed under identifiers ; such as address and salary. In particular: ; ; a. Implement for headquarters a get-record procedure that retrieves a ; specified employee's record from a specified personnel file. The procedure ; should be applicable to any division's file. Explain how the individual ; divisions' files should be structured. In partucular, what type information ; must be supplied? ; ; b. Implement for headquarters a get-salary procedure that returns the salary ; information from a given employee's record from any division's personnel ; file. How should the record be structured in order to make this operation ; work? ; ; c. Implement for headquarters a find-employee-record procedure. This should ; search al the divisions' files for the record of a given employee and return ; the record. Assume that this procedure takes as arguments an employee's name ; and a list of all the divisions' files. ; ; d. WHen Insatiable takes over a new company, what changes must be made in ; order to incorporate the new personnel information into the central system? ; Alright then. Let's interpretate "a set of records" a bit loosely and have ; it as an s-expr, as opposed to having a specific set module. We'll have two ; divisions - Atreides and Fremen. Here's how their sets look like: (define atreides '(("Paul Atreides" ((salary 2000) (address "Arrakeen Palace"))) ("Gurney Halleck" ((salary 1500) (address "Here and there"))) ("Duke Leto" ((salary 2500) (address "The Caladan planet"))))) (define fremen '(("Stilgar" . ((income . 1000) (location . "Sietch Tabr"))) ("Chani" . ((income . 800) (location . "Whenever Paul is"))))) ; Note that each division file has a type tag. Also note that while Atreides ; have each record as an a-list, Fremen have their records as a list of pairs. ; That way we have two data structures, which we should call a-lists and ; p-lists (for pair lists). Let's write some code for handling them: (define (a-list-get a-list key) (cond ((null? a-list) '()) ((equal? (caar a-list) key) (cadar a-list)) (else (a-list-get (cdr a-list) key)))) (define (p-list-get p-list key) (cond ((null? p-list) '()) ((equal? (caar p-list) key) (cdar p-list)) (else (p-list-get (cdr p-list) key)))) ; We will be working with tagged data, so we a couple of functions for that: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ; Finally, we need to implement the infrastructure we need for data-directed ; programming, i.e. the get and put procedures. We shall use Racket hashes for ; that one. (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type))) ; a. get-record is just a simple generic procedure, implemented in a ; data-directed way. The generic implementation is below, while the specific ; implementation for each file is in the install-*-package procedure. Note ; that we attach a tag to the name to be consistent with apply-generic. (define (get-record name file) (apply-generic 'get-record (attach-tag 'string name) file)) ; b. get-salary is fairly similar to get-record: (define (get-salary record) (apply-generic 'get-salary record)) ; c. The list of divisions taken by find-employee-record should be type ; tagged. That said, here's the implementation: (define (find-employee-record name division-files) (if (null? division-files) '() (let ((record (get-record name (car division-files)))) (if (null? record) (find-employee-record name (cdr division-files)) record)))) ; Here are the Atreides and Fremen packages: (define (install-atreides-package) (define (tag record) (if (null? record) record (attach-tag 'atreides record))) (define (get-record name file) (a-list-get file name)) (define (get-salary record) (a-list-get record 'salary)) (put 'get-record '(string atreides-file) (lambda (name file) (tag (get-record name file)))) (put 'get-salary '(atreides) get-salary)) (define (install-fremen-package) (define (tag record) (if (null? record) record (attach-tag 'fremen record))) (define (get-record name file) (p-list-get file name)) (define (get-salary record) (p-list-get record 'income)) (put 'get-record '(string fremen-file) (lambda (name file) (tag (get-record name file)))) (put 'get-salary '(fremen) get-salary)) ; And here's how we install them: (install-atreides-package) (install-fremen-package) ; d. Whenever a new company is bought, there is only one change needed. The ; company needs to provide a procedure analogous to install-atreides-package ; that is able to work with their file. ; ; A question that is left unanswered is how to get the file for each division ; and tag it accodingly. One idea would be that each division has a name and ; we implement a procedure get-division-file that takes as an argument the ; division name and returns the file. This can be implemented in a number of ; ways, but all of those I can think of involve knowing something about state. ================================================ FILE: scheme/sicp/02/75.scm ================================================ ; SICP exercise 2.75 ; ; Implement the constructor make-from-mag-ang in message-passing style. This ; procedure should be analogousto the make-from-real-imag procedure given ; above. (define (apply-generic op arg) (arg op)) (define (magnitute imag) (apply-generic 'magnitute imag)) (define (angle imag) (apply-generic 'angle imag)) (define (real-part imag) (apply-generic 'real-part imag)) (define (imag-part imag) (apply-generic 'imag-part imag)) (define (make-from-mag-ang mag ang) (define (dispatch op) (cond ((eq? op 'magnitute) mag) ((eq? op 'angle) ang) ((eq? op 'real-part) (* mag (cos ang))) ((eq? op 'imag-part) (* mag (sin ang))) (else (error "Unknown op - MAKE-FROM-MAG-ANG" op)))) dispatch) ================================================ FILE: scheme/sicp/02/76.scm ================================================ ; SICP exercise 2.76 ; ; As a large system with generic operations evolves, new types of data objects ; or new operations may be needed. For each of the three strategies - generic ; operations with explicit dispatch, data-directed style and ; message-passing-style - describe the changes that must be made to a system ; in order to add new types or new operations. Which organization would be ; most appropriate for a system in which new types must often be added? Which ; would be most appropriate for a system in which new operations must often be ; added? ; This is very similar to Uncle Bob's dichotomy about structures vs. objects. ; ; With generic operations with explicit dispatch, we need to modify every ; existing procedure when we add a new type. Adding a new operation is ; simpler, since we just need to add one procedure. ; ; With message-passing-style, we need to modify all existing types when we add ; a new operation, but we can add a new type without additively. ; ; Data-directed style is a bit more complicated. The structure in the examples ; we've seen so far implies that it is similar to message-passing-style - i.e. ; we can add a new type easily, but adding operations requires modifying the ; existing modules. But this is not true - we can write a module that adds a ; new operation as well, although it needs to know about the types that exist ; so far. To be fair, the packages we've seen so far have been centered around ; a type, but we can organize them around operations too. That way, it is not ; a matter of possibility, but consistency - we can add either new operations ; and new types, but if we have type-centered packages, creating one that ; defines a new operation would be inconsistent. It becomes more complex when ; the packages that are installed need to know about each other - i.e. package ; A introduces an operation and package B introduces a type that implements ; the operation from package A. In all cases, this is the most flexible ; solution. ; ; In object-oriented lingo, generic operations with explicit dispatch is ; similar to structures, message-passing-style is similar to objects and ; data-directed style is quite similar to a sparse Visitor design pattern. ; ; As for the questions, generic operations with explicit dispatch are more ; appropriate for adding a new operation, while message-passing style is more ; appropriate for adding a new type. Data-directed style is less optimal than ; either, but enables both in an additive way. ================================================ FILE: scheme/sicp/02/77.scm ================================================ ; SICP exercise 2.77 ; ; Louis Reasoner tries to evaluate the expression (magnitute z) where z is the ; object shown in Figure 2.24. To his surprise, instead of the answer 5 he ; gets an error message from apply-generic, saying there is no method for the ; operation magnitute on the types (complex). He shows this interaction to ; Alyssa P. Hacker, who says "The problem is that the complex-number selectors ; were never defined for complex numbers, just for polar and rectangular ; numbers. All you have to do to make this work is add the following to the ; complex package:" ; ; (put 'real-part '(complex) real-part) ; (put 'imag-part '(complex) imag-part) ; (put 'magnitute '(complex) magnitute) ; (put 'angle '(complex) angle) ; ; Describe in details why this works. As an example, trace through all the ; procedures called in evaluating the expression (magnitute z) where z is the ; object shown in Figure 2.24. In particular, how many times is apply-generic ; invoked? What procedure is dispatched in each case? ; It's straightforward. ; ; Whenever we call (magnitute z) we get to: ; ; (apply-generic 'magnitute z) ; ; where z is (complex (rectangular (3 . 4))). This, of course, fails since ; magnitute is not installed for complex. As soon as we install it, though, it ; would resolve to calling: ; ; (apply-generic 'magnitute '(rectangular (3 . 4))) ; ; That's because apply-generic strips the type tags whenever it passes the ; datum. This will dispatch to the code in the rectangular package, which ; would return 5. ; ; That said, apply-generic is called twice. The first time it is dispatched to ; back to magnitute, while the second - to the code in the rectangular ; package. ================================================ FILE: scheme/sicp/02/78.scm ================================================ ; SICP exercise 2.78 ; ; The internal procedures in the scheme-number package are essentially nothing ; more than calls to the primitive procedures +, -, etc. It was not possible ; to use the primitives of the language directly because our type-tag system ; requires that each data object have a type attached to it. In fact, however, ; all Lisp implementations do have a type system, which they use internally. ; Primitive predicates such as symbol? and number? determine whether data ; objects have particular types. Modify the definitions of type-tag, contents ; and attach-tag form Section 2.4.2 so that our generic system takes advantage ; of Scheme's internal type system. That is to say, the system should work as ; before except that ordinary numbers should be represented simply as Scheme ; numbers rather than as pairs whose car is the symbol scheme-number. ; Boy, that's though. We need to implement a chunk of the code we had so far ; in the chapter. Let's do it, since we are going to need it for the next few ; exercises. The actual solution of the exercise is at the end. ; First, let's start with the dispatch table. (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type))) ; Now the procedures we need for the type system: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ; Some auxilary functions: (define (square a) (* a a)) ; Now the generic arithmemtic procedures: (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) ; And now - the scheme number package: (define (install-scheme-number-package) (define (tag x) (attach-tag 'scheme-number x)) (put 'add '(scheme-number scheme-number) (lambda (x y) (tag (+ x y)))) (put 'sub '(scheme-number scheme-number) (lambda (x y) (tag (- x y)))) (put 'mul '(scheme-number scheme-number) (lambda (x y) (tag (* x y)))) (put 'div '(scheme-number scheme-number) (lambda (x y) (tag (/ x y)))) (put 'make 'scheme-number (lambda (x) (tag x))) 'done) (define (make-scheme-number n) ((get 'make 'scheme-number) n)) ; The next one is the rational numbers: (define (install-rational-package) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (let ((g (gcd n d))) (cons (/ n g) (/ d g)))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (tag x) (attach-tag 'rational x)) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'make 'rational (lambda (n d) (tag (make-rat n d)))) 'done) (define (make-rational n d) ((get 'make 'rational) n d)) ; Now we need the complex numbers. They are trickier. We start with the ; selector procedures: (define (real-part z) (apply-generic 'real-part z)) (define (imag-part z) (apply-generic 'imag-part z)) (define (magnitude z) (apply-generic 'magnitude z)) (define (angle z) (apply-generic 'angle z)) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) ; They are followed by the rectangular package: (define (install-rectangular-package) (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) (define (magnitude z) (sqrt (+ (square (real-part z)) (square (imag-part z))))) (define (angle z) (atan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (* r (cos a)) (* r (sin a)))) (define (tag x) (attach-tag 'rectangular x)) (put 'real-part '(rectangular) real-part) (put 'imag-part '(rectangular) imag-part) (put 'angle '(rectangular) angle) (put 'magnitude '(rectangular) magnitude) (put 'make-from-real-imag 'rectangular (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) ; Second, the polar package: (define (install-polar-package) (define (magnitude z) (car z)) (define (angle z) (cdr z)) (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) (* (magnitude z) (cos (angle z)))) (define (imag-part z) (* (magnitude z) (sin (angle z)))) (define (make-from-real-imag x y) (cons (sqrt (+ (square x) (square y))) (atan y x))) (define (tag x) (attach-tag 'polar x)) (put 'real-part '(polar) real-part) (put 'imag-part '(polar) imag-part) (put 'magnitude '(polar) magnitude) (put 'angle '(polar) angle) (put 'make-from-real-imag 'polar (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'polar (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) ; And finally, the complex package: (define (install-complex-package) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) (define (add-complex z1 z2) (make-from-real-imag (+ (real-part z1) (real-part z2)) (+ (imag-part z1) (imag-part z2)))) (define (sub-complex z1 z2) (make-from-real-imag (- (real-part z1) (real-part z2)) (- (imag-part z1) (imag-part z2)))) (define (mul-complex z1 z2) (make-from-mag-ang (* (magnitude z1) (magnitude z2)) (+ (angle z1) (angle z2)))) (define (div-complex z1 z2) (make-from-mag-ang (/ (magnitude z1) (magnitude z2)) (- (angle z1) (angle z2)))) (define (tag x) (attach-tag 'complex x)) (put 'real-part '(complex) real-part) (put 'imag-part '(complex) imag-part) (put 'magnitude '(complex) magnitude) (put 'angle '(complex) angle) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a)) ; Finally, we install the packages: (install-scheme-number-package) (install-rational-package) (install-rectangular-package) (install-polar-package) (install-complex-package) ; And now - the solution. We just redefine some functions. The solution is ; neat, since it does not involve modifying the internals of scheme-package, ; which is very weird. It is way slower, however, since there is a bunch of ; no-op calls to type-tag and contents whenever the operations is performed. ; It is not optimal, but it definitelly introduces an interesting thought - ; the modification the exercises required can be implemented just in the code ; for the "type system", without modification of ; install-scheme-number-package. It has just one global dependency, which is ; the name of the type - scheme-number. (define (attach-tag type-tag contents) (if (equal? type-tag 'scheme-number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((pair? datum) (car datum)) ((number? datum) 'scheme-number) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((pair? datum) (cdr datum)) ((number? datum) datum) (else (error "Bad tagged datum - CONTENTS" datum)))) ================================================ FILE: scheme/sicp/02/79.scm ================================================ ; SICP exercise 2.79 ; ; Define a generic equality predicate equ? that tests the equality of two ; numbers, and install it in the generic arithmetic package. The operation ; should work for ordinary numbers, rational numbers, and complex numbers. ; Simple enough. We shall define a package that just defines a single ; operation - equ?. The alternative would be to spread this over in the ; existing packages. The solution is in the end, since we need to define ; install-equ?-package after we have redefined real-part and imag-part. ; First, let's start with the dispatch table. (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type))) ; Now the procedures we need for the type system: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ; Some auxilary functions: (define (square a) (* a a)) ; Now the generic arithmemtic procedures: (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) ; And now - the scheme number package: (define (install-scheme-number-package) (define (tag x) (attach-tag 'scheme-number x)) (put 'add '(scheme-number scheme-number) (lambda (x y) (tag (+ x y)))) (put 'sub '(scheme-number scheme-number) (lambda (x y) (tag (- x y)))) (put 'mul '(scheme-number scheme-number) (lambda (x y) (tag (* x y)))) (put 'div '(scheme-number scheme-number) (lambda (x y) (tag (/ x y)))) (put 'make 'scheme-number (lambda (x) (tag x))) 'done) (define (make-scheme-number n) ((get 'make 'scheme-number) n)) ; The next one is the rational numbers: (define (install-rational-package) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (let ((g (gcd n d))) (cons (/ n g) (/ d g)))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (tag x) (attach-tag 'rational x)) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'make 'rational (lambda (n d) (tag (make-rat n d)))) 'done) (define (make-rational n d) ((get 'make 'rational) n d)) ; Now we need the complex numbers. They are trickier. We start with the ; selector procedures: (define (real-part z) (apply-generic 'real-part z)) (define (imag-part z) (apply-generic 'imag-part z)) (define (magnitude z) (apply-generic 'magnitude z)) (define (angle z) (apply-generic 'angle z)) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) ; They are followed by the rectangular package: (define (install-rectangular-package) (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) (define (magnitude z) (sqrt (+ (square (real-part z)) (square (imag-part z))))) (define (angle z) (atan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (* r (cos a)) (* r (sin a)))) (define (tag x) (attach-tag 'rectangular x)) (put 'real-part '(rectangular) real-part) (put 'imag-part '(rectangular) imag-part) (put 'angle '(rectangular) angle) (put 'magnitude '(rectangular) magnitude) (put 'make-from-real-imag 'rectangular (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) ; Second, the polar package: (define (install-polar-package) (define (magnitude z) (car z)) (define (angle z) (cdr z)) (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) (* (magnitude z) (cos (angle z)))) (define (imag-part z) (* (magnitude z) (sin (angle z)))) (define (make-from-real-imag x y) (cons (sqrt (+ (square x) (square y))) (atan y x))) (define (tag x) (attach-tag 'polar x)) (put 'real-part '(polar) real-part) (put 'imag-part '(polar) imag-part) (put 'magnitude '(polar) magnitude) (put 'angle '(polar) angle) (put 'make-from-real-imag 'polar (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'polar (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) ; And finally, the complex package: (define (install-complex-package) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) (define (add-complex z1 z2) (make-from-real-imag (+ (real-part z1) (real-part z2)) (+ (imag-part z1) (imag-part z2)))) (define (sub-complex z1 z2) (make-from-real-imag (- (real-part z1) (real-part z2)) (- (imag-part z1) (imag-part z2)))) (define (mul-complex z1 z2) (make-from-mag-ang (* (magnitude z1) (magnitude z2)) (+ (angle z1) (angle z2)))) (define (div-complex z1 z2) (make-from-mag-ang (/ (magnitude z1) (magnitude z2)) (- (angle z1) (angle z2)))) (define (tag x) (attach-tag 'complex x)) (put 'real-part '(complex) real-part) (put 'imag-part '(complex) imag-part) (put 'magnitude '(complex) magnitude) (put 'angle '(complex) angle) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a)) ; Finally, we install the packages: (install-scheme-number-package) (install-rational-package) (install-rectangular-package) (install-polar-package) (install-complex-package) ; Finally, the solution. Note that comparing rational is slightly hacky (it ; compares representation, not values), since rational numbers do not expose ; selectors like numer and denom. (define (install-equ?-package) (put 'equ? '(scheme-number scheme-number) =) (lambda (x y) (= x y)) (put 'equ? '(rational rational) (lambda (x y) (equal? x y))) (put 'equ? '(complex complex) (lambda (x y) (and (= (real-part x) (real-part y)) (= (imag-part x) (imag-part y))))) 'done) (define (equ? x y) (apply-generic 'equ? x y)) (install-equ?-package) ================================================ FILE: scheme/sicp/02/80.scm ================================================ ; SICP exercise 2.80 ; ; Define a generic predicate =zero? that tests if its argument is zero, and ; instal it in the generic artihmetic package. The operation should work for ; ordinary numbers, rational numbers, and complex numbers. ; It would have been awesome if we could base this on the previous exercise. ; Our type system, however, unboxes the type tags and we cannot directly ; delegate to equ?. Unfortunatelly, we need to implement it ourselves. Again, ; we shall define it in a separate package. The solution, due to Racket ; scoping rules, is at the end. We start with the arithmetic package. ; First, let's start with the dispatch table. (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type))) ; Now the procedures we need for the type system: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ; Some auxilary functions: (define (square a) (* a a)) ; Now the generic arithmemtic procedures: (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) ; And now - the scheme number package: (define (install-scheme-number-package) (define (tag x) (attach-tag 'scheme-number x)) (put 'add '(scheme-number scheme-number) (lambda (x y) (tag (+ x y)))) (put 'sub '(scheme-number scheme-number) (lambda (x y) (tag (- x y)))) (put 'mul '(scheme-number scheme-number) (lambda (x y) (tag (* x y)))) (put 'div '(scheme-number scheme-number) (lambda (x y) (tag (/ x y)))) (put 'make 'scheme-number (lambda (x) (tag x))) 'done) (define (make-scheme-number n) ((get 'make 'scheme-number) n)) ; The next one is the rational numbers: (define (install-rational-package) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (let ((g (gcd n d))) (cons (/ n g) (/ d g)))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (tag x) (attach-tag 'rational x)) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'make 'rational (lambda (n d) (tag (make-rat n d)))) 'done) (define (make-rational n d) ((get 'make 'rational) n d)) ; Now we need the complex numbers. They are trickier. We start with the ; selector procedures: (define (real-part z) (apply-generic 'real-part z)) (define (imag-part z) (apply-generic 'imag-part z)) (define (magnitude z) (apply-generic 'magnitude z)) (define (angle z) (apply-generic 'angle z)) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) ; They are followed by the rectangular package: (define (install-rectangular-package) (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) (define (magnitude z) (sqrt (+ (square (real-part z)) (square (imag-part z))))) (define (angle z) (atan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (* r (cos a)) (* r (sin a)))) (define (tag x) (attach-tag 'rectangular x)) (put 'real-part '(rectangular) real-part) (put 'imag-part '(rectangular) imag-part) (put 'angle '(rectangular) angle) (put 'magnitude '(rectangular) magnitude) (put 'make-from-real-imag 'rectangular (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) ; Second, the polar package: (define (install-polar-package) (define (magnitude z) (car z)) (define (angle z) (cdr z)) (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) (* (magnitude z) (cos (angle z)))) (define (imag-part z) (* (magnitude z) (sin (angle z)))) (define (make-from-real-imag x y) (cons (sqrt (+ (square x) (square y))) (atan y x))) (define (tag x) (attach-tag 'polar x)) (put 'real-part '(polar) real-part) (put 'imag-part '(polar) imag-part) (put 'magnitude '(polar) magnitude) (put 'angle '(polar) angle) (put 'make-from-real-imag 'polar (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'polar (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) ; And finally, the complex package: (define (install-complex-package) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) (define (add-complex z1 z2) (make-from-real-imag (+ (real-part z1) (real-part z2)) (+ (imag-part z1) (imag-part z2)))) (define (sub-complex z1 z2) (make-from-real-imag (- (real-part z1) (real-part z2)) (- (imag-part z1) (imag-part z2)))) (define (mul-complex z1 z2) (make-from-mag-ang (* (magnitude z1) (magnitude z2)) (+ (angle z1) (angle z2)))) (define (div-complex z1 z2) (make-from-mag-ang (/ (magnitude z1) (magnitude z2)) (- (angle z1) (angle z2)))) (define (tag x) (attach-tag 'complex x)) (put 'real-part '(complex) real-part) (put 'imag-part '(complex) imag-part) (put 'magnitude '(complex) magnitude) (put 'angle '(complex) angle) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (r a) (tag (make-from-mag-ang r a)))) 'done) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a)) ; Finally, we install the packages: (install-scheme-number-package) (install-rational-package) (install-rectangular-package) (install-polar-package) (install-complex-package) ; Finally, the solution. Note that, again, it is slightly hacky because the ; rational package does not expose enough interface to have a clean level of ; abstraction. We end up having to compare representations. (define (install-=zero?-package) (put '=zero? '(scheme-number) (lambda (x) (= x 0))) (put '=zero? '(rational) (lambda (x) (equal? x (contents (make-rational 0 1))))) (put '=zero? '(complex) (lambda (z) (and (= (real-part z) 0) (= (imag-part z) 0)))) 'done) (define (=zero? x) (apply-generic '=zero? x)) (install-=zero?-package) ================================================ FILE: scheme/sicp/02/81.scm ================================================ ; SICP exercise 2.81 ; ; Louis Reasoner has noticed that apply-generic may try to coerce arguments to ; each other's types even if they already have the same type. Therefore, he ; reasons, we need to put procedures in the coercion table to coerce arguments ; of each type to their own type. For exapmle, in addition to the ; scheme-number->complex coercion shown above, he would do: ; ; (define (scheme-number->scheme-number n) n) ; (define (complex->complex z) z) ; (put-coercion 'scheme-number 'scheme-number ; scheme-number->scheme-number) ; (put-coercion 'complex 'complex complex->complex) ; ; a. With Louis' coercion procedures installed, what happens if apply-generic ; is called with two arguments of type scheme-number or two arguments of type ; complex for an operation that is not found in the table for those types? For ; example, assume that we've defined a generic exponentiation operation: ; ; (define (exp x y) (apply-generic 'exp x y)) ; ; and have put a procedure for exponentiation in the Scheme number package but ; not in any other package: ; ; ;; following added to Scheme-number package ; (put 'exp '(scheme-number scheme-number) ; (lambda (x y) (tag (expt x y)))) ; using primitive expt ; ; What happens if we call exp with two complex numbers as arguments? ; ; b. Is Louis correct that something had to be done about coercion with ; arguments of the same type, or does apply-generic work correctly as is? ; ; c. Modify apply-generic so that it doesn't try coercion if the two arguments ; have the same type. ; a. Well, naturally, when exp is called with two complex numbers, it would ; not be found in the table. Since a coercion procedure is found, though, it ; would recursively call itself with the same two complex numbers, leading to ; an infinite recursion. Given the tail position of the recursive call, the ; program would just loop infinitely. ; ; b. He is right, although he does not provide a good reason for being right. ; Trying to coerce numbers to the same type does not hurt. It slows the ; computation down, but in no way makes it incorrect. The real problem is that ; installing those coercion procedures causes operations to end up in an ; infinite loop. What we can do is avoid coercing numbers that are the same ; type. That way installing those procedures (which are logically right) would ; not cause the program to get stuck. ; ; c. I will not provide a test for this, just the code. I hope I am forgiven, ; since otherwise I would need to drag in a lot of code in order to test it: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (if (= (length args) 2) (let ((type1 (car type-tags)) (type2 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (if (not (eq? type1 type2)) (let ((t1->t2 (get-coercion type1 type2)) (t2->t1 (get-coercion type2 type1))) (cond (t1->t2 (apply-generic op (t1->t2 a1) a2)) (t2->t1 (apply-generic op a1 (t2->t1 a2))) (else (error "No method for these types" (list op type-tags))))) (error "No method for these types" (list op type-tags)))) (error "No method for these types" (list op type-tags))))))) ================================================ FILE: scheme/sicp/02/82.scm ================================================ ; SICP exercise 2.82 ; ; Show how the generalize apply-generic to handle coercion in the general case ; of multiple arguments. One strategy is to attempt to coerce all the ; arguments to the type of the first argument, then to the type of the second ; argument, and so on. Give an example of a situation where this strategy (and ; likewise the two-argument version given above) is not sufficiently general. ; (Hint: consider the case where there are some suitable mixed-type operations ; present in the table that will not be tried.) ; We want to test this. So first, we are going to implement all the necessary ; infrastructure. We shall not use real types, however, and we shall not ; introduce real operations. We would just have dummy operations and dummy ; conversions. ; Let's assume we have three types - a, b and c, where we have conversions ; a->b and b->c. Thus, c is the most generic type and a is the least generic ; one. ; Let's have the usual infrastructure. First, the table: (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Next, the coercion operations: (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; Then, the type operations: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) ; Here's an intermediate version of apply-generic: (define (apply-generic op . args) (define (id x) x) (define (get-coercion-or-id from to) (if (equal? from to) id (get-coercion from to))) (define (coerce-to args target-type) (let* ((type-tags (map type-tag args)) (coercions (map (lambda (type) (get-coercion-or-id type target-type)) type-tags)) (coerced-all? (not (memq #f coercions)))) (if coerced-all? (map (lambda (coerce datum) (coerce datum)) coercions args) #f))) (define (find-coercion type-tags) (if (null? type-tags) #f (or (coerce-to args (car type-tags)) (find-coercion (cdr type-tags))))) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (let ((coerced-args (find-coercion type-tags))) (if coerced-args (apply apply-generic op coerced-args) (error "No method for these types" (list op type-tags)))))))) ; Now, let's introduce our types: (define (make-a) (attach-tag 'a "a")) (define (make-b) (attach-tag 'b "b")) (define (make-c) (attach-tag 'c "c")) ; Not some coercion operations: (put-coercion 'a 'b (lambda (x) (attach-tag 'b (string-append (contents x) "->" "b")))) ; Our operations would be nonsensical - foo, bar and baz. (define (foo x y) (apply-generic 'foo x y)) (define (bar x y z) (apply-generic 'bar x y z)) (define (baz w x y z) (apply-generic 'baz w x y z)) (put 'foo '(a a) (lambda args (cons 'foo-a-a (map string->symbol args)))) (put 'foo '(b b) (lambda args (cons 'foo-b-b (map string->symbol args)))) (put 'bar '(a a a) (lambda args (cons 'bar-a-a-a (map string->symbol args)))) (put 'bar '(b b b) (lambda args (cons 'bar-b-b-b (map string->symbol args)))) (put 'baz '(a a a a) (lambda args (cons 'baz-a-a-a-a (map string->symbol args)))) (put 'baz '(b b b b) (lambda args (cons 'baz-b-b-b-b (map string->symbol args)))) ; As for when this not sufficiently general - consider having foo defined for ; '(c c), but passing 'a and 'b - coercing just to b won't be enough. We need ; to coerce both arguments to c, but our apply-generic has no way of knowing ; that. Another example is if (foo b c) is defined and we call it with a and ; c. apply-generic will attempt to convert either to a or to c, but foo would ; not be defined for both. ================================================ FILE: scheme/sicp/02/83.scm ================================================ ; SICP exercise 2.83 ; ; Suppose you are designing a generic artihmetic system for dealing with the ; tower of types shown in Figure 2.25: integer, rational, real and complex. ; For each type (except complex), design a procedure that raises objects of ; that type one level in the tower. Show how to install a generic raise ; operation that will work with each type (except complex). ; Ugh. We end up having tons of code again. Ok, let's start with the ; boilerplate. We shall use a simplified version of our previous code that ; does not support all the operations. Furthermore, we shall not hide stuff ; behind install-*-package. ; Let's have the usual infrastructure. First, the table: (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Next, the coercion operations: (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; Then, the type operations: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ; Now our types (define (make-integer n) (attach-tag 'integer n)) (define (make-rational r d) (attach-tag 'rational (cons r d))) (define (make-real x) (attach-tag 'real x)) (define (make-complex r i) (attach-tag 'complex (cons r i))) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'raise '(rational) (lambda (r) (make-real (* 1.0 (/ (car r) (cdr r)))))) (put 'raise '(real) (lambda (x) (make-complex x 0))) (define (raise x) (apply-generic 'raise x)) ================================================ FILE: scheme/sicp/02/84.scm ================================================ ; SICP exercise 2.84 ; ; Using the raise operation in Exercise 2.83, modify the apply-generic ; procedure so that it coerces its arguments to have the same type by the ; method of succesive raising, as discussed in this section. You will need to ; devise a way to test which of two types is higher in the tower. Do this in a ; manner that is compatible with the rest of the system and will not lead to ; problems in adding new levels to the tower. ; Since we don't know about state yet, we have to accept some constraints. ; First, if new types can be added, they can make it only on the top or bottom ; of the type tower. Second, for simplicity, the operations supported by ; apply-generic will accept only two arguments. If we have that, we can ; implement the exercise nicely. ; Again, we start with our usual infrastructure. First, the table: (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Next, the coercion operations: (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; Then, the type operations: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) ; Now our types and the raise procedure. (define (make-integer n) (attach-tag 'integer n)) (define (make-rational r d) (attach-tag 'rational (cons r d))) (define (make-real x) (attach-tag 'real x)) (define (make-complex r i) (attach-tag 'complex (cons r i))) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'raise '(rational) (lambda (r) (make-real (* 1.0 (/ (car r) (cdr r)))))) (put 'raise '(real) (lambda (x) (make-complex x 0))) (define (raise x) (apply-generic 'raise x)) ; Now, we are going to implement a procedure that returns the supertype of ; another type. (put 'supertype 'integer 'rational) (put 'supertype 'rational 'real) (put 'supertype 'real 'complex) (define (supertype type) (get 'supertype type)) ; Next, we implement a predicate that tells us whether one type is the ; supertype of another. (define (supertype? parent child) (let ((type (supertype child))) (cond ((equal? type parent) #t) ((not type) #f) (else (supertype? parent type))))) ; Now we can define apply-generic: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (cond (proc (apply proc (map contents args))) ((= (length type-tags) 2) (let ((type1 (car type-tags)) (type2 (cadr type-tags)) (x (car args)) (y (cadr args))) (cond ((supertype? type1 type2) (apply-generic op x (raise y))) ((supertype? type2 type1) (apply-generic op (raise x) y)) (else (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) (else (error "No method for these types - APPLY-GENERIC" (list op type-tags))))))) ; Finally, we have an operation we can test with: (put 'foo '(integer integer) (lambda (x y) 'foo-integer)) (put 'foo '(rational rational) (lambda (x y) 'foo-rational)) (put 'foo '(real real) (lambda (x y) 'foo-real)) (put 'foo '(complex complex) (lambda (x y) 'foo-complex)) (define (foo x y) (apply-generic 'foo x y)) ; Now if we need to add another supertype on the top or the bottom of the ; tower, we need to do two things - first, add it as a supertype of complex ; (if it is on the top) or add it as the supertype of integer (if it is on the ; bottom) and second, we need to provide a coercion procedure. ================================================ FILE: scheme/sicp/02/85.scm ================================================ ; SICP exercise 2.85 ; ; This section mentioned a method for "simplifying" a data object by lowering ; it in the tower of types as far as possible. Design a procedure drop that ; accomplishes this for the tower described in Exercise 2.83. The key is to ; decide, in some general way, whether an object can be lowered. For example, ; the complex number 1.5 + 0i can be lowered as far as real, the complex ; number 1 + 0i can be lowered as far s integer, and the complex number 2 + 3i ; cannot be lowered at all. Here is a plan for determining whether an object ; can be lowered: begin by defining a generic operation project that "pushes" ; an object down in the tower. For example, projecting a complex number would ; involve throwing away the imaginary part. Then a number can be dropped if, ; when we project it and raise the result back to the type we started with, we ; end up with something equal to what we started with. Show how to implement ; this idea in detail, by writing a drop procedure that drops an object as far ; as possible. You will need to design the various projection operations and ; install project as a generic operation in the system. You will also need to ; make use of a generic equality predicate, such as described in exercise ; 2.79. Finally, use drop to rewrite apply-generic from exercise 2.84 so that ; it "simplifies" its answers. ; We base our work on the solution of the previous exercise. The ; implementation will be a bit flaky, since it is in no way the responsibility ; of apply-generic to simplify types. Instead, each operation should indicate ; whether it wants simplification. We shall just assume that every ; two-argument generic operation that returns a pair (i.e., tagged data) does ; simplificaiton. Otherwise, the result from drop and project would try to get ; simplified, which would lead to an infinite recursion. Furthermore, we shall ; call our procedure drop-down instead of drop, since the name drop is used in ; Racket and there are some weird rules going on. ; Again, we start with our usual infrastructure. First, the table: (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Next, the coercion operations: (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; Then, the type operations: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) ; Now our types and the raise procedure. (define (round-to-int x) (inexact->exact (truncate x))) (define (make-integer n) (attach-tag 'integer n)) (define (make-rational n d) (let ((g (gcd n d))) (attach-tag 'rational (cons (round-to-int (/ n g)) (round-to-int (/ d g)))))) (define (make-real x) (attach-tag 'real x)) (define (make-complex r i) (attach-tag 'complex (cons r i))) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'raise '(rational) (lambda (r) (make-real (* 1.0 (/ (car r) (cdr r)))))) (put 'raise '(real) (lambda (x) (make-complex x 0))) (define (raise x) (apply-generic 'raise x)) ; Now, we are going to implement a procedure that returns the supertype of ; another type. (put 'supertype 'integer 'rational) (put 'supertype 'rational 'real) (put 'supertype 'real 'complex) (define (supertype type) (get 'supertype type)) ; Next, we implement a predicate that tells us whether one type is the ; supertype of another. (define (supertype? parent child) (let ((type (supertype child))) (cond ((equal? type parent) #t) ((not type) #f) (else (supertype? parent type))))) ; Now we can define apply-generic: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (let ((result (apply proc (map contents args)))) (if (and (= (length args) 2) (projectable? result)) (drop-down result) result)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ; Let's have an add operation we can use: (put 'add '(integer integer) (lambda (x y) (make-integer (+ x y)))) (put 'add '(rational rational) (lambda (x y) (let* ((n1 (car x)) (d1 (cdr x)) (n2 (car y)) (d2 (cdr y))) (make-rational (+ (* n1 d2) (* n2 d1)) (* d1 d2))))) (put 'add '(real real) (lambda (x y) (make-real (+ x y)))) (put 'add '(complex complex) (lambda (z1 z2) (make-complex (+ (car z1) (car z2)) (+ (cdr z1) (cdr z2))))) (define (add x y) (apply-generic 'add x y)) ; The equ? procedure: (put 'equ? '(integer integer) =) (put 'equ? '(rational rational) equal?) (put 'equ? '(real real) =) (put 'equ? '(complex complex) equal?) (define (equ? x y) (apply-generic 'equ? x y)) ; The project procedure: (put 'project '(complex) (lambda (z) (make-real (car z)))) (put 'project '(real) (lambda (x) (make-rational (round-to-int (numerator x)) (round-to-int (denominator x))))) (put 'project '(rational) (lambda (x) (make-integer (round-to-int (/ (car x) (cdr x)))))) (define (project x) (apply-generic 'project x)) (define (projectable? x) (and (pair? x) (get 'project (list (type-tag x))))) ; The drop procedure: (define (drop-down x) (if (projectable? x) (let* ((projection (project x)) (reraise (raise projection))) (if (equ? reraise x) (drop-down projection) x)) x)) ; Again, we do this for Racket scoping rules: (define drop drop-down) ================================================ FILE: scheme/sicp/02/86.scm ================================================ ; SICP exercise 2.86 ; ; Suppose we want to handle comlex numbers whose real parts, imaginary parts, ; magnitudes and angles can be either ordinary numbers, rational numbers or ; other numbers we wish to add to our system. Describe and implement the ; changes to the system needed to accomodate this. You will have to define ; operations such as sine and cosine that are generic over ordinary numbers ; and rational numbers. ; Meh. This is a long one. OK, let's start with our assumptions first. ; ; We shall have three number types - integer, rational and real. We shall ; implement our own. Additionally we will support the scheme-number type by ; patching the type system functions. We will have all the generic operations ; working for those two types. Furthermore, we shall support the type tower ; and have raise, project and drop. We shall have a coercion procedure that ; attempts to raise its arguments as much as it can, in order to implement ; sine, cosine and atan on all the numbers we have. ; We shall have five number types - integer, rational, scheme-number, scheme ; and complex. We will patch the type functions as we did in a previous ; exercise in order to support scheme-numbers seamlessly. We will implement ; generic operations on all those types. Our type tower will support raise, ; project and drop (although we will call it simplify). We will have a ; coercion procedure that attempts to raise arguments, first to the same type ; and then as much as possible, in order to implement sine, cosine and ; arctangent. We shall eschew the install-*-package pattern - the package ; boundaries are obvious. ; Let's start with the type functions, table and coercion infrastructure: (define (attach-tag type-tag contents) (if (equal? type-tag 'scheme-number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) 'scheme-number) ((pair? datum) (car datum)) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum - CONTENTS" datum)))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; Here is our type tower, supetype, supertype?, raise and project: (put 'supertype 'integer 'rational) (put 'supertype 'rational 'scheme-number) (put 'supertype 'scheme-number 'real) (put 'supertype 'real 'complex) (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now a simplification procedure. It will be called simplify instead of drop, ; because drop is already reserved: (define (simplify x) (cond ((not (projectable? x)) x) ((equ? (raise (project x)) x) (simplify (project x))) (else x))) ; Now the generic arithmemtic procedures. Note how square is defined in terms ; of a generic operation without using apply-generic. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (equ? x y) (apply-generic 'equ? x y)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (arctangent x y) (apply-generic 'arctangent x y)) (define (square x) (mul x x)) ; Now some infrastructure for which operations can be simplified. We shall put ; them in the table under the key simplifiable. If an operation is present ; there, the result can be simplified. This is very nice, since apply-generic ; does not need to know which operations should be simplified - instead, when ; adding a new operation, the writer can decide whether it should simplify its ; result. (define (simplifiable? op) (get 'simplifiable op)) (put 'simplifiable 'add #t) (put 'simplifiable 'sub #t) (put 'simplifiable 'mul #t) (put 'simplifiable 'div #t) (put 'simplifiable 'square-root #t) (put 'simplifiable 'sine #t) (put 'simplifiable 'cosine #t) (put 'simplifiable 'arctangent #t) (put 'simplifiable 'real-part #t) (put 'simplifiable 'imag-part #t) (put 'simplifiable 'magnitude #t) (put 'simplifiable 'angle #t) ; And now - the integers. Note that they are not implementing div, since ; division of integers will result to a rational. Also note, that if you ; construct an integer with make-integer, you need to pass in an exact ; integer, otherwise you get an error. (let () (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'equ? '(integer integer) =) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'make 'integer (lambda (n) (if (exact-integer? n) (tag n) (error "Attempted to make an integer with a non-integer" n))))) (define (make-integer n) ((get 'make 'integer) n)) ; The next one is the rational numbers: (let () (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (exact-integer? n) (exact-integer? d)) (let ((g (gcd n d))) (cons (/ n g) (/ d g))) (error "Cannot construct a rational with non-exact numbers" n d))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (raise-rat r) (make-scheme-number (/ (numer r) (denom r)))) (define (project-rat r) (make-integer (truncate (/ (numer r) (denom r))))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put 'raise '(rational) raise-rat) (put 'project '(rational) project-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; And now, the ever-mysterious scheme-numbers. Note that they are inbetween ; the rationals and the reals. This is somehow uncool, since we'll never get a ; real as a result form our operations because of simplification. At least it ; is less writing in the tests. (let () (put 'add '(scheme-number scheme-number) +) (put 'sub '(scheme-number scheme-number) -) (put 'mul '(scheme-number scheme-number) *) (put 'div '(scheme-number scheme-number) /) (put 'equ? '(scheme-number scheme-number) =) (put 'sine '(scheme-number) sin) (put 'cosine '(scheme-number) cos) (put 'square-root '(scheme-number scheme-number) sqrt) (put 'arctangent '(scheme-number scheme-number) atan) (put 'project '(scheme-number) (lambda (x) (make-rational (inexact->exact (truncate x)) 1))) (put 'raise '(scheme-number) (lambda (x) (make-real (exact->inexact x))))) (define (make-scheme-number x) (attach-tag 'scheme-number x)) ; Then the real numbers. They are pretty much the same as the integers, ; although without the exact-integer check. (let () (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'sine '(real) (lambda (x) (tag (sin x)))) (put 'cosine '(real) (lambda (x) (tag (cos x)))) (put 'square-root '(real) (lambda (x) (tag (sqrt x)))) (put 'arctangent '(real real) (lambda (x y) (tag (atan x y)))) (put 'project '(real) (lambda (x) (make-scheme-number x))) (put 'raise '(real) (lambda (x) (make-complex-from-real-imag (tag x) (tag 0.0)))) (put 'equ? '(real real) =) (put 'make 'real (lambda (x) (tag x)))) (define (make-real n) ((get 'make 'real) n)) ; Now we need the complex numbers. They are trickier. We start with the ; generic procedures: (define (real-part z) (apply-generic 'real-part z)) (define (imag-part z) (apply-generic 'imag-part z)) (define (magnitude z) (apply-generic 'magnitude z)) (define (angle z) (apply-generic 'angle z)) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) ; They are followed by the rectangular representation. Note that it is ; implemented in terms of the generic procedures we defined earlier. (let () (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) (define (magnitude z) (square-root (add (square (real-part z)) (square (imag-part z))))) (define (angle z) (arctangent (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (mul r (cosine a)) (mul r (sine a)))) (define (tag x) (attach-tag 'rectangular x)) (put 'real-part '(rectangular) real-part) (put 'imag-part '(rectangular) imag-part) (put 'angle '(rectangular) angle) (put 'magnitude '(rectangular) magnitude) (put 'make-from-real-imag 'rectangular (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-mag-ang r a))))) ; The polar package is similar. (let () (define (magnitude z) (car z)) (define (angle z) (cdr z)) (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) (mul (magnitude z) (cosine (angle z)))) (define (imag-part z) (mul (magnitude z) (sine (angle z)))) (define (make-from-real-imag x y) (cons (square-root (add (square x) (square y))) (arctangent y x))) (define (tag x) (attach-tag 'polar x)) (put 'real-part '(polar) real-part) (put 'imag-part '(polar) imag-part) (put 'magnitude '(polar) magnitude) (put 'angle '(polar) angle) (put 'make-from-real-imag 'polar (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'polar (lambda (r a) (tag (make-from-mag-ang r a))))) ; And finally, the complex package: (let () (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) (define (add-complex z1 z2) (make-from-real-imag (add (real-part z1) (real-part z2)) (add (imag-part z1) (imag-part z2)))) (define (sub-complex z1 z2) (make-from-real-imag (sub (real-part z1) (real-part z2)) (sub (imag-part z1) (imag-part z2)))) (define (mul-complex z1 z2) (make-from-mag-ang (mul (magnitude z1) (magnitude z2)) (add (angle z1) (angle z2)))) (define (div-complex z1 z2) (make-from-mag-ang (div (magnitude z1) (magnitude z2)) (sub (angle z1) (angle z2)))) (define (equ?-complex z1 z2) (and (equ? (real-part z1) (real-part z2)) (equ? (imag-part z1) (imag-part z2)))) (define (tag x) (attach-tag 'complex x)) (put 'real-part '(complex) real-part) (put 'imag-part '(complex) imag-part) (put 'magnitude '(complex) magnitude) (put 'angle '(complex) angle) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'equ? '(complex complex) equ?-complex) (put 'project '(complex) (lambda (z) (real-part z))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (r a) (tag (make-from-mag-ang r a))))) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a)) (define make-complex make-complex-from-real-imag) ; The apply-generic procedure is at the end, because it uses procedures that ; are redefined (such as raise). It is fairly complicated. When it is called ; with a number of arguments, it looks them up in the table and if a procedure ; is present, it calls it. Otherwise, it checks if all the arguments passed to ; it are of the same type and if so, it raises them all and tries again. There ; is an internal recursion in order to provide a good error message - ; otherwise the original arguments will get lost and then error will include ; the raised types. (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (let ((result (apply (get op (map type-tag args)) (map contents args)))) (if (simplifiable? op) (simplify result) result)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/87.scm ================================================ ; SICP exercise 2.87 ; ; Install =zero? for polynomials in the generic arithmetic package. This will ; allow adjoin-term to work for polynomials with coefficients that are ; themselves polynomials. ; OK, let's start with our original arithmetic package. We are going to reuse ; the code from exercise 2.86, although we will remove scheme-numbers because ; they complicate things. ; ; Apart from introducing =zero? to polynomials, we need to add allow for a ; polynomial to be addded and multiplied by a number in order to support ; adding and multiplying polynomials that whose coefficients are themselves ; polynomial. ; The type functions, table and coercion infrastructure. (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; The type tower, supetype, supertype?, raise and project: (put 'supertype 'integer 'rational) (put 'supertype 'rational 'scheme-number) (put 'supertype 'scheme-number 'real) (put 'supertype 'real 'complex) (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now a simplification procedure. It will be called simplify instead of drop, ; because drop is already reserved: (define (simplify x) (cond ((not (projectable? x)) x) ((equ? (raise (project x)) x) (simplify (project x))) (else x))) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (equ? x y) (apply-generic 'equ? x y)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (arctangent x y) (apply-generic 'arctangent x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; The simplification table: (define (simplifiable? op) (get 'simplifiable op)) (put 'simplifiable 'add #t) (put 'simplifiable 'sub #t) (put 'simplifiable 'mul #t) (put 'simplifiable 'div #t) (put 'simplifiable 'square-root #t) (put 'simplifiable 'sine #t) (put 'simplifiable 'cosine #t) (put 'simplifiable 'arctangent #t) (put 'simplifiable 'real-part #t) (put 'simplifiable 'imag-part #t) (put 'simplifiable 'magnitude #t) (put 'simplifiable 'angle #t) ; Integers: (let () (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'equ? '(integer integer) =) (put '=zero? '(integer) zero?) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'make 'integer (lambda (n) (if (exact-integer? n) (tag n) (error "Attempted to make an integer with a non-integer" n))))) (define (make-integer n) ((get 'make 'integer) n)) ; Rational numbers: (let () (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (exact-integer? n) (exact-integer? d)) (let ((g (gcd n d))) (cons (/ n g) (/ d g))) (error "Cannot construct a rational with non-exact numbers" n d))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (=zero?-rat x) (zero? (numer x))) (define (raise-rat r) (make-real (exact->inexact (/ (numer r) (denom r))))) (define (project-rat r) (make-integer (truncate (/ (numer r) (denom r))))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put 'raise '(rational) raise-rat) (put 'project '(rational) project-rat) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; Real numbers: (let () (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'sine '(real) (lambda (x) (tag (sin x)))) (put 'cosine '(real) (lambda (x) (tag (cos x)))) (put 'square-root '(real) (lambda (x) (tag (sqrt x)))) (put 'arctangent '(real real) (lambda (x y) (tag (atan x y)))) (put 'project '(real) (lambda (x) (make-rational (inexact->exact (truncate x)) 1))) (put 'raise '(real) (lambda (x) (make-complex-from-real-imag (tag x) (tag 0.0)))) (put 'equ? '(real real) =) (put '=zero? '(real) zero?) (put 'make 'real (lambda (x) (tag x)))) (define (make-real n) ((get 'make 'real) n)) ; Generic procedures for complex numbers: (define (real-part z) (apply-generic 'real-part z)) (define (imag-part z) (apply-generic 'imag-part z)) (define (magnitude z) (apply-generic 'magnitude z)) (define (angle z) (apply-generic 'angle z)) (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) ; Rectangular representation of complex numbers: (let () (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) (define (magnitude z) (square-root (add (square (real-part z)) (square (imag-part z))))) (define (angle z) (arctangent (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (mul r (cosine a)) (mul r (sine a)))) (define (tag x) (attach-tag 'rectangular x)) (put 'real-part '(rectangular) real-part) (put 'imag-part '(rectangular) imag-part) (put 'angle '(rectangular) angle) (put 'magnitude '(rectangular) magnitude) (put 'make-from-real-imag 'rectangular (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-mag-ang r a))))) ; Polar representation of complex numbers: (let () (define (magnitude z) (car z)) (define (angle z) (cdr z)) (define (make-from-mag-ang r a) (cons r a)) (define (real-part z) (mul (magnitude z) (cosine (angle z)))) (define (imag-part z) (mul (magnitude z) (sine (angle z)))) (define (make-from-real-imag x y) (cons (square-root (add (square x) (square y))) (arctangent y x))) (define (tag x) (attach-tag 'polar x)) (put 'real-part '(polar) real-part) (put 'imag-part '(polar) imag-part) (put 'magnitude '(polar) magnitude) (put 'angle '(polar) angle) (put 'make-from-real-imag 'polar (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'polar (lambda (r a) (tag (make-from-mag-ang r a))))) ; The complex numbers themselves: (let () (define (make-from-real-imag x y) ((get 'make-from-real-imag 'rectangular) x y)) (define (make-from-mag-ang r a) ((get 'make-from-mag-ang 'polar) r a)) (define (add-complex z1 z2) (make-from-real-imag (add (real-part z1) (real-part z2)) (add (imag-part z1) (imag-part z2)))) (define (sub-complex z1 z2) (make-from-real-imag (sub (real-part z1) (real-part z2)) (sub (imag-part z1) (imag-part z2)))) (define (mul-complex z1 z2) (make-from-mag-ang (mul (magnitude z1) (magnitude z2)) (add (angle z1) (angle z2)))) (define (div-complex z1 z2) (make-from-mag-ang (div (magnitude z1) (magnitude z2)) (sub (angle z1) (angle z2)))) (define (equ?-complex z1 z2) (and (equ? (real-part z1) (real-part z2)) (equ? (imag-part z1) (imag-part z2)))) (define (tag x) (attach-tag 'complex x)) (put 'real-part '(complex) real-part) (put 'imag-part '(complex) imag-part) (put 'magnitude '(complex) magnitude) (put 'angle '(complex) angle) (put 'add '(complex complex) (lambda (z1 z2) (tag (add-complex z1 z2)))) (put 'sub '(complex complex) (lambda (z1 z2) (tag (sub-complex z1 z2)))) (put 'mul '(complex complex) (lambda (z1 z2) (tag (mul-complex z1 z2)))) (put 'div '(complex complex) (lambda (z1 z2) (tag (div-complex z1 z2)))) (put 'equ? '(complex complex) equ?-complex) (put 'zero? '(complex complex) (lambda (z) (and (=zero? (real-part z)) (=zero? (imag-part z))))) (put 'project '(complex) (lambda (z) (real-part z))) (put 'make-from-real-imag 'complex (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'complex (lambda (r a) (tag (make-from-mag-ang r a))))) (define (make-complex-from-real-imag x y) ((get 'make-from-real-imag 'complex) x y)) (define (make-complex-from-mag-ang r a) ((get 'make-from-mag-ang 'complex) r a)) (define make-complex make-complex-from-real-imag) ; Now the new stuff - the polynomial package: (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (variable? x) (symbol? x)) (define (adjoin-term term term-list) (if (=zero? (coeff term)) term-list (cons term term-list))) (define (the-empty-termlist) '()) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (empty-termlist? term-list) (null? term-list)) (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - MUL-POLY" (list p1 p2)))) (define (make-const p n) (tag (make-poly (variable p) (adjoin-term (make-term 0 (make-integer n)) (the-empty-termlist))))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'add '(integer polynomial) (lambda (n p) (add (make-const p n) (tag p)))) (put 'mul '(integer polynomial) (lambda (n p) (mul (make-const p n) (tag p)))) (put 'mul '(polynomial integer) (lambda (p n) (mul (make-integer n) (tag p)))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic with some coercion: (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (let ((result (apply (get op (map type-tag args)) (map contents args)))) (if (simplifiable? op) (simplify result) result)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/88.scm ================================================ ; SICP exercise 2.88 ; ; Extend the polynomial system to include subtraction of polynomials. (Hint: ; you may find it helpful to define a generic negation operation.) ; Ok, let's do that. We shall take the code from the previous exercise, but ; for simplicity's sake, let's get rid of the complex numbers. We will ; introduce a new generic operation, neg and we shall use it to implement ; subtraction of polynomials. Whenever we subtract b from a (a - b), we shall ; negate b and add the result to a. Negating b means creating a new polynomial ; in the same variable, will all the coefficients negated with neg. ; The type functions, table and coercion infrastructure. (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; The type tower, supetype, supertype?, raise and project: (put 'supertype 'integer 'rational) (put 'supertype 'rational 'scheme-number) (put 'supertype 'scheme-number 'real) (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now a simplification procedure. It will be called simplify instead of drop, ; because drop is already reserved: (define (simplify x) (cond ((not (projectable? x)) x) ((equ? (raise (project x)) x) (simplify (project x))) (else x))) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (arctangent x y) (apply-generic 'arctangent x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; The simplification table: (define (simplifiable? op) (get 'simplifiable op)) (put 'simplifiable 'add #t) (put 'simplifiable 'sub #t) (put 'simplifiable 'mul #t) (put 'simplifiable 'div #t) (put 'simplifiable 'neg #t) (put 'simplifiable 'square-root #t) (put 'simplifiable 'sine #t) (put 'simplifiable 'cosine #t) (put 'simplifiable 'arctangent #t) (put 'simplifiable 'real-part #t) (put 'simplifiable 'imag-part #t) (put 'simplifiable 'magnitude #t) (put 'simplifiable 'angle #t) ; Integers: (let () (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'neg '(integer) (lambda (x) (tag (- x)))) (put 'equ? '(integer integer) =) (put '=zero? '(integer) zero?) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'make 'integer (lambda (n) (if (exact-integer? n) (tag n) (error "Attempted to make an integer with a non-integer" n))))) (define (make-integer n) ((get 'make 'integer) n)) ; Rational numbers: (let () (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (exact-integer? n) (exact-integer? d)) (let ((g (gcd n d))) (cons (/ n g) (/ d g))) (error "Cannot construct a rational with non-exact numbers" n d))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (neg-rat x) (make-rat (- (numer x)) (denom x))) (define (=zero?-rat x) (zero? (numer x))) (define (raise-rat r) (make-real (exact->inexact (/ (numer r) (denom r))))) (define (project-rat r) (make-integer (truncate (/ (numer r) (denom r))))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put 'raise '(rational) raise-rat) (put 'project '(rational) project-rat) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'neg '(rational) (lambda (x) (tag (neg-rat x)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; Real numbers: (let () (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'neg '(real) (lambda (x) (tag (- x)))) (put 'sine '(real) (lambda (x) (tag (sin x)))) (put 'cosine '(real) (lambda (x) (tag (cos x)))) (put 'square-root '(real) (lambda (x) (tag (sqrt x)))) (put 'arctangent '(real real) (lambda (x y) (tag (atan x y)))) (put 'project '(real) (lambda (x) (make-rational (inexact->exact (truncate x)) 1))) (put 'equ? '(real real) =) (put '=zero? '(real) zero?) (put 'make 'real (lambda (x) (tag x)))) (define (make-real n) ((get 'make 'real) n)) ; The polynomial package: (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (variable? x) (symbol? x)) (define (adjoin-term term term-list) (if (=zero? (coeff term)) term-list (cons term term-list))) (define (the-empty-termlist) '()) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (empty-termlist? term-list) (null? term-list)) (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (map-coeffs proc p) (make-poly (variable p) (map (lambda (term) (make-term (order term) (proc (coeff term)))) (term-list p)))) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - MUL-POLY" (list p1 p2)))) (define (neg-poly p) (map-coeffs neg p)) (define (sub-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (add-poly p1 (neg-poly p2)) (error "Polynomials not in same var - SUB-POLY" (list p1 p2)))) (define (make-const p n) (tag (make-poly (variable p) (adjoin-term (make-term 0 (make-integer n)) (the-empty-termlist))))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(integer polynomial) (lambda (n p) (add (make-const p n) (tag p)))) (put 'mul '(integer polynomial) (lambda (n p) (mul (make-const p n) (tag p)))) (put 'mul '(polynomial integer) (lambda (p n) (mul (make-integer n) (tag p)))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic with some coercion: (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (let ((result (apply (get op (map type-tag args)) (map contents args)))) (if (simplifiable? op) (simplify result) result)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/89.scm ================================================ ; SICP exercise 2.89 ; ; Define procedures that implement the term-list representation described ; above as appropriate for dense polynomials. ; First, we need to derefine map-coeffs in terms of adjoin-term so it can be ; independent of the representation. It is substantially slower, but at least ; it works with both representations. Second, we shall define first-term to ; return a list (order coeff) and we shall calculate the order with length. ; This is an O(n) operation, so it makes everything slower. In the next ; exercise, we shall look into a better representation abstraction and clearer ; bounaries. ; The type functions, table and coercion infrastructure. (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; The type tower, supetype, supertype?, raise and project: (put 'supertype 'integer 'rational) (put 'supertype 'rational 'scheme-number) (put 'supertype 'scheme-number 'real) (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now a simplification procedure. It will be called simplify instead of drop, ; because drop is already reserved: (define (simplify x) (cond ((not (projectable? x)) x) ((equ? (raise (project x)) x) (simplify (project x))) (else x))) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (arctangent x y) (apply-generic 'arctangent x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; The simplification table: (define (simplifiable? op) (get 'simplifiable op)) (put 'simplifiable 'add #t) (put 'simplifiable 'sub #t) (put 'simplifiable 'mul #t) (put 'simplifiable 'div #t) (put 'simplifiable 'neg #t) (put 'simplifiable 'square-root #t) (put 'simplifiable 'sine #t) (put 'simplifiable 'cosine #t) (put 'simplifiable 'arctangent #t) (put 'simplifiable 'real-part #t) (put 'simplifiable 'imag-part #t) (put 'simplifiable 'magnitude #t) (put 'simplifiable 'angle #t) ; Integers: (let () (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'neg '(integer) (lambda (x) (tag (- x)))) (put 'equ? '(integer integer) =) (put '=zero? '(integer) zero?) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'make 'integer (lambda (n) (if (exact-integer? n) (tag n) (error "Attempted to make an integer with a non-integer" n))))) (define (make-integer n) ((get 'make 'integer) n)) ; Rational numbers: (let () (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (exact-integer? n) (exact-integer? d)) (let ((g (gcd n d))) (cons (/ n g) (/ d g))) (error "Cannot construct a rational with non-exact numbers" n d))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (neg-rat x) (make-rat (- (numer x)) (denom x))) (define (=zero?-rat x) (zero? (numer x))) (define (raise-rat r) (make-real (exact->inexact (/ (numer r) (denom r))))) (define (project-rat r) (make-integer (truncate (/ (numer r) (denom r))))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put 'raise '(rational) raise-rat) (put 'project '(rational) project-rat) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'neg '(rational) (lambda (x) (tag (neg-rat x)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; Real numbers: (let () (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'neg '(real) (lambda (x) (tag (- x)))) (put 'sine '(real) (lambda (x) (tag (sin x)))) (put 'cosine '(real) (lambda (x) (tag (cos x)))) (put 'square-root '(real) (lambda (x) (tag (sqrt x)))) (put 'arctangent '(real real) (lambda (x y) (tag (atan x y)))) (put 'project '(real) (lambda (x) (make-rational (inexact->exact (truncate x)) 1))) (put 'equ? '(real real) =) (put '=zero? '(real) zero?) (put 'make 'real (lambda (x) (tag x)))) (define (make-real n) ((get 'make 'real) n)) ; The polynomial package: (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (variable? x) (symbol? x)) (define (adjoin-term term term-list) (let ((term-list-order (- (length term-list) 1)) (term-order (order term))) (cond ((=zero? (coeff term)) term-list) ((= term-list-order term-order) (cons (add (coeff term) (car term-list)) (cdr term-list))) ((< term-order term-list-order) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((> term-order term-list-order) (adjoin-term term (cons (make-integer 0) term-list)))))) (define (the-empty-termlist) '()) (define (first-term term-list) (make-term (- (length term-list) 1) (car term-list))) (define (rest-terms term-list) (cdr term-list)) (define (empty-termlist? term-list) (null? term-list)) (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (map-coeffs proc p) (define (map-terms term-list result) (if (empty-termlist? term-list) result (let ((first (first-term term-list)) (rest (rest-terms term-list))) (map-terms rest (adjoin-term (make-term (order first) (proc (coeff first))) result))))) (make-poly (variable p) (map-terms (term-list p) (the-empty-termlist)))) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - MUL-POLY" (list p1 p2)))) (define (neg-poly p) (map-coeffs neg p)) (define (sub-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (add-poly p1 (neg-poly p2)) (error "Polynomials not in same var - SUB-POLY" (list p1 p2)))) (define (make-const p n) (tag (make-poly (variable p) (adjoin-term (make-term 0 (make-integer n)) (the-empty-termlist))))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(integer polynomial) (lambda (n p) (add (make-const p n) (tag p)))) (put 'mul '(integer polynomial) (lambda (n p) (mul (make-const p n) (tag p)))) (put 'add '(polynomial integer) (lambda (p n) (add (make-integer n) (tag p)))) (put 'mul '(polynomial integer) (lambda (p n) (mul (make-integer n) (tag p)))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic with some coercion: (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (let ((result (apply (get op (map type-tag args)) (map contents args)))) (if (simplifiable? op) (simplify result) result)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/90.scm ================================================ ; SICP exercise 2.90 ; ; Suppose we want to have a polynomial system that is efficient for both ; sparse and dense polynomials. One way to do this is to allow both kinds of ; term-list representations in our system. The situation is analogous to the ; complex-number example of section 2.4, where we allowed both rectangular and ; polar representations. To do this we must distinguish different types of ; term lists and make the operations on term lists generic. Redesign the ; polynomial system to implement this generalization. This is a major effort, ; not a local change. ; Come now, it is not a major effort. It is not uber simple either, but hey, ; it is not supposed to be either. We base this on the prevoius exercise: (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; The type tower, supetype, supertype?, raise and project: (put 'supertype 'integer 'rational) (put 'supertype 'rational 'scheme-number) (put 'supertype 'scheme-number 'real) (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now a simplification procedure. It will be called simplify instead of drop, ; because drop is already reserved: (define (simplify x) (cond ((not (projectable? x)) x) ((equ? (raise (project x)) x) (simplify (project x))) (else x))) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (arctangent x y) (apply-generic 'arctangent x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; The simplification table: (define (simplifiable? op) (get 'simplifiable op)) (put 'simplifiable 'add #t) (put 'simplifiable 'sub #t) (put 'simplifiable 'mul #t) (put 'simplifiable 'div #t) (put 'simplifiable 'neg #t) (put 'simplifiable 'square-root #t) (put 'simplifiable 'sine #t) (put 'simplifiable 'cosine #t) (put 'simplifiable 'arctangent #t) (put 'simplifiable 'real-part #t) (put 'simplifiable 'imag-part #t) (put 'simplifiable 'magnitude #t) (put 'simplifiable 'angle #t) ; Integers: (let () (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'neg '(integer) (lambda (x) (tag (- x)))) (put 'equ? '(integer integer) =) (put '=zero? '(integer) zero?) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'make 'integer (lambda (n) (if (exact-integer? n) (tag n) (error "Attempted to make an integer with a non-integer" n))))) (define (make-integer n) ((get 'make 'integer) n)) ; Rational numbers: (let () (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (exact-integer? n) (exact-integer? d)) (let ((g (gcd n d))) (cons (/ n g) (/ d g))) (error "Cannot construct a rational with non-exact numbers" n d))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (neg-rat x) (make-rat (- (numer x)) (denom x))) (define (=zero?-rat x) (zero? (numer x))) (define (raise-rat r) (make-real (exact->inexact (/ (numer r) (denom r))))) (define (project-rat r) (make-integer (truncate (/ (numer r) (denom r))))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put 'raise '(rational) raise-rat) (put 'project '(rational) project-rat) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'neg '(rational) (lambda (x) (tag (neg-rat x)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; Real numbers: (let () (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'neg '(real) (lambda (x) (tag (- x)))) (put 'sine '(real) (lambda (x) (tag (sin x)))) (put 'cosine '(real) (lambda (x) (tag (cos x)))) (put 'square-root '(real) (lambda (x) (tag (sqrt x)))) (put 'arctangent '(real real) (lambda (x y) (tag (atan x y)))) (put 'project '(real) (lambda (x) (make-rational (inexact->exact (truncate x)) 1))) (put 'equ? '(real real) =) (put '=zero? '(real) zero?) (put 'make 'real (lambda (x) (tag x)))) (define (make-real n) ((get 'make 'real) n)) ; And now, the polynomial package. First, the generic term-list operations. ; Note that adjoin-term uses the table, but not apply-generic. (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (define (empty-termlist? term-list) (apply-generic 'empty-termlist? term-list)) (define (first-term term-list) (apply-generic 'first-term term-list)) (define (rest-terms term-list) (apply-generic 'rest-terms term-list)) (define (adjoin-term term term-list) (let ((proc (get 'adjoin-term (type-tag term-list)))) (if proc (proc term (contents term-list)) (error "No method for these types - ADJOIN-TERM" term-list)))) ; Sparse representation: (let () (define (the-empty-termlist) '()) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (cond ((=zero? (coeff term)) term-list) ((null? term-list) (list term)) ((> (order (car term-list)) (order term)) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((= (order (car term-list)) (order term)) (adjoin-term (make-term (order term) (add (coeff term) (coeff (car term-list)))) (cdr term-list))) (else (cons term term-list)))) (define (tag x) (attach-tag 'sparse x)) (put 'empty-termlist? '(sparse) empty-termlist?) (put 'first-term '(sparse) first-term) (put 'rest-terms '(sparse) (lambda (l) (tag (rest-terms l)))) (put 'adjoin-term 'sparse (lambda (term term-list) (tag (adjoin-term term term-list)))) (put 'make 'sparse (lambda () (tag (the-empty-termlist))))) (define (the-empty-sparse-termlist) ((get 'make 'sparse))) ; Dense representation: (let () (define (the-empty-termlist) '()) (define (term-list-order term-list) (- (length term-list) 1)) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (make-term (term-list-order term-list) (car term-list))) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (let ((term-list-order (term-list-order term-list)) (term-order (order term))) (cond ((=zero? (coeff term)) term-list) ((= term-list-order term-order) (cons (add (coeff term) (car term-list)) (cdr term-list))) ((< term-order term-list-order) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((> term-order term-list-order) (adjoin-term term (cons (make-integer 0) term-list)))))) (define (tag x) (attach-tag 'dense x)) (put 'first-term '(dense) first-term) (put 'rest-terms '(dense) (lambda (l) (tag (rest-terms l)))) (put 'empty-termlist? '(dense) empty-termlist?) (put 'adjoin-term 'dense (lambda (term term-list) (tag (adjoin-term term term-list)))) (put 'make 'dense (lambda () (tag (the-empty-termlist))))) (define (the-empty-dense-termlist) ((get 'make 'dense))) ; The polynomial package. Operations between polynomials with the same ; representation will preserve the type of representation. Polynomials with ; operations of mixed representation will choose an arbitrary representation ; for the result. (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (variable? x) (symbol? x)) (define (empty-termlist-of-type term-list) ((get 'make (type-tag term-list)))) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (empty-termlist-of-type L1) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (empty-termlist-of-type L) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (map-terms proc L) (if (empty-termlist? L) (empty-termlist-of-type L) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (neg-terms L) (map-terms neg L)) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - MUL-POLY" (list p1 p2)))) (define (sub-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (add-poly p1 (neg-poly p2)) (error "Polynomials not in same var - SUB-POLY" (list p1 p2)))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (make-const p n) (tag (make-poly (variable p) (adjoin-term (make-term 0 (make-integer n)) (empty-termlist-of-type (term-list p)))))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(integer polynomial) (lambda (n p) (add (make-const p n) (tag p)))) (put 'mul '(integer polynomial) (lambda (n p) (mul (make-const p n) (tag p)))) (put 'add '(polynomial integer) (lambda (p n) (add (make-integer n) (tag p)))) (put 'mul '(polynomial integer) (lambda (p n) (mul (make-integer n) (tag p)))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic with some coercion: (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (let ((result (apply (get op (map type-tag args)) (map contents args)))) (if (simplifiable? op) (simplify result) result)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/91.scm ================================================ ; SICP exercise 2.91 ; ; A univariate polynomial can be divided by another one to produce a ; polynomial quotient and a polynomial remainder. For example: ; ; x⁵ - 1 ; ────── = x³ + x, remainder x - 1 ; x² - 1 ; ; Division can be performed via long division. That is, divide the ; highest-order term of the dividend by the highest-order term of the divisor. ; The result is the first term of the quotient. Next, multiply the result by ; the divisor, subtract that from the dividend, and produce the rest of the ; answer by recursively dividing the difference by the divisor. Stop when the ; order of the divisor exceeds the order of the dividend and declare the ; dividend to be the remainder. Also, if the dividend ever becomes zero, ; return zero as both quotient and remainder. ; ; We can design a div-poly procedure on the model of add-poly and mul-poly. ; The procedure checks to see if two polys have the same variable. If so, ; div-poly strips off the variable and passes the problem to div-terms, which ; performs the division operation on term lists. div-poly finally reattaches ; the variable to the result supplied by div-terms. It is convenient to design ; div-terms to compute both the quotient and the remainder of a division. ; div-terms can take two term lists as arguments and return a list of the ; quotient term list and the remainder term list. ; ; Complete the following definition of div-terms by filling in the missing ; expressions. Use this to implement div-poly, which takes two polys as ; arguments and returns a list of quotient and remainder polys. ; ; (define (div-terms L1 L2) ; (if (empty-termlist? L1) ; (list (the-empty-termlist) (the-empty-termlist)) ; (let ((t1 (first-term L1)) ; (t2 (first-term L2))) ; (if (> (order t2) (order t1)) ; (list (the-empty-termlist) L1) ; (let ((new-c (div (coeff t1) (coeff t2))) ; (new-o (- (order t1) (order t2)))) ; (let ((rest-of-result ; ; )) ;
    ; )))))) ; We base this on the dense representation in exercise 2.89. ; The type functions, table and coercion infrastructure. (define (attach-tag type-tag contents) (cons type-tag contents)) (define (type-tag datum) (if (pair? datum) (car datum) (error "Bad tagged datum - TYPE-TAG" datum))) (define (contents datum) (if (pair? datum) (cdr datum) (error "Bad tagged datum - CONTENTS" datum))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; The type tower, supetype, supertype?, raise and project: (put 'supertype 'integer 'rational) (put 'supertype 'rational 'scheme-number) (put 'supertype 'scheme-number 'real) (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now a simplification procedure. It will be called simplify instead of drop, ; because drop is already reserved: (define (simplify x) (cond ((not (projectable? x)) x) ((equ? (raise (project x)) x) (simplify (project x))) (else x))) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (square-root x) (apply-generic 'square-root x)) (define (sine x) (apply-generic 'sine x)) (define (cosine x) (apply-generic 'cosine x)) (define (arctangent x y) (apply-generic 'arctangent x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; The simplification table: (define (simplifiable? op) (get 'simplifiable op)) (put 'simplifiable 'add #t) (put 'simplifiable 'sub #t) (put 'simplifiable 'mul #t) (put 'simplifiable 'div #t) (put 'simplifiable 'neg #t) (put 'simplifiable 'square-root #t) (put 'simplifiable 'sine #t) (put 'simplifiable 'cosine #t) (put 'simplifiable 'arctangent #t) (put 'simplifiable 'real-part #t) (put 'simplifiable 'imag-part #t) (put 'simplifiable 'magnitude #t) (put 'simplifiable 'angle #t) ; Integers: (let () (define (tag x) (attach-tag 'integer x)) (put 'add '(integer integer) (lambda (x y) (tag (+ x y)))) (put 'sub '(integer integer) (lambda (x y) (tag (- x y)))) (put 'mul '(integer integer) (lambda (x y) (tag (* x y)))) (put 'neg '(integer) (lambda (x) (tag (- x)))) (put 'equ? '(integer integer) =) (put '=zero? '(integer) zero?) (put 'raise '(integer) (lambda (n) (make-rational n 1))) (put 'make 'integer (lambda (n) (if (exact-integer? n) (tag n) (error "Attempted to make an integer with a non-integer" n))))) (define (make-integer n) ((get 'make 'integer) n)) ; Rational numbers: (let () (define (numer x) (car x)) (define (denom x) (cdr x)) (define (make-rat n d) (if (and (exact-integer? n) (exact-integer? d)) (let ((g (gcd n d))) (cons (/ n g) (/ d g))) (error "Cannot construct a rational with non-exact numbers" n d))) (define (add-rat x y) (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (sub-rat x y) (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (define (mul-rat x y) (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (define (div-rat x y) (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (define (neg-rat x) (make-rat (- (numer x)) (denom x))) (define (=zero?-rat x) (zero? (numer x))) (define (raise-rat r) (make-real (exact->inexact (/ (numer r) (denom r))))) (define (project-rat r) (make-integer (truncate (/ (numer r) (denom r))))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put 'raise '(rational) raise-rat) (put 'project '(rational) project-rat) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'neg '(rational) (lambda (x) (tag (neg-rat x)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; Real numbers: (let () (define (tag x) (attach-tag 'real x)) (put 'add '(real real) (lambda (x y) (tag (+ x y)))) (put 'sub '(real real) (lambda (x y) (tag (- x y)))) (put 'mul '(real real) (lambda (x y) (tag (* x y)))) (put 'div '(real real) (lambda (x y) (tag (/ x y)))) (put 'neg '(real) (lambda (x) (tag (- x)))) (put 'sine '(real) (lambda (x) (tag (sin x)))) (put 'cosine '(real) (lambda (x) (tag (cos x)))) (put 'square-root '(real) (lambda (x) (tag (sqrt x)))) (put 'arctangent '(real real) (lambda (x y) (tag (atan x y)))) (put 'project '(real) (lambda (x) (make-rational (inexact->exact (truncate x)) 1))) (put 'equ? '(real real) =) (put '=zero? '(real) zero?) (put 'make 'real (lambda (x) (tag x)))) (define (make-real n) ((get 'make 'real) n)) ; The polynomial package: (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (variable? x) (symbol? x)) (define (adjoin-term term term-list) (let ((term-list-order (- (length term-list) 1)) (term-order (order term))) (cond ((=zero? (coeff term)) term-list) ((= term-list-order term-order) (cons (add (coeff term) (car term-list)) (cdr term-list))) ((< term-order term-list-order) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((> term-order term-list-order) (adjoin-term term (cons (make-integer 0) term-list)))))) (define (the-empty-termlist) '()) (define (first-term term-list) (make-term (- (length term-list) 1) (car term-list))) (define (rest-terms term-list) (cdr term-list)) (define (empty-termlist? term-list) (null? term-list)) (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (sub-terms L1 L2) (add-terms L1 (neg-terms L2))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let* ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2))) (term (make-term new-o new-c)) (multiplier (adjoin-term term (the-empty-termlist))) (rest-of-result (div-terms (sub-terms L1 (mul-terms multiplier L2)) L2)) (result-quotient (car rest-of-result)) (result-remainder (cadr rest-of-result))) (list (adjoin-term term result-quotient) result-remainder)))))) (define (neg-terms L) (map-terms neg L)) (define (map-terms proc L) (if (empty-termlist? L) (the-empty-termlist) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - MUL-POLY" (list p1 p2)))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (term-list) (make-poly (variable p1) term-list)) (div-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - DIV-POLY" (list p1 p2)))) (define (sub-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (sub-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - SUB-POLY" (list p1 p2)))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (make-const p n) (tag (make-poly (variable p) (adjoin-term (make-term 0 (make-integer n)) (the-empty-termlist))))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (map tag (div-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(integer polynomial) (lambda (n p) (add (make-const p n) (tag p)))) (put 'mul '(integer polynomial) (lambda (n p) (mul (make-const p n) (tag p)))) (put 'add '(polynomial integer) (lambda (p n) (add (make-integer n) (tag p)))) (put 'mul '(polynomial integer) (lambda (p n) (mul (make-integer n) (tag p)))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic with some coercion: (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (let ((result (apply (get op (map type-tag args)) (map contents args)))) (if (simplifiable? op) (simplify result) result)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/92.scm ================================================ ; SICP exercise 2.92 ; ; By imposing an ordering on variables, extend the polynomial package so that ; addition and multiplication of polynomials works for polynomials in ; different variables. (This is not easy!) ; That's gonna be fun! ; ; Let's use the code from the previous examples. We will choose sparse ; representation of polynomials. Furthermore, we shall only have one numerical ; type - scheme-number that we will dub number in order to simplify things. (define (attach-tag type-tag contents) (if (eq? type-tag 'number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) 'number) ((pair? datum) (car datum)) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum - CONTENTS" datum)))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) (define (put-coercion from to op) (put 'coerce (list from to) op)) (define (get-coercion from to) (get 'coerce (list from to))) ; The type tower, supetype, supertype?, raise and project: (define (supertype type) (get 'supertype type)) (define (supertype? a b) (let ((super (supertype a))) (cond ((equal? super b) #t) ((not super) #f) (else (supertype? super b))))) (define (same-type? a b) (equal? (type-tag a) (type-tag b))) (define (raise a) (apply-generic 'raise a)) (define (project a) (apply-generic 'project a)) (define (projectable? a) (get 'project (list (type-tag a)))) (define (raisable? a) (get 'raise (list (type-tag a)))) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; Numbers (let () (put 'add '(number number) +) (put 'sub '(number number) -) (put 'mul '(number number) *) (put 'div '(number number) /) (put 'neg '(number) -) (put 'equ? '(number number) =) (put '=zero? '(number) zero?)) ; A very clever procedure for normalizing terms. It is not nested under ; polynomials so it can be tested separately. ; The polynomial package: (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (before? v1 v2) (stringstring v1) (symbol->string v2))) (define (variable? x) (symbol? x)) (define (the-empty-termlist) '()) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (cond ((=zero? (coeff term)) term-list) ((null? term-list) (list term)) ((> (order (car term-list)) (order term)) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((= (order (car term-list)) (order term)) (adjoin-term (make-term (order term) (add (coeff term) (coeff (car term-list)))) (cdr term-list))) (else (cons term term-list)))) (define (const var number) (make-poly var (adjoin-term (make-term 0 number) (the-empty-termlist)))) (define (poly-const var polynomial) (make-term var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (define (map-terms proc L) (if (empty-termlist? L) (the-empty-termlist) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (neg-terms L) (map-terms neg L)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (sub-terms L1 L2) (add-terms L1 (neg-terms L2))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let* ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2))) (term (make-term new-o new-c)) (multiplier (adjoin-term term (the-empty-termlist))) (rest-of-result (div-terms (sub-terms L1 (mul-terms multiplier L2)) L2)) (result-quotient (car rest-of-result)) (result-remainder (cadr rest-of-result))) (list (adjoin-term term result-quotient) result-remainder)))))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (add-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (add-terms t1 t2))) ((before? v1 v2) (add-poly p1 (const v1 p2))) (else (add-poly (const v2 p1) p2))))) (define (mul-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (mul-terms t1 t2))) ((before? v1 v2) (mul-poly p1 (const v1 p2))) (else (mul-poly (const v2 p1) p2))))) (define (sub-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (sub-terms t1 t2))) ((before? v1 v2) (sub-poly p1 (const v1 p2))) (else (sub-poly (const v2 p1) p2))))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (term-list) (make-poly (variable p1) term-list)) (div-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - DIV-POLY" (list p1 p2)))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (map tag (div-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(number polynomial) (lambda (n p) (tag (add-poly (const (variable p) n) p)))) (put 'mul '(number polynomial) (lambda (n p) (tag (mul-poly (const (variable p) n) p)))) (put 'add '(polynomial number) (lambda (p n) (tag (add-poly p (const (variable p) n))))) (put 'mul '(polynomial number) (lambda (p n) (tag (mul-poly p (const (variable p) n))))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic with some coercion: (define (apply-generic op . args) (define (applicable? args) (get op (map type-tag args))) (define (apply-generic-failed) (error "No method for these types - APPLY-GENERIC" (list op (map type-tag args)))) (define (all-of-same-type? args) (define (check rest) (cond ((null? rest) #t) ((same-type? (car args) (car rest)) (check (cdr rest))) (else #f))) (check args)) (define (of-same-type-and-raisable? args) (and (all-of-same-type? args) (raisable? (car args)))) (define (coercable-to-same-type? args) (and (= (length args) 2) (let ((type-a (type-tag (car args))) (type-b (type-tag (cadr args)))) (or (supertype? type-a type-b) (supertype? type-b type-a))))) (define (coerce-to-same-type args) (and (= (length args) 2) (let* ((a (car args)) (b (cadr args)) (type-a (type-tag a)) (type-b (type-tag b))) (cond ((same-type? a b) (list a b)) ((supertype? type-a type-b) (coerce-to-same-type (list (raise a) b))) ((supertype? type-b type-a) (coerce-to-same-type (list a (raise b)))) (else #f))))) (define (attempt-coercion args) (let ((number-of-arguments (length args))) (cond ((of-same-type-and-raisable? args) (try (map raise args))) ((coercable-to-same-type? args) (try (coerce-to-same-type args))) (else (apply-generic-failed))))) (define (try args) (if (applicable? args) (apply (get op (map type-tag args)) (map contents args)) (attempt-coercion args))) (try args)) ================================================ FILE: scheme/sicp/02/93.scm ================================================ ; SICP exercise 2.93 ; ; Modify the rational-artihmetic package to use generic operations, but change ; make-rat so that it does not attempt to reduce fractions to lowest terms. ; Test your system by calling make-rational on two polynomials to produce a ; rational function ; ; (define p1 (make-polynomial 'x '((2 1) (0 1)))) ; (define p2 (make-polynomial 'x '((3 1) (0 1)))) ; (define rf (make-rational p2 p1)) ; ; Now add rf to itself, using add. You will observe that this addition ; procedure does not reduce fractions to lowest terms. (define (attach-tag type-tag contents) (if (eq? type-tag 'number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) 'number) ((pair? datum) (car datum)) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum - CONTENTS" datum)))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (square x) (mul x x)) ; Numbers (let () (put 'add '(number number) +) (put 'sub '(number number) -) (put 'mul '(number number) *) (put 'div '(number number) /) (put 'neg '(number) -) (put 'equ? '(number number) =) (put '=zero? '(number) zero?)) ; Rationals: (let () (define (make-rat n d) (cons n d)) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (add-rat x y) (make-rat (add (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (sub-rat x y) (make-rat (sub (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (mul-rat x y) (make-rat (mul (numer x) (numer y)) (mul (denom x) (denom y)))) (define (div-rat x y) (make-rat (mul (numer x) (denom y)) (mul (denom x) (numer y)))) (define (=zero?-rat x) (zero? (numer x))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; A very clever procedure for normalizing terms. It is not nested under ; polynomials so it can be tested separately. ; The polynomial package: (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (before? v1 v2) (stringstring v1) (symbol->string v2))) (define (variable? x) (symbol? x)) (define (the-empty-termlist) '()) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (cond ((=zero? (coeff term)) term-list) ((null? term-list) (list term)) ((> (order (car term-list)) (order term)) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((= (order (car term-list)) (order term)) (adjoin-term (make-term (order term) (add (coeff term) (coeff (car term-list)))) (cdr term-list))) (else (cons term term-list)))) (define (const var number) (make-poly var (adjoin-term (make-term 0 number) (the-empty-termlist)))) (define (poly-const var polynomial) (make-term var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (define (map-terms proc L) (if (empty-termlist? L) (the-empty-termlist) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (neg-terms L) (map-terms neg L)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (sub-terms L1 L2) (add-terms L1 (neg-terms L2))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let* ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2))) (term (make-term new-o new-c)) (multiplier (adjoin-term term (the-empty-termlist))) (rest-of-result (div-terms (sub-terms L1 (mul-terms multiplier L2)) L2)) (result-quotient (car rest-of-result)) (result-remainder (cadr rest-of-result))) (list (adjoin-term term result-quotient) result-remainder)))))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (add-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (add-terms t1 t2))) ((before? v1 v2) (add-poly p1 (const v1 p2))) (else (add-poly (const v2 p1) p2))))) (define (mul-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (mul-terms t1 t2))) ((before? v1 v2) (mul-poly p1 (const v1 p2))) (else (mul-poly (const v2 p1) p2))))) (define (sub-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (sub-terms t1 t2))) ((before? v1 v2) (sub-poly p1 (const v1 p2))) (else (sub-poly (const v2 p1) p2))))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (term-list) (make-poly (variable p1) term-list)) (div-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - DIV-POLY" (list p1 p2)))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (map tag (div-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(number polynomial) (lambda (n p) (tag (add-poly (const (variable p) n) p)))) (put 'mul '(number polynomial) (lambda (n p) (tag (mul-poly (const (variable p) n) p)))) (put 'add '(polynomial number) (lambda (p n) (tag (add-poly p (const (variable p) n))))) (put 'mul '(polynomial number) (lambda (p n) (tag (mul-poly p (const (variable p) n))))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic without any coercion: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ================================================ FILE: scheme/sicp/02/94.scm ================================================ ; SICP exercise 2.94 ; ; Using div-terms, implement the procedure remainder-terms and use this to ; define gcd-terms as above. Now write a procedure gcd-poly that computes the ; polynomial GCD of two polys. (The procedure should signal an error if the ; two polys are not in the same variable.) Install in the system a generic ; operation greated-common-divisor that reduces to gcd-poly for polynomials ; and to ordinary gcd for ordinary numbers. As a test, try: ; ; (define (p1 (make-polynomial 'x '((4 1) (3 -1) (2 -2) (1 2))))) ; (define (p2 (make-polynomial 'x '((3 1) (1 -1))))) ; (greated-common-divisor p1 p2) ; ; and check your result by hand. (define (attach-tag type-tag contents) (if (eq? type-tag 'number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) 'number) ((pair? datum) (car datum)) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum - CONTENTS" datum)))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (greatest-common-divisor x y) (apply-generic 'greatest-common-divisor x y)) (define (square x) (mul x x)) ; Numbers (let () (put 'add '(number number) +) (put 'sub '(number number) -) (put 'mul '(number number) *) (put 'div '(number number) /) (put 'neg '(number) -) (put 'greatest-common-divisor '(number number) gcd) (put 'equ? '(number number) =) (put '=zero? '(number) zero?)) ; Rationals: (let () (define (make-rat n d) (cons n d)) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (add-rat x y) (make-rat (add (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (sub-rat x y) (make-rat (sub (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (mul-rat x y) (make-rat (mul (numer x) (numer y)) (mul (denom x) (denom y)))) (define (div-rat x y) (make-rat (mul (numer x) (denom y)) (mul (denom x) (numer y)))) (define (=zero?-rat x) (zero? (numer x))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; A very clever procedure for normalizing terms. It is not nested under ; polynomials so it can be tested separately. ; The polynomial package: (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (before? v1 v2) (stringstring v1) (symbol->string v2))) (define (variable? x) (symbol? x)) (define (the-empty-termlist) '()) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (cond ((=zero? (coeff term)) term-list) ((null? term-list) (list term)) ((> (order (car term-list)) (order term)) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((= (order (car term-list)) (order term)) (adjoin-term (make-term (order term) (add (coeff term) (coeff (car term-list)))) (cdr term-list))) (else (cons term term-list)))) (define (const var number) (make-poly var (adjoin-term (make-term 0 number) (the-empty-termlist)))) (define (poly-const var polynomial) (make-term var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (define (map-terms proc L) (if (empty-termlist? L) (the-empty-termlist) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (neg-terms L) (map-terms neg L)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (sub-terms L1 L2) (add-terms L1 (neg-terms L2))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2)))) (let ((rest-of-result (div-terms (add-terms L1 (neg-terms (mul-term-by-all-terms (make-term new-o new-c) L2))) L2))) (cons (adjoin-term (make-term new-o new-c) (car rest-of-result)) (cdr rest-of-result)))))))) (define (remainder-terms a b) (cadr (div-terms a b))) (define (gcd-terms a b) (if (empty-termlist? b) a (gcd-terms b (remainder-terms a b)))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (add-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (add-terms t1 t2))) ((before? v1 v2) (add-poly p1 (const v1 p2))) (else (add-poly (const v2 p1) p2))))) (define (mul-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (mul-terms t1 t2))) ((before? v1 v2) (mul-poly p1 (const v1 p2))) (else (mul-poly (const v2 p1) p2))))) (define (sub-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (sub-terms t1 t2))) ((before? v1 v2) (sub-poly p1 (const v1 p2))) (else (sub-poly (const v2 p1) p2))))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (term-list) (make-poly (variable p1) term-list)) (div-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - DIV-POLY" (list p1 p2)))) (define (gcd-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (gcd-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - GCD-POLY" (list p1 p2)))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (map tag (div-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'greatest-common-divisor '(polynomial polynomial) (lambda (p1 p2) (tag (gcd-poly p1 p2)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(number polynomial) (lambda (n p) (tag (add-poly (const (variable p) n) p)))) (put 'mul '(number polynomial) (lambda (n p) (tag (mul-poly (const (variable p) n) p)))) (put 'add '(polynomial number) (lambda (p n) (tag (add-poly p (const (variable p) n))))) (put 'mul '(polynomial number) (lambda (p n) (tag (mul-poly p (const (variable p) n))))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic without any coercion: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ================================================ FILE: scheme/sicp/02/95.scm ================================================ ; SICP exercise 2.95 ; ; ₁₂₃ ; Define P₁, P₂, and P₃ to be the polynomials: ; ; P₁: x² - 2x + 1 ; P₂: 11x² + 7 ; P₃: 13x + 5 ; ; Now define Q₁ to be the product of P₁ and P₂ and Q₂ to be the product of P₁ ; and P₃, and use greated-common-divisor (exercise 2.94) to compute the GCD of ; Q₁ and Q₂. Note that the answer is not the same as P₁. This example ; introduces noninteger operations into the computation, causing difficulties ; with the GCD algorithms. To understand what is happening, try tracing ; gcd-terms while computing the GCD or try performing the division by hand. ; I'll avoid doing it by hand, since the numbers are not too nice. Here is ; each step from gcd-terms: ; ; +------------------------------------+------------------------------------+ ; | quotient | remainder | ; +------------------------------------+------------------------------------+ ; | 11x⁴ + -22x³ + 18x² + -14x + 7 | 13x³ + -21x² + 3x + 5 | ; | 13x³ + -21x² + 3x + 5 | 1458/169x² + -2916/169x + 1458/169 | ; | 1458/169x² + -2916/169x + 1458/169 | 0 | ; +------------------------------------+------------------------------------+ ; ; As you can see, it goes into divison of non-integers. Since Racket supports ; rational numbers, this is actually a GCD of Q₁ and Q₂, although with ; rational coefficients (as the footnote indicates). It can easily produce ; rounding errors in case of floating-point precision. ================================================ FILE: scheme/sicp/02/96.scm ================================================ ; SICP exercise 2.96 ; ; a. Implement the procedure pseudoremainder-terms, which is just like ; remainder-terms except that it multiplies the dividend by the integerizing ; factor described above before calling div-terms. Modify gcd-terms to use ; pseudoremainder-terms and verify that greatest-common-divisor now produces ; an answer with integer coefficients on the example in exercise 2.95. ; ; b. The GCD now has integer coefficients, but they are larger than those of ; P₁. Modify gcd-terms so that it removes common factors from the coefficients ; of the answer by dividing all the coefficients by their (integer) greated ; common divisor. ; Here it goes: ; The type system: (define (attach-tag type-tag contents) (if (eq? type-tag 'number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) 'number) ((pair? datum) (car datum)) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum - CONTENTS" datum)))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (greatest-common-divisor x y) (apply-generic 'greatest-common-divisor x y)) (define (square x) (mul x x)) ; Numbers (let () (put 'add '(number number) +) (put 'sub '(number number) -) (put 'mul '(number number) *) (put 'div '(number number) /) (put 'neg '(number) -) (put 'greatest-common-divisor '(number number) gcd) (put 'equ? '(number number) =) (put '=zero? '(number) zero?)) ; Rationals: (let () (define (make-rat n d) (cons n d)) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (add-rat x y) (make-rat (add (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (sub-rat x y) (make-rat (sub (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (mul-rat x y) (make-rat (mul (numer x) (numer y)) (mul (denom x) (denom y)))) (define (div-rat x y) (make-rat (mul (numer x) (denom y)) (mul (denom x) (numer y)))) (define (=zero?-rat x) (zero? (numer x))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; A very clever procedure for normalizing terms. It is not nested under ; polynomials so it can be tested separately. ; The polynomial package: (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (before? v1 v2) (stringstring v1) (symbol->string v2))) (define (variable? x) (symbol? x)) (define (the-empty-termlist) '()) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (cond ((=zero? (coeff term)) term-list) ((null? term-list) (list term)) ((> (order (car term-list)) (order term)) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((= (order (car term-list)) (order term)) (adjoin-term (make-term (order term) (add (coeff term) (coeff (car term-list)))) (cdr term-list))) (else (cons term term-list)))) (define (const var number) (make-poly var (adjoin-term (make-term 0 number) (the-empty-termlist)))) (define (poly-const var polynomial) (make-term var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (define (map-terms proc L) (if (empty-termlist? L) (the-empty-termlist) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (neg-terms L) (map-terms neg L)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (sub-terms L1 L2) (add-terms L1 (neg-terms L2))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2)))) (let ((rest-of-result (div-terms (add-terms L1 (neg-terms (mul-term-by-all-terms (make-term new-o new-c) L2))) L2))) (cons (adjoin-term (make-term new-o new-c) (car rest-of-result)) (cdr rest-of-result)))))))) (define (pseudoremainder-terms a b) (let ((factor (expt (coeff (car b)) (+ 1 (order (car a)) (- (order (car b))))))) (cadr (div-terms (mul-term-by-all-terms (make-term 0 factor) a) b)))) (define (gcd-terms a b) (if (empty-termlist? b) (let ((divisor (apply gcd (map coeff a)))) (map-terms (lambda (c) (/ c divisor)) a)) (gcd-terms b (pseudoremainder-terms a b)))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (add-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (add-terms t1 t2))) ((before? v1 v2) (add-poly p1 (const v1 p2))) (else (add-poly (const v2 p1) p2))))) (define (mul-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (mul-terms t1 t2))) ((before? v1 v2) (mul-poly p1 (const v1 p2))) (else (mul-poly (const v2 p1) p2))))) (define (sub-poly p1 p2) (define (const var polynomial) (make-poly var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (let ((v1 (variable p1)) (v2 (variable p2)) (t1 (term-list p1)) (t2 (term-list p2))) (cond ((same-variable? v1 v2) (make-poly v1 (sub-terms t1 t2))) ((before? v1 v2) (sub-poly p1 (const v1 p2))) (else (sub-poly (const v2 p1) p2))))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (term-list) (make-poly (variable p1) term-list)) (div-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - DIV-POLY" (list p1 p2)))) (define (gcd-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (gcd-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - GCD-POLY" (list p1 p2)))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (map tag (div-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'greatest-common-divisor '(polynomial polynomial) (lambda (p1 p2) (tag (gcd-poly p1 p2)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(number polynomial) (lambda (n p) (tag (add-poly (const (variable p) n) p)))) (put 'mul '(number polynomial) (lambda (n p) (tag (mul-poly (const (variable p) n) p)))) (put 'add '(polynomial number) (lambda (p n) (tag (add-poly p (const (variable p) n))))) (put 'mul '(polynomial number) (lambda (p n) (tag (mul-poly p (const (variable p) n))))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic without any coercion: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ================================================ FILE: scheme/sicp/02/97.scm ================================================ ; SICP exercise 2.97 ; ; a. Implement this algorithm as a procedure reduce-terms that takes two term ; lists n and d as arguments and returns a list nn, dd, which are n and d ; reduced to lowest terms via the algorithm given above. Also write a ; procedure reduce-poly, analogous to add-poly, that checks to see if the two ; polys have the same variable. If so, reduce-poly strips off the variable and ; passes the problem to reduce-terms, then reattaches the variable to the two ; term lists supplied by reduce-terms. ; ; b. Define a procedure analogous to reduce-terms that does what the original ; make-rat did for integers: ; ; (define (reduce-integers n d) ; (let ((g (gcd n d))) ; (list (/ n g) (/ d g)))) ; ; and define reduce as a generic operation that calls apply-generic to ; dispatch either reduce-poly (for polynomial arguments) or reduce-integers ; (for scheme-number arguments). You can now easily make the ; rational-arithmetic package reduce fractions to lowest terms by having ; make-rat call reduce before combining the given numberator and denominator ; to form a rational number. The system now handles rational expressions in ; either integers or polynomials. ; ; To test your program, try the example at the beginning of this extended ; exercise: ; ; (define p1 (make-polynomial 'x '((1 1) (0 1)))) ; (define p2 (make-polynomial 'x '((3 1) (0 -1))) ; (define p3 (make-polynomial 'x '((1 1)))) ; (define p4 (make-polynomial 'x '((2 1) (0 -1)))) ; ; (define rf1 (make-rational p1 p2)) ; (define rf2 (make-rational p3 p4)) ; ; (add rf1 rf2) ; ; See if you get the correct answer, correctly reduced to lowest terms. ; Our type system: (define (attach-tag type-tag contents) (if (eq? type-tag 'number) contents (cons type-tag contents))) (define (type-tag datum) (cond ((number? datum) 'number) ((pair? datum) (car datum)) (else (error "Bad tagged datum - TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum - CONTENTS" datum)))) (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Now the generic arithmemtic procedures. (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (reduce x y) (apply-generic 'reduce x y)) (define (neg x) (apply-generic 'neg x)) (define (equ? x y) (apply-generic 'equ? x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (greatest-common-divisor x y) (apply-generic 'greatest-common-divisor x y)) (define (square x) (mul x x)) ; Numbers (let () (define (reduce-integers n d) (let ((g (gcd n d))) (list (/ n g) (/ d g)))) (put 'add '(number number) +) (put 'sub '(number number) -) (put 'reduce '(number number) reduce-integers) (put 'mul '(number number) *) (put 'div '(number number) /) (put 'neg '(number) -) (put 'greatest-common-divisor '(number number) gcd) (put 'equ? '(number number) =) (put '=zero? '(number) zero?)) ; Rationals: (let () (define (make-rat n d) (let ((terms (reduce n d))) (cons (car terms) (cadr terms)))) (define (numer x) (car x)) (define (denom x) (cdr x)) (define (add-rat x y) (make-rat (add (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (sub-rat x y) (make-rat (sub (mul (numer x) (denom y)) (mul (numer y) (denom x))) (mul (denom x) (denom y)))) (define (mul-rat x y) (make-rat (mul (numer x) (numer y)) (mul (denom x) (denom y)))) (define (div-rat x y) (make-rat (mul (numer x) (denom y)) (mul (denom x) (numer y)))) (define (=zero?-rat x) (zero? (numer x))) (define (tag x) (attach-tag 'rational x)) (put 'numer '(rational) numer) (put 'denom '(rational) denom) (put '=zero? '(rational) =zero?-rat) (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y)))) (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y)))) (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y)))) (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y)))) (put 'equ? '(rational rational) equal?) (put 'make 'rational (lambda (n d) (tag (make-rat n d))))) (define (make-rational n d) ((get 'make 'rational) n d)) (define (numer r) (apply-generic 'numer r)) (define (denom r) (apply-generic 'denom r)) ; A very clever procedure for normalizing terms. It is not nested under ; polynomials so it can be tested separately. ; The polynomial package: (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (let () (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (before? v1 v2) (stringstring v1) (symbol->string v2))) (define (variable? x) (symbol? x)) (define (the-empty-termlist) '()) (define (empty-termlist? term-list) (null? term-list)) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (adjoin-term term term-list) (cond ((=zero? (coeff term)) term-list) ((null? term-list) (list term)) ((> (order (car term-list)) (order term)) (cons (car term-list) (adjoin-term term (cdr term-list)))) ((= (order (car term-list)) (order term)) (adjoin-term (make-term (order term) (add (coeff term) (coeff (car term-list)))) (cdr term-list))) (else (cons term term-list)))) (define (const var number) (make-poly var (adjoin-term (make-term 0 number) (the-empty-termlist)))) (define (poly-const var polynomial) (make-term var (adjoin-term (make-term 0 (tag polynomial)) (the-empty-termlist)))) (define (map-terms proc L) (if (empty-termlist? L) (the-empty-termlist) (let ((first (first-term L)) (rest (rest-terms L))) (adjoin-term (make-term (order first) (proc (coeff first))) (map-terms proc rest))))) (define (neg-terms L) (map-terms neg L)) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (sub-terms L1 L2) (add-terms L1 (neg-terms L2))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-term L2))) (if (> (order t2) (order t1)) (list (the-empty-termlist) L1) (let ((new-c (div (coeff t1) (coeff t2))) (new-o (- (order t1) (order t2)))) (let ((rest-of-result (div-terms (add-terms L1 (neg-terms (mul-term-by-all-terms (make-term new-o new-c) L2))) L2))) (cons (adjoin-term (make-term new-o new-c) (car rest-of-result)) (cdr rest-of-result)))))))) (define (pseudoremainder-terms a b) (let ((factor (expt (coeff (car b)) (+ 1 (order (car a)) (- (order (car b))))))) (cadr (div-terms (mul-term-by-all-terms (make-term 0 factor) a) b)))) (define (gcd-terms a b) (if (empty-termlist? b) (let ((divisor (apply gcd (map coeff a)))) (map-terms (lambda (c) (/ c divisor)) a)) (gcd-terms b (pseudoremainder-terms a b)))) (define (reduce-terms n d) (let ((g (gcd-terms n d))) (list (car (div-terms n g)) (car (div-terms d g))))) (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p)))) (define (reduce-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (terms) (make-poly (variable p1) terms)) (reduce-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - REDUCE-POLY" (list p1 p2)))) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - MUL-POLY" (list p1 p2)))) (define (sub-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (sub-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - SUB-POLY" (list p1 p2)))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (map (lambda (term-list) (make-poly (variable p1) term-list)) (div-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - DIV-POLY" (list p1 p2)))) (define (gcd-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (gcd-terms (term-list p1) (term-list p2))) (error "Polynomials not in same var - GCD-POLY" (list p1 p2)))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (map tag (div-poly p1 p2)))) (put 'reduce '(polynomial polynomial) (lambda (p1 p2) (map tag (reduce-poly p1 p2)))) (put '=zero? '(polynomial) (lambda (p) (empty-termlist? (term-list p)))) (put 'greatest-common-divisor '(polynomial polynomial) (lambda (p1 p2) (tag (gcd-poly p1 p2)))) (put 'neg '(polynomial) (lambda (p) (tag (neg-poly p)))) (put 'add '(number polynomial) (lambda (n p) (tag (add-poly (const (variable p) n) p)))) (put 'mul '(number polynomial) (lambda (n p) (tag (mul-poly (const (variable p) n) p)))) (put 'add '(polynomial number) (lambda (p n) (tag (add-poly p (const (variable p) n))))) (put 'mul '(polynomial number) (lambda (p n) (tag (mul-poly p (const (variable p) n))))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms))))) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) ; apply-generic without any coercion: (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (error "No method for these types - APPLY-GENERIC" (list op type-tags)))))) ================================================ FILE: scheme/sicp/02/showcase/picturelang/main.scm ================================================ (require racket/gui/base) (require racket/draw) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Vectors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (make-vect x y) (list x y)) (define (xcor-vect vect) (car vect)) (define (ycor-vect vect) (cadr vect)) (define (add-vect v1 v2) (make-vect (+ (xcor-vect v1) (xcor-vect v2)) (+ (ycor-vect v1) (ycor-vect v2)))) (define (sub-vect v1 v2) (make-vect (- (xcor-vect v1) (xcor-vect v2)) (- (ycor-vect v1) (ycor-vect v2)))) (define (scale-vect s v) (make-vect (* s (xcor-vect v)) (* s (ycor-vect v)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Segments ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (make-segment start end) (list start end)) (define (start-segment segment) (car segment)) (define (end-segment segment) (cadr segment)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Frames ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (make-frame origin edge1 edge2) (list origin edge1 edge2)) (define (origin-frame frame) (car frame)) (define (edge1-frame frame) (cadr frame)) (define (edge2-frame frame) (caddr frame)) (define (frame-coord-map frame) (lambda (v) (add-vect (origin-frame frame) (add-vect (scale-vect (xcor-vect v) (edge1-frame frame)) (scale-vect (ycor-vect v) (edge2-frame frame)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Transforming painters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (transform-painter painter origin corner1 corner2) (lambda (frame) (let ((m (frame-coord-map frame))) (let ((new-origin (m origin))) (painter (make-frame new-origin (sub-vect (m corner1) new-origin) (sub-vect (m corner2) new-origin))))))) (define (identity painter) painter) (define (flip-vert painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (define (flip-horiz painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) (define (rotate90 painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (define (rotate180 painter) (transform-painter painter (make-vect 1.0 1.0) (make-vect 0.0 1.0) (make-vect 1.0 0.0))) (define (rotate270 painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) (define (squash-inwards painter) (transform-painter painter (make-vect 0.0 0.0) (make-vect 0.65 0.35) (make-vect 0.35 0.65))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Composing painters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (beside painter1 painter2) (let ((split-point (make-vect 0.5 0.0))) (let ((paint-left (transform-painter painter1 (make-vect 0.0 0.0) split-point (make-vect 0.0 1.0))) (paint-right (transform-painter painter2 split-point (make-vect 1.0 0.0) (make-vect 0.5 1.0)))) (lambda (frame) (paint-left frame) (paint-right frame))))) (define (below painter1 painter2) (let ((split-point (make-vect 0.0 0.5))) (let ((paint-bottom (transform-painter painter1 (make-vect 0.0 0.0) (make-vect 1.0 0.0) split-point)) (paint-top (transform-painter painter2 split-point (make-vect 1.0 0.5) (make-vect 0.0 1.0)))) (lambda (frame) (paint-bottom frame) (paint-top frame))))) (define (square-of-four tl tr bl br) (lambda (painter) (let ((top (beside (tl painter) (tr painter))) (bottom (beside (bl painter) (br painter)))) (below bottom top)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Line-drawing painters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (segments->painter segment-list) (lambda (frame) (for-each (lambda (segment) (draw-line ((frame-coord-map frame) (start-segment segment)) ((frame-coord-map frame) (end-segment segment)))) segment-list))) (define outline (segments->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 0.0 1.0)) (make-segment (make-vect 0.0 1.0) (make-vect 1.0 1.0)) (make-segment (make-vect 1.0 1.0) (make-vect 1.0 0.0)) (make-segment (make-vect 1.0 0.0) (make-vect 0.0 0.0))))) (define diamond (segments->painter (list (make-segment (make-vect 0.5 0.0) (make-vect 1.0 0.5)) (make-segment (make-vect 1.0 0.5) (make-vect 0.5 1.0)) (make-segment (make-vect 0.5 1.0) (make-vect 0.0 0.5)) (make-segment (make-vect 0.0 0.5) (make-vect 0.5 0.0)) ))) (define cross (segments->painter (list (make-segment (make-vect 0.0 0.0) (make-vect 1.0 1.0)) (make-segment (make-vect 1.0 0.0) (make-vect 0.0 1.0))))) (define wave (segments->painter (list (make-segment (make-vect 0.00 0.70) (make-vect 0.16 0.57)) (make-segment (make-vect 0.16 0.57) (make-vect 0.30 0.67)) (make-segment (make-vect 0.30 0.67) (make-vect 0.37 0.67)) (make-segment (make-vect 0.37 0.67) (make-vect 0.40 0.64)) (make-segment (make-vect 0.40 0.64) (make-vect 0.42 0.68)) (make-segment (make-vect 0.42 0.68) (make-vect 0.32 0.80)) (make-segment (make-vect 0.32 0.80) (make-vect 0.33 0.85)) (make-segment (make-vect 0.33 0.85) (make-vect 0.36 1.00)) (make-segment (make-vect 0.60 1.00) (make-vect 0.62 0.84)) (make-segment (make-vect 0.62 0.84) (make-vect 0.62 0.78)) (make-segment (make-vect 0.62 0.78) (make-vect 0.53 0.70)) (make-segment (make-vect 0.53 0.70) (make-vect 0.57 0.64)) (make-segment (make-vect 0.57 0.64) (make-vect 0.63 0.67)) (make-segment (make-vect 0.63 0.67) (make-vect 0.68 0.66)) (make-segment (make-vect 0.68 0.66) (make-vect 0.87 0.51)) (make-segment (make-vect 0.87 0.51) (make-vect 1.00 0.40)) (make-segment (make-vect 1.00 0.30) (make-vect 0.73 0.52)) (make-segment (make-vect 0.73 0.52) (make-vect 0.61 0.53)) (make-segment (make-vect 0.61 0.53) (make-vect 0.67 0.25)) (make-segment (make-vect 0.67 0.25) (make-vect 0.71 0.00)) (make-segment (make-vect 0.60 0.00) (make-vect 0.56 0.23)) (make-segment (make-vect 0.56 0.23) (make-vect 0.51 0.28)) (make-segment (make-vect 0.51 0.28) (make-vect 0.46 0.28)) (make-segment (make-vect 0.46 0.28) (make-vect 0.40 0.12)) (make-segment (make-vect 0.40 0.12) (make-vect 0.36 0.00)) (make-segment (make-vect 0.23 0.00) (make-vect 0.34 0.30)) (make-segment (make-vect 0.34 0.30) (make-vect 0.36 0.52)) (make-segment (make-vect 0.36 0.52) (make-vect 0.32 0.55)) (make-segment (make-vect 0.32 0.55) (make-vect 0.28 0.55)) (make-segment (make-vect 0.28 0.55) (make-vect 0.17 0.45)) (make-segment (make-vect 0.17 0.45) (make-vect 0.00 0.60))))) (define smiling-wave (segments->painter (list (make-segment (make-vect 0.00 0.70) (make-vect 0.16 0.57)) (make-segment (make-vect 0.16 0.57) (make-vect 0.30 0.67)) (make-segment (make-vect 0.30 0.67) (make-vect 0.37 0.67)) (make-segment (make-vect 0.37 0.67) (make-vect 0.40 0.64)) (make-segment (make-vect 0.40 0.64) (make-vect 0.42 0.68)) (make-segment (make-vect 0.42 0.68) (make-vect 0.32 0.80)) (make-segment (make-vect 0.32 0.80) (make-vect 0.33 0.85)) (make-segment (make-vect 0.33 0.85) (make-vect 0.36 1.00)) (make-segment (make-vect 0.60 1.00) (make-vect 0.62 0.84)) (make-segment (make-vect 0.62 0.84) (make-vect 0.62 0.78)) (make-segment (make-vect 0.62 0.78) (make-vect 0.53 0.70)) (make-segment (make-vect 0.53 0.70) (make-vect 0.57 0.64)) (make-segment (make-vect 0.57 0.64) (make-vect 0.63 0.67)) (make-segment (make-vect 0.63 0.67) (make-vect 0.68 0.66)) (make-segment (make-vect 0.68 0.66) (make-vect 0.87 0.51)) (make-segment (make-vect 0.87 0.51) (make-vect 1.00 0.40)) (make-segment (make-vect 1.00 0.30) (make-vect 0.73 0.52)) (make-segment (make-vect 0.73 0.52) (make-vect 0.61 0.53)) (make-segment (make-vect 0.61 0.53) (make-vect 0.67 0.25)) (make-segment (make-vect 0.67 0.25) (make-vect 0.71 0.00)) (make-segment (make-vect 0.60 0.00) (make-vect 0.56 0.23)) (make-segment (make-vect 0.56 0.23) (make-vect 0.51 0.28)) (make-segment (make-vect 0.51 0.28) (make-vect 0.46 0.28)) (make-segment (make-vect 0.46 0.28) (make-vect 0.40 0.12)) (make-segment (make-vect 0.40 0.12) (make-vect 0.36 0.00)) (make-segment (make-vect 0.23 0.00) (make-vect 0.34 0.30)) (make-segment (make-vect 0.34 0.30) (make-vect 0.36 0.52)) (make-segment (make-vect 0.36 0.52) (make-vect 0.32 0.55)) (make-segment (make-vect 0.32 0.55) (make-vect 0.28 0.55)) (make-segment (make-vect 0.28 0.55) (make-vect 0.17 0.45)) (make-segment (make-vect 0.17 0.45) (make-vect 0.00 0.60)) (make-segment (make-vect 0.41 0.78) (make-vect 0.54 0.78)) (make-segment (make-vect 0.54 0.78) (make-vect 0.52 0.76)) (make-segment (make-vect 0.52 0.76) (make-vect 0.43 0.76)) (make-segment (make-vect 0.43 0.76) (make-vect 0.41 0.78))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Splitting painters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (right-split painter n) (if (= n 0) painter (let ((smaller (right-split painter (- n 1)))) (beside painter (below smaller smaller))))) (define (up-split painter n) (if (= n 0) painter (let ((smaller (up-split painter (- n 1)))) (below painter (beside smaller smaller))))) (define (corner-split painter n) (if (= n 0) painter (let ((up (up-split painter (- n 1))) (right (right-split painter (- n 1)))) (let ((top-left (beside up up)) (bottom-right (below right right)) (corner (corner-split painter (- n 1)))) (beside (below painter top-left) (below bottom-right corner)))))) (define (simpler-corner-split painter n) (if (= n 0) painter (let ((up (up-split painter (- n 1))) (right (right-split painter (- n 1)))) (beside (below painter up) (below right (corner-split painter (- n 1))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Square of four painters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (square-limit painter n) (let ((quarter (corner-split painter n))) (let ((half (beside (flip-horiz quarter) quarter))) (below (flip-vert half) half)))) (define flipped-pairs (square-of-four identity flip-vert identity flip-vert)) (define (simpler-square-limit painter n) (let ((combine4 (square-of-four flip-horiz identity rotate180 flip-vert))) (combine4 (simpler-corner-split painter n)))) (define (inverted-square-limit painter n) (let ((combine4 (square-of-four flip-vert rotate180 identity flip-horiz))) (combine4 (corner-split painter n)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Canvas-drawing functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (draw-line a b) (let ((original-pen (send dc get-pen))) (send dc set-pen "black" 1 'solid) (send dc draw-line (xcor-vect a) (ycor-vect a) (xcor-vect b) (ycor-vect b)) (send dc set-pen original-pen))) (define rogers-size 150) (define rogers-bitmap (make-object bitmap% rogers-size rogers-size)) (send rogers-bitmap load-file "rogers.jpg") (define (rogers frame) (let ((original-transformation (send dc get-transformation)) (origin (origin-frame frame)) (x-axis (edge1-frame frame)) (y-axis (edge2-frame frame)) (factor (/ 1.0 (- rogers-size 2)))) (send dc transform (vector (xcor-vect x-axis) (xcor-vect y-axis) (ycor-vect x-axis) (ycor-vect y-axis) (xcor-vect origin) (ycor-vect origin))) (send dc scale factor factor) (send dc draw-bitmap rogers-bitmap 0 0) (send dc set-transformation original-transformation))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Drawing pictures list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define pictures-in-a-row 6) (define pictures-in-a-column 4) (define picture-size 190) (define picture-margin 20) (define (draw-pictures-list pictures pos) (define (draw-text text x y) (let ((original-transformation (send dc get-transformation))) (send dc scale 1 -1) (send dc translate 0 (- 0 picture-size picture-margin)) (send dc draw-text text x (+ (- y) 4)) (send dc set-transformation original-transformation))) (if (null? pictures) #t (let ((x (+ (* (+ picture-margin picture-size) (remainder pos pictures-in-a-row)) picture-margin)) (y (+ (* (+ picture-margin picture-size) (- pictures-in-a-column (quotient pos pictures-in-a-row) 1)) picture-margin)) (label (car pictures)) (picture (cadr pictures)) (remaining (cddr pictures))) (draw-text label x y) (picture (make-frame (make-vect x y) (make-vect picture-size 0.0) (make-vect 0.0 picture-size))) (draw-pictures-list remaining (+ pos 1))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Setting up a canvas ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define width (+ (* pictures-in-a-row picture-size) (* pictures-in-a-row picture-margin) picture-margin)) (define height (+ (* pictures-in-a-column picture-size) (* pictures-in-a-column picture-margin) picture-margin)) (define target (make-bitmap width height)) (define dc (new bitmap-dc% [bitmap target])) (send dc translate 0 height) (send dc scale 1 -1) (send dc set-smoothing 'smoothed) (send dc set-font (make-object font% 12 'system 'normal 'bold)) (send dc set-text-foreground "dim gray") (define frame (new frame% [label "Example"] [width width] [height (+ height 10)])) (define canvas (new canvas% [parent frame] [paint-callback (lambda (canvas dc) (send dc draw-bitmap target 0 0))])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Drawing things ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (draw-pictures-list (list "outline (2.49a)" outline "cross (2.49b)" cross "diamond (2.49c)" diamond "beside" (beside diamond outline) "below (2.51)" (below outline cross) "beside, below" (below (beside cross outline) (beside diamond cross)) "wave (2.49d)" wave "flip-horiz (2.50)" (flip-horiz wave) "rotate180 (2.50)" (rotate180 wave) "rotate270 (2.50)" (rotate270 wave) "smiling-wave (2.52a)" smiling-wave "flipped-pairs" (flipped-pairs wave) "right-split" (right-split outline 4) "up-split (2.44)" (up-split outline 4) "corner-split" (corner-split outline 4) "simpler-corner-split (2.52b)" (simpler-corner-split outline 4) "square-limit" (square-limit wave 4) "inverted-square-limit (2.52c)" (inverted-square-limit wave 4) "rogers" rogers "simpler-square-limit, rogers" (simpler-square-limit rogers 4) "square-limit, rogers" (square-limit rogers 4) "inverted-square-limit, rogers" (inverted-square-limit (flip-vert rogers) 4) "squash-inwards" (squash-inwards rogers) "square-limit, squash-inwards" (square-limit (squash-inwards rogers) 4)) 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Render the frame ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (send frame show #t) ================================================ FILE: scheme/sicp/02/tests/01-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../01.scm") (define sicp-2.01-tests (test-suite "Tests for SICP exercise 2.01" (check-equal? (numer (make-rat 1 2)) 1) (check-equal? (denom (make-rat 1 2)) 2) (check-equal? (numer (make-rat -1 2)) -1) (check-equal? (denom (make-rat -1 2)) 2) (check-equal? (numer (make-rat 1 -2)) -1) (check-equal? (denom (make-rat 1 -2)) 2) (check-equal? (numer (make-rat -1 -2)) 1) (check-equal? (denom (make-rat -1 -2)) 2) (check-equal? (numer (make-rat -2 -4)) 1) (check-equal? (denom (make-rat -2 -4)) 2) (check-equal? (numer (make-rat 2 4)) 1) (check-equal? (denom (make-rat 2 4)) 2) )) (run-tests sicp-2.01-tests) ================================================ FILE: scheme/sicp/02/tests/02-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../02.scm") (define sicp-2.02-tests (test-suite "Tests for SICP exercise 2.02" (check-equal? (x-point (make-point 1 2)) 1) (check-equal? (y-point (make-point 1 2)) 2) (check-equal? (start-segment (make-segment (make-point 1 2) (make-point 3 4))) (make-point 1 2)) (check-equal? (end-segment (make-segment (make-point 1 2) (make-point 3 4))) (make-point 3 4)) (check-equal? (midpoint-segment (make-segment (make-point 0 10) (make-point 10 0))) (make-point 5 5)) (check-equal? (midpoint-segment (make-segment (make-point 0 0) (make-point 0 10))) (make-point 0 5)) (check-equal? (midpoint-segment (make-segment (make-point 10 0) (make-point 0 0))) (make-point 5 0)) )) (run-tests sicp-2.02-tests) ================================================ FILE: scheme/sicp/02/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../03.scm") (define sicp-2.03-tests (test-suite "Tests for SICP exercise 2.03" (check-equal? (perimeter (make-rectangle (make-point 1 1) (make-point 2 2))) 4) (check-equal? (perimeter (make-rectangle (make-point 0 0) (make-point 3 4))) 14) (check-equal? (area (make-rectangle (make-point 1 1) (make-point 2 2))) 1) (check-equal? (area (make-rectangle (make-point 0 0) (make-point 3 4))) 12) )) (run-tests sicp-2.03-tests) ================================================ FILE: scheme/sicp/02/tests/05-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../05.scm") (define sicp-2.05-tests (test-suite "Tests for SICP exercise 2.05" (check-equal? (car (cons 5 7)) 5) (check-equal? (cdr (cons 5 7)) 7) (check-equal? (car (cons 0 7)) 0) (check-equal? (cdr (cons 5 0)) 0) )) (run-tests sicp-2.05-tests) ================================================ FILE: scheme/sicp/02/tests/06-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../06.scm") (define (double x) (+ x x)) (define sicp-2.06-tests (test-suite "Tests for SICP exercise 2.06" (check-equal? ((one double) 2) 4) (check-equal? ((two double) 2) 8) (check-equal? (((add one two) double) 2) 16) )) (run-tests sicp-2.06-tests) ================================================ FILE: scheme/sicp/02/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../07.scm") (define sicp-2.07-tests (test-suite "Tests for SICP exercise 2.07" (check-equal? (lower-bound (make-interval 4 5)) 4) (check-equal? (upper-bound (make-interval 4 5)) 5) )) (run-tests sicp-2.07-tests) ================================================ FILE: scheme/sicp/02/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../08.scm") (define sicp-2.08-tests (test-suite "Tests for SICP exercise 2.08" (check-equal? (sub-interval (make-interval 20 25) (make-interval 1 2)) (make-interval 18 24)) (check-equal? (sub-interval (make-interval 10 12) (make-interval -3 -1)) (make-interval 11 15)) )) (run-tests sicp-2.08-tests) ================================================ FILE: scheme/sicp/02/tests/10-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../10.scm") (define sicp-2.10-tests (test-suite "Tests for SICP exercise 2.10" (check-equal? (div-interval (make-interval 10.0 20.0) (make-interval 2.0 5.0)) (make-interval 2.0 10.0)) (check-exn exn? (lambda () (div-interval (make-interval 10 20) (make-interval -1 1)))) )) (run-tests sicp-2.10-tests) ================================================ FILE: scheme/sicp/02/tests/11-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../11.scm") (define sicp-2.11-tests (test-suite "Tests for SICP exercise 2.11" (check-equal? (mul-interval (make-interval 1 2) (make-interval 3 4)) (make-interval 3 8)) (check-equal? (mul-interval (make-interval 1 2) (make-interval -3 4)) (make-interval -6 8)) (check-equal? (mul-interval (make-interval 1 2) (make-interval -4 -3)) (make-interval -8 -3)) (check-equal? (mul-interval (make-interval -1 2) (make-interval 3 4)) (make-interval -4 8)) (check-equal? (mul-interval (make-interval -1 2) (make-interval -3 4)) (make-interval -6 8)) (check-equal? (mul-interval (make-interval -4 2) (make-interval -3 4)) (make-interval -16 12)) (check-equal? (mul-interval (make-interval -2 2) (make-interval -3 2)) (make-interval -6 6)) (check-equal? (mul-interval (make-interval -2 2) (make-interval -2 3)) (make-interval -6 6)) (check-equal? (mul-interval (make-interval -1 2) (make-interval -4 -3)) (make-interval -8 4)) (check-equal? (mul-interval (make-interval -2 -1) (make-interval 3 4)) (make-interval -8 -3)) (check-equal? (mul-interval (make-interval -2 -1) (make-interval -3 4)) (make-interval -8 6)) (check-equal? (mul-interval (make-interval -2 -1) (make-interval -4 -3)) (make-interval 3 8)) )) (run-tests sicp-2.11-tests) ================================================ FILE: scheme/sicp/02/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../12.scm") (define sicp-2.12-tests (test-suite "Tests for SICP exercise 2.12" (check-equal? (percent (make-interval 95 105)) 5) (check-equal? (make-center-percent 100 5) (make-interval 95 105)) (check-equal? (percent (make-center-percent 100 5)) 5) )) (run-tests sicp-2.12-tests) ================================================ FILE: scheme/sicp/02/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../17.scm") (define sicp-2.17-tests (test-suite "Tests for SICP exercise 2.17" (check-equal? (last-pair (list 23 72 149 34)) (list 34)) (check-equal? (last-pair (list 34)) (list 34)) )) (run-tests sicp-2.17-tests) ================================================ FILE: scheme/sicp/02/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../18.scm") (define sicp-2.18-tests (test-suite "Tests for SICP exercise 2.18" (check-equal? (reverse (list 1 4 9 16 25)) (list 25 16 9 4 1)) (check-equal? (reverse (list 1)) (list 1)) (check-equal? (reverse '()) '()) )) (run-tests sicp-2.18-tests) ================================================ FILE: scheme/sicp/02/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../19.scm") (define sicp-2.19-tests (test-suite "Tests for SICP exercise 2.19" (check-equal? (cc 100 '(50 25 10 5 1)) 292) (check-equal? (cc 11 '(10 5 1)) 4) )) (run-tests sicp-2.19-tests) ================================================ FILE: scheme/sicp/02/tests/20-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../20.scm") (define sicp-2.20-tests (test-suite "Tests for SICP exercise 2.20" (check-equal? (same-parity 1 2 3 4 5 6 7) (list 1 3 5 7)) (check-equal? (same-parity 2 3 4 5 6 7) (list 2 4 6)) )) (run-tests sicp-2.20-tests) ================================================ FILE: scheme/sicp/02/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../21.scm") (define sicp-2.21-tests (test-suite "Tests for SICP exercise 2.21" (check-equal? (square-list-1 (list 1 2 3 4)) (list 1 4 9 16)) (check-equal? (square-list-2 (list 1 2 3 4)) (list 1 4 9 16)) )) (run-tests sicp-2.21-tests) ================================================ FILE: scheme/sicp/02/tests/25-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../25.scm") (define sicp-2.25-tests (test-suite "Tests for SICP exercise 2.25" (check-equal? (car (cdr (car (cdr (cdr '(1 3 (5 7) 9)))))) 7) (check-equal? (car (car '((7)))) 7) (check-equal? (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr '(1 (2 (3 (4 (5 (6 7)))))))))))))))))) 7) )) (run-tests sicp-2.25-tests) ================================================ FILE: scheme/sicp/02/tests/27-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../27.scm") (define sicp-2.27-tests (test-suite "Tests for SICP exercise 2.27" (check-equal? (deep-reverse '((1 2) (3 4))) '((4 3) (2 1))) )) (run-tests sicp-2.27-tests) ================================================ FILE: scheme/sicp/02/tests/28-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../28.scm") (define sicp-2.28-tests (test-suite "Tests for SICP exercise 2.28" (check-equal? (fringe '((1 2) (3 4))) '(1 2 3 4)) (check-equal? (fringe '(((1 2) (3 4)) ((1 2) (3 4)))) '(1 2 3 4 1 2 3 4)) (check-equal? (fringe '(((1 2) 3 4) 5)) '(1 2 3 4 5)) (check-equal? (fringe '(1 (2 (3 4) 5 (6)) 7)) '(1 2 3 4 5 6 7)) )) (run-tests sicp-2.28-tests) ================================================ FILE: scheme/sicp/02/tests/29-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../29.scm") (define sicp-2.29-tests (test-suite "Tests for SICP exercise 2.29" (check-equal? (left-branch (make-mobile (make-branch 1 2) (make-branch 3 4))) (make-branch 1 2)) (check-equal? (right-branch (make-mobile (make-branch 1 2) (make-branch 3 4))) (make-branch 3 4)) (check-equal? (branch-length (make-branch 1 2)) 1) (check-equal? (branch-structure (make-branch 1 2)) 2) (check-equal? (total-weight (make-mobile (make-branch 1 (make-mobile (make-branch 2 3) (make-branch 4 5))) (make-branch 6 7))) 15) (check-true (balanced? (make-mobile (make-branch 3 4) (make-branch 6 2)))) (check-false (balanced? (make-mobile (make-branch 3 3) (make-branch 6 2)))) (check-true (balanced? (make-mobile (make-branch 3 (make-mobile (make-branch 2 4) (make-branch 8 1))) (make-branch 5 3)))) (check-false (balanced? (make-mobile (make-branch 3 (make-mobile (make-branch 2 4) (make-branch 7 1))) (make-branch 5 3)))) (check-false (balanced? (make-mobile (make-branch 3 (make-mobile (make-branch 2 4) (make-branch 8 1))) (make-branch 4 3)))) )) (run-tests sicp-2.29-tests) ================================================ FILE: scheme/sicp/02/tests/30-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../30.scm") (define sicp-2.30-tests (test-suite "Tests for SICP exercise 2.30" (check-equal? (square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))) '(1 (4 (9 16) 25) (36 49))) )) (run-tests sicp-2.30-tests) ================================================ FILE: scheme/sicp/02/tests/31-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../31.scm") (define sicp-2.31-tests (test-suite "Tests for SICP exercise 2.31" (check-equal? (square-tree '(1 (2 (3 4) 5) (6 7))) '(1 (4 (9 16) 25) (36 49))) (check-equal? (tree-map (lambda (x) (+ x 1)) '(1 (2 (3 4) 5) (6 7))) '(2 (3 (4 5) 6) (7 8))) )) (run-tests sicp-2.31-tests) ================================================ FILE: scheme/sicp/02/tests/32-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../32.scm") (define sicp-2.32-tests (test-suite "Tests for SICP exercise 2.32" (check-equal? (subsets '()) '(())) (check-equal? (subsets '(1)) '(() (1))) (check-equal? (subsets '(1 2)) '(() (2) (1) (1 2))) (check-equal? (subsets '(1 2 3)) '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))) )) (run-tests sicp-2.32-tests) ================================================ FILE: scheme/sicp/02/tests/33-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../33.scm") (define sicp-2.33-tests (test-suite "Tests for SICP exercise 2.33" (check-equal? (map (lambda (x) (* x x)) '(1 2 3 4)) '(1 4 9 16)) (check-equal? (append '(1 2 3) '(4 5 6)) '(1 2 3 4 5 6)) (check-equal? (length '(1 2 3)) 3) )) (run-tests sicp-2.33-tests) ================================================ FILE: scheme/sicp/02/tests/34-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../34.scm") (define sicp-2.34-tests (test-suite "Tests for SICP exercise 2.34" (check-equal? (horner-eval 2 (list 1 3 0 5 0 1)) 79) )) (run-tests sicp-2.34-tests) ================================================ FILE: scheme/sicp/02/tests/35-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../35.scm") (define sicp-2.35-tests (test-suite "Tests for SICP exercise 2.35" (check-equal? (count-leaves '()) 0) (check-equal? (count-leaves '(1 2 3 4)) 4) (check-equal? (count-leaves '(1 2 (3 4 (5 6) 7) 8 (9))) 9) )) (run-tests sicp-2.35-tests) ================================================ FILE: scheme/sicp/02/tests/36-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../36.scm") (define sicp-2.36-tests (test-suite "Tests for SICP exercise 2.36" (check-equal? (accumulate-n + 0 '((1 2 3) (4 5 6) (7 8 9) (10 11 12))) '(22 26 30)) )) (run-tests sicp-2.36-tests) ================================================ FILE: scheme/sicp/02/tests/37-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../37.scm") (define sicp-2.37-tests (test-suite "Tests for SICP exercise 2.37" (check-equal? (matrix-*-vector '((1 2) (3 4)) '(5 6)) '(17 39)) (check-equal? (transpose '((1 2 3) (4 5 6) (7 8 9))) '((1 4 7) (2 5 8) (3 6 9))) (check-equal? (matrix-*-matrix '((1 2) (3 4)) '((5 6) (7 8))) '((19 22) (43 50))) )) (run-tests sicp-2.37-tests) ================================================ FILE: scheme/sicp/02/tests/39-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../39.scm") (define sicp-2.39-tests (test-suite "Tests for SICP exercise 2.39" (check-equal? (reverse-r '(1 2 3 4 5)) '(5 4 3 2 1)) (check-equal? (reverse-l '(1 2 3 4 5)) '(5 4 3 2 1)) )) (run-tests sicp-2.39-tests) ================================================ FILE: scheme/sicp/02/tests/40-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../40.scm") (define sicp-2.40-tests (test-suite "Tests for SICP exercise 2.40" (check-equal? (enumerate-interval 1 5) '(1 2 3 4 5)) (check-equal? (unique-pairs 2) '((1 2))) (check-equal? (unique-pairs 3) '((1 2) (1 3) (2 3))) (check-equal? (unique-pairs 4) '((1 2) (1 3) (1 4) (2 3) (2 4) (3 4))) (check-equal? (prime-sum-pairs 6) '((1 2) (1 4) (1 6) (2 3) (2 5) (3 4) (5 6))) )) (run-tests sicp-2.40-tests) ================================================ FILE: scheme/sicp/02/tests/41-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../41.scm") (define sicp-2.41-tests (test-suite "Tests for SICP exercise 2.41" (check-equal? (triples-sum 5 9) '((1 3 5) (2 3 4))) (check-equal? (triples-sum 5 10) '((1 4 5) (2 3 5))) )) (run-tests sicp-2.41-tests) ================================================ FILE: scheme/sicp/02/tests/42-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../42.scm") (define sicp-2.42-tests (test-suite "Tests for SICP exercise 2.42" (check-true (safe? 2 '((1 1) (3 2)))) (check-false (safe? 2 '((1 1) (1 2)))) (check-true (safe? 2 '((3 1) (1 2)))) (check-false (safe? 2 '((3 1) (2 2)))) (check-false (safe? 2 '((1 1) (2 2)))) (check-true (all? zero? '(0 0 0))) (check-false (all? zero? '(0 1 0))) (check-true (all? zero? '())) (check-equal? 92 (length (queens 8))) )) (run-tests sicp-2.42-tests) ================================================ FILE: scheme/sicp/02/tests/44-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../44.scm") (define (below a b) (list 'below a b)) (define (beside a b) (list 'beside a b)) (define sicp-2.44-tests (test-suite "Tests for SICP exercise 2.44" (check-equal? (up-split 'a 1) '(below a (beside a a))) (check-equal? (up-split 'a 2) '(below a (beside (below a (beside a a)) (below a (beside a a))))) )) (run-tests sicp-2.44-tests) ================================================ FILE: scheme/sicp/02/tests/45-tests.scm ================================================ (require rackunit rackunit/text-ui) (define (below a b) (list 'below a b)) (define (beside a b) (list 'beside a b)) (load "../45.scm") (define sicp-2.45-tests (test-suite "Tests for SICP exercise 2.45" (check-equal? (up-split 'a 1) '(below a (beside a a))) (check-equal? (up-split 'a 2) '(below a (beside (below a (beside a a)) (below a (beside a a))))) (check-equal? (right-split 'a 1) '(beside a (below a a))) (check-equal? (right-split 'a 2) '(beside a (below (beside a (below a a)) (beside a (below a a))))) )) (run-tests sicp-2.45-tests) ================================================ FILE: scheme/sicp/02/tests/46-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../46.scm") (define sicp-2.46-tests (test-suite "Tests for SICP exercise 2.46" (check-equal? 1.0 (xcor-vect (make-vect 1.0 2.0))) (check-equal? 2.0 (ycor-vect (make-vect 1.0 2.0))) (check-equal? (make-vect 4.0 6.0) (add-vect (make-vect 1.0 2.0) (make-vect 3.0 4.0))) (check-equal? (make-vect 3.0 1.0) (sub-vect (make-vect 4.0 3.0) (make-vect 1.0 2.0))) (check-equal? (make-vect 3.0 6.0) (scale-vect 3.0 (make-vect 1.0 2.0))) )) (run-tests sicp-2.46-tests) ================================================ FILE: scheme/sicp/02/tests/47-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../47.scm") (define sicp-2.47-tests (test-suite "Tests for SICP exercise 2.47" (check-equal? (origin-frame1 (make-frame1 1 2 3)) 1) (check-equal? (edge1-frame1 (make-frame1 1 2 3)) 2) (check-equal? (edge2-frame1 (make-frame1 1 2 3)) 3) (check-equal? (origin-frame2 (make-frame2 1 2 3)) 1) (check-equal? (edge1-frame2 (make-frame2 1 2 3)) 2) (check-equal? (edge2-frame2 (make-frame2 1 2 3)) 3) )) (run-tests sicp-2.47-tests) ================================================ FILE: scheme/sicp/02/tests/48-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../48.scm") (define sicp-2.48-tests (test-suite "Tests for SICP exercise 2.48" (check-equal? (start-segment (make-segment (make-vect 1.0 2.0) (make-vect 3.0 4.0))) (make-vect 1.0 2.0)) (check-equal? (end-segment (make-segment (make-vect 1.0 2.0) (make-vect 3.0 4.0))) (make-vect 3.0 4.0)) )) (run-tests sicp-2.48-tests) ================================================ FILE: scheme/sicp/02/tests/54-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../54.scm") (define sicp-2.54-tests (test-suite "Tests for SICP exercise 2.54" (check-true (equal2? 'a 'a)) (check-true (equal2? '(a b) '(a b))) (check-true (equal2? '(a (b c) d) '(a (b c) d))) (check-true (equal2? '(a (b c) d (e f)) '(a (b c) d (e f)))) )) (run-tests sicp-2.54-tests) ================================================ FILE: scheme/sicp/02/tests/56-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../56.scm") (define sicp-2.56-tests (test-suite "Tests for SICP exercise 2.56" (check-equal? (deriv '(+ x 3) 'x) 1) (check-equal? (deriv '(* x y) 'x) 'y) (check-equal? (deriv '(* (* x y) (+ x 3)) 'x) '(+ (* x y) (* y (+ x 3)))) (check-equal? (deriv '(** x 3) 'x) '(* 3 (** x 2))) (check-equal? (deriv '(** x 2) 'x) '(* 2 x)) (check-equal? (deriv '(** x 1) 'x) 1) )) (run-tests sicp-2.56-tests) ================================================ FILE: scheme/sicp/02/tests/57-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../57.scm") (define sicp-2.57-tests (test-suite "Tests for SICP exercise 2.57" (check-equal? (multiplier '(* x y z)) 'x) (check-equal? (multiplicand '(* x y z)) '(* y z)) (check-equal? (addend '(+ x y z)) 'x) (check-equal? (augend '(+ x y z)) '(+ y z)) (check-equal? (deriv '(* x y (+ x 3)) 'x) '(+ (* x y) (* y (+ x 3)))) (check-equal? (deriv '(+ 0 y x) 'x) 1) )) (run-tests sicp-2.57-tests) ================================================ FILE: scheme/sicp/02/tests/58-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../58.scm") (define sicp-2.58-tests (test-suite "Tests for SICP exercise 2.58" (check-equal? (deriv '(x * x) 'x) '(x + x)) (check-equal? (deriv '(x + (3 * (x + (y + 2)))) 'x) 4) )) (run-tests sicp-2.58-tests) ================================================ FILE: scheme/sicp/02/tests/59-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../59.scm") (define sicp-2.59-tests (test-suite "Tests for SICP exercise 2.59" (check-equal? (union-set '(1 2) '(3 4)) '(1 2 3 4)) (check-equal? (union-set '(1 2 3) '(2 4)) '(1 3 2 4)) )) (run-tests sicp-2.59-tests) ================================================ FILE: scheme/sicp/02/tests/60-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../60.scm") (define sicp-2.60-tests (test-suite "Tests for SICP exercise 2.60" (check-true (element-of-set? 1 '(2 3 2 1 3 2 2))) (check-true (element-of-set? 2 '(2 3 2 1 3 2 2))) (check-true (element-of-set? 3 '(2 3 2 1 3 2 2))) (check-false (element-of-set? 4 '(2 3 2 1 3 2 2))) (check-equal? (adjoin-set '1 '()) '(1)) (check-equal? (adjoin-set '1 '(2 3)) '(1 2 3)) (check-equal? (adjoin-set '2 '(3 2 1)) '(2 3 2 1)) (check-equal? (union-set '(1 2) '(3 4)) '(1 2 3 4)) (check-equal? (union-set '(1 2) '(1 3)) '(1 2 1 3)) (check-equal? (intersection-set '(1 2 3) '(2 3 4)) '(2 3)) (check-equal? (intersection-set '(1 2 2 3 3) '(2 3 3 4 4 4)) '(2 2 3 3)) (check-equal? (intersection-set '(1 2 3) '(2 2 2 3 3 4 4 4)) '(2 3)) )) (run-tests sicp-2.60-tests) ================================================ FILE: scheme/sicp/02/tests/61-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../61.scm") (define sicp-2.61-tests (test-suite "Tests for SICP exercise 2.61" (check-equal? (adjoin-set 0 '()) '(0)) (check-equal? (adjoin-set 0 '(1 3 5)) '(0 1 3 5)) (check-equal? (adjoin-set 1 '(1 3 5)) '(1 3 5)) (check-equal? (adjoin-set 2 '(1 3 5)) '(1 2 3 5)) (check-equal? (adjoin-set 3 '(1 3 5)) '(1 3 5)) (check-equal? (adjoin-set 4 '(1 3 5)) '(1 3 4 5)) (check-equal? (adjoin-set 5 '(1 3 5)) '(1 3 5)) (check-equal? (adjoin-set 6 '(1 3 5)) '(1 3 5 6)) (check-equal? (adjoin-set 7 '(1 3 5)) '(1 3 5 7)) )) (run-tests sicp-2.61-tests) ================================================ FILE: scheme/sicp/02/tests/62-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../62.scm") (define sicp-2.62-tests (test-suite "Tests for SICP exercise 2.62" (check-equal? (union-set '() '()) '()) (check-equal? (union-set '(1) '()) '(1)) (check-equal? (union-set '() '(1)) '(1)) (check-equal? (union-set '(1) '(2)) '(1 2)) (check-equal? (union-set '(2) '(1)) '(1 2)) (check-equal? (union-set '(1 3) '(2)) '(1 2 3)) (check-equal? (union-set '(1) '(2 3)) '(1 2 3)) (check-equal? (union-set '(2) '(1 3)) '(1 2 3)) (check-equal? (union-set '(1 2) '(3)) '(1 2 3)) (check-equal? (union-set '(1 2) '(1 3)) '(1 2 3)) (check-equal? (union-set '(1 2 3) '(1 2)) '(1 2 3)) (check-equal? (union-set '(1 2) '(1 2 3)) '(1 2 3)) (check-equal? (union-set '(1 3 5 7 9) '(2 4 6 8 10)) '(1 2 3 4 5 6 7 8 9 10)) )) (run-tests sicp-2.62-tests) ================================================ FILE: scheme/sicp/02/tests/65-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../65.scm") (define sicp-2.65-tests (test-suite "Tests for SICP exercise 2.65" (check-equal? (tree->list (intersection-set (list->tree '(1 3 5 7 9 11)) (list->tree '(2 3 5 9 10)))) '(3 5 9)) (check-equal? (tree->list (union-set (list->tree '(1 3 5 7 9 11)) (list->tree '(2 3 5 9 10)))) '(1 2 3 5 7 9 10 11)) )) (run-tests sicp-2.65-tests) ================================================ FILE: scheme/sicp/02/tests/66-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../66.scm") (define a-tree '((99 a) ((50 b) ((25 c) ((12 d) () ()) ((42 e) ((30 f) () ()) ())) ((75 g) () ())) ())) (define (name-for number) (let ((record (lookup number a-tree))) (if record (name record) #f))) (define sicp-2.66-tests (test-suite "Tests for SICP exercise 2.66" (check-equal? (name-for 99) 'a) (check-equal? (name-for 50) 'b) (check-equal? (name-for 25) 'c) (check-equal? (name-for 12) 'd) (check-equal? (name-for 42) 'e) (check-equal? (name-for 30) 'f) (check-equal? (name-for 75) 'g) (check-equal? (name-for 20) #f) )) (run-tests sicp-2.66-tests) ================================================ FILE: scheme/sicp/02/tests/67-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../67.scm") (define sicp-2.67-tests (test-suite "Tests for SICP exercise 2.67" (check-equal? (decode sample-message sample-tree) '(A D A B B C A)) )) (run-tests sicp-2.67-tests) ================================================ FILE: scheme/sicp/02/tests/68-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../68.scm") (define sample-tree (make-code-tree (make-leaf 'A 4) (make-code-tree (make-leaf 'B 2) (make-code-tree (make-leaf 'D 1) (make-leaf 'C 1))))) (define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0)) (define sicp-2.68-tests (test-suite "Tests for SICP exercise 2.68" (check-equal? (encode '(A D A B B C A) sample-tree) '(0 1 1 0 0 1 0 1 0 1 1 1 0)) (check-exn exn? (lambda () (encode '(E) sample-tree))) )) (run-tests sicp-2.68-tests) ================================================ FILE: scheme/sicp/02/tests/69-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../69.scm") (define sicp-2.69-tests (test-suite "Tests for SICP exercise 2.69" (check-equal? (generate-huffman-tree '((A 4) (B 2) (C 1) (D 1))) (make-code-tree (make-leaf 'A 4) (make-code-tree (make-leaf 'B 2) (make-code-tree (make-leaf 'D 1) (make-leaf 'C 1))))) )) (run-tests sicp-2.69-tests) ================================================ FILE: scheme/sicp/02/tests/73-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../73.scm") (define sicp-2.73-tests (test-suite "Tests for SICP exercise 2.73" (check-equal? (deriv '(+ x 3) 'x) 1) (check-equal? (deriv '(* x y) 'x) 'y) (check-equal? (deriv '(* (* x y) (+ x 3)) 'x) '(+ (* x y) (* y (+ x 3)))) (check-equal? (deriv '(** x 3) 'x) '(* 3 (** x 2))) (check-equal? (deriv '(** x 2) 'x) '(* 2 x)) (check-equal? (deriv '(** x 1) 'x) 1) )) (run-tests sicp-2.73-tests) ================================================ FILE: scheme/sicp/02/tests/74-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../74.scm") (define paul '((salary 2000) (address "Arrakeen Palace"))) (define leto '((salary 2500) (address "The Caladan planet"))) (define atreides (attach-tag 'atreides-file (list (list "Paul Atreides" paul) (list "Duke Leto" leto)))) (define stilgar '((income . 1000) (location . "Sietch Tabr"))) (define chani '((income . 800) (location . "Whenever Paul is"))) (define fremen (attach-tag 'fremen-file (list (cons "Stilgar" stilgar) (cons "Chani" chani)))) (define sicp-2.74-tests (test-suite "Tests for SICP exercise 2.74" (test-suite "Data structures" (check-equal? (a-list-get '(("a" 1) ("b" 2)) "b") 2) (check-equal? (a-list-get '() 'a) '()) (check-equal? (p-list-get '((a . 1) (b . 2)) 'b) 2) (check-equal? (p-list-get '() 'a) '()) ) (test-suite "Tags" (check-equal? (attach-tag 'number 1) '(number . 1)) (check-equal? (type-tag (attach-tag 'number 1)) 'number) (check-exn exn? (lambda () (type-tag 1))) (check-equal? (contents (attach-tag 'number 1)) 1) (check-exn exn? (lambda () (contents 1))) ) (test-suite "get-record" (check-equal? (get-record "Paul Atreides" atreides) (attach-tag 'atreides paul)) (check-equal? (get-record "Duke Leto" atreides) (attach-tag 'atreides leto)) (check-equal? (get-record "Stilgar" fremen) (attach-tag 'fremen stilgar)) (check-equal? (get-record "Chani" fremen) (attach-tag 'fremen chani)) (check-equal? (get-record "Vladimir Harkonnen" atreides) '()) (check-equal? (get-record "Feyd-Rautha Harkonnen" fremen) '()) ) (test-suite "get-salary" (check-equal? (get-salary (get-record "Paul Atreides" atreides)) 2000) (check-equal? (get-salary (get-record "Duke Leto" atreides)) 2500) (check-equal? (get-salary (get-record "Stilgar" fremen)) 1000) (check-equal? (get-salary (get-record "Chani" fremen)) 800) ) (test-suite "find-employee-record" (check-equal? (find-employee-record "Paul Atreides" (list atreides fremen)) (attach-tag 'atreides paul)) (check-equal? (find-employee-record "Duke Leto" (list atreides fremen)) (attach-tag 'atreides leto)) (check-equal? (find-employee-record "Stilgar" (list atreides fremen)) (attach-tag 'fremen stilgar)) (check-equal? (find-employee-record "Chani" (list atreides fremen)) (attach-tag 'fremen chani)) (check-equal? (find-employee-record "Vladimir Harkonnen" (list atreides fremen)) '()) ) )) (run-tests sicp-2.74-tests) ================================================ FILE: scheme/sicp/02/tests/75-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../75.scm") (define sicp-2.75-tests (test-suite "Tests for SICP exercise 2.75" (check-equal? (magnitute (make-from-mag-ang 3 4)) 3) (check-equal? (angle (make-from-mag-ang 3 4)) 4) (check-= (real-part (make-from-mag-ang 2 (acos 1))) 2 0.001) (check-= (imag-part (make-from-mag-ang 2 (asin 1))) 2 0.001) )) (run-tests sicp-2.75-tests) ================================================ FILE: scheme/sicp/02/tests/78-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../78.scm") (define sicp-2.78-tests (test-suite "Tests for SICP exercise 2.78" (test-suite "scheme-number package" (check-equal? (add (make-scheme-number 8) (make-scheme-number 2)) (make-scheme-number 10)) (check-equal? (sub (make-scheme-number 8) (make-scheme-number 2)) (make-scheme-number 6)) (check-equal? (mul (make-scheme-number 8) (make-scheme-number 2)) (make-scheme-number 16)) (check-equal? (div (make-scheme-number 8) (make-scheme-number 2)) (make-scheme-number 4)) ) (test-suite "rational package" (check-equal? (add (make-rational 3 4) (make-rational 1 2)) (make-rational 5 4)) (check-equal? (sub (make-rational 3 4) (make-rational 1 2)) (make-rational 1 4)) (check-equal? (mul (make-rational 3 4) (make-rational 1 2)) (make-rational 3 8)) (check-equal? (div (make-rational 3 4) (make-rational 1 2)) (make-rational 6 4)) ) (test-suite "rational package" (check-equal? (real-part (make-from-real-imag 3 4)) 3) (check-equal? (imag-part (make-from-real-imag 3 4)) 4) (check-equal? (magnitude (make-from-real-imag 3 4)) 5) (check-equal? (angle (make-from-real-imag 3 4)) (atan 4 3)) (check-= (real-part ((get 'make-from-mag-ang 'rectangular) 5 (atan 4 3))) 3 0.0001) (check-= (imag-part ((get 'make-from-mag-ang 'rectangular) 5 (atan 4 3))) 4 0.0001) ) (test-suite "polar package" (check-= (real-part (make-from-mag-ang 5 (atan 4 3))) 3 0.0001) (check-= (imag-part (make-from-mag-ang 5 (atan 4 3))) 4 0.0001) (check-equal? (magnitude (make-from-mag-ang 3 4)) 3) (check-equal? (angle (make-from-mag-ang 3 4)) 4) (check-= (magnitude ((get 'make-from-real-imag 'polar) 3 4)) 5 0.0001) (check-= (angle ((get 'make-from-real-imag 'polar) 3 4)) (atan 4 3) 0.0001) ) (test-suite "complex package" (check-equal? (add (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 3 4)) (make-complex-from-real-imag 4 6)) (check-equal? (sub (make-complex-from-real-imag 6 7) (make-complex-from-real-imag 1 3)) (make-complex-from-real-imag 5 4)) (check-equal? (mul (make-complex-from-mag-ang 2 4) (make-complex-from-mag-ang 3 5)) (make-complex-from-mag-ang 6 9)) (check-equal? (div (make-complex-from-mag-ang 6 5) (make-complex-from-mag-ang 3 4)) (make-complex-from-mag-ang 2 1)) (check-equal? (real-part (make-complex-from-real-imag 3 4)) 3) (check-equal? (imag-part (make-complex-from-real-imag 3 4)) 4) (check-equal? (magnitude (make-complex-from-mag-ang 1 2)) 1) (check-equal? (angle (make-complex-from-mag-ang 1 2)) 2) (check-= (real-part (mul (make-complex-from-mag-ang 5 (atan 4 3)) (make-complex-from-real-imag 1 0))) 3 0.0001) (check-= (imag-part (mul (make-complex-from-mag-ang 5 (atan 4 3)) (make-complex-from-real-imag 1 0))) 4 0.0001) ) )) (run-tests sicp-2.78-tests) ================================================ FILE: scheme/sicp/02/tests/79-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../79.scm") (define sicp-2.79-tests (test-suite "Tests for SICP exercise 2.79" (check-true (equ? (make-scheme-number 1) (make-scheme-number 1))) (check-false (equ? (make-scheme-number 1) (make-scheme-number 2))) (check-true (equ? (make-rational 1 2) (make-rational 1 2))) (check-true (equ? (make-rational 1 2) (make-rational 2 4))) (check-false (equ? (make-rational 1 2) (make-rational 2 2))) (check-false (equ? (make-rational 1 2) (make-rational 1 1))) (check-true (equ? (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 1 2))) (check-true (equ? (make-complex-from-mag-ang 1 2) (make-complex-from-mag-ang 1 2))) (check-false (equ? (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 1 1))) (check-false (equ? (make-complex-from-real-imag 1 2) (make-complex-from-real-imag 2 2))) (check-false (equ? (make-complex-from-mag-ang 1 2) (make-complex-from-mag-ang 1 1))) (check-false (equ? (make-complex-from-mag-ang 1 2) (make-complex-from-mag-ang 2 2))) )) (run-tests sicp-2.79-tests) ================================================ FILE: scheme/sicp/02/tests/80-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../80.scm") (define sicp-2.80-tests (test-suite "Tests for SICP exercise 2.80" (check-true (=zero? (make-scheme-number 0))) (check-false (=zero? (make-scheme-number 1))) (check-true (=zero? (make-rational 0 1))) (check-true (=zero? (make-rational 0 2))) (check-false (=zero? (make-rational 1 2))) (check-true (=zero? (make-complex-from-real-imag 0 0))) (check-false (=zero? (make-complex-from-real-imag 0 1))) (check-true (=zero? (make-complex-from-mag-ang 0 1))) (check-false (=zero? (make-complex-from-mag-ang 1 0))) )) (run-tests sicp-2.80-tests) ================================================ FILE: scheme/sicp/02/tests/82-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../82.scm") (define sicp-2.82-tests (test-suite "Tests for SICP exercise 2.82" (check-equal? (foo (make-a) (make-a)) '(foo-a-a a a)) (check-equal? (foo (make-a) (make-b)) '(foo-b-b a->b b)) (check-equal? (foo (make-b) (make-a)) '(foo-b-b b a->b)) (check-equal? (bar (make-a) (make-a) (make-a)) '(bar-a-a-a a a a)) (check-equal? (bar (make-a) (make-b) (make-b)) '(bar-b-b-b a->b b b)) (check-equal? (bar (make-b) (make-a) (make-b)) '(bar-b-b-b b a->b b)) (check-equal? (bar (make-b) (make-b) (make-a)) '(bar-b-b-b b b a->b)) (check-equal? (bar (make-a) (make-a) (make-b)) '(bar-b-b-b a->b a->b b)) (check-equal? (bar (make-a) (make-b) (make-a)) '(bar-b-b-b a->b b a->b)) (check-equal? (bar (make-b) (make-a) (make-a)) '(bar-b-b-b b a->b a->b)) (check-equal? (baz (make-a) (make-a) (make-a) (make-a)) '(baz-a-a-a-a a a a a)) (check-equal? (baz (make-a) (make-b) (make-b) (make-b)) '(baz-b-b-b-b a->b b b b)) (check-equal? (baz (make-b) (make-a) (make-b) (make-b)) '(baz-b-b-b-b b a->b b b)) (check-equal? (baz (make-b) (make-b) (make-a) (make-b)) '(baz-b-b-b-b b b a->b b)) (check-equal? (baz (make-b) (make-b) (make-b) (make-a)) '(baz-b-b-b-b b b b a->b)) (check-exn exn? (lambda () (foo (make-a) (make-c)))) )) (run-tests sicp-2.82-tests) ================================================ FILE: scheme/sicp/02/tests/83-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../83.scm") (define sicp-2.83-tests (test-suite "Tests for SICP exercise 2.83" (check-equal? (raise (make-integer 4)) (make-rational 4 1)) (check-equal? (raise (make-rational 5 2)) (make-real 2.5)) (check-equal? (raise (make-real 2.0)) (make-complex 2.0 0)) )) (run-tests sicp-2.83-tests) ================================================ FILE: scheme/sicp/02/tests/84-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../84.scm") (define sicp-2.84-tests (test-suite "Tests for SICP exercise 2.84" (check-equal? (supertype 'integer) 'rational) (check-equal? (supertype 'rational) 'real) (check-equal? (supertype 'real) 'complex) (check-equal? (supertype 'complex) #f) (check-true (supertype? 'rational 'integer)) (check-true (supertype? 'real 'integer)) (check-true (supertype? 'complex 'integer)) (check-true (supertype? 'real 'rational)) (check-true (supertype? 'complex 'rational)) (check-true (supertype? 'complex 'real)) (check-false (supertype? 'integer 'rational)) (check-false (supertype? 'integer 'real)) (check-false (supertype? 'integer 'complex)) (check-false (supertype? 'rational 'real)) (check-false (supertype? 'rational 'complex)) (check-false (supertype? 'real 'complex)) (check-equal? (foo (make-integer 1) (make-integer 1)) 'foo-integer) (check-equal? (foo (make-rational 1 2) (make-integer 1)) 'foo-rational) (check-equal? (foo (make-integer 1) (make-rational 1 2)) 'foo-rational) (check-equal? (foo (make-integer 1) (make-real 1.0)) 'foo-real) (check-equal? (foo (make-rational 1 2) (make-real 1.0)) 'foo-real) (check-equal? (foo (make-real 1.0) (make-integer 1)) 'foo-real) (check-equal? (foo (make-real 1.0) (make-rational 1 2)) 'foo-real) (check-equal? (foo (make-integer 1) (make-complex 1 2)) 'foo-complex) (check-equal? (foo (make-rational 1 2) (make-complex 1 2)) 'foo-complex) (check-equal? (foo (make-real 1.0) (make-complex 1 2)) 'foo-complex) (check-equal? (foo (make-complex 1 2) (make-integer 1)) 'foo-complex) (check-equal? (foo (make-complex 1 2) (make-rational 1 2)) 'foo-complex) (check-equal? (foo (make-complex 1 2) (make-real 1.0)) 'foo-complex) )) (run-tests sicp-2.84-tests) ================================================ FILE: scheme/sicp/02/tests/85-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../85.scm") (define sicp-2.85-tests (test-suite "Tests for SICP exercise 2.85" (check-true (equ? (make-integer 1) (make-integer 1))) (check-true (equ? (make-rational 1 2) (make-rational 2 4))) (check-true (equ? (make-real 1.5) (make-real 1.5))) (check-true (equ? (make-complex 1 2) (make-complex 1 2))) (check-false (equ? (make-integer 1) (make-integer 2))) (check-false (equ? (make-rational 1 2) (make-rational 1 3))) (check-false (equ? (make-rational 1 2) (make-rational 2 2))) (check-false (equ? (make-real 1.5) (make-real 2.5))) (check-false (equ? (make-complex 1 2) (make-complex 1 3))) (check-false (equ? (make-complex 1 2) (make-complex 2 2))) (check-equal? (project (make-complex 1.0 2.0)) (make-real 1.0)) (check-equal? (project (make-real 2.5)) (make-rational 25 10)) (check-equal? (project (make-rational 5 2)) (make-integer 2)) (check-equal? (drop (make-complex 1 2)) (make-complex 1 2)) (check-equal? (drop (make-complex 2.5 0)) (make-rational 5 2)) (check-equal? (drop (make-complex 1 0)) (make-integer 1)) (check-equal? (drop (make-real 2.5)) (make-rational 5 2)) (check-equal? (drop (make-real 1.0)) (make-integer 1)) (check-equal? (drop (make-rational 1 2)) (make-rational 1 2)) (check-equal? (drop (make-rational 1 1)) (make-integer 1)) (check-equal? (drop (make-integer 1)) (make-integer 1)) (check-equal? (add (make-complex 1 2) (make-complex 3 4)) (make-complex 4 6)) (check-equal? (add (make-complex 1 1) (make-complex 2 -1)) (make-integer 3)) (check-equal? (add (make-real 1.5) (make-real 2.5)) (make-integer 4)) )) (run-tests sicp-2.85-tests) ================================================ FILE: scheme/sicp/02/tests/86-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../86.scm") (define sicp-2.86-tests (test-suite "Tests for SICP exercise 2.86" (test-suite "type tower" (check-true (supertype? 'integer 'rational)) (check-true (supertype? 'integer 'real)) (check-true (supertype? 'integer 'complex)) (check-true (supertype? 'rational 'real)) (check-true (supertype? 'rational 'complex)) (check-true (supertype? 'real 'complex)) ) (test-suite "integers" (check-exn exn? (lambda () (make-integer 1.5))) (check-equal? (add (make-integer 1) (make-integer 2)) (make-integer 3)) (check-equal? (sub (make-integer 3) (make-integer 2)) (make-integer 1)) (check-equal? (mul (make-integer 2) (make-integer 4)) (make-integer 8)) (check-true (equ? (make-integer 1) (make-integer 1))) (check-false (equ? (make-integer 1) (make-integer 2))) (check-equal? (raise (make-integer 2)) (make-rational 2 1)) ) (test-suite "rationals" (check-exn exn? (lambda () (make-rational 1.5 1))) (check-exn exn? (lambda () (make-rational 1 1.5))) (check-equal? (add (make-rational 1 2) (make-rational 3 4)) (make-rational 5 4)) (check-equal? (sub (make-rational 3 4) (make-rational 1 2)) (make-rational 1 4)) (check-equal? (mul (make-rational 2 3) (make-rational 3 6)) (make-rational 1 3)) (check-equal? (div (make-rational 5 4) (make-rational 1 2)) (make-rational 5 2)) (check-equal? (raise (make-rational 5 2)) (/ 5 2)) (check-true (equ? (make-rational 1 2) (make-rational 2 4))) (check-false (equ? (make-rational 1 2) (make-rational 1 3))) (check-equal? (project (make-rational 5 2)) (make-integer 2)) ) (test-suite "scheme numbers" (check-equal? (type-tag 1) 'scheme-number) (check-equal? (contents 1) 1) (check-equal? (attach-tag 'scheme-number 1) 1) (check-equal? (add 1 2) (make-integer 3)) (check-equal? (sub 3 2) (make-integer 1)) (check-equal? (mul 2 4) (make-integer 8)) (check-equal? (div 8 4) (make-integer 2)) (check-equal? (sine 1) (sin 1)) (check-equal? (cosine 1) (cos 1)) (check-equal? (arctangent 3 4) (atan 3 4)) (check-equal? (project 4.5) (make-rational 4 1)) (check-equal? (raise 4.5) (make-real 4.5)) (check-true (equ? 1 1)) (check-false (equ? 2 3)) ) (test-suite "reals" (check-equal? (add (make-real 1.5) (make-real 2.0)) 3.5) (check-equal? (sub (make-real 3.5) (make-real 2.0)) 1.5) (check-equal? (mul (make-real 1.25) (make-real 2.0)) 2.5) (check-equal? (div (make-real 5.0) (make-real 2.0)) 2.5) (check-equal? (sine (make-real 1.0)) (sin 1.0)) (check-equal? (cosine (make-real 1.0)) (cos 1.0)) (check-equal? (square-root (make-real 2.0)) (sqrt 2.0)) (check-equal? (arctangent (make-real 3.0) (make-real 4.0)) (atan 3.0 4.0)) (check-true (equ? (make-real 2.5) (make-real 2.5))) (check-false (equ? (make-real 2.0) (make-real 2.5))) (check-equal? (project (make-real 2.5)) 2.5) ) (test-suite "coercions among numbers" (check-equal? (div (make-integer 1) (make-integer 2)) (make-rational 1 2)) (check-equal? (add (make-integer 1) (make-rational 1 2)) (make-rational 3 2)) (check-equal? (add (make-integer 1) (make-real 2.5)) 3.5) (check-equal? (sine (make-integer 1)) (sin 1.0)) (check-equal? (sine (make-rational 2 2)) (sin 1.0)) (check-equal? (arctangent (make-integer 3) (make-integer 4)) (atan 3.0 4.0)) ) (test-suite "simplification" (check-equal? (simplify (make-rational 2 1)) (make-integer 2)) (check-equal? (simplify (/ 2 1)) (make-integer 2)) (check-equal? (simplify (make-real 4.0)) (make-integer 4)) (check-equal? (simplify 2.5) 2.5) (check-equal? (simplify (make-real 2.5)) 2.5) ) (test-suite "complex numbers with various coercions and simplifications" (check-equal? (add (make-complex (make-real 1.0) (make-real 2.0)) (make-complex (make-real 3.0) (make-real 4.0))) (make-complex (make-integer 4) (make-integer 6))) (check-equal? (sub (make-complex (make-real 3.0) (make-real 5.0)) (make-complex (make-real 1.0) (make-real 2.0))) (make-complex (make-integer 2) (make-integer 3))) (check-equal? (mul (make-complex (make-real 3.0) (make-real 4.0)) (make-complex (make-real 6.0) (make-real 8.0))) (make-complex-from-mag-ang (make-integer 50) (+ (atan 4.0 3.0) (atan 8.0 6.0)))) (check-equal? (div (make-complex (make-real 6.0) (make-real 8.0)) (make-complex (make-real 3.0) (make-real 4.0))) (make-integer 2)) (check-true (equ? (make-complex (make-real 1.0) (make-real 2.0)) (make-complex (make-real 1.0) (make-real 2.0)))) (check-true (equ? (make-complex (make-real 1.0) (make-real 2.0)) (make-complex (make-integer 1) (make-integer 2)))) (check-equal? (mul (make-complex-from-mag-ang (make-integer 2) (make-rational 2 1)) (make-complex-from-mag-ang (make-real 3) (make-real 4))) (make-complex-from-mag-ang (make-integer 6) (make-integer 6))) (check-equal? (real-part (make-complex-from-mag-ang (make-real 5) (make-real (atan 4 3)))) (* 5 (cos (atan 4 3)))) (check-equal? (imag-part (make-complex-from-mag-ang (make-real 5) (make-real (atan 4 3)))) (* 5 (sin (atan 4 3)))) (check-equal? (mul (make-complex-from-mag-ang (make-integer 2) (make-rational 2 1)) (make-complex-from-mag-ang 3 (make-real 4))) (make-complex-from-mag-ang (make-integer 6) (make-integer 6))) ) )) (run-tests sicp-2.86-tests) ================================================ FILE: scheme/sicp/02/tests/87-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../87.scm") (define (poly var . coeffs) (define (value coeff) (cond ((and (number? coeff) (integer? coeff)) (make-integer coeff)) ((number? coeff) (make-real coeff)) (else coeff))) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (value (car coeffs))) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (value (car coeffs))) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define sicp-2.87-tests (test-suite "Tests for SICP exercise 2.87" (test-suite "polynomials" (check-equal? (add (poly 'x 1 2 3) (poly 'x 4 5 6)) (poly 'x 5 7 9)) (check-equal? (mul (poly 'x 1 1) (poly 'x 1 -1)) (poly 'x 1 0 -1)) (check-equal? (mul (poly 'x 1 (poly 'y 1 0)) (poly 'x 1 (poly 'y 1 0))) (poly 'x 1 (poly 'y 2 0) (poly 'y 1 0 0))) ) (test-suite "type tower" (check-true (supertype? 'integer 'rational)) (check-true (supertype? 'integer 'real)) (check-true (supertype? 'integer 'complex)) (check-true (supertype? 'rational 'real)) (check-true (supertype? 'rational 'complex)) (check-true (supertype? 'real 'complex)) ) (test-suite "integers" (check-exn exn? (lambda () (make-integer 1.5))) (check-equal? (add (make-integer 1) (make-integer 2)) (make-integer 3)) (check-equal? (sub (make-integer 3) (make-integer 2)) (make-integer 1)) (check-equal? (mul (make-integer 2) (make-integer 4)) (make-integer 8)) (check-true (equ? (make-integer 1) (make-integer 1))) (check-false (equ? (make-integer 1) (make-integer 2))) (check-equal? (raise (make-integer 2)) (make-rational 2 1)) (check-true (=zero? (make-integer 0))) ) (test-suite "rationals" (check-exn exn? (lambda () (make-rational 1.5 1))) (check-exn exn? (lambda () (make-rational 1 1.5))) (check-equal? (add (make-rational 1 2) (make-rational 3 4)) (make-rational 5 4)) (check-equal? (sub (make-rational 3 4) (make-rational 1 2)) (make-rational 1 4)) (check-equal? (mul (make-rational 2 3) (make-rational 3 6)) (make-rational 1 3)) (check-equal? (div (make-rational 5 4) (make-rational 1 2)) (make-rational 5 2)) (check-equal? (raise (make-rational 5 2)) (make-real 2.5)) (check-true (equ? (make-rational 1 2) (make-rational 2 4))) (check-false (equ? (make-rational 1 2) (make-rational 1 3))) (check-equal? (project (make-rational 5 2)) (make-integer 2)) (check-true (=zero? (make-rational 0 1))) ) (test-suite "reals" (check-equal? (add (make-real 1.5) (make-real 2.0)) (make-real 3.5)) (check-equal? (sub (make-real 3.5) (make-real 2.0)) (make-real 1.5)) (check-equal? (mul (make-real 1.25) (make-real 2.0)) (make-real 2.5)) (check-equal? (div (make-real 5.0) (make-real 2.0)) (make-real 2.5)) (check-equal? (sine (make-real 1.0)) (make-real (sin 1.0))) (check-equal? (cosine (make-real 1.0)) (make-real (cos 1.0))) (check-equal? (square-root (make-real 2.0)) (make-real (sqrt 2.0))) (check-equal? (arctangent (make-real 3.0) (make-real 4.0)) (make-real (atan 3.0 4.0))) (check-true (equ? (make-real 2.5) (make-real 2.5))) (check-false (equ? (make-real 2.0) (make-real 2.5))) (check-equal? (project (make-real 2.5)) (make-rational 2 1)) (check-true (=zero? (make-real 0.0))) ) (test-suite "coercions among numbers" (check-equal? (div (make-integer 1) (make-integer 2)) (make-rational 1 2)) (check-equal? (add (make-integer 1) (make-rational 1 2)) (make-rational 3 2)) (check-equal? (add (make-integer 1) (make-real 2.5)) (make-real 3.5)) (check-equal? (sine (make-integer 1)) (make-real (sin 1.0))) (check-equal? (sine (make-rational 2 2)) (make-real (sin 1.0))) (check-equal? (arctangent (make-integer 3) (make-integer 4)) (make-real (atan 3.0 4.0))) ) (test-suite "simplification" (check-equal? (simplify (make-rational 2 1)) (make-integer 2)) (check-equal? (simplify (make-real 4.0)) (make-integer 4)) (check-equal? (simplify (make-real 2.5)) (make-real 2.5)) ) )) (run-tests sicp-2.87-tests) ================================================ FILE: scheme/sicp/02/tests/88-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../88.scm") (define (poly var . coeffs) (define (value coeff) (cond ((and (number? coeff) (integer? coeff)) (make-integer coeff)) ((number? coeff) (make-real coeff)) (else coeff))) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (value (car coeffs))) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (value (car coeffs))) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define sicp-2.88-tests (test-suite "Tests for SICP exercise 2.88" (test-suite "polynomials" (check-equal? (add (poly 'x 1 2 3) (poly 'x 4 5 6)) (poly 'x 5 7 9)) (check-equal? (mul (poly 'x 1 1) (poly 'x 1 -1)) (poly 'x 1 0 -1)) (check-equal? (mul (poly 'x 1 (poly 'y 1 0)) (poly 'x 1 (poly 'y 1 0))) (poly 'x 1 (poly 'y 2 0) (poly 'y 1 0 0))) (check-equal? (neg (poly 'x 1 -2 3)) (poly 'x -1 2 -3)) (check-equal? (sub (poly 'x 4 4 4) (poly 'x 3 2 1)) (poly 'x 1 2 3)) ) (test-suite "type tower" (check-true (supertype? 'integer 'rational)) (check-true (supertype? 'integer 'real)) (check-true (supertype? 'rational 'real)) ) (test-suite "integers" (check-exn exn? (lambda () (make-integer 1.5))) (check-equal? (add (make-integer 1) (make-integer 2)) (make-integer 3)) (check-equal? (sub (make-integer 3) (make-integer 2)) (make-integer 1)) (check-equal? (mul (make-integer 2) (make-integer 4)) (make-integer 8)) (check-equal? (neg (make-integer 1)) (make-integer -1)) (check-true (equ? (make-integer 1) (make-integer 1))) (check-false (equ? (make-integer 1) (make-integer 2))) (check-equal? (raise (make-integer 2)) (make-rational 2 1)) (check-true (=zero? (make-integer 0))) ) (test-suite "rationals" (check-exn exn? (lambda () (make-rational 1.5 1))) (check-exn exn? (lambda () (make-rational 1 1.5))) (check-equal? (add (make-rational 1 2) (make-rational 3 4)) (make-rational 5 4)) (check-equal? (sub (make-rational 3 4) (make-rational 1 2)) (make-rational 1 4)) (check-equal? (mul (make-rational 2 3) (make-rational 3 6)) (make-rational 1 3)) (check-equal? (div (make-rational 5 4) (make-rational 1 2)) (make-rational 5 2)) (check-equal? (neg (make-rational 1 2)) (make-rational -1 2)) (check-equal? (raise (make-rational 5 2)) (make-real 2.5)) (check-true (equ? (make-rational 1 2) (make-rational 2 4))) (check-false (equ? (make-rational 1 2) (make-rational 1 3))) (check-equal? (project (make-rational 5 2)) (make-integer 2)) (check-true (=zero? (make-rational 0 1))) ) (test-suite "reals" (check-equal? (add (make-real 1.5) (make-real 2.0)) (make-real 3.5)) (check-equal? (sub (make-real 3.5) (make-real 2.0)) (make-real 1.5)) (check-equal? (mul (make-real 1.25) (make-real 2.0)) (make-real 2.5)) (check-equal? (div (make-real 5.0) (make-real 2.0)) (make-real 2.5)) (check-equal? (neg (make-real 2.5)) (make-real -2.5)) (check-equal? (sine (make-real 1.0)) (make-real (sin 1.0))) (check-equal? (cosine (make-real 1.0)) (make-real (cos 1.0))) (check-equal? (square-root (make-real 2.0)) (make-real (sqrt 2.0))) (check-equal? (arctangent (make-real 3.0) (make-real 4.0)) (make-real (atan 3.0 4.0))) (check-true (equ? (make-real 2.5) (make-real 2.5))) (check-false (equ? (make-real 2.0) (make-real 2.5))) (check-equal? (project (make-real 2.5)) (make-rational 2 1)) (check-true (=zero? (make-real 0.0))) ) (test-suite "coercions among numbers" (check-equal? (div (make-integer 1) (make-integer 2)) (make-rational 1 2)) (check-equal? (add (make-integer 1) (make-rational 1 2)) (make-rational 3 2)) (check-equal? (add (make-integer 1) (make-real 2.5)) (make-real 3.5)) (check-equal? (sine (make-integer 1)) (make-real (sin 1.0))) (check-equal? (sine (make-rational 2 2)) (make-real (sin 1.0))) (check-equal? (arctangent (make-integer 3) (make-integer 4)) (make-real (atan 3.0 4.0))) ) (test-suite "simplification" (check-equal? (simplify (make-rational 2 1)) (make-integer 2)) (check-equal? (simplify (make-real 4.0)) (make-integer 4)) (check-equal? (simplify (make-real 2.5)) (make-real 2.5)) ) )) (run-tests sicp-2.88-tests) ================================================ FILE: scheme/sicp/02/tests/89-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../89.scm") (define (poly var . coeffs) (define (value coeff) (cond ((and (number? coeff) (integer? coeff)) (make-integer coeff)) ((number? coeff) (make-real coeff)) (else coeff))) (make-polynomial var (map value coeffs))) (define sicp-2.89-tests (test-suite "Tests for SICP exercise 2.89" (test-suite "polynomials" (check-equal? (add (poly 'x 1 2 3) (poly 'x 4 5 6)) (poly 'x 5 7 9)) (check-equal? (mul (poly 'x 1 1) (poly 'x 1 -1)) (poly 'x 1 0 -1)) (check-equal? (mul (poly 'x 1 (poly 'y 1 0)) (poly 'x 1 (poly 'y 1 0))) (poly 'x 1 (poly 'y 2 0) (poly 'y 1 0 0))) (check-equal? (neg (poly 'x 1 -2 3)) (poly 'x -1 2 -3)) (check-equal? (sub (poly 'x 4 4 4) (poly 'x 3 2 1)) (poly 'x 1 2 3)) (check-equal? (sub (poly 'x 3 3 3) (poly 'x 3 2 1)) (poly 'x 1 2)) ) )) (run-tests sicp-2.89-tests) ================================================ FILE: scheme/sicp/02/tests/90-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../90.scm") (define (t order n) (list order (make-integer n))) (define (sparse . terms) (cons 'sparse terms)) (define (dense . coeffs) (cons 'dense (map make-integer coeffs))) (define (poly var term-list) (make-polynomial var term-list)) (define sicp-2.90-tests (test-suite "Tests for SICP exercise 2.90" (test-suite "sparse representation" (check-true (empty-termlist? (the-empty-sparse-termlist))) (check-equal? (first-term (sparse (t 2 1))) (t 2 1)) (check-equal? (rest-terms (sparse (t 2 1) (t 1 2))) (sparse (t 1 2))) (check-equal? (adjoin-term (t 2 2) (sparse (t 1 1))) (sparse (t 2 2) (t 1 1))) (check-equal? (adjoin-term (t 2 0) (sparse (t 1 1))) (sparse (t 1 1))) (check-equal? (adjoin-term (t 1 -1) (sparse (t 2 1) (t 1 1) (t 0 1))) (sparse (t 2 1) (t 0 1))) ) (test-suite "dense representation" (check-true (empty-termlist? (the-empty-dense-termlist))) (check-equal? (first-term (dense 10 20 30)) (t 2 10)) (check-equal? (rest-terms (dense 10 20 30)) (dense 20 30)) (check-equal? (adjoin-term (t 2 1) (dense 1)) (dense 1 0 1)) (check-equal? (adjoin-term (t 0 1) (dense 1 1)) (dense 1 2)) (check-equal? (adjoin-term (t 0 1) (dense 1 0 0)) (dense 1 0 1)) (check-equal? (adjoin-term (t 2 0) (dense 1)) (dense 1)) ) (test-suite "polynomial operations" (check-equal? (add (poly 'x (sparse (t 2 1))) (poly 'x (sparse (t 1 0)))) (poly 'x (sparse (t 2 1) (t 1 0)))) (check-equal? (mul (poly 'x (sparse (t 1 1) (t 0 1))) (poly 'x (sparse (t 1 1) (t 0 -1)))) (poly 'x (sparse (t 2 1) (t 0 -1)))) (check-equal? (sub (poly 'x (sparse (t 2 3) (t 1 3) (t 0 3))) (poly 'x (sparse (t 2 3) (t 1 2) (t 0 1)))) (poly 'x (sparse (t 1 1) (t 0 2)))) (check-equal? (add (poly 'x (dense 2 0)) (poly 'x (dense 1))) (poly 'x (dense 2 1))) (check-equal? (mul (poly 'x (dense 1 1)) (poly 'x (dense 1 -1))) (poly 'x (dense 1 0 -1))) ) )) (run-tests sicp-2.90-tests) ================================================ FILE: scheme/sicp/02/tests/91-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../91.scm") (define (poly var . coeffs) (define (value coeff) (cond ((and (number? coeff) (integer? coeff)) (make-integer coeff)) ((number? coeff) (make-real coeff)) (else coeff))) (make-polynomial var (map value coeffs))) (define sicp-2.91-tests (test-suite "Tests for SICP exercise 2.91" (check-equal? (add (poly 'x 1 2 3) (poly 'x 4 5 6)) (poly 'x 5 7 9)) (check-equal? (mul (poly 'x 1 1) (poly 'x 1 -1)) (poly 'x 1 0 -1)) (check-equal? (mul (poly 'x 1 (poly 'y 1 0)) (poly 'x 1 (poly 'y 1 0))) (poly 'x 1 (poly 'y 2 0) (poly 'y 1 0 0))) (check-equal? (neg (poly 'x 1 -2 3)) (poly 'x -1 2 -3)) (check-equal? (sub (poly 'x 4 4 4) (poly 'x 3 2 1)) (poly 'x 1 2 3)) (check-equal? (sub (poly 'x 3 3 3) (poly 'x 3 2 1)) (poly 'x 1 2)) (check-equal? (div (poly 'x 1 0 0 0 0 -1) (poly 'x 1 0 -1)) (list (poly 'x 1 0 1 0) (poly 'x 1 -1))) )) (run-tests sicp-2.91-tests) ================================================ FILE: scheme/sicp/02/tests/92-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../92.scm") (define (poly var . coeffs) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (car coeffs)) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (car coeffs)) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define sicp-2.92-tests (test-suite "Tests for SICP exercise 2.92" (check-equal? (add (poly 'x 1 0) (poly 'y 1 0)) (poly 'x 1 (poly 'y 1 0))) (check-equal? (add (poly 'y 1 0) (poly 'x 1 0)) (poly 'x 1 (poly 'y 1 0))) (check-equal? (mul (poly 'x 1 2 0) (poly 'y 1 0)) (poly 'x (poly 'y 1 0) (poly 'y 2 0) 0)) (check-equal? (mul (poly 'y 1 0) (poly 'x 1 2 0)) (poly 'x (poly 'y 1 0) (poly 'y 2 0) 0)) (check-equal? (sub (poly 'x 1 0) (poly 'y 1 0)) (poly 'x 1 (poly 'y -1 0))) (check-equal? (sub (poly 'y 1 0) (poly 'x 1 0)) (poly 'x -1 (poly 'y 1 0))) )) (run-tests sicp-2.92-tests) ================================================ FILE: scheme/sicp/02/tests/93-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../93.scm") (define (poly var . coeffs) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (car coeffs)) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (car coeffs)) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define sicp-2.93-tests (test-suite "Tests for SICP exercise 2.93" (test-suite "rationals" (check-equal? (add (make-rational 1 2) (make-rational 3 4)) (make-rational 10 8)) (check-equal? (sub (make-rational 3 4) (make-rational 1 2)) (make-rational 2 8)) (check-equal? (mul (make-rational 2 3) (make-rational 4 5)) (make-rational 8 15)) (check-equal? (div (make-rational 2 3) (make-rational 4 5)) (make-rational 10 12)) ) (test-suite "rational functions" (check-equal? (add (make-rational (poly 'x 1 0 1) (poly 'x 1 0 0 1)) (make-rational (poly 'x 1 0 1) (poly 'x 1 0 0 1))) (make-rational (poly 'x 2 0 2 2 0 2) (poly 'x 1 0 0 2 0 0 1))) ) )) (run-tests sicp-2.93-tests) ================================================ FILE: scheme/sicp/02/tests/94-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../94.scm") (define (poly var . coeffs) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (car coeffs)) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (car coeffs)) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define sicp-2.94-tests (test-suite "Tests for SICP exercise 2.94" (check-equal? (greatest-common-divisor 10 6) 2) (check-equal? (greatest-common-divisor (poly 'x 1 -1 -2 2) (poly 'x 1 0 -1)) (poly 'x -1 1)) (check-equal? (greatest-common-divisor (poly 'x 1 0 -1) (poly 'x 1 -1 -2 2)) (poly 'x -1 1)) )) (run-tests sicp-2.94-tests) ================================================ FILE: scheme/sicp/02/tests/96-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../96.scm") (define (poly var . coeffs) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (car coeffs)) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (car coeffs)) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define p1 (poly 'x 1 -2 1)) (define p2 (poly 'x 11 0 7)) (define p3 (poly 'x 13 5)) (define q1 (mul p1 p2)) (define q2 (mul p1 p3)) (define sicp-2.96-tests (test-suite "Tests for SICP exercise 2.96" (check-equal? (greatest-common-divisor q1 q2) p1) )) (run-tests sicp-2.96-tests) ================================================ FILE: scheme/sicp/02/tests/97-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../97.scm") (define (poly var . coeffs) (define (to-term-list coeffs) (cond ((null? coeffs) '()) ((=zero? (car coeffs)) (to-term-list (cdr coeffs))) (else (cons (list (- (length coeffs) 1) (car coeffs)) (to-term-list (cdr coeffs)))))) (make-polynomial var (to-term-list coeffs))) (define sicp-2.97-tests (test-suite "Tests for SICP exercise 2.97" (check-equal? (make-rational 8 10) (make-rational 4 5)) (check-equal? (reduce (poly 'x 1 2 1) (poly 'x 1 0 -1)) (list (poly 'x 1 1) (poly 'x 1 -1))) (check-equal? (add (make-rational (poly 'x 1 1) (poly 'x 1 0 0 -1)) (make-rational (poly 'x 1 0) (poly 'x 1 0 -1))) (make-rational (poly 'x -1 -2 -3 -1) (poly 'x -1 -1 0 1 1))) )) (run-tests sicp-2.97-tests) ================================================ FILE: scheme/sicp/03/01.scm ================================================ ; SICP exercise 3.01 ; ; An accumulator is a procedure that is called repeatedly with a single ; numeric argument and accumulates its arguments into a sum. Each time it is ; called, it returns the currently accumulated sum. Write a procedure ; make-acumulator that generates accumulators, each maintaining an independent ; sum. The input to make-accumulator should specify the initial value of the ; sum; for example ; ; (define A (make-accumulator 5)) ; ; (A 10) ; 15 ; ; (A 10) ; 25 (define (make-accumulator amount) (lambda (value) (set! amount (+ amount value)) amount)) ================================================ FILE: scheme/sicp/03/02.scm ================================================ ; SICP exercise 3.02 ; ; In software-testing applications, it is useful to be able to count the ; number of times a given procedure is caled during the course of a ; computation. Write a procedure make-monitored that takes as input a ; procedure, f, that itself takes one input.The result returned by ; make-monitored is a third procedure, say mf, that keeps track of the number ; of times is has been called by a maintaining an internal counter. If the ; input to mf is the special symbol how-many-calls?, then mf returns the value ; of the counter. If the input is the special symbol reset-count, then mf ; resets the counter to zero. For any other input, mf returns the result of ; calling f on that input and increments the counter. For instance, we sould ; make a monitored version of the sqrt procedure: ; ; (define s (make-monitored sqrt)) ; ; (s 100) ; 10 ; ; (s 'how-many-calls?) ; 1 (define (make-monitored function) (let ((count 0)) (lambda (arg) (cond ((eq? arg 'how-many-calls?) count) ((eq? arg 'reset-count) (set! count 0)) (else (set! count (+ count 1)) (function arg)))))) ================================================ FILE: scheme/sicp/03/03.scm ================================================ ; SICP exercise 3.03 ; ; Modify the make-account procedure so that is creates password-protected ; accounts. That is, make-account should take a sumbol as an additional ; argument, as in: ; ; (define acc (make-account 100 'secret-password)) ; ; The resulting account object should process a request only if it is ; accompanied by the password with which the account was created, and should ; otherwise return a complaint: ; ; ((acc 'secret-password 'withdraw) 40) ; 60 ; ; ((acc 'some-other-password 'deposit) 50) ; "Incorect password" (define (make-account balance account-password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (unauthorized amount) "Incorrect password") (define (dispatch message password) (cond ((not (eq? account-password password)) unauthorized) ((eq? message 'withdraw) withdraw) ((eq? message 'deposit) deposit) (else (error "Unknown request - MAKE-ACCOUNT" m)))) dispatch) ================================================ FILE: scheme/sicp/03/04.scm ================================================ ; SICP exercise 3.04 ; ; Modify the make-account procedure of exercise 3.3 by adding another local ; state variable so that, if an account is accessed more than seven ; consecutive times with an incorrect password, it invokes the procedure ; call-the-cops. (define (make-account balance account-password) (define consecuitive-failed-attempts 0) (define (withdraw amount) (set! consecuitive-failed-attempts 0) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! consecuitive-failed-attempts 0) (set! balance (+ balance amount)) balance) (define (unauthorized amount) (set! consecuitive-failed-attempts (+ consecuitive-failed-attempts 1)) (if (>= consecuitive-failed-attempts 7) (call-the-cops) #f) "Incorrect password") (define (dispatch message password) (cond ((not (eq? account-password password)) unauthorized) ((eq? message 'withdraw) withdraw) ((eq? message 'deposit) deposit) (else (error "Unknown request - MAKE-ACCOUNT" m)))) dispatch) ================================================ FILE: scheme/sicp/03/05.scm ================================================ ; SICP exercise 3.05 ; ; Monte Carlo integration is a method of estimating definite integrals by ; means of Monte Carlo simulation. Consider computing the area of a region of ; space described by a predicate P(x,y) that is true for points (x,y) in the ; region and false for points not in the region. For example, the region ; contained within a circle of radius 3 centered at (5,7) is described by the ; predicate that tests whether (x - 5)² + (y - 7)² ≤ 3². To estimate the area ; of the region described by such a predicate, begin by choosing a rectangle ; that contins the region. For example, a rectangle with diagonally opposite ; corners at (2,4) and (8,10) contains the circle above. The desired integral ; is the area of that portion of the rectangle that lies in the region. We can ; estimate the integral by picking, at random, points (x,y) that lie in the ; rectangle, and testing P(x,y) for each point to determine whether the point ; lies in the region. If we try this with many points, then the fraction of ; points that fall in the region should give an estimate of the proportion of ; the rectangle that lies in the region. Hence, multiplying this fraction by ; the area of the entire rectangle should produce an estimate of the integral. ; ; Implement Monte Carlo integration as a procedure estimate-integral that ; takes as arguments a predicate P, upper and lower bounds x1, x2, y1 and y2 ; for the rectangle, and the number of trials to perform in order to produce ; the estimate. Your procedure should use the same monte-carlo procedure that ; was used above to estimate π. Use your estimate-integral to produce an ; estimate of π by measuring the area of a unit circle. ; ; You will find it useful to have a procedure that returns a number chosen at ; random for a given range. The following random-in-range procedure implements ; this in terms of the random procedure used in section 1.2.6, which returns a ; nonnegative number less than its input. ; ; (define (random-in-range low high) ; (let ((range (- high low))) ; (+ low (random range)))) (define (monte-carlo trials experiment) (define (iter trials-remaining trials-passed) (cond ((= trials-remaining 0) (/ trials-passed trials)) ((experiment) (iter (- trials-remaining 1) (+ trials-passed 1))) (else (iter (- trials-remaining 1) trials-passed)))) (iter trials 0)) (define (estimate-integral predicate x1 x2 y1 y2 trials) (monte-carlo trials (lambda () (predicate (random-in-range x1 x2) (random-in-range y1 y2))))) (define (random-in-range low high) (+ (* (random) (- high low)) low)) (define (estimate-pi) (define (circle x y) (<= (+ (* x x) (* y y)) 1)) (* (estimate-integral circle -1 1 -1 1 1000000) 4.0)) ================================================ FILE: scheme/sicp/03/06.scm ================================================ ; SICP exercise 3.06 ; ; It is useful to be able to reset a random-number generator to produce a ; sequence starting from a given value. Design a new rand procedure that is ; called with an argument that is either the symbol generate or the symbol ; reset and behaves as follows: (rand 'generate) produces a new random number; ; ((rand 'reset) ) resets the internal state variable to the ; designated . Thus, by resetting the state, one can generate ; repeateble sequences. These are very handy to have when testing and ; debugging programs that use random numbers. (define seed (current-milliseconds)) (define (rand-update number) (let ((modulus 4294967296) (multiplier 1664525) (increment 1013904223)) (modulo (+ (* multiplier number) increment) modulus))) (define rand (let ((x seed)) (lambda (message) (cond ((eq? message 'generate) (set! x (rand-update x)) x) ((eq? message 'reset) (lambda (new-value) (set! x new-value))) (else (error "Unknown request - RAND" message)))))) ================================================ FILE: scheme/sicp/03/07.scm ================================================ ; SICP exercise 3.07 ; ; Consider the bank account objects created by make-account, with the password ; modification described in exercise 3.3. Suppose that our banking system ; requires the ability to make joint accounts. Define a procedure make-joint ; that accomplishes this. make-joint should take three arguments. The first is ; a password-protected account. The second argument must match the password ; with which the account was defined in order for the make-joint operation to ; proceed. The third argument is a new password. make-joint is to create an ; additional access to the original account using the new password. For ; example, if peter-acc is a bank account with password open-sesame, then ; ; (define paul-acc ; (make-joint peter-acc 'open-sesame 'rosebud)) ; ; will allow one to make transaction on peter-acc using the name paul-acc and ; the password rosebud. You may wish to modify your solution to exercise 3.3 ; to accommodate for this new feature. (define (make-account balance account-password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (unauthorized amount) "Incorrect password") (define (dispatch message password) (cond ((not (eq? account-password password)) unauthorized) ((eq? message 'withdraw) withdraw) ((eq? message 'deposit) deposit) (else (error "Unknown request - MAKE-ACCOUNT" m)))) dispatch) (define (make-joint account original-password new-password) (lambda (message password) (if (eq? password new-password) (account message original-password) (lambda (amount) "Incorrect password")))) ================================================ FILE: scheme/sicp/03/08.scm ================================================ ; SICP exercise 3.08 ; ; When we defined the evaluation model in section 1.1.3, we said that the ; first step in evaluating an expression is to evaluate its subexpressions. ; But we never specified the order in which the subexpressions should be ; evaluated (e.g., left to right or right to left). When we introduce ; assignment, the order in which the arguments to a procedure are evaluated ; can make a difference to the result. Define a simple procedure f such that ; evaluating ; ; (+ (f 0) (f 1)) ; ; will return 0 if the arguments to + are evaluted from left to right but will ; return 1 if the arguments are evaluated from right to left. (define f (let ((current 0)) (lambda (number) (let ((existing current)) (set! current number) existing)))) ================================================ FILE: scheme/sicp/03/09.scm ================================================ ; SICP exercise 3.09 ; ; In section 1.2.1 we used the substitution model to analyze two procedures ; for computing factorials, a recursive version ; ; (define (factorial n) ; (if (= n 1) ; 1 ; (* n (factorial (- n 1))))) ; ; and an iterative version ; ; (define (factorial n) ; (fact-iter 1 1 n)) ; ; (define (fact-iter product counter max-count) ; (if (> counter max-count) ; product ; (fact-iter (* counter product) ; (+ counter 1) ; max-count))) ; ; Show the environment structures created by evaluating (factorial 6) using ; each version of the factorial procedure. ; With the first version, we have the following environments on each call: ; ; +------+ +------+ +------+ +------+ +------+ +------+ ; | n: 6 | | n: 5 | | n: 4 | | n: 3 | | n: 2 | | n: 1 | ; +------+ +------+ +------+ +------+ +------+ +------+ ; ; With the second version, we have the following environments: ; ; +---------------------------------------------------------------------+ ; | factorial: | ; | fact-iter: | ; +---------------------------------------------------------------------+ ; ^ ^ ^ ^ ^ ; | | | | | ; +--------------+ +---------------+ +----------------+ | | ; | product: 1 | | product: 1 | | product: 2 | | +------+ ; | counter: 1 | | counter: 2 | | counter: 3 | | | n: 6 | ; | max-count: 6 | | max-count: 6 | | max-count: 6 | | +------+ ; +--------------+ +---------------+ +----------------+ | (factorial) ; | ; +------------------+--------------------+-----------+--------+ ; | | | | ; +--------------+ +---------------+ +----------------+ +----------------+ ; | product: 6 | | product: 24 | | product: 120 | | product: 720 | ; | counter: 4 | | counter: 5 | | counter: 6 | | counter: 7 | ; | max-count: 6 | | max-count: 6 | | max-count: 6 | | max-count: 6 | ; +--------------+ +---------------+ +----------------+ +----------------+ ================================================ FILE: scheme/sicp/03/10.scm ================================================ ; SICP exercise 3.10 ; ; In the make-withdraw procedure, the local variable balance is created as a ; parameter of make-withdraw. We could also create the local state variable ; explicitly, using let, as follows: ; ; (define (make-withdraw initial-amount) ; (let ((balance initial-amount)) ; (lambda (amount) ; (>= balance amount) ; (being (set! balance (- balance amount)) ; (balance) ; "Insufficient funds")))) ; ; Recall from section 1.3.2 that let is simply syntactic sugar for a procedure ; call: ; ; (let (( )) ) ) = balance amount) ; (begin (set! balance (- balance amount)) ; balance) ; "Insufficient funds")) ; ; After the withdraw, we get the following: ; ; global-env: +-----------------------------------------------------------------------+ ; | W1 W2 | ; +-|------------------------------|--------------------------------------+ ; | +---------------------+ | +---------------------+ ; | | initial-amount: 100 | | | initial-amount: 100 | ; | +---------------------+ | +---------------------+ ; | ^ | ^ ; | | | | ; | +---------------------+ | +---------------------+ ; | | amount: 50 | | | amount: 100 | ; | +---------------------+ | +---------------------+ ; | ^ | ^ ; | | | | ; +--------+ | +--------+ | ; | lambda |-----+ | lambda |-----+ ; +--------+ +--------+ ; | | ; parameters: amount parameters: amount ; body: ... body: ... ; ; The difference is that this version creates one additional frame that holds ; the amount. That way the initial amount is still available, although not ; used in the code we currently have. Since the initial-amount is not used, we ; can safely ignore it. Since this version is only modifying the second frame ; in a manner, similar to the previous version, the behavior of the two ; version is the same. ================================================ FILE: scheme/sicp/03/11.scm ================================================ ; SICP exercise 3.11 ; ; In section 3.2.3 we saw how the environment model described the behavior of ; procedures with local state. Now we have seen how internal definitions work. ; A typical message-passing procedure contains both of these aspects. Consider ; the bank account procedure of section 3.1.1: ; ; (define (make-account balance) ; (define (withdraw amount) ; (if (>= balance amount) ; (begin (set! balance (- balance amount)) ; balance) ; "Insufficient funds")) ; (define (deposit amount) ; (set! balance (+ balance amount)) ; balance) ; (define (dispatch m) ; (cond ((eq? m 'withdraw) withdraw) ; ((eq? m 'deposit) deposit) ; (else (error "Unknown request - MAKE-ACCOUNT" m)))) ; dispatch) ; ; Show the environment structure generated by the sequence of interactions ; ; (define (acc (make-account 50))) ; ; ((acc 'deposit) 40) ; 90 ; ; ((acc 'withdraw) 60) ; 30 ; ; Where is the local state for acc kept? Suppose we define another account ; ; (define acc2 (make-account 100)) ; ; How are the local states for the two accounts kept distinct? Which parts of ; the environment structure are shared between acc and acc2? ; Here's the environment structure: ; ; globals: ; +--------------------------------------------------------------+ ; | make-account: | ; | acc: | ; +--|-----------------------------------------------------------+ ; | ^ ; | | +------------------------------+ ; | acc: | | | ; | +-----------------------+ | ; | | balance: 30 | +-----------+ | ; | | withdraw: --------| procedure ----+ ; | | deposit: -----+ +-----------+ ; | | dispatch: | | parameters: amount ; | +-|---------------------+ | body: (if (>= balance amount) ; | | ^ ^ | (being (set! balance (- balance amount)) ; | | | | | balance) ; | | | | | "Insufficient funds") ; | | | | | ; | | | | +-----------+ ; | | | +---- procedure | ; | | | +-----------+ ; | | | parameters: amount ; | | | body: (set! balance (+ balance amount)) ; | | | balance ; +-----------+ | ; | procedure ---+ ; +-----------+ ; parameters: m ; code: (cond ((eq? m 'withdraw) withdraw) ; ((eq? m 'deposit) deposit) ; ((else error "Unknown require - MAKE-ACCOUNT" m))) ; ; The local state of acc is kept within the frame created by calling ; make-account. If we define acc2, the whole structure (apart form globals) ; would be replicated and there would be a similar procedure with a similar ; frame that stores the ammount of acc2 and all the procedures that manipulate ; it. The only part of the environment that is shared is the globals. ================================================ FILE: scheme/sicp/03/12.scm ================================================ ; SICP exercise 3.12 ; ; The following procedure for appending lists was introduced in section 2.2.1: ; (define (append x y) ; (if (null? x) ; y ; (cons (car x) (append (cdr x) y)))) ; ; append forms a new list by succesively consing the elements of x onto y. The ; procedure append! is similar to append, but it is a mutator rather than a ; constructor. It appends the lists by splicing them together, modifying the ; final pair of x so that its cdr is not y. (It is an error to call append! ; with an empty x.) ; ; (define (append! x y) ; (set-cdr! (last-pair x) y) ; x) ; ; Here last-pair is a procedure that returns the last pair in its argument: ; ; (define (last-pair x) ; (if (null? (cdr x)) ; x ; (last-pair (cdr x)))) ; ; Consider the interaction ; ; (define x (list 'a 'b)) ; (define y (list 'c d)) ; (define z (append x y)) ; ; z ; (a b c d) ; ; (cdr x) ; ; ; (define w (append! x y)) ; ; w ; (a b c d) ; ; (cdr x) ; ; ; What are the missing s? Draw box-and-pointer diagrams to explain ; your answer. ; The first missing response is: (b) ; The second missing response is: (b c d) ; ; Here's how everything looks before calling append!: ; ; +---+---+ +---+---+ ; x --> | . | . ------| . | / | ; +-|-+---+ +-|-+---+ ; | | ; +---+ +---+ ; | a | | b | ; +---+ +---+ ; ; +---+---+ +---+---+ y --> +---+---+ +---+---+ ; z --> | . | . ------| . | . -----------| . | . ------| . | / | ; +-|-+---+ +-|-+---+ +-|-+---+ +-|-+---+ ; | | | | ; +---+ +---+ +---+ +---+ ; | a | | b | | c | | d | ; +---+ +---+ +---+ +---+ ; ; When we call append!, the pairs look like this: ; ; w --> +---+---+ +---+---+ ; x --> | . | . ------| . | . -------------+ ; +-|-+---+ +-|-+---+ | ; | | | ; +---+ +---+ | ; | a | | b | | ; +---+ +---+ | ; | ; +---+---+ +---+---+ y --> +---+---+ +---+---+ ; z --> | . | . ------| . | . -----------| . | . ------| . | / | ; +-|-+---+ +-|-+---+ +-|-+---+ +-|-+---+ ; | | | | ; +---+ +---+ +---+ +---+ ; | a | | b | | c | | d | ; +---+ +---+ +---+ +---+ ================================================ FILE: scheme/sicp/03/13.scm ================================================ ; SICP exercise 3.13 ; ; Consider the following make-cycle procedure, which uses the last-pair ; procedure defined in exercise 3.12: ; ; (define (make-cycle x) ; (set-cdr! (last-pair x) x) ; x) ; ; Draw a box-and-pointer diagram that shows the structure z created by ; ; (define z (make-cycle (list 'a 'b 'c))) ; ; What happens if we try to compute (last-pair z)? ; Here's the diagram: ; ; +----------------------------------+ ; | | ; +---+---+ +---+---+ +---+---+ | ; z --> | . | . -----| . | . -----| . | . ---+ ; +-|-+---+ +-|-+---+ +-|-+---+ ; | | | ; +---+ +---+ +---+ ; | a | | b | | c | ; +---+ +---+ +---+ ; ; If we try to compute (last-pair z), it will end up in an infinite recursion, ; because there is no pair with a cdr that is null. ================================================ FILE: scheme/sicp/03/14.scm ================================================ ; SICP exercise 3.14 ; ; The following procedure is quite useful, although obscure: ; ; (define (mystery x) ; (define (loop x y) ; (if (null? x) ; y ; (let ((temp (cdr x))) ; (set-cdr! x y) ; (loop temp x)))) ; (loop 'x ())) ; ; loop uses the "temporary variable temp to hold the old value of the cdr of ; x, since the set-cdr! on the next line destroys the cdr. Explain what ; mystery does in general. Suppose v is defined by ; ; (define v (list 'a 'b 'c 'd)) ; ; Draw the box-and-pointer diagram that represents the list to which v is ; bound. Suppose that we now evaluate (define w (mystery v)). Draw ; box-and-pointer diagrams that show the structures v and w after evaluating ; this expression. What would be printed as the values of v and w? ; Here's the box and pointer diagram for v: ; ; +---+---+ +---+---+ +---+---+ +---+---+ ; v ---> | . | . -----| . | . -----| . | . -----| . | / | ; +-|-+---+ +-|-+---+ +-|-+---+ +-|-+---+ ; | | | | ; +---+ +---+ +---+ +---+ ; | a | | b | | c | | d | ; +---+ +---+ +---+ +---+ ; ; This is what happens after we call mystery: ; ; +---------------+ +----------+ +----------------+ ; | | | | | | ; +---+---+ +---+|--+ +---+|--+ +---+-|-+ ; v ---> | . | / | | . | . | | . | . | w ---> | . | . | ; +-|-+---+ +-|-+---+ +-|-+---+ +-|-+---+ ; | | | | ; +---+ +---+ +---+ +---+ ; | a | | b | | c | | d | ; +---+ +---+ +---+ +---+ ; ; In general, mystery reverses the list in space. It sets the cdr of the ; second element to the first, then the cdr of the third element to the second ; and so on. When it runs out of elements, it returns the last. ; ; In the end, the values are: ; ; w: (d c b a) ; v: (a) ================================================ FILE: scheme/sicp/03/15.scm ================================================ ; SICP exercise 3.15 ; ; Draw box-and-pointer diagrams to explain the effect of set-to-wow! on the ; structures z1 and z2 above. ; Here is how the structures look before calling set-to-wow!: ; ; +---+---+ +---+---+ +---+---+ +---+---+ ; z1 ---> | . | . | z2 ---> | . | . -----| . | . -----| . | / | ; +-|-+-|-+ +-|-+---+ +-|-+---+ +-|-+---+ ; | | | | | ; +---+---+ +---+---+ | +---+ +---+ ; x ---> | . | . -----| . | / | | | a | | b | ; +-|-+---+ +-|-+---+ | +---+ +---+ ; | | | | | ; +---+ +---+ | +-|-+---+ +-|-+---+ ; | a | | b | +----------| . | . -----| . | / | ; +---+ +---+ +---+---+ +---+---+ ; ; Here's what happens after the two calls to set-to-wow!: ; ; +---+---+ +---+---+ +---+---+ +---+---+ ; z1 ---> | . | . | z2 ---> | . | . -----| . | . -----| . | / | ; +-|-+-|-+ +-|-+---+ +-|-+---+ +-|-+---+ ; | | | | | ; +---+---+ +---+---+ | +---+ +---+ ; x ---> | . | . -----| . | / | | | a | | b | ; +-|-+---+ +-|-+---+ | +---+ +---+ ; | | | | ; +-----+ +---+ | +---+---+ +-|-+---+ ; | wow | | b | +----------| . | . -----| . | / | ; +-----+ +---+ +-|-+---+ +---+---+ ; | ; +-----+ ; | wow | ; +-----+ ================================================ FILE: scheme/sicp/03/16.scm ================================================ ; SICP exercise 3.16 ; ; Ben Bitdiddle decides to write a procedure to count the number of pairs in ; any list structure. "It's easy," he reasons. "The number of pairs in any ; structure is the number in the car plus the number in the cdr plus one more ; to count the current pair." So Ben writes the following procedure: ; ; (define (count-pairs x) ; (if (not (pair? x)) ; 0 ; (+ (count-pairs (car x)) ; (count-pairs (cdr x)) ; 1))) ; ; Show that this procedure is not correct. In particular, draw box-and-pointer ; diagrams representing list structures made up of exactly three pairs for ; which Ben's procedure would return 3; return 4; never return at all. ; Here are the diagrams: ; ; 3: +---+---+ +---+---+ +---+---+ ; | . | . -----| . | . -----| . | / | ; +---+---+ +---+---+ +---+---+ ; ; 4: +---+---+ +---+---+ ; | . | . -----| . | / | ; +-|-+---+ +---+---+ ; | | ; +---+---+ | ; | . | . -------+ ; +---+---+ ; ; 7: +---+---+ ; | . | . | ; +-|-+-|-+ ; | | ; +---+---+ ; | . | . | ; +-|-+-|-+ ; | | ; +---+---+ ; | . | / | ; +---+---+ ; ; infinite: ; +---+---+ +---+---+ +---+---+ ; | . | . -----| . | . -----| . | . | ; +---+---+ +---+---+ +---+-|-+ ; | | ; +-----------------------------+ (define (count-pairs x) (if (not (pair? x)) 0 (+ (count-pairs (car x)) (count-pairs (cdr x)) 1))) (define a '(a)) (define b (cons 'b a)) (define c (cons a a)) (define three '(a b c)) (define four (cons b a)) (define seven (cons c c)) ================================================ FILE: scheme/sicp/03/17.scm ================================================ ; SICP exercise 3.17 ; ; Devise a correct version of count-pairs procedure of exercise 3.16 that ; retuns the number of distinct pairs in any structure. (Hint: traverse the ; structure, maintaining an auxiliary data structure that is used to keep ; track of which pairs have already been counted.) (define (count-pairs x) (let ((counted '())) (define (count x) (cond ((not (pair? x)) 0) ((null? x) 0) ((memq x counted) 0) (else (set! counted (cons x counted)) (+ 1 (count (car x)) (count (cdr x)))))) (count x))) ================================================ FILE: scheme/sicp/03/18.scm ================================================ ; SICP exercise 3.18 ; ; Write a procedure that examines a list and determines whether it contains a ; cycle, that is, whether a program that tried to find the end of the list by ; taking successive cdrs would go into an infinite loop. Exercise 3.13 ; constructed such lists. (require r5rs/init) (define (has-cycle? x) (let ((counted '())) (define (cycle? x) (cond ((null? x) #f) ((memq x counted) #t) (else (set! counted (cons x counted)) (cycle? (cdr x))))) (cycle? x))) (define (lastpair x) (if (null? (cdr x)) x (lastpair (cdr x)))) (define (make-cycle x) (set-cdr! (lastpair x) x) x) ================================================ FILE: scheme/sicp/03/19.scm ================================================ ; SICP exercise 3.19 ; ; Redo exercise 3.18 using an algorithm that takes only a constant amount of ; space. (This requires a very clever idea.) (require r5rs/init) (define (has-cycle? x) (if (null? x) #f (let ((p1 x) (p2 (cdr x))) (define (loop) (cond ((null? p2) #f) ((null? (cdr p2)) #f) ((eq? p1 p2) #t) (else (set! p1 (cdr p1)) (set! p2 (cddr p2)) (loop)))) (loop)))) (define (lastpair x) (if (null? (cdr x)) x (lastpair (cdr x)))) (define (make-cycle x) (set-cdr! (lastpair x) x) x) ================================================ FILE: scheme/sicp/03/20.scm ================================================ ; SICP exercise 3.20 ; ; Draw environment diagrams to illustrate the evaluation of the sequence of ; expressions ; ; (define x (cons 1 2)) ; (define z (cons x x)) ; (set-car! (cdr z) 17) ; (car x) ; ; using the procedural representation of pairs given above. (Compare exercise ; 3.11.) ; This is the environment after the two defines: ; ; global: +-----------------------------------------------------------------+ ; | cons: | ; | car: | ; | cdr: | ; | set-car!: | ; | set-cdr!: | ; +-----------------------------------------------------------------+ ; ^ ; | ; +-----------------------+ +-----------------------+ ; | x: 1 | +---------- x: | ; | y: 2 | | +----- y: | ; | set-x!: | | | | set-x!: | ; | set-y!: | +----+ | set-y!: | ; | dispatch: | | | dispatch: | ; +---|-------------------+ | +---|-------------------+ ; | ^ | | ^ ; | | | | | ; +-----------+ | +-----------+ ; x ---> | procedure |--------------+ z ---> | procedure | ; +-----------+ +-----------+ ; parameters: m params: m ; body: (cond ((eq? m 'car) x) body: ... ; ((eq? m 'cdr) y) ; ((eq? m 'set-car!) set-x!) ; ((eq? m 'set-cdr!) set-y!) ; (else (error "Undefined operation - CONS" m))) ; ; This is what happens after we call (set-car! (cdr z) 17) ; ; global: +-----------------------------------------------------------------+ ; | cons: | ; | car: | ; | cdr: | ; | set-car!: | ; | set-cdr!: | ; +-----------------------------------------------------------------+ ; ^ ; | ; +-----------------------+ +-----------------------+ ; | x: 17 | +---------- x: | ; | y: 2 | | +----- y: | ; | set-x!: | | | | set-x!: | ; | set-y!: | +----+ | set-y!: | ; | dispatch: | | | dispatch: | ; +---|-------------------+ | +---|-------------------+ ; | ^ | | ^ ; | | | | | ; +-----------+ | +-----------+ ; x ---> | procedure |--------------+ z ---> | procedure | ; +-----------+ +-----------+ ; parameters: m params: m ; body: (cond ((eq? m 'car) x) body: ... ; ((eq? m 'cdr) y) ; ((eq? m 'set-car!) set-x!) ; ((eq? m 'set-cdr!) set-y!) ; (else (error "Undefined operation - CONS" m))) ; ; Essentially, nothing drastic happens. The only difference is where the ; variable x in the frame of the procedure named pointed by x changes from 1 ; to 17. ================================================ FILE: scheme/sicp/03/21.scm ================================================ ; SICP exercise 3.21 ; ; Ben Bitdiddle decides to test the queue implementation described above. He ; types in the procedures to the List interpreter and proceeds to try them ; out: ; ; (define q1 (make-queue)) ; ; (insert-queue! q1 'a) ; ((a) a) ; ; (insert-queue! q1 'b) ; ((a b) b) ; ; (delete-queue! q1) ; ((b) b) ; ; (delete-queue! q1) ; (() b) ; ; "It's all wrong!" he complains. "The interpreter's response shows that the ; last item is inserted into the queue twice. And when I delete both items, ; the second b is still there, so the queue isn't empty, even though it's ; supposed to be." Eva Lu Ator suggests that Ben has misunderstood what is ; happening. "It's not that the items are going into the queue twice," she ; explains. "It's just that the standard Lisp printer doesn't know how to make ; sense of the queue representation. If you want to see the queue printed ; correctly, you'll have to define your own print procedure for queues." ; Explain what Eva Lu is talking about. In particular, show why Ben's examples ; produce the printed results that they do. Define a procedure print-queue ; that takes a queue as input and prints the sequence of items in the queue. ; It's quite simple. The queue is a pair whose car is a list of the queue ; elements and whose cdr is the last pair of that list. Removing an element ; from the queue does not update the cdr of that pair - when the last element ; is removed, the queue still holds a reference to a pair whose car is that ; element. That's why b is printed after an empty list. ; ; You can find print-queue in the end of this file. (require r5rs/init) (define (front-ptr queue) (car queue)) (define (rear-ptr queue) (cdr queue)) (define (set-front-ptr! queue item) (set-car! queue item)) (define (set-rear-ptr! queue item) (set-cdr! queue item)) (define (empty-queue? queue) (null? (front-ptr queue))) (define (make-queue) (cons '() '())) (define (front-queue queue) (if (empty-queue? queue) (error "FRONT called with an empty queue" queue) (car (front-ptr queue)))) (define (insert-queue! queue item) (let ((new-pair (cons item '()))) (cond ((empty-queue? queue) (set-front-ptr! queue new-pair) (set-rear-ptr! queue new-pair) queue) (else (set-cdr! (rear-ptr queue) new-pair) (set-rear-ptr! queue new-pair) queue)))) (define (delete-queue! queue) (cond ((empty-queue? queue) (error "DELETE! called with an empty queue" queue)) (else (set-front-ptr! queue (cdr (front-ptr queue))) queue))) (define (print-queue queue) (display "#") (newline)) ================================================ FILE: scheme/sicp/03/22.scm ================================================ ; SICP exercise 3.22 ; ; Instead of representing the queue as a pair of pointes, we can build a queue ; as a procedure with local state. The local state will consist of pointers to ; the beginning and the end of an ordinary list. Thus, the make-queue ; procedure will have the form ; ; (define (make-queue) ; (let ((front-ptr ...) ; (rear-ptr ...)) ; ; (define (dispatch m) ...) ; dispatch)) ; ; Complete the definition of make-queue and provide implementations of the ; queue operations using this representation. (require r5rs/init) (define (empty-queue? queue) ((queue 'empty?))) (define (front-queue queue) ((queue 'front))) (define (insert-queue! queue item) ((queue 'insert) item)) (define (delete-queue! queue) ((queue 'delete))) (define (make-queue) (let ((front-ptr '()) (rear-ptr '())) (define (empty?) (null? front-ptr)) (define (front) (if (empty?) (error "FRONT called with an empty queue") (car front-ptr))) (define (insert item) (let ((new-pair (cons item '()))) (cond ((empty?) (set! front-ptr new-pair) (set! rear-ptr new-pair)) (else (set-cdr! rear-ptr new-pair) (set! rear-ptr new-pair))) dispatch)) (define (delete) (cond ((empty?) (error "DELETE called with an empty queue")) (else (set! front-ptr (cdr front-ptr)) dispatch))) (define (dispatch m) (cond ((eq? m 'empty?) empty?) ((eq? m 'front) front) ((eq? m 'insert) insert) ((eq? m 'delete) delete) (else (error "Undefined operation - QUEUE" m)))) dispatch)) ================================================ FILE: scheme/sicp/03/23.scm ================================================ ; SICP exercise 3.23 ; ; A deque ("double-ended queue") is a sequence in which items can be ; inserted and deleted at either the front or the rear. Operations on deques ; are the constructor make-deque, the predicate empty-deque?, selectors ; front-deque and rear-deque and mutators front-insert-deque!, ; rear-insert-deque!, front-delete-deque! and rear-delete-deque!. Show how to ; represent deques using pairs, and give implementation of the operations. All ; operations should be accomplished in Θ(1) steps. ; Oooh, nice! This requires implementing a doubly-linked list. The segments of ; the lists will be created with make-segment and each will contain an item ; and a pointer to the previous and the next segment in the queue. (require r5rs/init) (define (front-ptr deque) (car deque)) (define (rear-ptr deque) (cdr deque)) (define (set-front-ptr! deque item) (set-car! deque item)) (define (set-rear-ptr! deque item) (set-cdr! deque item)) (define (make-segment item previous next) (cons item (cons previous next))) (define (item segment) (car segment)) (define (previous segment) (cadr segment)) (define (next segment) (cddr segment)) (define (set-previous! segment previous) (set-car! (cdr segment) previous)) (define (set-next! segment next) (set-cdr! (cdr segment) next)) (define (make-deque) (cons '() '())) (define (empty-deque? deque) (null? (front-ptr deque))) (define (front-deque deque) (if (empty-deque? deque) (error "FRONT called with an empty deque" deque) (item (front-ptr deque)))) (define (rear-deque deque) (if (empty-deque? deque) (error "REAR called with an empty deque" deque) (item (rear-ptr deque)))) (define (front-insert-deque! deque item) (let* ((front (front-ptr deque)) (new-segment (make-segment item '() front))) (cond ((empty-deque? deque) (set-front-ptr! deque new-segment) (set-rear-ptr! deque new-segment)) (else (set-previous! front new-segment) (set-front-ptr! deque new-segment))) deque)) (define (rear-insert-deque! deque item) (let* ((rear (rear-ptr deque)) (new-segment (make-segment item rear '()))) (cond ((empty-deque? deque) (set-front-ptr! deque new-segment) (set-rear-ptr! deque new-segment)) (else (set-next! rear new-segment) (set-rear-ptr! deque new-segment))) deque)) (define (front-delete-deque! deque) (cond ((empty-deque? deque) (error "FRONT-DELETE called with an empty deque" deque)) ((null? (next (front-ptr deque))) (set-front-ptr! deque '()) (set-rear-ptr! deque '())) (else (set-front-ptr! deque (next (front-ptr deque))) (set-previous! (front-ptr deque) '()))) deque) (define (rear-delete-deque! deque) (cond ((empty-deque? deque) (error "REAR-DELETE called with an empty deque" deque)) ((null? (previous (rear-ptr deque))) (set-front-ptr! deque '()) (set-rear-ptr! deque '())) (else (set-rear-ptr! deque (previous (rear-ptr deque))) (set-next! (rear-ptr deque) '()))) deque) ================================================ FILE: scheme/sicp/03/24.scm ================================================ ; SICP exercise 3.24 ; ; In the table implementations above, the keys are tested for equality using ; equal? (called by assoc). This is not always the appropriate test. For ; instance, we might have a table with numeric keys in which we don't need an ; exact match to the number we're looking up, but only a number within some ; tolerance of it. Design a table constructor make-table that takes as an ; argument a same-key? procedure that will be used to test "equality" of keys. ; make-table should return a dispatch procedure that can be used to access ; appropriate lookup and insert! procedures for a local table. (require r5rs/init) (define (make-table same-key?) (let ((table '(*table*))) (define (find-pair key) (define (search remaining) (cond ((null? remaining) #f) ((same-key? key (caar remaining)) (car remaining)) (else (search (cdr remaining))))) (search (cdr table))) (define (lookup key) (let ((pair (find-pair key))) (if pair (cdr pair) false))) (define (insert key value) (let ((pair (find-pair key))) (cond (pair (set-cdr! pair value)) (else (set-cdr! table (cons (cons key value) (cdr table))))) dispatch)) (define (dispatch m) (cond ((eq? m 'lookup) lookup) ((eq? m 'insert) insert) (else (error "Unrecognized message - TABLE" m)))) dispatch)) (define (lookup key table) ((table 'lookup) key)) (define (insert! key value table) ((table 'insert) key value)) ================================================ FILE: scheme/sicp/03/25.scm ================================================ ; SICP exercise 3.25 ; ; Generalizing one- and two- dimensional tables, show how to implement a table ; in which values are stored under an arbitrary number of keys and different ; values may be stored under different numbers of keys. The lookup and insert! ; procedures should take as input a list of keys used to access the table. ; I fairly uncertain why we're not using list as key. In good spirit, however, ; I'm going to let that pass and implement nested tables. ; (require r5rs/init) (define (make-keyed-table key) (list key)) (define (make-table) (make-keyed-table '*table)) (define (find-pair key table) (define (search records) (cond ((null? records) false) ((equal? key (caar records)) (car records)) (else (search (cdr records))))) (search (cdr table))) (define (lookup keys table) (let* ((first-key (car keys)) (rest-keys (cdr keys)) (record (find-pair first-key table))) (cond ((not record) #f) ((null? rest-keys) (cdr record)) (else (lookup rest-keys record))))) (define (insert! keys value table) (define (prepend-pair! pair) (set-cdr! table (cons pair (cdr table)))) (let* ((first-key (car keys)) (rest-keys (cdr keys)) (pair (find-pair first-key table))) (cond ((and pair (null? rest-keys)) (set-cdr! pair value)) (pair (insert! rest-keys value pair)) ((null? rest-keys) (prepend-pair! (cons first-key value))) (else (let ((new-table (make-keyed-table first-key))) (prepend-pair! new-table) (insert! rest-keys value new-table)))) table)) ================================================ FILE: scheme/sicp/03/26.scm ================================================ ; SICP exercise 3.26 ; ; To search a table as implemented above, one needs to scan the list of ; records. This is basically the unordered list representation of Section ; 2.3.3. For large tables, it may be more efficient to structure the table in ; a different manner. Describe a table implementation where the (key, value) ; records are organized using a binary tree, assuming that keys can be ordered ; in some way (e.g. numerically or alphabetically.) (Compare exercise 2.66 of ; Chapter 2.) ; I am so happy you said "describe". ; ; Anyway, it is fairly simple - we just organize the table in a binary tree ; instead of a list. Whenever we're looking up a key, we're doing a binary ; tree search for the car of the entry of each one and if we find such a node, ; we return the cdr of its entry. This performs in O(log(n)) time, which is ; nice. ; ; The hairy side is insert!. On one hand, we can recreate the tree on every ; insert!. This would keep it balanced and it would perform in O(log(n)), but ; the insertion cost will be huge. On the other hand, modifying the tree is ; not straightforward - if we just find a branch where to add a new element, ; the performance will degrade to O(n), since the tree will not be balanced. ; And if we want to keep it balanced, we need to learn about AVL-trees, ; red-black trees and various other balanced binary trees. ; ; It's not for the weak of heart. ================================================ FILE: scheme/sicp/03/27.scm ================================================ ; SICP exercise 3.27 ; ; Memoization (also called tabulation) is a technique that enables a procedure ; to record, in a local table, values that have previously been computed. This ; technique can make a vast difference in the performance of a program. A ; memoized procedure matintains a table in which values of previous calls are ; stored using as keys the arguments that produced the values. When the ; memoized procedure is asked to compute a value, it first checks the table to ; see if the value is already there and, if so, just returns that value. ; Otherwise, it compute sthe new value in the ordinary way and stores this in ; the table. As an example of memoization, recall from section 1.2.2 the ; exponential process for computing Fibonacci numbers: ; ; (define (fib n) ; (cond ((=n 0) 0) ; ((=n 1) 1) ; (else (+ (fib (- n 1)) ; (fib (- n 2)))))) ; ; The memoized version of the same procedure is ; ; (define memo-fib ; (memoize (lambda (n) ; (cond ((= n 0) 0) ; ((= n 1) 1) ; (else (+ (memo-fib (- n 1)) ; (memo-fib (- n 2)))))))) ; ; where the memoizer is defined as ; ; (define (memoize f) ; (let ((table (make-table))) ; (lambda (x) ; (let ((previously-computed-result (lookup x table))) ; (or previously-computed-result ; (let ((result (f x))) ; (insert! x result table) ; result)))))) ; ; Draw an environment diagram to analyze the computation (memo-fib 3). Explain ; why memo-fib computes the nth Fibonacci number in a number of steps ; proportional to n. Would the scheme still work if we had simply defined ; memo-fib to be (memoize fib)? ; God, I hate environment diagrams. Here's how the environment looks before ; computing (memo-fib 3). ; ; globals: ; +-------------------------------------------------------------------------+ ; | memoize: | ; | memo-fib: | ; +--|----------------------------------------------------------------------+ ; | ^ ; | | ; | +----------------+ ; | | f: --------> ; | +----------------+ params: n ; | ^ body: (cond ((= n 0) 0) ; | | ... ; | +----------------+ ; | | table: --------> (*table) ; | +----------------+ ; | ^ ; | | ; +------> ; parameters: x ; body: (let ((... ; ; When we call (memo-fib 3) it does a table lookup, fails and then goes to ; calculate [1] (+ (memo-fib 2) (memo-fib 1)). Let's assume left-to-right ; evaluation. It procedures to evaluate (memo-fib 2) which fails the table ; lookup and then results to [2] (+ (memo-fib 1) (memo-fib 0)). Both fail the ; lookup, but at least they return immediatelly and the results are written in ; the table. This is how the environment looks when [2] completes: ; ; globals: ; +-------------------------------------------------------------------------+ ; | memoize: | ; | memo-fib: | ; +--|----------------------------------------------------------------------+ ; | ^ ; | | ; | +----------------+ ; | | f: --------> ; | +----------------+ params: n ; | ^ body: (cond ((= n 0) 0) ; | | ... ; | +----------------+ ; | | table:
    --------> (*table (1 . 1) ; | +----------------+ (0 . 0)) ; | ^ ^ ; | | | ; +----|-> ; | parameters: x ; | body: (let ((... ; | ; +------------------------------------+ ; [1] | [2] | ; +--------------------------------+ +--------------------------------+ ; | x: 3 | | x: 2 | ; | previously-computed-result: #f | | previously-computed-result: #f | ; +--------------------------------+ +--------------------------------+ ; ; When (f x) completes, the result is written in the table and the function ; returns it. This is how the environment looks after (make-fib 2) has ; returned: ; ; globals: ; +-------------------------------------------------------------------------+ ; | memoize: | ; | memo-fib: | ; +--|----------------------------------------------------------------------+ ; | ^ ; | | ; | +----------------+ ; | | f: --------> ; | +----------------+ params: n ; | ^ body: (cond ((= n 0) 0) ; | | ... ; | +----------------+ ; | | table:
    --------> (*table (2 . 2) ; | +----------------+ (1 . 1) ; | ^ ^ (0 . 0)) ; | | | ; +----|-> ; | parameters: x ; | body: (let ((... ; [1] | ; +--------------------------------+ ; | x: 3 | ; | previously-computed-result: #f | ; +--------------------------------+ ; ; Now the second part of [1] computes, which is (memo-fib 1). This time it is ; found in the table and instead of calling f, the lookup just returns 1. The ; addition is carried out and the final result, 3, is written in the table and ; then returned. In the end, we have the following environment: ; ; globals: ; +-------------------------------------------------------------------------+ ; | memoize: | ; | memo-fib: | ; +--|----------------------------------------------------------------------+ ; | ^ ; | | ; | +----------------+ ; | | f: --------> ; | +----------------+ params: n ; | ^ body: (cond ((= n 0) 0) ; | | ... ; | +----------------+ ; | | table:
    --------> (*table (3 . 3) ; | +----------------+ (2 . 2) ; | ^ (1 . 1) ; | | (0 . 0)) ; +------> ; parameters: x ; body: (let ((... ; ; You can note, that (memo-fib 1) invoked f only once. Even if it had to be ; calculated once in [1] and once in [2]. Furthermore, note that if we call ; (memo-fib 3) now, f would not get invoked at all. That's why the steps are ; proportional to n. ; ; This scheme would not work if we did: ; ; (define memo-fib (memoize fib)) ; ; Or more accuratelly, it would work half-way. The problem is that fib calls ; recursively itself, instead of memo-fib. Thus, intermediate values are not ; calculated and the time is still exponential. The only benefit is that if we ; call memo-fib with the same argument twice, it will reuse the result from ; the first calculation. ================================================ FILE: scheme/sicp/03/28.scm ================================================ ; SICP exercise 3.28 ; ; Define an or-gate as a primitive function box. Your or-gate constructor ; should be similar to and-gate. ; Sure. Let's grab all the code we've written so far first. The solution is ; somewhere in there. ; Half-adder & adder: (require r5rs/init) (define (half-adder a b s c) (let ((d (make-wire)) (e (make-wire))) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) 'ok)) (define (full-adder a b c-in sum c-out) (let ((s (make-wire)) (c1 (make-wire)) (c2 (make-wire))) (half-adder b c-in s c1) (half-adder a s sum c2) (or-gate c1 c2 c-out) 'ok)) ; Primitive function boxes (define (inverter input output) (define (invert-input) (let ((new-value (logical-not (get-signal input)))) (after-delay inverter-delay (lambda () (set-signal! output new-value))))) (add-action! input invert-input) 'ok) (define (and-gate a1 a2 output) (define (and-action-procedure) (let ((new-value (logical-and (get-signal a1) (get-signal a2)))) (after-delay and-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 and-action-procedure) (add-action! a2 and-action-procedure) 'ok) (define (or-gate o1 o2 output) (define (or-action-procedure) (let ((new-value (logical-or (get-signal o1) (get-signal o2)))) (after-delay or-gate-delay (lambda () (set-signal! output new-value))))) (add-action! o1 or-action-procedure) (add-action! o2 or-action-procedure) 'ok) ; Logical functions (define (logical-not s) (cond ((= s 0) 1) ((= s 1) 0) (else (error "Invalid signal" s)))) (define (logical-and a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 0) ((and (= a 1) (= b 0)) 0) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) (define (logical-or a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 1) ((and (= a 1) (= b 0)) 1) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) ; Wires (define (make-wire) (let ((signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (set! signal-value new-value) (call-each action-procedures)) 'done)) (define (accept-action-procedure! proc) (set! action-procedures (cons proc action-procedures)) (proc)) (define (dispatch m) (cond ((eq? m 'get-signal) signal-value) ((eq? m 'set-signal!) set-my-signal!) ((eq? m 'add-action!) accept-action-procedure!) (else (error "Unknown operation -- WIRE" m)))) dispatch)) (define (call-each procedures) (if (null? procedures) 'done (begin ((car procedures)) (call-each (cdr procedures))))) (define (get-signal wire) (wire 'get-signal)) (define (set-signal! wire new-value) ((wire 'set-signal!) new-value)) (define (add-action! wire action-procedure) ((wire 'add-action!) action-procedure)) ; Queues (define (front-ptr queue) (car queue)) (define (rear-ptr queue) (cdr queue)) (define (set-front-ptr! queue item) (set-car! queue item)) (define (set-rear-ptr! queue item) (set-cdr! queue item)) (define (make-queue) (cons '() '())) (define (empty-queue? queue) (null? (front-ptr queue))) (define (front-queue queue) (if (empty-queue? queue) (error "FRONT called with an empty queue" queue) (car (front-ptr queue)))) (define (insert-queue! queue item) (let ((new-pair (cons item '()))) (cond ((empty-queue? queue) (set-front-ptr! queue new-pair) (set-rear-ptr! queue new-pair)) (else (set-cdr! (rear-ptr queue) new-pair) (set-rear-ptr! queue new-pair))) queue)) (define (delete-queue! queue) (cond ((empty-queue? queue) (error "DELETE! called with an empty queue" queue)) (else (set-front-ptr! queue (cdr (front-ptr queue))) queue))) ; The agenda (define (make-time-segment time queue) (cons time queue)) (define (segment-time s) (car s)) (define (segment-queue s) (cdr s)) (define (make-agenda) (list 0)) (define (current-time agenda) (car agenda)) (define (set-current-time! agenda time) (set-car! agenda time)) (define (segments agenda) (cdr agenda)) (define (set-segments! agenda segments) (set-cdr! agenda segments)) (define (first-segment agenda) (car (segments agenda))) (define (rest-segments agenda) (cdr (segments agenda))) (define (empty-agenda? agenda) (null? (segments agenda))) (define (add-to-agenda! time action agenda) (define (belongs-before? segments) (or (null? segments) (< time (segment-time (car segments))))) (define (make-new-time-segment time action) (let ((q (make-queue))) (insert-queue! q action) (make-time-segment time q))) (define (add-to-segments! segments) (if (= (segment-time (car segments)) time) (insert-queue! (segment-queue (car segments)) action) (let ((rest (cdr segments))) (if (belongs-before? rest) (set-cdr! segments (cons (make-new-time-segment time action) rest)) (add-to-segments! rest))))) (let ((segments (segments agenda))) (if (belongs-before? segments) (set-segments! agenda (cons (make-new-time-segment time action) segments)) (add-to-segments! segments)))) (define (remove-first-agenda-item! agenda) (let ((q (segment-queue (first-segment agenda)))) (delete-queue! q) (if (empty-queue? q) (set-segments! agenda (rest-segments agenda)) 'done))) (define (first-agenda-item agenda) (if (empty-agenda? agenda) (error "Agenda is empty -- FIRST-AGENDA-ITEM") (let ((first-seg (first-segment agenda))) (set-current-time! agenda (segment-time first-seg)) (front-queue (segment-queue first-seg))))) ; Delays (define inverter-delay 2) (define and-gate-delay 3) (define or-gate-delay 5) ; Simulation infrastructure (define the-agenda (make-agenda)) (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda)) action the-agenda)) (define (propagate) (if (empty-agenda? the-agenda) 'done (let ((first-item (first-agenda-item the-agenda))) (first-item) (remove-first-agenda-item! the-agenda) (propagate)))) (define (probe name wire) (add-action! wire (lambda () (display name) (display " ") (display (current-time the-agenda)) (display " New-value = ") (display (get-signal wire)) (newline)))) ================================================ FILE: scheme/sicp/03/29.scm ================================================ ; SICP exercise 3.29 ; ; Another way to construct an or-gate is as a compound digital device, built ; from and-gates and inverters. Define a procedure or-gate that accomplishes ; this. What is the delay of the or-gate in terms of and-gate-delay and ; inverter-delay? ; If we apply De Morgan's law, we get that a || b = !(!a && !b). Here's how ; the diagram looks: ; _ ; a ---|>o---| \ ; | |---|>o--- r ; b ---|>o---|_/ ; ; The signal travels through an inverted, then an AND gate, then another ; inverter, so it is (+ (2 inverter-delay) and-gate-delay). (require r5rs/init) (define (half-adder a b s c) (let ((d (make-wire)) (e (make-wire))) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) 'ok)) (define (full-adder a b c-in sum c-out) (let ((s (make-wire)) (c1 (make-wire)) (c2 (make-wire))) (half-adder b c-in s c1) (half-adder a s sum c2) (or-gate c1 c2 c-out) 'ok)) ; Primitive function boxes (define (inverter input output) (define (invert-input) (let ((new-value (logical-not (get-signal input)))) (after-delay inverter-delay (lambda () (set-signal! output new-value))))) (add-action! input invert-input) 'ok) (define (and-gate a1 a2 output) (define (and-action-procedure) (let ((new-value (logical-and (get-signal a1) (get-signal a2)))) (after-delay and-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 and-action-procedure) (add-action! a2 and-action-procedure) 'ok) (define (or-gate o1 o2 output) (let ((a (make-wire)) (b (make-wire)) (c (make-wire))) (inverter o1 a) (inverter o2 b) (and-gate a b c) (inverter c output) 'ok)) ; Logical functions (define (logical-not s) (cond ((= s 0) 1) ((= s 1) 0) (else (error "Invalid signal" s)))) (define (logical-and a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 0) ((and (= a 1) (= b 0)) 0) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) ; Wires (define (make-wire) (let ((signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (set! signal-value new-value) (call-each action-procedures)) 'done)) (define (accept-action-procedure! proc) (set! action-procedures (cons proc action-procedures)) (proc)) (define (dispatch m) (cond ((eq? m 'get-signal) signal-value) ((eq? m 'set-signal!) set-my-signal!) ((eq? m 'add-action!) accept-action-procedure!) (else (error "Unknown operation -- WIRE" m)))) dispatch)) (define (call-each procedures) (if (null? procedures) 'done (begin ((car procedures)) (call-each (cdr procedures))))) (define (get-signal wire) (wire 'get-signal)) (define (set-signal! wire new-value) ((wire 'set-signal!) new-value)) (define (add-action! wire action-procedure) ((wire 'add-action!) action-procedure)) ; Queues (define (front-ptr queue) (car queue)) (define (rear-ptr queue) (cdr queue)) (define (set-front-ptr! queue item) (set-car! queue item)) (define (set-rear-ptr! queue item) (set-cdr! queue item)) (define (make-queue) (cons '() '())) (define (empty-queue? queue) (null? (front-ptr queue))) (define (front-queue queue) (if (empty-queue? queue) (error "FRONT called with an empty queue" queue) (car (front-ptr queue)))) (define (insert-queue! queue item) (let ((new-pair (cons item '()))) (cond ((empty-queue? queue) (set-front-ptr! queue new-pair) (set-rear-ptr! queue new-pair)) (else (set-cdr! (rear-ptr queue) new-pair) (set-rear-ptr! queue new-pair))) queue)) (define (delete-queue! queue) (cond ((empty-queue? queue) (error "DELETE! called with an empty queue" queue)) (else (set-front-ptr! queue (cdr (front-ptr queue))) queue))) ; The agenda (define (make-time-segment time queue) (cons time queue)) (define (segment-time s) (car s)) (define (segment-queue s) (cdr s)) (define (make-agenda) (list 0)) (define (current-time agenda) (car agenda)) (define (set-current-time! agenda time) (set-car! agenda time)) (define (segments agenda) (cdr agenda)) (define (set-segments! agenda segments) (set-cdr! agenda segments)) (define (first-segment agenda) (car (segments agenda))) (define (rest-segments agenda) (cdr (segments agenda))) (define (empty-agenda? agenda) (null? (segments agenda))) (define (add-to-agenda! time action agenda) (define (belongs-before? segments) (or (null? segments) (< time (segment-time (car segments))))) (define (make-new-time-segment time action) (let ((q (make-queue))) (insert-queue! q action) (make-time-segment time q))) (define (add-to-segments! segments) (if (= (segment-time (car segments)) time) (insert-queue! (segment-queue (car segments)) action) (let ((rest (cdr segments))) (if (belongs-before? rest) (set-cdr! segments (cons (make-new-time-segment time action) rest)) (add-to-segments! rest))))) (let ((segments (segments agenda))) (if (belongs-before? segments) (set-segments! agenda (cons (make-new-time-segment time action) segments)) (add-to-segments! segments)))) (define (remove-first-agenda-item! agenda) (let ((q (segment-queue (first-segment agenda)))) (delete-queue! q) (if (empty-queue? q) (set-segments! agenda (rest-segments agenda)) 'done))) (define (first-agenda-item agenda) (if (empty-agenda? agenda) (error "Agenda is empty -- FIRST-AGENDA-ITEM") (let ((first-seg (first-segment agenda))) (set-current-time! agenda (segment-time first-seg)) (front-queue (segment-queue first-seg))))) ; Delays (define inverter-delay 2) (define and-gate-delay 3) ; Simulation infrastructure (define the-agenda (make-agenda)) (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda)) action the-agenda)) (define (propagate) (if (empty-agenda? the-agenda) 'done (let ((first-item (first-agenda-item the-agenda))) (first-item) (remove-first-agenda-item! the-agenda) (propagate)))) (define (probe name wire) (add-action! wire (lambda () (display name) (display " ") (display (current-time the-agenda)) (display " New-value = ") (display (get-signal wire)) (newline)))) ================================================ FILE: scheme/sicp/03/30.scm ================================================ ; SICP exercise 3.30 ; ; Figure 3.27 shows a ripple-carry adder formed by stringing together n ; full-adders. This is the simplest form of parallel adder for adding two ; n-bit binary numbers. The inputs A₁, A₂, A₃, ..., Aᵢ and B₁, B₂, B₃, ..., Bᵢ ; are the two binary numbers to be added (each Aᵣ and Bᵣ is a 0 or a 1). The ; circuit generates S₁, S₂, S₃, ..., Sᵢ, the i bits of the sum, and C , the ; carry from the addition. Write a procedure ripple-carry-adder that generates ; that circuit. The procedure should take as arguments three lists of i wires ; each - the Aᵣ, the Bᵣ and the Sᵣ - and also another wire C. The major ; drawback of the ripple-carry adder is the need to wait for the signals to ; propagate. What is the delay needed to obtain the complete output from an ; i-bit ripple-carry adder, expressed in terms of the delays of and-gates, ; or-gates, and inverters? ; The ripple-carry-adder procedure is defined below. ; ; As for the delay: ; ; The half-adder has the following delays for each output: ; ; s: and + not + and | or + and (whichever is slower) ; c: and ; ; The full-adder has the following delays: ; ; sum: and + not + and | or + and ; c-out: (and + not + and | or + and) + and + or ; ; Finally, the delay of C an n-bit ripple adder is: ; ; n-ripple: n((and + not + and | or + and) + and + or) ; ; With the delays we have defined, this is either: ; ; n(3and + or + not) ; ; or ; ; n(2or + 2and) ; ; whichever is slower. However, we need wait for the last SUM too. We can ; subtract (and + or) from the time (since this is the time that takes the ; signal to travel through the carry from the second half-adder in the last ; adder and then through the and gate) and then we can add the s time for ; another half-adder, which makes the total time: ; ; n(3and + or + not) + and + not - or ; ; or, again: ; ; n(2or + 2and) (require r5rs/init) ; Ripple-carry adder (define (ripple-carry-adder a b c-in s c-out) (define (ripple a b s c) (cond ((null? (cdr a)) (full-adder (car a) (car b) c-in (car s) c)) (else (let ((w (make-wire))) (full-adder (car a) (car b) w (car s) c) (ripple (cdr a) (cdr b) (cdr s) w))))) (ripple (reverse a) (reverse b) (reverse s) c-out)) ; Half-adder & adder (define (half-adder a b s c) (let ((d (make-wire)) (e (make-wire))) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) 'ok)) (define (full-adder a b c-in sum c-out) (let ((s (make-wire)) (c1 (make-wire)) (c2 (make-wire))) (half-adder b c-in s c1) (half-adder a s sum c2) (or-gate c1 c2 c-out) 'ok)) ; Primitive function boxes (define (inverter input output) (define (invert-input) (let ((new-value (logical-not (get-signal input)))) (after-delay inverter-delay (lambda () (set-signal! output new-value))))) (add-action! input invert-input) 'ok) (define (and-gate a1 a2 output) (define (and-action-procedure) (let ((new-value (logical-and (get-signal a1) (get-signal a2)))) (after-delay and-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 and-action-procedure) (add-action! a2 and-action-procedure) 'ok) (define (or-gate o1 o2 output) (define (or-action-procedure) (let ((new-value (logical-or (get-signal o1) (get-signal o2)))) (after-delay or-gate-delay (lambda () (set-signal! output new-value))))) (add-action! o1 or-action-procedure) (add-action! o2 or-action-procedure) 'ok) ; Logical functions (define (logical-not s) (cond ((= s 0) 1) ((= s 1) 0) (else (error "Invalid signal" s)))) (define (logical-and a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 0) ((and (= a 1) (= b 0)) 0) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) (define (logical-or a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 1) ((and (= a 1) (= b 0)) 1) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) ; Wires (define (make-wire) (let ((signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (set! signal-value new-value) (call-each action-procedures)) 'done)) (define (accept-action-procedure! proc) (set! action-procedures (cons proc action-procedures)) (proc)) (define (dispatch m) (cond ((eq? m 'get-signal) signal-value) ((eq? m 'set-signal!) set-my-signal!) ((eq? m 'add-action!) accept-action-procedure!) (else (error "Unknown operation -- WIRE" m)))) dispatch)) (define (call-each procedures) (if (null? procedures) 'done (begin ((car procedures)) (call-each (cdr procedures))))) (define (get-signal wire) (wire 'get-signal)) (define (set-signal! wire new-value) ((wire 'set-signal!) new-value)) (define (add-action! wire action-procedure) ((wire 'add-action!) action-procedure)) ; Queues (define (front-ptr queue) (car queue)) (define (rear-ptr queue) (cdr queue)) (define (set-front-ptr! queue item) (set-car! queue item)) (define (set-rear-ptr! queue item) (set-cdr! queue item)) (define (make-queue) (cons '() '())) (define (empty-queue? queue) (null? (front-ptr queue))) (define (front-queue queue) (if (empty-queue? queue) (error "FRONT called with an empty queue" queue) (car (front-ptr queue)))) (define (insert-queue! queue item) (let ((new-pair (cons item '()))) (cond ((empty-queue? queue) (set-front-ptr! queue new-pair) (set-rear-ptr! queue new-pair)) (else (set-cdr! (rear-ptr queue) new-pair) (set-rear-ptr! queue new-pair))) queue)) (define (delete-queue! queue) (cond ((empty-queue? queue) (error "DELETE! called with an empty queue" queue)) (else (set-front-ptr! queue (cdr (front-ptr queue))) queue))) ; The agenda (define (make-time-segment time queue) (cons time queue)) (define (segment-time s) (car s)) (define (segment-queue s) (cdr s)) (define (make-agenda) (list 0)) (define (current-time agenda) (car agenda)) (define (set-current-time! agenda time) (set-car! agenda time)) (define (segments agenda) (cdr agenda)) (define (set-segments! agenda segments) (set-cdr! agenda segments)) (define (first-segment agenda) (car (segments agenda))) (define (rest-segments agenda) (cdr (segments agenda))) (define (empty-agenda? agenda) (null? (segments agenda))) (define (add-to-agenda! time action agenda) (define (belongs-before? segments) (or (null? segments) (< time (segment-time (car segments))))) (define (make-new-time-segment time action) (let ((q (make-queue))) (insert-queue! q action) (make-time-segment time q))) (define (add-to-segments! segments) (if (= (segment-time (car segments)) time) (insert-queue! (segment-queue (car segments)) action) (let ((rest (cdr segments))) (if (belongs-before? rest) (set-cdr! segments (cons (make-new-time-segment time action) rest)) (add-to-segments! rest))))) (let ((segments (segments agenda))) (if (belongs-before? segments) (set-segments! agenda (cons (make-new-time-segment time action) segments)) (add-to-segments! segments)))) (define (remove-first-agenda-item! agenda) (let ((q (segment-queue (first-segment agenda)))) (delete-queue! q) (if (empty-queue? q) (set-segments! agenda (rest-segments agenda)) 'done))) (define (first-agenda-item agenda) (if (empty-agenda? agenda) (error "Agenda is empty -- FIRST-AGENDA-ITEM") (let ((first-seg (first-segment agenda))) (set-current-time! agenda (segment-time first-seg)) (front-queue (segment-queue first-seg))))) ; Delays (define inverter-delay 2) (define and-gate-delay 3) (define or-gate-delay 5) ; Simulation infrastructure (define the-agenda (make-agenda)) (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda)) action the-agenda)) (define (propagate) (if (empty-agenda? the-agenda) 'done (let ((first-item (first-agenda-item the-agenda))) (first-item) (remove-first-agenda-item! the-agenda) (propagate)))) (define (probe name wire) (add-action! wire (lambda () (display name) (display " ") (display (current-time the-agenda)) (display " New-value = ") (display (get-signal wire)) (newline)))) ================================================ FILE: scheme/sicp/03/31.scm ================================================ ; SICP exercise 3.31 ; ; The internal procedure accept-action-procedure! defined in make-wire ; specifies that when a new action procedure is added to a wire, the procedure ; is immediately run. Explain why this initialization is necessary. In ; particular, trace through the half-adder example in the paragraph above and ; say how the system's response would differ if we had defined ; accept-action-procedure! as ; ; (define (accept-action-procedure! proc) ; (set! action-procedures (cons proc action-procedures))) ; If we define the procedure like that, the output of the inverter will be 0 ; even if its input is also 0. This is wrong. In the example above, when we ; set the signal of input-1 to 1, the sum would remain 1 because the inputs of ; the and-gate that leads to sum will be 1 and 0. Thus, sum will remain 0, ; even if that is wrong. ; ; You can run this file to verify. (require r5rs/init) ; Half-adder & adder: (define (half-adder a b s c) (let ((d (make-wire)) (e (make-wire))) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) 'ok)) (define (full-adder a b c-in sum c-out) (let ((s (make-wire)) (c1 (make-wire)) (c2 (make-wire))) (half-adder b c-in s c1) (half-adder a s sum c2) (or-gate c1 c2 c-out) 'ok)) ; Primitive function boxes (define (inverter input output) (define (invert-input) (let ((new-value (logical-not (get-signal input)))) (after-delay inverter-delay (lambda () (set-signal! output new-value))))) (add-action! input invert-input) 'ok) (define (and-gate a1 a2 output) (define (and-action-procedure) (let ((new-value (logical-and (get-signal a1) (get-signal a2)))) (after-delay and-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 and-action-procedure) (add-action! a2 and-action-procedure) 'ok) (define (or-gate o1 o2 output) (define (or-action-procedure) (let ((new-value (logical-or (get-signal o1) (get-signal o2)))) (after-delay or-gate-delay (lambda () (set-signal! output new-value))))) (add-action! o1 or-action-procedure) (add-action! o2 or-action-procedure) 'ok) ; Logical functions (define (logical-not s) (cond ((= s 0) 1) ((= s 1) 0) (else (error "Invalid signal" s)))) (define (logical-and a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 0) ((and (= a 1) (= b 0)) 0) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) (define (logical-or a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 1) ((and (= a 1) (= b 0)) 1) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) ; Wires (define (make-wire) (let ((signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (set! signal-value new-value) (call-each action-procedures)) 'done)) (define (accept-action-procedure! proc) (set! action-procedures (cons proc action-procedures))) (define (dispatch m) (cond ((eq? m 'get-signal) signal-value) ((eq? m 'set-signal!) set-my-signal!) ((eq? m 'add-action!) accept-action-procedure!) (else (error "Unknown operation -- WIRE" m)))) dispatch)) (define (call-each procedures) (if (null? procedures) 'done (begin ((car procedures)) (call-each (cdr procedures))))) (define (get-signal wire) (wire 'get-signal)) (define (set-signal! wire new-value) ((wire 'set-signal!) new-value)) (define (add-action! wire action-procedure) ((wire 'add-action!) action-procedure)) ; Queues (define (front-ptr queue) (car queue)) (define (rear-ptr queue) (cdr queue)) (define (set-front-ptr! queue item) (set-car! queue item)) (define (set-rear-ptr! queue item) (set-cdr! queue item)) (define (make-queue) (cons '() '())) (define (empty-queue? queue) (null? (front-ptr queue))) (define (front-queue queue) (if (empty-queue? queue) (error "FRONT called with an empty queue" queue) (car (front-ptr queue)))) (define (insert-queue! queue item) (let ((new-pair (cons item '()))) (cond ((empty-queue? queue) (set-front-ptr! queue new-pair) (set-rear-ptr! queue new-pair)) (else (set-cdr! (rear-ptr queue) new-pair) (set-rear-ptr! queue new-pair))) queue)) (define (delete-queue! queue) (cond ((empty-queue? queue) (error "DELETE! called with an empty queue" queue)) (else (set-front-ptr! queue (cdr (front-ptr queue))) queue))) ; The agenda (define (make-time-segment time queue) (cons time queue)) (define (segment-time s) (car s)) (define (segment-queue s) (cdr s)) (define (make-agenda) (list 0)) (define (current-time agenda) (car agenda)) (define (set-current-time! agenda time) (set-car! agenda time)) (define (segments agenda) (cdr agenda)) (define (set-segments! agenda segments) (set-cdr! agenda segments)) (define (first-segment agenda) (car (segments agenda))) (define (rest-segments agenda) (cdr (segments agenda))) (define (empty-agenda? agenda) (null? (segments agenda))) (define (add-to-agenda! time action agenda) (define (belongs-before? segments) (or (null? segments) (< time (segment-time (car segments))))) (define (make-new-time-segment time action) (let ((q (make-queue))) (insert-queue! q action) (make-time-segment time q))) (define (add-to-segments! segments) (if (= (segment-time (car segments)) time) (insert-queue! (segment-queue (car segments)) action) (let ((rest (cdr segments))) (if (belongs-before? rest) (set-cdr! segments (cons (make-new-time-segment time action) rest)) (add-to-segments! rest))))) (let ((segments (segments agenda))) (if (belongs-before? segments) (set-segments! agenda (cons (make-new-time-segment time action) segments)) (add-to-segments! segments)))) (define (remove-first-agenda-item! agenda) (let ((q (segment-queue (first-segment agenda)))) (delete-queue! q) (if (empty-queue? q) (set-segments! agenda (rest-segments agenda)) 'done))) (define (first-agenda-item agenda) (if (empty-agenda? agenda) (error "Agenda is empty -- FIRST-AGENDA-ITEM") (let ((first-seg (first-segment agenda))) (set-current-time! agenda (segment-time first-seg)) (front-queue (segment-queue first-seg))))) ; Delays (define inverter-delay 2) (define and-gate-delay 3) (define or-gate-delay 5) ; Simulation infrastructure (define the-agenda (make-agenda)) (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda)) action the-agenda)) (define (propagate) (if (empty-agenda? the-agenda) 'done (let ((first-item (first-agenda-item the-agenda))) (first-item) (remove-first-agenda-item! the-agenda) (propagate)))) (define (probe name wire) (add-action! wire (lambda () (display name) (display " ") (display (current-time the-agenda)) (display " New-value = ") (display (get-signal wire)) (newline)))) (define input-1 (make-wire)) (define input-2 (make-wire)) (define sum (make-wire)) (define carry (make-wire)) (probe 'sum sum) (probe 'carry carry) (half-adder input-1 input-2 sum carry) (set-signal! input-1 1) (propagate) (set-signal! input-2 1) (propagate) ================================================ FILE: scheme/sicp/03/32.scm ================================================ ; SICP exercise 3.32 ; ; The procedures to be run during each time segment of the agenda are kept in ; a queue. Thus, the procedures for each segment are called in the order in ; which they were added to the agenda (first-in, first-out). Explain why this ; order must be used. In particular, trace the behavior of an and-gate whose ; inputs change from 0, 1 to 1, 0 in the same segment and say how the behavior ; would differ if we stored a segment's procedures in an ordinary list, adding ; and removing procedures only at the front (last in, first out). ; Each action calculates the new result to be set before it is added to the ; queue. If we change 0, 1 to 1, 0, we will add two actions to the queue: ; ; a1: set output to 1 ; a2: set output to 0 ; ; The reason that we set those outputs is because the gate reads the wire ; signals before it puts the action after a specific delay. When we change ; from (0, 1) to (1, 1) it will determine that the output should be 1. We ; immediatelly change (1, 1) to (1, 0) and the action will set the output to ; 0. ; ; That is, assuming, we use a queue. If we use a stack (last in, first out), ; those actions will get executed in reverse order. That is, a2 will set the ; output to 0, after which a1 will set it to 1. In the end, the and gate will ; output erroneous result. ; ; You can run this file to verify. (require r5rs/init) ; Primitive function boxes (define (and-gate a1 a2 output) (define (and-action-procedure) (let ((new-value (logical-and (get-signal a1) (get-signal a2)))) (after-delay and-gate-delay (lambda () (set-signal! output new-value))))) (add-action! a1 and-action-procedure) (add-action! a2 and-action-procedure) 'ok) ; Logical functions (define (logical-and a b) (cond ((and (= a 0) (= b 0)) 0) ((and (= a 0) (= b 1)) 0) ((and (= a 1) (= b 0)) 0) ((and (= a 1) (= b 1)) 1) (else (error "Invalid signals" a b)))) ; Wires (define (make-wire) (let ((signal-value 0) (action-procedures '())) (define (set-my-signal! new-value) (if (not (= signal-value new-value)) (begin (set! signal-value new-value) (call-each action-procedures)) 'done)) (define (accept-action-procedure! proc) (set! action-procedures (cons proc action-procedures))) (define (dispatch m) (cond ((eq? m 'get-signal) signal-value) ((eq? m 'set-signal!) set-my-signal!) ((eq? m 'add-action!) accept-action-procedure!) (else (error "Unknown operation -- WIRE" m)))) dispatch)) (define (call-each procedures) (if (null? procedures) 'done (begin ((car procedures)) (call-each (cdr procedures))))) (define (get-signal wire) (wire 'get-signal)) (define (set-signal! wire new-value) ((wire 'set-signal!) new-value)) (define (add-action! wire action-procedure) ((wire 'add-action!) action-procedure)) ; The agenda (define (make-time-segment time actions) (cons time actions)) (define (segment-time s) (car s)) (define (segment-actions s) (cdr s)) (define (set-segment-actions! s actions) (set-cdr! s actions)) (define (make-agenda) (list 0)) (define (current-time agenda) (car agenda)) (define (set-current-time! agenda time) (set-car! agenda time)) (define (segments agenda) (cdr agenda)) (define (set-segments! agenda segments) (set-cdr! agenda segments)) (define (first-segment agenda) (car (segments agenda))) (define (rest-segments agenda) (cdr (segments agenda))) (define (empty-agenda? agenda) (null? (segments agenda))) (define (add-to-agenda! time action agenda) (define (belongs-before? segments) (or (null? segments) (< time (segment-time (car segments))))) (define (make-new-time-segment time action) (make-time-segment time (list action))) (define (add-to-segments! segments) (if (= (segment-time (car segments)) time) (set-segment-actions! (car segments) (cons action (segment-actions (car segments)))) (let ((rest (cdr segments))) (if (belongs-before? rest) (set-cdr! segments (cons (make-new-time-segment time action) rest)) (add-to-segments! rest))))) (let ((segments (segments agenda))) (if (belongs-before? segments) (set-segments! agenda (cons (make-new-time-segment time action) segments)) (add-to-segments! segments)))) (define (remove-first-agenda-item! agenda) (set-segment-actions! (first-segment agenda) (cdr (segment-actions (first-segment agenda)))) (if (null? (segment-actions (first-segment agenda))) (set-segments! agenda (rest-segments agenda)) 'done)) (define (first-agenda-item agenda) (if (empty-agenda? agenda) (error "Agenda is empty -- FIRST-AGENDA-ITEM") (let ((first-seg (first-segment agenda))) (set-current-time! agenda (segment-time first-seg)) (car (segment-actions first-seg))))) ; Delays (define inverter-delay 2) (define and-gate-delay 3) (define or-gate-delay 5) ; Simulation infrastructure (define the-agenda (make-agenda)) (define (after-delay delay action) (add-to-agenda! (+ delay (current-time the-agenda)) action the-agenda)) (define (propagate) (if (empty-agenda? the-agenda) 'done (let ((first-item (first-agenda-item the-agenda))) (first-item) (remove-first-agenda-item! the-agenda) (propagate)))) (define (probe name wire) (add-action! wire (lambda () (display name) (display " ") (display (current-time the-agenda)) (display " New-value = ") (display (get-signal wire)) (newline)))) (define input-1 (make-wire)) (define input-2 (make-wire)) (define output (make-wire)) (define carry (make-wire)) (probe 'output output) (and-gate input-1 input-2 output) (set-signal! input-1 0) (set-signal! input-2 1) (propagate) (set-signal! input-1 1) (set-signal! input-2 0) (propagate) ================================================ FILE: scheme/sicp/03/33.scm ================================================ ; SICP exercise 3.33 ; ; Using primitive multiplier, adder, and constant constraints, define a ; procedure averager that takes three connectors a, b and c as inputs and ; establishes the constraint that the value of c is average of the values of a ; and b. ; Averager ; c = (a + b)/2 ; ; 2c = a + b (define (averager a b c) (let ((x (make-connector)) (y (make-connector))) (adder a b x) (multiplier c y x) (constant 2 y) 'ok)) ; Celsius to Fahrenheit converter (define (celsius-fahrenheit-converter c f) (let ((u (make-connector)) (v (make-connector)) (w (make-connector)) (x (make-connector)) (y (make-connector))) (multiplier c w u) (multiplier v x u) (adder v y f) (constant 9 w) (constant 5 x) (constant 32 y) 'ok)) ; Constraints (define (adder a1 a2 sum) (define (process-new-value) (cond ((and (has-value? a1) (has-value? a2)) (set-value! sum (+ (get-value a1) (get-value a2)) me)) ((and (has-value? a1) (has-value? sum)) (set-value! a2 (- (get-value sum) (get-value a1)) me)) ((and (has-value? a2) (has-value? sum)) (set-value! a1 (- (get-value sum) (get-value a2)) me)))) (define (process-forget-value) (forget-value! sum me) (forget-value! a1 me) (forget-value! a2 me) (process-new-value)) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - ADDER" request)))) (connect a1 me) (connect a2 me) (connect sum me) me) (define (multiplier m1 m2 product) (define (process-new-value) (cond ((or (and (has-value? m1) (= (get-value m1) 0)) (and (has-value? m2) (= (get-value m2) 0))) (set-value! product 0 me)) ((and (has-value? m1) (has-value? m2)) (set-value! product (* (get-value m1) (get-value m2)) me)) ((and (has-value? product) (has-value? m1)) (set-value! m2 (/ (get-value product) (get-value m1)) me)) ((and (has-value? product) (has-value? m2)) (set-value! m1 (/ (get-value product) (get-value m2)) me)))) (define (process-forget-value) (forget-value! product me) (forget-value! m1 me) (forget-value! m2 me) (process-new-value)) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - MULTIPLIER" request)))) (connect m1 me) (connect m2 me) (connect product me) me) (define (constant value connector) (define (me request) (error "Unknown request - CONSTANT" request)) (connect connector me) (set-value! connector value me) me) (define (inform-about-value constraint) (constraint 'i-have-a-value)) (define (inform-about-no-value constraint) (constraint 'i-lost-my-value)) ; Connectors (define (make-connector) (let ((value false) (informant false) (constraints '())) (define (set-my-value newval setter) (cond ((not (has-value? me)) (set! value newval) (set! informant setter) (for-each-except setter inform-about-value constraints)) ((not (= value newval)) (error "Contradiction" (list value newval))) (else 'ignored))) (define (forget-my-value retractor) (if (eq? retractor informant) (begin (set! informant false) (for-each-except retractor inform-about-no-value constraints)) 'ignored)) (define (connect new-constraint) (if (not (memq new-constraint constraints)) (set! constraints (cons new-constraint constraints)) #t) (if (has-value? me) (inform-about-value new-constraint) #t) 'done) (define (me request) (cond ((eq? request 'has-value?) (if informant true false)) ((eq? request 'value) value) ((eq? request 'set-value!) set-my-value) ((eq? request 'forget) forget-my-value) ((eq? request 'connect) connect) (else (error "Unknown operator - CONNECTOR" request)))) me)) (define (for-each-except exception procedure list) (define (loop items) (cond ((null? items) 'done) ((eq? (car items) exception) (loop (cdr items))) (else (procedure (car items)) (loop (cdr items))))) (loop list)) (define (has-value? connector) (connector 'has-value?)) (define (get-value connector) (connector 'value)) (define (set-value! connector new-value informant) ((connector 'set-value!) new-value informant)) (define (forget-value! connector retractor) ((connector 'forget) retractor)) (define (connect connector new-constraint) ((connector 'connect) new-constraint)) ; Probe (define (probe name connector) (define (print-probe value) (newline) (display "Probe: ") (display name) (display " = ") (display value)) (define (process-new-value) (print-probe (get-value connector))) (define (process-forget-value) (print-probe "?")) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - PROBE" request)))) (connect connector me) me) ================================================ FILE: scheme/sicp/03/34.scm ================================================ ; SICP exercise 3.34 ; ; Louis Reasoner wants to build a squarer, a constraint device with two ; terminals such that the value of connector b on the second terminal will ; always be the square of the value a on the first terminal. He proposes the ; following simple device made from a multiplier: ; ; (define (squarer a b) ; (multiplier a a b)) ; ; There is a serious flaw in this idea. Explain. ; This will work alright when a is known and b is unknown. In the reverse ; case, however, we have a multiplier with a known product and two unknown ; multiplicands. There is no way to calculate what they are. Thus, it will ; simply not work when a is unknown. ================================================ FILE: scheme/sicp/03/35.scm ================================================ ; SICP exercise 3.35 ; ; Ben Bitdiddle tells Louis that one way to avoid the trouble in exercise 3.34 ; is to define a squarer as a new primitive constraint. Fill in the missing ; portions in Ben's outline for a procedure to implement such a constraint: ; ; (define (squarer a b) ; (define (process-new-value) ; (if (has-value? b) ; (if (< (get-value b) 0) ; (error "square less than 0 - SQUARER" (get-value b)) ; ) ; )) ; (define (process-forget-value) ) ; (define (me request) ) ; > ; me) ; I think a cond would have been nicer, but whatever. Here it is: (define (squarer a b) (define (process-new-value) (if (has-value? b) (if (< (get-value b) 0) (error "square less than 0 - SQUARER" (get-value b)) (set-value! a (sqrt (get-value b)) me)) (if (has-value? a) (if (< (get-value a) 0) (error "does not work with negative numbers - SQUARER" (get-value a)) (set-value! b (square (get-value a)) me)) 'ignored))) (define (process-forget-value) (forget-value! a me) (forget-value! b me) (process-new-value)) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - SQUARER" request)))) (connect a me) (connect b me) me) (define (square x) (* x x)) (define (inform-about-value constraint) (constraint 'i-have-a-value)) (define (inform-about-no-value constraint) (constraint 'i-lost-my-value)) ; Connectors (define (make-connector) (let ((value false) (informant false) (constraints '())) (define (set-my-value newval setter) (cond ((not (has-value? me)) (set! value newval) (set! informant setter) (for-each-except setter inform-about-value constraints)) ((not (= value newval)) (error "Contradiction" (list value newval))) (else 'ignored))) (define (forget-my-value retractor) (if (eq? retractor informant) (begin (set! informant false) (for-each-except retractor inform-about-no-value constraints)) 'ignored)) (define (connect new-constraint) (if (not (memq new-constraint constraints)) (set! constraints (cons new-constraint constraints)) #t) (if (has-value? me) (inform-about-value new-constraint) #t) 'done) (define (me request) (cond ((eq? request 'has-value?) (if informant true false)) ((eq? request 'value) value) ((eq? request 'set-value!) set-my-value) ((eq? request 'forget) forget-my-value) ((eq? request 'connect) connect) (else (error "Unknown operator - CONNECTOR" request)))) me)) (define (for-each-except exception procedure list) (define (loop items) (cond ((null? items) 'done) ((eq? (car items) exception) (loop (cdr items))) (else (procedure (car items)) (loop (cdr items))))) (loop list)) (define (has-value? connector) (connector 'has-value?)) (define (get-value connector) (connector 'value)) (define (set-value! connector new-value informant) ((connector 'set-value!) new-value informant)) (define (forget-value! connector retractor) ((connector 'forget) retractor)) (define (connect connector new-constraint) ((connector 'connect) new-constraint)) ; Probe (define (probe name connector) (define (print-probe value) (newline) (display "Probe: ") (display name) (display " = ") (display value)) (define (process-new-value) (print-probe (get-value connector))) (define (process-forget-value) (print-probe "?")) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - PROBE" request)))) (connect connector me) me) ================================================ FILE: scheme/sicp/03/36.scm ================================================ ; SICP exercise 3.36 ; ; Suppose we evaluate the following sequence of expressions in the global ; environment: ; ; (define a (make-connector)) ; (define b (make-connector)) ; (set-value! a 10 'user) ; ; At some time during evaluation of the set-value!, the following expression ; from the connector's local procedure is evaluated: ; ; (for-each-except ; setter inform-about-value constraints) ; ; Draw an environment diagram showing the environment in which the above ; expression is evaluated ; globals: ; +-------------------------------------------------------------------------+ ; | a: | ; | b: | ; | make-connector: | ; | inform-about-value: | ; | ... | ; +-------------------------------------------------------------------------+ ; ^ ; | ; +------------------------------+ ; | set-my-value: | ; | forget-my-value: | ; | connect: | ; | me: | ; +------------------------------+ ; ^ ; | ; +------------------------------+ ; | value: false | ; | informant: false | ; | constraints: () | ; +------------------------------+ ; ^ ; | ; +------------------------------+ ; | newval: 10 | ; | setter: 'user | ; +------------------------------+ ================================================ FILE: scheme/sicp/03/37.scm ================================================ ; SICP exercise 3.37 ; ; The celsius-fahrenheit-converter procedure is cumbersome when compared with ; a more expression-oriented style of definition, such as ; ; (define (celsius-fahrenheit-converter x) ; (c+ (c* (c/ (cv 9) (cv 5)) ; x) ; (cv 32))) ; ; (define C (make-connector)) ; (define F (celsius-fahrenheit-converter C)) ; ; Here c+, c*, etc. are the "constraint" versions of the arithmetic ; operations. For example, c+ takes two connectors as arguments and returns a ; connector that is related to these by an adder constraint: ; ; (define (c+ x y) ; (let ((z (make-connector))) ; (adder x y z) ; z)) ; ; Define analogous procedures c-, c*, c/ and cv (constant value) that enable ; us to define compound constraints as in the converter example above. ; Celsius to Fahrenheit converter (define (celsius-fahrenheit-converter x) (c+ (c* (c/ (cv 9) (cv 5)) x) (cv 32))) ; Domain-specific language (define (c+ x y) (let ((z (make-connector))) (adder x y z) z)) (define (c* x y) (let ((z (make-connector))) (multiplier x y z) z)) (define (c/ x y) (let ((z (make-connector))) (multiplier y z x) z)) (define (cv c) (let ((z (make-connector))) (constant c z) z)) ; Constraints (define (adder a1 a2 sum) (define (process-new-value) (cond ((and (has-value? a1) (has-value? a2)) (set-value! sum (+ (get-value a1) (get-value a2)) me)) ((and (has-value? a1) (has-value? sum)) (set-value! a2 (- (get-value sum) (get-value a1)) me)) ((and (has-value? a2) (has-value? sum)) (set-value! a1 (- (get-value sum) (get-value a2)) me)))) (define (process-forget-value) (forget-value! sum me) (forget-value! a1 me) (forget-value! a2 me) (process-new-value)) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - ADDER" request)))) (connect a1 me) (connect a2 me) (connect sum me) me) (define (multiplier m1 m2 product) (define (process-new-value) (cond ((or (and (has-value? m1) (= (get-value m1) 0)) (and (has-value? m2) (= (get-value m2) 0))) (set-value! product 0 me)) ((and (has-value? m1) (has-value? m2)) (set-value! product (* (get-value m1) (get-value m2)) me)) ((and (has-value? product) (has-value? m1)) (set-value! m2 (/ (get-value product) (get-value m1)) me)) ((and (has-value? product) (has-value? m2)) (set-value! m1 (/ (get-value product) (get-value m2)) me)))) (define (process-forget-value) (forget-value! product me) (forget-value! m1 me) (forget-value! m2 me) (process-new-value)) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - MULTIPLIER" request)))) (connect m1 me) (connect m2 me) (connect product me) me) (define (constant value connector) (define (me request) (error "Unknown request - CONSTANT" request)) (connect connector me) (set-value! connector value me) me) (define (inform-about-value constraint) (constraint 'i-have-a-value)) (define (inform-about-no-value constraint) (constraint 'i-lost-my-value)) ; Connectors (define (make-connector) (let ((value false) (informant false) (constraints '())) (define (set-my-value newval setter) (cond ((not (has-value? me)) (set! value newval) (set! informant setter) (for-each-except setter inform-about-value constraints)) ((not (= value newval)) (error "Contradiction" (list value newval))) (else 'ignored))) (define (forget-my-value retractor) (if (eq? retractor informant) (begin (set! informant false) (for-each-except retractor inform-about-no-value constraints)) 'ignored)) (define (connect new-constraint) (if (not (memq new-constraint constraints)) (set! constraints (cons new-constraint constraints)) #t) (if (has-value? me) (inform-about-value new-constraint) #t) 'done) (define (me request) (cond ((eq? request 'has-value?) (if informant true false)) ((eq? request 'value) value) ((eq? request 'set-value!) set-my-value) ((eq? request 'forget) forget-my-value) ((eq? request 'connect) connect) (else (error "Unknown operator - CONNECTOR" request)))) me)) (define (for-each-except exception procedure list) (define (loop items) (cond ((null? items) 'done) ((eq? (car items) exception) (loop (cdr items))) (else (procedure (car items)) (loop (cdr items))))) (loop list)) (define (has-value? connector) (connector 'has-value?)) (define (get-value connector) (connector 'value)) (define (set-value! connector new-value informant) ((connector 'set-value!) new-value informant)) (define (forget-value! connector retractor) ((connector 'forget) retractor)) (define (connect connector new-constraint) ((connector 'connect) new-constraint)) ; Probe (define (probe name connector) (define (print-probe value) (newline) (display "Probe: ") (display name) (display " = ") (display value)) (define (process-new-value) (print-probe (get-value connector))) (define (process-forget-value) (print-probe "?")) (define (me request) (cond ((eq? request 'i-have-a-value) (process-new-value)) ((eq? request 'i-lost-my-value) (process-forget-value)) (else (error "Unknown request - PROBE" request)))) (connect connector me) me) ================================================ FILE: scheme/sicp/03/38.scm ================================================ ; SICP exercise 3.38 ; ; Suppose that Peter, Paul and Mary share a joint back account that initially ; contains $100. Concurrently, Peter deposits $10, Paul withdraws $20, and ; Mary withdraws half the money in the account, by executing the following ; commands: ; ; Peter: (set! balance (+ balance 10)) ; Paul: (set! balance (- balance 20)) ; Mary: (set! balance (- balance (/ balance 2))) ; ; a. List all the different possible values for balance after these three ; transactions have been completed, assuming that the banking system forces ; the three processes to run sequentially in some order. ; ; b. What are some other values that could be produced if the system allows ; the processes to be interleaved? Draw timing diagrams like the one in figure ; 3.29 to explain how these values can occur. ; a. The possible values are 35, 40, 45 and 50. To illustrate them, we will ; abbreviate the operations to +10, -20 and /2. Here are the options: ; ; 45: +10, -20, /2 ; 35: +10, /2, -20 ; 45: -20, +10, /2 ; 50: -20, /2, +10 ; 40: /2, +10, -20 ; 40: /2, -20, +10 ; ; b. I hate plurals. One possible value is 30. ; ; Peter Paul Marry ; ----------------------- ----------------------- ----------------------- ; access balance: 100 ; new value: 50 ; set balance: 50 ; access balance: 50 ; access balance: 50 ; new value: 70 ; set balance: 70 ; new value: 30 ; set balance: 30 ; ; Another possible value is 55: ; ; Peter Paul Marry ; ----------------------- ----------------------- ----------------------- ; access balance: 100 ; access balance: 100 ; new value: 110 ; new value: 80 ; set balance: 80 ; set balance: 110 ; access balance: 110 ; new value: 55 ; set balance: 55 ================================================ FILE: scheme/sicp/03/39.scm ================================================ ; SICP exercise 3.39 ; ; Which of the five possibilities in the parallel execution shown above remain ; if we instead serialize exection as follows: ; ; (define x 10) ; ; (define s (make-serializer)) ; ; (parallel-execute ; (lambda () (set! x ((s (lambda () (* x x)))))) ; (s (lambda () (set! x (+ x 1))))) ; If we assume that the lambdas are P1 and P2, then the possible values are: ; ; 101: P1 sets x to 100 and then P2 increments x to x. ; 121: P2 increments x to 11 and then P2 sets x to x. ; 100: P1 accesses x, then P2 sets X to 11, then P1 sets x. ================================================ FILE: scheme/sicp/03/40.scm ================================================ ; SICP exercise 3.40 ; ; Give all possible values of x that can result from executing ; ; (define x 10) ; ; (parallel-execute (lambda () (set! x (* x x))) ; (lambda () (set! x (* x x x)))) ; ; Which of these possibilities remain if we instead use serialized procedures: ; ; (define x 10) ; ; (define s (make-serializer)) ; ; (parallel-execute (s (lambda () (set! x (* x x)))) ; (s (lambda () (set! x (* x x x))))) ; Assuming that (* x x) and (* x x x) is atomic and reads the same x all ; times and that the lambdas are P1 and P2: ; ; 1000000: P1 reads (10) and sets (100), P2 reads (100) and sets (1000000) ; 1000000: P2 reads (10) and sets (1000), P1 reads (1000) and sets (1000000) ; 1000: P1-read (10), P2-read (10), P1-set (100), P2-set (1000) ; 100: P1-read (10), P2-read (10), P2-set (1000), P1-set (100) ; 1000: P2-read (10), P1-read (10), P1-set (100), P2-set (1000) ; 100: P2-read (10), P1-read (10), P2-set (1000), P1-set (100) ; ; If we use the serializer, only the first two option remain. ================================================ FILE: scheme/sicp/03/41.scm ================================================ ; SICP exercise 3.41 ; ; Ben Bitdiddle worries that it would be better to implement the bank account ; as follows (where the commented line has been changed): ; ; (define (make-account balance) ; (define (withdraw amount) ; (if (>= balance amount) ; (begin (set! balance (- balance amount)) ; balance) ; "Insufficient funds")) ; (define (deposit amount) ; (set! balance (+ balance amount)) ; balance) ; (let ((protected (make-serializer))) ; (define (dispatch m) ; (cond ((eq? m 'withdraw) (protected withdraw)) ; ((eq? m 'deposit) (protected deposit)) ; ((eq? m 'balance) (protected (lambda () balance))) ; (else (error "Unknown request - MAKE-ACCOUNT" m)))) ; dispatch)) ; ; because allowing unserialized access to the bank balance can result in ; anomalous behavior. Do you agree? Is there any scenario that demonstrats ; Ben's concern? ; In general - no. It works perfectly fine without serializing the access. ; ; In case we're working with some ancient technology where writes to the ; memory are not atomic, balance might be read while withdraw or deposit are ; in the middle of updating in, thus we can get a jumble of bits that is not ; the real balance. Finding a machine where that could happen in the present ; year, though, might be very expensive. ================================================ FILE: scheme/sicp/03/42.scm ================================================ ; SICP exercise 3.42 ; ; Ben Bitdiddle suggests that it's a waste of time to create a new serialized ; procedure in response to every withdraw and deposit message. He says that ; make-account could be changed so that the calls to protected are done ; outside the dispatch procedure. That is, an account would return the same ; serialized procedure (which was created at the same time as the account) ; each time it is asked for a withdrawal procedure. ; ; (define (make-account balance) ; (define (withdraw amount) ; (if (>= balance amount) ; (begin (set! balance (- balance amount)) ; balance) ; "Insufficient funds")) ; (define (deposit amount) ; (set! balance (+ balance amount)) ; balance) ; (let ((protected (make-serializer))) ; (let ((protected-withdraw (protected withdraw)) ; (protected-deposit (protected deposit))) ; (define (dispatch m) ; (cond ((eq? m 'withdraw) protected-withdraw) ; ((eq? m 'deposit) protected-deposit) ; ((eq? m 'balance) balance) ; (else (error "Unknown request - MAKE-ACCOUNT" m)))) ; dispatch))) ; ; Is this a safe change to make? In particular, is there any difference in ; what concurrency is allowed by these two versions of make-account? ; It actually depends on how make-serializer is implemented. In the original ; version, two withdrawals are two separate procedures that are serialized. In ; Ben's approach, we have one serialized procedure that can be called twice at ; the same time. The question is if the serializer executes those concurrently ; or sequentially. ; ; If execution is sequential (as it should be, if we're using the serializer ; implementation later in the chapter), then the change is not a problem. On ; the other hand, if it is a weird serializer that allows the function to be ; executed twice concurrently, then it is a problem. But I don't think it's ; likely for a serializer to be like that. ================================================ FILE: scheme/sicp/03/43.scm ================================================ ; SICP exercise 3.43 ; ; Suppose that the balances in three accounts start out as $10, $20, and $30, ; and that multiple processes run, exchanging the balances of the accounts. ; Argue that if the processes are run sequentially, after any number of ; concurrent exchanges, the account balances should be $10, $20 and $30 in ; some order. Draw a timing diagram like the one in figure 3.29 to show how ; this condition can be violated if the exchanges are implemented using the ; first version of the account-exchange program in this section. On the other ; hand, argue that even with this exchange program, the sum of the balances in ; the accounts will be preserved. Draw a timing diagram to show how even this ; condition would be violated if we did not serialize the transactions on ; individual accounts. ; Well, exchanging x and y in (x, y, z) will result to (y, x, z). It is the ; same for any other pair. The numbers are preserved, even if the order is ; changed. ; ; (x, y, z) = (10, 20, 30) ; 60 total ; ; (exchange y z) (exchange z x) ; ------------------------------- ------------------------------- ; read y: 20 ; read x: 10 ; difference: 10 ; ; read z: 30 ; read x: 10 ; difference: 20 ; withdraw y 10: 10 ; withdraw z 20: 10 ; deposit x 10: 20 ; deposit x 20: 40 ; ; When the exchanges complete, the account balances will be (40, 10, 10) that ; ammounts to 60 total. In general, once the difference is calculated, when it ; is removed to one account it will be added to another. There is no loss of ; money, even if the balances end up randomly. ; ; If we use the non-serialized access to the accounts, we can easily get this ; situation: ; ; (exchange y z) (exchange z x) ; ------------------------------- ------------------------------- ; read y: 20 ; read x: 10 ; difference: 10 ; ; read z: 30 ; read x: 10 ; difference: 20 ; withdraw y 10 ; read y: 20 ; set y: 10 ; withdraw z 20 ; read z: 30 ; set z: 10 ; deposit x 10 ; read x: 10 ; deposit x 20 ; read x: 10 ; set x: 30 ; set x: 20 ; ; In the end, we get (20, 10, 10) which is a loss of money. Not using a ; serializer just costed the bank 20 bucks. ================================================ FILE: scheme/sicp/03/44.scm ================================================ ; SICP exercise 3.44 ; ; Consider the problem of transferring an amount from one account to another. ; Ben Bitdiddle claims that this can be accomplished with the following ; procedure, even if there are multiple people concurrently transferring money ; among multiple accounts, using any account mechanism that serializes deposit ; and withdrawal transactions, for example, the version of make-account in the ; text above. ; ; (define (transfer from-account to-account amount) ; ((from-account 'withdraw) amount) ; ((to-account 'deposit) amount)) ; ; Louis Reasoner clains that there is a problem here, and that we need to use ; a more sophisticated method, such as the one required for dealing with the ; exchange problem. Is Louis right? If not, what is the essential difference ; between the transfer problem and the exchange problem? (You should assume ; that the balance in from-account is at least amount.) ; Louis is wrong. ; ; The essential difference is that exchanges performs reads prior to writing ; and that what is written depends on what is read. In this example we only ; perform writes and the amount is known in advance (and save, since we know ; that from-account has enough money.) ================================================ FILE: scheme/sicp/03/45.scm ================================================ ; SICP exercise 3.45 ; ; Louis Reasoner thinks our bank-account system is unnecessarily complex and ; error-prone now that deposits and withdrawals aren't automatically ; serialized. He suggests and make-account-and-serializer should have exported ; the serializer (for use by such procedures as serialized-exchange) in ; addition to (rather than instead of) using it to serialize accounts and ; deposists as make-account did. He proposes to redefine accounts as follows: ; ; (define (make-account-and-serializer balance) ; (define (withdraw amount) ; (if (>= balance amount) ; (begin (set! balance (- balance amount)) ; balance) ; "Insufficient funds")) ; (define (deposit amount) ; (set! balance (+ balance amount)) ; balance) ; (let ((balance-serialzier (make-serializer))) ; (define (dispatch m) ; (cond ((eq? m 'withdraw) (balance-serialzier withdraw)) ; ((eq? m 'deposit) (balance-serialzier deposit)) ; ((eq? m 'balance) balance) ; ((eq? m 'serializer) balance-serialzier) ; (else (error "Unknown request - MAKE-ACCOUNT" m)))) ; dispatch)) ; ; Then deposits are handled as with the original make-account: ; ; (define (deposit account amount) ; ((acount 'deposit) amount)) ; ; Explain what is wrong with Louis' reasoning. In particular, consider whan ; happens when serialized-exchange is called. ; The system will deadlock. ; ; When se called serialized-exchange, it will use the serializer of an account ; to execute the exchange procedure. However, exchange will eventually call ; withdraw, which in turn uses the same serializer to modify the amount. ; However, it cannot proceed until exchange is finished - and exchange cannot ; finish until (at least) the withdrawal completes. ================================================ FILE: scheme/sicp/03/46.scm ================================================ ; SICP exercise 3.46 ; ; Suppose that we implement test-and-set! using an ordinary procedure as shown ; in the text, without attempting to make the operation attomic. Draw a timing ; diagram like the one in figure 3.29 to demonstrate how the mutex ; implementation can fail by allowing two processes to acquire the mutex at ; the same time. ; Eh. ; ; (the-mutex 'acquire) (the-mutex 'acquire) ; ------------------------------------- ------------------------------------- ; test-and-set! cell ; test-and-set! cell ; (if (car cell) ; (if (car cell) ; (begin (set-car! cell true) ; false) ; ; (begin (set-car! cell true) ; false) ; (set-car! cell true) ; false ; (set-car! cell true) ; false ; ; Both calls set the variable to false and then return immediatelly. Now the ; mutex has been acquired by two separate processes. ================================================ FILE: scheme/sicp/03/47.scm ================================================ ; SICP exercise 3.47 ; ; A semaphore (of size n) is a generalization of a mutex. Like a mutex, a ; semaphore supports acquire and release operations, but it is more general in ; that up to n processes can acquire it concurrently. Additional processes ; that attempt to acquire the semaphore must wait for release operations. Give ; implementations of semaphores ; ; a. in terms of mutexes ; b. in terms of atomic test-and-set! operations. ; a. (define (make-semaphore n) (let ((lock (make-mutex))) (define (the-semaphore m) (cond ((eq? m 'acquire) (lock 'acquire) (cond ((> n 0) (set! n (- n 1)) (lock 'release)) (else (lock 'release) (the-semaphore 'acquire)))) ((eq? m 'release) (lock 'acquire) (set! n (+ n 1)) (lock 'release)))) the-semaphore)) ; b. This sucks. Oh well. (define (make-semaphore n) (let ((lock (list false))) (define (the-semaphore m) (cond ((eq? m 'acquire) (if (or (= n 0) (test-and-set! lock)) (the-semaphore 'acquire) (begin (set! n (- n 1)) (clear! lock)))) ((eq? m 'release) (if (test-and-set! lock) (the-semaphore 'release) (begin (set! n (+ n 1)) (clear! lock)))))) the-semaphore)) ================================================ FILE: scheme/sicp/03/48.scm ================================================ ; SICP exercise 3.48 ; ; Explain in detail why the deadlock-avoidance method described above, (i.e. ; accounts are numbered, and each process attempts to acquire the ; smaller-numbered account first) avoids deadlock in the exchange problem. ; Rewrite serialzied-exchange to incorporate this idea. (You will also need to ; modify make-account so that each account is created with a number, which can ; be accessed by sending an appropriate message.) ; In order to have a deadlock, we need two processes and are attempting to ; require locks on two resources (x and y). The situation can occur if one ; tries to acquire the locks in order (x, y) and the other in order (y, x). If ; both manage to acquire the first lock before they attempt to require the ; second, a deadlock occurs. ; ; If we order the accounts and acquire locks only in ascending order, this ; situation cannot arise, because both will attempt to acquire the locks in ; order (x, y). ; ; Here's some untested code: ; First, we need a way to generate account numbers. We need to have a lock for ; this, otherwise we might end up with two accounts sharing the same number. (define last-account-number 0) (define account-number-lock (make-mutex)) (define (generate-account-number) (account-number-lock 'acquire) (let ((number last-account-number)) (set! last-account-number (+ last-account-number 1)) (account-number-lock 'release) number)) ; This is how we make accounts with a number: (define (make-account-and-serializer balance) (let ((number (generate-account-number)) (serializer (make-serializer))) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (dispatch m) (cond ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) ((eq? m 'balance) balance) ((eq? m 'serializer) serializer) ((eq? m 'number) number) (else (error "Unknown request - MAKE-ACCOUNT" m)))) dispatch)) ; This is how our serialized-exchange looks like: (define (serialized-exchange account1 account2) (let ((serializer1 (account1 'serializer)) (serializer2 (account2 'serializer))) ((serialize-both exchange acount1 acount2) account1 account2))) ; And this is or auxiliary function. The outer serializer gets invoked first. ; Note, that it doesn't matter whether we lock accounts in ascending or ; descending order, as long as we always lock in the same order. (define (serialize-both proc account1 account2) (if (< (number account1) (number account2)) ((account1 (account2 proc))) ((account2 (account1 proc))))) ================================================ FILE: scheme/sicp/03/49.scm ================================================ ; SICP exercise 3.49 ; ; Give a scenario where the deadlock-avoidance mechanism described above does ; not work. (Hint: In the exchange problem, each process knows in advance ; which accounts it will neet to get access to. Consider a situation where a ; process must get access to some shared resource before it can know which ; additional shared resources it will require.) ; The question pretty much answers itself. Let's say that we need to acquire ; two locks. We need to acquire the first lock in order to determine what ; second lock we need to acquire later. Let's say we need to acquire a in ; order to determine that we need to acquire b second. If the reverse case is ; possible (we acquire b and then we determine that we need to acquire a ; second), there is a possibility of a deadlock. ; ; We can solve this problem by having a third lock we acquire before acquiring ; the first one. ================================================ FILE: scheme/sicp/03/50.scm ================================================ ; SICP exercise 3.50 ; ; Complete the following definition, which generalizes stream-map to allow ; procedures that take multiple arguments analogous to map in section 2.2.1, ; footnote 12. ; ; (define (stream-map proc . argstreams) ; (if ( (car argstreams)) ; the-empty-stream ; ( ; (apply proc (map argstreams)) ; (apply stream-map ; (cons proc (map argstreams)))))) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) ================================================ FILE: scheme/sicp/03/51.scm ================================================ ; SICP exercise 3.51 ; ; In order to take a closer look at delayed evaluation, we will use the ; following procedure, which simply returns its argument after printing it: ; ; (define (show x) ; (display-line x) ; x) ; ; What does the interpreter print in response to evaluating each expression in ; the following sequence? ; ; (define x (stream-map ; show ; (stream-enumerate-interval 0 10))) ; ; (stream-ref x 5) ; (stream-ref x 7) ; This is the output in the streams we've defined so far: ; ; (define x ..) ; 0 ; ; (stream-ref x 5) ; 5 ; 1 ; 2 ; 3 ; 4 ; 5 ; ; (stream-ref x 7) ; 7 ; 6 ; 7 ; ; Note, that if you run this in Racket, it will print only 5 and 7. That's ; because the cars of the streams are also lazy. ================================================ FILE: scheme/sicp/03/52.scm ================================================ ; SICP exercise 3.52 ; ; Consider the sequence of expressions ; ; (define sum 0) ; (define (accum x) ; (set! sum (+ x sum)) ; sum) ; ; (define seq ; (stream-map accum ; (stream-enumerate-interval 1 20))) ; ; (define y (stream-filter even? seq)) ; (define z (stream-filter ; (lambda (x) (= (remainder x 5) 0)) seq)) ; ; (stream-ref y 7) ; (display-stream z) ; ; What is the value of sum after each of the above expressions is evaluated? ; What is the printed response to evaluating the stream-ref and display-stream ; expressions? Would these responses differ if we had implemented (delay ; ) simply as (lambda () ) without using the optimization provided ; by memo-proc? Explain. ; Fully evaluated, seq is: ; ; (1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210) ; ; However, it gets evaluated in parts. Here is how it goes: ; ; (define seq ; (stream-map accum ; (stream-enumerate-interval 1 20))) ; sum = 1 ; ; (define y (stream-filter even? seq)) ; sum = 6 ; ; (define z (stream-filter ; (lambda (x) (= (remainder x 5) 0)) seq)) ; sum = 10 ; ; (stream-ref y 7) ; sum = 136 ; result = 136 ; ; (display-stream z) ; sum = 210 ; output is: ; 10 ; 15 ; 45 ; 55 ; 105 ; 120 ; 190 ; 210 ; ; If we did not memoize the delayed thunk, each subsequent interation of the ; stream would modify the sum. Iterating seq twice would produce different ; results. For, after (define y ...) sum will be 7 and after (define z ...), ; sum will be 17. Each evaluation of a part of the stream will offset the ; elements more and more. ; ; Without this optimization, we cannot iterate a stream twice if there are ; side effects in the stream. ================================================ FILE: scheme/sicp/03/53.scm ================================================ ; SICP exercise 3.53 ; ; Without running the program, describe the elements of the stream defined by ; ; (define s (cons-stream 1 (add-streams s s))) ; Every element is twice the previous, that is (1 2 4 8 16 32 ...), that is ; the powers of two. ================================================ FILE: scheme/sicp/03/54.scm ================================================ ; SICP exercise 3.54 ; ; Define a procedure mul-streams, analogous to add-streams, that produces the ; elementwise product of its two input streams. Use this together with the ; stream of integers to complete the following definition of the stream whose ; nth elemen (counting down from 0) is n + 1 factorial: ; ; (define factorials (cons-stream 1 ; (mul-streams ; ))) (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define (mul-streams a b) (stream-map2 * a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define factorials (stream-cons 1 (mul-streams factorials (stream-cdr integers)))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) ================================================ FILE: scheme/sicp/03/55.scm ================================================ ; SICP exercise 3.55 ; ; Define a procedure partial-sums that takes as argument a stream S and ; returns the stream whose elements are S₀, S₀ + S₁, S₀ + S₁ + S₂, ... . For ; example, (partial-sums integers) should be the stream 1, 3, 6, 10, 15 (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define (mul-streams a b) (stream-map2 * a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (partial-sums stream) (define result (stream-cons (stream-car stream) (add-streams (stream-cdr stream) result))) result) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) ================================================ FILE: scheme/sicp/03/56.scm ================================================ ; SICP exercise 3.56 ; ; A famous problem, first raised by R. Hamming, is to enumerate, in ascending ; order with no repetitions, all positive integers with no prime factors other ; than 2, 3, or 5. One obvious way to do this is to simply test each integer ; in turn to see whether it has any factors other than 2, 3 and 5. But this is ; very inefficient, since, as the integers get larger, fewer and fewer of them ; fit the requirement. As an alternative, let us call the required stream of ; numbers S and notice the following facts about it. ; ; * S begins with 1. ; * The elements of (scale-stream S 2) are also elements of S. ; * The same is true for (scale-stream S 3) and (scale-stream 5 s) ; * There are all the elements of S. ; ; Now all we have to do is combine elements from these sources. For this we ; define a procedure merge that combines two ordered streams into one ordered ; result stream, eliminating repetitions: ; ; (define (merge s1 s2) ; (cond ((stream-null? s1) s2) ; ((stream-null? s2) s1) ; (else ; (let ((s1car (stream-car s1)) ; (s2car (stream-car s2))) ; (cond ((< s1car s2car) ; (stream-cons ; s1car ; (merge (stream-cdr s1) s2))) ; ((> s1car s2car) ; (stream-cons ; s2car ; (merge s1 (stream-cdr s2)))) ; (else ; (stream-cons ; s1car ; (merge (stream-cdr s1) (stream-cdr s2))))))))) ; ; Then the required stream may be constructed with merge, as follows: ; ; (define S (stream-cons 1 (merge ))) ; ; Fill in the missing expressions in the places marked above. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (merge s1 s2) (cond ((stream-null? s1) s2) ((stream-null? s2) s1) (else (let ((s1car (stream-car s1)) (s2car (stream-car s2))) (cond ((< s1car s2car) (stream-cons s1car (merge (stream-cdr s1) s2))) ((> s1car s2car) (stream-cons s2car (merge s1 (stream-cdr s2)))) (else (stream-cons s1car (merge (stream-cdr s1) (stream-cdr s2))))))))) (define (scale-stream stream n) (stream-map (lambda (x) (* x n)) stream)) (define S (stream-cons 1 (merge (scale-stream S 2) (merge (scale-stream S 3) (scale-stream S 5))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) ================================================ FILE: scheme/sicp/03/57.scm ================================================ ; SICP exercise 3.57 ; ; How many additions are performed when we compute the nth Fibonacci number ; using the definition of fibs based on the add-streams procdure? Show that ; the number of additions would be exponentially greater if we had implemented ; (delay ) simply as (lambda () ), without using the optimization ; provided by the memo-proc procedure described in section 3.5.1 ; There are n - 1 additions performed for computing the nth fibonacci number. ; In order to calculate the kth number, we're adding the (k - 1)th and the ; (k - 2)th. ; ; If we don't memoize, we'll have to compute the two previous numbers for each ; number we want to calculate. Recursively. This is the definition of ; exponential. ================================================ FILE: scheme/sicp/03/58.scm ================================================ ; SICP exercise 3.58 ; ; Give an interpretation of the stream computed by the following procedure: ; ; (define (expand num den radix) ; (stream-cons ; (quotient (* num radix) den) ; (expand (remainder (* num radix) den) den radix))) ; ; (quotient is a primitive that returns the integer quotient of two integers.) ; What are the successive elements produced by (expand 1 7 10)? What is ; produced by (expand 3 8 10)? ; It produces the a stream of the digits of the decimal part of num/den in ; radix. (num * radix) / den is the first digit. Then it proceeds to calculate ; the first digit of the remainder of that division, which is the second digit ; of the decimal part of the number. An so on and so forth. ; ; (expand 1 7 10) produces (1 4 2 8 5 7 1 4 2 8 5 7 1 4 2 8 5 7 1 4) ; (expand 3 8 10) produces (3 7 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) ================================================ FILE: scheme/sicp/03/59.scm ================================================ ; SICP exercise 3.59 ; ; Section 2.5.3 we saw how to implement a polynomial arithmetic system ; representing polynomials as lists of terms. In a similar way, we can work ; with power series, such as ; ; x² x³ x⁴ ; eⁿ = 1 + x + ─ + ─── + ───── + … ; 2 3·2 4·3·2 ; ; x² x⁴ ; cosx = 1 - ─ + ───── - … ; 2 4·3·2 ; ; x³ x⁵ ; sinx = x - ─── + ─────── - … ; 3·2 5·4·3·2 ; ; represented as infinite streams. We will represent the series a₀ + a₁x + ; a₂x² + a₃x³ + … as the stream whose elements are the coefficients a₀, a₁, ; a₂, a₃, …. ; ; ; a. The integral of the series a₀ + a₁x + a₂x² + a₃x³ + … is the series ; ; 1 1 1 ; c + a₀x + ─a₁x² + ─a₂x³ + ─a₃x⁴ + … ; 2 3 4 ; ; ; where c is any constant. Define a procedure integrate-series that takes as ; input a stream a₀, a₁, a₂, … representing a power series and returns the ; stream a₀, ½a₁, ⅓a₂, … of coefficients of the non-constant terms of the ; integral series. (Since the result has no constant term, it doesn't ; represent a power series; when we use integrate-series, we will cons on the ; appropriate constant.) ; ; b. The function x ↦ eⁿ is its own derivative. This implies that eⁿ and the ; ingral of eⁿ are the same series, except for the constant term, which is ; e⁰ = 1. Accordingly, we can generate the series for eⁿ as ; ; (define exp-series ; (cons-stream 1 (integrate-series exp-series))) ; ; Show how to generate the series for sine and cosine starting from the facts ; that the given derivative of sine is cosine and the derivative of cosine is ; the negative of sine: ; ; (define cosine-series ; (cons-stream 1 )) ; ; (define sine-series ; (cons-stream 0 )) ; This is ridiculously easy. So easy, I'm shocked how much time it took to ; input the exercise in comparison to solving it. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (neg-stream a) (stream-map - a)) (define (add-streams a b) (stream-map2 + a b)) (define (mul-streams a b) (stream-map2 * a b)) (define (div-streams a b) (stream-map2 / a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (integrate-series stream) (div-streams stream integers)) (define cosine-series (stream-cons 1 (integrate-series (neg-stream sine-series)))) (define sine-series (stream-cons 0 (integrate-series cosine-series))) ================================================ FILE: scheme/sicp/03/60.scm ================================================ ; SICP exercise 3.60 ; ; With power series represented as streams of coefficients as in exercise ; 3.59, adding series is implemented by add-streams. Complete the definition ; of the following procedure for multiplying series: ; ; (define (mul-series s1 s2) ; (cons-stream (add-streams ))) ; ; You can test your procedure by verifying that sin²x + cos²x = 1, using the ; series from exercise 3.59 ; It would have been good if I knew how to multiply series. Anyway, let's say ; we have (a₀ + A)(b₀ + B) where A and B are the remainder of the series. ; Then: ; ; (a₀ + A)(b₀ + B) = a₀b₀ + Ab₀ + Ba₀ + AB = a₀b₀ + a₀B + A(b₀ + B) ; ; In that expression, a₀b₀ is the first element of the series and the rest is ; the remaining elements. The solution is at the end. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (neg-stream a) (stream-map - a)) (define (add-streams a b) (stream-map2 + a b)) (define (mul-streams a b) (stream-map2 * a b)) (define (div-streams a b) (stream-map2 / a b)) (define (scale-stream stream n) (stream-map (lambda (x) (* x n)) stream)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (integrate-series stream) (div-streams stream integers)) (define cosine-series (stream-cons 1 (integrate-series (neg-stream sine-series)))) (define sine-series (stream-cons 0 (integrate-series cosine-series))) (define (mul-series s1 s2) (stream-cons (* (stream-car s1) (stream-car s2)) (add-streams (scale-stream (stream-cdr s2) (stream-car s1)) (mul-series (stream-cdr s1) s2)))) ================================================ FILE: scheme/sicp/03/61.scm ================================================ ; SICP exercise 3.61 ; ; Let S be a power series (exercise 3.59) whose constant term is 1. Suppose we ; want to find the power series 1/S, that is, the series X such that SX = 1. ; Write S = 1 + Sᵣ where Sᵣ is the part of S after the constant term. Then we ; can solve for X as follows: ; ; S·X = 1 ; (1 + Sᵣ)·X = 1 ; X + Sᵣ·X = 1 ; X = 1 - Sᵣ·X ; ; In other words, X is the power series whose constant term is 1 and whose ; higher-order terms are given by the genative of Sᵣ times X. Use this idea to ; write a procedure invert-unit-series that computes 1/S for a power series S ; with constant term 1. You will need to use mul-series from exercise 3.60. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (neg-stream a) (stream-map - a)) (define (add-streams a b) (stream-map2 + a b)) (define (mul-streams a b) (stream-map2 * a b)) (define (div-streams a b) (stream-map2 / a b)) (define (scale-stream stream n) (stream-map (lambda (x) (* x n)) stream)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (integrate-series stream) (div-streams stream integers)) (define cosine-series (stream-cons 1 (integrate-series (neg-stream sine-series)))) (define sine-series (stream-cons 0 (integrate-series cosine-series))) (define (mul-series s1 s2) (stream-cons (* (stream-car s1) (stream-car s2)) (add-streams (scale-stream (stream-cdr s2) (stream-car s1)) (mul-series (stream-cdr s1) s2)))) (define (invert-unit-series series) (stream-cons 1 (neg-stream (mul-series (stream-cdr series) (invert-unit-series series))))) ================================================ FILE: scheme/sicp/03/62.scm ================================================ ; SICP exercise 3.62 ; ; Use the result of exercise 3.60 and exercise 3.61 to define a procedure ; div-series that divides two power series. div-series should work for any two ; series, provided that the denominator series begins with a nonzero constant ; term. (If the denominator has a zero constant term, the div-series should ; signal an error.) Show how to use div-series together with the result of ; exercise 3.59 to generate the power series for tangent. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (neg-stream a) (stream-map - a)) (define (add-streams a b) (stream-map2 + a b)) (define (mul-streams a b) (stream-map2 * a b)) (define (div-streams a b) (stream-map2 / a b)) (define (scale-stream stream n) (stream-map (lambda (x) (* x n)) stream)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (integrate-series stream) (div-streams stream integers)) (define (mul-series s1 s2) (stream-cons (* (stream-car s1) (stream-car s2)) (add-streams (scale-stream (stream-cdr s2) (stream-car s1)) (mul-series (stream-cdr s1) s2)))) (define (invert-unit-series series) (stream-cons 1 (neg-stream (mul-series (stream-cdr series) (invert-unit-series series))))) (define (div-series a b) (if (= (stream-car b) 0) (error "Cannot divide by a power series with constant term = 0") (mul-series a (invert-unit-series b)))) (define cosine-series (stream-cons 1 (integrate-series (neg-stream sine-series)))) (define sine-series (stream-cons 0 (integrate-series cosine-series))) (define tangent-series (div-series sine-series cosine-series)) ================================================ FILE: scheme/sicp/03/63.scm ================================================ ; SICP exercise 3.63 ; ; Louis Reasoner asks why the sqrt-stream procedure was not written in the ; following more straightforward way, without the local variable guesses: ; ; (define (sqrt-stream x) ; (cons-stream 1.0 ; (stream-map (lambda (guess) ; (sqrt-improve guess x)) ; (sqrt-stream x)))) ; ; Alyssa P. Hacker replies that this version of the procedure is considerably ; less efficient because it performs redundant computation. Explain Alyssa's ; answer. Would the two versions still differ in efficiency if our ; implementation of delay used only (lambda () ) without using the ; optimization provided by mem-proc (section 3.5.1)? ; Since sqrt-stream is dependend on itself, every calculation of the (n + 1)th ; term would require calculating the nth term again. This is exponential. By ; using a variable, we're reusing the stream and we don't need to recalculate ; the previous terms. If our delay does not memoize, the two versions would be ; equally slow. ================================================ FILE: scheme/sicp/03/64.scm ================================================ ; SICP exercise 3.64 ; ; Write a procedure stream-limit that takes as arguments a stream and a number ; (the tolerance). It should examine the stream until it finds two successive ; elements that differ in absolute value by less than the tolerance, and ; return the second of the two elements. Using this, we could compute square ; roots up to a given tolerance by ; ; (define (sqrt x tolerance) ; (stream-limit (sqrt-stream x) tolerance)) (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (average a b) (/ (+ a b) 2)) (define (sqrt-improve guess x) (average guess (/ x guess))) (define (sqrt-stream x) (define guesses (stream-cons 1.0 (stream-map (lambda (guess) (sqrt-improve guess x)) guesses))) guesses) (define (stream-limit stream tolerance) (let ((s1 (stream-car stream)) (s2 (stream-car (stream-cdr stream)))) (if (< (abs (- s1 s2)) tolerance) s2 (stream-limit (stream-cdr stream) tolerance)))) (define (sqrt-tolerance number tolerance) (stream-limit (sqrt-stream number) tolerance)) ================================================ FILE: scheme/sicp/03/65.scm ================================================ ; SICP exercise 3.65 ; ; Use the series ; ; 1 1 1 ; ln2 = 1 - ─ + ─ - ─ + … ; 2 3 4 ; ; to compute three sequences of approximations of the natural logarithm of 2, ; in the same way we did above for π. How rapidly do these sequences converge? ; The definitions are at the end of file. You can run it in order to see how ; many steps it takes to converge on a specific tolerance with all the ; sequences. This is the result from running it: ; ; ln2-stream takes 9999 steps to tolerance 0.0001 ; ln2-stream-euler takes 12 steps to tolerance 0.0001 ; ln2-stream-accelarated takes 4 steps to tolerance 0.0001 (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (add-streams a b) (stream-map2 + a b)) (define (neg-stream a) (stream-map - a)) (define (steps-to-tolerance stream tolerance) (define (count stream n) (let ((s1 (stream-car stream)) (s2 (stream-car (stream-cdr stream)))) (if (< (abs (- s1 s2)) tolerance) n (count (stream-cdr stream) (+ n 1))))) (count stream 1)) (define (square x) (* x x)) (define (partial-sums stream) (define result (stream-cons (stream-car stream) (add-streams (stream-cdr stream) result))) result) (define (alternate-signs stream) (stream-cons (stream-car stream) (neg-stream (alternate-signs (stream-cdr stream))))) (define (euler-transform s) (let ((s0 (stream-ref s 0)) (s1 (stream-ref s 1)) (s2 (stream-ref s 2))) (stream-cons (- s2 (/ (square (- s2 s1)) (+ s0 (* -2 s1) s2))) (euler-transform (stream-cdr s))))) (define (make-tableau transform s) (stream-cons s (make-tableau transform (transform s)))) (define (accelarated-sequence transform s) (stream-map stream-car (make-tableau transform s))) (define (ln2-summands n) (stream-cons (/ 1.0 n) (neg-stream (ln2-summands (+ n 1))))) (define ln2-stream (partial-sums (ln2-summands 1))) (define ln2-stream-euler (euler-transform ln2-stream)) (define ln2-stream-accelarated (accelarated-sequence euler-transform ln2-stream)) (define tolerance 0.0001) (printf "ln2-stream takes ~s steps to tolerance ~s\n" (steps-to-tolerance ln2-stream tolerance) tolerance) (printf "ln2-stream-euler takes ~s steps to tolerance ~s\n" (steps-to-tolerance ln2-stream-euler tolerance) tolerance) (printf "ln2-stream-accelarated takes ~s steps to tolerance ~s\n" (steps-to-tolerance ln2-stream-accelarated tolerance) tolerance) ================================================ FILE: scheme/sicp/03/66.scm ================================================ ; SICP exercise 3.66 ; ; Examine the stream (pairs integers integers). Can you make any general ; comments about the order in which the pairs are placed into the stream? For ; example, approximately how many pairs precede the pair (1, 100)? the pair ; (99, 100)? the pair (100, 100)? (If you can make precise mathematical ; statements here, all the better. But feel free to give more qualitative ; answers if you find yourself getting bogged down.) ; The stream looks like this: ; ; (1 1) ; (1 2) ; (2 2) ; (1 3) ; (2 3) ; (1 4) ; (3 3) ; (1 5) ; (2 4) ; (1 6) ; (3 4) ; (1 7) ; (2 5) ; (1 8) ; (4 4) ; (1 9) ; (2 6) ; (1 10) ; (3 5) ; (1 11) ; ; After the first one, every second element starts with 1. If we remove those, ; we get this: ; ; (2 2) ; (2 3) ; (3 3) ; (2 4) ; (3 4) ; (2 5) ; (4 4) ; (2 6) ; (3 5) ; ; We see the same behavior - every second element after the first starts with ; 2. That goes all the way, since the pairs starting with x are interleaved ; with the pairs starting with (x + 1). The interleaving of both streams is ; interleaved with the pairs that start with x - 1. Here are the positions of ; each pair, starting with a specific element ; ; (1 x): 1 2 4 6 8 10 ; (2 x): 3 5 9 13 17 21 ; (3 x): 7 11 19 27 35 43 ; (4 x): 15 23 39 55 71 87 ; ; It is easy to see that (i i) is at the 2ⁱ - 1 position, (i i+1) is 2ⁱ⁻¹ ; positions apart and all other pairs starting with i are 2ⁱ positions apart ; afterwards. ; ; Thus, pos((a b)) is ; ; b - a = 0, 2ⁱ - 1 ; b - a ≥ 1, 2ⁱ - 1 + 2ⁱ⁻¹ + (b-a-1)2ⁱ (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (interleave s1 s2) (if (stream-null? s1) s2 (stream-cons (stream-car s1) (interleave s2 (stream-cdr s1))))) (define (pairs s t) (stream-cons (list (stream-car s) (stream-car t)) (interleave (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (pairs (stream-cdr s) (stream-cdr t))))) (define int-pairs (pairs integers integers)) (define (location stream pair) (define (count stream n) (if (equal? (stream-car stream) pair) n (count (stream-cdr stream) (+ n 1)))) (count stream 1)) (define (position pair) (let* ((a (car pair)) (b (cadr pair)) (first (- (expt 2 a) 1)) (second (expt 2 (- a 1)))) (cond ((= a b) first) ((= (+ a 1) b) (+ first second)) (else (+ first second (* (- b a 1) (expt 2 a))))))) ================================================ FILE: scheme/sicp/03/67.scm ================================================ ; SICP exercise 3.67 ; ; Modify the pairs procedure so that (pairs integers integers) will produce ; the stream of all pairs of integers (i, j) (without the condition i ≤ j). ; Hint: You will need to mix in an additional stream. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (interleave s1 s2) (if (stream-null? s1) s2 (stream-cons (stream-car s1) (interleave s2 (stream-cdr s1))))) (define (pairs s t) (stream-cons (list (stream-car s) (stream-car t)) (interleave (interleave (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (stream-map (lambda (x) (list x (stream-car t))) (stream-cdr s))) (pairs (stream-cdr s) (stream-cdr t))))) (define int-pairs (pairs integers integers)) (display (stream-take int-pairs 100)) ================================================ FILE: scheme/sicp/03/68.scm ================================================ ; SICP exercise 3.68 ; ; Louis Reasoner thinks that building a stream of pairs from three pars in ; unnecessarily complicated. Instead of separating the pair (S₀, T₀) from the ; rest of the pairs in the first row, he proposes to work with the whole first ; row, as follows: ; ; (define (pairs s t) ; (interleave (stream-map (lambda (x) (list (stream-car s) x)) ; t) ; (pairs (stream-cdr s) (stream-cdr t)))) ; ; Does this work? Consider what happens if we evaluate (pairs integers ; integers) using Louis's definition of pairs. ; Although conceptually sound, this doesn't work in practice. When pairs is ; called, it has to execute interleave. Before doing that, it needs to ; evaluate the arguments, the second of which is a call to pairs. Since call ; is not delayed, we end up in an recursion, where pairs keeps calling itself ; with the cdr's of its arguments. Since both streams are infinite, this is ; never bound to end. ================================================ FILE: scheme/sicp/03/69.scm ================================================ ; SICP exercise 3.69 ; ; Write a procedure triples that takes three infinite streams, S, T and U and ; produces the stream of triples (Sᵢ, Tᵣ, Uᵥ) such that i ≤ r ≤ v. Use triples ; to generate the stream of all Pythagorean triples of positive integers, i.e. ; the triples (i, j, k) such that i ≤ j and i² + j² = k². (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (interleave s1 s2) (if (stream-null? s1) s2 (stream-cons (stream-car s1) (interleave s2 (stream-cdr s1))))) (define (pairs s t) (stream-cons (list (stream-car s) (stream-car t)) (interleave (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (pairs (stream-cdr s) (stream-cdr t))))) (define (triples s t u) (stream-cons (list (stream-car s) (stream-car t) (stream-car u)) (interleave (stream-map (lambda (x) (append (list (stream-car s)) x)) (stream-cdr (pairs t u))) (triples (stream-cdr s) (stream-cdr t) (stream-cdr u))))) (define int-triples (triples integers integers integers)) (define (square x) (* x x)) (define (pythagorean? triple) (let ((a (car triple)) (b (cadr triple)) (c (caddr triple))) (= (+ (square a) (square b)) (square c)))) (define pythagorean-triples (stream-filter pythagorean? int-triples)) ================================================ FILE: scheme/sicp/03/70.scm ================================================ ; SICP exercise 3.70 ; ; It would be nice to be able to generate streams in which the pairs appear in ; some useful order, rather than in the order that results from an ad hoc ; interleaving process. We can use a technique similar to the merge procedure ; in figure 3.56, if we define a way to say that one pair of integers is "less ; than" another. One way to do this is to define a "weighting function" ; W(i, j) and stipulate that (i₁, j₁) is less than (i₂, j₂) if ; W(i₁, j₁) < W(i₂, j₂). Write a procedure merge-weighted that is like merge, ; except that merge-weighted takes an additional argument weight, which is a ; procedure that computes the weight of a pair, and is used to determine the ; order in which elements should appear in the resulting merged stream. Using ; this, generalize pairs to a procedure weighted-pairs that takes two streams, ; together with a procedure that computes a weighting function, and generates ; the stream of pairs, ordered according to weight. Use your procedure to ; generate ; ; a. the stream of all pairs of positive integers (i, j) with i ≤ j ordered ; according to the sum i + j ; ; b. the stream of all pairs of positive integers (i, j) with i ≤ j, where ; neither i nor j is divisable by 2, 3, or 5 and the pairs are ordered ; according to the sum 2i + 3j + 5ij. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (merge-weighted s t weight) (let* ((s0 (stream-car s)) (t0 (stream-car t)) (s0w (weight s0)) (t0w (weight t0))) (if (< s0w t0w) (stream-cons s0 (merge-weighted (stream-cdr s) t weight)) (stream-cons t0 (merge-weighted s (stream-cdr t) weight))))) (define (weighted-pairs s t weight) (stream-cons (list (stream-car s) (stream-car t)) (merge-weighted (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (weighted-pairs (stream-cdr s) (stream-cdr t) weight) weight))) (define (a-pairs) (define (pair-sum pair) (+ (car pair) (cadr pair))) (weighted-pairs integers integers pair-sum)) (define (b-pairs) (define (useful? integer) (not (or (= (remainder integer 2) 0) (= (remainder integer 3) 0) (= (remainder integer 5) 0)))) (define (weight pair) (let ((i (car pair)) (j (cadr pair))) (+ (* 2 i) (* 3 j) (* 5 i j)))) (define useful-integers (stream-filter useful? integers)) (weighted-pairs useful-integers useful-integers weight)) ================================================ FILE: scheme/sicp/03/71.scm ================================================ ; SICP exercise 3.71 ; ; Numbers that can be expressed as the sum of two cubes in more than one way ; are sometimes called Ramanujan numbers, in honor of the mathematician ; Srinivasa Ramanujan. Ordered streams of pairs provide an elegant solution to ; the problem of computing these numbers. To find a number that can be written ; as the sum of two cubes in two different ways, we need only generate the ; stream of pairs of integers (i, j) weighted according to the sum i^3 + j^3 ; (see exercise 3.70), then search the stream for two consecutive pairs with ; the same weight. Write a procedure to generate the Ramanujan numbers. The ; first such number is 1,729. What are the next five? (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (merge-weighted s t weight) (let* ((s0 (stream-car s)) (t0 (stream-car t)) (s0w (weight s0)) (t0w (weight t0))) (if (< s0w t0w) (stream-cons s0 (merge-weighted (stream-cdr s) t weight)) (stream-cons t0 (merge-weighted s (stream-cdr t) weight))))) (define (weighted-pairs s t weight) (stream-cons (list (stream-car s) (stream-car t)) (merge-weighted (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (weighted-pairs (stream-cdr s) (stream-cdr t) weight) weight))) (define (ramanujan-numbers) (define (cube x) (* x x x)) (define (weight pair) (+ (cube (car pair)) (cube (cadr pair)))) (define ordered-integers (weighted-pairs integers integers weight)) (define (filter-ramanujan stream) (let ((p1 (stream-car stream)) (p2 (stream-car (stream-cdr stream)))) (if (= (weight p1) (weight p2)) (stream-cons (weight p1) (filter-ramanujan (stream-cdr stream))) (filter-ramanujan (stream-cdr stream))))) (filter-ramanujan ordered-integers)) ================================================ FILE: scheme/sicp/03/72.scm ================================================ ; SICP exercise 3.72 ; ; In a similar way to exercise 3.72 generate a stream of all numbers that can ; be written as the sum of two squares in three different ways (showing how ; they can be so written). (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (merge-weighted s t weight) (let* ((s0 (stream-car s)) (t0 (stream-car t)) (s0w (weight s0)) (t0w (weight t0))) (if (< s0w t0w) (stream-cons s0 (merge-weighted (stream-cdr s) t weight)) (stream-cons t0 (merge-weighted s (stream-cdr t) weight))))) (define (weighted-pairs s t weight) (stream-cons (list (stream-car s) (stream-car t)) (merge-weighted (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) (weighted-pairs (stream-cdr s) (stream-cdr t) weight) weight))) (define (three-ways-of-two-squares) (define (square x) (* x x)) (define (weight pair) (+ (square (car pair)) (square (cadr pair)))) (define (uniq stream) (if (= (stream-car stream) (stream-car (stream-cdr stream))) (uniq (stream-cons (stream-car stream) (stream-cdr (stream-cdr stream)))) (stream-cons (stream-car stream) (uniq (stream-cdr stream))))) (define ordered-integers (weighted-pairs integers integers weight)) (define (filter-numbers stream) (let ((p1 (stream-car stream)) (p2 (stream-car (stream-cdr stream))) (p3 (stream-car (stream-cdr (stream-cdr stream))))) (if (= (weight p1) (weight p2) (weight p3)) (stream-cons (weight p1) (filter-numbers (stream-cdr stream))) (filter-numbers (stream-cdr stream))))) (uniq (filter-numbers ordered-integers))) ================================================ FILE: scheme/sicp/03/73.scm ================================================ ; SICP exercise 3.73 ; ; We can model electrical circuits using streams to represent the values of ; currents or voltages at a sequence of times. For instance, suppose we have ; an RC circuit consisting of a resistor of resistance R and a capacitor C in ; series. The voltage response v of the circuit to an injected current i is ; determined by the formula in figure 3.33, whose structure is shown by the ; accomplanying signal-flow diagram: ; ; [figure 3.33] ; ; Write a procedure RC that models this circuit. RC should take as inputs the ; values of R, C, and dt and should return a procedure that takes as inputs a ; stream representing the current i and an initial value for the capacitor ; voltage v₀ and produces as output the stream of voltages v. For example, you ; should be able to use RC to model an RC circuit with R = 5 ohms, C = 1 ; farad, and 0.5-second time step by evaluating (define RC1 (RC 5 1 0.5)). ; This defines RC1 as a procedure that takes a stream representing the time ; sequence of currents and an initial capacitor voltage and produces the ; output stream of voltages. ; Man, this brings me a long time back. Also, I have no idea what I'm doing. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define (scale-stream stream n) (stream-map (lambda (x) (* n x)) stream)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define ones-and-zeroes (stream-cons 1 (stream-cons 0 ones-and-zeroes))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (integral integrand initial-value dt) (define int (stream-cons initial-value (add-streams (scale-stream integrand dt) int))) int) (define (RC resistance capacity dt) (define (result stream initial-voltage) (add-streams (scale-stream stream resistance) (integral (scale-stream stream (/ 1 capacity)) initial-voltage dt))) result) (define RC1 (RC 5 1 0.5)) ================================================ FILE: scheme/sicp/03/74.scm ================================================ ; SICP exercise 3.74 ; ; Alyssa P. Hacker is designing a system to process signals coming from ; physical sensors. One important feture she wishes to produce is a signal ; that describes the zero corssings of the input signal. That is, the ; resulting singal should be +1 whenever the input signal changes form ; negative to positive, -1 whenever the input signal changes from positive to ; negative and 0 otherwise. (Assume that the sign of 0 input is positive.) For ; example, a typical input signal with its associated zero-crossing signal ; would be: ; ; ...1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4... ; ...0 0 0 0 0 -1 0 0 0 0 1 0 0... ; ; In Alyssa's system, the signal from the sensor is represented as a stream ; sense-data and the stream zero-crossings is the corresponding stream of zero ; crossings. Alyssa first writes a procedure sign-change-detector that takes ; two values as arguments and compares the signs of the values to produce an ; appropriate 0, 1, or -1. She then constructs her zero-crossing stream as ; follows: ; ; (define (make-zero-crossings input-stream last-value) ; (cons-stream ; (sign-change-detector (stream-car input-stream) ; last-value) ; (make-zero-crossings (stream-cdr input-stream) ; (stream-car input-stream)))) ; ; (define zero-crossings (make-zero-crossings sense-data 0)) ; ; Alyssa's boss, Eva Lu Ator, walks by and suggests that this program is ; approximately equivalent to the following one, which uses the generalized ; version of stream-map from exercise 3.50 ; ; (define zero-crossings ; (stream-map sign-change-detector sense-data )) ; ; Complete the program by supplying the indicated . (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (sign-change-detector a b) (cond ((and (< b 0) (< 0 a)) 1) ((and (< a 0) (< 0 b)) -1) (else 0))) (define (make-zero-crossings input-stream last-value) (stream-cons (sign-change-detector (stream-car input-stream) last-value) (make-zero-crossings (stream-cdr input-stream) (stream-car input-stream)))) (define (make-zero-crossings-with-map sense-data) (stream-map2 sign-change-detector sense-data (stream-cons 0 sense-data))) ================================================ FILE: scheme/sicp/03/75.scm ================================================ ; SICP exercise 3.75 ; ; Unfortunately, Alyssa's zero-crossing detector in exercise 3.74 provides to ; be insufficient, because the nosiy signal from the sensor leads to spurious ; zero-crossings. Lem E. Tweakit, a hardware specialist, suggests that Alyssa ; smooth the signal to filter out the noise before extracting the zero ; crossings. Alyssa takes his advice and decides to extract the zero crossings ; from the signal constructed by averaging each value of the sense data with ; the previous value. She explains the problem to her assistant, Louis ; Reasoner, who attempts to implement the idea, altering Alyssa's program as ; follows: ; ; (define (make-zero-crossings input-stream last-value) ; (let ((avpt (/ (+ (stream-car input-stream) ; last-value) ; 2))) ; (cons-stream (sign-change-detector avpt last-value) ; (make-zero-crossings ; (stream-cdr input-stream) avpt)))) ; ; This does not correctly implement Alyssa's plan. Fidn the bug that Louis has ; installed and fix it without changing the structure of the program. (Hint: ; You will need to increase the number of arguments to make-zero-crossings.) ; The problem is that it does not average each element with the previous, but ; with the average of the previous and its previous' average. This offsets the ; whole calculation. Here's the real implementation. For a change, no tests, ; since testing this is tricky. (define (make-zero-crossings input-stream last-value last-avpt) (let ((avpt (/ (+ (stream-car input-stream) last-value) 2))) (cons-stream (sign-change-detector avpt last-value) (make-zero-crossings (stream-cdr input-stream) (stream-car input-stream) avpt)))) ================================================ FILE: scheme/sicp/03/76.scm ================================================ ; SICP exercise 3.76 ; ; Eva Lu Ator has a criticism of Louis's approach in exercise 3.75. The ; program he wrote is not modular, because it intermixes the operation of ; smoothing with the zero-crossing extraction. For example, the extractor ; should not have to be changed if Alyssa finds a better way to condition her ; input signal. Help Louis by writing a procedure smooth that takes a stream ; as input and produces a stream in which each element is the average of two ; succesive input stream elements. Then use smooth as a component to implement ; the zero-crossing detector in a more modular style. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (sign-change-detector a b) (cond ((and (< b 0) (< 0 a)) 1) ((and (< a 0) (< 0 b)) -1) (else 0))) (define (smooth stream) (define (smooth-stream stream prev) (let ((first (stream-car stream)) (rest (stream-cdr stream))) (stream-cons (/ (+ first prev) 2.0) (smooth-stream rest prev)))) (stream-cons (stream-car stream) (smooth-stream (stream-cdr stream) (stream-car stream)))) (define (make-zero-crossings input-stream last-value) (let ((smooth-stream (smooth input-stream))) (stream-map2 sign-change-detector smooth-stream (stream-cons 0 smooth-stream)))) ================================================ FILE: scheme/sicp/03/77.scm ================================================ ; SICP exercise 3.77 ; ; The integral procedure used above was analogous to the "implicit" definition ; of the infinite stream of integers in section 3.5.2. Alternatively, we can ; give a definition of integral that is more like integres-strating-from (also ; in section 3.5.2): ; ; (define (integral integrand initial-value dt) ; (cons-stream initial-value ; (if (stream-null? integrand) ; the-empty-stream ; (integral (stream-cdr integrand) ; (+ (* dt (stream-car integrand)) ; initial-value) ; dt)))) ; ; When used in systems with loops, this procedure has the same problem as does ; our original version of integral. Modify the procedure so that it expects ; the integrand as a delayed argument and hence can be used in the solve ; procedure shown above. ; This is very hard to test, given how Racket works. Anyway: (define (integral delayed-integrand initial-value dt) (cons-stream initial-value (if (stream-null? delayed-integrand) the-empty-stream (let ((integrand (force delayed-integrand))) (integral (delay (stream-cdr integrand)) (+ (* dt (force (stream-car integrand))) initial-value) dt))))) ================================================ FILE: scheme/sicp/03/78.scm ================================================ ; SICP exercise 3.78 ; ; Consider the problem of designing a signal-processing system to study the ; homogeneous second-order linear differential equation ; ; d²y dy ; ─── - a── - by = 0 ; dt² dt ; ; The output stream, modeling y, is generated by a network that contains a ; loop. This is because the value of d²y/dt² depends upon the values of y and ; dy/dt and both of these are determined by integrating d²y/dt². The diagram ; we would like to encode is shown in figure 3.35. Write a procedure solve-2nd ; that takes as arguments the constants a, b and dt and the initial values y₀ ; and dy₀ for y and dy/dt and generates the stream of successive values of y. (define (solve-2nd a b dt y0 dy0) (define y (integral (delay dy) y0 dt)) (define dy (integral (delay ddy) dy0 dt)) (define ddy (add-streams (scale-stream dy a) (scale-stream y b))) y) ================================================ FILE: scheme/sicp/03/79.scm ================================================ ; SICP exercise 3.79 ; ; Generlize the solve-2nd procedure of exercise 3.78 so that it can be used to ; solve general second-order differential equations d²y/dt² = f(dy/dt, y). (define (solve-2nd-generic f y0 dy0 dt) (define y (integral (delay dy) y0 dt)) (define dy (integral (delay ddy) dy0 dt)) (define ddy (stream-map f dy y)) y) ================================================ FILE: scheme/sicp/03/80.scm ================================================ ; SICP exercise 3.80 ; ; A series RLC circuit consists of a resistor, a capacitor, and an inductor ; connected in series, as shown in figure 3.36. If R, L, and C are the ; resistance, inductance and capacitance, then the relations between voltage ; (v) and current (i) for the three components are described by the equations ; ; v(R) = i(R)R ; ; di(L) ; v(L) = L───── ; dt ; ; dv(C) ; i(C) = C───── ; dt ; ; and the circuit connections dictate the relations ; ; i(R) = i(L) = -i(C) ; v(C) = v(L) + v(R) ; ; Combining these equations shows that the state of the circuit (summarized by ; v(C), the voltage accross the capacitor, and i(L), the current in the ; inductor) is described by the pair of differential equations ; ; dv(C) i(L) ; ───── = - ──── ; dt C ; ; di(L) 1 R ; ───── = ─v(C) - ─i(L) ; dt L L ; ; The signal-flow diagram representing this system of differential equations ; is shown in figure 3.37. ; ; Write a procedure RLC that takes as arguments the parameters R, L, and C of ; the circuit and the time increment dt. In a manner similar to that of the RC ; procedure of exercise 3.73, RLC should produce a procedure that takes the ; initial values of the state variables, v(C₀) and i(L₀), and produces a pair ; (using cons) of the streams of states v(C) and i(L). Using RLC, generate the ; pair of streams that models the behavior of a series RLC circuit with R = 1 ; ohm, C = 0.2 farad, L = 1 henry, dt = 0.1 second, and initial values i(L₀) = ; 0 amps and v(C₀) = 10 volts. ; Wow. The electronics here are beyond me. To be honest - the math too. ; Anyway: (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (add-streams a b) (stream-map2 + a b)) (define (scale-stream stream n) (stream-map (lambda (x) (* n x)) stream)) (define ones (stream-cons 1 ones)) (define integers (stream-cons 1 (add-streams ones integers))) (define ones-and-zeroes (stream-cons 1 (stream-cons 0 ones-and-zeroes))) (define (stream-map2 proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map2 (cons proc (map stream-cdr argstreams)))))) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define (integral delayed-integrand initial-value dt) (define int (stream-cons initial-value (add-streams (scale-stream (force delayed-integrand) dt) int))) int) (define (RLC R L C dt) (lambda (vc0 il0) (define vc (integral (delay dvc) vc0 dt)) (define il (integral (delay dil) il0 dt)) (define dvc (scale-stream il (- (/ 1 C)))) (define dil (add-streams (scale-stream vc (/ 1 L)) (scale-stream il (- (/ R L))))) (stream-map2 cons vc il))) (define RLC1 (RLC 1 1 0.2 0.1)) ================================================ FILE: scheme/sicp/03/81.scm ================================================ ; SICP exercise 3.81 ; ; Exercise 3.6 discussed generalizing the random-number generator to allow one ; to reset the random-number sequence so as to produce repeatable sequences of ; "random" numbers. Produce a stream formulation of this same generator that ; operates on an input stream of requests to generate a new random number or ; to reset the sequence to a specified value and that produces the desired ; stream of random numbers. Don't use assignment in your solution. (define stream-take '()) (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define (stream-take stream n) (if (= n 0) '() (cons (stream-car stream) (stream-take (stream-cdr stream) (- n 1))))) (define random-init (current-milliseconds)) (define (rand-update number) (let ((modulus 4294967296) (multiplier 1664525) (increment 1013904223)) (modulo (+ (* multiplier number) increment) modulus))) (define (random-numbers requests) (define (next seed requests) (cond ((stream-null? requests) the-empty-stream) ((eq? (stream-car requests) 'generate) (let ((generated (rand-update seed)) (rest (stream-cdr requests))) (stream-cons generated (next generated rest)))) ((eq? (stream-car requests) 'reset) (let ((new-seed (stream-car (stream-cdr requests))) (rest (stream-cdr (stream-cdr requests)))) (next new-seed rest))))) (next random-init requests)) ================================================ FILE: scheme/sicp/03/82.scm ================================================ ; SICP exercise 3.82 ; ; Redo exercise 3.5 on Monte Carlo integration in terms of streams. The stream ; version of estimate-integral will not have an argument telling how many ; trials to perform. Instead, it will produce a stream of estimates based on ; succesively more trials. (define the-empty-stream empty-stream) (define stream-null? stream-empty?) (define stream-car stream-first) (define stream-cdr stream-rest) (define random-modulus 4294967296) (define random-init (modulo (current-milliseconds) random-modulus)) (define (rand-update number) (let ((modulus random-modulus) (multiplier 1664525) (increment 1013904223)) (modulo (+ (* multiplier number) increment) modulus))) (define random-integers (stream-cons random-init (stream-map rand-update random-integers))) (define random-floats (stream-map (lambda (x) (exact->inexact (/ x random-modulus))) random-integers)) (define (monte-carlo experiment-stream passed failed) (define (next passed failed) (stream-cons (/ passed (+ passed failed)) (monte-carlo (stream-cdr experiment-stream) passed failed))) (if (stream-car experiment-stream) (next (+ passed 1) failed) (next passed (+ failed 1)))) (define (map-successive-pairs f s) (stream-cons (f (stream-car s) (stream-car (stream-cdr s))) (map-successive-pairs f (stream-cdr (stream-cdr s))))) (define (estimate-integral predicate x1 x2 y1 y2) (define (scale-within value low high) (+ (* value (- high low)) low)) (define experiment-stream (map-successive-pairs (lambda (a b) (predicate (scale-within a x1 x2) (scale-within b y1 y2))) random-floats)) (monte-carlo experiment-stream 0 0)) (define (estimate-pi tries) (define (circle x y) (<= (+ (* x x) (* y y)) 1)) (* (stream-ref (estimate-integral circle -1 1 -1 1) tries) 4.0)) ================================================ FILE: scheme/sicp/03/tests/01-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../01.scm") (define sicp-3.01-tests (test-suite "Tests for SICP exercise 3.01" (check-equal? ((make-accumulator 10) 5) 15) (test-begin (let ((accumulator (make-accumulator 0))) (accumulator 10) (accumulator 20) (check-equal? (accumulator 30) 60))) (test-begin (let ((first (make-accumulator 0)) (second (make-accumulator 0))) (check-equal? (first 10) 10) (check-equal? (second 20) 20) (check-equal? (first 10) 20) (check-equal? (second 20) 40))) )) (run-tests sicp-3.01-tests) ================================================ FILE: scheme/sicp/03/tests/02-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../02.scm") (define sicp-3.02-tests (test-suite "Tests for SICP exercise 3.02" (test-begin (let ((s (make-monitored sqrt))) (check-equal? (s 100) 10) (check-equal? (s 'how-many-calls?) 1))) (test-begin (let ((s (make-monitored sqrt))) (s 100) (s 100) (s 100) (check-equal? (s 'how-many-calls?) 3))) (test-begin (let ((s (make-monitored sqrt))) (s 100) (s 'reset-count) (check-equal? (s 'how-many-calls?) 0))) )) (run-tests sicp-3.02-tests) ================================================ FILE: scheme/sicp/03/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../03.scm") (define sicp-3.03-tests (test-suite "Tests for SICP exercise 3.03" (test-begin (let ((account (make-account 100 'secret))) (check-equal? ((account 'deposit 'secret) 0) 100) (check-equal? ((account 'deposit 'secret) 50) 150) (check-equal? ((account 'withdraw 'secret) 100) 50) (check-equal? ((account 'withdraw 'secret) 100) "Insufficient funds"))) (test-begin (let ((account (make-account 100 'secret))) (check-equal? ((account 'deposit 'wrong) 0) "Incorrect password") (check-equal? ((account 'deposit 'secret) 0) 100))) )) (run-tests sicp-3.03-tests) ================================================ FILE: scheme/sicp/03/tests/04-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../04.scm") (define cops-called #f) (define (call-the-cops) (set! cops-called #t)) (define sicp-3.04-tests (test-suite "Tests for SICP exercise 3.04" (before (set! cops-called #f) (test-begin (let ((account (make-account 100 'secret))) (check-equal? ((account 'deposit 'secret) 0) 100) (check-equal? ((account 'deposit 'secret) 50) 150) (check-equal? ((account 'withdraw 'secret) 100) 50) (check-equal? ((account 'withdraw 'secret) 100) "Insufficient funds"))) (test-begin (let ((account (make-account 100 'secret))) (check-equal? ((account 'deposit 'wrong) 0) "Incorrect password") (check-equal? ((account 'deposit 'secret) 0) 100))) (test-begin (let ((account (make-account 100 'secret))) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'secret) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) (check-equal? cops-called #f))) (test-begin (let ((account (make-account 100 'secret))) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) ((account 'withdraw 'wrong) 10) (check-equal? cops-called #t)))) )) (run-tests sicp-3.04-tests) ================================================ FILE: scheme/sicp/03/tests/05-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../05.scm") (define sicp-3.05-tests (test-suite "Tests for SICP exercise 3.05" (check-= (estimate-pi) 3.14 0.01) )) (run-tests sicp-3.05-tests) ================================================ FILE: scheme/sicp/03/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../07.scm") (define sicp-3.07-tests (test-suite "Tests for SICP exercise 3.07" (test-begin (let* ((peter-acc (make-account 100 'open-sesame)) (paul-acc (make-joint peter-acc 'open-sesame 'rosebud))) ((paul-acc 'deposit 'rosebud) 10) ((paul-acc 'withdraw 'rosebud) 50) (check-equal? ((peter-acc 'deposit 'open-sesame) 0) 60))) (test-begin (let* ((peter-acc (make-account 100 'open-sesame)) (paul-acc (make-joint peter-acc 'open-sesame 'rosebud))) (check-equal? ((paul-acc 'deposit 'wrong) 0) "Incorrect password"))) )) (run-tests sicp-3.07-tests) ================================================ FILE: scheme/sicp/03/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../16.scm") (define sicp-3.16-tests (test-suite "Tests for SICP exercise 3.16" (check-equal? (count-pairs three) 3) (check-equal? (count-pairs four) 4) (check-equal? (count-pairs seven) 7) )) (run-tests sicp-3.16-tests) ================================================ FILE: scheme/sicp/03/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../17.scm") (define a '(a)) (define b (cons 'b a)) (define c (cons a a)) (define three '(a b c)) (define four (cons b a)) (define seven (cons c c)) (define sicp-3.17-tests (test-suite "Tests for SICP exercise 3.17" (check-equal? (count-pairs three) 3) (check-equal? (count-pairs four) 3) (check-equal? (count-pairs seven) 3) )) (run-tests sicp-3.17-tests) ================================================ FILE: scheme/sicp/03/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../18.scm") (define sicp-3.18-tests (test-suite "Tests for SICP exercise 3.18" (check-true (has-cycle? (make-cycle '(a b c d)))) (check-false (has-cycle? '(a b c d))) )) (run-tests sicp-3.18-tests) ================================================ FILE: scheme/sicp/03/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../19.scm") (define sicp-3.19-tests (test-suite "Tests for SICP exercise 3.19" (check-true (has-cycle? (make-cycle '(a b c d)))) (check-true (has-cycle? (make-cycle '(a b c d e)))) (check-false (has-cycle? '())) (check-false (has-cycle? '(a))) (check-false (has-cycle? '(a b))) (check-false (has-cycle? '(a b c))) (check-false (has-cycle? '(a b c d))) )) (run-tests sicp-3.19-tests) ================================================ FILE: scheme/sicp/03/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../21.scm") (define sicp-3.21-tests (test-suite "Tests for SICP exercise 3.21" (test-begin "print-queue" (define q (make-queue)) (insert-queue! q 'a) (insert-queue! q 'b) (insert-queue! q 'c) (check-equal? (with-output-to-string (lambda () (print-queue q))) "#\n")) (test-suite "queue operations" (test-begin "insert-queue!" (define q (make-queue)) (insert-queue! q 'a) (check-equal? 'a (front-queue q))) (test-begin "delete-queue!" (define q (make-queue)) (insert-queue! q 'a) (insert-queue! q 'b) (check-equal? 'a (front-queue q)) (delete-queue! q) (check-equal? 'b (front-queue q)))) )) (run-tests sicp-3.21-tests) ================================================ FILE: scheme/sicp/03/tests/22-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../22.scm") (define sicp-3.22-tests (test-suite "Tests for SICP exercise 3.22" (test-begin "empty-queue?" (check-true (empty-queue? (make-queue)))) (test-begin "insert-queue!" (define q (make-queue)) (insert-queue! q 'a) (check-equal? 'a (front-queue q))) (test-begin "delete-queue!" (define q (make-queue)) (insert-queue! q 'a) (insert-queue! q 'b) (check-equal? 'a (front-queue q)) (delete-queue! q) (check-equal? 'b (front-queue q))) )) (run-tests sicp-3.22-tests) ================================================ FILE: scheme/sicp/03/tests/23-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../23.scm") (define sicp-3.23-tests (test-suite "Tests for SICP exercise 3.23" (test-case "empty-deque?" (check-true (empty-deque? (make-deque)))) (test-case "front-insert-deque!" (define deque (make-deque)) (front-insert-deque! deque 'a) (front-insert-deque! deque 'b) (front-insert-deque! deque 'c) (check-equal? (front-deque deque) 'c) (check-equal? (rear-deque deque) 'a)) (test-case "rear-insert-deque!" (define deque (make-deque)) (rear-insert-deque! deque 'a) (rear-insert-deque! deque 'b) (rear-insert-deque! deque 'c) (check-equal? (front-deque deque) 'a) (check-equal? (rear-deque deque) 'c)) (test-case "front-delete-deque!" (define deque (make-deque)) (rear-insert-deque! deque 'a) (rear-insert-deque! deque 'b) (rear-insert-deque! deque 'c) (front-delete-deque! deque) (check-equal? (front-deque deque) 'b) (check-equal? (rear-deque deque) 'c) (front-delete-deque! deque) (check-equal? (front-deque deque) 'c) (check-equal? (rear-deque deque) 'c) (front-delete-deque! deque) (check-true (empty-deque? deque))) (test-case "rear-delete-deque!" (define deque (make-deque)) (rear-insert-deque! deque 'a) (rear-insert-deque! deque 'b) (rear-insert-deque! deque 'c) (rear-delete-deque! deque) (check-equal? (front-deque deque) 'a) (check-equal? (rear-deque deque) 'b) (rear-delete-deque! deque) (check-equal? (front-deque deque) 'a) (check-equal? (rear-deque deque) 'a) (rear-delete-deque! deque) (check-true (empty-deque? deque))) )) (run-tests sicp-3.23-tests) ================================================ FILE: scheme/sicp/03/tests/24-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../24.scm") (define sicp-3.24-tests (test-suite "Tests for SICP exercise 3.24" (test-begin "lookup" (check-equal? (lookup 'inexistant (make-table equal?)) #f)) (test-begin "insert!" (define table (make-table equal?)) (insert! 1 'one table) (insert! 2 'two table) (check-equal? (lookup 1 table) 'one) (check-equal? (lookup 2 table) 'two)) (test-begin "make-table with a lambda" (define table (make-table (lambda (a b) (= (remainder a 10) (remainder b 10))))) (insert! 11 'one table) (check-equal? (lookup 11 table) 'one) (check-equal? (lookup 21 table) 'one) (check-equal? (lookup 1 table) 'one)) )) (run-tests sicp-3.24-tests) ================================================ FILE: scheme/sicp/03/tests/25-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../25.scm") (define sicp-3.25-tests (test-suite "Tests for SICP exercise 3.25" (test-begin "lookup" (check-equal? (lookup '(inexistant) (make-table)) #f)) (test-begin "insert! (simple)" (define table (make-table)) (insert! '(1) 'one table) (insert! '(2) 'two table) (check-equal? (lookup '(1) table) 'one) (check-equal? (lookup '(2) table) 'two)) (test-begin "insert! (two levels)" (define table (make-table)) (insert! '(1 1) 'eleven table) (insert! '(1 2) 'twelve table) (insert! '(2 1) 'twenty-one table) (insert! '(2 2) 'twenty-two table) (check-equal? (lookup '(1 1) table) 'eleven) (check-equal? (lookup '(1 2) table) 'twelve) (check-equal? (lookup '(2 1) table) 'twenty-one) (check-equal? (lookup '(2 2) table) 'twenty-two)) (test-begin "insert! (mixed levels)" (define table (make-table)) (insert! '(1) 'one table) (insert! '(2 1) 'two-one table) (insert! '(2 2) 'two-two table) (insert! '(3 1 1) 'three-one-one table) (insert! '(3 1 2) 'three-one-two table) (insert! '(3 2 1) 'three-two-one table) (insert! '(3 2 2) 'three-two-two table) (check-equal? (lookup '(1) table) 'one) (check-equal? (lookup '(2 1) table) 'two-one) (check-equal? (lookup '(2 2) table) 'two-two) (check-equal? (lookup '(3 1 1) table) 'three-one-one) (check-equal? (lookup '(3 1 2) table) 'three-one-two) (check-equal? (lookup '(3 2 1) table) 'three-two-one) (check-equal? (lookup '(3 2 2) table) 'three-two-two)) )) (run-tests sicp-3.25-tests) ================================================ FILE: scheme/sicp/03/tests/28-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../28.scm") (define sicp-3.28-tests (test-suite "Tests for SICP exercise 3.28" (test-case "half-adder" (define input-1 (make-wire)) (define input-2 (make-wire)) (define sum (make-wire)) (define carry (make-wire)) (with-output-to-string (lambda () (probe 'sum sum) (probe 'carry carry))) (half-adder input-1 input-2 sum carry) (set-signal! input-1 1) (check-equal? "sum 8 New-value = 1\n" (with-output-to-string propagate)) (set-signal! input-2 1) (check-equal? (string-append "carry 11 New-value = 1\n" "sum 16 New-value = 0\n") (with-output-to-string propagate))) (test-case "full-adder" (define input-1 (make-wire)) (define input-2 (make-wire)) (define carry-in (make-wire)) (define sum (make-wire)) (define carry-out (make-wire)) (define (check-adder? a b c-in c-out s) (set-signal! input-1 a) (set-signal! input-2 b) (set-signal! carry-in c-in) (propagate) (check-equal? (list (get-signal sum) (get-signal carry-out)) (list s c-out))) (full-adder input-1 input-2 carry-in sum carry-out) (check-adder? 0 0 0 0 0) (check-adder? 0 1 0 0 1) (check-adder? 1 0 0 0 1) (check-adder? 1 1 0 1 0) (check-adder? 0 0 1 0 1) (check-adder? 0 1 1 1 0) (check-adder? 1 0 1 1 0) (check-adder? 1 1 1 1 1)) )) (run-tests sicp-3.28-tests) ================================================ FILE: scheme/sicp/03/tests/29-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../29.scm") (define sicp-3.29-tests (test-suite "Tests for SICP exercise 3.29" (test-case "or-gate" (define input-1 (make-wire)) (define input-2 (make-wire)) (define output (make-wire)) (define (check-or-gate? a b o) (set-signal! input-1 a) (set-signal! input-2 b) (propagate) (check-equal? (get-signal output) o)) (or-gate input-1 input-2 output) (check-or-gate? 0 0 0) (check-or-gate? 0 1 1) (check-or-gate? 1 0 1) (check-or-gate? 1 1 1)) (test-case "full-adder" (define input-1 (make-wire)) (define input-2 (make-wire)) (define carry-in (make-wire)) (define sum (make-wire)) (define carry-out (make-wire)) (define (check-adder? a b c-in c-out s) (set-signal! input-1 a) (set-signal! input-2 b) (set-signal! carry-in c-in) (propagate) (check-equal? (list (get-signal sum) (get-signal carry-out)) (list s c-out))) (full-adder input-1 input-2 carry-in sum carry-out) (check-adder? 0 0 0 0 0) (check-adder? 0 1 0 0 1) (check-adder? 1 0 0 0 1) (check-adder? 1 1 0 1 0) (check-adder? 0 0 1 0 1) (check-adder? 0 1 1 1 0) (check-adder? 1 0 1 1 0) (check-adder? 1 1 1 1 1)) )) (run-tests sicp-3.29-tests) ================================================ FILE: scheme/sicp/03/tests/30-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../30.scm") (define sicp-3.30-tests (test-suite "Tests for SICP exercise 3.30" (test-case "ripple-carry adder" (define addend1 (list (make-wire) (make-wire) (make-wire))) (define addend2 (list (make-wire) (make-wire) (make-wire))) (define sum (list (make-wire) (make-wire) (make-wire))) (define carry-in (make-wire)) (define carry-out (make-wire)) (define (digits n) (define (bits n r) (if (= r 0) '() (cons (remainder n 2) (bits (quotient n 2) (- r 1))))) (bits n 3)) (define (set-signals! wires signals) (if (null? signals) 'done (begin (set-signal! (car wires) (car signals)) (set-signals! (cdr wires) (cdr signals))))) (define (check-adder a b s c-in c-out) (set-signals! addend1 (digits a)) (set-signals! addend2 (digits b)) (set-signal! carry-in c-in) (propagate) (check-equal? (map get-signal sum) (digits s)) (check-equal? (get-signal carry-out) c-out)) (ripple-carry-adder addend1 addend2 carry-in sum carry-out) (check-adder 0 0 0 0 0) (check-adder 1 2 3 0 0) (check-adder 2 4 6 0 0) (check-adder 0 0 1 1 0) (check-adder 3 3 7 1 0) (check-adder 3 4 0 1 1)) )) (run-tests sicp-3.30-tests) ================================================ FILE: scheme/sicp/03/tests/33-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../33.scm") (define sicp-3.33-tests (test-suite "Tests for SICP exercise 3.33" (test-case "averager" (define a (make-connector)) (define b (make-connector)) (define c (make-connector)) (averager a b c) (set-value! a 4 'user) (set-value! b 6 'user) (check-equal? (get-value c) 5) (forget-value! b 'user) (set-value! c 5 'user) (check-equal? (get-value b) 6) (forget-value! a 'user) (set-value! b 6 'user) (check-equal? (get-value a) 4)) (test-case "celsius-fahrenheit-converter" (define C (make-connector)) (define F (make-connector)) (celsius-fahrenheit-converter C F) (set-value! C 25 'user) (check-equal? (get-value F) 77) (check-exn exn? (lambda () (set-value! F 212 'user))) (forget-value! C 'user) (set-value! F 212 'user) (check-equal? (get-value C) 100)) )) (run-tests sicp-3.33-tests) ================================================ FILE: scheme/sicp/03/tests/35-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../35.scm") (define sicp-3.35-tests (test-suite "Tests for SICP exercise 3.35" (test-case "squarer" (define a (make-connector)) (define b (make-connector)) (squarer a b) (set-value! a 2 'user) (check-equal? (get-value b) 4) (forget-value! a 'user) (set-value! b 4 'user) (check-equal? (get-value a) 2)) )) (run-tests sicp-3.35-tests) ================================================ FILE: scheme/sicp/03/tests/37-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../37.scm") (define sicp-3.37-tests (test-suite "Tests for SICP exercise 3.37" (test-case "celsius-fahrenheit-converter" (define C (make-connector)) (define F (celsius-fahrenheit-converter C)) (set-value! C 25 'user) (check-equal? (get-value F) 77) (check-exn exn? (lambda () (set-value! F 212 'user))) (forget-value! C 'user) (set-value! F 212 'user) (check-equal? (get-value C) 100)) )) (run-tests sicp-3.37-tests) ================================================ FILE: scheme/sicp/03/tests/50-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../50.scm") (define sicp-3.50-tests (test-suite "Tests for SICP exercise 3.50" (check-equal? (stream->list (stream-map2 + (stream-cons 1 (stream-cons 2 (stream-cons 3 the-empty-stream))) (stream-cons 4 (stream-cons 5 (stream-cons 6 the-empty-stream))))) '(5 7 9)) (check-equal? (stream->list (stream-map2 + (stream-cons 1 (stream-cons 2 (stream-cons 3 the-empty-stream))) (stream-cons 4 (stream-cons 5 (stream-cons 6 the-empty-stream))) (stream-cons 7 (stream-cons 8 (stream-cons 9 the-empty-stream))))) '(12 15 18)) )) (run-tests sicp-3.50-tests) ================================================ FILE: scheme/sicp/03/tests/54-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../54.scm") (define sicp-3.54-tests (test-suite "Tests for SICP exercise 3.54" (check-equal? (stream-take factorials 6) '(1 2 6 24 120 720)) )) (run-tests sicp-3.54-tests) ================================================ FILE: scheme/sicp/03/tests/55-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../55.scm") (define sicp-3.55-tests (test-suite "Tests for SICP exercise 3.55" (check-equal? (stream-take (partial-sums integers) 5) '(1 3 6 10 15)) )) (run-tests sicp-3.55-tests) ================================================ FILE: scheme/sicp/03/tests/56-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../56.scm") (define sicp-3.56-tests (test-suite "Tests for SICP exercise 3.56" (check-equal? (stream-take S 20) '(1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36)) )) (run-tests sicp-3.56-tests) ================================================ FILE: scheme/sicp/03/tests/59-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../59.scm") (define sicp-3.59-tests (test-suite "Tests for SICP exercise 3.59" (check-equal? (stream-take (integrate-series integers) 6) '(1 1 1 1 1 1)) (check-equal? (stream-take cosine-series 6) (list 1 0 (/ -1 2) 0 (/ 1 24) 0)) (check-equal? (stream-take sine-series 6) (list 0 1 0 (/ -1 6) 0 (/ 1 120))) )) (run-tests sicp-3.59-tests) ================================================ FILE: scheme/sicp/03/tests/60-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../60.scm") (define sicp-3.60-tests (test-suite "Tests for SICP exercise 3.60" (check-equal? (stream-take (add-streams (mul-series sine-series sine-series) (mul-series cosine-series cosine-series)) 6) '(1 0 0 0 0 0)) )) (run-tests sicp-3.60-tests) ================================================ FILE: scheme/sicp/03/tests/61-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../61.scm") (define sicp-3.61-tests (test-suite "Tests for SICP exercise 3.61" (check-equal? (stream-take (mul-series cosine-series (invert-unit-series cosine-series)) 6) '(1 0 0 0 0 0)) )) (run-tests sicp-3.61-tests) ================================================ FILE: scheme/sicp/03/tests/62-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../62.scm") (define sicp-3.62-tests (test-suite "Tests for SICP exercise 3.62" (check-exn exn? (lambda () (div-series ones (stream-cons 0 ones)))) (check-equal? (stream-take tangent-series 6) (list 0 1 0 (/ 1 3) 0 (/ 2 15))) )) (run-tests sicp-3.62-tests) ================================================ FILE: scheme/sicp/03/tests/64-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../64.scm") (define sicp-3.64-tests (test-suite "Tests for SICP exercise 3.64" (check-= (sqrt-tolerance 2 0.0000000001) 1.41421356237 0.0000000001) )) (run-tests sicp-3.64-tests) ================================================ FILE: scheme/sicp/03/tests/66-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../66.scm") (define sicp-3.66-tests (test-suite "Tests for SICP exercise 3.66" (check-equal? (location int-pairs '(1 100)) (position '(1 100))) (check-equal? (location int-pairs '(7 30)) (position '(7 30))) )) (run-tests sicp-3.66-tests) ================================================ FILE: scheme/sicp/03/tests/69-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../69.scm") (define sicp-3.69-tests (test-suite "Tests for SICP exercise 3.69" (check-equal? (stream-take pythagorean-triples 5) '((3 4 5) (6 8 10) (5 12 13) (9 12 15) (8 15 17))) )) (run-tests sicp-3.69-tests) ================================================ FILE: scheme/sicp/03/tests/70-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../70.scm") (define sicp-3.70-tests (test-suite "Tests for SICP exercise 3.70" (check-equal? (stream-take (a-pairs) 20) '((1 1) (1 2) (2 2) (1 3) (2 3) (1 4) (3 3) (2 4) (1 5) (3 4) (2 5) (1 6) (4 4) (3 5) (2 6) (1 7) (4 5) (3 6) (2 7) (1 8))) (check-equal? (stream-take (b-pairs) 20) '((1 1) (1 7) (1 11) (1 13) (1 17) (1 19) (1 23) (1 29) (1 31) (7 7) (1 37) (1 41) (1 43) (1 47) (1 49) (1 53) (7 11) (1 59) (1 61) (7 13))) )) (run-tests sicp-3.70-tests) ================================================ FILE: scheme/sicp/03/tests/71-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../71.scm") (define sicp-3.71-tests (test-suite "Tests for SICP exercise 3.71" (check-equal? (stream-take (ramanujan-numbers) 6) '(1729 4104 13832 20683 32832 39312)) )) (run-tests sicp-3.71-tests) ================================================ FILE: scheme/sicp/03/tests/72-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../72.scm") (define sicp-3.72-tests (test-suite "Tests for SICP exercise 3.72" (check-equal? (stream-take (three-ways-of-two-squares) 20) '( 325 425 650 725 845 850 925 1025 1105 1250 1300 1325 1445 1450 1525 1625 1690 1700 1825 1850)) )) (run-tests sicp-3.72-tests) ================================================ FILE: scheme/sicp/03/tests/73-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../73.scm") (define sicp-3.73-tests (test-suite "Tests for SICP exercise 3.73" (check-equal? (stream-take (RC1 ones-and-zeroes 0) 10) '(5 0.5 5.5 1.0 6.0 1.5 6.5 2.0 7.0 2.5)) )) (run-tests sicp-3.73-tests) ================================================ FILE: scheme/sicp/03/tests/74-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../74.scm") (define (list->infinite-stream list) (define (next items) (if (null? items) (list->infinite-stream list) (stream-cons (car items) (next (cdr items))))) (next list)) (define sense-data (list->infinite-stream '(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4))) (define zero-crossings '(0 0 0 0 0 -1 0 0 0 0 1 0 0)) (define sicp-3.74-tests (test-suite "Tests for SICP exercise 3.74" (check-equal? (stream-take (make-zero-crossings sense-data 0) 13) zero-crossings) (check-equal? (stream-take (make-zero-crossings-with-map sense-data) 13) zero-crossings) )) (run-tests sicp-3.74-tests) ================================================ FILE: scheme/sicp/03/tests/76-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../76.scm") (define (list->infinite-stream list) (define (next items) (if (null? items) (list->infinite-stream list) (stream-cons (car items) (next (cdr items))))) (next list)) (define sense-data (list->infinite-stream '(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4))) (define sicp-3.76-tests (test-suite "Tests for SICP exercise 3.76" (check-equal? (stream-take (smooth sense-data) 13) '(1 1.5 1.25 1.0 0.75 0.45 -0.5 -1.0 -0.5 0.25 0.6 2.0 2.5)) (check-equal? (stream-take (make-zero-crossings sense-data 0) 13) '(0 0 0 0 0 0 -1 0 0 1 0 0 0)) )) (run-tests sicp-3.76-tests) ================================================ FILE: scheme/sicp/03/tests/80-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../80.scm") (define sicp-3.80-tests (test-suite "Tests for SICP exercise 3.80" (check-equal? (stream-take (RLC1 10 0) 4) '((10 . 0) (10 . 1.0) (9.5 . 1.9) (8.55 . 2.66))) )) (run-tests sicp-3.80-tests) ================================================ FILE: scheme/sicp/03/tests/81-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../81.scm") (define (list->infinite-stream list) (define (next items) (if (null? items) (list->infinite-stream list) (stream-cons (car items) (next (cdr items))))) (next list)) (define sicp-3.81-tests (test-suite "Tests for SICP exercise 3.81" (check-equal? (stream-take (random-numbers (list->infinite-stream '(reset 1 generate generate generate generate reset 2 generate generate generate generate))) 8) '(1015568748 1586005467 2165703038 3027450565 1017233273 1975575172 811535379 3186434646)) )) (run-tests sicp-3.81-tests) ================================================ FILE: scheme/sicp/03/tests/82-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../82.scm") (define sicp-3.82-tests (test-suite "Tests for SICP exercise 3.82" (check-= (estimate-pi 20000) 3.14 0.01) )) (run-tests sicp-3.82-tests) ================================================ FILE: scheme/sicp/04/01.scm ================================================ ; SICP exercise 4.01 ; ; Notice that we cannot tell whether the metacircular evaluator evaluates ; operands from left to right or from right to left. Its evaluation order is ; inherited from the underlying Lisp: If the arguments to cons in ; list-of-values are evaluated from left to right, then list-of-values will ; evaluate operands from left to right; and if the arguments to cons are ; evaluated from right to left, then list-of-values will evaluate operands ; from right to left. ; ; Write a version of list-of-values that evaluates from right to left ; regardless of the order of evaluation in the underlying Lisp. Also write a ; version of list-of-values that evaluates operands from right to left. ; I'm basic the code on the metacircular evaluator in the book. There will be ; a procedure that can change the behavior of list-of-values in order to be ; able to test it. (require r5rs/init) ; The solution: (define (list-of-values-left-to-right exps env) (if (no-operands? exps) '() (let ((first (evaluate (first-operand exps) env)) (rest (list-of-values-left-to-right (rest-operands exps) env))) (cons first rest)))) (define (list-of-values-right-to-left exps env) (if (no-operands? exps) '() (let ((rest (list-of-values-left-to-right (rest-operands exps) env)) (first (evaluate (first-operand exps) env))) (cons first rest)))) (define evaluation-order 'none) (define (set-evaluation-order! order) (set! evaluation-order order)) (define (list-of-values exps env) (cond ((eq? evaluation-order 'left-to-right) (list-of-values-left-to-right exps env)) ((eq? evaluation-order 'right-to-left) (list-of-values-right-to-left exps env)) (error "Unknown evaluation order" evaluation-order))) ; The rest of the interpreter: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/02.scm ================================================ ; SICP exercise 4.02 ; ; Louis Reasoner plans to reorder the cond caluses in eval so that the clause ; for procedure applications appears before the clause for assignment. He ; argues that this will make the interpreter more efficient: Since program ; usually contains more applications than assignments, definitions and so on, ; his modified eval will usually check fewer clauses than the original eval ; before identifying the type of an expression. ; ; a. What is wrong with Louis' plan? (Hint: What will Louis's evaluator do ; with the expression (define x 3)?) ; ; b. Louis is upset that his plan didn't work. He is willing to go to any ; lengths to make his evaluator recognize procedure applications before it ; checks for most other kinds of expressions. Help him by changing the syntax ; of the evaluated language so that procedure applications start with call. ; For example, instead of (factorial 3) we will now have to write ; (call factorial 3) and instead of (+ 1 2) we will have to write ; (call + 1 2). (require r5rs/init) ; a. If we do that, every list that does not appear before definition? will be ; treated as a function application. For example, (define x 3) will be ; considered as a function call by the evaluator. ; b. OK, let's do that. We need to redefine just a bunch of functions: (define (application? exp) (tagged-list? exp 'call)) (define (operator exp) (cadr exp)) (define (operands exp) (cddr exp)) ; We also need to move the check up in evaluate: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) (else (error "Unknown expression type - EVALUATE" exp)))) ; The rest of the evaluator: (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/03.scm ================================================ ; SICP exercise 4.03 ; ; Rewrite eval so that the dispatch is done in data-directed style. Compare ; this with the data-directed procedure of exercise 2.73. (You may use the car ; of a compound expression as the type of the expression, as is appropriate ; for the syntax implemented in this section.) ; That should be fun. ; ; I'm going to define a special-from? predicate and an evaluate-form ; procedure. Both will look up in the table and see what to do. ; ; I might end up using this interpreter for some of the future exercises. ; ; As for the comparison with 2.73, it is nice that we can now add new special ; forms without modifying eval. This comes with the assumption that every ; special form should be identifiable by the first symbol in its s-exp, but I ; believe that to hold for all of LISP. ; ; The modified evaluator is below: (require r5rs/init) ; First we start with eval and apply. (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((special-form? exp) (evaluate-form exp env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) ; Here is the data-directed infrastructure for the form: (define special-forms (make-hash)) (define (define-form keyword handler) (hash-set! special-forms keyword handler)) (define (get-form keyword) (hash-ref special-forms keyword)) (define (form-defined? keyword) (if (hash-ref special-forms keyword false) true false)) ; Here are the mentioned procedures (define (special-form? exp) (and (pair? exp) (form-defined? (car exp)))) (define (evaluate-form exp env) ((get-form (car exp)) (cdr exp) env)) ; And here is the definitions of the existing forms: (define-form 'quote (lambda (exp env) (car exp))) (define-form 'if (lambda (exp env) (if (true? (evaluate (car exp) env)) (evaluate (cadr exp) env) (if (null? (cddr exp)) false (evaluate (caddr exp) env))))) (define-form 'set! (lambda (exp env) (let ((name (car exp)) (value (evaluate (cadr exp) env))) (set-variable-value! name value env) 'ok))) (define-form 'define (lambda (exp env) (let ((name (if (symbol? (car exp)) (car exp) (caar exp))) (value (if (symbol? (car exp)) (cadr exp) (make-lambda (cdar exp) (cdr exp))))) (define-variable! name (evaluate value env) env) 'ok))) (define-form 'lambda (lambda (exp env) (make-procedure (car exp) (cdr exp) env))) (define-form 'begin (lambda (exp env) (eval-sequence exp env))) (define-form 'cond (lambda (exp env) (define clauses exp) (define (else-clause? clause) (eq? (predicate clause) 'else)) (define (predicate clause) (car clause)) (define (actions clause) (cdr clause)) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (else-clause? first) (if (null? rest) (sequence->exp (actions first)) (error "ELSE clause isn't last - COND" clauses)) (make-if (predicate first) (sequence->exp (actions first)) (expand-clauses rest)))))) (evaluate (expand-clauses exp) env))) ; And this is the rest of the interpreter (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) ================================================ FILE: scheme/sicp/04/04.scm ================================================ ; SICP exercise 4.04 ; ; Recall the definitions of the special forms and and or from chapter 1: ; ; • and: The expressions are evaluated from left to right. If any expression ; evaluates to false, false is returned; any remaining expressions are not ; evaluated. If all the expressions evaluate to true values, the value of ; the last expression is returned. If there are no expressions then true is ; returned. ; • or: The expressions are evaluated from left to right. If any expression ; evaluates to a true value, that value is returned; any remaining ; expressions are not evaluated. If all expressions evaluate to false, or if ; there are no expressions, then false is returned. ; ; Install and and or as new special forms for the evaluator by defining ; appropriate syntax procedures and evaluation procedures eval-and and ; eval-or. Alternatively, show how to implement and and or as derived ; expressions. ; We will implement it in a similar way to exercise 4.02 - there will be an ; option to flip which approach to use in order to be able to test both of ; them. ; ; We cannot reasonably implement or without having a let. And even then, we ; have the problem of shadowing the name of the value. So we will modify the ; request a bit - we return true, instead of the first non-false value. Then ; we have (require r5rs/init) (define logical-operations-implementation 'none) (define (set-logical-operations-implementation! type) (set! logical-operations-implementation type)) (define (and? exp) (tagged-list? exp 'and)) (define (and-terms exp) (cdr exp)) (define (or? exp) (tagged-list? exp 'or)) (define (or-terms exp) (cdr exp)) (define (eval-and exp env) (cond ((eq? logical-operations-implementation 'syntax-procedures) (eval-and-terms-procedures (and-terms exp) env)) ((eq? logical-operations-implementation 'derived-forms) (eval-and-terms-derived (and-terms exp) env)) (error "Unknown implementation" logical-operations-implementation))) (define (eval-or exp env) (cond ((eq? logical-operations-implementation 'syntax-procedures) (eval-or-terms-procedures (or-terms exp) env)) ((eq? logical-operations-implementation 'derived-forms) (eval-or-terms-derived (or-terms exp) env)) (error "Unknown implementation" logical-operations-implementation))) (define (eval-and-terms-procedures terms env) (cond ((empty-exp? terms) true) ((last-exp? terms) (evaluate (first-exp terms) env)) ((evaluate (first-exp terms) env) (eval-and-terms-procedures (rest-exps terms) env)) (else false))) (define (eval-or-terms-procedures terms env) (if (empty-exp? terms) false (let ((value (evaluate (first-exp terms) env))) (if value value (eval-or-terms-procedures (rest-exps terms) env))))) (define (eval-or-terms-derived terms env) (define (or->if terms) (if (empty-exp? terms) 'false (make-if (first-exp terms) 'true (or->if (rest-exps terms))))) (evaluate (or->if terms) env)) (define (eval-and-terms-derived terms env) (define (and->if terms) (cond ((empty-exp? terms) 'true) ((last-exp? terms) (first-exp terms)) (else (make-if (first-exp terms) (and->if (rest-exps terms)) 'false)))) (evaluate (and->if terms) env)) ; The rest of the evaluator (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((and? exp) (eval-and exp env)) ((or? exp) (eval-or exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (empty-exp? seq) (null? seq)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/05.scm ================================================ ; SICP exercise 4.05 ; ; Scheme allows additional syntax for cond clauses, ( => ). ; If evaluates to a true value, then is evaluated. Its ; value must be a procedure of one argument; this procedure is then invoked on ; the value of the , and the result is returned as the value of the cond ; expession. For example ; ; (cond ((assoc 'b ((a 1) (b 2))) => cadr) ; (else false)) ; ; returns 2. Modify the handling of cond so that it supports this extended ; syntax. ; We need to rewrite cond not to be a derived form, because otherwise we ; either need to evaluate the test twice or there will be name shadowing in ; the clauses following the stabby one. (require r5rs/init) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-stabby-clause? clause) (eq? (car (cond-actions clause)) '=>)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond-stabby-recipient clause) (caddr clause)) (define (eval-cond exp env) (define (eval-clauses clauses) (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (not (null? rest)) (error "ELSE clause is not the last - COND") (eval-sequence (cond-actions first) env)) (let ((test-result (evaluate (cond-predicate first) env))) (cond ((not test-result) (eval-clauses rest)) ((cond-stabby-clause? first) (apply-procedure (evaluate (cond-stabby-recipient first) env) (list test-result))) (else (eval-sequence (cond-actions first) env))))))) (eval-clauses (cond-clauses exp))) ; The rest of the evaluator: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval-cond exp env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'eq? eq?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/06.scm ================================================ ; SICP exercise 4.06 ; ; Let expressions are derived expressions, because ; ; (let (( ) ... ( )) ; ) ; ; is equivalent to ; ; ((lambda ( ... ) ; ) ; ; ... ; ) ; ; Implement a syntactic transformation let->combination that reduces ; evaluating let expressions to evaluating combinations of the type show ; above, and add the appropriate clause to eval to handle let expressions. (require r5rs/init) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) ; The rest of the evaluator: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((let? exp) (evaluate (let->combination exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/07.scm ================================================ ; SICP exercise 4.07 ; ; Let* is similar to let, except that the bindings of the let* variables are ; performed sequentially from left to right, and each binding is made in an ; environment in which all of the preceding bindings are visible. For example ; ; (let* ((x 3) ; (y (+ x 2)) ; (z (+ x y 5))) ; (* x z)) ; ; returns 39. Explain how a let* expression can be rewritten as a set of ; nested let expressions and write a procedure let*->nested-lets that performs ; this transformation. If we have already implemented let (exercise 4.6) and ; we want to extend the evaluator to handle let*, is it sufficient to add a ; clause to eval whose action is ; ; (eval (let*->nested-lets exp) env) ; ; or must we explicitly expand let* in terms of non-derived expressions? ; Simply, the expression above can be converted to: ; ; (let ((x 3)) ; (let ((y (+ x 2))) ; (let ((z (+ x y 5))) ; (* x z)))) ; ; You just create a new let statement for each bound name. And of course we ; can define let* in terms of let, which itself is a derived expression. (require r5rs/init) (define (let*? exp) (tagged-list? exp 'let*)) (define (let*->nested-lets exp) (define body (cddr exp)) (define (one-binding? bindings) (null? (cdr bindings))) (define (convert bindings) (let ((new-binding (list (car bindings))) (rest (cdr bindings))) (if (one-binding? bindings) (cons 'let (cons new-binding body)) (list 'let new-binding (convert rest))))) (convert (cadr exp))) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) ; The rest of the evaluator: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((let? exp) (evaluate (let->combination exp) env)) ((let*? exp) (evaluate (let*->nested-lets exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/08.scm ================================================ ; SICP exercise 4.08 ; ; "Named let" is a variant of let that has the form ; ; (let ) ; ; The and are just as in ordinary let, except that var is ; bound within to a procedure whose body is and whose parameters ; are the variables in the . Thus, one can repeatedly execute the ; by invoking the procedure, named . For example, the iterative ; Fibonacci procedure (section 1.2.2) can be rewritten using named let as ; follows: ; ; (define (fib n) ; (let fib-iter ((a 1) ; (b 0) ; (count n)) ; (if (= count 0) ; b ; (fib-iter (+ a b) a (- count 1))))) ; ; Modify let->combination of exercise 4.6 to also support named let. (require r5rs/init) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (if (symbol? (cadr exp)) (let ((name (cadr exp)) (names (map car (caddr exp))) (values (map cadr (caddr exp))) (body (cdddr exp))) (list (list 'lambda null (append (list 'define (cons name names)) body) (cons name values)))) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values)))) ; The rest of the evaluator: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((let? exp) (evaluate (let->combination exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/09.scm ================================================ ; SICP exercise 4.09 ; ; Many languages support a variety of iteration constructs, such as do, for, ; while and until. In scheme, iterative processes can be expressed in terms of ; ordinart procdure calls, so special iteration constructs provide no ; essential gain in computational power. On the other hand, such constructs ; are often convenient. Design some iteration constructs, give examples of ; their use, and show how to implement them as derived expressions. (require r5rs/init) ; I am not sure what "do" is, so we will start with the for loop. This is ; tricky, since we need to do it with recursion, and in order to accomplish ; that, we need put a name in the environment. Of course, this will lead to ; name-shadowing conflicts. Since the text of the book ignores this issue, we ; shall do so too. We'll need to introduce two names in the environment - ; items and for-loop. Same goes for the other constructs, really. It might ; make sense to name them something obscure (like _for-loop and _while-loop), ; since this is not a real evaluator, we don't need to do it. (define (for? exp) (tagged-list? exp 'for)) (define (for->lambda exp) (let ((name (cadr exp)) (items (caddr exp)) (body (cdddr exp))) (list (list 'lambda (list) (list 'define (list 'for-loop 'items) (list 'if (list 'null? 'items) ''done (append (list 'begin (list 'define name (list 'car 'items))) body (list (list 'for-loop (list 'cdr 'items)))))) (list 'for-loop items))))) ; Next we need to do while. We'll introduce < to our primitive functions in ; order to be able to test it. Otherwise, it goes like this: (define (while? exp) (tagged-list? exp 'while)) (define (while->lambda exp) (let ((condition (cadr exp)) (body (cddr exp))) (list (list 'lambda null (append '(define (while-loop)) (list (list 'if condition (sequence->exp (append body '((while-loop)))) ''done))) '(while-loop))))) ; And now, let's implement until: (define (until? exp) (tagged-list? exp 'until)) (define (until->lambda exp) (let ((condition (cadr exp)) (body (cddr exp))) (list (list 'lambda null (append '(define (until-loop)) (list (list 'if condition ''done (sequence->exp (append body '((until-loop))))))) '(until-loop))))) ; The rest of the evaluator: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((for? exp) (evaluate (for->lambda exp) env)) ((while? exp) (evaluate (while->lambda exp) env)) ((until? exp) (evaluate (until->lambda exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '< <) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/10.scm ================================================ ; SICP exercise 4.10 ; ; By using data abstraction, we were able to write an eval procedure that is ; independent of the particular syntax of the language to be evaluated. To ; illustrate this, design and implement a new syntax for Scheme by modifying ; the procedures in the section, without changing eval or apply. ; Let's go batshit crazy about this. Check out the specs of the new "syntax". ; It's horrible and unusuable, but at least it is fancy. (require r5rs/init) ; Here are the unmodified procedures: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((definition? exp) (eval-definition exp env)) ((assignment? exp) (eval-assignment exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) ; Some auxiliary stuff: (define (ends-with? name suffix-symbol) (define (take items n) (if (or (null? items) (= n 0)) '() (cons (car items) (take (cdr items) (- n 1))))) (let* ((str (symbol->string name)) (suffix (symbol->string suffix-symbol)) (len (min (string-length str) (string-length suffix))) (last-part (list->string (reverse (take (reverse (string->list str)) len))))) (equal? last-part suffix))) (define (strip-suffix name suffix) (let* ((name (symbol->string name)) (suffix (symbol->string suffix)) (name-length (string-length name)) (suffix-length (string-length suffix))) (string->symbol (substring name 0 (- name-length suffix-length))))) ; The rest of the evaluator, modified: (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (and (pair? exp) (symbol? (car exp)) (not (eq? (car exp) '=)) (ends-with? (car exp) '=))) (define (assignment-variable exp) (strip-suffix (car exp) '=)) (define (assignment-value exp) (cadr exp)) (define (definition? exp) (and (pair? exp) (symbol? (car exp)) (or (ends-with? (car exp) ':) (ends-with? (car exp) ':=)))) (define (definition-variable exp) (if (ends-with? (car exp) ':) (strip-suffix (car exp) ':) (strip-suffix (car exp) ':=))) (define (definition-value exp) (if (ends-with? (car exp) ':) (make-lambda (cadr exp) (cddr exp)) (cadr exp))) (define (lambda? exp) (and (pair? exp) (not (null? exp)) (not (null? (cdr exp))) (eq? (cadr exp) '=>))) (define (lambda-parameters exp) (car exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (append (list parameters '=>) body)) (define (if? exp) (tagged-list? exp '?)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list '? predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'do)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'do seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'switch)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/11.scm ================================================ ; SICP exercise 4.11 ; ; Instead of representing a frame as a pair of lists, we can represent a frame ; as a list of bindings, where each binding is a name-value pair. Rewrite the ; environment operations to use this alternative representation. (require r5rs/init) ; Frames: ; (define (zip a b) (if (and (null? a) (null? b)) null (cons (cons (car a) (car b)) (zip (cdr a) (cdr b))))) (define (make-frame variables values) (cons 'frame (zip variables values))) (define (frame-variables frame) (map car (cdr frame))) (define (frame-values frame) (map cdr (cdr frame))) (define (frame-bindings frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (let ((new-binding (cons var val)) (other-bindings (cdr frame))) (set-cdr! frame (cons new-binding other-bindings)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan bindings) (cond ((null? bindings) (env-loop (enclosing-environment env))) ((eq? var (caar bindings)) (set-cdr! (car bindings) val)) (else (scan (cdr bindings))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (scan (frame-bindings (first-frame env))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan bindings) (cond ((null? bindings) (add-binding-to-frame! var val frame)) ((eq? var (caar bindings)) (set-cdr! (car bindings) val)) (else (scan (cdr bindings))))) (scan (frame-bindings frame)))) ; The rest of the interpreter: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) ;(define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/12.scm ================================================ ; SICP exercise 4.12 ; ; The procedures set-variable-value!, define-variable!, and ; lookup-variable-value can be expressed in terms of more abstract procedures ; for traversing the enivornment structure. Define abstractions that capture ; the common patterns and redefine the three procedures in terms of these ; abstractions. (require r5rs/init) ; We are going two define two procedures -- one that traverses an environment ; and one that traverses a frame, both looking for a variable defined in their ; respective argument. They will take two callbacks -- one invoked when the ; variable is found and one invoked when the variable could not be found. The ; first callback will receive a list of the values in that frame whose car is ; the value of the variable found. The other will receive no arguments. ; ; The functions are the following: (define (find-variable-in-frame var frame found not-found) (define (scan vars vals) (cond ((null? vars) (not-found)) ((eq? (car vars) var) (found vals)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame))) (define (find-variable-in-environment var env found not-found) (if (eq? env the-empty-environment) (not-found) (find-variable-in-frame var (first-frame env) found (lambda () (find-variable-in-environment var (enclosing-environment env) found not-found))))) ; We are going to use them to implement the environment operations: (define (lookup-variable-value var env) (find-variable-in-environment var env (lambda (vals) (car vals)) (lambda () (error "Unbound variable" var)))) (define (set-variable-value! var val env) (find-variable-in-environment var env (lambda (vals) (set-car! vals val)) (lambda () (error "Unbound variable - SET!" var)))) (define (define-variable! var val env) (let ((frame (first-frame env))) (find-variable-in-frame var frame (lambda (vals) (set-car! vals val)) (lambda () (add-binding-to-frame! var val frame))))) ; Note that this is not the best solution. The smell here is passing a list of ; values to the found callback. We can, instead, introduce more refined ; abstractions that manipulate frames instead of lists, but that's just too ; much work. This is sufficient for this exercise. ; ; This is the rest of the interpreter (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/13.scm ================================================ ; SICP exercise 4.13 ; ; Scheme allows us to create new bindings for variables by means of define, but ; provides no way to get rid of bindings. Implement for the evaluator a special ; form make-unbound! that removes the binding of a given symbol from the ; environment in which the make-unbound! expressions is evaluated. This problem ; is not completely specified. For example, should we remove only the binding ; in the first frame of the environment? Complete the specification and justify ; any choices you make. ; The solution is sprinkled in the interpreter. It is not that interesting, so ; I shall not elaborate on it. I've chosen not to undefine variables, that are ; declared in an enclosing environment. There are two reasons for this. First, ; that way make-unbound! is symmetrical to define - they both operate on the ; same environment. Second, if make-unbound! can undefine a variable in an ; enclosing frame, it produces two side effects that are hard to understand. ; ; First, lets take a case where the same variable is defined in two ; environments and then undefined. If we later remove the second definition, ; the program would result in a delayed "Unbound variable" error. A better ; behavior would be to let the user know that they need to remove the ; make-unbound! form. ; ; Second, if a variable is shadowed, make-unbound! can be invoked multiple ; times with the same variable. Alternatively, we can have it remove all ; definitions in all frames, but that will lead to the form undefining a ; variable in an enclosing frame, which is potentially confusing. (require r5rs/init) (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((unbinding? exp) (eval-unbinding exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (eval-unbinding exp env) (undefine-variable! (unbinding-variable exp) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (unbinding? exp) (tagged-list? exp 'make-unbound!)) (define (unbinding-variable exp) (cadr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define (set-first-frame! env frame) (set-car! env frame)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (frame-without-variable frame var) (define (remove vars vals) (cond ((null? vars) (error "Cannot unbind a variable that is not declared in the current frame" var)) ((eq? (car vars) var) (list (cdr vars) (cdr vals))) (else (let* ((rest (remove (cdr vars) (cdr vals))) (new-vars (car rest)) (new-vals (cadr rest))) (list (cons (car vars) new-vars) (cons (car vals) new-vals)))))) (apply make-frame (remove (frame-variables frame) (frame-values frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (undefine-variable! var env) (set-first-frame! env (frame-without-variable (first-frame env) var))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/14.scm ================================================ ; SICP exercise 4.14 ; ; Eva Lu Ator and Louis Reasoner are each experimenting with the meracircular ; evaluator. Eva types in the definition of map, and runs some test programs ; that use it. They work fine. Louis, in contrast, has installed the system ; version of map as a primitve for the metacircular evaluator. When he tries ; it, things go terribly wrong. Explain why Louis's map fails even though Eva's ; works. ; Scheme's map takes two arguments a procedure to apply and a list of things to ; apply it to. The procedure should, of course, be a Scheme procedure. When ; Louis installs the system version and calls map in the evaluator, the first ; argument to apply is a procedure in the evaluator, which is a list starting ; with either 'procedure, which is the evaluator's representation of a ; procedure. map then results with an error that it expected a procedure and ; it got a list. ================================================ FILE: scheme/sicp/04/15.scm ================================================ ; SICP exercise 4.15 ; ; Given a one-argument procedure p and an object a, p is said to "halt" on a if ; evaluating the expresssion (p a) returns a value (as opposed to terminating ; with an error message or running forever). Show that it is impossible to ; write a procedure halts? that correctly determines whether p halts on a for ; any procedure p and object a. Use the following reasoning: If you had such a ; procedure halts?, you could implement the following program: ; ; (define (run-forever) (run-forever)) ; ; (define (try p) ; (if (halts? p p) ; (run-forever) ; 'halted)) ; ; Now consider evaluating the expression (try try) and show that any possible ; outcome (either halting or running) violates the intended behavior of halts? ; try checks if the argument will halt when given itself. In case it halts, try ; will run forever and halt otherwise. That is, try has the inverse behavior of ; the passed procedure. So what happens when we pass try to itself? ; ; Let's assume that (halts? try try) returns true. In that case, (try try) will ; run forever, which is a violation of our assumption. We're led to believe ; that (halts? try try) should return false. But in that case, if we run (try ; try), it will halt and return 'halted, which again, is a violation of our ; assumption. ; ; We have to accept that halts? cannot exist. ================================================ FILE: scheme/sicp/04/16.scm ================================================ ; SICP exercise 4.16 ; ; In this exercise we implement the method just described for interpreting ; internal definitions. We assume that the evaluator supports let (see exercise ; 4.6). ; ; a. Change the lookup-variable-value (section 4.1.3) to singal an error if the ; value it finds is the symbol *unassigned*. ; ; b. Write a procedure scan-out-defines that takes a procedure body and returns ; an equivalent one that has no internal definitions, by making the ; transformation described above. ; ; c. Install scan-out-defines in the interpreter, either in make-procedure or ; in procedure-body (see section 4.1.3). Which place is better? Why? (require r5rs/init) ; a. Here is the modified procedure: (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (let ((value (car vals))) (if (eq? value '*unassigned*) (error "Unassigned variable" var) value))) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) ; b. Here's scan-out-defines: (define (scan-out-defines body) (define (definitions-in body) (cond ((null? body) '()) ((definition? (car body)) (cons (car body) (definitions-in (cdr body)))) (else (definitions-in (cdr body))))) (define (body-without-definitions body) (cond ((null? body) '()) ((definition? (car body)) (body-without-definitions (cdr body))) (else (cons (car body) (body-without-definitions (cdr body)))))) (define (definition->unassigned-pair definition) (list (definition-variable definition) ''*unassigned*)) (define (definition->set! definition) (list 'set! (definition-variable definition) (definition-value definition))) (define (defines->let definitions body) (list (cons 'let (cons (map definition->unassigned-pair definitions) (append (map definition->set! definitions) body))))) (let ((internal-definitions (definitions-in body))) (if (null? internal-definitions) body (defines->let internal-definitions (body-without-definitions body))))) ; c. And finally, we install it in. We do it in make-procedure, because that is ; more efficient - it is called once for each procedure. Otherwise, it will be ; called on every procedure invocation (define (make-procedure parameters body env) (list 'procedure parameters (scan-out-defines body) env)) ; The rest of the interpreter. Note that I added a primitive procedure list to ; enable an easier test case. (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((let? exp) (evaluate (let->combination exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/17.scm ================================================ ; SICP exercise 4.17 ; ; Draw diagrams of the environment in effect when evaluating the expression ; in the procedure in the text, comparing how this will be structured when ; definitions are interpreted sequentially with how it will be structured if ; definitions are scanned out as described. Why is there an extra frame in the ; transformed program? Explain why this difference in environment structure can ; never make a difference in the behavior of a correct program. Design a way to ; make the interpreter implement the "simultaneous" scope rule for internal ; definitions without constructing the extra frame. ; Here's the diagram of the sequential interpretation: ; ; : +----------------------+ ; | : ... | ; +----------------------+ ; ^ ; | ; : +----------------------+ ; | u: | ; | v: | ; ----> +----------------------+ ; ; In comparison, this is the environment with the sequential interpretation: ; ; : +----------------------+ ; | : ... | ; | u: | ; | v: | ; ----> +----------------------+ ; ; The extra frame is there because of the let statement, which is implemented ; as a lambda invocation. It does not make a difference, because the variables ; have the same values in both environments. set! will affect different ; environments in the two cases, but the value in the inner environment will ; still be the same. Since this construction does not allow us to create ; outside of the let, we cannot create a new function that will use the ; environment of the lambda, but not the environment of the let. ; ; If we want to remove the extra frame, we can do it just by rearranging the ; body of the procedure and moving all the definitions to the top, kind of like ; function hoisting in JavaScript. In that case we will only have one ; environemnt. ================================================ FILE: scheme/sicp/04/18.scm ================================================ ; SICP exercise 4.18 ; ; Consider an alternative strategy for scanning out definitions that ; translates the example in the text to ; ; (lambda ; (let ((u '*unassigned*) ; (v '*unassigned*)) ; (let ((a ') ; (b ')) ; (set! u a) ; (set! v b)) ; )) ; ; Here a and b are meant to represent new variables names, created by the ; interpreter, that do not appear in the user's program. Consider the solve ; procedure from 3.5.4: ; ; (define (solve f y0 dt) ; (define y (integral (delay dy) y0 dt)) ; (define dy (stream-map f y)) ; y) ; ; Will this procedure work if internal definitions are scanned out as shown in ; this exercise? What if they are scanned out as shown in the text? Explain. ; In the first case, the result will be: ; ; (lambda (f y 0 dt) ; (let ((y '*unassigned*) ; (dy '*unassigned*)) ; (let ((a (integral (delay dy) y0 dt)) ; (b (stream-map f y))) ; (set! y a) ; (set! dy b)) ; y)) ; ; This will not work, because b will be (stream-map f '*unassigned*). ; ; In the second case, the expansion will produce: ; ; (lambda (f y 0 dt) ; (let ((y '*unassigned) ; (dy '*unassigned)) ; (set! y (integral (delay dy) y0 dt)) ; (set! dy (stream-map f y)) ; y)) ; ; This will work, since dy will refer to the proper value of y. ================================================ FILE: scheme/sicp/04/19.scm ================================================ ; SICP exercise 4.19 ; ; Ben Bitdiddle, Alyssa P. Hacker, and Eva Lu Ator are arguing about the ; desired result of evaluating the expression ; ; (let ((a 1)) ; (define (f x) ; (define b (+ a x)) ; (define a 5) ; (+ a b)) ; (f 10)) ; ; Ben asserts that the result should be obtained using the sequential rule for ; define: b is defined to be 11, then a is defined to be 5, so the result is ; 16. Alyssa objects that mutual recursion requires the simultaneous scope ; rule for internal procedure definitions, and that is unreasonable to treat ; procedure names differently from other names. Thus, she argues, for the ; mechanism implemented in exercise 4.16. This would lead to a being ; unassigned at the time that the value for b is to be computed. Hence, in ; Alyssa's view, the procedure should produce an error. Eva has a third ; opinion. She says that if the definitions of a and b are truly meant to be ; simultaneous, then the value 5 for a should be used in evaluating b. Hence, ; in Eva's view a should be 5, b should be 15, and the result should be 20. ; Which (if any) of these viewpoints do you support? Can you devise a way to ; implement internal definitions so that they behave as Eva prefers? ; Personally, I dislike the distinction between define and set!. I prefer both ; behaving the same way, that is, allowing assignment to an unassigned name ; and setting to an assigned one. This removes the distinction between ; definition and assignment, which I find superflous at best. Granted, it ; imposes an order of evaluating, but that is simple enough to understand. The ; downside is that such a strategy would not allow name shadowing with define. ; This is not a problem with variable names (since you can use let), but ; results in an awkward syntax for shadowing functions. ; ; If you have to live with having define able to shadow names, I would prefer ; Alyssa's approach, because of its simplicity. ; ; Finally, Eva's preference would require finding the dependencies between ; definitions and reordering them. My guy feeling is that this can be done ; compile time in an efficient manner, but it is more complex than just ; sticking with Alyssa's approach. It also introduces a harder to understand ; system, where the user needs to be aware of this reordering in order to ; understand why their programming is behaving the way they observe. ; ; I find that simple-to-understand interpreter outweights fancy, but rarely ; used features. ================================================ FILE: scheme/sicp/04/20.scm ================================================ ; SICP exercise 4.20 ; ; Because internal definitions look sequential but are actually simultaneous, ; some people prefer to avoid them entirely, and use the special form letrec ; instead. Letrec looks like let, so it is no surprising that the variables it ; binds are bound simultaneously and have the same scope as each other. The ; sample procedure f above can be written without internal definitions, but ; with exactly the same meaning, as: ; ; (define (f x) ; (letrec ((even? ; (lambda (n) ; (if (= n 0) ; true ; (odd? (- n 1))))) ; (odd? ; (lambda (n) ; (if (= n 0) ; false ; (even? (- n 1)))))) ; )) ; ; letrec expressions, which have the form ; ; (letrec (( ) ... ( )) ; ) ; ; are a variation on let in which the expressions that provide the ; initial values for the variables are evaluated in an environment ; that includes all the letrec bindings. This permits recursion in the ; bindings, such as the mutual recursion of even? and odd? in the example ; above, or the evaluation of 10 factorial with ; ; (letrec ((fact ; (lambda (n) ; (if (= n 1) ; 1 ; (* n (fact (- n 1))))))) ; (fact 10)) ; ; a. Implement letrec as a derived expression, by transforming a letrec ; expression into a let expression as shown in the text above or in exercise ; 4.18. That is, the letrec variables should be created with a let and then be ; assigned their values with set!. ; ; b. Louis Reasoner is confused by all this fuss about internal definitions. ; The way he sees it, if you don't like to use define inside a procedure, you ; can just use let. Illustrate what is loose about his reasoning by drawing an ; environment diagram that shows the environment in which ; is evaluated during evaluation of the expression (f 5), with f defined as in ; this exercise. Draw an environment diagram for the same evaluation, but with ; let in place of letrec in the definition of f. (require r5rs/init) ; a. Let's begin with the letrec implementation: (define (letrec? exp) (tagged-list? exp 'letrec)) (define (letrec-pairs exp) (cadr exp)) (define (letrec-body exp) (cddr exp)) (define (letrec->combination exp) (cons 'let (cons (map (lambda (pair) (list (car pair) ''*unassigned*)) (letrec-pairs exp)) (append (map (lambda (pair) (list 'set! (car pair) (cadr pair))) (letrec-pairs exp)) (letrec-body exp))))) ; It is installed in the evaluator. ; ; b. This is the code Louis proposes: ; ; (define (f x) ; (let ((even? ; (lambda (n) ; (if (= n 0) ; true ; (odd? (- n 1))))) ; (odd? ; (lambda (n) ; (if (= n 0) ; false ; (even? (- n 1)))))) ; )) ; ; Here's the environment diagram of (f 10): ; ; f: +-------------------+ ; | x: 10 | ; +-------------------+ ; ^ ^ ^ ; | | | ; | | +---------------------------------------+ ; | +----------------------+ | ; +-------------------+ | +----------+ ; | even?: ---------------|------------| | ; | odd?: -----+ | +----------+ ; +-------------------+ | +----------+ params: n ; ^ +---| | code: (if (= n 0) ; | +----------+ true ; params: n (odd? (- n 1))) ; code: (if (= n 0) ; false ; (even? (- n 1))) ; ; It is apparant that even? is not defined in odd?'s environment and odd? is ; not defined in even?'s environment. Thus, it will simply not work. ; The rest of the evaluator: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((let? exp) (evaluate (let->combination exp) env)) ((letrec? exp) (evaluate (letrec->combination exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/21.scm ================================================ ; SICP exercise 4.21 ; ; Amazingly, Louis's intuition on exercise 4.20 is correct. It is indeed ; possible to specify recursive procedures without using letrec (or even ; define), although the method for accomplishing this is much more subtle than ; Louis imagined. The following expression computes 10 factorial by applying a ; recursive factorial procedure: ; ; ((lambda (n) ; ((lambda (fact) ; (fact fact n)) ; (lambda (ft k) ; (if (= k 1) ; 1 ; (* k (ft ft (- k 1))))))) ; 10) ; ; a. Check (by evaluating the expression) that this really does compute ; factorials. Devise an analogous expression for computing the Fibonacci ; numbers. ; ; b. Consider the following procedure, which includes mutually recursive ; internal definitions. ; ; (define (f x) ; (define (even? n) ; (if (= n 0) ; true ; (odd? (- n 1)))) ; (define (odd? n) ; (if (= n 0) ; false ; (even? (- n 1)))) ; (even? x)) ; ; Fill in the missing expressions to complete an alternative definition of f, ; which uses neither internal definitions nor letrec: ; ; (define (f x) ; ((lambda (even? odd?) ; (even? even? odd? x)) ; (lambda (ev? od? n) ; (if (= n 0) true (od? ))) ; (lambda (ev? od? n) ; (if (= n 0) false (ev? ))))) (require r5rs/init) ; a. The check is in the tests. The similar expression is: (define (y-fibonacci number) ((lambda (n) ((lambda (fibonacci) (fibonacci fibonacci n)) (lambda (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib fib (- n 1)) (fib fib (- n 2)))))))) number)) ; b. This is the alternative definition of f: (define (f x) ((lambda (even? odd?) (even? even? odd? x)) (lambda (ev? od? n) (if (= n 0) true (od? ev? od? (- n 1)))) (lambda (ev? od? n) (if (= n 0) false (ev? ev? od? (- n 1)))))) ; The rest of the interpreter: (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/22.scm ================================================ ; SICP exercise 4.22 ; ; Extend the evaluator in this section to support the special form let. (See ; exercise 4.6) (require r5rs/init) ; Let is just a syntactic transformation, so not much additional code is ; necessary. We have the code we had in 4.6: (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) ; We just need to install it in the rest of the interpreter: (define (evaluate exp env) ((analyze exp) env)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args) (cond ((primitive-procedure? proc) (apply-primitive-procedure proc args)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)))) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (analyze-self-evaluating exp) (lambda (env) exp)) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env) qval))) (define (analyze-variable exp) (lambda (env) (lookup-variable-value exp env))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env) (set-variable-value! var (vproc env) env) 'ok))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env) (define-variable! var (vproc env) env) 'ok))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env) (if (true? (pproc env)) (cproc env) (aproc env))))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env) (make-procedure vars bproc env)))) (define (analyze-sequence exps) (define (sequentially proc1 proc2) (lambda (env) (proc1 env) (proc2 env))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/23.scm ================================================ ; SICP exercise 4.23 ; ; Alyssa P. Hacker doesn't understand why analyze-sequence needs to be so ; complicated. All the other analysis procedures are straightforward ; transformations of the corresponding evaluation procedures (or eval clauses) ; in section 4.1.1. She expected analyze-sequence to look like this: ; ; (define (analyze-sequence exps) ; (define (execute-sequence procs env) ; (cond ((null? (cdr procs)) ((car procs) env)) ; (else ((car procs) env) ; (execute-sequence (cdr procs) env)))) ; (let ((procs (map analyze exps))) ; (if (null? procs) ; (error "Empty sequence -- ANALYZE")) ; (lambda (env) (execute-sequence procs env)))) ; ; Eva Lu Ator explains to Alyssa that the version in the text does more of the ; work of evaluating a sequence at analysis time. Alyssa's sequence-execution ; procedure, rather than having the calls to the individual built in, loops ; through the procedures in order to call them: In effect, although the ; individual expressions in the sequence have been analyzed, the sequence ; itself has not been. ; ; Compare the two versions of analyze-sequence. For example, consider the ; common case (typical of procedure bodies) where the sequence has just one ; expression. What work will the execution procedure produced by Alyssa's ; program do? What about the execution procedure produced by the program in ; the text above? How do the two versions compare for a sequence with two ; expressions? ; The extra work is iterating the over each expression in the body. In the ; case of a body with one expression, Alyssa's code will do an additional ; cond, null?, cdr and car. In case of a procedure with two expressions in its ; body, Alyssa's code will in addition do another cond, null?, car and two ; extra cdrs (one for the null? check and one in the else clause). ================================================ FILE: scheme/sicp/04/24.scm ================================================ ; SICP exercise 4.24 ; ; Design and carry out some experiments to compare the speed of the original ; metacircular evaluator with the version in this section. Use your results to ; estimate the fraction of time spent in analysis versus execution for various ; procedures. ; This solution steps away from the traditional approach and uses a bit more ; of Racket's functionality (although there is probably a better way to do ; this). ; ; The output, slightly rearranged is: ; ; evaluator recursive-fib-25: cpu time: 941 real time: 943 gc time: 10 ; analyzing recursive-fib-25: cpu time: 475 real time: 477 gc time: 92 ; ; evaluator odd-even-1000000: cpu time: 221 real time: 221 gc time: 2 ; analyzing odd-even-1000000: cpu time: 116 real time: 118 gc time: 8 ; ; evaluator factorial-100000: cpu time: 98 real time: 99 gc time: 27 ; analyzing factorial-100000: cpu time: 71 real time: 73 gc time: 16 ; ; Unsurprisingly, the analyzing evaluator is faster. (module benchmark racket/load (require r5rs/init) (define recursive-fib-25 '(begin (define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))))) (fib 25))) (define factorial-100000 '(begin (define (factorial n) (if (= n 0) 1 (* n (factorial (- n 1))))) (factorial 10000))) (define odd-even-1000000 '(begin (define (odd? n) (if (= n 0) false (even? (- n 1)))) (define (even? n) (if (= n 0) true (odd? (- n 1)))) (even? 100000))) (define experiments (list (cons "recursive-fib-25" recursive-fib-25) (cons "odd-even-1000000" odd-even-1000000) (cons "factorial-100000" factorial-100000))) (define (benchmark evaluator-name) (define (loop experiments) (if (null? experiments) 'done (let ((experiment-name (caar experiments)) (code (cdar experiments))) (printf "~a ~a: " evaluator-name experiment-name) (time (evaluate code (setup-environment))) (loop (cdr experiments))))) (loop experiments)) (load-relative "showcase/evaluator/evaluator.scm") (benchmark "evaluator") (load-relative "./showcase/analyzing/evaluator.scm") (benchmark "analyzing")) (require 'benchmark) ================================================ FILE: scheme/sicp/04/25.scm ================================================ ; SICP exercise 4.25 ; ; Suppose that (in ordinary applicative-order Scheme) we define unless as ; shown above and then define factorial in terms of unless as ; ; (define (factorial n) ; (unless (= n 1) ; (* n (factorial (- n 1))) ; 1)) ; ; What happens if we attempt to evaluate (factorial 5)? Will our definitions ; work in a normal-order language? ; The interpreter will end up in a bottomless recursion, since invoking ; factorial always invokes factorial before returning (even before calling ; unless). Simple, it would not do. ; ; In a normal-order language this definition will work, since the arguments to ; unless won't be evaluated unless they are needed. ================================================ FILE: scheme/sicp/04/26.scm ================================================ ; SICP exercise 4.26 ; ; Ben Bitdidle and Alyssa P. Hacker disagree over the importance of lazy ; evaluation for implementing things such as unless. Ben points out that it's ; possible to implement unless in applicative order as a special form. Alyssa ; counters that, if one did that, unless would be merely syntax, not a ; procedure that could be used in conjunction with higher-order procedures. ; Fill in the details on both sides of the argument. Show how to implement ; unless as a derived expression (like cond or let), and give an example of a ; situation where it might be useful to have unless as a procedure, rather ; than as a special form. ; "Merely syntax". Heh. ; ; On Ben's side, we can add that there is nothing wrong with having unless ; implemented as a special form. I can't see a case where one would want to ; pass unless as an argument. Granted, it requires a change to the interpreter ; or the introduction of macro mechanisms. Converting to lazy evaluation ; raises some hairy questions when side effects are involved (as we shall see ; in the upcomming exercises) and carries a certain performance overhead. ; ; On Alyssa's side, it would actually be cool to pass unless as a function. ; While unless is not the best example, lazy evaluation would be useful for ; streams - the cons-stream form from the previous chapter can be replaced ; with cons. Furthermore, we won't need a macro facility. ; ; Here is how unless can be implemented as a special form: (define (unless->combination condition usual-value exceptional-value) (list 'if condition exceptional-value usual-value)) ; It of course, needs to be installed in eval. ; ; As for an example of a situation where it might be useful to have unless as ; a procedure, I'm going to point out something similar I already mentioned - ; cons-stream. Lazy evaluation would remove the necessity to add a special ; form and we can just use cons instead. ================================================ FILE: scheme/sicp/04/27.scm ================================================ ; SICP exercise 4.27 ; ; Suppose we type in the following definitions to the lazy evaluator: ; ; (define count 0) ; (define (id x) ; (set! count (+ count 1)) ; x) ; ; Give the missing values in the following sequence of interactions, and ; explain your answers: ; ; (define w (id (id 10))) ; ;;; L-Eval input ; count ; ;;; L-Eval output ; ; ;;; L-Eval input ; w ; ;;; L-Eval output ; ; ;;; L-Eval input ; count ; ;;; L-Eval output ; ; Here is the full interaction: ; ; (define w (id (id 10))) ; ;;; L-Eval input ; count ; ;;; L-Eval output ; 1 ; ;;; L-Eval input ; w ; ;;; L-Eval output ; 10 ; ;;; L-Eval input ; count ; ;;; L-Eval output ; 2 ; ; When we define w, id gets executed. It takes (id 10) for an argument, ; invokes set! to increment the count and returns a thunk containing (id 10). ; At this point, when we print out count, we get 1. ; ; When we print w, the REPL forces the thunk which calls id again with 10 as ; an argument. set! is invoked one more, incrementing counter to 2. The result ; is printed. ; ; The subsequent printing of count shows the twice incremented value. ================================================ FILE: scheme/sicp/04/28.scm ================================================ ; SICP exercise 4.28 ; ; Eval uses actual-value rather than eval to evaluate the operator before ; passing it to apply, in order to force the value of the operator. Give an ; example that demonstrates the need for this forcing. ; An example can be the following (rather weird) code: ; ; ((lambda (f) (f 2)) ; (lambda (x) (* x 2))) ; ; In the working interpreter it should return 4, but if we use evaluate ; instead of actual-value, it will result to an error. The reason is that ; apply would receive a thunk instead of a procedure and the cond will fail to ; match in either clauses (because a thunk is not a primitive-procedure? and ; is not a compound-procedure?). ================================================ FILE: scheme/sicp/04/29.scm ================================================ ; SICP exercise 4.29 ; ; Exhibit a program that you would expect to run much more slowly without ; memoization than with memoization. Also, consider the following interaction, ; where the id procedure is defined as in exercise 4.27 and count starts as 0: ; ; (define (square x) ; (* x x)) ; ; ;;; L-Eval input: ; (square (id 10)) ; ;;; L-Eval output: ; ; ;;; L-Eval input: ; count ; ;;; L-Eval output: ; ; The interaction would go as follows: ; ; ;;; L-Eval input: ; (square (id 10)) ; ;;; L-Eval output: ; 100 ; ;;; L-Eval input: ; count ; ;;; L-Eval output: ; 2 ; ; The result from square is obvious. Count is 2, because (id 10) got evaluated ; twice - once for each argument of the multiplication. ; ; We had a simple example of such a function in exercise 1.20: ; ; (define (gcd a b) ; (if (= b 0) ; a ; (gcd b (remainder a b)))) ; ; Check out the exercise to see the expansion. The thunk b is evaluated twice ; for every application of gcd, which will take much more time than with ; memoization. ================================================ FILE: scheme/sicp/04/30.scm ================================================ ; SICP exercise 4.30 ; ; Cy D. Fect, a reformed C programmer, is worried that some side effects may ; never take place, because the lazy evaluator doesn't force the expressions ; in a sequence. Since the value of an expression in a sequence other than the ; last one is not used (the expression is there only for its effect, such as ; assigning to a variable or printing), there can be no subsequent use of this ; value (e.g., as an argument to a primitive procedure) that will cause it to ; be forced. Cy thus thinks that when evaluating sequences, we must force all ; expressions in the sequence except the final one. He proposes to modify ; eval-sequence from section 4.1.1 to use actual-value rather than eval: ; ; (define (eval-sequence exps env) ; (cond ((last-exp? exps) (eval (first-exp exps) env)) ; (else (actual-value (first-exp exps) env) ; (eval-sequence (rest-exps exps) env)))) ; ; a. Ben Bitdiddle thinks Cy is wrong. He shows Cy the for-each procedure ; described in exercise 2.23, which gives an important example of a sequence ; with side effects: ; ; (define (for-each proc items) ; (if (null? items) ; 'done ; (begin (proc (car items)) ; (for-each proc (cdr items))))) ; ; He claims that the evaluator in the text (with the original eval-sequence) ; handles this correctly: ; ; ;;; L-Eval input: ; (for-each (lambda (x) (newline) (display x)) ; (list 57 321 88)) ; 57 ; 321 ; 88 ; ;;; L-Eval value: ; done ; ; Explain why Ben is right about the behavior of for-each. ; ; b. Cy agrees that Ben is right about the for-each example, but says that ; that's not the kind of program he was thinking about when he proposed his ; change to eval-sequence. He defines the following two procedures in the lazy ; evaluator: ; ; (define (p1 x) ; (set! x (cons x '(2))) ; x) ; ; (define (p2 x) ; (define (p e) ; e ; x) ; (p (set! x (cons x '(2))))) ; ; What are the values of (p1 1) and (p2 1) with the original eval-sequence? ; What would the values be with Cy's proposed change to eval-sequence? ; ; c. Cy also points out that changing eval-sequence as he proposes does not ; affect the behavior of the example in part a. Explain why this is true. ; ; d. How do you think sequences ought to be treated in the lazy evaluator? Do ; you like Cy's approach, the approach in the text, or some other approach? ; a. It works, whenever eval find an application, it evalutes it. Thus, the ; first expression in begin - (proc (car items)) will get evaluated, which ; will in turn evaluate newline and display, and the latter will force its ; argument. ; ; b. The results in with the original procedure are (1 2) and 1. With Cy's ; version, they will both be (1 2). ; ; c. It is fairly obvious - (proc (car items)) passes through actual-value ; instead of evaluate, but that doesn't change anything, since both will ; force the value. ; ; d. I prefer the approach in the text, since otherwise a huge part of the ; lazy evaluation will be lost. The problem obviously stems from side-effects ; and that can be handled in other ways (do I hear the word "monads"?). ================================================ FILE: scheme/sicp/04/31.scm ================================================ ; SICP exercise 4.31 ; ; The approach taken in this section is somewhat unpleasant, because it makes ; an incompatible change to Scheme. It might be nicer to implement lazy ; evaluation as an upward-compatible extension, that is, so that ordinary ; Scheme programs will work as before. We can do this by extending the syntax ; of procedure declarations to let the user control whether or not arguments ; are to be delayed. While we're at it, we may as well also give the user the ; choice between delaying with and without memoization. For example, the ; definition ; ; (define f a (b lazy) c (d lazy-memo) ; ...) ; ; would define f to be a procedure of four arguments, where the first and ; third arguments are evaluated when the procedure is called, the second ; argument is delayed, and the fourth argument is both delayed and memoized. ; Thus, ordinary procedure definitions will produce the same behavior as ; ordinary Scheme, while adding the lazy-memo declaration to each parameter of ; every compound procedure will produce the behavior of the lazy evaluator ; defined in this section. Design and implement the changes required to ; produce such an extension to Scheme. You will have to implement new syntax ; procedures to handle the new syntax for define. You must also arrange for ; eval or apply to determine when the arguments are to be delayed, and to ; force or delay arguments accordingly, and you must arrange for forcing to ; memoize or not, as appropriate. ; Below is a lazy (as in "not too tidy") implementation of the requested ; evaluator. It introduces some abstraction over procedures, that are used by ; eval and apply. (require r5rs/init) (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (operands exp) env)) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-values arguments env))) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-arguments (procedure-argument-types procedure) arguments env) (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (actual-value exp env) (force-it (evaluate exp env))) (define (thunk exp env) (list 'thunk exp env)) (define (memoizable-thunk exp env) (list 'memoizable-thunk exp env)) (define (thunk? obj) (tagged-list? obj 'thunk)) (define (memoizable-thunk? obj) (tagged-list? obj 'memoizable-thunk)) (define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) (define (force-it obj) (cond ((thunk? obj) (actual-value (thunk-exp obj) (thunk-env obj))) ((memoizable-thunk? obj) (let ((result (actual-value (thunk-exp obj) (thunk-env obj)))) (set-car! obj 'evaluated-thunk) (set-car! (cdr obj) result) (set-cdr! (cdr obj) '()) result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) (define (make-argument type arg env) (cond ((eq? type 'normal) (evaluate arg env)) ((eq? type 'lazy) (thunk arg env)) ((eq? type 'lazy-memo) (memoizable-thunk arg env)) (error "Unknown parameter type" type))) (define (list-of-arguments types arguments env) (map (lambda (type arg) (make-argument type arg env)) types arguments)) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (actual-value (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (define (name-of parameter) (if (pair? parameter) (car parameter) parameter)) (map name-of (cadr p))) (define (procedure-argument-types p) (define (type-of parameter) (cond ((not (pair? parameter)) 'normal) ((eq? (cadr parameter) 'lazy) 'lazy) ((eq? (cadr parameter) 'lazy-memo) 'lazy-memo) (else (error "Badly formed parameter" parameter)))) (map type-of (cadr p))) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/32.scm ================================================ ; SICP exercise 4.32 ; ; Give some examples that illustrate the difference between the streams of ; chapter 3 and the "lazier" lazy lists described in this section. How can you ; take advantage of this extra laziness? ; Well, one of them, obviously, is implementing solve without the necessity ; for delays. This can be generalized for all infinite data structures - ; instead of having to introduce a special form in the language, we can have a ; constructor that lazily evaluates its parameters. A favourite of mine is ; implementing map via accumulate, which cannot happen otherwise. It is not ; the most practical, but it is cool nontheless. ================================================ FILE: scheme/sicp/04/33.scm ================================================ ; SICP exercise 4.33 ; ; Ben Bitdiddle tests the lazy list implementation given above by evaluating ; the expression ; ; (car '(a b c)) ; ; To his surprise, this produces an error. After some thought, he realizes ; that the "lists" obtained by reading in quoted expressions are different ; from the lists manipulated by the new definitions of cons, car and cdr. ; Modify the evaluator's treatment of quoated expressions so that quoted lists ; typed at the driver loop will produce true lazy lists. (require r5rs/init) (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (eval-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (actual-value (operator exp) env) (operands exp) env)) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-arg-values arguments env))) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-delayed-args arguments env) (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (actual-value exp env) (force-it (evaluate exp env))) (define (delay-it exp env) (list 'thunk exp env)) (define (thunk? obj) (tagged-list? obj 'thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk)) (define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) (define (force-it obj) (cond ((thunk? obj) (let ((result (actual-value (thunk-exp obj) (thunk-env obj)))) (set-car! obj 'evaluated-thunk) (set-car! (cdr obj) result) (set-cdr! (cdr obj) '()) result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) (define (list-of-arg-values exps env) (if (no-operands? exps) '() (cons (actual-value (first-operand exps) env) (list-of-arg-values (rest-operands exps) env)))) (define (list-of-delayed-args exps env) (if (no-operands? exps) '() (cons (delay-it (first-operand exps) env) (list-of-delayed-args (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (actual-value (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (eval-quotation exp) (let ((text (text-of-quotation exp))) (if (pair? text) (evaluate (list 'cons (list 'quote (car text)) (list 'quote (cdr text))) the-global-environment) text))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list '= =) (list 'null? null?) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define definitions '((define (cons x y) (lambda (m) (m x y))) (define (car z) (z (lambda (p q) p))) (define (cdr z) (z (lambda (p q) q))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (evaluate definition initial-env)) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; L-Eval input:") (define output-prompt ";;; L-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/34.scm ================================================ ; SICP exercise 4.34 ; ; Modify the driver loop for the evaluator so that lazy pairs and lists will ; print in some reasonable way. (What are you going to do about infinite ; lists?) You may also need to modify the representation of lazy pairs so that ; the evaluator can identify them in order to print them. ; Phew, this gave me some hard time. I had to take a piece of paper and sketch ; notes. Apparently that is a good idea from time to time. ; ; We base the code on the previous exercise's solution. We implement a ; procedure print in the evaluator. We change the representation to a tagged ; list (with 'pair) and the lambda. It is far from the best solution, but at ; least it does it in the interpreter. We also make the pair self-evaluating, ; since we're passing it to apply-procedure in user-print. (require r5rs/init) (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (eval-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (actual-value (operator exp) env) (operands exp) env)) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-arg-values arguments env))) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-delayed-args arguments env) (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (actual-value exp env) (force-it (evaluate exp env))) (define (delay-it exp env) (list 'thunk exp env)) (define (thunk? obj) (tagged-list? obj 'thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk)) (define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) (define (force-it obj) (cond ((thunk? obj) (let ((result (actual-value (thunk-exp obj) (thunk-env obj)))) (set-car! obj 'evaluated-thunk) (set-car! (cdr obj) result) (set-cdr! (cdr obj) '()) result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) (define (list-of-arg-values exps env) (if (no-operands? exps) '() (cons (actual-value (first-operand exps) env) (list-of-arg-values (rest-operands exps) env)))) (define (list-of-delayed-args exps env) (if (no-operands? exps) '() (cons (delay-it (first-operand exps) env) (list-of-delayed-args (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (actual-value (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (eval-quotation exp) (let ((text (text-of-quotation exp))) (if (pair? text) (evaluate (list 'cons (list 'quote (car text)) (list 'quote (cdr text))) the-global-environment) text))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) ((tagged-list? exp 'pair) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list '= =) (list 'null? null?) (list 'scheme-eq? eq?) (list 'scheme-cons cons) (list 'scheme-car car) (list 'scheme-cdr cdr) (list 'scheme-pair? pair?) (list 'display display) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define definitions '((define (pair? x) (if (scheme-pair? x) (scheme-eq? (scheme-car x) 'pair) false)) (define (cons x y) (scheme-cons 'pair (lambda (m) (m x y)))) (define (car z) ((scheme-cdr z) (lambda (p q) p))) (define (cdr z) ((scheme-cdr z) (lambda (p q) q))) (define (memq item items) (cond ((null? items) false) ((scheme-eq? (car items) item) true) (else (memq item (cdr items))))) (define (print object) (define (print object encountered) (cond ((memq object encountered) (display "(...)")) ((pair? object) (display "(") (print (car object) (cons object encountered)) (print-cdr (cdr object) (cons object encountered))) ((null? object) (display "()")) (else (display object)))) (define (print-cdr rest encountered) (cond ((memq rest encountered) (display " (...))")) ((null? rest) (display ")")) ((pair? rest) (display " ") (print (car rest) (cons rest encountered)) (print-cdr (cdr rest) (cons rest encountered))) (else (display " . ") (print rest encountered) (display ")")))) (print object '())))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (evaluate definition initial-env)) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; L-Eval input:") (define output-prompt ";;; L-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (apply-procedure (lookup-variable-value 'print the-global-environment) (list object) the-global-environment))) ================================================ FILE: scheme/sicp/04/35.scm ================================================ ; SICP exercise 4.35 ; ; Write a procedure an-integer-between that returns an integer between two ; given bounds. This can be used to implement a procedure that finds ; Pythagorean triples, i.e., triples of integers (i, j, k) between the given ; bounds such that i ≤ j and i² + j² = k², as follows: ; ; (define (a-ptyhagorean-triple-between low high) ; (let ((i (an-integer-between low high))) ; (let ((j (an-integer-between i high))) ; (let ((k (an-integer-between j high))) ; (require (= (+ (* i i) (* j j) (* k k)))) ; (list i j k))))) (require r5rs/init) ; The solution follows. There is some support code for the tests in the end of ; the file. (define solution '((define (an-integer-between low high) (if (> low high) (amb) (amb low (an-integer-between (+ low 1) high)))) (define (a-pythagorean-triple-between low high) (let ((i (an-integer-between low high))) (let ((j (an-integer-between i high))) (let ((k (an-integer-between j high))) (require (= (+ (* i i) (* j j)) (* k k))) (list i j k))))))) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/36.scm ================================================ ; SICP exercise 4.36 ; ; Exercise 3.69 discussed how to generate the stream of all Pythagorean ; triples, with no upper bound on the size of the integers to be searched. ; Explain why simply replacing an-integer-between by an-integer-starting-from ; in the procedure in exercise 4.35 is not an adequate way to generate ; arbitrary Pythagorean triples. Write a procedure that actually will ; accomplish this. (That is, write a procedure for which repeatedly typing ; try-again would in principle eventually generate all Pythagorean triples). (require r5rs/init) ; Say we do said replacing. On the first backtrack, the innermost call to ; an-integer-starting-from will result to 2. On the second backtrack, it will ; be 3 and so on, never giving a chance to the previous calls to return ; anything different than the initial value. ; The solution follows. There is some support code for the tests in the end of ; the file. (define solution '((define (an-integer-starting-from n) (amb n (an-integer-starting-from (+ n 1)))) (define (an-integer-between low high) (if (> low high) (amb) (amb low (an-integer-between (+ low 1) high)))) (define (a-pythagorean-triple) (let ((k (an-integer-starting-from 1))) (let ((i (an-integer-between 1 k))) (let ((j (an-integer-between i k))) (require (= (+ (* i i) (* j j)) (* k k))) (list i j k))))))) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/37.scm ================================================ ; SICP exercise 4.37 ; ; Ben Bitdiddle claims that the following method for generating Pythagorean ; triples is more efficient than the one in exercise 4.35. Is he correct? ; (Hint: Consider the number of possibilities that must be explored.) ; ; (define (a-pythagorean-triple-between low high) ; (let ((i (an-integer-between low high)) ; (hsq (* high high))) ; (let ((j (an-integer-between i high))) ; (let ((ksq (+ (* i i) (* j j)))) ; (require (>= hsq ksq)) ; (let ((k (sqrt ksq))) ; (require (integer? k)) ; (list i j k)))))) ; It seems so. Ben's version is n², while the text version is n³. On the other ; hand, Ben's version uses sqrt which is slower in general, so there might be ; cases where where Ben's version is slower (probably for small values of ; high - low). ================================================ FILE: scheme/sicp/04/38.scm ================================================ ; SICP exercise 4.38 ; ; Modify the multiple-dwelling procedure to omit the requirement that Smith ; and Fletcher do not live on adjancent floors. How many solutions are there ; to this modified puzzle? (require r5rs/init) ; We get five values, which are the following: ; ; ((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) ; ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3)) ; ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3)) ; ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) ; ((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1)) ; ; Here's the code to reproduce it: (define solution '((define (distinct? items) (cond ((null? items) true) ((null? (cdr items)) true) ((member (car items) (cdr items)) false) (else (distinct? (cdr items))))) (define (multiple-dwelling) (let ((baker (amb 1 2 3 4 5)) (cooper (amb 1 2 3 4 5)) (fletcher (amb 1 2 3 4 5)) (miller (amb 1 2 3 4 5)) (smith (amb 1 2 3 4 5))) (require (distinct? (list baker cooper fletcher miller smith))) (require (not (= baker 5))) (require (not (= cooper 1))) (require (not (= fletcher 5))) (require (not (= fletcher 1))) (require (> miller cooper)) (require (not (= (abs (- fletcher cooper)) 1))) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))))) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/39.scm ================================================ ; SICP exercise 4.39 ; ; Does the order of the restrictions in the multiple-dwelling procedure affect ; the answer? Does it affect the time to find an answer? If you think it ; matters, demonstrate a faster program obtained from the given one by ; reordering the restrictions. If you think it does not matter, argue your ; case. (require r5rs/init) ; The result is not going to change at all. The running time can change, ; though. Doing the rearrangement below, we can achieve the following results: ; ; slow-multiple-dwelling: cpu time: 1247 real time: 1264 gc time: 66 ; fast-multiple-dwelling: cpu time: 765 real time: 774 gc time: 25 ; ; One trick is moving (> miller cooper) up front, since it is a cheap and ; restrictive requirement. Another is moving the distinct? check at the end, ; because that is an expensive operation. (define solution '((define (distinct? items) (cond ((null? items) true) ((null? (cdr items)) true) ((member (car items) (cdr items)) false) (else (distinct? (cdr items))))) (define (slow-multiple-dwelling) (let ((baker (amb 1 2 3 4 5)) (cooper (amb 1 2 3 4 5)) (fletcher (amb 1 2 3 4 5)) (miller (amb 1 2 3 4 5)) (smith (amb 1 2 3 4 5))) (require (distinct? (list baker cooper fletcher miller smith))) (require (not (= baker 5))) (require (not (= cooper 1))) (require (not (= fletcher 5))) (require (not (= fletcher 1))) (require (> miller cooper)) (require (not (= (abs (- smith fletcher)) 1))) (require (not (= (abs (- fletcher cooper)) 1))) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))) (define (fast-multiple-dwelling) (let ((baker (amb 1 2 3 4 5)) (cooper (amb 1 2 3 4 5)) (fletcher (amb 1 2 3 4 5)) (miller (amb 1 2 3 4 5)) (smith (amb 1 2 3 4 5))) (require (> miller cooper)) (require (not (= cooper 1))) (require (not (= fletcher 1))) (require (not (= (abs (- smith fletcher)) 1))) (require (not (= (abs (- fletcher cooper)) 1))) (require (not (= fletcher 5))) (require (not (= baker 5))) (require (distinct? (list baker cooper fletcher miller smith))) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))))) (define (time-procedure name) (define (times n proc) (if (= n 0) 'done (begin (proc) (times (- n 1) proc)))) (printf "~a: " name) (time (times 100 (lambda () (ambeval (list name) solution-environment (lambda (val fail) 'ok) (lambda () 'ok)))))) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) (time-procedure 'slow-multiple-dwelling) (time-procedure 'fast-multiple-dwelling) ================================================ FILE: scheme/sicp/04/40.scm ================================================ ; SICP exercise 4.40 ; ; In the multiple dwelling problem, how many sets of assignments are there of ; people to floors, both before and after the requirement that floor ; assignments be distinct? It is very inefficient to generate all possible ; assignments of people to floors and then leave it to backtracking to ; eliminate them. For example, most of the restrictions depend on only one or ; two of the person-floor variables, and can thus be imposed before floors ; have been selected for all the people. Write and demonstrate a much more ; efficient nondeterministic procedure that solves this problem based upon ; generating only those possibilities that are not already ruled out by ; previous restrictions. (Hint: This will require a nest of let expressions). (require r5rs/init) ; In the first case, there are 5⁵ lists passed to distinct?, which is ; incredibly slow. ; ; Below you will find a faster version when. The comparison is: ; ; slow-multiple-dwelling: cpu time: 1226 real time: 1241 gc time: 59 ; fast-multiple-dwelling: cpu time: 40 real time: 40 gc time: 2 ; ; ...which is way better than the previous exercise. (define solution '((define (distinct? items) (cond ((null? items) true) ((null? (cdr items)) true) ((member (car items) (cdr items)) false) (else (distinct? (cdr items))))) (define (fast-multiple-dwelling) (let ((cooper (amb 1 2 3 4 5))) (require (not (= cooper 1))) (let ((miller (amb 1 2 3 4 5))) (require (> miller cooper)) (let ((fletcher (amb 1 2 3 4 5))) (require (not (= fletcher 1))) (require (not (= fletcher 1))) (require (not (= (abs (- fletcher cooper)) 1))) (let ((smith (amb 1 2 3 4 5))) (require (not (= (abs (- smith fletcher)) 1))) (let ((baker (amb 1 2 3 4 5))) (require (not (= baker 5))) (require (distinct? (list baker cooper fletcher miller smith))) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))))))) (define (slow-multiple-dwelling) (let ((baker (amb 1 2 3 4 5)) (cooper (amb 1 2 3 4 5)) (fletcher (amb 1 2 3 4 5)) (miller (amb 1 2 3 4 5)) (smith (amb 1 2 3 4 5))) (require (distinct? (list baker cooper fletcher miller smith))) (require (not (= baker 5))) (require (not (= cooper 1))) (require (not (= fletcher 5))) (require (not (= fletcher 1))) (require (> miller cooper)) (require (not (= (abs (- smith fletcher)) 1))) (require (not (= (abs (- fletcher cooper)) 1))) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))))) (define (time-procedure name) (define (times n proc) (if (= n 0) 'done (begin (proc) (times (- n 1) proc)))) (printf "~a: " name) (time (times 100 (lambda () (ambeval (list name) solution-environment (lambda (val fail) 'ok) (lambda () 'ok)))))) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) (time-procedure 'slow-multiple-dwelling) (time-procedure 'fast-multiple-dwelling) ================================================ FILE: scheme/sicp/04/41.scm ================================================ ; SICP exercise 4.41 ; ; Write an ordinary Scheme program to solve the multiple dwelling puzzle. ; Wow, really? OK! (define (multiple-dwellings) (define (solution? baker cooper fletcher miller smith) (and (not (= baker 5)) (not (= cooper 1)) (not (= fletcher 5)) (not (= fletcher 1)) (> miller cooper) (not (= (abs (- smith fletcher)) 1)) (not (= (abs (- fletcher cooper)) 1)))) (define (combine-lists a b) (if (null? a) '() (cons (list (car a) (car b)) (combine-lists (cdr a) (cdr b))))) (map (lambda (floors) (combine-lists '(baker cooper fletcher miller smith) floors)) (filter (lambda (floors) (apply solution? floors)) (permute 5)))) (define (permute n) (define (insert-into n items) (if (null? items) (list (cons n '())) (cons (cons n items) (map (lambda (rest) (cons (car items) rest)) (insert-into n (cdr items)))))) (if (= n 1) '((1)) (flat-map (lambda (items) (insert-into n items)) (permute (- n 1))))) (define (flat-map proc items) (if (null? items) '() (append (proc (car items)) (flat-map proc (cdr items))))) ================================================ FILE: scheme/sicp/04/42.scm ================================================ ; SICP exercise 4.42 ; ; Solve the following "Liars" puzzle (from Phillips 1934): ; ; Five schoolgirls sat for an examination. Their parents - so they thought - ; showed an undue degree of interest in the result. They therefore agreed ; that, in writing home about the examination, each girl should make one ; true statement and one untrue one. The following are the relevant passages ; from their letters: ; ; * Betty: Kitty was second in the examination. I was only third. ; * Ethel: You'll be glad to hear I was on top. Joan was second. ; * Joan: I was third, and poor old Ethel was bottom. ; * Kitty: I came out second. Mary was only fourth. ; * Mary: I was fourth. Top place was taked by Betty. ; ; What in fact was the order in which the five girls were placed? (require r5rs/init) ; The solution to the puzzle is: ; ; ((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4)) ; ; The code that discovers it is below. (define solution '((define (distinct? items) (cond ((null? items) true) ((null? (cdr items)) true) ((member (car items) (cdr items)) false) (else (distinct? (cdr items))))) (define (xor a b) (if a (not b) b)) (define (lairs) (let ((betty (amb 1 2 3 4 5)) (ethel (amb 1 2 3 4 5)) (joan (amb 1 2 3 4 5)) (kitty (amb 1 2 3 4 5)) (mary (amb 1 2 3 4 5))) (require (xor (= kitty 2) (= betty 3))) (require (xor (= ethel 1) (= joan 2))) (require (xor (= joan 3) (= ethel 5))) (require (xor (= kitty 2) (= mary 4))) (require (xor (= mary 4) (= betty 1))) (require (distinct? (list betty ethel joan kitty mary))) (list (list 'betty betty) (list 'ethel ethel) (list 'joan joan) (list 'kitty kitty) (list 'mary mary)))))) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/43.scm ================================================ ; SICP exercise 4.43 ; ; Use the amb evaluator to solve the following puzzle: ; ; Mary Ann Moore's father has a yacht and so has each of his four friends. ; Colonel Downing, Mr. Hall, Sir Barnacle Hood, and Dr. Parker. Each of the ; five also has one daughter and each has named his yacht after a daughter ; of one of the others. Sir Barnacle's yacht is the Gabrielle, Mr. Moore ; owns the Lorna; Mr. Hall the Rosalind. The Melissa, owned by Colonel ; Downing, is named after Sir Barnacle's daughter. Gabrielle's father owns ; the yacht that is named after Dr. Parker's daughter. Who is Lorna's ; father? ; ; Try to write the program so that it runs efficiently (see exercise 4.40). ; Also determine how many solutions are there if we are not told that Mary ; Ann's last name is Moore. (require r5rs/init) ; The solution to the puzzle is Colonel Downing. ; ; If we omit the fact that Mary Ann's last name is Moore, then there would be ; two solutions, the second of which is Dr. Parker. (define solution '((define (map proc items) (if (null? items) '() (cons (proc (car items)) (map proc (cdr items))))) (define (distinct? items) (cond ((null? items) true) ((null? (cdr items)) true) ((member (car items) (cdr items)) false) (else (distinct? (cdr items))))) (define (xor a b) (if a (not b) b)) (define (yachts-and-daughters mary-ann-is-moore) (define (names) (amb 'gabrielle 'lorna 'rosalind 'mary-ann 'melissa)) (define (daughter pair) (car pair)) (define (yacht pair) (car (cdr pair))) (define (father-of girl fathers) (cond ((null? fathers) (error)) ((eq? (daughter (car fathers)) girl) (car fathers)) (else (father-of girl (cdr fathers))))) (define (daughter-and-yacht) (let ((daughter (names)) (yacht (names))) (require (not (eq? daughter yacht))) (list daughter yacht))) (define (name-of-father daughter results) (if (eq? (car (cdr (car results))) daughter) (car (car results)) (name-of-father daughter (cdr results)))) (let ((moore (daughter-and-yacht))) (if mary-ann-is-moore (require (eq? (daughter moore) 'mary-ann)) 'ok) (require (eq? (yacht moore) 'lorna)) (let ((barnacle (daughter-and-yacht))) (require (eq? (yacht barnacle) 'gabrielle)) (require (eq? (daughter barnacle) 'melissa)) (let ((hall (daughter-and-yacht))) (require (eq? (yacht hall) 'rosalind)) (let ((downing (daughter-and-yacht))) (require (eq? (yacht downing) 'melissa)) (let ((parker (daughter-and-yacht))) (let ((fathers (list moore barnacle hall downing parker))) (require (distinct? (map yacht fathers))) (require (distinct? (map daughter fathers))) (require (eq? (daughter parker) (yacht (father-of 'gabrielle fathers)))) (name-of-father 'lorna (list (cons 'moore moore) (cons 'barnacle barnacle) (cons 'hall hall) (cons 'downing downing) (cons 'parker parker)))))))))) )) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'eq? eq?) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list 'display display) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/44.scm ================================================ ; SICP exercise 4.44 ; ; Exercise 2.42 described the "eight-queens puzzle" of placing queens on a ; chessboard so that no two attack each other. Write a nondeterministic ; program to solve this puzzle. (require r5rs/init) ; The solution is simpler than the one in exercise 2.42. First, it does not ; have awkward requirements on representing queen positions. Second, the ; algorithm does not require map-ing, flatmap-ing and filtering like crazy. (define solution '((define (map proc items) (if (null? items) '() (cons (proc (car items)) (map proc (cdr items))))) (define (all? proc items) (cond ((null? items) true) ((proc (car items)) (all? proc (cdr items))) (else false))) (define (an-integer-between low high) (if (> low high) (amb) (amb low (an-integer-between (+ low 1) high)))) (define (queens board-size) (define (safe? position other-queens) (let ((q1r (car position)) (q1f (cadr position))) (all? (lambda (queen) (let ((q2r (car queen)) (q2f (cadr queen))) (cond ((= q1r q2r) false) ((= q1f q2f) false) ((= (+ q1r q1f) (+ q2r q2f)) false) ((= (- q1r q1f) (- q2r q2f)) false) (else true)))) other-queens))) (define (place-queens rank queens) (if (> rank board-size) (reverse (map cadr queens)) (let ((file (an-integer-between 1 board-size))) (let ((position (list rank file))) (require (safe? position queens)) (place-queens (+ rank 1) (cons position queens)))))) (place-queens 1 '())) )) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cadr cadr) (list 'cons cons) (list 'eq? eq?) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list 'reverse reverse) (list 'display display) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/45.scm ================================================ ; SICP exercise 4.45 ; ; With the grammar give above, the following sentence can be parsed in five ; different ways: "The professor lectures to the student in the class with the ; cat". Give the five parses and explain the differences in shades of meaning ; among them. (require r5rs/init) ; The possible meanings are: ; ; (sentence ; (simple-noun-phrase (article the) (noun professor)) ; (verb-phrase ; (verb-phrase ; (verb-phrase ; (verb lectures) ; (prep-phrase ; (prep to) ; (simple-noun-phrase (article the) (noun student)))) ; (prep-phrase ; (prep in) ; (simple-noun-phrase (article the) (noun class)))) ; (prep-phrase ; (prep with) ; (simple-noun-phrase (article the) (noun cat))))) ; ; The profer is lecuring in a class using a cat to a student that is in the class. ; ; (sentence ; (simple-noun-phrase (article the) (noun professor)) ; (verb-phrase ; (verb-phrase ; (verb lectures) ; (prep-phrase ; (prep to) ; (simple-noun-phrase (article the) (noun student)))) ; (prep-phrase ; (prep in) ; (noun-phrase ; (simple-noun-phrase (article the) (noun class)) ; (prep-phrase ; (prep with) ; (simple-noun-phrase (article the) (noun cat))))))) ; ; The professor is lecturing a student, which being in a class that has a cat. ; ; (sentence ; (simple-noun-phrase (article the) (noun professor)) ; (verb-phrase ; (verb-phrase ; (verb lectures) ; (prep-phrase ; (prep to) ; (noun-phrase ; (simple-noun-phrase (article the) (noun student)) ; (prep-phrase ; (prep in) ; (simple-noun-phrase (article the) (noun class)))))) ; (prep-phrase ; (prep with) ; (simple-noun-phrase (article the) (noun cat))))) ; ; The professor is using a lact to lecture a student that is in the class. ; ; (sentence ; (simple-noun-phrase (article the) (noun professor)) ; (verb-phrase ; (verb lectures) ; (prep-phrase ; (prep to) ; (noun-phrase ; (noun-phrase ; (simple-noun-phrase (article the) (noun student)) ; (prep-phrase ; (prep in) ; (simple-noun-phrase (article the) (noun class)))) ; (prep-phrase ; (prep with) ; (simple-noun-phrase (article the) (noun cat))))))) ; ; There is a student in the class that has a cat, that is being lectured by ; the professor. ; ; (sentence ; (simple-noun-phrase (article the) (noun professor)) ; (verb-phrase ; (verb lectures) ; (prep-phrase ; (prep to) ; (noun-phrase ; (simple-noun-phrase (article the) (noun student)) ; (prep-phrase ; (prep in) ; (noun-phrase ; (simple-noun-phrase (article the) (noun class)) ; (prep-phrase ; (prep with) ; (simple-noun-phrase (article the) (noun cat))))))))))) ; ; In the class with the cat, there is a student, that is being lectured by the ; professor. (define solution '((define nouns '(noun student professor cat class)) (define verbs '(verb studies lectures eats sleeps)) (define articles '(article the a)) (define prepositions '(prep for to in by with)) (define (parse-sentence) (list 'sentence (parse-noun-phrase) (parse-verb-phrase))) (define (parse-noun-phrase) (define (maybe-extend noun-phrase) (amb noun-phrase (maybe-extend (list 'noun-phrase noun-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-simple-noun-phrase))) (define (parse-simple-noun-phrase) (list 'simple-noun-phrase (parse-word articles) (parse-word nouns))) (define (parse-verb-phrase) (define (maybe-extend verb-phrase) (amb verb-phrase (maybe-extend (list 'verb-phrase verb-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-word verbs))) (define (parse-prepositional-phrase) (list 'prep-phrase (parse-word prepositions) (parse-noun-phrase))) (define (parse-word word-list) (require (not (null? *unparsed*))) (require (memq (car *unparsed*) (cdr word-list))) (let ((found-word (car *unparsed*))) (set! *unparsed* (cdr *unparsed*)) (list (car word-list) found-word))) (define *unparsed* '()) (define (parse input) (set! *unparsed* input) (let ((sent (parse-sentence))) (require (null? *unparsed*)) sent)) )) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cadr cadr) (list 'cons cons) (list 'eq? eq?) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list 'memq memq) (list 'reverse reverse) (list 'display display) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/46.scm ================================================ ; SICP exercise 4.46 ; ; The evaluators in section 4.1 and 4.2 do not determine what order operands ; are evaluated in. We will see that the amb evaluator evaluates them from ; left to right. Explain why our parsing program wouldn't work if the operands ; are evaluated in some other order. ; Well, that's painstakingly straightforward. ; ; Given the initial parse-noun-phrase definition: ; ; (define (parse-noun-phrase) ; (list 'noun-phrase ; (parse-word articles) ; (parse-word nouns))) ; ; When we evaluate right to left instead of left to right, (parse-word nouns) ; would consume input before (parse-word articles), changing the meaning of ; (parse-noun-phrase) as if those two were reversed in the left to right ; evaluator. ================================================ FILE: scheme/sicp/04/47.scm ================================================ ; SICP exercise 4.47 ; ; Louis Reasoner suggests that, since a verb phrase is either a verb or a verb ; phrase followed by a prepositional phrase, it would be much more ; straightforward to define the procedure parse-verb-phrase as follows (and ; similarly for noun phrases): ; ; (define (parse-verb-phrase) ; (amb (parse-word verbs) ; (list 'verb-phrase ; (parse-verb-phrase) ; (parse-prepositional-phrase)))) ; ; Does this work? Does the program's behavior change if we interchange the ; order of expressions in amb? ; It does not work. The problem is apparent when we rearrange the statements. ; parse-verb-phrase falls into an infinite recurssion. ; ; When the expressions in amb are in the order Louis' suggets, it might ; produce a result if (parse-word verbs) matches anything, but calling ; try-again will get it stuck in the other infinite recursion branch. That ; might also produce a result, but eventually, trying to exhaust all ; posibilities will be stuck in that recursion. ================================================ FILE: scheme/sicp/04/48.scm ================================================ ; SICP exercise 4.48 ; ; Extend the grammar given above to handle more complex sentences. For ; example, you could extend noun phrases and verb phrases to include ; adjectives and adverbs, or you could handle compound sentences. (require r5rs/init) ; Since this isn't very interesting, we only introducing adjectives and ; adverbs. A noun phrase is [article adjective* noun] and a verb phrase ; becomes [verb preposition-phrase* adverb?]. (define solution '((define nouns '(noun student professor cat class)) (define verbs '(verb studies lectures eats sleeps)) (define adjectives '(adjective brown fast quick sharp)) (define adverbs '(adverb solemnly quietly loudly silently)) (define articles '(article the a)) (define prepositions '(prep for to in by with)) (define (parse-sentence) (list 'sentence (parse-noun-phrase) (parse-verb-phrase))) (define (parse-noun-phrase) (define (maybe-extend noun-phrase) (amb noun-phrase (maybe-extend (list 'noun-phrase noun-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-simple-noun-phrase))) (define (parse-simple-noun-phrase) (list 'simple-noun-phrase (parse-word articles) (optional-list-of 'adjective-list parse-adjective) (parse-word nouns))) (define (parse-verb-phrase) (define (maybe-extend verb-phrase) (amb verb-phrase (list 'verb-phrase verb-phrase (parse-adverb)) (maybe-extend (list 'verb-phrase verb-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-word verbs))) (define (parse-prepositional-phrase) (list 'prep-phrase (parse-word prepositions) (parse-noun-phrase))) (define (parse-adverb) (parse-word adverbs)) (define (parse-adjective) (parse-word adjectives)) (define (optional-list-of name parse-function) (amb (list name) (cons name (cons (parse-function) (cdr (optional-list-of name parse-function)))))) (define (parse-word word-list) (require (not (null? *unparsed*))) (require (memq (car *unparsed*) (cdr word-list))) (let ((found-word (car *unparsed*))) (set! *unparsed* (cdr *unparsed*)) (list (car word-list) found-word))) (define *unparsed* '()) (define (parse input) (set! *unparsed* input) (let ((sent (parse-sentence))) (require (null? *unparsed*)) sent)) )) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cadr cadr) (list 'cons cons) (list 'eq? eq?) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list 'memq memq) (list 'reverse reverse) (list 'display display) (list 'append append) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/49.scm ================================================ ; SICP exercise 4.49 ; ; Alyssa P. Hacker is more interested in generating interesting sentences than ; in parsing them. She reasons that by simply changing the procedure ; parse-word so that it ignores the "input sentence" and instead always ; succeeds and generates an appropriate word, we can use the programs we had ; built for parsing to do generation instead. Implement Alyssa's idea, and ; show the first half-dozen or so sentences generated. (require r5rs/init) ; The modification is below. There is an additional procedure terminals that ; extracts the terminal symbols of the parsed sentence to form a list that ; looks like a sentence. Here are the first half-dozen sentences: ; ; (the student studies) ; (the student studies for the student) ; (the student studies for the student for the student) ; (the student studies for the student for the student for the student) ; (the student studies for the student for the student for the student for the student) ; (the student studies for the student for the student for the student for the student for the student) ; ; Obviously, there are not very useful, even if they are "gramatically ; correct" for some definition of the term. (define solution '((define nouns '(noun student professor cat class)) (define verbs '(verb studies lectures eats sleeps)) (define articles '(article the a)) (define prepositions '(prep for to in by with)) (define (parse-sentence) (list 'sentence (parse-noun-phrase) (parse-verb-phrase))) (define (parse-noun-phrase) (define (maybe-extend noun-phrase) (amb noun-phrase (maybe-extend (list 'noun-phrase noun-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-simple-noun-phrase))) (define (parse-simple-noun-phrase) (list 'simple-noun-phrase (parse-word articles) (parse-word nouns))) (define (parse-verb-phrase) (define (maybe-extend verb-phrase) (amb verb-phrase (maybe-extend (list 'verb-phrase verb-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-word verbs))) (define (parse-prepositional-phrase) (list 'prep-phrase (parse-word prepositions) (parse-noun-phrase))) (define (parse-word word-list) (if (null? (cdr word-list)) (amb) (amb (list (car word-list) (cadr word-list)) (parse-word (cons (car word-list) (cddr word-list)))))) (define (generate-sentence) (parse-sentence)) (define (terminals sentence) (cond ((null? sentence) '()) ((pair? (car sentence)) (append (terminals (car sentence)) (terminals (cdr sentence)))) ((memq (car sentence) '(noun verb article prep)) (list (cadr sentence))) (else (terminals (cdr sentence))))) )) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cadr cadr) (list 'cons cons) (list 'eq? eq?) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list 'append append) (list 'memq memq) (list 'reverse reverse) (list 'display display) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) ================================================ FILE: scheme/sicp/04/50.scm ================================================ ; SICP exercise 4.50 ; ; Implement a new special form ramb that is like amb except that it searches ; alternatives in a random order, rather than from left to right. Show how ; this can help with Alyssa's problem in exercise 4.49. (require r5rs/init) ; Just run this file to get an output. (define solution '((define nouns '(noun student professor cat class)) (define verbs '(verb studies lectures eats sleeps)) (define articles '(article the a)) (define prepositions '(prep for to in by with)) (define (parse-sentence) (list 'sentence (parse-noun-phrase) (parse-verb-phrase))) (define (parse-noun-phrase) (define (maybe-extend noun-phrase) (ramb noun-phrase (maybe-extend (list 'noun-phrase noun-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-simple-noun-phrase))) (define (parse-simple-noun-phrase) (list 'simple-noun-phrase (parse-word articles) (parse-word nouns))) (define (parse-verb-phrase) (define (maybe-extend verb-phrase) (ramb verb-phrase (maybe-extend (list 'verb-phrase verb-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-word verbs))) (define (parse-prepositional-phrase) (list 'prep-phrase (parse-word prepositions) (parse-noun-phrase))) (define (parse-word word-list) (if (null? (cdr word-list)) (ramb) (ramb (list (car word-list) (cadr word-list)) (parse-word (cons (car word-list) (cddr word-list)))))) (define (generate-sentence) (parse-sentence)) (define (terminals sentence) (cond ((null? sentence) '()) ((pair? (car sentence)) (append (terminals (car sentence)) (terminals (cdr sentence)))) ((memq (car sentence) '(noun verb article prep)) (list (cadr sentence))) (else (terminals (cdr sentence))))) )) ; The rest of the interpreter. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((ramb? exp) (analyze-ramb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (randomize items) (define (remove-item item items) (if (eq? item (car items)) (cdr items) (cons (car items) (remove-item item (cdr items))))) (define (list-item n items) (if (= n 0) (car items) (list-item (- n 1) (cdr items)))) (if (null? items) '() (let ((item (list-item (random (length items)) items))) (cons item (randomize (remove-item item items)))))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (analyze-ramb exp) (let ((cprocs (map analyze (ramb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next (randomize cprocs))))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (ramb? exp) (tagged-list? exp 'ramb)) (define (ramb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cadr cadr) (list 'cddr cddr) (list 'cons cons) (list 'eq? eq?) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list 'abs abs) (list 'member member) (list 'append append) (list 'memq memq) (list 'reverse reverse) (list 'display display) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define solution-environment ((lambda () (define environment (setup-environment)) (for-each (lambda (definition) (ambeval definition environment (lambda (value fail) 'ok) (lambda () 'ok))) solution) environment))) (define (a-value-of exp) (ambeval exp solution-environment (lambda (value fail) value) (lambda () '()))) (display (a-value-of '(terminals (generate-sentence)))) (newline) ================================================ FILE: scheme/sicp/04/51.scm ================================================ ; SICP exercise 4.51 ; ; Implement a new kind of assignment called permanent-set! that is not undone ; upon failure. For example, we can choose two distinct elements from a list ; and count the number of trials required to make a successful choice as ; follows: ; ; (define count 0) ; (let ((x (an-element-of '(a b c))) ; (y (an-element-of '(a b c)))) ; (permanent-set! count (+ count 1)) ; (require (not (eq? x y))) ; (list x y count)) ; ; ;;; Starting a new problem ; ;;; Amb-Eval value: ; (a b 2) ; ;;; Amb-Eval input ; try-again ; ;;; Amb-Eval value ; (a c 3) ; ; What values would have been displayed if we had used set! here rather than ; permanent-set! ? (require r5rs/init) ; The implementation is below. ; ; The values would be (a b 1), (a c 1) and so on... (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((permantent-assignment? exp) (analyze-permanent-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-permanent-assignment exp) (let ((var (permantent-assignment-variable exp)) (vproc (analyze (permantent-assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (set-variable-value! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (permantent-assignment? exp) (tagged-list? exp 'permanent-set!)) (define (permantent-assignment-variable exp) (cadr exp)) (define (permantent-assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'eq? eq?) (list 'list list) (list 'not not) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/52.scm ================================================ ; SICP exercise 4.52 ; ; Implement a new construct called if-fail that permits the user to catch the ; failure of an expression. If-fail takes two expressions. It evaluates the ; first expression as usual and returns as usual if the evaluation succeeds. ; If the evaluation fails, however, the value of the second expression is ; returned, as in the following example: ; ; (if-fail (let ((x (an-element-of '(1 3 5)))) ; (require (even? x)) ; x) ; 'all-odd) ; ;;; Starting a new problem ; ;;; Amb-Eval value: ; all-odd ; ;;; Amb-Eval input: ; (if-fail (let ((x (an-element-of '(1 3 5 8)))) ; (require (even? x)) ; x) ; 'all-odd) ; ;;; Starting a new problem ; ;;; Amb-Eval value: ; 8 (require r5rs/init) ; The implementation is below. ; ; I'm basing this on the previous exercise, because we are going to need both ; fail-if and permanent-set! in the next one. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((permantent-assignment? exp) (analyze-permanent-assignment exp)) ((if-fail? exp) (analyze-if-fail exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-permanent-assignment exp) (let ((var (permantent-assignment-variable exp)) (vproc (analyze (permantent-assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (set-variable-value! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (analyze-if-fail exp) (let ((eproc (analyze (if-fail-body exp))) (fproc (analyze (if-fail-failure-callback exp)))) (lambda (env succeed fail) (eproc env succeed (lambda () (fproc env succeed fail)))))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (permantent-assignment? exp) (tagged-list? exp 'permanent-set!)) (define (permantent-assignment-variable exp) (cadr exp)) (define (permantent-assignment-value exp) (caddr exp)) (define (if-fail? exp) (tagged-list? exp 'if-fail)) (define (if-fail-body exp) (cadr exp)) (define (if-fail-failure-callback exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'even? even?) (list 'eq? eq?) (list 'list list) (list 'not not) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/53.scm ================================================ ; SICP exercise 4.53 ; ; With permanent-set! as described in exercise 4.51 and if-fail as in exercise ; 4.52, what will be the result of evaluating ; ; (let ((pairs '())) ; (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110)))) ; (permanent-set! pairs (cons p pairs)) ; (amb)) ; pairs)) (require r5rs/init) ; The result will be: ; ; ((8 35) (3 110) (3 20))) ; ; We're essentially using backtracking as part of backtracking, which is ; fancy. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((permantent-assignment? exp) (analyze-permanent-assignment exp)) ((if-fail? exp) (analyze-if-fail exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-permanent-assignment exp) (let ((var (permantent-assignment-variable exp)) (vproc (analyze (permantent-assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (set-variable-value! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (analyze-if-fail exp) (let ((eproc (analyze (if-fail-body exp))) (fproc (analyze (if-fail-failure-callback exp)))) (lambda (env succeed fail) (eproc env succeed (lambda () (fproc env succeed fail)))))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (permantent-assignment? exp) (tagged-list? exp 'permanent-set!)) (define (permantent-assignment-variable exp) (cadr exp)) (define (permantent-assignment-value exp) (caddr exp)) (define (if-fail? exp) (tagged-list? exp 'if-fail)) (define (if-fail-body exp) (cadr exp)) (define (if-fail-failure-callback exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'even? even?) (list 'eq? eq?) (list 'list list) (list 'not not) (list 'remainder remainder) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))) (define (prime? n) (= n (smallest-divisor n))) (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1))))) (define (square a) (* a a)) (define (divides? a b) (= (remainder b a) 0)))) (define (divides? a b) (= (remainder b a) 0)) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/54.scm ================================================ ; SICP exercise 4.54 ; ; If we had not realized that require could be implemented as an ordinary ; procedure that uses amb, to be defined by the user as part of a ; nondeterministic program, we would have had to implement it as a special ; form. This would require syntax procedures ; ; (define (require? exp) (tagged-list? exp 'require)) ; (define (require-predicate exp) (cadr exp)) ; ; and a new clause in the dispatch in analyze ; ; ((require? exp) (analyze-require exp)) ; ; as well the procedure analyze-require that handles require expressions. ; Complete the following definition of analyze-require. ; ; (define (analyze-require exp) ; (let ((pproc (analyze (require-predicate exp)))) ; (lambda (env succeed fail) ; (pproc env ; (lambda (value fail2) ; (if ; ; (succeed 'ok fail2))) ; fail)))) (require r5rs/init) ; The full definition is: ; ; (define (analyze-require exp) ; (let ((pproc (analyze (require-predicate exp)))) ; (lambda (env succeed fail) ; (pproc env ; (lambda (value fail2) ; (if (not (true? value)) ; (fail) ; (succeed 'ok fail2))) ; fail)))) ; ; The test case uses the code from the previous exercise. (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((require? exp) (analyze-require exp)) ((assignment? exp) (analyze-assignment exp)) ((permantent-assignment? exp) (analyze-permanent-assignment exp)) ((if-fail? exp) (analyze-if-fail exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((let? exp) (analyze (let->combination exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-permanent-assignment exp) (let ((var (permantent-assignment-variable exp)) (vproc (analyze (permantent-assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (set-variable-value! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (analyze-require exp) (let ((pproc (analyze (require-predicate exp)))) (lambda (env succeed fail) (pproc env (lambda (value fail2) (if (not (true? value)) (fail) (succeed 'ok fail2))) fail)))) (define (analyze-if-fail exp) (let ((eproc (analyze (if-fail-body exp))) (fproc (analyze (if-fail-failure-callback exp)))) (lambda (env succeed fail) (eproc env succeed (lambda () (fproc env succeed fail)))))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (require? exp) (tagged-list? exp 'require)) (define (require-predicate exp) (cadr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (permantent-assignment? exp) (tagged-list? exp 'permanent-set!)) (define (permantent-assignment-variable exp) (cadr exp)) (define (permantent-assignment-value exp) (caddr exp)) (define (if-fail? exp) (tagged-list? exp 'if-fail)) (define (if-fail-body exp) (cadr exp)) (define (if-fail-failure-callback exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'even? even?) (list 'eq? eq?) (list 'list list) (list 'not not) (list 'remainder remainder) (list '= =) (list '+ +) (list '- -) (list '* *) (list '> >) (list '/ /))) (define definitions '((define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))) (define (prime? n) (= n (smallest-divisor n))) (define (smallest-divisor n) (find-divisor n 2)) (define (find-divisor n test-divisor) (cond ((> (square test-divisor) n) n) ((divides? test-divisor n) test-divisor) (else (find-divisor n (+ test-divisor 1))))) (define (square a) (* a a)) (define (divides? a b) (= (remainder b a) 0)))) (define (divides? a b) (= (remainder b a) 0)) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/55.scm ================================================ ; SICP exercise 4.55 ; ; Give simple queries that retrieve the following information from the data ; base: ; ; a. all people supervised by Ben Bitdiddle ; b. the names and jobs of all people in the accounting division ; c. the names and addresses of all people who live in Slumerville (define query-a '(supervisor ?person (Bitdiddle Ben))) (define query-b '(job ?person (accounting . ?rest))) (define query-c '(address ?person (Slumerville . ?rest))) ================================================ FILE: scheme/sicp/04/56.scm ================================================ ; SICP exercise 4.56 ; ; Formulate compound queries that retrieve the following information: ; ; a. the names of all people who are supervised by Ben Bitdiddle, together ; with their addresses ; b. all people whose salary is less than Ben Bitdiddle's, together with their ; salary and Ben Bitdiddle's salary ; c. all people who are supervised by someone who is not in the computer ; division, together with the supervisor's name and job (define query-a '(and (address ?person ?address) (supervisor ?person (Bitdiddle Ben)))) (define query-b '(and (salary ?person ?person-salary) (salary (Bitdiddle Ben) ?bens-salary) (lisp-value < ?person-salary ?bens-salary))) (define query-c '(and (supervisor ?person ?supervisor) (not (job ?supervisor (computer . ?title))))) ================================================ FILE: scheme/sicp/04/57.scm ================================================ ; SICP exercise 4.57 ; ; Define a rule that says that person 1 can replace person 2 if either 1 does ; the same job as person 2 or someone who does person 1's job can also do ; person 2's job, and if person 1 and person 2 are not the same person. Using ; your rule, give queries that find the following: ; ; a. all people who can replace Cy D Fect; ; b. all people who can replace someone who is being paid more than they are, ; together with the two salaries (add-to-data-base! '((rule (can-replace ?person-1 ?person-2) (and (job ?person-1 ?job-1) (job ?person-2 ?job-2) (can-do-job ?job-1 ?job-2))) (rule (can-replace ?person-1 ?person-2) (and (can-do-job ?middle-man ?person-2) (can-replace ?person-1 ?middle-man))))) (define query-a '(can-replace ?person-1 (Fect Cy D))) (define query-b '(and (can-replace ?person-1 ?person-2) (salary ?person-1 ?salary-1) (salary ?person-2 ?salary-2) (lisp-value < ?salary-1 ?salary-2))) ================================================ FILE: scheme/sicp/04/58.scm ================================================ ; SICP exercise 4.58 ; ; Define a rule that says that a person is a "big shot" in a division if the ; person works in the division but does not have a supervisor who works in the ; division. (add-to-data-base! '((rule (big-shot ?person) (and (job ?person (?division . ?person-title)) (not (and (supervisor ?person ?supervisor) (job ?supervisor (?division . ?supervisor-title)))))))) ================================================ FILE: scheme/sicp/04/59.scm ================================================ ; SICP exercise 4.59 ; ; Ben Bitdiddle has missed on meeting too many. Fearing that his habit of ; forgetting meetings could cost him his job, Ben decides to do something ; about it. He adds the weekly meetings of the firm to the Microshaft data ; base by asserting the following: ; ; (meeting accounting (Monday 9am)) ; (meeting administration (Monday 10am)) ; (meeting computer (Wednesday 3pm)) ; (meeting administration (Friday 1pm)) ; ; Each of the above assertions is for a meeting of an entire division. Ben ; also adds an entry for company-wide meeting that spans all the divisions. ; All of the company's employees attend this meeting. ; ; (meeting whole-company (Wednesday 4pm)) ; ; a. On Friday morning, Ben wants to query the data base for all the meetings ; that occur that day. What query should he use? ; ; b. Alyssa P. Hacker is unimpressed. She thinks it would be much more useful ; to be able to ask for her meetings by specifying her name. So she designs ; a rule that says a person's mettings include all whole-company meetings ; plus all meetings of that person's division. Fill in the body of Alyssa's ; rule. ; ; (rule (meeting-time ?person ?day-and-time) ; ) ; ; c. Alyssa arrives at work on Wednesday morning and wonders what meetings she ; has to attend that day. Having defined the above rule, what query should she ; make to find this out? (add-to-data-base! '((meeting accounting (Monday 9am)) (meeting administration (Monday 10am)) (meeting computer (Wednesday 3pm)) (meeting administration (Friday 1pm)) (meeting whole-company (Wednesday 4pm)) (rule (meeting-time ?person ?day-and-time) (or (and (job ?person (?division . ?title)) (meeting ?division ?day-and-time)) (meeting whole-company ?day-and-time))))) (define bens-query '(meeting ?division (Friday ?time))) (define alyssas-query '(meeting-time (Hacker Alyssa P) (Wednesday ?time))) ================================================ FILE: scheme/sicp/04/60.scm ================================================ ; SICP exercise 4.60 ; ; By giving the query ; ; (lives-near ?person (Hacker Alyssa P)) ; ; Alyssa P. Hacker is able to find people who live near her, with whom she can ; ride to work. On the other hand, when she tries to find all pairs of people ; who live near each other by querying ; ; (lives-near ?person-1 ?person-2) ; ; she notices that each pair of people who live near each other is listed ; twice; for example, ; ; (lives-near (Hacker Alyssa P) (Fect Cy D)) ; (lives-near (Fect Cy D) (Hacker Alyssa P)) ; ; Why does this happen? Is there a way to find a list of people who live near ; each other, in which each pair appears only once? Explain. ; When the runtime executes lives-near, it matches the following pattern in ; the body of the rule ; ; (and (address ?person-1 (?town . ?rest-1)) ; (address ?person-2 (?town . ?rest-2)) ; (not (same ?person-1 ?person-2)))) ; ; If scans the assertions for (address ?person-1 (?town . ?rest-1)) and it ; first finds Alyssa. Then it matches the second pattern to eventually find it ; matches Cy and subsequently figure out that he is not the same as Alyssa. ; ; Afterwards, the runtime continues to scan the assertions and it matches the ; first pattern to Cy, subsequently matching the second to Alyssa. That why ; each pair appears twice. ; ; We can find a list in which each pair is listed once if we resort to some ; trickery. We can order the people in some way and assert that the pair has ; to be ordered. A good way to do that is order people alphabetically. Here is ; the new rule: (add-to-data-base! '((rule (ordered-neighbour-pair ?person-1 ?person-2) (and (lives-near ?person-1 ?person-2) (lisp-value (lambda (person-1 person-2) (stringstring person-1) " ") (string-join (map symbol->string person-2) " "))) ?person-1 ?person-2))))) ================================================ FILE: scheme/sicp/04/61.scm ================================================ ; SICP exercise 4.61 ; ; The following rules implement a next-to relation that finds adjancent ; elements of a list. ; ; (rule (?x next-to ?y in (?x ?y . ?u))) ; ; (rule (?x next-to ?y in (?v . ?z)) ; (?x next-to ?y in ?z)) ; ; What will the response be to the following queries? ; ; (?x next-to ?y in (1 (2 3) 4)) ; (?x next-to 1 in (2 1 3 1)) (add-to-data-base! '((rule (?x next-to ?y in (?x ?y . ?u))) (rule (?x next-to ?y in (?v . ?z)) (?x next-to ?y in ?z)))) (define query-1 '(?x next-to ?y in (1 (2 3) 4))) (define query-2 '(?x next-to 1 in (2 1 3 1))) (define response-1 '((1 next-to (2 3) in (1 (2 3) 4)) ((2 3) next-to 4 in (1 (2 3) 4)))) (define response-2 '((2 next-to 1 in (2 1 3 1)) (3 next-to 1 in (2 1 3 1)))) ================================================ FILE: scheme/sicp/04/62.scm ================================================ ; SICP exercise 4.62 ; ; Define rules to implement the last-pair operation of exercise 2.17, which ; returns a list containing the last element of a nonempty list. Check your ; rules on queries such as (last-pair (3) ?x), (last-pair (1 2 3) ?x), and ; (last-pair (2 ?x) (3)). Do your rules work correctly on queries such as ; (last-pair ?x (3)). ; The rule gets stuck in an infinite recursion. This is to be expected, since ; there are infinitely many pairs whose last pair is (3). That is to say, they ; don't work. (add-to-data-base! '((rule (last-pair (?x) (?x))) (rule (last-pair (?any . ?x) ?y) (last-pair ?x ?y)))) ================================================ FILE: scheme/sicp/04/63.scm ================================================ ; SICP exercise 4.63 ; ; The following data base (see Genesis 4) traces the genealogy of the ; descendants of Ada back to Adam, by way of Cain: ; ; (son Adam Cain) ; (son Cain Enoch) ; (son Enoch Irad) ; (son Irad Mehujael) ; (son Mehujael Methushael) ; (son Methushael Lamech) ; (wife Lamech Ada) ; (son Ada Jabal) ; (son Ada Jubal) ; ; Formulate rules such as "If S is the son of F, and F is the son of G, then S ; is the grandson of G" and "If W is the wife of M, and S is the son of W, ; then S is the son of M" (which was supposedly more true in biblical times ; than today) that will enable to query the system to find grandson of Cain; ; the sons of Lamech; the grandsons of Methushael. (See exercise 4.69 for some ; rules to deduce more complicated relationships.) (add-to-data-base! '((son Adam Cain) (son Cain Enoch) (son Enoch Irad) (son Irad Mehujael) (son Mehujael Methushael) (son Methushael Lamech) (wife Lamech Ada) (son Ada Jabal) (son Ada Jubal) (rule (grandson ?grandfather ?son) (and (son ?grandfather ?father) (son ?father ?son))) (rule (son ?father ?son) (and (wife ?father ?mother) (son ?mother ?son))))) (define grandson-of-cain '(grandson Cain ?grandson)) (define sons-of-lamech '(son Lamech ?son)) (define grandsons-of-methushael '(grandson Methushael ?grandson)) ================================================ FILE: scheme/sicp/04/64.scm ================================================ ; SICP exercise 4.64 ; ; Louis Reasoner mistakenly deletes the outranked-by rule (section 4.4.1) from ; the data base. When he realizes this, he quickly reinstalls it. ; Unfortunatelly, he makes a slight change in the rule, and types it in as ; ; (rule (outranked-by ?staff-person ?boss) ; (or (supervisor ?staff-person ?boss) ; (and (outranked-by ?middle-manager ?boss) ; (supervisor ?staff-person ?middle-manager)))) ; ; Just after Louis types this information into the system, DeWitt Aull comes ; by to find out who outranks Ben Bitdiddle. He issues the query ; ; (outranked-by (Bitdiddle Ben) ?who) ; ; After answering, the system goes into an infinite loop. Explain why. ; First the system will answer with ; ; (outranked-by (Bitdiddle Ben) (Warbucks Oliver)) ; ; because the first disjunct will match an existing assertion. Afterwards, the ; system will try to match (outranked-by ?middle-manager ?boss), which means ; applying the rule again. In this second application, we will first get all ; supervisor assertions (because they are the first clause of the disjunction), ; but when the second disjunct gets evaluated, it will invoke the rule again. ; This will get everything stuck in a loop. ================================================ FILE: scheme/sicp/04/65.scm ================================================ ; SICP exercise 4.65 ; ; Cy D. Fect, looking forward to the day when he will rise in the ; organization, gives a query to find all the wheels (using the wheel rule of ; section 4.4.1): ; ; (wheel ?who) ; ; To his surprise, the system responds ; ; ;;; Query results: ; (wheel (Warbucks Oliver)) ; (wheel (Bitdiddle Ben)) ; (wheel (Warbucks Oliver)) ; (wheel (Warbucks Oliver)) ; (wheel (Warbucks Oliver)) ; ; Why is Oliver listed four times? ; The rule looks like this: ; ; (rule (wheel ?person) ; (and (supervisor ?middle-manager ?person) ; (supervisor ?x ?middle-manager))) ; ; With this definition, it lists the wheel once for each employee supervised ; by a middle manager under them. Alyssa, Lem and Cy are under Ben, while ; Robert is under Eben. This is why Oliver is listed four times. The only ; supervisor under Ben is Alyssa and she is supervising one employee - Louis, ; which is why Ben is listed once. ; ; The order is not as straightfoward, since stream-flatmap interleaves the ; streams it maps to. ================================================ FILE: scheme/sicp/04/66.scm ================================================ ; SICP exercise 4.66 ; ; Ben has been generalizing the query system to provide statistics about the ; company. For example, to find the total salaries of all the computer ; programmers one will be able to say ; ; (sum ?amount ; (and (job ?x (computer programmer)) ; (salary ?x ?amount))) ; ; In general, Ben's new system allows expressions of the form ; ; (accumulation-function ; ) ; ; where accumulation-function can be things like sum, average, or maximum. Ben ; reasons that it should be a cinch to implement this. He will simnply feed ; the query pattern to qeval. This will produce a stream of frames. He will ; then pass this stream through a mapping function that extracts the value of ; the designated variable from each frame in the stream and feed the resulting ; stream of values to the accumulation function. Just as Ben completes the ; implementation and is about to try it out, Cy walks by, still puzzling over ; the wheel query result in exercise 4.65. When Cy shows Ben the system's ; response, Ben groans, "Oh, no, my simple accumulation scheme won't work!". ; ; What has Ben just realized? Outline a method he can use to salvage this ; situation. ; He has realizes that a result may be matched multiple times due to how a ; rule is written. For example, trying to sum the salaries of the wheels will ; result in Oliver Warbucks' salary being counted four times (see exercise ; 4.65). ; ; This can be salvaged by filtering the stream to remove the duplication. We ; can instantiate the query with each frame and check it against previous ; instances. If we encounted a query for a second time, we don't pass it to ; the aggregation function. ================================================ FILE: scheme/sicp/04/67.scm ================================================ ; SICP exercise 4.67 ; ; Devise a way to install a loop detector in the query system so as to avoid ; the kinds of simple loops illustrated in the text and in exercise 4.64. The ; general idea is that the system should maintain some sort of history of its ; current chain of deductions and should not begin processing a query that it ; is already working on. Describe what kind of information (patterns and ; frames) is included in this history, and how the check should be made. ; (After you study the details of the query-system implementation in section ; 4.4.4, you may want to modify the system to include your loop detector). ; We need to maintain a history of each rule we applied. We can instantiate ; the rule with the current frame and store it (the result is a query where ; all the variables are free variables in the current frame). Every time we ; apply a rule, we check to see if we are not already processing the rule. We ; can do that by unifying the current rule with each one in the history. If ; they can be unified and all of the variables of the rule in the history ; remain free, then we are already processing the rule and we have detected a ; loop. ; ; The code below implements this. There are a bunch of new functions defined ; and the existing ones are modified so qeval takes an additional history ; argument. apply-a-rule is also modified to return the empty stream if it ; detects a loop. (define loopy-rules '((married Minnie Mickey) (rule (married ?x ?y) (married ?y ?x)) (rule (loopy-outranked-by ?staff-person ?boss) (or (supervisor ?staff-person ?boss) (and (loopy-outranked-by ?middle-manager ?boss) (supervisor ?staff-person ?middle-manager)))))) ; Loop Detection (define (instantiate-pattern query frame) (define (rename-variable var) (if (number? (cadr var)) (cons '? (cons (- (cadr var)) (cddr var))) (cons '? (cons '- (cdr var))))) (instantiate-exp query frame (lambda (v f) (rename-variable v)))) (define (free-var? var frame) (let ((binding (binding-in-frame var frame))) (or (not binding) (and (var? (binding-value binding)) (free-var? (binding-value binding) frame))))) (define (all-free? vars frame) (andmap (lambda (var) (free-var? var frame)) vars)) (define (processing-query? query history) (ormap (lambda (history-entry) (same-query? history-entry query)) history)) (define (variables query) (cond ((var? query) (list query)) ((pair? query) (append (variables (car query)) (variables (cdr query)))) (else '()))) (define (same-query? history-entry query) (let ((vars (variables history-entry)) (unify-result (unify-match history-entry query '()))) (and (not (eq? unify-result 'failed)) (all-free? vars unify-result)))) ; The Driver Loop and Instantiation (define input-prompt ";;; Query input:") (define output-prompt ";;; Query output:") (define (query-driver-loop) (prompt-for-input input-prompt) (let ((q (query-syntax-process (read)))) (cond ((assertion-to-be-added? q) (add-rule-or-assertion! (add-assertion-body q)) (newline) (display "Assertion added to data base.") (query-driver-loop)) (else (newline) (display output-prompt) (display-stream (stream-map (lambda (frame) (instantiate-exp q frame (lambda (v f) (contract-question-mark v)))) (qeval q (singleton-stream '()) '()))) (query-driver-loop))))) (define (instantiate-exp exp frame unbound-var-handler) (define (copy exp) (cond ((var? exp) (let ((binding (binding-in-frame exp frame))) (if binding (copy (binding-value binding)) (unbound-var-handler exp frame)))) ((pair? exp) (cons (copy (car exp)) (copy (cdr exp)))) (else exp))) (copy exp)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (display-stream stream) (unless (stream-empty? stream) (newline) (display (stream-first stream)) (display-stream (stream-rest stream)))) ; The Evaluator (define (qeval query frame-stream history) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) frame-stream history) (simple-query query frame-stream history)))) (define (execute exp) (apply (eval (predicate exp)) (args exp))) (define (simple-query query-pattern frame-stream history) (stream-flatmap (lambda (frame) (stream-append (find-assertions query-pattern frame) (apply-rules query-pattern frame history))) frame-stream)) (define (con-join conjuncts frame-stream history) (if (empty-conjunction? conjuncts) frame-stream (con-join (rest-conjuncts conjuncts) (qeval (first-conjunct conjuncts) frame-stream history) history))) (define (dis-join disjuncts frame-stream history) (if (empty-disjunction? disjuncts) empty-stream (interleave (qeval (first-disjunct disjuncts) frame-stream history) (dis-join (rest-disjuncts disjuncts) frame-stream history)))) (define (negate operands frame-stream history) (stream-flatmap (lambda (frame) (if (stream-empty? (qeval (negated-query operands) (singleton-stream frame) history)) (singleton-stream frame) empty-stream)) frame-stream)) (define (lisp-value call frame-stream history) (stream-flatmap (lambda (frame) (if (execute (instantiate-exp call frame (lambda (v f) (error "Unknown pat var -- LISP-VALUE" v)))) (singleton-stream frame) empty-stream)) frame-stream)) (define (always-true ignore frame-stream history) frame-stream) ; Finding Assertions by Pattern Matching (define (find-assertions pattern frame) (stream-flatmap (lambda (datum) (check-an-assertion datum pattern frame)) (fetch-assertions pattern frame))) (define (check-an-assertion assertion query-pat query-frame) (let ((match-result (pattern-match query-pat assertion query-frame))) (if (eq? match-result 'failed) empty-stream (singleton-stream match-result)))) (define (pattern-match pat dat frame) (cond ((eq? frame 'failed) 'failed) ((equal? pat dat) frame) ((var? pat) (extend-if-consistent pat dat frame)) ((and (pair? pat) (pair? dat)) (pattern-match (cdr pat) (cdr dat) (pattern-match (car pat) (car dat) frame))) (else 'failed))) (define (extend-if-consistent var dat frame) (let ((binding (binding-in-frame var frame))) (if binding (pattern-match (binding-value binding) dat frame) (extend var dat frame)))) ; Rules and Unification (define (apply-rules pattern frame history) (stream-flatmap (lambda (rule) (apply-a-rule rule pattern frame history)) (fetch-rules pattern frame))) (define (apply-a-rule rule query-pattern query-frame history) (let ((clean-rule (rename-variables-in rule))) (let ((unify-result (unify-match query-pattern (conclusion clean-rule) query-frame))) (if (eq? unify-result 'failed) empty-stream (let ((current-query (instantiate-pattern (conclusion clean-rule) unify-result))) (if (processing-query? current-query history) empty-stream (qeval (rule-body clean-rule) (singleton-stream unify-result) (cons current-query history)))))))) (define (rename-variables-in rule) (let ((rule-application-id (new-rule-application-id))) (define (tree-walk exp) (cond ((var? exp) (make-new-variable exp rule-application-id)) ((pair? exp) (cons (tree-walk (car exp)) (tree-walk (cdr exp)))) (else exp))) (tree-walk rule))) (define (unify-match p1 p2 frame) (cond ((eq? frame 'failed) 'failed) ((equal? p1 p2) frame) ((var? p1) (extend-if-possible p1 p2 frame)) ((var? p2) (extend-if-possible p2 p1 frame)) ((and (pair? p1) (pair? p2)) (unify-match (cdr p1) (cdr p2) (unify-match (car p1) (car p2) frame))) (else 'failed))) (define (extend-if-possible var val frame) (let ((binding (binding-in-frame var frame))) (cond (binding (unify-match (binding-value binding) val frame)) ((var? val) (let ((binding (binding-in-frame val frame))) (if binding (unify-match var (binding-value binding) frame) (extend var val frame)))) ((depends-on? val var frame) 'failed) (else (extend var val frame))))) (define (depends-on? exp var frame) (define (tree-walk e) (cond ((var? e) (if (equal? var e) true (let ((b (binding-in-frame e frame))) (if b (tree-walk (binding-value b)) false)))) ((pair? e) (or (tree-walk (car e)) (tree-walk (cdr e)))) (else false))) (tree-walk exp)) ; Maintaining the Data Base (define THE-ASSERTIONS '()) (define (fetch-assertions pattern frame) (if (use-index? pattern) (get-indexed-assertions pattern) (get-all-assertions))) (define (get-all-assertions) (reverse-list->stream THE-ASSERTIONS)) (define (get-indexed-assertions pattern) (reverse-list->stream (get-list (index-key-of pattern) 'assertion-list))) (define THE-RULES '()) (define (fetch-rules pattern frame) (if (use-index? pattern) (get-indexed-rules pattern) (get-all-rules))) (define (get-all-rules) (reverse-list->stream THE-RULES)) (define (get-indexed-rules pattern) (reverse-list->stream (append (get-list '? 'rule-list) (get-list (index-key-of pattern) 'rule-list)))) (define (add-rule-or-assertion! assertion) (if (rule? assertion) (add-rule! assertion) (add-assertion! assertion))) (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons assertion old-assertions)) 'ok)) (define (add-rule! rule) (store-rule-in-index rule) (let ((old-rules THE-RULES)) (set! THE-RULES (cons rule old-rules)) 'ok)) (define (store-assertion-in-index assertion) (when (indexable? assertion) (let ((key (index-key-of assertion))) (let ((current-assertion-list (get-list key 'assertion-list))) (put key 'assertion-list (cons assertion current-assertion-list)))))) (define (store-rule-in-index rule) (let ((pattern (conclusion rule))) (when (indexable? pattern) (let ((key (index-key-of pattern))) (let ((current-rule-list (get-list key 'rule-list))) (put key 'rule-list (cons rule current-rule-list))))))) (define (indexable? pattern) (or (constant-symbol? (car pattern)) (var? (car pattern)))) (define (index-key-of pattern) (let ((key (car pattern))) (if (var? key) '? key))) (define (use-index? pattern) (constant-symbol? (car pattern))) (define (list->stream items) (if (null? items) empty-stream (stream-cons (car items) (list->stream (cdr items))))) (define (reverse-list->stream items) (list->stream (reverse items))) (define (get-list key1 key2) (let ((s (get key1 key2))) (if s s '()))) ; Operator table (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Stream Operations (define (interleave s1 s2) (if (stream-empty? s1) s2 (stream-cons (stream-first s1) (interleave s2 (stream-rest s1))))) (define (stream-flatmap proc s) (flatten-stream (stream-map proc s))) (define (flatten-stream stream) (if (stream-empty? stream) empty-stream (interleave (stream-first stream) (flatten-stream (stream-rest stream))))) (define (singleton-stream x) (stream-cons x empty-stream)) ; Query Syntax Procedures (define (type exp) (if (pair? exp) (car exp) (error "Unknown expression TYPE" exp))) (define (contents exp) (if (pair? exp) (cdr exp) (error "Unknown expression CONTENTS" exp))) (define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp))) (define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps)) (define (rule? statement) (tagged-list? statement 'rule)) (define (conclusion rule) (cadr rule)) (define (rule-body rule) (if (null? (cddr rule)) '(always-true) (caddr rule))) (define (query-syntax-process exp) (map-over-symbols expand-question-mark exp)) (define (map-over-symbols proc exp) (cond ((pair? exp) (cons (map-over-symbols proc (car exp)) (map-over-symbols proc (cdr exp)))) ((symbol? exp) (proc exp)) (else exp))) (define (expand-question-mark symbol) (let ((chars (symbol->string symbol))) (if (string=? (substring chars 0 1) "?") (list '? (string->symbol (substring chars 1 (string-length chars)))) symbol))) (define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp)) (define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var)))) (define (contract-question-mark variable) (string->symbol (string-append "?" (if (number? (cadr variable)) (string-append (symbol->string (caddr variable)) "-" (number->string (cadr variable))) (symbol->string (cadr variable)))))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ; Frames and Bindings (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-frame variable frame) (assoc variable frame)) (define (extend variable value frame) (cons (make-binding variable value) frame)) ; Reseting the state (define (reset-state!) (set! table (make-hash)) (set! rule-counter 0) (set! THE-ASSERTIONS '()) (set! THE-RULES '()) (put 'and 'qeval con-join) (put 'or 'qeval dis-join) (put 'not 'qeval negate) (put 'lisp-value 'qeval lisp-value) (put 'always-true 'qeval always-true)) (reset-state!) ================================================ FILE: scheme/sicp/04/68.scm ================================================ ; SICP exercise 4.68 ; ; Define rules to implement the reverse operation of exercise 2.18, which ; returns a list containing the same elements as a given list in reverse ; order. (Hint: Use append-to-form.) Can your rules answer both ; (reverse (1 2 3) ?x) and (reverse ?x (1 2 3))? ; They can't. (reverse ?x (1 2 3)) gets the system stuck in an infinite loop. (add-to-data-base! '((rule (reverse (?x) (?x))) (rule (reverse (?a . ?b) ?c) (and (reverse ?b ?r-b) (append-to-form ?r-b (?a) ?c))))) ================================================ FILE: scheme/sicp/04/69.scm ================================================ ; SICP exercise 4.69 ; ; Beginning with the data base and the rules you formulated in exercise 4.63, ; devise a rule for adding "greats" to a grandson relationship. This should ; enable the system to deduce that Irad is the great-grandson of Adam, or that ; Jabal and Jubal are the great-great-great-great-great-grandsons of Adam. ; (Hint: Represent the fact about Irad, for example, as ((great grandson) Adam ; Irad). Write rules that determine if a list ends in the word grandson. Use ; this to express a rule that allows one to derive the relationship ; ((great . ?rel) ?x ?y), where ?rel is a list ending in grandson). Check your ; rules on queries such as ((great grandson) ?g ?ggs) and ; (?relationship Adam Irad). ; We base this on the loop detection in 4.67, since otherwise ; (?relationship Adam Irad) will fall into such a loop. (define grands-rules '((son Adam Cain) (son Cain Enoch) (son Enoch Irad) (son Irad Mehujael) (son Mehujael Methushael) (son Methushael Lamech) (wife Lamech Ada) (son Ada Jabal) (son Ada Jubal) (rule (son ?father ?son) (and (wife ?father ?mother) (son ?mother ?son))) (rule (grandson ?grandfather ?son) (and (son ?grandfather ?father) (son ?father ?son))) (rule (ends-with-grandson (grandson))) (rule (ends-with-grandson (?x . ?rest)) (ends-with-grandson ?rest)) (rule ((grandson) ?grandfather ?grandson) (grandson ?grandfather ?grandson)) (rule ((great . ?rel) ?ancestor ?descendant) (and (ends-with-grandson ?rel) (son ?ancestor ?son-of-ancestor) (?rel ?son-of-ancestor ?descendant))))) ; Loop Detection (define (instantiate-pattern query frame) (define (rename-variable var) (if (number? (cadr var)) (cons '? (cons (- (cadr var)) (cddr var))) (cons '? (cons '- (cdr var))))) (instantiate-exp query frame (lambda (v f) (rename-variable v)))) (define (free-var? var frame) (let ((binding (binding-in-frame var frame))) (or (not binding) (and (var? (binding-value binding)) (free-var? (binding-value binding) frame))))) (define (all-free? vars frame) (andmap (lambda (var) (free-var? var frame)) vars)) (define (processing-query? query history) (ormap (lambda (history-entry) (same-query? history-entry query)) history)) (define (variables query) (cond ((var? query) (list query)) ((pair? query) (append (variables (car query)) (variables (cdr query)))) (else '()))) (define (same-query? history-entry query) (let ((vars (variables history-entry)) (unify-result (unify-match history-entry query '()))) (and (not (eq? unify-result 'failed)) (all-free? vars unify-result)))) ; The Driver Loop and Instantiation (define input-prompt ";;; Query input:") (define output-prompt ";;; Query output:") (define (query-driver-loop) (prompt-for-input input-prompt) (let ((q (query-syntax-process (read)))) (cond ((assertion-to-be-added? q) (add-rule-or-assertion! (add-assertion-body q)) (newline) (display "Assertion added to data base.") (query-driver-loop)) (else (newline) (display output-prompt) (display-stream (stream-map (lambda (frame) (instantiate-exp q frame (lambda (v f) (contract-question-mark v)))) (qeval q (singleton-stream '()) '()))) (query-driver-loop))))) (define (instantiate-exp exp frame unbound-var-handler) (define (copy exp) (cond ((var? exp) (let ((binding (binding-in-frame exp frame))) (if binding (copy (binding-value binding)) (unbound-var-handler exp frame)))) ((pair? exp) (cons (copy (car exp)) (copy (cdr exp)))) (else exp))) (copy exp)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (display-stream stream) (unless (stream-empty? stream) (newline) (display (stream-first stream)) (display-stream (stream-rest stream)))) ; The Evaluator (define (qeval query frame-stream history) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) frame-stream history) (simple-query query frame-stream history)))) (define (execute exp) (apply (eval (predicate exp)) (args exp))) (define (simple-query query-pattern frame-stream history) (stream-flatmap (lambda (frame) (stream-append (find-assertions query-pattern frame) (apply-rules query-pattern frame history))) frame-stream)) (define conjoin '()) (define (conjoin conjuncts frame-stream history) (if (empty-conjunction? conjuncts) frame-stream (conjoin (rest-conjuncts conjuncts) (qeval (first-conjunct conjuncts) frame-stream history) history))) (define disjoin '()) (define (disjoin disjuncts frame-stream history) (if (empty-disjunction? disjuncts) empty-stream (interleave (qeval (first-disjunct disjuncts) frame-stream history) (disjoin (rest-disjuncts disjuncts) frame-stream history)))) (define (negate operands frame-stream history) (stream-flatmap (lambda (frame) (if (stream-empty? (qeval (negated-query operands) (singleton-stream frame) history)) (singleton-stream frame) empty-stream)) frame-stream)) (define (lisp-value call frame-stream history) (stream-flatmap (lambda (frame) (if (execute (instantiate-exp call frame (lambda (v f) (error "Unknown pat var -- LISP-VALUE" v)))) (singleton-stream frame) empty-stream)) frame-stream)) (define (always-true ignore frame-stream history) frame-stream) ; Finding Assertions by Pattern Matching (define (find-assertions pattern frame) (stream-flatmap (lambda (datum) (check-an-assertion datum pattern frame)) (fetch-assertions pattern frame))) (define (check-an-assertion assertion query-pat query-frame) (let ((match-result (pattern-match query-pat assertion query-frame))) (if (eq? match-result 'failed) empty-stream (singleton-stream match-result)))) (define (pattern-match pat dat frame) (cond ((eq? frame 'failed) 'failed) ((equal? pat dat) frame) ((var? pat) (extend-if-consistent pat dat frame)) ((and (pair? pat) (pair? dat)) (pattern-match (cdr pat) (cdr dat) (pattern-match (car pat) (car dat) frame))) (else 'failed))) (define (extend-if-consistent var dat frame) (let ((binding (binding-in-frame var frame))) (if binding (pattern-match (binding-value binding) dat frame) (extend var dat frame)))) ; Rules and Unification (define (apply-rules pattern frame history) (stream-flatmap (lambda (rule) (apply-a-rule rule pattern frame history)) (fetch-rules pattern frame))) (define (apply-a-rule rule query-pattern query-frame history) (let ((clean-rule (rename-variables-in rule))) (let ((unify-result (unify-match query-pattern (conclusion clean-rule) query-frame))) (if (eq? unify-result 'failed) empty-stream (let ((current-query (instantiate-pattern (conclusion clean-rule) unify-result))) (if (processing-query? current-query history) empty-stream (qeval (rule-body clean-rule) (singleton-stream unify-result) (cons current-query history)))))))) (define (rename-variables-in rule) (let ((rule-application-id (new-rule-application-id))) (define (tree-walk exp) (cond ((var? exp) (make-new-variable exp rule-application-id)) ((pair? exp) (cons (tree-walk (car exp)) (tree-walk (cdr exp)))) (else exp))) (tree-walk rule))) (define (unify-match p1 p2 frame) (cond ((eq? frame 'failed) 'failed) ((equal? p1 p2) frame) ((var? p1) (extend-if-possible p1 p2 frame)) ((var? p2) (extend-if-possible p2 p1 frame)) ((and (pair? p1) (pair? p2)) (unify-match (cdr p1) (cdr p2) (unify-match (car p1) (car p2) frame))) (else 'failed))) (define (extend-if-possible var val frame) (let ((binding (binding-in-frame var frame))) (cond (binding (unify-match (binding-value binding) val frame)) ((var? val) (let ((binding (binding-in-frame val frame))) (if binding (unify-match var (binding-value binding) frame) (extend var val frame)))) ((depends-on? val var frame) 'failed) (else (extend var val frame))))) (define (depends-on? exp var frame) (define (tree-walk e) (cond ((var? e) (if (equal? var e) true (let ((b (binding-in-frame e frame))) (if b (tree-walk (binding-value b)) false)))) ((pair? e) (or (tree-walk (car e)) (tree-walk (cdr e)))) (else false))) (tree-walk exp)) ; Maintaining the Data Base (define THE-ASSERTIONS '()) (define (fetch-assertions pattern frame) (if (use-index? pattern) (get-indexed-assertions pattern) (get-all-assertions))) (define (get-all-assertions) (reverse-list->stream THE-ASSERTIONS)) (define (get-indexed-assertions pattern) (reverse-list->stream (get-list (index-key-of pattern) 'assertion-list))) (define THE-RULES '()) (define (fetch-rules pattern frame) (if (use-index? pattern) (get-indexed-rules pattern) (get-all-rules))) (define (get-all-rules) (reverse-list->stream THE-RULES)) (define (get-indexed-rules pattern) (reverse-list->stream (append (get-list '? 'rule-list) (get-list (index-key-of pattern) 'rule-list)))) (define (add-rule-or-assertion! assertion) (if (rule? assertion) (add-rule! assertion) (add-assertion! assertion))) (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons assertion old-assertions)) 'ok)) (define (add-rule! rule) (store-rule-in-index rule) (let ((old-rules THE-RULES)) (set! THE-RULES (cons rule old-rules)) 'ok)) (define (store-assertion-in-index assertion) (when (indexable? assertion) (let ((key (index-key-of assertion))) (let ((current-assertion-list (get-list key 'assertion-list))) (put key 'assertion-list (cons assertion current-assertion-list)))))) (define (store-rule-in-index rule) (let ((pattern (conclusion rule))) (when (indexable? pattern) (let ((key (index-key-of pattern))) (let ((current-rule-list (get-list key 'rule-list))) (put key 'rule-list (cons rule current-rule-list))))))) (define (indexable? pattern) (or (constant-symbol? (car pattern)) (var? (car pattern)))) (define (index-key-of pattern) (let ((key (car pattern))) (if (var? key) '? key))) (define (use-index? pattern) (constant-symbol? (car pattern))) (define (list->stream items) (if (null? items) empty-stream (stream-cons (car items) (list->stream (cdr items))))) (define (reverse-list->stream items) (list->stream (reverse items))) (define (get-list key1 key2) (let ((s (get key1 key2))) (if s s '()))) ; Operator table (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Stream Operations (define (interleave s1 s2) (if (stream-empty? s1) s2 (stream-cons (stream-first s1) (interleave s2 (stream-rest s1))))) (define (stream-flatmap proc s) (flatten-stream (stream-map proc s))) (define (flatten-stream stream) (if (stream-empty? stream) empty-stream (interleave (stream-first stream) (flatten-stream (stream-rest stream))))) (define (singleton-stream x) (stream-cons x empty-stream)) ; Query Syntax Procedures (define (type exp) (if (pair? exp) (car exp) (error "Unknown expression TYPE" exp))) (define (contents exp) (if (pair? exp) (cdr exp) (error "Unknown expression CONTENTS" exp))) (define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp))) (define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps)) (define (rule? statement) (tagged-list? statement 'rule)) (define (conclusion rule) (cadr rule)) (define (rule-body rule) (if (null? (cddr rule)) '(always-true) (caddr rule))) (define (query-syntax-process exp) (map-over-symbols expand-question-mark exp)) (define (map-over-symbols proc exp) (cond ((pair? exp) (cons (map-over-symbols proc (car exp)) (map-over-symbols proc (cdr exp)))) ((symbol? exp) (proc exp)) (else exp))) (define (expand-question-mark symbol) (let ((chars (symbol->string symbol))) (if (string=? (substring chars 0 1) "?") (list '? (string->symbol (substring chars 1 (string-length chars)))) symbol))) (define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp)) (define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var)))) (define (contract-question-mark variable) (string->symbol (string-append "?" (if (number? (cadr variable)) (string-append (symbol->string (caddr variable)) "-" (number->string (cadr variable))) (symbol->string (cadr variable)))))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ; Frames and Bindings (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-frame variable frame) (assoc variable frame)) (define (extend variable value frame) (cons (make-binding variable value) frame)) ; Reseting the state (define (reset-state!) (set! table (make-hash)) (set! rule-counter 0) (set! THE-ASSERTIONS '()) (set! THE-RULES '()) (put 'and 'qeval conjoin) (put 'or 'qeval disjoin) (put 'not 'qeval negate) (put 'lisp-value 'qeval lisp-value) (put 'always-true 'qeval always-true)) (reset-state!) (load-relative "showcase/query/database.scm") (add-to-data-base! grands-rules) ================================================ FILE: scheme/sicp/04/70.scm ================================================ ; SICP exercise 4.70 ; ; What is the purpose of the let bindings in the procedures add-assertion! and ; add-rule! ? What would be wrong with the following implementation of ; add-assertion! ? Hint: Recall the definition of the infinite stream of ones ; in section 3.5.2: (define ones (cons-stream 1 ones)). ; ; (define (add-assertion! assertion) ; (store-assertion-in-index assertion) ; (set! THE-ASSERTIONS ; (cons-stream assertion THE-ASSERTIONS)) ; 'ok) ; If we define add-assertion! that way, THE-ASSERTIONS will effectively be a ; stream containing infinitely many times the passed assertion. The reason is ; that THE-ASSERTIONS is evaluated in a lazy way. ================================================ FILE: scheme/sicp/04/71.scm ================================================ ; SICP exercise 4.71 ; ; Louis Reasoner wonders why the simple-query and disjoin procedures (section ; 4.4.4.2) are implemented using explicit delay operations, rather than being ; defined as follows: ; ; (define (simple-query query-pattern frame-stream) ; (stream-flatmap ; (lambda (frame) ; (stream-append (find-assertions query-pattern frame) ; (apply-rules query-pattern frame))) ; frame-stream)) ; (define (disjoin disjuncts frame-stream) ; (if (empty-disjunction? disjuncts) ; the-empty-stream ; (interleave ; (qeval (first-disjunct disjuncts) frame-stream) ; (disjoin (rest-disjuncts disjuncts) frame-stream)))) ; ; Can you give examples of queries where these simpler definitions would lead ; to undesirable behavior? ; Assuming the implementation of streams suggested in the book, the second ; argument to both function will get evaluated before calling the function, ; which might lead to infinite recursions. To be fair, this has only a single ; disadvantage - using the delayed versions we can get some results printed, ; before the interpreter gets stuck in an infinite loop. With this adjustment, ; we won't get any results before getting stuck. ; ; An example is the following rule: ; ; (something a) ; (rule (something ?a) ; (something ?a)) ; ; And the query is: ; ; (something ?what) ================================================ FILE: scheme/sicp/04/72.scm ================================================ ; SICP exercise 4.72 ; ; Why do disjoin and stream-flatmap interleave the streams rather than simply ; append them? Give examples that illustrate why interleaving works better. ; (Hint: Why did we use interleave in section 3.5.3?) ; It is pretty much the same as in last exercise. If the first stream is ; infinite, this gives a chance for elements of the second stream to be ; returned. If we don't interleave, the first stream will possibly not let the ; interpreter report terminating results from the second stream. ; ; However, this still does not make a big difference in my opinion. The ; interpreter gets a chance to to report some results before getting stuck, ; but in the long run, I don't think that makes a meaningful difference. ================================================ FILE: scheme/sicp/04/73.scm ================================================ ; SICP exercise 4.73 ; ; Why does flatten-stream use delay explicitly? What would be wrong with ; defining it as follows: ; ; (define (flatten-stream stream) ; (if (stream-null? stream) ; the-empty-stream ; (interleave ; (stream-car stream) ; (flatten-stream (stream-cdr stream))))) ; Well, to be fair, this is just how I implemented it. If it is defined that ; way, flatten-stream would not terminate if the stream is infinite. ================================================ FILE: scheme/sicp/04/74.scm ================================================ ; SICP exercise 4.74 ; ; Alyssa P. Hacker proposes to use a simpler version of stream-flatmap in ; negate, lisp-value, and find-assertions. She observes that the procedure ; that is mapped over the frame stream in these cases always produces either ; the empty stream or a singleton stream, so no interleaving is needed when ; combining those streams. ; ; a. Fill in the missing expressions in Alyssa's program. ; ; (define (simple-stream-flatmap proc s) ; (simple-flatten (stream-map proc s))) ; ; (define (simple-flatten stream) ; (stream-map ; (stream-filter stream))) ; ; b. Does the query system's behavior change if we change it in this way? ; a. This is the solution: ; ; (define (simple-stream-flatmap proc s) ; (simple-flatten (stream-map proc s))) ; ; (define (simple-flatten stream) ; (stream-map stream-car ; (stream-filter (lambda (s) (not (stream-null? s))) stream))) ; ; b. I don't see how the system behavior might change. ================================================ FILE: scheme/sicp/04/75.scm ================================================ ; SICP exercise 4.75 ; ; Implement for the query language a new special form called unique. Unique ; should succeed if there is precisely one item in the data base satisfying a ; specified query. For example, ; ; (unique (job ?x (computer wizard))) ; ; should print the one-item stream ; ; (unique (job (Bitdiddle Ben) (computer wizard))) ; ; since Ben is the only computer wizard, and ; ; (unique (job ?x (computer programmer))) ; ; should print the empty stream, since there is more than one computer ; programmer. Moreover, ; ; (and (job ?x ?j) (unique (job ?anyone ?j))) ; ; should list all the jobs that are filled by only one person, and the people ; who fill them. ; ; There are two parts to implementing unique. The first is to write a ; procedure that handles this special form, and the second is to make qeval ; dispatch to that procedure. The second part is trivial, since qeval does its ; dispatching in a data-directed way. If your procedure is called ; uniquely-asserted, all you need to do is: ; ; (put 'unique 'qeval uniquely-asserted) ; ; and qeval will dispatch to this procedure for every query whose type (car) ; is the symbol unique. ; ; The real problem is to write the procedure uniquely-asserted. This should ; take as input the contents (cdr) of the unique query, together with a stream ; of frames. For each frame in the stream, it should use qeval to find the ; stream of all extensions to the frame that satisfy the given query. Any ; stream that does not have exactly one item in it should be eliminated. The ; remaining strems should be passed back to be accumulated into one big stream ; that is the result of the unique query. This is similar to the ; implementation of the not special form. ; ; Test your implementation by forming a query that lists all people who ; supervise precisely one person. (define (uniquely-asserted query frame-stream) (stream-flatmap (lambda (frame) (let ((result (qeval (car query) (singleton-stream frame)))) (cond ((stream-empty? result) empty-stream) ((not (stream-empty? (stream-rest result))) empty-stream) (else (singleton-stream (stream-first result)))))) frame-stream)) (put 'unique 'qeval uniquely-asserted) (define supervises-one-person '(and (supervisor ?j ?x) (unique (supervisor ?anyone ?x)))) ================================================ FILE: scheme/sicp/04/76.scm ================================================ ; SICP exercise 4.76 ; ; Our implementation of and as a series combination of queries (figure 4.5) is ; elegant, but it is inefficient because in processing the second query of the ; and we must scan the data base for each frame produced by the first query. ; If the data base has N elements, and a typical query produces a number of ; output frames proportional to N (say N/k), then scanning the data base for ; each frame produced by the first query will require N²/k calls to the ; pattern matcher. Another approach would be to process the two clauses of the ; and separately, then look for all pairs of output frames that are ; compatible. If each query produces N/k output frames, then this means that ; we must perform N²/k² compatibility checks -- a factor of k fewer than the ; number of matches required in our current method. ; ; Devise an implementation of and that uses this strategy. You must implement ; a procedure that takes two frames as inputs, checks whether the bindings in ; the frames are compatible, and, if so, produces a frame that merges the two ; sets of bindings. This operation is similar to unification. ; The implementation is below. It has its disadvantages, though. First, the ; following query stops working: ; ; (and (supervisor ?x (Bitdiddle Ben)) ; (not (job ?x (computer programmer)))) ; ; The reason is that (not (job ?x (computer programmer))) results to the empty ; stream of frames. ; ; There is another issue, which is illustrated in the outranked-by rule: ; ; (rule (outranked-by ?staff-person ?boss) ; (or (supervisor ?staff-person ?boss) ; (and (supervisor ?staff-person ?middle-manager) ; (outranked-by ?middle-manager ?boss)))) ; ; In this case, outranked-by results to an infinte loop, since ; ; (outranked-by ?staff-person ?boss) ; ; calls directly ; ; (outranked-by ?middle-manager ?boss) ; ; and all frames (not just the reduced set of frames from the previous ; conjunct. (define (merge-frames frame1 frame2) (cond ((null? frame1) frame2) ((eq? 'failed frame2) 'failed) (else (let ((var (binding-variable (car frame1))) (val (binding-value (car frame1)))) (let ((extension (extend-if-possible var val frame2))) (merge-frames (cdr frame1) extension)))))) (define (conjoin-frame-streams stream1 stream2) (stream-flatmap (lambda (frame1) (stream-filter (lambda (frame) (not (eq? frame 'failed))) (stream-map (lambda (frame2) (merge-frames frame1 frame2)) stream2))) stream1)) (define (faster-conjoin conjuncts frame-stream) (if (empty-conjunction? conjuncts) frame-stream (conjoin-frame-streams (qeval (first-conjunct conjuncts) frame-stream) (conjoin (rest-conjuncts conjuncts) frame-stream)))) (put 'and 'qeval faster-conjoin) ================================================ FILE: scheme/sicp/04/77.scm ================================================ ; SICP exercise 4.77 ; ; In section 4.4.3 we saw that not and lisp-value can cause the query langauge ; to give "wrong" answers if these filtering operations are applied to frames ; in which variables are unbound. Devise a way to fix this shortcoming. One ; idea is to perform the filtering in a "delayed" manner by appending to the ; frame a "promise" to filter that is fulfilled only when enough variables ; have been bound to make the operation possible. We could wait to perform ; filtering until all other operations have been performed. However, for ; efficiency's sake, we would like to perform filtering as soon as possible so ; as to cut down on the number of intermediate frames generated. ; Sure. This is fun. ; ; We extend the frame to store an list of promises. Each promise is list of ; free variables and a predicate. Once all the free variables have been bound, ; the predicate is evaluted on the frame. ; ; This process is handled by the procedure compact-frame. It evaluates to ; topmost promise if all the necessary free variables have been bound. If the ; predicate fails, it returns 'failed. If it passes, it constructs a frame ; without the topmost promise and applies itself recursively. The process ; stops until (1) a promise with free variables is encountered, (2) all ; promises have been fulfiled or (3) a promise fails and compact-frame returns ; 'failed. ; ; compact-frame is invoked in extend after the new frame has been constructed. ; Since all the calls to extend take into account the possiblity of returing ; the symbol 'failed, there is system works like a charm. ; Frames, Bindings and Promises (define (make-frame bindings promises) (list bindings promises)) (define (frame-bindings frame) (car frame)) (define (frame-promises frame) (cadr frame)) (define empty-frame (make-frame '() '())) (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-frame variable frame) (assoc variable (frame-bindings frame))) (define (extend variable value frame) (compact-frame (make-frame (cons (make-binding variable value) (frame-bindings frame)) (frame-promises frame)))) (define (make-promise variables predicate) (cons variables predicate)) (define (promise-variables promise) (car promise)) (define (promise-predicate promise) (cdr promise)) (define (free-var? var frame) (let ((binding (binding-in-frame var frame))) (or (not binding) (and (var? (binding-value binding)) (free-var? (binding-value binding) frame))))) (define (free-variables-in query frame) (cond ((null? query) '()) ((and (var? query) (free-var? query frame)) (list query)) ((pair? query) (append (free-variables-in (car query) frame) (free-variables-in (cdr query) frame))) (else '()))) (define (compact-frame frame) (let ((promises (frame-promises frame))) (if (null? promises) frame (let* ((promise (car promises)) (rest-promises (cdr promises)) (vars (promise-variables promise)) (predicate (promise-predicate promise)) (has-free-vars? (ormap (lambda (var) (free-var? var frame)) vars))) (cond (has-free-vars? frame) ((predicate frame) (compact-frame (make-frame (frame-bindings frame) rest-promises))) (else 'failed)))))) (define (promise-to-frame frame free-vars predicate) (make-frame (frame-bindings frame) (cons (make-promise free-vars predicate) (frame-promises frame)))) ; negate and lisp-value, modified to suit the new implementation (define (negate operands frame-stream) (stream-map (lambda (frame) (promise-to-frame frame (free-variables-in (negated-query operands) frame) (lambda (frame) (stream-empty? (qeval (negated-query operands) (singleton-stream frame)))))) frame-stream)) (define (lisp-value call frame-stream) (stream-map (lambda (frame) (promise-to-frame frame (free-variables-in call frame) (lambda (frame) (execute (instantiate-exp call frame (lambda (v f) (error "Unknown var -- LISP-VALUE" v))))))) frame-stream)) ; The Driver Loop and Instantiation (define input-prompt ";;; Query input:") (define output-prompt ";;; Query output:") (define (query-driver-loop) (prompt-for-input input-prompt) (let ((q (query-syntax-process (read)))) (cond ((assertion-to-be-added? q) (add-rule-or-assertion! (add-assertion-body q)) (newline) (display "Assertion added to data base.") (query-driver-loop)) (else (newline) (display output-prompt) (display-stream (stream-map (lambda (frame) (instantiate-exp q frame (lambda (v f) (contract-question-mark v)))) (qeval q (singleton-stream '())))) (query-driver-loop))))) (define (instantiate-exp exp frame unbound-var-handler) (define (copy exp) (cond ((var? exp) (let ((binding (binding-in-frame exp frame))) (if binding (copy (binding-value binding)) (unbound-var-handler exp frame)))) ((pair? exp) (cons (copy (car exp)) (copy (cdr exp)))) (else exp))) (copy exp)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (display-stream stream) (unless (stream-empty? stream) (newline) (display (stream-first stream)) (display-stream (stream-rest stream)))) ; The Evaluator (define (qeval query frame-stream) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) frame-stream) (simple-query query frame-stream)))) (define (execute exp) (apply (eval (predicate exp)) (args exp))) (define (simple-query query-pattern frame-stream) (stream-flatmap (lambda (frame) (stream-append (find-assertions query-pattern frame) (apply-rules query-pattern frame))) frame-stream)) (define conjoin '()) (define (conjoin conjuncts frame-stream) (if (empty-conjunction? conjuncts) frame-stream (conjoin (rest-conjuncts conjuncts) (qeval (first-conjunct conjuncts) frame-stream)))) (define disjoin '()) (define (disjoin disjuncts frame-stream) (if (empty-disjunction? disjuncts) empty-stream (interleave (qeval (first-disjunct disjuncts) frame-stream) (disjoin (rest-disjuncts disjuncts) frame-stream)))) (define (always-true ignore frame-stream) frame-stream) ; Finding Assertions by Pattern Matching (define (find-assertions pattern frame) (stream-flatmap (lambda (datum) (check-an-assertion datum pattern frame)) (fetch-assertions pattern frame))) (define (check-an-assertion assertion query-pat query-frame) (let ((match-result (pattern-match query-pat assertion query-frame))) (if (eq? match-result 'failed) empty-stream (singleton-stream match-result)))) (define (pattern-match pat dat frame) (cond ((eq? frame 'failed) 'failed) ((equal? pat dat) frame) ((var? pat) (extend-if-consistent pat dat frame)) ((and (pair? pat) (pair? dat)) (pattern-match (cdr pat) (cdr dat) (pattern-match (car pat) (car dat) frame))) (else 'failed))) (define (extend-if-consistent var dat frame) (let ((binding (binding-in-frame var frame))) (if binding (pattern-match (binding-value binding) dat frame) (extend var dat frame)))) ; Rules and Unification (define (apply-rules pattern frame) (stream-flatmap (lambda (rule) (apply-a-rule rule pattern frame)) (fetch-rules pattern frame))) (define (apply-a-rule rule query-pattern query-frame) (let ((clean-rule (rename-variables-in rule))) (let ((unify-result (unify-match query-pattern (conclusion clean-rule) query-frame))) (if (eq? unify-result 'failed) empty-stream (qeval (rule-body clean-rule) (singleton-stream unify-result)))))) (define (rename-variables-in rule) (let ((rule-application-id (new-rule-application-id))) (define (tree-walk exp) (cond ((var? exp) (make-new-variable exp rule-application-id)) ((pair? exp) (cons (tree-walk (car exp)) (tree-walk (cdr exp)))) (else exp))) (tree-walk rule))) (define (unify-match p1 p2 frame) (cond ((eq? frame 'failed) 'failed) ((equal? p1 p2) frame) ((var? p1) (extend-if-possible p1 p2 frame)) ((var? p2) (extend-if-possible p2 p1 frame)) ((and (pair? p1) (pair? p2)) (unify-match (cdr p1) (cdr p2) (unify-match (car p1) (car p2) frame))) (else 'failed))) (define (extend-if-possible var val frame) (let ((binding (binding-in-frame var frame))) (cond (binding (unify-match (binding-value binding) val frame)) ((var? val) (let ((binding (binding-in-frame val frame))) (if binding (unify-match var (binding-value binding) frame) (extend var val frame)))) ((depends-on? val var frame) 'failed) (else (extend var val frame))))) (define (depends-on? exp var frame) (define (tree-walk e) (cond ((var? e) (if (equal? var e) true (let ((b (binding-in-frame e frame))) (if b (tree-walk (binding-value b)) false)))) ((pair? e) (or (tree-walk (car e)) (tree-walk (cdr e)))) (else false))) (tree-walk exp)) ; Maintaining the Data Base (define THE-ASSERTIONS '()) (define (fetch-assertions pattern frame) (if (use-index? pattern) (get-indexed-assertions pattern) (get-all-assertions))) (define (get-all-assertions) (reverse-list->stream THE-ASSERTIONS)) (define (get-indexed-assertions pattern) (reverse-list->stream (get-list (index-key-of pattern) 'assertion-list))) (define THE-RULES '()) (define (fetch-rules pattern frame) (if (use-index? pattern) (get-indexed-rules pattern) (get-all-rules))) (define (get-all-rules) (reverse-list->stream THE-RULES)) (define (get-indexed-rules pattern) (reverse-list->stream (append (get-list '? 'rule-list) (get-list (index-key-of pattern) 'rule-list)))) (define (add-rule-or-assertion! assertion) (if (rule? assertion) (add-rule! assertion) (add-assertion! assertion))) (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons assertion old-assertions)) 'ok)) (define (add-rule! rule) (store-rule-in-index rule) (let ((old-rules THE-RULES)) (set! THE-RULES (cons rule old-rules)) 'ok)) (define (store-assertion-in-index assertion) (when (indexable? assertion) (let ((key (index-key-of assertion))) (let ((current-assertion-list (get-list key 'assertion-list))) (put key 'assertion-list (cons assertion current-assertion-list)))))) (define (store-rule-in-index rule) (let ((pattern (conclusion rule))) (when (indexable? pattern) (let ((key (index-key-of pattern))) (let ((current-rule-list (get-list key 'rule-list))) (put key 'rule-list (cons rule current-rule-list))))))) (define (indexable? pattern) (or (constant-symbol? (car pattern)) (var? (car pattern)))) (define (index-key-of pattern) (let ((key (car pattern))) (if (var? key) '? key))) (define (use-index? pattern) (constant-symbol? (car pattern))) (define (list->stream items) (if (null? items) empty-stream (stream-cons (car items) (list->stream (cdr items))))) (define (reverse-list->stream items) (list->stream (reverse items))) (define (get-list key1 key2) (let ((s (get key1 key2))) (if s s '()))) ; Operator table (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Stream Operations (define (interleave s1 s2) (if (stream-empty? s1) s2 (stream-cons (stream-first s1) (interleave s2 (stream-rest s1))))) (define (stream-flatmap proc s) (flatten-stream (stream-map proc s))) (define (flatten-stream stream) (if (stream-empty? stream) empty-stream (interleave (stream-first stream) (flatten-stream (stream-rest stream))))) (define (singleton-stream x) (stream-cons x empty-stream)) ; Query Syntax Procedures (define (type exp) (if (pair? exp) (car exp) (error "Unknown expression TYPE" exp))) (define (contents exp) (if (pair? exp) (cdr exp) (error "Unknown expression CONTENTS" exp))) (define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp))) (define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps)) (define (rule? statement) (tagged-list? statement 'rule)) (define (conclusion rule) (cadr rule)) (define (rule-body rule) (if (null? (cddr rule)) '(always-true) (caddr rule))) (define (query-syntax-process exp) (map-over-symbols expand-question-mark exp)) (define (map-over-symbols proc exp) (cond ((pair? exp) (cons (map-over-symbols proc (car exp)) (map-over-symbols proc (cdr exp)))) ((symbol? exp) (proc exp)) (else exp))) (define (expand-question-mark symbol) (let ((chars (symbol->string symbol))) (if (string=? (substring chars 0 1) "?") (list '? (string->symbol (substring chars 1 (string-length chars)))) symbol))) (define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp)) (define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var)))) (define (contract-question-mark variable) (string->symbol (string-append "?" (if (number? (cadr variable)) (string-append (symbol->string (caddr variable)) "-" (number->string (cadr variable))) (symbol->string (cadr variable)))))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ; Reseting the state (define (reset-state!) (set! table (make-hash)) (set! rule-counter 0) (set! THE-ASSERTIONS '()) (set! THE-RULES '()) (put 'and 'qeval conjoin) (put 'or 'qeval disjoin) (put 'not 'qeval negate) (put 'lisp-value 'qeval lisp-value) (put 'always-true 'qeval always-true)) (reset-state!) ================================================ FILE: scheme/sicp/04/78.scm ================================================ ; SICP exercise 4.78 ; ; Redesign the query langauge as a nondeterministic program to be implemented ; using the evaluator of section 4.3, rather than as a stream process. In this ; approach, each query will produce a single answer (rather than the stream of ; all answers) and the user can type try-again to see more answers. You should ; find that much of the mechanism we built in this section is subsumed by ; nondeterministic search and backtracking. You will probably also find, ; however, that your new query language has subtle differences in behavior ; from the one implemented here. Can you find examples that illustrate this ; difference? ; Let's not overdo it. ; ; I will implement this using an obscure PLaneT package that implements amb. ; Afterwards it will be straightforward enough to port this to the ; nondeterministic evaluator. I will, however, not do that yet. Maybe in the ; future. ; ; I would also cheat a bit by using amb-collect in negate. ; ; Furthermore, the all subtle differences have to do with either getting stuck ; in an infinite loop, having an infinite stream or the order of operations. I ; don't find that very interesting, so I will not elaborate. (require (planet murphy/amb:1:1/amb)) ; Some amb mumbo-jumbo (define (require p) (unless p (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))) ; The Driver Loop and Instantiation (define (instantiate-exp exp frame unbound-var-handler) (define (copy exp) (cond ((var? exp) (let ((binding (binding-in-frame exp frame))) (if binding (copy (binding-value binding)) (unbound-var-handler exp frame)))) ((pair? exp) (cons (copy (car exp)) (copy (cdr exp)))) (else exp))) (copy exp)) ; The Evaluator (define (qeval query frame) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) frame) (simple-query query frame)))) (define (execute exp) (apply (eval (predicate exp)) (args exp))) (define (simple-query query-pattern frame) (amb (find-assertions query-pattern frame) (apply-rules query-pattern frame))) (define conjoin '()) (define (conjoin conjuncts frame) (if (empty-conjunction? conjuncts) frame (let ((match (qeval (first-conjunct conjuncts) frame))) (require (matched? match)) (conjoin (rest-conjuncts conjuncts) match)))) (define disjoin '()) (define (disjoin disjuncts frame) (if (empty-disjunction? disjuncts) (amb) (amb (qeval (first-disjunct disjuncts) frame) (disjoin (rest-disjuncts disjuncts) frame)))) (define (negate operands frame) (require (null? (amb-collect (qeval (negated-query operands) frame)))) frame) (define (lisp-value call frame) (require (execute (instantiate-exp call frame (lambda (v f) (error "Unknown pat var -- LISP-VALUE" v))))) frame) (define (always-true ignore frame) frame) ; Finding Assertions by Pattern Matching (define (failed? result) (eq? result 'failed)) (define (matched? result) (not (failed? result))) (define (find-assertions pattern frame) (let ((assertion (an-element-of (fetch-assertions pattern frame)))) (let ((match (pattern-match pattern assertion frame))) (require (matched? match)) match))) (define (pattern-match pat dat frame) (cond ((eq? frame 'failed) 'failed) ((equal? pat dat) frame) ((var? pat) (extend-if-consistent pat dat frame)) ((and (pair? pat) (pair? dat)) (pattern-match (cdr pat) (cdr dat) (pattern-match (car pat) (car dat) frame))) (else 'failed))) (define (extend-if-consistent var dat frame) (let ((binding (binding-in-frame var frame))) (if binding (pattern-match (binding-value binding) dat frame) (extend var dat frame)))) ; Rules and Unification (define (apply-rules pattern frame) (let ((rule (an-element-of (fetch-rules pattern frame)))) (let ((clean-rule (rename-variables-in rule))) (let ((unify-result (unify-match pattern (conclusion clean-rule) frame))) (require (matched? unify-result)) (qeval (rule-body clean-rule) unify-result))))) (define (rename-variables-in rule) (let ((rule-application-id (new-rule-application-id))) (define (tree-walk exp) (cond ((var? exp) (make-new-variable exp rule-application-id)) ((pair? exp) (cons (tree-walk (car exp)) (tree-walk (cdr exp)))) (else exp))) (tree-walk rule))) (define (unify-match p1 p2 frame) (cond ((eq? frame 'failed) 'failed) ((equal? p1 p2) frame) ((var? p1) (extend-if-possible p1 p2 frame)) ((var? p2) (extend-if-possible p2 p1 frame)) ((and (pair? p1) (pair? p2)) (unify-match (cdr p1) (cdr p2) (unify-match (car p1) (car p2) frame))) (else 'failed))) (define (extend-if-possible var val frame) (let ((binding (binding-in-frame var frame))) (cond (binding (unify-match (binding-value binding) val frame)) ((var? val) (let ((binding (binding-in-frame val frame))) (if binding (unify-match var (binding-value binding) frame) (extend var val frame)))) ((depends-on? val var frame) 'failed) (else (extend var val frame))))) (define (depends-on? exp var frame) (define (tree-walk e) (cond ((var? e) (if (equal? var e) true (let ((b (binding-in-frame e frame))) (if b (tree-walk (binding-value b)) false)))) ((pair? e) (or (tree-walk (car e)) (tree-walk (cdr e)))) (else false))) (tree-walk exp)) ; Maintaining the Data Base (define THE-ASSERTIONS '()) (define (fetch-assertions pattern frame) (if (use-index? pattern) (get-indexed-assertions pattern) (get-all-assertions))) (define (get-all-assertions) (reverse THE-ASSERTIONS)) (define (get-indexed-assertions pattern) (reverse (get-list (index-key-of pattern) 'assertion-list))) (define THE-RULES '()) (define (fetch-rules pattern frame) (if (use-index? pattern) (get-indexed-rules pattern) (get-all-rules))) (define (get-all-rules) (reverse THE-RULES)) (define (get-indexed-rules pattern) (reverse (append (get-list '? 'rule-list) (get-list (index-key-of pattern) 'rule-list)))) (define (add-rule-or-assertion! assertion) (if (rule? assertion) (add-rule! assertion) (add-assertion! assertion))) (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons assertion old-assertions)) 'ok)) (define (add-rule! rule) (store-rule-in-index rule) (let ((old-rules THE-RULES)) (set! THE-RULES (cons rule old-rules)) 'ok)) (define (store-assertion-in-index assertion) (when (indexable? assertion) (let ((key (index-key-of assertion))) (let ((current-assertion-list (get-list key 'assertion-list))) (put key 'assertion-list (cons assertion current-assertion-list)))))) (define (store-rule-in-index rule) (let ((pattern (conclusion rule))) (when (indexable? pattern) (let ((key (index-key-of pattern))) (let ((current-rule-list (get-list key 'rule-list))) (put key 'rule-list (cons rule current-rule-list))))))) (define (indexable? pattern) (or (constant-symbol? (car pattern)) (var? (car pattern)))) (define (index-key-of pattern) (let ((key (car pattern))) (if (var? key) '? key))) (define (use-index? pattern) (constant-symbol? (car pattern))) (define (get-list key1 key2) (let ((s (get key1 key2))) (if s s '()))) ; Operator table (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Query Syntax Procedures (define (type exp) (if (pair? exp) (car exp) (error "Unknown expression TYPE" exp))) (define (contents exp) (if (pair? exp) (cdr exp) (error "Unknown expression CONTENTS" exp))) (define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp))) (define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps)) (define (rule? statement) (tagged-list? statement 'rule)) (define (conclusion rule) (cadr rule)) (define (rule-body rule) (if (null? (cddr rule)) '(always-true) (caddr rule))) (define (query-syntax-process exp) (map-over-symbols expand-question-mark exp)) (define (map-over-symbols proc exp) (cond ((pair? exp) (cons (map-over-symbols proc (car exp)) (map-over-symbols proc (cdr exp)))) ((symbol? exp) (proc exp)) (else exp))) (define (expand-question-mark symbol) (let ((chars (symbol->string symbol))) (if (string=? (substring chars 0 1) "?") (list '? (string->symbol (substring chars 1 (string-length chars)))) symbol))) (define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp)) (define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var)))) (define (contract-question-mark variable) (string->symbol (string-append "?" (if (number? (cadr variable)) (string-append (symbol->string (caddr variable)) "-" (number->string (cadr variable))) (symbol->string (cadr variable)))))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ; Frames and Bindings (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-frame variable frame) (assoc variable frame)) (define (extend variable value frame) (cons (make-binding variable value) frame)) ; Reseting the state (define (reset-state!) (set! table (make-hash)) (set! rule-counter 0) (set! THE-ASSERTIONS '()) (set! THE-RULES '()) (put 'and 'qeval conjoin) (put 'or 'qeval disjoin) (put 'not 'qeval negate) (put 'lisp-value 'qeval lisp-value) (put 'always-true 'qeval always-true)) (reset-state!) ================================================ FILE: scheme/sicp/04/79.scm ================================================ ; SICP exercise 4.79 ; ; When we implemented the Lisp evaluator in section 4.1, we saw how to use ; local environments to avoid name conflicts between the parameters of ; procedures. For example, in evaluating ; ; (define (square x) ; (* x x)) ; (define (sum-of-squares x y) ; (+ (square x) (square y))) ; (sum-of-squares 3 4) ; ; there is no confusion between the x in square and the x in sum-of-squares, ; because we evaluate the body of each procedure in an environment that is ; specially constructed to contain bindings for the local variables. In the ; query system, we used a different strategy to avoid name conflicts in ; applying rules. Each time we apply a rule we rename the variables with new ; names that are guaranteed to be unique. The analogous strategy for the Lisp ; evaluator would be to do away with local environments and simply rename the ; variables in the body of a procedure each time we apply the procedure. ; ; Implement for the query language a rule-application method that uses ; environments rather than renaming. See if you can build on your environment ; structure to create constructs in the query language for dealing with large ; systems, such as the rule analog of block-structured procedures. Can you ; relate any of this to the problem of making deductions in a context (e.g., ; "If I supposed that P were true, then I would be able to deduce A and B.") ; as a method of problem solving? (This problem is open-ended. A good answer ; is probably worth a Ph. D.). ; Phew. That was some seriously tricky business. ; ; Our environment would be a list of frame, where each frame is a list of ; bindings (a binding is an associative list, mapping variable to value). We ; will also have a special kind of variables, called "outer" variables. If a ; frame has a value for (? outer y), then this is the value of (? y) in the ; parent frame. ; ; We also need a procedure that "pops" an environment. It removes the top ; frame of the environment after copying all the outer variable assignments it ; has to its parents. That is, when the first frame in an environment binds ; (? outer y) to (1 2), then the procedure returns the second frame, extended ; with a binding form ?y to (1 2). ; ; The rule application is as follows: ; 1. We rename all variables in the query to outer variables ; 2. We unify the rule conclusion with the renamed query in a new ; environment, whose parent is the current environment. ; 3. If the unification was successful, we proceed to evaluate the body of ; the rule in the frame that resulted from the unification. ; 4. We map the resulting stream to the procedure that pops the enviornment ; ; This results to a stream of frames, that have bindings for all the ; variables in the query. ; ; In order to define rule-scoped rules and assertions, we are going to attach ; rules and assertions to each frame. We have a special (if awkward) syntax ; for inner definitions. Check out the tests for details. ; ; As for the implementation, there was a nice hint in the book. Namely, that ; fetch-rules and fetch-assertions take an extra environment argument. That ; way we can retrieve the rules or assertions in the current environment along ; with the ones in the database. ; ; For retrieving the rules, we take the rules of each frame and instantiate ; them in the frame (leaving the free variables as they are). We flatmap the ; result and remove duplicates to avoid checking a rule multiple times (this ; happens if a rule recursively invokes itself or the rule that defines it). ; This introduce an important semantic: the variables in the conclusion of the ; rule are bound within the inner rules. That is, a variable has the same ; value within the body of the rule and the bodies and conclusions of its ; inner rules. ; ; The process for assertions is the same. ; ; And I'm just going to ignore the open-ended question that gets you a Ph. D. ; Environments, Frames and Bindings (define (empty-frame) (make-frame '() '() '() '())) (define (make-frame bindings assertions rules parent) (list bindings assertions rules parent)) (define (frame-bindings frame) (car frame)) (define (frame-assertions frame) (cadr frame)) (define (frame-rules frame) (caddr frame)) (define (frame-parent frame) (cadddr frame)) (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-env variable env) (assoc variable (frame-bindings env))) ; The selectors for rules (define (rule? statement) (tagged-list? statement 'rule)) (define (conclusion rule) (cadr rule)) (define (rule-inner-assertions rule) (map cadr (filter (lambda (sexp) (eq? (car sexp) 'assert!)) (cddr rule)))) (define (rule-inner-rules rule) (filter (lambda (sexp) (eq? (car sexp) 'rule)) (cddr rule))) (define (rule-body rule) (let ((stripped (filter (lambda (sexp) (and (not (eq? (car sexp) 'rule)) (not (eq? (car sexp) 'assert!)))) (cddr rule)))) (if (null? stripped) '(always-true) (car stripped)))) (define (build-frame-for rule parent-env) (make-frame '() (rule-inner-assertions rule) (rule-inner-rules rule) parent-env)) ; Helper procedures for "outer" variables (define (outer? var) (and (not (null? (cddr var))) (eq? 'outer (cadr var)))) (define (remove-outer var) (cons '? (cddr var))) (define (add-outer-to-variables pattern env) (instantiate-exp pattern env (lambda (var f) (append '(? outer) (cdr var))))) ; Helper procedures for environments (define (substitute-variables expr env) (instantiate-exp expr env (lambda (var frame) var))) (define (extend var val env) (make-frame (add-or-redefine var val (frame-bindings env)) (frame-rules env) (frame-assertions env) (frame-parent env))) (define (add-or-redefine var val bindings) (cons (make-binding var val) (filter (lambda (binding) (not (equal? (binding-variable binding) var))) bindings))) (define (pop-env env) (define (merge binding frame) (let ((var (binding-variable binding)) (val (binding-value binding))) (if (outer? var) (extend (remove-outer var) (substitute-variables val env) frame) frame))) (foldr merge (frame-parent env) (frame-bindings env))) ; Extracting rules and assertions from environments (define (get-assertions-in-env env) (if (null? env) '() (append (map (lambda (assertion) (substitute-variables assertion env)) (frame-assertions env)) (get-assertions-in-env (frame-parent env))))) (define (get-rules-in-env env) (if (null? env) '() (append (map (lambda (rule) (substitute-variables rule env)) (frame-rules env)) (get-rules-in-env (frame-parent env))))) ; Rule application (define (apply-a-rule rule query-pattern query-env) (let ((new-env (build-frame-for rule query-env)) (renamed-query (add-outer-to-variables query-pattern query-env))) (let ((unify-result (unify-match renamed-query (conclusion rule) new-env))) (if (eq? unify-result 'failed) empty-stream (stream-map pop-env (qeval (rule-body rule) (singleton-stream unify-result))))))) ; The result of the interpreter: ; Instantiation (define (instantiate-exp exp env unbound-var-handler) (define (copy exp) (cond ((var? exp) (let ((binding (binding-in-env exp env))) (if binding (copy (binding-value binding)) (unbound-var-handler exp env)))) ((pair? exp) (cons (copy (car exp)) (copy (cdr exp)))) (else exp))) (copy exp)) ; The Evaluator (define (qeval query env-stream) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) env-stream) (simple-query query env-stream)))) (define (execute exp) (apply (eval (predicate exp)) (args exp))) (define (simple-query query-pattern env-stream) (stream-flatmap (lambda (env) (stream-append (find-assertions query-pattern env) (apply-rules query-pattern env))) env-stream)) (define conjoin '()) (define (conjoin conjuncts env-stream) (if (empty-conjunction? conjuncts) env-stream (conjoin (rest-conjuncts conjuncts) (qeval (first-conjunct conjuncts) env-stream)))) (define disjoin '()) (define (disjoin disjuncts env-stream) (if (empty-disjunction? disjuncts) empty-stream (interleave (qeval (first-disjunct disjuncts) env-stream) (disjoin (rest-disjuncts disjuncts) env-stream)))) (define (negate operands env-stream) (stream-flatmap (lambda (env) (if (stream-empty? (qeval (negated-query operands) (singleton-stream env))) (singleton-stream env) empty-stream)) env-stream)) (define (lisp-value call env-stream) (stream-flatmap (lambda (env) (if (execute (instantiate-exp call env (lambda (v e) (error "Unknown pat var -- LISP-VALUE" v)))) (singleton-stream env) empty-stream)) env-stream)) (define (always-true ignore env-stream) env-stream) ; Finding Assertions by Pattern Matching (define (find-assertions pattern env) (stream-flatmap (lambda (datum) (check-an-assertion datum pattern env)) (fetch-assertions pattern env))) (define (check-an-assertion assertion query-pat query-env) (let ((match-result (pattern-match query-pat assertion query-env))) (if (eq? match-result 'failed) empty-stream (singleton-stream match-result)))) (define (pattern-match pat dat env) (cond ((eq? env 'failed) 'failed) ((equal? pat dat) env) ((var? pat) (extend-if-consistent pat dat env)) ((and (pair? pat) (pair? dat)) (pattern-match (cdr pat) (cdr dat) (pattern-match (car pat) (car dat) env))) (else 'failed))) (define (extend-if-consistent var dat env) (let ((binding (binding-in-env var env))) (if binding (pattern-match (binding-value binding) dat env) (extend var dat env)))) ; Rules and Unification (define (apply-rules pattern env) (stream-flatmap (lambda (rule) (apply-a-rule rule pattern env)) (fetch-rules pattern env))) (define (unify-match p1 p2 env) (cond ((eq? env 'failed) 'failed) ((equal? p1 p2) env) ((var? p1) (extend-if-possible p1 p2 env)) ((var? p2) (extend-if-possible p2 p1 env)) ((and (pair? p1) (pair? p2)) (unify-match (cdr p1) (cdr p2) (unify-match (car p1) (car p2) env))) (else 'failed))) (define (extend-if-possible var val env) (let ((binding (binding-in-env var env))) (cond (binding (unify-match (binding-value binding) val env)) ((var? val) (let ((binding (binding-in-env val env))) (if binding (unify-match var (binding-value binding) env) (extend var val env)))) ((depends-on? val var env) 'failed) (else (extend var val env))))) (define (depends-on? exp var env) (define (tree-walk e) (cond ((var? e) (if (equal? var e) true (let ((b (binding-in-env e env))) (if b (tree-walk (binding-value b)) false)))) ((pair? e) (or (tree-walk (car e)) (tree-walk (cdr e)))) (else false))) (tree-walk exp)) ; Maintaining the Data Base (define THE-ASSERTIONS '()) (define (fetch-assertions pattern env) (reverse-list->stream (remove-duplicates (append (get-assertions-in-env env) (if (use-index? pattern) (get-indexed-assertions pattern) (get-all-assertions)))))) (define (get-all-assertions) THE-ASSERTIONS) (define (get-indexed-assertions pattern) (get-list (index-key-of pattern) 'assertion-list)) (define THE-RULES '()) (define (fetch-rules pattern env) (reverse-list->stream (remove-duplicates (append (get-rules-in-env env) (if (use-index? pattern) (get-indexed-rules pattern) (get-all-rules)))))) (define (get-all-rules) THE-RULES) (define (get-indexed-rules pattern) (append (get-list '? 'rule-list) (get-list (index-key-of pattern) 'rule-list))) (define (add-rule-or-assertion! assertion) (if (rule? assertion) (add-rule! assertion) (add-assertion! assertion))) (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons assertion old-assertions)) 'ok)) (define (add-rule! rule) (store-rule-in-index rule) (let ((old-rules THE-RULES)) (set! THE-RULES (cons rule old-rules)) 'ok)) (define (store-assertion-in-index assertion) (when (indexable? assertion) (let ((key (index-key-of assertion))) (let ((current-assertion-list (get-list key 'assertion-list))) (put key 'assertion-list (cons assertion current-assertion-list)))))) (define (store-rule-in-index rule) (let ((pattern (conclusion rule))) (when (indexable? pattern) (let ((key (index-key-of pattern))) (let ((current-rule-list (get-list key 'rule-list))) (put key 'rule-list (cons rule current-rule-list))))))) (define (indexable? pattern) (or (constant-symbol? (car pattern)) (var? (car pattern)))) (define (index-key-of pattern) (let ((key (car pattern))) (if (var? key) '? key))) (define (use-index? pattern) (constant-symbol? (car pattern))) (define (list->stream items) (if (null? items) empty-stream (stream-cons (car items) (list->stream (cdr items))))) (define (reverse-list->stream items) (list->stream (reverse items))) (define (get-list key1 key2) (let ((s (get key1 key2))) (if s s '()))) ; Operator table (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Stream Operations (define (interleave s1 s2) (if (stream-empty? s1) s2 (stream-cons (stream-first s1) (interleave s2 (stream-rest s1))))) (define (stream-flatmap proc s) (flatten-stream (stream-map proc s))) (define (flatten-stream stream) (if (stream-empty? stream) empty-stream (interleave (stream-first stream) (flatten-stream (stream-rest stream))))) (define (singleton-stream x) (stream-cons x empty-stream)) ; Query Syntax Procedures (define (type exp) (if (pair? exp) (car exp) (error "Unknown expression TYPE" exp))) (define (contents exp) (if (pair? exp) (cdr exp) (error "Unknown expression CONTENTS" exp))) (define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp))) (define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps)) (define (query-syntax-process exp) (map-over-symbols expand-question-mark exp)) (define (map-over-symbols proc exp) (cond ((pair? exp) (cons (map-over-symbols proc (car exp)) (map-over-symbols proc (cdr exp)))) ((symbol? exp) (proc exp)) (else exp))) (define (expand-question-mark symbol) (let ((chars (symbol->string symbol))) (if (string=? (substring chars 0 1) "?") (list '? (string->symbol (substring chars 1 (string-length chars)))) symbol))) (define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp)) (define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var)))) (define (contract-question-mark variable) (string->symbol (string-append "?" (if (number? (cadr variable)) (string-append (symbol->string (caddr variable)) "-" (number->string (cadr variable))) (symbol->string (cadr variable)))))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ; Reseting the state (define (reset-state!) (set! table (make-hash)) (set! rule-counter 0) (set! THE-ASSERTIONS '()) (set! THE-RULES '()) (put 'and 'qeval conjoin) (put 'or 'qeval disjoin) (put 'not 'qeval negate) (put 'lisp-value 'qeval lisp-value) (put 'always-true 'qeval always-true)) (reset-state!) ================================================ FILE: scheme/sicp/04/showcase/amb/evaluator.scm ================================================ ; Our interpreter will not scan out definitions. Instead, it will rely on the ; programmer putting their internal definitions in the beginning of the ; procedures. This is a simplifying assumption. (require r5rs/init) (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((amb? exp) (analyze-amb exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args succeed fail) (cond ((primitive-procedure? proc) (succeed (apply-primitive-procedure proc args) fail)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)) succeed fail)) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (analyze-self-evaluating exp) (lambda (env succeed fail) (succeed exp fail))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env succeed fail) (succeed qval fail)))) (define (analyze-variable exp) (lambda (env succeed fail) (succeed (lookup-variable-value exp env) fail))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (let ((old-value (lookup-variable-value var env))) (set-variable-value! var val env) (succeed 'ok (lambda () (set-variable-value! var old-value env) (fail2))))) fail)))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fail2) (define-variable! var val env) (succeed 'ok fail2)) fail)))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env succeed fail) (pproc env (lambda (pred-value fail2) (if (true? pred-value) (cproc env succeed fail2) (aproc env succeed fail2))) fail)))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env succeed fail) (succeed (make-procedure vars bproc env) fail)))) (define (analyze-sequence exps) (define (sequentially a b) (lambda (env succeed fail) (a env (lambda (a-value fail2) (b env succeed fail2)) fail))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env succeed fail) (fproc env (lambda (proc fail2) (get-args aprocs env (lambda (args fail3) (execute-application proc args succeed fail3)) fail2)) fail)))) (define (analyze-amb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) ((car choices) env succeed (lambda () (try-next (cdr choices)))))) (try-next cprocs)))) (define (get-args aprocs env succeed fail) (if (null? aprocs) (succeed '() fail) ((car aprocs) env (lambda (arg fail2) (get-args (cdr aprocs) env (lambda (args fail3) (succeed (cons arg args) fail3)) fail2)) fail))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (amb? exp) (tagged-list? exp 'amb)) (define (amb-choices exp) (cdr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list 'list list) (list 'not not) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define definitions '((define (require p) (if (not p) (amb))) (define (an-element-of items) (require (not (null? items))) (amb (car items) (an-element-of (cdr items)))))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) (for-each (lambda (definition) (ambeval definition initial-env (lambda (value fail) 'ok) (lambda () 'ok))) definitions) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; Amb-Eval input:") (define output-prompt ";;; Amb-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (driver-loop) (define (internal-loop try-again) (prompt-for-input input-prompt) (let ((input (read))) (if (eq? input 'try-again) (try-again) (begin (newline) (display ";;; Starting a new problem") (ambeval input the-global-environment (lambda (val next-alternative) (announce-output output-prompt) (user-print val) (internal-loop next-alternative)) (lambda () (announce-output ";;; There are no more values of") (user-print input) (driver-loop))))))) (internal-loop (lambda () (newline) (display ";;; There is no current problem") (driver-loop)))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/showcase/amb/main.scm ================================================ (load "evaluator.scm") (driver-loop) ================================================ FILE: scheme/sicp/04/showcase/amb/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "evaluator.scm") (define (run exp) (evaluate exp (setup-environment))) (define evaluator-tests (test-suite "Tests for the nondeterministic evaluator" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/04/showcase/analyzing/evaluator.scm ================================================ ; This is the analyzing evaluator, implemented in SICP 4.1.7. eval is renamed ; to evaluate because of naming issues in Racket. It uses r5rs in order to get ; set-car! and set-cdr! (require r5rs/init) (define (evaluate exp env) ((analyze exp) env)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((cond? exp) (analyze (cond->if exp))) ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) (define (execute-application proc args) (cond ((primitive-procedure? proc) (apply-primitive-procedure proc args)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)))) (else (error "Unknown procedure type -- EXECUTE-APPLICATION" proc)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (analyze-self-evaluating exp) (lambda (env) exp)) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda (env) qval))) (define (analyze-variable exp) (lambda (env) (lookup-variable-value exp env))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env) (set-variable-value! var (vproc env) env) 'ok))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda (env) (define-variable! var (vproc env) env) 'ok))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda (env) (if (true? (pproc env)) (cproc env) (aproc env))))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda (env) (make-procedure vars bproc env)))) (define (analyze-sequence exps) (define (sequentially proc1 proc2) (lambda (env) (proc1 env) (proc2 env))) (define (loop first-proc rest-procs) (if (null? rest-procs) first-proc (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) (let ((procs (map analyze exps))) (if (null? procs) (error "Empty sequence -- ANALYZE")) (loop (car procs) (cdr procs)))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda (env) (execute-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/showcase/analyzing/main.scm ================================================ (load "evaluator.scm") (driver-loop) ================================================ FILE: scheme/sicp/04/showcase/analyzing/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "evaluator.scm") (define (run exp) (evaluate exp (setup-environment))) (define evaluator-tests (test-suite "Tests for the analyzing evaluator" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/04/showcase/evaluator/evaluator.scm ================================================ ; This is an implementation of the SICP metacircular evaluator as-is. Due to ; Racket semantics I don't really get, I had to rename eval and apply to ; evaluate and apply-procedure. It runs in R5RS because of set-car! and ; set-cdr!, which are notoriously annoying in plain Racket. (require r5rs/init) (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; M-Eval input:") (define output-prompt ";;; M-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (evaluate input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/showcase/evaluator/main.scm ================================================ ; A straightforward runner for the basic metacircular evaluator in chapter 4. ; Running it throws you in a REPL that's quite straightfoward, although it ; does not support good error reporting. (load "evaluator.scm") (driver-loop) ================================================ FILE: scheme/sicp/04/showcase/evaluator/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "evaluator.scm") (define (run exp) (evaluate exp (setup-environment))) (define evaluator-tests (test-suite "Tests for the metacircular evaluator" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/04/showcase/lazy/evaluator.scm ================================================ ; The lazy evaluator, explored in SICP. (require r5rs/init) (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (actual-value (operator exp) env) (operands exp) env)) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-arg-values arguments env))) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-delayed-args arguments env) (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (actual-value exp env) (force-it (evaluate exp env))) (define (delay-it exp env) (list 'thunk exp env)) (define (thunk? obj) (tagged-list? obj 'thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk)) (define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) (define (force-it obj) (cond ((thunk? obj) (let ((result (actual-value (thunk-exp obj) (thunk-env obj)))) (set-car! obj 'evaluated-thunk) (set-car! (cdr obj) result) (set-cdr! (cdr obj) '()) result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) (define (list-of-arg-values exps env) (if (no-operands? exps) '() (cons (actual-value (first-operand exps) env) (list-of-arg-values (rest-operands exps) env)))) (define (list-of-delayed-args exps env) (if (no-operands? exps) '() (cons (delay-it (first-operand exps) env) (list-of-delayed-args (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (actual-value (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define input-prompt ";;; L-Eval input:") (define output-prompt ";;; L-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ================================================ FILE: scheme/sicp/04/showcase/lazy/main.scm ================================================ (load "evaluator.scm") (driver-loop) ================================================ FILE: scheme/sicp/04/showcase/lazy/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "evaluator.scm") (define (run exp) (actual-value exp (setup-environment))) (define evaluator-tests (test-suite "Tests for the lazy evaluator" (test-suite "Lazy evaluation" (check-equal? 1 (run '(begin (define (try a b) (if (= a 0) 1 b)) (try 0 (/ 1 0)))))) (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/04/showcase/query/database.scm ================================================ (define database-assertions '((address (Warbucks Oliver) (Swellesley (Top Head Road))) (job (Warbucks Oliver) (administration big wheel)) (salary (Warbucks Oliver) 150000) (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)) (job (Bitdiddle Ben) (computer wizard)) (salary (Bitdiddle Ben) 60000) (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)) (job (Hacker Alyssa P) (computer programmer)) (salary (Hacker Alyssa P) 40000) (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Fect Cy D) (Cambridge (Ames Street) 3)) (job (Fect Cy D) (computer programmer)) (salary (Fect Cy D) 35000) (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Tweakit Lem E) (Boston (Bay State Road) 22)) (job (Tweakit Lem E) (computer technician)) (salary (Tweakit Lem E) 25000) (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)) (job (Reasoner Louis) (computer programmer trainee)) (salary (Reasoner Louis) 30000) (supervisor (Reasoner Louis) (Hacker Alyssa P)) (address (Scrooge Eben) (Westen (Shady Lane) 10)) (job (Scrooge Eben) (accounting chief accountant)) (salary (Scrooge Eben) 75000) (supervisor (Scrooge Eben) (Warbucks Oliver)) (address (Cratchet Robert) (Allston (N Harvard Street) 16)) (job (Cratchet Robert) (accounting scrivener)) (salary (Cratchet Robert) 18000) (supervisor (Cratchet Robert) (Scrooge Eben)) (address (Aull DeWitt) (Slumerville (Onion Square) 5)) (job (Aull DeWitt) (administration secretary)) (salary (Aull DeWitt) 25000) (supervisor (Aull DeWitt) (Warbucks Oliver)) (can-do-job (computer wizard) (computer programmer)) (can-do-job (computer wizard) (computer technician)) (can-do-job (computer programmer) (computer programmer trainee)) (can-do-job (administration secretary) (administration big wheel)) (rule (lives-near ?person-1 ?person-2) (and (address ?person-1 (?town . ?rest-1)) (address ?person-2 (?town . ?rest-2)) (not (same ?person-1 ?person-2)))) (rule (same ?x ?x)) (rule (wheel ?person) (and (supervisor ?middle-manager ?person) (supervisor ?x ?middle-manager))) (rule (outranked-by ?staff-person ?boss) (or (supervisor ?staff-person ?boss) (and (supervisor ?staff-person ?middle-manager) (outranked-by ?middle-manager ?boss)))) (rule (append-to-form () ?y ?y)) (rule (append-to-form (?u . ?v) ?y (?u . ?z)) (append-to-form ?v ?y ?z)))) (define (add-to-data-base! assertions) (for-each (compose add-rule-or-assertion! query-syntax-process) assertions)) (add-to-data-base! database-assertions) ================================================ FILE: scheme/sicp/04/showcase/query/evaluator.scm ================================================ ; This is the query language from the Logic Programming section in SICP. There ; are some modifications to the original code: ; ; * Racket stream procedures are differently named than the ones described in ; the book. ; * Racket streams are different than the streams described in SICP in that ; they delay their cdr. This removes the need to have delayed versions of ; the stream procedures. ; * The query system in the book stores rules and assertions in an order that ; is the reverse of their definition order, which introduces inconsistencies ; between the shown examples and the actual results. This implementation ; stores the rules and assertions as lists and converts them to a stream in ; which their elements appear in reverse order upon retrieval. ; The Driver Loop and Instantiation (define input-prompt ";;; Query input:") (define output-prompt ";;; Query output:") (define (query-driver-loop) (prompt-for-input input-prompt) (let ((q (query-syntax-process (read)))) (cond ((assertion-to-be-added? q) (add-rule-or-assertion! (add-assertion-body q)) (newline) (display "Assertion added to data base.") (query-driver-loop)) (else (newline) (display output-prompt) (display-stream (stream-map (lambda (frame) (instantiate-exp q frame (lambda (v f) (contract-question-mark v)))) (qeval q (singleton-stream '())))) (query-driver-loop))))) (define (instantiate-exp exp frame unbound-var-handler) (define (copy exp) (cond ((var? exp) (let ((binding (binding-in-frame exp frame))) (if binding (copy (binding-value binding)) (unbound-var-handler exp frame)))) ((pair? exp) (cons (copy (car exp)) (copy (cdr exp)))) (else exp))) (copy exp)) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (display-stream stream) (unless (stream-empty? stream) (newline) (display (stream-first stream)) (display-stream (stream-rest stream)))) ; The Evaluator (define (qeval query frame-stream) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) frame-stream) (simple-query query frame-stream)))) (define (execute exp) (apply (eval (predicate exp)) (args exp))) (define (simple-query query-pattern frame-stream) (stream-flatmap (lambda (frame) (stream-append (find-assertions query-pattern frame) (apply-rules query-pattern frame))) frame-stream)) (define (conjoin conjuncts frame-stream) (if (empty-conjunction? conjuncts) frame-stream (conjoin (rest-conjuncts conjuncts) (qeval (first-conjunct conjuncts) frame-stream)))) (define (disjoin disjuncts frame-stream) (if (empty-disjunction? disjuncts) empty-stream (interleave (qeval (first-disjunct disjuncts) frame-stream) (disjoin (rest-disjuncts disjuncts) frame-stream)))) (define (negate operands frame-stream) (stream-flatmap (lambda (frame) (if (stream-empty? (qeval (negated-query operands) (singleton-stream frame))) (singleton-stream frame) empty-stream)) frame-stream)) (define (lisp-value call frame-stream) (stream-flatmap (lambda (frame) (if (execute (instantiate-exp call frame (lambda (v f) (error "Unknown pat var -- LISP-VALUE" v)))) (singleton-stream frame) empty-stream)) frame-stream)) (define (always-true ignore frame-stream) frame-stream) ; Finding Assertions by Pattern Matching (define (find-assertions pattern frame) (stream-flatmap (lambda (datum) (check-an-assertion datum pattern frame)) (fetch-assertions pattern frame))) (define (check-an-assertion assertion query-pat query-frame) (let ((match-result (pattern-match query-pat assertion query-frame))) (if (eq? match-result 'failed) empty-stream (singleton-stream match-result)))) (define (pattern-match pat dat frame) (cond ((eq? frame 'failed) 'failed) ((equal? pat dat) frame) ((var? pat) (extend-if-consistent pat dat frame)) ((and (pair? pat) (pair? dat)) (pattern-match (cdr pat) (cdr dat) (pattern-match (car pat) (car dat) frame))) (else 'failed))) (define (extend-if-consistent var dat frame) (let ((binding (binding-in-frame var frame))) (if binding (pattern-match (binding-value binding) dat frame) (extend var dat frame)))) ; Rules and Unification (define (apply-rules pattern frame) (stream-flatmap (lambda (rule) (apply-a-rule rule pattern frame)) (fetch-rules pattern frame))) (define (apply-a-rule rule query-pattern query-frame) (let ((clean-rule (rename-variables-in rule))) (let ((unify-result (unify-match query-pattern (conclusion clean-rule) query-frame))) (if (eq? unify-result 'failed) empty-stream (qeval (rule-body clean-rule) (singleton-stream unify-result)))))) (define (rename-variables-in rule) (let ((rule-application-id (new-rule-application-id))) (define (tree-walk exp) (cond ((var? exp) (make-new-variable exp rule-application-id)) ((pair? exp) (cons (tree-walk (car exp)) (tree-walk (cdr exp)))) (else exp))) (tree-walk rule))) (define (unify-match p1 p2 frame) (cond ((eq? frame 'failed) 'failed) ((equal? p1 p2) frame) ((var? p1) (extend-if-possible p1 p2 frame)) ((var? p2) (extend-if-possible p2 p1 frame)) ((and (pair? p1) (pair? p2)) (unify-match (cdr p1) (cdr p2) (unify-match (car p1) (car p2) frame))) (else 'failed))) (define (extend-if-possible var val frame) (let ((binding (binding-in-frame var frame))) (cond (binding (unify-match (binding-value binding) val frame)) ((var? val) (let ((binding (binding-in-frame val frame))) (if binding (unify-match var (binding-value binding) frame) (extend var val frame)))) ((depends-on? val var frame) 'failed) (else (extend var val frame))))) (define (depends-on? exp var frame) (define (tree-walk e) (cond ((var? e) (if (equal? var e) true (let ((b (binding-in-frame e frame))) (if b (tree-walk (binding-value b)) false)))) ((pair? e) (or (tree-walk (car e)) (tree-walk (cdr e)))) (else false))) (tree-walk exp)) ; Maintaining the Data Base (define THE-ASSERTIONS '()) (define (fetch-assertions pattern frame) (if (use-index? pattern) (get-indexed-assertions pattern) (get-all-assertions))) (define (get-all-assertions) (reverse-list->stream THE-ASSERTIONS)) (define (get-indexed-assertions pattern) (reverse-list->stream (get-list (index-key-of pattern) 'assertion-list))) (define THE-RULES '()) (define (fetch-rules pattern frame) (if (use-index? pattern) (get-indexed-rules pattern) (get-all-rules))) (define (get-all-rules) (reverse-list->stream THE-RULES)) (define (get-indexed-rules pattern) (reverse-list->stream (append (get-list '? 'rule-list) (get-list (index-key-of pattern) 'rule-list)))) (define (add-rule-or-assertion! assertion) (if (rule? assertion) (add-rule! assertion) (add-assertion! assertion))) (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons assertion old-assertions)) 'ok)) (define (add-rule! rule) (store-rule-in-index rule) (let ((old-rules THE-RULES)) (set! THE-RULES (cons rule old-rules)) 'ok)) (define (store-assertion-in-index assertion) (when (indexable? assertion) (let ((key (index-key-of assertion))) (let ((current-assertion-list (get-list key 'assertion-list))) (put key 'assertion-list (cons assertion current-assertion-list)))))) (define (store-rule-in-index rule) (let ((pattern (conclusion rule))) (when (indexable? pattern) (let ((key (index-key-of pattern))) (let ((current-rule-list (get-list key 'rule-list))) (put key 'rule-list (cons rule current-rule-list))))))) (define (indexable? pattern) (or (constant-symbol? (car pattern)) (var? (car pattern)))) (define (index-key-of pattern) (let ((key (car pattern))) (if (var? key) '? key))) (define (use-index? pattern) (constant-symbol? (car pattern))) (define (list->stream items) (if (null? items) empty-stream (stream-cons (car items) (list->stream (cdr items))))) (define (reverse-list->stream items) (list->stream (reverse items))) (define (get-list key1 key2) (let ((s (get key1 key2))) (if s s '()))) ; Operator table (define table (make-hash)) (define (put op type item) (hash-set! table (list op type) item)) (define (get op type) (hash-ref table (list op type) #f)) ; Stream Operations (define (interleave s1 s2) (if (stream-empty? s1) s2 (stream-cons (stream-first s1) (interleave s2 (stream-rest s1))))) (define (stream-flatmap proc s) (flatten-stream (stream-map proc s))) (define (flatten-stream stream) (if (stream-empty? stream) empty-stream (interleave (stream-first stream) (flatten-stream (stream-rest stream))))) (define (singleton-stream x) (stream-cons x empty-stream)) ; Query Syntax Procedures (define (type exp) (if (pair? exp) (car exp) (error "Unknown expression TYPE" exp))) (define (contents exp) (if (pair? exp) (cdr exp) (error "Unknown expression CONTENTS" exp))) (define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp))) (define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps)) (define (rule? statement) (tagged-list? statement 'rule)) (define (conclusion rule) (cadr rule)) (define (rule-body rule) (if (null? (cddr rule)) '(always-true) (caddr rule))) (define (query-syntax-process exp) (map-over-symbols expand-question-mark exp)) (define (map-over-symbols proc exp) (cond ((pair? exp) (cons (map-over-symbols proc (car exp)) (map-over-symbols proc (cdr exp)))) ((symbol? exp) (proc exp)) (else exp))) (define (expand-question-mark symbol) (let ((chars (symbol->string symbol))) (if (string=? (substring chars 0 1) "?") (list '? (string->symbol (substring chars 1 (string-length chars)))) symbol))) (define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp)) (define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var)))) (define (contract-question-mark variable) (string->symbol (string-append "?" (if (number? (cadr variable)) (string-append (symbol->string (caddr variable)) "-" (number->string (cadr variable))) (symbol->string (cadr variable)))))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ; Frames and Bindings (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-frame variable frame) (assoc variable frame)) (define (extend variable value frame) (cons (make-binding variable value) frame)) ; Reseting the state (define (reset-state!) (set! table (make-hash)) (set! rule-counter 0) (set! THE-ASSERTIONS '()) (set! THE-RULES '()) (put 'and 'qeval conjoin) (put 'or 'qeval disjoin) (put 'not 'qeval negate) (put 'lisp-value 'qeval lisp-value) (put 'always-true 'qeval always-true)) (reset-state!) ================================================ FILE: scheme/sicp/04/showcase/query/main.scm ================================================ (load "evaluator.scm") (query-driver-loop) ================================================ FILE: scheme/sicp/04/showcase/query/test-helpers.scm ================================================ (load-relative "evaluator.scm") (load-relative "database.scm") (define (matches-of query) (let ((processed-query (query-syntax-process query))) (stream->list (stream-map (lambda (frame) (instantiate-exp processed-query frame (lambda (v f) (contract-question-mark v)))) (qeval processed-query (singleton-stream '())))))) (define (matches? query) (not (null? (matches-of query)))) ================================================ FILE: scheme/sicp/04/showcase/query/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "test-helpers.scm") (define (stream . items) (if (null? items) empty-stream (stream-cons (car items) (apply stream (cdr items))))) (define (env items) (if (null? items) '() (cons (cons (list '? (caar items)) (cadar items)) (env (cdr items))))) (define evaluator-tests (test-suite "Tests for the query language" (test-suite "simple queries" (check-equal? (matches-of '(job ?x (computer programmer))) '((job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)))) (check-equal? (matches-of '(job ?x (computer ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)))) (check-equal? (matches-of '(job ?x (computer . ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)) (job (Reasoner Louis) (computer programmer trainee)))) (check-equal? (matches-of '(and (job ?person (computer programmer)) (address ?person ?where))) '((and (job (Hacker Alyssa P) (computer programmer)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))) (and (job (Fect Cy D) (computer programmer)) (address (Fect Cy D) (Cambridge (Ames Street) 3))))) (check-equal? (matches-of '(or (supervisor ?x (Bitdiddle Ben)) (supervisor ?x (Hacker Alyssa P)))) '((or (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Hacker Alyssa P) (Hacker Alyssa P))) (or (supervisor (Reasoner Louis) (Bitdiddle Ben)) (supervisor (Reasoner Louis) (Hacker Alyssa P))) (or (supervisor (Fect Cy D) (Bitdiddle Ben)) (supervisor (Fect Cy D) (Hacker Alyssa P))) (or (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (supervisor (Tweakit Lem E) (Hacker Alyssa P))))) (check-equal? (matches-of '(and (supervisor ?x (Bitdiddle Ben)) (not (job ?x (computer programmer))))) '((and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer)))))) (check-equal? (matches-of '(and (salary ?person ?amount) (lisp-value > ?amount 30000))) '((and (salary (Warbucks Oliver) 150000) (lisp-value > 150000 30000)) (and (salary (Bitdiddle Ben) 60000) (lisp-value > 60000 30000)) (and (salary (Hacker Alyssa P) 40000) (lisp-value > 40000 30000)) (and (salary (Fect Cy D) 35000) (lisp-value > 35000 30000)) (and (salary (Scrooge Eben) 75000) (lisp-value > 75000 30000))))) (test-suite "rules" (check-true (matches? '(same x x))) (check-true (matches? '(lives-near (Hacker Alyssa P) (Fect Cy D)))) (check-false (matches? '(lives-near (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(wheel (Warbucks Oliver)))) (check-true (matches? '(wheel (Bitdiddle Ben)))) (check-false (matches? '(wheel (Hacker Alyssa P)))) (check-true (matches? '(outranked-by (Bitdiddle Ben) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Hacker Alyssa P)))) (check-false (matches? '(outranked-by (Warbucks Oliver) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Eben Scrooge) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Bitdiddle Ben) (Eben Scrooge))))) (test-suite "logic as programs" (check-equal? (matches-of '(append-to-form (a b) (c d) ?z)) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form (a b) ?y (a b c d))) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form ?x ?y (a b c d))) '((append-to-form () (a b c d) (a b c d)) (append-to-form (a) (b c d) (a b c d)) (append-to-form (a b) (c d) (a b c d)) (append-to-form (a b c) (d) (a b c d)) (append-to-form (a b c d) () (a b c d))))) (test-suite "always true" (check-equal? (stream->list (qeval '(always-true) (singleton-stream '()))) '(()))) (test-suite "pattern matching" (check-equal? (pattern-match 'a 'a '()) '()) (check-equal? (pattern-match 'a 'b '()) 'failed) (check-equal? (pattern-match '(? x) 'a '()) (env '((x a)))) (check-equal? (pattern-match '(same (? x) (? x)) '(same a a) '()) (env '((x a)))) (check-equal? (pattern-match '(same (? x) (? x)) '(same a b) '()) 'failed) (check-equal? (pattern-match '(same (? x) a) '(same a a) (env '((x a)))) (env '((x a)))) (check-equal? (pattern-match '(? x) '(f b) (env '((x (f (? y)))))) (env '((y b) (x (f (? y)))))) (check-equal? (pattern-match '(? x) '(f b) (env '((x (f (? y))) (y b)))) (env '((x (f (? y))) (y b)))) (check-equal? (pattern-match '(? x) '(f b) (env '((x (f (? y))) (y c)))) 'failed)) (test-suite "rename variables" (before (reset-state!) (check-equal? (rename-variables-in '(same (? x) (? y))) '(same (? 1 x) (? 1 y))))) (test-suite "depends-on?" (check-false (depends-on? '(same (? x)) '(? y) '())) (check-true (depends-on? '(same (? x)) '(? x) '())) (check-true (depends-on? '(same (? x)) '(? y) (env '((x (? y))))))) (test-suite "unification" (check-equal? (unify-match 'a 'a '()) '()) (check-equal? (unify-match 'a 'b '()) 'failed) (check-equal? (unify-match '(? x) '(? y) '()) (env '((x (? y))))) (check-equal? (unify-match '(same (? x) b) '(same a (? y)) '()) (env '((y b) (x a)))) (check-equal? (unify-match '((? x) (? x)) '((? y) (? y)) '()) (env '((x (? y))))) (check-equal? (unify-match '(same (person (? a)) (? b)) '(same (? c) (? c)) (env '((b (person smith))))) (env '((a smith) (c (person (? a))) (b (person smith)))))) (test-suite "adding to the database" (test-case "adding an assertion" (reset-state!) (add-assertion! '(father luke anakin)) (check-equal? (stream->list (get-all-assertions)) '((father luke anakin)))) (test-case "indexing assertions" (reset-state!) (add-assertion! '(father luke anakin)) (add-assertion! '(son anakin luke)) (check-equal? (stream->list (fetch-assertions '(son (? x) (? x)) '())) '((son anakin luke))) (check-equal? (stream->list (fetch-assertions '(father (? x) (? x)) '())) '((father luke anakin)))) (test-case "adding a rule" (reset-state!) (add-rule! '(rule (same (? x) (? x)))) (check-equal? (stream->list (get-all-rules)) '((rule (same (? x) (? x)))))) (test-case "indexing rules" (reset-state!) (add-rule! '(rule (same (? x) (? x)))) (add-rule! '(rule (two (? x) (? y)))) (add-rule! '(rule ((? x) might-be (? y)))) (check-equal? (stream->list (fetch-rules '(same a a) '())) '((rule (same (? x) (? x))) (rule ((? x) might-be (? y))))) (check-equal? (stream->list (fetch-rules '((? x) a a) '())) '((rule (same (? x) (? x))) (rule (two (? x) (? y))) (rule ((? x) might-be (? y))))))) (test-suite "query-syntax-process" (check-equal? (query-syntax-process '?a) '(? a)) (check-equal? (query-syntax-process '(?a ?b)) '((? a) (? b))) (check-equal? (query-syntax-process '(a (b ?c) ?d)) '(a (b (? c)) (? d)))) (test-suite "make-new-variable" (check-equal? (make-new-variable '(? x) 1) '(? 1 x))) (test-suite "contract-question-mark" (check-equal? (contract-question-mark '(? x)) '?x) (check-equal? (contract-question-mark '(? 1 x)) '?x-1)) (test-suite "stream operations" (check-equal? (stream->list (interleave (stream 1 3 5 7 9) (stream 2 4 6 8 10))) '(1 2 3 4 5 6 7 8 9 10)) (check-equal? (stream->list (stream-flatmap (lambda (n) (stream (* n 10) (+ (* n 10) 5))) (stream 1 2 3 4 5))) '(10 20 15 30 25 40 35 50 45 55)) (check-equal? (stream->list (singleton-stream 1)) '(1))) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/04/tests/01-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../01.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.01-tests (test-suite "Tests for SICP exercise 4.01" (test-case "Left-to-right evaluation" (set-evaluation-order! 'left-to-right) (check-equal? (run '(begin (define x 1) (cons (set! x 2) (set! x 3)) x)) 3)) (test-case "Right-to-left evaluation" (set-evaluation-order! 'right-to-left) (check-equal? (run '(begin (define x 1) (cons (set! x 2) (set! x 3)) x)) 2)) )) (run-tests sicp-4.01-tests) ================================================ FILE: scheme/sicp/04/tests/02-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../02.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.02-tests (test-suite "Tests for SICP exercise 4.02" (check-equal? (run '(begin (define (factorial n) (if (call = n 1) 1 (call * n (call factorial (call - n 1))))) (call factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (call = n 0) result (call iter (call - n 1) (call * result n)))) (call iter n 1)) (call factorial 5))) 120) )) (run-tests sicp-4.02-tests) ================================================ FILE: scheme/sicp/04/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../03.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.03-tests (test-suite "Tests for SICP exercise 4.03" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests sicp-4.03-tests) ================================================ FILE: scheme/sicp/04/tests/04-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../04.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.04-tests (test-suite "Tests for SICP exercise 4.04" (test-case "And with evaluation procedures" (set-logical-operations-implementation! 'syntax-procedures) (check-equal? (run '(and)) true) (check-equal? (run '(and false)) false) (check-equal? (run '(and false false)) false) (check-equal? (run '(and 1)) 1) (check-equal? (run '(and 1 2)) 2) (check-equal? (run '(and false (fail))) false) (check-equal? (run '(begin (define (x) 2) (and 1 (x)))) 2)) (test-case "And as a derived form" (set-logical-operations-implementation! 'derived-forms) (check-equal? (run '(and)) true) (check-equal? (run '(and false)) false) (check-equal? (run '(and false false)) false) (check-equal? (run '(and 1)) 1) (check-equal? (run '(and 1 2)) 2) (check-equal? (run '(and false (fail))) false) (check-equal? (run '(begin (define (x) 2) (and 1 (x)))) 2)) (test-case "Or with evaluation procedures" (set-logical-operations-implementation! 'syntax-procedures) (check-equal? (run '(or)) false) (check-equal? (run '(or false)) false) (check-equal? (run '(or false false)) false) (check-equal? (run '(or 1)) 1) (check-equal? (run '(or 1 2)) 1) (check-equal? (run '(or 1 (fail))) 1) (check-equal? (run '(or false 2)) 2) (check-equal? (run '(begin (define (x) false) (or (x) 1))) 1)) (test-case "Or as a derived form" (set-logical-operations-implementation! 'derived-forms) (check-equal? (run '(or)) false) (check-equal? (run '(or false)) false) (check-equal? (run '(or false false)) false) (check-equal? (run '(or 1)) true) (check-equal? (run '(or 1 2)) true) (check-equal? (run '(or 1 (fail))) true) (check-equal? (run '(or false 2)) true) (check-equal? (run '(begin (define (x) false) (or (x) 1))) true)) )) (run-tests sicp-4.04-tests) ================================================ FILE: scheme/sicp/04/tests/05-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../05.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.05-tests (test-suite "Tests for SICP exercise 4.05" (check-equal? (run '(begin (define (assoc key items) (cond ((null? items) false) ((eq? key (car (car items))) (car items)) (else (assoc key (cdr items))))) (define (cadr x) (car (cdr x))) (cond ((assoc 'b '((a 1) (b 2))) => cadr) (else false)))) 2) (check-equal? (run '(begin (define (assoc key items) (cond ((null? items) false) ((eq? key (car (car items))) (car items)) (else (assoc key (cdr items))))) (define (cadr x) (car (cdr x))) (cond ((assoc 'c '((a 1) (b 2))) => cadr) (else 3)))) 3) )) (run-tests sicp-4.05-tests) ================================================ FILE: scheme/sicp/04/tests/06-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../06.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.06-tests (test-suite "Tests for SICP exercise 4.06" (check-equal? (run '(let ((x 1)) x)) 1) (check-equal? (run '(let ((a 1) (b 2)) (+ a b))) 3) (check-equal? (run '(let ((a 1) (b 2)) a b)) 2) (check-equal? (run '(begin (define a 1) (let ((b 2) (c 3)) (+ a b c)))) 6) )) (run-tests sicp-4.06-tests) ================================================ FILE: scheme/sicp/04/tests/07-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../07.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.07-tests (test-suite "Tests for SICP exercise 4.07" (check-equal? (run '(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z))) 39) )) (run-tests sicp-4.07-tests) ================================================ FILE: scheme/sicp/04/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../08.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.08-tests (test-suite "Tests for SICP exercise 4.08" (check-equal? (run '(let ((x 1)) x)) 1) (check-equal? (run '(let ((a 1) (b 2)) (+ a b))) 3) (check-equal? (run '(let ((a 1) (b 2)) a b)) 2) (check-equal? (run '(begin (define a 1) (let ((b 2) (c 3)) (+ a b c)))) 6) (check-equal? (run '(begin (define (fib n) (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) (fib 12))) 144) )) (run-tests sicp-4.08-tests) ================================================ FILE: scheme/sicp/04/tests/09-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../09.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.09-tests (test-suite "Tests for SICP exercise 4.09" (test-suite "For" (check-equal? (run '(begin (define sum 0) (for x '(1 2 3 4 5) (set! sum (+ sum x))) sum)) 15) (check-equal? (run '(begin (define sum 0) (for x '(1 2 3 4 5) (set! sum (+ sum x)) (set! sum (+ sum x))) sum)) 30)) (test-suite "While" (check-equal? (run '(begin (define sum 0) (define n 1) (while (< n 10) (set! sum (+ sum n)) (set! n (+ n 1))) sum)) 45)) (test-suite "Until" (check-equal? (run '(begin (define sum 0) (define n 1) (until (= n 10) (set! sum (+ sum n)) (set! n (+ n 1))) sum)) 45)) )) (run-tests sicp-4.09-tests) ================================================ FILE: scheme/sicp/04/tests/10-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../10.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.10-tests (test-suite "Tests for SICP exercise 4.10" (check-true (ends-with? 'foo: ':)) (check-true (ends-with? 'foo:= ':=)) (check-true (ends-with? 'foo= '=)) (check-false (ends-with? 'foo ':)) (check-false (ends-with? 'a ':=)) (check-equal? (strip-suffix 'foo: ':) 'foo) (check-equal? (strip-suffix 'foo:= ':=) 'foo) (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(do 1 2)) 2)) (test-suite "Define" (check-equal? (run '(x:= 1)) 'ok) (check-equal? (run '(do (x:= 1) x)) 1) (check-equal? (run '(x: () 1)) 'ok) (check-equal? (run '(do (x: () 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(do (x:= 1) (x= 2))) 'ok) (check-equal? (run '(do (x:= 1) (x= 2) x)) 2)) (test-suite "If" (check-equal? (run '(? true 1 2)) 1) (check-equal? (run '(? false 1 2)) 2) (check-equal? (run '(? true 1)) 1) (check-equal? (run '(? false 1)) false)) (test-suite "Lambda" (check-equal? (run '((() => 1))) 1) (check-equal? (run '(((x) => x) 1)) 1) (check-equal? (run '(((a b) => (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(do (a:= 1) (b:= 2) (((a) => (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(switch (true 1))) 1) (check-equal? (run '(switch (false 1) (true 2))) 2) (check-equal? (run '(switch (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(switch (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(do (a: () 1) (a))) 1) (check-equal? (run '(do (pair: (a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(do (a:= 1) (pair: (b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(do (append: (x y) (? (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(do (factorial: (n) (? (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(do (factorial: (n) (iter: (n result) (? (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests sicp-4.10-tests) ================================================ FILE: scheme/sicp/04/tests/11-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../11.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.11-tests (test-suite "Tests for SICP exercise 4.11" (check-equal? (make-frame '(a b c) '(1 2 3)) '(frame (a . 1) (b . 2) (c . 3))) (check-equal? (frame-variables (make-frame '(a b c) '(1 2 3))) '(a b c)) (check-equal? (frame-values (make-frame '(a b c) '(1 2 3))) '(1 2 3)) (check-equal? (extend-environment '(a b) '(1 2) (extend-environment '(a c) '(3 4) the-empty-environment)) '((frame (a . 1) (b . 2)) (frame (a . 3) (c . 4)))) (check-equal? (lookup-variable-value 'a (extend-environment '(a) '(1) the-empty-environment)) 1) (check-equal? (lookup-variable-value 'a (extend-environment '(b) '(1) (extend-environment '(a) '(2) the-empty-environment))) 2) (check-equal? (lookup-variable-value 'b (extend-environment '(a b) '(1 2) the-empty-environment)) 2) (check-equal? (lookup-variable-value 'c (extend-environment '(a b) '(1 2) (extend-environment '(a c) '(3 4) the-empty-environment))) 4) (check-equal? (lookup-variable-value 'a (extend-environment '(a b) '(1 2) (extend-environment '(a c) '(3 4) the-empty-environment))) 1) (test-begin (define frame (make-frame '(a b) '(1 2))) (add-binding-to-frame! 'c 3 frame) (check-equal? frame '(frame (c . 3) (a . 1) (b . 2)))) (test-begin (define env (extend-environment '(a b) '(1 2) the-empty-environment)) (set-variable-value! 'b 3 env) (check-equal? (lookup-variable-value 'b env) 3)) (test-begin (define env (extend-environment '(a b) '(1 2) (extend-environment '(a c) '(3 4) the-empty-environment))) (set-variable-value! 'c 5 env) (check-equal? env '((frame (a . 1) (b . 2)) (frame (a . 3) (c . 5))))) (test-begin (define env (extend-environment '(a b) '(1 2) the-empty-environment)) (define-variable! 'c 3 env) (check-equal? env '((frame (c . 3) (a . 1) (b . 2))))) (test-begin (define env (extend-environment '(a b) '(1 2) the-empty-environment)) (define-variable! 'b 3 env) (check-equal? env '((frame (a . 1) (b . 3))))) )) (run-tests sicp-4.11-tests) ================================================ FILE: scheme/sicp/04/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../12.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.12-tests (test-suite "Tests for SICP exercise 4.12" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests sicp-4.12-tests) ================================================ FILE: scheme/sicp/04/tests/13-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../13.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.13-tests (test-suite "Tests for SICP exercise 4.13" (check-exn (regexp "Unbound variable x") (lambda () (run '(begin (define x 10) (make-unbound! x) x)))) (check-exn (regexp "Cannot unbind a variable that is not declared in the current frame x") (lambda () (run '(begin (define x 10) ((lambda () (make-unbound! x))))))) )) (run-tests sicp-4.13-tests) ================================================ FILE: scheme/sicp/04/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../16.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.16-tests (test-suite "Tests for SICP exercise 4.16" (check-exn (regexp "Unassigned variable x") (lambda () (run '(begin (define x '*unassigned*) x)))) (check-equal? (scan-out-defines '((* x x))) '((* x x))) (check-equal? (scan-out-defines '((define x 1) (+ x 2))) '((let ((x '*unassigned*)) (set! x 1) (+ x 2)))) (check-equal? (scan-out-defines '((define x 1) (define y 2) (+ x y 3))) '((let ((x '*unassigned*) (y '*unassigned*)) (set! x 1) (set! y 2) (+ x y 3)))) (check-equal? '(#t #f) (run '(begin (define (f x) (list (even? x) (odd? x)) (define (even? n) (if (= n 0) true (odd? (- n 1)))) (define (odd? n) (if (= n 0) false (even? (- n 1))))) (f 4)))) )) (run-tests sicp-4.16-tests) ================================================ FILE: scheme/sicp/04/tests/20-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../20.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.20-tests (test-suite "Tests for SICP exercise 4.20" (check-equal? (letrec->combination '(letrec ((a 1) (b 2)) (+ a b))) '(let ((a '*unassigned*) (b '*unassigned*)) (set! a 1) (set! b 2) (+ a b))) (check-equal? '(#t #f) (run '(begin (define (f x) (letrec ((even? (lambda (n) (if (= n 0) true (odd? (- n 1))))) (odd? (lambda (n) (if (= n 0) false (even? (- n 1)))))) (list (odd? x) (even? x)))) (f 3)))) (check-equal? 3628800 (run '(letrec ((fact (lambda (n) (if (= n 1) 1 (* n (fact (- n 1))))))) (fact 10)))) )) (run-tests sicp-4.20-tests) ================================================ FILE: scheme/sicp/04/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../21.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.21-tests (test-suite "Tests for SICP exercise 4.21" (check-equal? 3628800 (run '((lambda (n) ((lambda (fact) (fact fact n)) (lambda (ft k) (if (= k 1) 1 (* k (ft ft (- k 1))))))) 10))) (check-equal? (y-fibonacci 3) 2) (check-equal? (y-fibonacci 4) 3) (check-equal? (y-fibonacci 5) 5) (check-equal? (y-fibonacci 6) 8) (check-equal? (y-fibonacci 7) 13) (check-true (f 0)) (check-false (f 1)) (check-true (f 2)) (check-false (f 3)) (check-true (f 4)) (check-false (f 5)) )) (run-tests sicp-4.21-tests) ================================================ FILE: scheme/sicp/04/tests/22-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../22.scm") (define (run exp) (evaluate exp (setup-environment))) (define sicp-4.22-tests (test-suite "Tests for SICP exercise 4.22" (check-equal? (run '(let ((x 1)) x)) 1) (check-equal? (run '(let ((a 1) (b 2)) (+ a b))) 3) (check-equal? (run '(let ((a 1) (b 2)) a b)) 2) (check-equal? (run '(begin (define a 1) (let ((b 2) (c 3)) (+ a b c)))) 6) )) (run-tests sicp-4.22-tests) ================================================ FILE: scheme/sicp/04/tests/31-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../31.scm") (define (run exp) (actual-value exp (setup-environment))) (define sicp-4.31-tests (test-suite "Tests for SICP exercise 4.31" (test-suite "Lazy evaluation" (check-equal? 1 (run '(begin (define (try a (b lazy)) (if (= a 0) 1 b)) (try 0 (/ 1 0))))) (check-equal? 2 (run '(begin (define counter 0) (define (square (x lazy)) (* x x)) (define (two) (set! counter (+ 1 counter)) 2) (square (two)) counter))) (check-equal? 1 (run '(begin (define counter 0) (define (square (x lazy-memo)) (* x x)) (define (two) (set! counter (+ 1 counter)) 2) (square (two)) counter))) (check-equal? 1 (run '(begin (define (unless (condition lazy) (on-fail lazy) (on-success lazy)) (if condition on-success on-fail)) (unless (= 0 0) (/ 1 0) 1)))) ) (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Variables" (check-equal? (evaluate 'x (extend-environment '(x) '(1) the-empty-environment)) 1) (check-exn exn? (lambda () (evaluate 'x the-empty-environment)))) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests sicp-4.31-tests) ================================================ FILE: scheme/sicp/04/tests/33-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../33.scm") (define (run exp) (actual-value exp (setup-environment))) (define sicp-4.33-tests (test-suite "Tests for SICP exercise 4.33" (check-true (run '(null? '()))) (check-true (run '(null? (cdr '(a))))) (check-true (run '(null? (car '(() a))))) (check-equal? 'a (run '(car '(a b c)))) (check-equal? 'c (run '(car (cdr (car (cdr '(a (b c)))))))) (check-equal? '() (run '(car '(() a)))) (check-equal? '() (run '(cdr (cdr '(() a))))) )) (run-tests sicp-4.33-tests) ================================================ FILE: scheme/sicp/04/tests/34-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../34.scm") (define (run exp) (actual-value exp (setup-environment))) (define (to-s exp) (with-output-to-string (lambda () (run `(begin (define result ,exp) (print result)))))) (define sicp-4.34-tests (test-suite "Tests for SICP exercise 4.34" (check-equal? (to-s ''()) "()") (check-equal? (to-s ''(() a)) "(() a)") (check-equal? (to-s ''(a b c)) "(a b c)") (check-equal? (to-s ''(a (b c) d)) "(a (b c) d)") (check-equal? (to-s ''(a . b)) "(a . b)") (check-equal? (to-s '(begin (define pair (cons 'a pair)) pair)) "(a (...))") (check-equal? (to-s '(begin (define pair (cons 'a (cons pair 'b))) pair)) "(a (...) . b)" ) (check-equal? (to-s '(begin (define pair (cons 'a (cons pair (cons 'b '())))) pair)) "(a (...) b)") )) (run-tests sicp-4.34-tests) ================================================ FILE: scheme/sicp/04/tests/35-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../35.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.35-tests (test-suite "Tests for SICP exercise 4.35" (check-equal? (all-values '(begin (a-pythagorean-triple-between 2 10))) '((3 4 5) (6 8 10))) )) (run-tests sicp-4.35-tests) ================================================ FILE: scheme/sicp/04/tests/36-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../36.scm") (define (first-n-values n exp) (define (take n results) (if (= n 0) '() (cons (car results) (take (- n 1) (force (cdr results)))))) (take n (ambeval exp solution-environment (lambda (value fail) (cons value (delay (fail)))) (lambda () '())))) (define sicp-4.36-tests (test-suite "Tests for SICP exercise 4.36" (check-equal? (first-n-values 5 '(a-pythagorean-triple)) '((3 4 5) (6 8 10) (5 12 13) (9 12 15) (8 15 17))) )) (run-tests sicp-4.36-tests) ================================================ FILE: scheme/sicp/04/tests/38-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../38.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.38-tests (test-suite "Tests for SICP exercise 4.38" (check-equal? (all-values '(multiple-dwelling)) '(((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3)) ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3)) ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) ((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1)))) )) (run-tests sicp-4.38-tests) ================================================ FILE: scheme/sicp/04/tests/41-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../41.scm") (define sicp-4.41-tests (test-suite "Tests for SICP exercise 4.41" (check-equal? (multiple-dwellings) '(((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)))) )) (run-tests sicp-4.41-tests) ================================================ FILE: scheme/sicp/04/tests/42-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../42.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.42-tests (test-suite "Tests for SICP exercise 4.42" (check-equal? (all-values '(lairs)) '(((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4)))) )) (run-tests sicp-4.42-tests) ================================================ FILE: scheme/sicp/04/tests/43-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../43.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.43-tests (test-suite "Tests for SICP exercise 4.43" (check-equal? (all-values '(yachts-and-daughters true)) '(downing)) (check-equal? (all-values '(yachts-and-daughters false)) '(parker downing)) )) (run-tests sicp-4.43-tests) ================================================ FILE: scheme/sicp/04/tests/44-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../44.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.44-tests (test-suite "Tests for SICP exercise 4.44" (check-equal? (length (all-values '(queens 8))) 92) (check member '(4 2 8 5 7 1 3 6) (all-values '(queens 8))) )) (run-tests sicp-4.44-tests) ================================================ FILE: scheme/sicp/04/tests/45-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../45.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.45-tests (test-suite "Tests for SICP exercise 4.45" (check-equal? (all-values '(parse '(the professor lectures to the student in the class with the cat))) '((sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))) (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))) (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))))))) )) (run-tests sicp-4.45-tests) ================================================ FILE: scheme/sicp/04/tests/48-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../48.scm") (define (all-values exp) (ambeval exp solution-environment (lambda (value fail) (cons value (fail))) (lambda () '()))) (define (parses? exp) (not (null? (all-values `(parse (quote ,exp)))))) (define sicp-4.48-tests (test-suite "Tests for SICP exercise 4.48" (check-true (parses? '(the cat sleeps quietly))) (check-true (parses? '(the brown cat sleeps))) (check-true (parses? '(the quick brown cat sleeps))) (check-true (parses? '(the quick brown cat sleeps in the class))) (check-true (parses? '(the quick brown cat sleeps in the class quietly))) )) (run-tests sicp-4.48-tests) ================================================ FILE: scheme/sicp/04/tests/49-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../49.scm") (define (first-n-values n exp) (define (take n results) (if (= n 0) '() (cons (car results) (take (- n 1) (force (cdr results)))))) (take n (ambeval exp solution-environment (lambda (value fail) (cons value (delay (fail)))) (lambda () '())))) (define sicp-4.49-tests (test-suite "Tests for SICP exercise 4.49" (check-equal? (first-n-values 6 '(terminals (generate-sentence))) '((the student studies) (the student studies for the student) (the student studies for the student for the student) (the student studies for the student for the student for the student) (the student studies for the student for the student for the student for the student) (the student studies for the student for the student for the student for the student for the student))) )) (run-tests sicp-4.49-tests) ================================================ FILE: scheme/sicp/04/tests/51-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../51.scm") (define (all-values exp) (ambeval exp (setup-environment) (lambda (value fail) (cons value (fail))) (lambda () '()))) (define sicp-4.51-tests (test-suite "Tests for SICP exercise 4.51" (check-equal? (all-values '(begin (define count 0) (let ((x (an-element-of '(a b c))) (y (an-element-of '(a b c)))) (permanent-set! count (+ count 1)) (require (not (eq? x y))) (list x y count)))) '((a b 2) (a c 3) (b a 4) (b c 6) (c a 7) (c b 8))) )) (run-tests sicp-4.51-tests) ================================================ FILE: scheme/sicp/04/tests/52-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../52.scm") (define (first-value exp) (ambeval exp (setup-environment) (lambda (value fail) value) (lambda () '()))) (define sicp-4.52-tests (test-suite "Tests for SICP exercise 4.52" (check-equal? (first-value '(if-fail (let ((x (an-element-of '(1 3 5)))) (require (even? x)) x) 'all-odd)) 'all-odd) (check-equal? (first-value '(if-fail (let ((x (an-element-of '(1 3 5 8)))) (require (even? x)) x) 'all-odd)) 8) )) (run-tests sicp-4.52-tests) ================================================ FILE: scheme/sicp/04/tests/53-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../53.scm") (define (first-value exp) (ambeval exp (setup-environment) (lambda (value fail) value) (lambda () '()))) (define sicp-4.53-tests (test-suite "Tests for SICP exercise 4.53" (check-equal? (first-value '(begin (define (prime-sum-pair list1 list2) (let ((a (an-element-of list1)) (b (an-element-of list2))) (require (prime? (+ a b))) (list a b))) (let ((pairs '())) (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110)))) (permanent-set! pairs (cons p pairs)) (amb)) pairs)))) '((8 35) (3 110) (3 20))) )) (run-tests sicp-4.53-tests) ================================================ FILE: scheme/sicp/04/tests/54-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../54.scm") (define (first-value exp) (ambeval exp (setup-environment) (lambda (value fail) value) (lambda () '()))) (define sicp-4.54-tests (test-suite "Tests for SICP exercise 4.54" (check-equal? (first-value '(begin (define (prime-sum-pair list1 list2) (let ((a (an-element-of list1)) (b (an-element-of list2))) (require (prime? (+ a b))) (list a b))) (let ((pairs '())) (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110)))) (permanent-set! pairs (cons p pairs)) (amb)) pairs)))) '((8 35) (3 110) (3 20))) )) (run-tests sicp-4.54-tests) ================================================ FILE: scheme/sicp/04/tests/55-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../55.scm") (load "helpers/query.scm") (define sicp-4.55-tests (test-suite "Tests for SICP exercise 4.55" (check-equal? (matches-of query-a) '((supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Fect Cy D) (Bitdiddle Ben)) (supervisor (Tweakit Lem E) (Bitdiddle Ben)))) (check-equal? (matches-of query-b) '((job (Scrooge Eben) (accounting chief accountant)) (job (Cratchet Robert) (accounting scrivener)))) (check-equal? (matches-of query-c) '((address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)) (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)) (address (Aull DeWitt) (Slumerville (Onion Square) 5)))) )) (run-tests sicp-4.55-tests) ================================================ FILE: scheme/sicp/04/tests/56-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../56.scm") (load "helpers/query.scm") (define sicp-4.56-tests (test-suite "Tests for SICP exercise 4.56" (check-equal? (matches-of query-a) '((and (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)) (supervisor (Hacker Alyssa P) (Bitdiddle Ben))) (and (address (Fect Cy D) (Cambridge (Ames Street) 3)) (supervisor (Fect Cy D) (Bitdiddle Ben))) (and (address (Tweakit Lem E) (Boston (Bay State Road) 22)) (supervisor (Tweakit Lem E) (Bitdiddle Ben))))) (check-equal? (matches-of query-b) '((and (salary (Hacker Alyssa P) 40000) (salary (Bitdiddle Ben) 60000) (lisp-value < 40000 60000)) (and (salary (Fect Cy D) 35000) (salary (Bitdiddle Ben) 60000) (lisp-value < 35000 60000)) (and (salary (Tweakit Lem E) 25000) (salary (Bitdiddle Ben) 60000) (lisp-value < 25000 60000)) (and (salary (Reasoner Louis) 30000) (salary (Bitdiddle Ben) 60000) (lisp-value < 30000 60000)) (and (salary (Cratchet Robert) 18000) (salary (Bitdiddle Ben) 60000) (lisp-value < 18000 60000)) (and (salary (Aull DeWitt) 25000) (salary (Bitdiddle Ben) 60000) (lisp-value < 25000 60000)))) (check-equal? (matches-of query-c) '((and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?title)))) (and (supervisor (Scrooge Eben) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?title)))) (and (supervisor (Cratchet Robert) (Scrooge Eben)) (not (job (Scrooge Eben) (computer . ?title)))) (and (supervisor (Aull DeWitt) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?title)))))) )) (run-tests sicp-4.56-tests) ================================================ FILE: scheme/sicp/04/tests/57-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../57.scm") (define sicp-4.57-tests (test-suite "Tests for SICP exercise 4.57" (check-equal? (matches-of query-a) '((can-replace (Bitdiddle Ben) (Fect Cy D)))) (check-equal? (matches-of query-b) '((and (can-replace (Aull DeWitt) (Warbucks Oliver)) (salary (Aull DeWitt) 25000) (salary (Warbucks Oliver) 150000) (lisp-value < 25000 150000)))) )) (run-tests sicp-4.57-tests) ================================================ FILE: scheme/sicp/04/tests/58-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../58.scm") (define sicp-4.58-tests (test-suite "Tests for SICP exercise 4.58" (check-equal? (matches-of '(big-shot ?person)) '((big-shot (Warbucks Oliver)) (big-shot (Bitdiddle Ben)) (big-shot (Scrooge Eben)))) )) (run-tests sicp-4.58-tests) ================================================ FILE: scheme/sicp/04/tests/59-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../59.scm") (define sicp-4.59-tests (test-suite "Tests for SICP exercise 4.59" (check-equal? (matches-of bens-query) '((meeting administration (Friday 1pm)))) (check-equal? (matches-of alyssas-query) '((meeting-time (Hacker Alyssa P) (Wednesday 3pm)) (meeting-time (Hacker Alyssa P) (Wednesday 4pm)))) )) (run-tests sicp-4.59-tests) ================================================ FILE: scheme/sicp/04/tests/60-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../60.scm") (define sicp-4.60-tests (test-suite "Tests for SICP exercise 4.60" (check-equal? (matches-of '(ordered-neighbour-pair ?person-1 ?person-2)) '((ordered-neighbour-pair (Bitdiddle Ben) (Reasoner Louis)) (ordered-neighbour-pair (Fect Cy D) (Hacker Alyssa P)) (ordered-neighbour-pair (Aull DeWitt) (Bitdiddle Ben)) (ordered-neighbour-pair (Aull DeWitt) (Reasoner Louis)))) )) (run-tests sicp-4.60-tests) ================================================ FILE: scheme/sicp/04/tests/61-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../61.scm") (define sicp-4.61-tests (test-suite "Tests for SICP exercise 4.61" (check-equal? (matches-of query-1) response-1) (check-equal? (matches-of query-2) response-2) )) (run-tests sicp-4.61-tests) ================================================ FILE: scheme/sicp/04/tests/62-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../62.scm") (define sicp-4.62-tests (test-suite "Tests for SICP exercise 4.62" (check-equal? (matches-of '(last-pair (3) ?x)) '((last-pair (3) (3)))) (check-equal? (matches-of '(last-pair (1 2 3) ?x)) '((last-pair (1 2 3) (3)))) (check-equal? (matches-of '(last-pair (2 ?x) (3))) '((last-pair (2 3) (3)))) )) (run-tests sicp-4.62-tests) ================================================ FILE: scheme/sicp/04/tests/63-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../63.scm") (define sicp-4.63-tests (test-suite "Tests for SICP exercise 4.63" (check-equal? (matches-of grandson-of-cain) '((grandson Cain Irad))) (check-equal? (matches-of sons-of-lamech) '((son Lamech Jabal) (son Lamech Jubal))) (check-equal? (matches-of grandsons-of-methushael) '((grandson Methushael Jabal) (grandson Methushael Jubal))) )) (run-tests sicp-4.63-tests) ================================================ FILE: scheme/sicp/04/tests/67-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../67.scm") (load-relative "../showcase/query/database.scm") (define (matches-of query) (let ((processed-query (query-syntax-process query))) (stream->list (stream-map (lambda (frame) (instantiate-exp processed-query frame (lambda (v f) (contract-question-mark v)))) (qeval processed-query (singleton-stream '()) '()))))) (define (matches? query) (not (null? (matches-of query)))) (define sicp-4.67-tests (test-suite "Tests for SICP exercise 4.67" (add-to-data-base! loopy-rules) (test-suite "loopy rules" (check-equal? (matches-of '(loopy-outranked-by (Bitdiddle Ben) ?who)) '((loopy-outranked-by (Bitdiddle Ben) (Warbucks Oliver)))) (check-equal? (matches-of '(married Mickey ?who)) '((married Mickey Minnie)))) (test-suite "simple queries" (check-equal? (matches-of '(job ?x (computer programmer))) '((job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)))) (check-equal? (matches-of '(job ?x (computer ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)))) (check-equal? (matches-of '(job ?x (computer . ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)) (job (Reasoner Louis) (computer programmer trainee)))) (check-equal? (matches-of '(and (job ?person (computer programmer)) (address ?person ?where))) '((and (job (Hacker Alyssa P) (computer programmer)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))) (and (job (Fect Cy D) (computer programmer)) (address (Fect Cy D) (Cambridge (Ames Street) 3))))) (check-equal? (matches-of '(or (supervisor ?x (Bitdiddle Ben)) (supervisor ?x (Hacker Alyssa P)))) '((or (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Hacker Alyssa P) (Hacker Alyssa P))) (or (supervisor (Reasoner Louis) (Bitdiddle Ben)) (supervisor (Reasoner Louis) (Hacker Alyssa P))) (or (supervisor (Fect Cy D) (Bitdiddle Ben)) (supervisor (Fect Cy D) (Hacker Alyssa P))) (or (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (supervisor (Tweakit Lem E) (Hacker Alyssa P))))) (check-equal? (matches-of '(and (supervisor ?x (Bitdiddle Ben)) (not (job ?x (computer programmer))))) '((and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer)))))) (check-equal? (matches-of '(and (salary ?person ?amount) (lisp-value > ?amount 30000))) '((and (salary (Warbucks Oliver) 150000) (lisp-value > 150000 30000)) (and (salary (Bitdiddle Ben) 60000) (lisp-value > 60000 30000)) (and (salary (Hacker Alyssa P) 40000) (lisp-value > 40000 30000)) (and (salary (Fect Cy D) 35000) (lisp-value > 35000 30000)) (and (salary (Scrooge Eben) 75000) (lisp-value > 75000 30000))))) (test-suite "rules" (check-true (matches? '(same x x))) (check-true (matches? '(lives-near (Hacker Alyssa P) (Fect Cy D)))) (check-false (matches? '(lives-near (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(wheel (Warbucks Oliver)))) (check-true (matches? '(wheel (Bitdiddle Ben)))) (check-false (matches? '(wheel (Hacker Alyssa P)))) (check-true (matches? '(outranked-by (Bitdiddle Ben) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Hacker Alyssa P)))) (check-false (matches? '(outranked-by (Warbucks Oliver) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Eben Scrooge) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Bitdiddle Ben) (Eben Scrooge))))) (test-suite "logic as programs" (check-equal? (matches-of '(append-to-form (a b) (c d) ?z)) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form (a b) ?y (a b c d))) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form ?x ?y (a b c d))) '((append-to-form () (a b c d) (a b c d)) (append-to-form (a) (b c d) (a b c d)) (append-to-form (a b) (c d) (a b c d)) (append-to-form (a b c) (d) (a b c d)) (append-to-form (a b c d) () (a b c d))))) )) (run-tests sicp-4.67-tests) ================================================ FILE: scheme/sicp/04/tests/68-tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "helpers/query.scm") (load "../68.scm") (define sicp-4.68-tests (test-suite "Tests for SICP exercise 4.68" (check-equal? (matches-of '(reverse (1 2 3) ?x)) '((reverse (1 2 3) (3 2 1)))) )) (run-tests sicp-4.68-tests) ================================================ FILE: scheme/sicp/04/tests/69-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../69.scm") (define (matches-of query) (let ((processed-query (query-syntax-process query))) (stream->list (stream-map (lambda (frame) (instantiate-exp processed-query frame (lambda (v f) (contract-question-mark v)))) (qeval processed-query (singleton-stream '()) '()))))) (define sicp-4.69-tests (test-suite "Tests for SICP exercise 4.69" (check-equal? (matches-of '((great grandson) ?g ?ggs)) '(((great grandson) Adam Irad) ((great grandson) Cain Mehujael) ((great grandson) Enoch Methushael) ((great grandson) Irad Lamech) ((great grandson) Mehujael Jabal) ((great grandson) Mehujael Jubal))) (check-equal? (matches-of '(?relationship Adam Irad)) '(((great grandson) Adam Irad))) )) (run-tests sicp-4.69-tests) ================================================ FILE: scheme/sicp/04/tests/75-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../75.scm") (define sicp-4.75-tests (test-suite "Tests for SICP exercise 4.75" (check-equal? (matches-of '(unique (job ?x (computer wizard)))) '((unique (job (Bitdiddle Ben) (computer wizard))))) (check-equal? (matches-of '(and (job ?x ?j) (unique (job ?anyone ?j)))) '((and (job (Warbucks Oliver) (administration big wheel)) (unique (job (Warbucks Oliver) (administration big wheel)))) (and (job (Bitdiddle Ben) (computer wizard)) (unique (job (Bitdiddle Ben) (computer wizard)))) (and (job (Tweakit Lem E) (computer technician)) (unique (job (Tweakit Lem E) (computer technician)))) (and (job (Reasoner Louis) (computer programmer trainee)) (unique (job (Reasoner Louis) (computer programmer trainee)))) (and (job (Scrooge Eben) (accounting chief accountant)) (unique (job (Scrooge Eben) (accounting chief accountant)))) (and (job (Cratchet Robert) (accounting scrivener)) (unique (job (Cratchet Robert) (accounting scrivener)))) (and (job (Aull DeWitt) (administration secretary)) (unique (job (Aull DeWitt) (administration secretary)))))) (check-equal? (matches-of supervises-one-person) '((and (supervisor (Reasoner Louis) (Hacker Alyssa P)) (unique (supervisor (Reasoner Louis) (Hacker Alyssa P)))) (and (supervisor (Cratchet Robert) (Scrooge Eben)) (unique (supervisor (Cratchet Robert) (Scrooge Eben)))))) )) (run-tests sicp-4.75-tests) ================================================ FILE: scheme/sicp/04/tests/76-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/query.scm") (load "../76.scm") (define (env items) (if (null? items) '() (cons (cons (list '? (caar items)) (cadar items)) (env (cdr items))))) (define sicp-4.76-tests (test-suite "Tests for SICP exercise 4.76" (test-suite "merging frames" (check-equal? (merge-frames (env '((x 1) (y 2))) (env '((z 3) (x 1)))) (env '((y 2) (z 3) (x 1)))) (check-equal? (merge-frames (env '((x (? y)) (z (1 2)))) (env '((x (? z)) (y (1 (? two)))))) (env '((two 2) (z (1 (? two))) (x (? z)) (y (1 (? two))))))) (test-suite "simple queries" (check-equal? (matches-of '(and (job ?person (computer programmer)) (address ?person ?where))) '((and (job (Hacker Alyssa P) (computer programmer)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))) (and (job (Fect Cy D) (computer programmer)) (address (Fect Cy D) (Cambridge (Ames Street) 3)))))) (test-suite "rules" (check-true (matches? '(same x x))) (check-true (matches? '(lives-near (Hacker Alyssa P) (Fect Cy D)))) (check-false (matches? '(lives-near (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(wheel (Warbucks Oliver)))) (check-true (matches? '(wheel (Bitdiddle Ben)))) (check-false (matches? '(wheel (Hacker Alyssa P))))) (test-suite "logic as programs" (check-equal? (matches-of '(append-to-form (a b) (c d) ?z)) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form (a b) ?y (a b c d))) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form ?x ?y (a b c d))) '((append-to-form () (a b c d) (a b c d)) (append-to-form (a) (b c d) (a b c d)) (append-to-form (a b) (c d) (a b c d)) (append-to-form (a b c) (d) (a b c d)) (append-to-form (a b c d) () (a b c d))))) )) (run-tests sicp-4.76-tests) ================================================ FILE: scheme/sicp/04/tests/77-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../77.scm") (load-relative "../showcase/query/database.scm") (define (matches-of query) (let ((processed-query (query-syntax-process query))) (stream->list (stream-map (lambda (frame) (instantiate-exp processed-query frame (lambda (v f) (contract-question-mark v)))) (qeval processed-query (singleton-stream empty-frame)))))) (define sicp-4.77-tests (test-suite "Tests for SICP exercise 4.77" (check-equal? (matches-of '(and (lisp-value > ?amount 30000) (salary ?person ?amount))) '((and (lisp-value > 150000 30000) (salary (Warbucks Oliver) 150000)) (and (lisp-value > 60000 30000) (salary (Bitdiddle Ben) 60000)) (and (lisp-value > 40000 30000) (salary (Hacker Alyssa P) 40000)) (and (lisp-value > 35000 30000) (salary (Fect Cy D) 35000)) (and (lisp-value > 75000 30000) (salary (Scrooge Eben) 75000)))) (check-equal? (matches-of '(and (not (job ?x (computer programmer))) (supervisor ?x (Bitdiddle Ben)))) '((and (not (job (Tweakit Lem E) (computer programmer))) (supervisor (Tweakit Lem E) (Bitdiddle Ben))))) )) (run-tests sicp-4.77-tests) ================================================ FILE: scheme/sicp/04/tests/78-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../78.scm") (load-relative "../showcase/query/database.scm") (define (matches-of query) (let ((processed-query (query-syntax-process query))) (map (lambda (frame) (instantiate-exp processed-query frame (lambda (v f) (contract-question-mark v)))) (amb-collect (qeval processed-query '()))))) (define (matches? query) (not (null? (matches-of query)))) (define sicp-4.78-tests (test-suite "Tests for SICP exercise 4.78" (test-suite "simple queries" (check-equal? (matches-of '(job ?x (computer programmer))) '((job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)))) (check-equal? (matches-of '(job ?x (computer ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)))) (check-equal? (matches-of '(job ?x (computer . ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)) (job (Reasoner Louis) (computer programmer trainee)))) (check-equal? (matches-of '(and (job ?person (computer programmer)) (address ?person ?where))) '((and (job (Hacker Alyssa P) (computer programmer)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))) (and (job (Fect Cy D) (computer programmer)) (address (Fect Cy D) (Cambridge (Ames Street) 3))))) (check-equal? (matches-of '(or (supervisor ?x (Bitdiddle Ben)) (supervisor ?x (Hacker Alyssa P)))) '((or (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Hacker Alyssa P) (Hacker Alyssa P))) (or (supervisor (Fect Cy D) (Bitdiddle Ben)) (supervisor (Fect Cy D) (Hacker Alyssa P))) (or (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (supervisor (Tweakit Lem E) (Hacker Alyssa P))) (or (supervisor (Reasoner Louis) (Bitdiddle Ben)) (supervisor (Reasoner Louis) (Hacker Alyssa P))))) (check-equal? (matches-of '(and (supervisor ?x (Bitdiddle Ben)) (not (job ?x (computer programmer))))) '((and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer)))))) (check-equal? (matches-of '(and (salary ?person ?amount) (lisp-value > ?amount 30000))) '((and (salary (Warbucks Oliver) 150000) (lisp-value > 150000 30000)) (and (salary (Bitdiddle Ben) 60000) (lisp-value > 60000 30000)) (and (salary (Hacker Alyssa P) 40000) (lisp-value > 40000 30000)) (and (salary (Fect Cy D) 35000) (lisp-value > 35000 30000)) (and (salary (Scrooge Eben) 75000) (lisp-value > 75000 30000))))) (test-suite "rules" (check-true (matches? '(same x x))) (check-true (matches? '(lives-near (Hacker Alyssa P) (Fect Cy D)))) (check-false (matches? '(lives-near (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(wheel (Warbucks Oliver)))) (check-true (matches? '(wheel (Bitdiddle Ben)))) (check-false (matches? '(wheel (Hacker Alyssa P)))) (check-true (matches? '(outranked-by (Bitdiddle Ben) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Hacker Alyssa P)))) (check-false (matches? '(outranked-by (Warbucks Oliver) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Eben Scrooge) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Bitdiddle Ben) (Eben Scrooge))))) (test-suite "logic as programs" (check-equal? (matches-of '(append-to-form (a b) (c d) ?z)) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form (a b) ?y (a b c d))) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form ?x ?y (a b c d))) '((append-to-form () (a b c d) (a b c d)) (append-to-form (a) (b c d) (a b c d)) (append-to-form (a b) (c d) (a b c d)) (append-to-form (a b c) (d) (a b c d)) (append-to-form (a b c d) () (a b c d))))) )) (run-tests sicp-4.78-tests) ================================================ FILE: scheme/sicp/04/tests/79-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../79.scm") (load-relative "../showcase/query/database.scm") (define (matches-of query) (let ((processed-query (query-syntax-process query))) (stream->list (stream-map (lambda (frame) (instantiate-exp processed-query frame (lambda (v f) (contract-question-mark v)))) (qeval processed-query (singleton-stream (empty-frame))))))) (define (matches? query) (not (null? (matches-of query)))) (define sicp-4.79-tests (test-suite "Tests for SICP exercise 4.79" (test-suite "inner rules" (add-to-data-base! '((rule (reverse (?x) (?x))) (rule (reverse (?a . ?b) ?c) (rule (i-append-to-form () ?y ?y)) (rule (i-append-to-form (?u . ?v) ?y (?u . ?z)) (i-append-to-form ?v ?y ?z)) (and (reverse ?b ?r-b) (i-append-to-form ?r-b (?a) ?c))) (rule (surrounded-by ?char (?char . ?rest)) (rule (proper-ending (?char))) (rule (proper-ending (?head . ?tail)) (proper-ending ?tail)) (proper-ending ?rest)))) (check-equal? (matches-of '(reverse (1 2 3) (3 2 1))) '((reverse (1 2 3) (3 2 1)))) (check-equal? (matches-of '(reverse (1 2 3) ?x)) '((reverse (1 2 3) (3 2 1)))) (check-true (matches? '(surrounded-by a (a b c b a)))) (check-false (matches? '(surrounded-by a (a b c b)))) (check-false (matches? '(surrounded-by b (a b c b a))))) (test-suite "simple queries" (check-equal? (matches-of '(job ?x (computer programmer))) '((job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)))) (check-equal? (matches-of '(job ?x (computer ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)))) (check-equal? (matches-of '(job ?x (computer . ?type))) '((job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) (job (Tweakit Lem E) (computer technician)) (job (Reasoner Louis) (computer programmer trainee)))) (check-equal? (matches-of '(and (job ?person (computer programmer)) (address ?person ?where))) '((and (job (Hacker Alyssa P) (computer programmer)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))) (and (job (Fect Cy D) (computer programmer)) (address (Fect Cy D) (Cambridge (Ames Street) 3))))) (check-equal? (matches-of '(or (supervisor ?x (Bitdiddle Ben)) (supervisor ?x (Hacker Alyssa P)))) '((or (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Hacker Alyssa P) (Hacker Alyssa P))) (or (supervisor (Reasoner Louis) (Bitdiddle Ben)) (supervisor (Reasoner Louis) (Hacker Alyssa P))) (or (supervisor (Fect Cy D) (Bitdiddle Ben)) (supervisor (Fect Cy D) (Hacker Alyssa P))) (or (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (supervisor (Tweakit Lem E) (Hacker Alyssa P))))) (check-equal? (matches-of '(and (supervisor ?x (Bitdiddle Ben)) (not (job ?x (computer programmer))))) '((and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer)))))) (check-equal? (matches-of '(and (salary ?person ?amount) (lisp-value > ?amount 30000))) '((and (salary (Warbucks Oliver) 150000) (lisp-value > 150000 30000)) (and (salary (Bitdiddle Ben) 60000) (lisp-value > 60000 30000)) (and (salary (Hacker Alyssa P) 40000) (lisp-value > 40000 30000)) (and (salary (Fect Cy D) 35000) (lisp-value > 35000 30000)) (and (salary (Scrooge Eben) 75000) (lisp-value > 75000 30000))))) (test-suite "rules" (check-true (matches? '(same x x))) (check-true (matches? '(lives-near (Hacker Alyssa P) (Fect Cy D)))) (check-false (matches? '(lives-near (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(wheel (Warbucks Oliver)))) (check-true (matches? '(wheel (Bitdiddle Ben)))) (check-false (matches? '(wheel (Hacker Alyssa P)))) (check-true (matches? '(outranked-by (Bitdiddle Ben) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Warbucks Oliver)))) (check-true (matches? '(outranked-by (Hacker Alyssa P) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Bitdiddle Ben)))) (check-true (matches? '(outranked-by (Reasoner Louis) (Hacker Alyssa P)))) (check-false (matches? '(outranked-by (Warbucks Oliver) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Eben Scrooge) (Bitdiddle Ben)))) (check-false (matches? '(outranked-by (Bitdiddle Ben) (Eben Scrooge))))) (test-suite "logic as programs" (check-equal? (matches-of '(append-to-form () (a b) ?y)) '((append-to-form () (a b) (a b)))) (check-equal? (matches-of '(append-to-form (a) (b c d) ?p)) '((append-to-form (a) (b c d) (a b c d)))) (check-equal? (matches-of '(append-to-form (a b) ?m (a b c d))) '((append-to-form (a b) (c d) (a b c d)))) (check-equal? (matches-of '(append-to-form ?x ?y (a b c d))) '((append-to-form () (a b c d) (a b c d)) (append-to-form (a) (b c d) (a b c d)) (append-to-form (a b) (c d) (a b c d)) (append-to-form (a b c) (d) (a b c d)) (append-to-form (a b c d) () (a b c d))))) )) (run-tests sicp-4.79-tests) ================================================ FILE: scheme/sicp/04/tests/helpers/query.scm ================================================ (load-relative "../../showcase/query/evaluator.scm") (load-relative "../../showcase/query/database.scm") (load-relative "../../showcase/query/test-helpers.scm") ================================================ FILE: scheme/sicp/05/01.scm ================================================ ; SICP exercise 5.01 ; ; Design a register machine to compute factorials using the iterative ; algorithm specified by the following procedure. Draw data-path and ; controller diagrams for this machine. ; ; (define (factorial n) ; (define (iter product counter) ; (if (> counter n) ; product ; (iter (* counter product) ; (+ counter 1)))) ; (iter 1 1)) ; Whee! More drawing! I had some fun trying to figure out how to draw this as a ; planar graph. I wonder if the exercise designers thought about that. ; ; The number we are calculating factorial of should be stored in the register ; n. When the machine finishes, the result will be stored in register p. ; ; This is the data-path diagram: ; ; +---------+ ; +---( > )---| n | ; | +---------+ ; | ; +---------+ c<-1 +-----+ p<-1 +---------+ ; | c |<-(x)-/ 1 \-(x)->| p | ; +---------+ +---------+ +---------+ ; | ^ | | | ^ ; | | +---------+ | | ; | | \ + / | (x) p<-* ; | | +-----+ | | ; | (x) c++ | | | ; | +-------+ | | ; +-----------------------+ | | ; | | | ; +---------+ | ; \ * / | ; +-----+ | ; | | ; +-----------+ ; ; Here's the controller diagram: ; ; start ; | ; V ; +-------+ ; | c<-1 | ; +-------+ ; | ; V ; +-------+ ; | p<-1 | ; +-------+ ; | ; V yes ; +-->( > )--------> done ; | | ; | | no ; | V ; | +-------+ ; | | p<-* | ; | +-------+ ; | | ; | V ; | +-------+ ; | | c++ | ; | +-------+ ; | | ; +------+ ; ; Note that if you get the order of the two instructions in the loop wrong, ; the controller diagram would be wrong. ================================================ FILE: scheme/sicp/05/02.scm ================================================ ; SICP exercise 5.02 ; ; Use the register machine language to describe the iterative factorial ; machine of exercise 5.1. (define factorial-machine (make-machine '(c p n) (list (list '+ +) (list '* *) (list '> >)) '( (assign c (const 1)) (assign p (const 1)) test-> (test (op >) (reg c) (reg n)) (branch (label factorial-done)) (assign p (op *) (reg c) (reg p)) (assign c (op +) (reg c) (const 1)) (goto (label test->)) factorial-done))) ================================================ FILE: scheme/sicp/05/03.scm ================================================ ; SICP exercise 5.03 ; ; Design a machine to compute square roots using Newton's method, as described ; in section 1.1.7: ; ; (define (sqrt x) ; (define (good-enough? guess) ; (< (abs (- (square guess) x)) 0.001)) ; (define (improve guess) ; (average guess (/ x guess))) ; (define (sqrt-iter guess) ; (if (good-enough? guess) ; guess ; (sqrt-iter (improve guess)))) ; (sqrt-iter 1.0)) ; ; Begin by assuming that good-enough? and improve operations are available as ; primitives. Then show how to expand these in terms of arithmetic operations. ; Describe each version of the sqrt machine design by a data-path diagram and ; writing a controller definition in the register machine language. ; Here's a bunch of helper functions: (define (square x) (* x x)) (define (average x y) (/ (+ x y) 2)) (define (good-enough? guess x) (< (abs (- (square guess) x)) 0.001)) (define (improve guess x) (average guess (/ x guess))) ; Now comes the "simple" version. ; ; The data-path diagram is fairly simple: ; ; +-->( ge? )<--+ ; | | ; +---+ +-----+ +-----+ ; / 1.0 \--(x)->| g | | x | ; +-------+ +-----+ +-----+ ; ^ | | ; | +---------+ ; | \ imp / ; | +-----+ ; (x) | ; +-------+ (define simple-sqrt-machine (make-machine '(g x) (list (list 'ge? good-enough?) (list 'imp improve)) '( (assign g (const 1.0)) test-ge? (test (op ge?) (reg g) (reg x)) (branch (label sqrt-done)) (assign g (op imp) (reg g) (reg x)) (goto (label test-ge?)) sqrt-done))) ; This is the second version, where all we use is arithmetic operations. This ; gets a bit more involved. Let's note a few things. ; ; * I've designed the data paths to operate exclusively on register a. All ; arithmetic operations have a as the first operand. I did that because I ; wanted to get closer to a traditional processor. Note that some of the ; instructions have g as the second operand, some have x, and some have a ; constant. I did this because I don't want to overcomplicate the ; controller. ; * Before jumping to test-good-enough?, a is already assigned the contents of ; register g. That's why test-good-enough? comes after the a <- g ; assignment. ; * There are, in total, ten instructions and two tests. They can be reduced ; if we introduce some new operations (and memory), but it's not yet the ; time for that. ; ; And now follows some ASCII art: ; ; +-+ +-----+ ; / 0 \---( < )---+ +---( < )---/ 0.001 \ ; +-----+ | | +---------+ ; | | ; | | +---+ ; | | / 1.0 \ ; | | +-------+ ; | | | ; | | (x) ; | | | ; | | V ; +-------------------------+ +-------+ +-------+ ; | a | --(x)-> | g | | x | ; +-------------------------+ +-------+ +-------+ ; | | ^ | | | ; | | +-+ | +----+ +----+ | ; | | / 2 \ | | | | | | ; | | +-----+ | | +-------+ | | ; | | | | | \ + / | | ; | +-------+ | | +---+ | | ; | \ / / | | | | | ; | +---+ +-----(x)--+ | | ; | | | | | | ; +-------+ +--(x)---+ +----+ +----+ | ; \ - / | | | | | | ; +---+ | | +-------+ | | ; | | | \ * / | | ; +---------(x)---+ | +---+ | | ; | | | | | ; +-----(x)--+ | | ; | | | | ; | +----+ +----+ | ; | | | | | | ; | | +-------+ | | ; | | \ / / | | ; | | +---+ | | ; | | | | | ; +-----(x)--+ | | ; | | | | ; +-----(x)----------+ | ; | | | ; | +----+ +----------------+ ; | | | | ; | +-------+ | ; | \ - / | ; | +---+ | ; | | | ; +-----(x)--+ | ; | | ; +-----(x)----------------------+ (define complex-sqrt-machine (make-machine '(g x a) (list (list '+ +) (list '- -) (list '* *) (list '/ /) (list '< <)) '( (assign g (const 1.0)) (assign a (reg g)) test-good-enough? (assign a (op *) (reg a) (reg g)) (assign a (op -) (reg a) (reg x)) (test (op <) (const 0) (reg a)) (branch (label after-abs-a)) (assign a (op -) (reg a)) after-abs-a (test (op <) (reg a) (const 0.001)) (branch (label sqrt-done)) (assign a (reg x)) (assign a (op /) (reg a) (reg g)) (assign a (op +) (reg a) (reg g)) (assign a (op /) (reg a) (const 2)) (assign g (reg a)) (goto (label test-good-enough?)) sqrt-done))) ================================================ FILE: scheme/sicp/05/04.scm ================================================ ; SICP exercise 5.04 ; ; Specify register machines that implement each of the following procedures. ; For each machine, write a controller instruction sequence and draw a diagram ; showing the data paths. ; ; a. Recursive exponentiation ; ; (define (expt b n) ; (if (= n 0) ; 1 ; (* b (expt b (- n 1))))) ; ; b. Iterative exponentiation ; ; (define (expt b n) ; (define (expt-iter counter product) ; (if (= counter 0) ; product ; (expt-iter (- counter 1) (* b product)))) ; (expt-iter n 1)) ; a. This is the data path diagram: ; ; +-+ +---------+ ; +--->( = )<---/ 0 \ | stack | ; | +-----+ +---------+ ; +-----+ +-+ +-----+ +-----+ | ^ ; | n | / 1 \---(x)--->| val | | b | (x) | ; +-----+ +-----+ +-----+ +-----+ | (x) ; ^ | | ^ | | V | ; | +-------+ | +-------+ +------------+ ; | \ - / | \ * / | continue |----> controller ; (x) +---+ (x) +---+ +------------+ ; | | | | ^ ^ ; +------+ +------+ | | ; (x) (x) ; | | ; +---------+ +----------+ ; / expt-done \ / after-expt \ ; +-------------+ +--------------+ (define recursive-expt-machine (make-machine '(b n val continue) (list (list '= =) (list '- -) (list '* *)) '( (assign continue (label expt-done)) expt-loop (test (op =) (reg n) (const 0)) (branch (label base-case)) (save continue) (assign n (op -) (reg n) (const 1)) (assign continue (label after-expt)) (goto (label expt-loop)) after-expt (assign val (op *) (reg val) (reg b)) (restore continue) (goto (reg continue)) base-case (assign val (const 1)) (goto (reg continue)) expt-done))) ; b. This is the iterative data path. Notice that it is simpler. ; ; +-+ ; +-->( = )<--/ 0 \ ; | +-----+ ; | ; +-----+ +-+ +-----+ +-----+ ; | n | / 1 \--(x)-->| val | | b | ; +-----+ +-----+ +-----+ +-----+ ; ^ | | ^ | | ; | +-------+ | +-------+ ; | \ - / | \ * / ; (x) +---+ (x) +---+ ; | | | | ; +------+ +------+ (define iterative-expt-machine (make-machine '(b n val continue) (list (list '= =) (list '- -) (list '* *)) '( (assign val (const 1)) expt-loop (test (op =) (reg n) (const 0)) (branch (label expt-done)) (assign val (op *) (reg val) (reg b)) (assign n (op -) (reg n) (const 1)) (goto (label expt-loop)) expt-done))) ================================================ FILE: scheme/sicp/05/05.scm ================================================ ; SICP exercise 5.05 ; ; Hand-simulate the factorial and Fibonacci machines, using some nontrivial ; input (requiring execution of at least one recursive call). Show the ; contents of the stack at each significant point in the execution. ; I did that on a piece of paper. It's fairly tricky to find a way to write it ; down in this file, so I will just show the state of the stacks after various ; saves and restores. ; ; First, the factorial machine. Let's say we're calculating it for 3. ; ; Initially n is 3 and the stack is empty. ; ; 1. +-------------+ n: 3 ; | | continue: fact-done ; +-------------+ val: ? ; ; 2. +-------------+ n: 2 ; | 3 | continue: after-fact ; +-------------+ val: ? ; | fact-done | ; +-------------+ ; ; 3. +-------------+ n: 1 ; | 2 | continue: after-fact ; +-------------+ val: ? ; | after-fact | ; +-------------+ ; | 3 | ; +-------------+ ; | fact-done | ; +-------------+ ; ; 4. +-------------+ n: 1 ; | 2 | continue: after-fact ; +-------------+ val: 1 ; | after-fact | ; +-------------+ ; | 3 | ; +-------------+ ; | fact-done | ; +-------------+ ; ; 5. +-------------+ n: 2 ; | 3 | continue: after-fact ; +-------------+ val: 2 ; | fact-done | ; +-------------+ ; ; 6. +-------------+ n: 3 ; | | continue: fact-done ; +-------------+ val: 6 ; ; ; ; The Fibonacci machine is a bit more intricate: ; ; 1. +---------------+ n: 3 ; | | continue: fib-done ; +---------------+ val: ? ; ; 2. +---------------+ n: 2 ; | 3 | continue: after-fib-n-1 ; +---------------+ val: ? ; | fib-done | ; +---------------+ ; ; 3. +---------------+ n: 1 ; | 2 | continue: after-fib-n-1 ; +---------------+ val: ? ; | after-fib-n-1 | ; +---------------+ ; | 3 | ; +---------------+ ; | fib-done | ; +---------------+ ; ; 4. +---------------+ n: 1 ; | 2 | continue: after-fib-n-1 ; +---------------+ val: 1 ; | after-fib-n-1 | ; +---------------+ ; | 3 | ; +---------------+ ; | fib-done | ; +---------------+ ; ; 5. +---------------+ n: 0 ; | 1 | continue: after-fib-n-2 ; +---------------+ val: 1 ; | after-fib-n-1 | ; +---------------+ ; | 3 | ; +---------------+ ; | fib-done | ; +---------------+ ; ; 6. +---------------+ n: 0 ; | 1 | continue: after-fib-n-2 ; +---------------+ val: 0 ; | after-fib-n-1 | ; +---------------+ ; | 3 | ; +---------------+ ; | fib-done | ; +---------------+ ; ; 7. +---------------+ n: 0 ; | 3 | continue: after-fib-n-1 ; +---------------+ val: 1 ; | fib-done | ; +---------------+ ; ; 8. +---------------+ n: 1 ; | 1 | continue: after-fib-n-2 ; +---------------+ val: 1 ; | fib-done | ; +---------------+ ; ; 9. +---------------+ n: 1 ; | 1 | continue: after-fib-n-2 ; +---------------+ val: 1 ; | fib-done | ; +---------------+ ; ; 10. +---------------+ n: 1 ; | | continue: fib-done ; +---------------+ val: 2 ================================================ FILE: scheme/sicp/05/06.scm ================================================ ; SICP exercise 5.06 ; ; Ben Bitdiddle observes that the Fibonacci machine's controller sequence has ; an extra save and an extra restore, which can be removed to make a faster ; machine. Where are these instructions? ; They are below, commented out: (define fibonacci-machine (make-machine '(n val continue) (list (list '< <) (list '- -) (list '+ +)) '( (assign continue (label fib-done)) fib-loop (test (op <) (reg n) (const 2)) (branch (label immediate-answer)) (save continue) (assign continue (label after-fib-n-1)) (save n) (assign n (op -) (reg n) (const 1)) (goto (label fib-loop)) after-fib-n-1 (restore n) ; (restore continue) (assign n (op -) (reg n) (const 2)) ; (save continue) (assign continue (label after-fib-n-2)) (save val) (goto (label fib-loop)) after-fib-n-2 (assign n (reg val)) (restore val) (restore continue) (assign val (op +) (reg val) (reg n)) (goto (reg continue)) immediate-answer (assign val (reg n)) (goto (reg continue)) fib-done))) ================================================ FILE: scheme/sicp/05/07.scm ================================================ ; SICP exercise 5.07 ; ; Use the simulator to test the machines you designed in exercise 5.4. ; How? At this point in the book, we haven't yet completed it. ; ; Anyway, I already did in the tests of exercise 5.4 ================================================ FILE: scheme/sicp/05/08.scm ================================================ ; SICP exercise 5.08 ; ; The following register-machine code is ambiguous, because the label here is ; defined more than once: ; ; start ; (goto (label here)) ; here ; (assign a (const 3)) ; (goto (label there)) ; here ; (assign a (const 4)) ; (goto (label there)) ; there ; ; With the simulator as written, what will the contents of register a be when ; control reaches there? Modify the extract-labels procedure so that the ; assembler will signal an error if the same label name is used to indicate ; two different locations. ; The result will be 3. Since the associative list of labels retains the order ; in which they are defined, goto will jump to the first label. ; ; Here's the modification: (define (extract-labels text receive) (if (null? text) (receive '() '()) (extract-labels (cdr text) (lambda (insts labels) (let ((next-inst (car text))) (if (symbol? next-inst) (if (assoc next-inst labels) (error "Duplicate label:" next-inst) (receive insts (cons (make-label-entry next-inst insts) labels))) (receive (cons (make-instruction next-inst) insts) labels))))))) ================================================ FILE: scheme/sicp/05/09.scm ================================================ ; SICP exercise 5.09 ; ; The treatment of machine operations above permits them to operate on labels ; as well as on constants and the contents of registers. Modify the ; expression-processing procedures to enforce the condition that operations ; can be used only with registers and constants. (define (make-operation-exp exp machine labels operations) (if (ormap label-exp? (operation-exp-operands exp)) (error "Operations are not applicable to labels" exp) (let ((op (lookup-prim (operation-exp-op exp) operations)) (aprocs (map (lambda (e) (make-primitive-exp e machine labels)) (operation-exp-operands exp)))) (lambda () (apply op (map (lambda (p) (p)) aprocs)))))) ================================================ FILE: scheme/sicp/05/10.scm ================================================ ; SICP exercise 5.10 ; ; Design a new syntax for register-machine instructions and modify the ; simulator to use your new syntax. Can you implement your new syntax without ; changing any part of the simulator except procedures in this section? ; Sure. ; ; Registers will be prefixed with @ and labels will be prefixed with :. ; Numbers will be constants. Everything else is an operation. (define (symbol-starting-with? symbol prefix) (and (symbol? symbol) (equal? (substring (symbol->string symbol) 0 (string-length prefix)) prefix))) (define (symbol-without-prefix symbol) (string->symbol (substring (symbol->string symbol) 1))) (define (register-exp? exp) (symbol-starting-with? exp "@")) (define (register-exp-reg exp) (symbol-without-prefix exp)) (define (constant-exp? exp) (number? exp)) (define (constant-exp-value exp) exp) (define (label-exp? exp) (symbol-starting-with? exp ":")) (define (label-exp-label exp) (symbol-without-prefix exp)) (define (operation-exp? exp) (and (pair? exp) (not (register-exp? (car exp))) (not (constant-exp? (car exp))) (not (label-exp? (car exp))))) (define (operation-exp-op operation-exp) (car operation-exp)) (define (operation-exp-operands operation-exp) (cdr operation-exp)) (define fibonacci-machine (make-machine '(n val continue) (list (list '< <) (list '- -) (list '+ +)) '( (assign continue :fib-done) fib-loop (test < @n 2) (branch :immediate-answer) (save continue) (assign continue :after-fib-n-1) (save n) (assign n - @n 1) (goto :fib-loop) after-fib-n-1 (restore n) (restore continue) (assign n - @n 2) (save continue) (assign continue :after-fib-n-2) (save val) (goto :fib-loop) after-fib-n-2 (assign n @val) (restore val) (restore continue) (assign val + @val @n) (goto @continue) immediate-answer (assign val @n) (goto @continue) fib-done))) ================================================ FILE: scheme/sicp/05/11.scm ================================================ ; SICP exercise 5.11 ; ; When we introduced save and restore in section 5.1.4, we didn't specify what ; would happen if you tried to restore a register that was not the last one ; saved, as in the sequence ; ; (save x) ; (save x) ; (restore y) ; ; There are several reasonable possibilities for the meaning of restore. ; ; a. (restore y) puts into y the last value saved on the stack, regardless of ; what register that value came from. This is the way our simulator behaves. ; Show how to take advantage of this behavior to eliminate one instruction ; from the Fibonacci machine of section 5.1.4 (figure 5.12). ; ; b. (restore y) puts into y the last value saved on the stack, but only if ; that value was saved from y; otherwise, it signals an error. Modify the ; simulator to behave this way. You will have to change save to put the ; register name on the stack along with the value. ; ; c. (restore y) puts into y the last value saved from y, regardless of what ; other registers were saved after y and not restored. Modify the simulator to ; behave this way. You will have to associate a separate stack with each ; register. You should make the initialize-stack operation initialize all the ; register stacks. ; Some code to allow all variants to coexist. (define table (make-hash)) (define (make-save inst machine stack pc) ((hash-ref table 'make-save) inst machine stack pc)) (define (make-restore inst machine stack pc) ((hash-ref table 'make-restore) inst machine stack pc)) (define original-make-register make-register) (define (make-register name) ((hash-ref table 'make-register) name)) (define (get-contents register) ((hash-ref table 'get-contents) register)) (define (set-contents! register value) ((hash-ref table 'set-contents!) register value)) (define (use-traditional-registers!) (define (get-contents register) (register 'get)) (define (set-contents! register value) ((register 'set) value)) (hash-set! table 'make-register original-make-register) (hash-set! table 'get-contents get-contents) (hash-set! table 'set-contents! set-contents!)) ; a. Here are the modified procedures: (define (use-version-a!) (define (make-save inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (push stack (get-contents reg)) (advance-pc pc)))) (define (make-restore inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (set-contents! reg (pop stack)) (advance-pc pc)))) (use-traditional-registers!) (hash-set! table 'make-save make-save) (hash-set! table 'make-restore make-restore)) ; And this is the shorter Fibonacci machine: (define (make-shorter-fibonacci-machine) (make-machine '(n val continue) (list (list '< <) (list '- -) (list '+ +)) '( (assign continue (label fib-done)) fib-loop (test (op <) (reg n) (const 2)) (branch (label immediate-answer)) (save continue) (assign continue (label after-fib-n-1)) (save n) (assign n (op -) (reg n) (const 1)) (goto (label fib-loop)) after-fib-n-1 (restore n) (restore continue) (assign n (op -) (reg n) (const 2)) (save continue) (assign continue (label after-fib-n-2)) (save val) (goto (label fib-loop)) after-fib-n-2 (restore n) ; The modification is here (restore continue) (assign val (op +) (reg val) (reg n)) (goto (reg continue)) immediate-answer (assign val (reg n)) (goto (reg continue)) fib-done))) ; b. Erroring out when registers don't match (define (use-version-b!) (define (make-save inst machine stack pc) (let ((reg-name (stack-inst-reg-name inst))) (let ((reg (get-register machine reg-name))) (lambda () (push stack (cons reg-name (get-contents reg))) (advance-pc pc))))) (define (make-restore inst machine stack pc) (let ((reg-name (stack-inst-reg-name inst))) (let ((reg (get-register machine reg-name))) (lambda () (let ((saved-value (pop stack))) (if (eq? reg-name (car saved-value)) (begin (set-contents! reg (cdr saved-value)) (advance-pc pc)) (error "Mismatching registers:" (car saved-value) inst))))))) (use-traditional-registers!) (hash-set! table 'make-save make-save) (hash-set! table 'make-restore make-restore)) ; c. A stack per each register ; ; I'm not going to modify the initialize stack operation. I can (and I ; should), but it is simpler if I don't modify the original code. I will store ; the stack in each register, since I don't want to modify make-machine. I'm ; doing this solely to have a compact exercise solution. (define (use-version-c!) (define (make-register name) (let ((register (original-make-register name))) ((register 'set) (mcons '() (make-stack))) register)) (define (get-contents register) (mcar (register 'get))) (define (set-contents! register value) (set-mcar! (register 'get) value)) (define (push-register register value) (push (mcdr (register 'get)) value)) (define (pop-register register) (pop (mcdr (register 'get)))) (define (make-save inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (push-register reg (get-contents reg)) (advance-pc pc)))) (define (make-restore inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (set-contents! reg (pop-register reg)) (advance-pc pc)))) (hash-set! table 'make-register make-register) (hash-set! table 'get-contents get-contents) (hash-set! table 'set-contents! set-contents!) (hash-set! table 'make-save make-save) (hash-set! table 'make-restore make-restore)) ================================================ FILE: scheme/sicp/05/12.scm ================================================ ; SICP exercise 5.12 ; ; The simulator can be used to help determine the data paths required for ; implementing a machine with a given controller. Extend the assembler to ; store the following information in the machine model: ; ; * a list of all instructions, with duplicates removed, sorted by instruction ; type (assign, goto, and so on); ; * a list (without duplicates) of the registers used to hold entry points ; (these are the registers referenced by goto instructions); ; * a list (without duplicates) of the registers that are saved or restored; ; * for each register, a list (without duplicates) of the sources from which ; it is assigned (for example, the sources for register val in the factorial ; of figure 5.11 are (const 1) and ((op *) (reg n) (reg val))). ; ; Extend the message-passing interface to the machine to provide access to ; this new information. To test your analyzer, define the Fibonacci machine ; from figure 5.12 and examine the lists you constructed. (define (extract-data-path-info controller-text) (list (list 'instructions (data-path-instructions controller-text)) (list 'entry-point-registers (data-path-entry-point-registers controller-text)) (list 'stack-registers (data-path-stack-registers controller-text)) (list 'register-sources (data-path-register-sources controller-text)))) (define (data-path-instructions controller-text) (process-text controller-text (lambda (inst) #t) (lambda (inst) inst))) (define (data-path-entry-point-registers controller-text) (process-text controller-text (lambda (inst) (and (eq? (car inst) 'goto) (register-exp? (goto-dest inst)))) (compose goto-dest register-exp-reg))) (define (data-path-stack-registers controller-text) (process-text controller-text (lambda (inst) (or (eq? (car inst) 'save) (eq? (car inst) 'restore))) stack-inst-reg-name)) (define (data-path-register-sources controller-text) (define (to-alist items result) (cond ((null? items) (list result)) ((null? result) (to-alist (cdr items) (car items))) ((eq? (caar items) (car result)) (to-alist (cdr items) (cons (car result) (append (cdr result) (list (cadar items)))))) (else (cons result (to-alist items '()))))) (to-alist (process-text controller-text (lambda (inst) (eq? (car inst) 'assign)) (lambda (inst) (list (assign-reg-name inst) (if (operation-exp? (assign-value-exp inst)) (assign-value-exp inst) (car (assign-value-exp inst)))))) '())) (define (process-text controller-text predicate proc) (sort (remove-duplicates (map proc (filter predicate (filter pair? controller-text)))) string 1. Note that each of these is a linear function of n and is thus ; determined by two constants. In order to get the statistics printed, you ; will have to augment the factorial machine with instructions to initialize ; the stack and print the statistics. You may want to also modify the machine ; so that it repeatedly reads a value for n, computes the factorial, and ; prints the result (as we did for the GCD machine in figure 5.4), so that you ; will not have to repeatedly invoke get-register-contents, ; set-register-contents!, and start. ; The results are: ; ; Running 1!: (total-pushes = 0 maximum-depth = 0) ; Running 2!: (total-pushes = 2 maximum-depth = 2) ; Running 3!: (total-pushes = 4 maximum-depth = 4) ; Running 4!: (total-pushes = 6 maximum-depth = 6) ; Running 5!: (total-pushes = 8 maximum-depth = 8) ; Running 6!: (total-pushes = 10 maximum-depth = 10) ; Running 7!: (total-pushes = 12 maximum-depth = 12) ; Running 8!: (total-pushes = 14 maximum-depth = 14) ; Running 9!: (total-pushes = 16 maximum-depth = 16) ; ; This implies that for computing n!, there are in total 2(n - 1) pushes. This ; number is equal to the maximum depth too. (load-relative "tests/helpers/simulator.scm") ; The modified procedures: (define (make-stack) (let ((s '()) (number-pushes 0) (max-depth 0) (current-depth 0)) (define (push x) (set! s (cons x s)) (set! number-pushes (+ 1 number-pushes)) (set! current-depth (+ 1 current-depth)) (set! max-depth (max current-depth max-depth))) (define (pop) (if (null? s) (error "Empty stack -- POP") (let ((top (car s))) (set! s (cdr s)) (set! current-depth (- current-depth 1)) top))) (define (initialize) (set! s '()) (set! number-pushes 0) (set! max-depth 0) (set! current-depth 0) 'done) (define (print-statistics) (display (list 'total-pushes '= number-pushes 'maximum-depth '= max-depth)) (newline)) (define (dispatch message) (cond ((eq? message 'push) push) ((eq? message 'pop) (pop)) ((eq? message 'initialize) (initialize)) ((eq? message 'print-statistics) (print-statistics)) (else (error "Unknown request -- STACK" message)))) dispatch)) (define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '())) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))) (list 'print-stack-statistics (lambda () (stack 'print-statistics))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined register: " name) (set! register-table (cons (list name (make-register name)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin ((instruction-execution-proc (car insts))) (execute))))) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) (else (error "Unknown request -- MACHINE" message)))) dispatch))) (define factorial-machine (make-machine '(n val continue) (list (list '= =) (list '- -) (list '* *)) '( (perform (op initialize-stack)) (assign continue (label fact-done)) fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) after-fact (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) (goto (reg continue)) base-case (assign val (const 1)) (goto (reg continue)) fact-done (perform (op print-stack-statistics))))) (define (measure-factorial n) (set-register-contents! factorial-machine 'n n) (display "Running ") (display n) (display "!: ") (start factorial-machine)) (for ([n (in-range 1 10)]) (measure-factorial n)) ================================================ FILE: scheme/sicp/05/15.scm ================================================ ; SICP exercise 5.15 ; ; Add instruction counting to the register machine simulation. That is, have ; the machine model keep track of the number of instructions executed. Extend ; the machine model's interface to accept a new message that prints the value ; of the instruction count and resets the count to zero. (define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '()) (instruction-count 0)) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined register: " name) (set! register-table (cons (list name (make-register name)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin ((instruction-execution-proc (car insts))) (set! instruction-count (+ instruction-count 1)) (execute))))) (define (get-instruction-count) (let ((count instruction-count)) (set! instruction-count 0) count)) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) ((eq? message 'instruction-count) (get-instruction-count)) (else (error "Unknown request -- MACHINE" message)))) dispatch))) ================================================ FILE: scheme/sicp/05/16.scm ================================================ ; SICP exercise 5.16 ; ; Augment the simulator to provide for instruction tracing. That is, before ; each instruction is executed, the simulator should print the text of the ; instruction. Make the machine model accept trace-on and trace-off messages ; to turn tracing on and off. ; I will base this on the solution of the previous exercise, since I'm going ; to need both instruction counting and tracing for the next one. Instead of ; printing the instructions, I will allow providing a trace procedure so ; testing can be easier. (define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '()) (trace-proc (lambda (inst) (void))) (tracing #f) (instruction-count 0)) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined register: " name) (set! register-table (cons (list name (make-register name)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (let ((inst (car insts))) (when tracing (trace-proc (instruction-text inst))) ((instruction-execution-proc inst)) (set! instruction-count (+ instruction-count 1)) (execute))))) (define (get-instruction-count) (let ((count instruction-count)) (set! instruction-count 0) count)) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) ((eq? message 'instruction-count) (get-instruction-count)) ((eq? message 'install-trace-proc) (lambda (proc) (set! trace-proc proc))) ((eq? message 'trace-on) (set! tracing #t)) ((eq? message 'trace-off) (set! tracing #f)) (else (error "Unknown request -- MACHINE" message)))) dispatch))) ================================================ FILE: scheme/sicp/05/17.scm ================================================ ; SICP exercise 5.17 ; ; Extend the instruction tracing of exercise 5.16 so that before printing an ; instruction, the simulator prints any labels that immediately precede that ; instruction in the controller sequence. Be careful to do this in a way that ; does not interfere with instruction counting (exercise 5.15). You will have ; to make the simulator retain the necessary label information. (define (extract-labels text receive) (if (null? text) (receive '() '()) (extract-labels (cdr text) (lambda (insts labels) (let ((next-inst (car text))) (if (symbol? next-inst) (begin (when (not (null? insts)) (set-instruction-label! (car insts) next-inst)) (receive insts (cons (make-label-entry next-inst insts) labels))) (receive (cons (make-instruction next-inst) insts) labels))))))) (define (make-instruction text) (mcons text (mcons '() (mcons '() '())))) (define (instruction-text inst) (mcar inst)) (define (instruction-execution-proc inst) (mcar (mcdr inst))) (define (instruction-label inst) (mcar (mcdr (mcdr inst)))) (define (instruction-labeled? inst) (not (null? (instruction-label inst)))) (define (set-instruction-execution-proc! inst proc) (set-mcar! (mcdr inst) proc)) (define (set-instruction-label! inst label) (set-mcar! (mcdr (mcdr inst)) label)) (define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '()) (trace-proc (lambda (inst) (void))) (tracing #f) (instruction-count 0)) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined register: " name) (set! register-table (cons (list name (make-register name)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (let ((inst (car insts))) (cond ((and tracing (instruction-labeled? inst)) (trace-proc (instruction-label inst)) (trace-proc (instruction-text inst))) (tracing (trace-proc (instruction-text inst)))) ((instruction-execution-proc inst)) (set! instruction-count (+ instruction-count 1)) (execute))))) (define (get-instruction-count) (let ((count instruction-count)) (set! instruction-count 0) count)) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) ((eq? message 'instruction-count) (get-instruction-count)) ((eq? message 'install-trace-proc) (lambda (proc) (set! trace-proc proc))) ((eq? message 'trace-on) (set! tracing #t)) ((eq? message 'trace-off) (set! tracing #f)) (else (error "Unknown request -- MACHINE" message)))) dispatch))) ================================================ FILE: scheme/sicp/05/18.scm ================================================ ; SICP exercise 5.18 ; ; Modify the make-register procedure of section 5.2.1 so that registers can be ; traced. Registers should accept messages that turn tracing on and off. When ; a register is traced, assigning a value to the register should print the ; name of the register, the old contents of the register, and the new contents ; being assigned. Extend the interface to the machine model to permit you to ; turn tracing on and off for designated machine registers. (define (make-register name trace) (let ((contents '*unassigned*) (tracing #f)) (define (dispatch message) (cond ((eq? message 'get) contents) ((eq? message 'set) (lambda (value) (when tracing (trace name contents value)) (set! contents value))) ((eq? message 'trace-off) (set! tracing #f)) ((eq? message 'trace-on) (set! tracing #t)) (else (error "Unknown request -- REGISTER" message)))) dispatch)) (define (make-new-machine) (define register-trace-proc (lambda (name old new) (void))) (define (trace name old new) (register-trace-proc name old new)) (let ((pc (make-register 'pc trace)) (flag (make-register 'flag trace)) (stack (make-stack)) (the-instruction-sequence '())) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined register: " name) (set! register-table (cons (list name (make-register name trace)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin ((instruction-execution-proc (car insts))) (execute))))) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) ((eq? message 'install-register-trace-proc) (lambda (proc) (set! register-trace-proc proc))) ((eq? message 'register-trace-off) (lambda (reg-name) ((lookup-register reg-name) 'trace-off))) ((eq? message 'register-trace-on) (lambda (reg-name) ((lookup-register reg-name) 'trace-on))) (else (error "Unknown request -- MACHINE" message)))) dispatch))) ================================================ FILE: scheme/sicp/05/19.scm ================================================ ; SICP exercise 5.19 ; ; Allysa P. Hacker wants a breakpoint feature in the simulator to help her ; debug her machine designs. You have been hired to install this feature for ; her. She wants to be able to specify a place in the controller sequence ; where the simulator will stop and allow her to examine the state of the ; machine. You are to implement a procedure ; ; (set-breakpoint
    ; ; The maximum depth is a measure of the amount of space used by the evaluator ; in carrying out the computation, and the number of pushes correlates well ; with the time required. ; The results are: ; ; 1! takes (total-pushes = 16 maximum-depth = 8) ; 2! takes (total-pushes = 48 maximum-depth = 13) ; 3! takes (total-pushes = 80 maximum-depth = 18) ; 4! takes (total-pushes = 112 maximum-depth = 23) ; 5! takes (total-pushes = 144 maximum-depth = 28) ; 6! takes (total-pushes = 176 maximum-depth = 33) ; 7! takes (total-pushes = 208 maximum-depth = 38) ; 8! takes (total-pushes = 240 maximum-depth = 43) ; 9! takes (total-pushes = 272 maximum-depth = 48) ; ; This implies that the maximum depth is 5n + 3 and the total pushes are ; 32n - 16. ; ; | Maximum depth | Number of pushes ; --------------------+---------------+----------------- ; Recursive factorial | 5n + 3 | 32n - 16 ; --------------------+---------------+----------------- ; Iterative factorial | 10 | 35n + 29 ; --------------------+---------------+----------------- (load-relative "tests/helpers/evaluator.scm") (load-relative "tests/helpers/monitored-stack.scm") (define code '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) (define machine (make-explicit-control-machine)) (set-register-contents! machine 'env the-global-environment) (set-register-contents! machine 'exp code) (start machine) (for ([n (in-range 1 10)]) (printf "~a! takes ~a\n" n (stack-stats-for machine (list 'factorial n)))) ================================================ FILE: scheme/sicp/05/28.scm ================================================ ; SICP exercise 5.28 ; ; Modify the definition of the evaluator by changing eval-sequence as ; described in section 5.4.2 so that the evaluator is no longer ; tail-recursive. Rerun your experiments from exercise 5.26 to 5.27 to ; demonstrate that both versions of the factorial procedure now require space ; that grows linearly with their input. ; The results are: ; ; Iterative factorial: ; 1! takes (total-pushes = 70 maximum-depth = 17) ; 2! takes (total-pushes = 107 maximum-depth = 20) ; 3! takes (total-pushes = 144 maximum-depth = 23) ; 4! takes (total-pushes = 181 maximum-depth = 26) ; 5! takes (total-pushes = 218 maximum-depth = 29) ; 6! takes (total-pushes = 255 maximum-depth = 32) ; 7! takes (total-pushes = 292 maximum-depth = 35) ; 8! takes (total-pushes = 329 maximum-depth = 38) ; 9! takes (total-pushes = 366 maximum-depth = 41) ; Recursive factorial: ; 1! takes (total-pushes = 18 maximum-depth = 11) ; 2! takes (total-pushes = 52 maximum-depth = 19) ; 3! takes (total-pushes = 86 maximum-depth = 27) ; 4! takes (total-pushes = 120 maximum-depth = 35) ; 5! takes (total-pushes = 154 maximum-depth = 43) ; 6! takes (total-pushes = 188 maximum-depth = 51) ; 7! takes (total-pushes = 222 maximum-depth = 59) ; 8! takes (total-pushes = 256 maximum-depth = 67) ; 9! takes (total-pushes = 290 maximum-depth = 75) ; ; One can see that both versions are not bound on stack space. The code to ; reproduce the results is below: (load-relative "tests/helpers/evaluator.scm") (load-relative "tests/helpers/monitored-stack.scm") (define ec-no-tail '( (assign continue (label done)) eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) (test (op variable?) (reg exp)) (branch (label ev-variable)) (test (op quoted?) (reg exp)) (branch (label ev-quoted)) (test (op assignment?) (reg exp)) (branch (label ev-assignment)) (test (op definition?) (reg exp)) (branch (label ev-definition)) (test (op if?) (reg exp)) (branch (label ev-if)) (test (op lambda?) (reg exp)) (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ; Evaluating simple expressions ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value) (reg exp) (reg env)) (goto (reg continue)) ev-quoted (assign val (op text-of-quotation) (reg exp)) (goto (reg continue)) ev-lambda (assign unev (op lambda-parameters) (reg exp)) (assign exp (op lambda-body) (reg exp)) (assign val (op make-procedure) (reg unev) (reg exp) (reg env)) (goto (reg continue)) ; Evaluating procedure applications ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) ; Procedure application apply-dispatch (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) (goto (label unknown-procedure-type)) primitive-apply (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (restore continue) (goto (reg continue)) compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) ; Sequence evaluation ev-begin (assign unev (op begin-actions) (reg exp)) (save continue) (goto (label ev-sequence)) ev-sequence (test (op no-more-exps?) (reg unev)) (branch (label ev-sequence-end)) (assign exp (op first-exp) (reg unev)) (save unev) (save env) (assign continue (label ev-sequence-continue)) (goto (label eval-dispatch)) ev-sequence-continue (restore env) (restore unev) (assign unev (op rest-exps) (reg unev)) (goto (label ev-sequence)) ev-sequence-end (restore continue) (goto (reg continue)) ; Conditionals ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ; Assignments and definitions ev-assignment (assign unev (op assignment-variable) (reg exp)) (save unev) (assign exp (op assignment-value) (reg exp)) (save env) (save continue) (assign continue (label ev-assignment-1)) (goto (label eval-dispatch)) ev-assignment-1 (restore continue) (restore env) (restore unev) (perform (op set-variable-value!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ev-definition (assign unev (op definition-variable) (reg exp)) (save unev) (assign exp (op definition-value) (reg exp)) (save env) (save continue) (assign continue (label ev-definition-1)) (goto (label eval-dispatch)) ev-definition-1 (restore continue) (restore env) (restore unev) (perform (op define-variable!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) unknown-procedure-type unknown-expression-type done)) (define iterative-code '(define (factorial-iterative n) (define (iter product counter) (if (> counter n) product (iter (* counter product) (+ counter 1)))) (iter 1 1))) (define recursive-code '(define (factorial-recursive n) (if (= n 1) 1 (* (factorial-recursive (- n 1)) n)))) (define machine (make-explicit-machine ec-no-tail `((no-more-exps? ,null?)))) (set-register-contents! machine 'env the-global-environment) (set-register-contents! machine 'exp iterative-code) (start machine) (set-register-contents! machine 'exp recursive-code) (start machine) (define (print-stats-for function name) (printf "~a:\n" name) (for ([n (in-range 1 10)]) (printf " ~a! takes ~a\n" n (stack-stats-for machine (list function n))))) (print-stats-for 'factorial-iterative "Iterative factorial") (print-stats-for 'factorial-recursive "Recursive factorial") ================================================ FILE: scheme/sicp/05/29.scm ================================================ ; SICP exercise 5.29 ; ; Monitor the stack operations in the tree-recursive Fibonacci computation: ; ; (define (fib n) ; (if (< n 2) ; n ; (+ (fib (- n 1)) (fib (- n 2))))) ; ; a. Give a formula in terms of n for the maximum depth of the stack required ; to compute Fib(n) for n ≥ 2. Hint: In section 1.2.2 we argued that the space ; used by this process grows linearly with n. ; ; b. Give a formula for the total number of pushes used to compute Fib(n) for ; n ≥ 2. You should find that the number of pushes (which correlates well with ; the time used) grows exponentially with n. Hint: Let S(n) be the number of ; pushes used in computing Fib(n). You should be able to argue that there is a ; formulate that expresses S(n) in terms of S(n - 1), S(n - 2), and some fixed ; "overhead" constant k that is independent of n. Give the formula, and say ; what k is. Then show that S(n) can be expressed as a.Fib(n + 1) + b and give ; the values of a and b. ; The results are: ; ; fib(0) takes (total-pushes = 16 maximum-depth = 8) ; fib(1) takes (total-pushes = 16 maximum-depth = 8) ; fib(2) takes (total-pushes = 72 maximum-depth = 13) ; fib(3) takes (total-pushes = 128 maximum-depth = 18) ; fib(4) takes (total-pushes = 240 maximum-depth = 23) ; fib(5) takes (total-pushes = 408 maximum-depth = 28) ; fib(6) takes (total-pushes = 688 maximum-depth = 33) ; fib(7) takes (total-pushes = 1136 maximum-depth = 38) ; fib(8) takes (total-pushes = 1864 maximum-depth = 43) ; fib(9) takes (total-pushes = 3040 maximum-depth = 48) ; ; a. The maximum stack depth for any n is ; ; 5n + 3 ; ; b. The number of pushes is ; ; S(n) = S(n - 1) + S(n - 2) + 40 ; ; or ; ; S(n) = 56.Fib(n + 1) - 40 (load-relative "tests/helpers/evaluator.scm") (load-relative "tests/helpers/monitored-stack.scm") (define code '(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))) (define machine (make-explicit-control-machine)) (set-register-contents! machine 'env the-global-environment) (set-register-contents! machine 'exp code) (start machine) (for ([n (in-range 0 10)]) (printf "fib(~a) takes ~a\n" n (stack-stats-for machine (list 'fib n)))) ================================================ FILE: scheme/sicp/05/30.scm ================================================ ; SICP exercise 5.30 ; ; Our evaluator currently catches and signals only two kind of errors -- ; unknown expression types and unknown procedure types. Other errors will take ; us out of the evaluator read-eval-print-loop. When we run the evaluator ; using the register machine simulator, these errors are caught by the ; underlying Scheme system. It is a large project to make a real error system ; work, but it is well worth the effort to understand what is involved here. ; ; a. Errors that occur in the evaluation process, such as an attempt to access ; an unbound variable, could be caught by changing the lookup operation to ; make it return a distinguished condition code, which cannot be a possible ; value of any user variable. The evaluator can test for this condition code ; and then do what is necessary to signal error. Find all the places in the ; evaluator where such a change is necessary and fix them. This is lots of ; work. ; ; b. Much worse is the problem of handling errors that are signaled by ; applying primitive procedures, such as an attempt to divide by zero or an ; attempt to extract the car of a symbol. In a professionally written ; high-quality system, each primitive application is checked for safety as ; part of the primitive. For example, every call to car could first check that ; the argument is a pair. If the argument is not a pair, the application would ; return a distinguished condition code to the evaluator, which would then ; report the failure. We could arrange for this in our register-machine ; simulator by making each primitive procedure check of applicability and ; returning an appropriate distinguished condition code on failure. Then the ; primitive-apply code in the evaluator can check for the condition code and ; go to signal-error in necessary. Build this structure and make it work. This ; is a major project. ; You know, I'm going to do both on the same pass. ; ; I am going to change things a bit. First, since I don't want to test in the ; REPL, I will have the machine return the error code itself in val when an ; error has occured. Second, I'm going to ignore unrolling the stack -- this ; topic is not covered in the book anyway. ; ; Also, I'm only going to implement the examples given. I could implement a ; few other errors (bad function call arity, setting an undefined variable, ; redefining a variable, etc.), but I don't think I need to. ; ; That way, it actually isn't that much work. ; Error codes (define (error-code code debug) (vector 'error code debug)) (define (error-code? obj) (and (vector? obj) (eq? (vector-ref obj 0) 'error))) (define (error-code-sym code) (vector-ref code 1)) (define (error-code-debug code) (vector-ref code 2)) ; The new operations required (define (lookup-variable-value-e var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (mcar vals)) (else (scan (cdr vars) (mcdr vals))))) (if (eq? env the-empty-environment) (error-code 'unbound-variable var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) ; New versions of the primitive procedures (define (car-e lst) (cond ((null? lst) (error-code 'car-on-null '())) ((not (pair? lst)) (error-code 'car-on-non-pair lst)) (else (car lst)))) (define (/-e a b) (if (zero? b) (error-code 'zero-division-error a) (/ a b))) (define primitive-procedures (list (list 'car car-e) (list '/ /-e) (list '+ +))) ; Additional operations (define extra-operations (list (list 'lookup-variable-value-e lookup-variable-value-e) (list 'error-code? error-code?) (list 'error-code-sym error-code-sym))) ; The controller text (define ec-error-support '( (assign continue (label done)) eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) (test (op variable?) (reg exp)) (branch (label ev-variable)) (test (op quoted?) (reg exp)) (branch (label ev-quoted)) (test (op assignment?) (reg exp)) (branch (label ev-assignment)) (test (op definition?) (reg exp)) (branch (label ev-definition)) (test (op if?) (reg exp)) (branch (label ev-if)) (test (op lambda?) (reg exp)) (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ; Evaluating simple expressions ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value-e) (reg exp) (reg env)) (test (op error-code?) (reg val)) (branch (label undefined-variable)) (goto (reg continue)) ev-quoted (assign val (op text-of-quotation) (reg exp)) (goto (reg continue)) ev-lambda (assign unev (op lambda-parameters) (reg exp)) (assign exp (op lambda-body) (reg exp)) (assign val (op make-procedure) (reg unev) (reg exp) (reg env)) (goto (reg continue)) ; Evaluating procedure applications ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) ; Procedure application apply-dispatch (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) (goto (label unknown-procedure-type)) primitive-apply (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (test (op error-code?) (reg val)) (branch (label primitive-apply-error)) (restore continue) (goto (reg continue)) compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) ; Sequence evaluation ev-begin (assign unev (op begin-actions) (reg exp)) (save continue) (goto (label ev-sequence)) ev-sequence (assign exp (op first-exp) (reg unev)) (test (op last-exp?) (reg unev)) (branch (label ev-sequence-last-exp)) (save unev) (save env) (assign continue (label ev-sequence-continue)) (goto (label eval-dispatch)) ev-sequence-continue (restore env) (restore unev) (assign unev (op rest-exps) (reg unev)) (goto (label ev-sequence)) ev-sequence-last-exp (restore continue) (goto (label eval-dispatch)) ; Conditionals ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ; Assignments and definitions ev-assignment (assign unev (op assignment-variable) (reg exp)) (save unev) (assign exp (op assignment-value) (reg exp)) (save env) (save continue) (assign continue (label ev-assignment-1)) (goto (label eval-dispatch)) ev-assignment-1 (restore continue) (restore env) (restore unev) (perform (op set-variable-value!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ev-definition (assign unev (op definition-variable) (reg exp)) (save unev) (assign exp (op definition-value) (reg exp)) (save env) (save continue) (assign continue (label ev-definition-1)) (goto (label eval-dispatch)) ev-definition-1 (restore continue) (restore env) (restore unev) (perform (op define-variable!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) undefined-variable (assign val (op error-code-sym) (reg val)) (goto (label done)) primitive-apply-error (assign val (op error-code-sym) (reg val)) (goto (label done)) unknown-procedure-type unknown-expression-type done)) ================================================ FILE: scheme/sicp/05/31.scm ================================================ ; SICP exercise 5.31 ; ; In evaluating a procedure application, the explicit-control evaluator always ; saves and restores the env register around the evaluation of the operator, ; saves and restores env around the evaluation of each operand (except the ; final one), saves and restores argl around the evalutaion of each operand, ; and saves and restores proc around the evaluation of the operand sequence. ; For each of the following combinations, say which of these save and restore ; operations are superfluous and thus could be eliminated by the compiler's ; preserving mechanism. ; ; (f 'x 'y) ; ; ((f) 'x 'y) ; ; (f (g 'x) y) ; ; (f (g 'x) 'y) ; (f 'x 'y) ; ; There is no need to save and restore anything. ; ; ((f) 'x 'y) ; ; Again, there is no need to save/restore anything. Once the operator is ; evaluated, all the operands are fine, since they don't depend on the ; environment. ; ; (f (g 'x) y) ; ; * proc needs to be saved and restored around the evaluation of the first ; operand ; * env needs to be saved and restored around the evaluation of the first ; operand, if operands are evaluated left to right. Otherwise, if they are ; evaluated right to left (as in the compiler), there is no need to save ; env. ; * argl needs to be saved ; * All other are superfluous ; ; (f (g 'x) 'y) ; ; * proc needs to be saved and restored around the evaluation of the first ; operand ; * argl needs to be saved ; * All other are superflous ================================================ FILE: scheme/sicp/05/32.scm ================================================ ; SICP exercise 5.32 ; ; Using the preserving mechanism, the compiler will avoid saving and restoring ; env around the evaluation of the operator of a combination in the case where ; the operator is a symbol. We could also build such optimizations into the ; evalutor. Indeed, the explicit-control evaluator of section 5.4 already ; performs a similar optimization, by treating combinations with no operands ; as a special case. ; ; a. Extend the explicit control evaluator to recognize as a separate class of ; expressions combinations whose operator is a symbol, and to take advantage ; of this fact in evaluating such expressions. ; ; b. Alyssa P. Hacker suggests that by extending the evaluator to recognize ; more and mroe special cases we could incorporate all the compiler's ; optimizations, and this would eliminate the advantage of compilation ; altogether. What do you think of this idea? ; a. The code is below. ; ; b. I don't think Alyssa is right. The compiler would still can perform ; optimizations that the interpreter can't. For example the interpreter still ; needs to look at the expressions and determine how to dispatch. The compiler ; already does that, making those tests superfluous (define (simple-application? exp) (and (pair? exp) (symbol? (car exp)))) (define extra-operations (list (list 'simple-application? simple-application?) )) (define ec-core-optimized '( (assign continue (label done)) eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) (test (op variable?) (reg exp)) (branch (label ev-variable)) (test (op quoted?) (reg exp)) (branch (label ev-quoted)) (test (op assignment?) (reg exp)) (branch (label ev-assignment)) (test (op definition?) (reg exp)) (branch (label ev-definition)) (test (op if?) (reg exp)) (branch (label ev-if)) (test (op lambda?) (reg exp)) (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) (test (op simple-application?) (reg exp)) (branch (label ev-simple-application)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ; Evaluating simple expressions ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value) (reg exp) (reg env)) (goto (reg continue)) ev-quoted (assign val (op text-of-quotation) (reg exp)) (goto (reg continue)) ev-lambda (assign unev (op lambda-parameters) (reg exp)) (assign exp (op lambda-body) (reg exp)) (assign val (op make-procedure) (reg unev) (reg exp) (reg env)) (goto (reg continue)) ; Evaluating simple applications (operator is a symbol) ev-simple-application (save continue) (assign unev (op operands) (reg exp)) (assign proc (op operator) (reg exp)) (assign proc (op lookup-variable-value) (reg proc) (reg env)) (assign argl (op empty-arglist)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) (goto (label ev-appl-operand-loop)) ; Evaluating procedure applications ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) ; Procedure application apply-dispatch (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) (goto (label unknown-procedure-type)) primitive-apply (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (restore continue) (goto (reg continue)) compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) ; Sequence evaluation ev-begin (assign unev (op begin-actions) (reg exp)) (save continue) (goto (label ev-sequence)) ev-sequence (assign exp (op first-exp) (reg unev)) (test (op last-exp?) (reg unev)) (branch (label ev-sequence-last-exp)) (save unev) (save env) (assign continue (label ev-sequence-continue)) (goto (label eval-dispatch)) ev-sequence-continue (restore env) (restore unev) (assign unev (op rest-exps) (reg unev)) (goto (label ev-sequence)) ev-sequence-last-exp (restore continue) (goto (label eval-dispatch)) ; Conditionals ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ; Assignments and definitions ev-assignment (assign unev (op assignment-variable) (reg exp)) (save unev) (assign exp (op assignment-value) (reg exp)) (save env) (save continue) (assign continue (label ev-assignment-1)) (goto (label eval-dispatch)) ev-assignment-1 (restore continue) (restore env) (restore unev) (perform (op set-variable-value!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ev-definition (assign unev (op definition-variable) (reg exp)) (save unev) (assign exp (op definition-value) (reg exp)) (save env) (save continue) (assign continue (label ev-definition-1)) (goto (label eval-dispatch)) ev-definition-1 (restore continue) (restore env) (restore unev) (perform (op define-variable!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) unknown-expression-type unknown-procedure-type done)) ================================================ FILE: scheme/sicp/05/33.scm ================================================ ; SICP exercise 5.33 ; ; Consider the following definition of a factorial procedure, which is ; slightly different frmo the one given above: ; ; (define (factorial-alt n) ; (if (= n 1) ; 1 ; (* n (factorial-alt (- n 1))))) ; ; Compile this procedure and compare the resulting code with that produced for ; factorial. Explain the differences you find. Does either program execute ; more efficiently? ; This is the diff: ; ; 33c33,35 ; < (save env) ; --- ; > (assign val (op lookup-variable-value) (const n) (reg env)) ; > (assign argl (op list) (reg val)) ; > (save argl) ; 61,63c63 ; < (assign argl (op list) (reg val)) ; < (restore env) ; < (assign val (op lookup-variable-value) (const n) (reg env)) ; --- ; > (restore argl) ; ; The new version of factorial needs to save and restore env (in order to ; evaluate n after the recursive call), while the original needs to save and ; restore argl (in order to put in it the value of the recursive call). Apart ; from that, the instructions are pretty much the same. There is no difference ; in efficiency. (load-relative "showcase/compiler/helpers.scm") (define factorial-alt-code '(define (factorial-alt n) (if (= n 1) 1 (* n (factorial-alt (- n 1)))))) (pretty-print (compiled-instructions factorial-alt-code)) ================================================ FILE: scheme/sicp/05/34.scm ================================================ ; SICP exercise 5.34 ; ; Compile the iterative factorial procedure ; ; (define (factorial n) ; (define (iter product counter) ; (if (> counter n) ; product ; (iter (* counter product) ; (+ counter 1)))) ; (iter 1)) ; ; Annotate the resulting code, showing the essential difference between the ; code for iterative and recursive versions of factorial that makes one ; process build up stack space and the other run in constant stack space. (define compiled-factorial-iter '( (assign val (op make-compiled-procedure) (label entry1) (reg env)) (goto (label after-lambda2)) entry1 ; (define (factorial n) ... (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const (n)) (reg argl) (reg env)) (assign val (op make-compiled-procedure) (label entry3) (reg env)) (goto (label after-lambda4)) entry3 ; (define (iter product counter) (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const (product counter)) (reg argl) (reg env)) (save continue) (save env) ; (> counter n) (assign proc (op lookup-variable-value) (const >) (reg env)) (assign val (op lookup-variable-value) (const n) (reg env)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const counter) (reg env)) (assign argl (op cons) (reg val) (reg argl)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch8)) compiled-branch9 (assign continue (label after-call10)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch8 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) after-call10 (restore env) (restore continue) ; (if ... (test (op false?) (reg val)) (branch (label false-branch6)) true-branch5 ; The base case. Here we return product (assign val (op lookup-variable-value) (const product) (reg env)) (goto (reg continue)) false-branch6 (assign proc (op lookup-variable-value) (const iter) (reg env)) (save continue) (save proc) (save env) ; (+ counter 1) (assign proc (op lookup-variable-value) (const +) (reg env)) (assign val (const 1)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const counter) (reg env)) (assign argl (op cons) (reg val) (reg argl)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch14)) compiled-branch15 (assign continue (label after-call16)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch14 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) after-call16 (assign argl (op list) (reg val)) (restore env) (save argl) ; (* counter product) (assign proc (op lookup-variable-value) (const *) (reg env)) (assign val (op lookup-variable-value) (const product) (reg env)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const counter) (reg env)) (assign argl (op cons) (reg val) (reg argl)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch11)) compiled-branch12 (assign continue (label after-call13)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch11 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) after-call13 ; Here we actually execute the recursive call to iter. iter is already ; stored in proc (restore argl) (assign argl (op cons) (reg val) (reg argl)) (restore proc) (restore continue) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch17)) compiled-branch18 ; This is the tail recursive part. Nothing is saved, instead the ; computation proceeds with the next first instruction in iter. This ; makes it not use up stack space. (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch17 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (goto (reg continue)) after-call19 after-if7 after-lambda4 (perform (op define-variable!) (const iter) (reg val) (reg env)) (assign val (const ok)) (assign proc (op lookup-variable-value) (const iter) (reg env)) (assign val (const 1)) (assign argl (op list) (reg val)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch20)) compiled-branch21 (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch20 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (goto (reg continue)) after-call22 after-lambda2 (perform (op define-variable!) (const factorial) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)))) ; Here we generate the compiled version. (load-relative "showcase/compiler/helpers.scm") (define factorial-iter-code '(define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* counter product) (+ counter 1)))) (iter 1))) (pretty-print (compiled-instructions factorial-iter-code)) ================================================ FILE: scheme/sicp/05/35.scm ================================================ ; SICP exercise 5.35 ; ; What expression was compiled to produce the code shown in figure 5.18? (define figure-5-18 '( (assign val (op make-compiled-procedure) (label entry16) (reg env)) (goto (label after-lambda15)) entry16 (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const (x)) (reg argl) (reg env)) (assign proc (op lookup-variable-value) (const +) (reg env)) (save continue) (save proc) (save env) (assing proc (op lookup-variable-value) (const g) (reg env)) (save proc) (assign proc (op lookup-variable-value) (const +) (reg env)) (assign val (const 2)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const x) (reg env)) (assign argl (op cons) (reg val) (reg argl)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch19)) compiled-branch18 (assign continue (label after-call17)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch19 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) after-call17 (assign argl (op list) (reg val)) (restore proc) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch22)) compiled-branch21 (assign continue (label after-call20)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch22 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) after-call20 (assign argl (op list) (reg val)) (restore env) (assign val (lookup-variable-value (const x) (reg env))) (assign argl (op cons) (reg val) (reg argl)) (restore proc) (restore continue) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch25)) compiled-branch24 (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch25 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (goto (reg continue)) after-call23 after-lambda15 (perform (op define-variable!) (const f) (reg val) (reg env)) (assign val (const ok)))) (define expression-to-be-compiled '(define (f x) (+ x (g (+ x 2))))) ================================================ FILE: scheme/sicp/05/36.scm ================================================ ; SICP exercise 5.36 ; ; What order of evaluation does our compiler produce for operands of a ; combination? Is it left-to-right, right-to-left, or some other order? Where ; in the compiler is this order determined? Modify the compiler so that it ; produces some other order of evaluation. (See the discussion of order of ; evaluation for the explicit-control evaluator in section 5.4.1). How does ; changing the order of operand evaluation affect the efficiency of the code ; that constructs the argument list? ; The compiler evaluates right-to-left. We can modify it by not reversing in ; construct-arglist and reverse argl instead, once we've accumulated all the ; arguments in it. This is less efficient, since we're doing the reverse ; run-time instead of compile-time. (define extra-operations (list (list 'reverse reverse))) (define (construct-arglist operand-codes) (let ((operand-codes operand-codes)) (if (null? operand-codes) (make-instruction-sequence '() '(argl) '((assign argl (const ())))) (let ((code-to-get-last-arg (append-instruction-sequences (car operand-codes) (make-instruction-sequence '(val) '(argl) '((assign argl (op list) (reg val))))))) (if (null? (cdr operand-codes)) code-to-get-last-arg (preserving '(env) code-to-get-last-arg (append-instruction-sequences (code-to-get-rest-args (cdr operand-codes)) (make-instruction-sequence '(argl) '() '((assign argl (op reverse) (reg argl))))))))))) ================================================ FILE: scheme/sicp/05/37.scm ================================================ ; SICP exercise 5.37 ; ; One way to understand the compiler's preserving mechanism for optimizing ; stack usage is to see what extra operations would be generated if we did not ; use this idea. Modify preserving so that it always generates the save and ; restore operations. Compile some simple expressions and identify the ; unnecessary stack operations that are generated. Compare the code to that ; generated with the preserving mechanism intact. ; For the simple expression (define simple-if '(if true 1 0)) ; There are 10 additional saves and restores: (define annotated-unoptimized-code '( (save continue) ; extra (save env) ; extra (save continue) ; extra (assign val (op lookup-variable-value) (const true) (reg env)) (restore continue) ; extra (restore env) ; extra (restore continue) ; extra (test (op false?) (reg val)) (branch (label false-branch5)) true-branch4 (save continue) ; extra (assign val (const 1)) (restore continue) ; extra (goto (reg continue)) false-branch5 (save continue) ; extra (assign val (const 0)) (restore continue) ; extra (goto (reg continue)) after-if6)) ; In the original code there are no saves and restores. Here is how to ; generate it: (load-relative "showcase/compiler/helpers.scm") (define with-optimization (compiled-instructions simple-if)) (define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) (preserving (cdr regs) (make-instruction-sequence (list-union (list first-reg) (registers-needed seq1)) (list-difference (registers-modified seq1) (list first-reg)) (append `((save ,first-reg)) (statements seq1) `((restore ,first-reg)))) seq2)))) (define without-optimization (compiled-instructions simple-if)) (printf "With optimization:\n") (pretty-print with-optimization) (printf "\n\nWithout optimization:\n") (pretty-print without-optimization) ================================================ FILE: scheme/sicp/05/38.scm ================================================ ; SICP exercise 5.38 ; ; Our compiler is clever about avoiding unnecessary stack operations, but it ; is not clever at all when it comes to compiling calls to the primitive ; procedures of the language in terms of the primitive operations supplied by ; the machine. For example, consider how much code is compiled to compute ; (+ a 1): The code sets up an argument list in argl, puts the primitive ; addition procedure (which it finds by lookup up the symbol + in the ; environment) into proc, and tests whether the procedure is primitive or ; compound. The compiler always generates code to perform the test, as well as ; code for primitive and compound branches (only one of which will be ; executed). We have not shown the part of the controller that implements ; primitives, but we presume that these instructions make use of primitive ; arithmetic operations in the machine's data path. Consider how much less ; code would be generated if the compiler could open-code primitives -- that ; is, if it could generate code to directly use these primitive machine ; operations. The expression (+ a 1) might be compiled into something as ; simple as ; ; (assign val (op lookup-variable-value) (const a) (reg env)) ; (assign val (op +) (reg val) (const 1)) ; ; In this exercise, we will extend our compiler to support open coding of ; selected primitives. Special-purpose code will be generated fo calls to ; these primitive procedures instead of the general proedure-application code. ; In order to support this, we will augment our machine with special argument ; registers arg1 and arg2. The primitive arithmetic operations of the machine ; will take their inputs from arg1 and arg2. The results may be put into val, ; arg1, or arg2. ; ; The compiler must be able to recognize the application of an open-coded ; primitive in the source program. We will augment the dispatch in the compile ; procedure to recognize the names of these primitives in addition to the ; reserved words (the special forms) it currently recognizes. For each special ; form our compiler has a code generator. In this exercise we will construct a ; family of code generators for the open-coded primitives. ; ; a. The open-coded primitives, unlike the special forms, all need their ; operands evaluated. Write a code generator spread-arguments for use by all ; the open-coding code generators. spread-arguments should take an operand ; list and compile the given operands targeted to successive argument ; registers. Note that an operand may contain a call to an open-coded ; primitive, so argument registers will have to be preserved during operand ; evaluation. ; ; b. For each of the primitive procedures =, *, -, and +, write a code ; generator that takes a combination with that operator, together with a ; target and a linkage descriptor, and produces code to spread the arguments ; into the registers and then performs the operation targeted to the given ; target with the given linkage. You need only handle expressions with two ; operands. Make compile dispatch to these code generators. ; ; c. Try your new compiler on the factorial example. Compare the resulting ; code with the result produced without open coding. ; ; d. Extend your code generators for + and * so that they can handle ; expressions with arbitrary numbers of operands. An expression with more ; than two operands will have to be compiled into a sequence of operations, ; each with only two inputs. ; I will just ignore the spread-arguments nonsense, since I cannot figure out ; how to get it working with the results I want. ; ; What I want is the expression (+ 1 2 3) to be compiled to: ; ; (assign arg1 (const 1)) ; (assign arg2 (const 2)) ; (assign arg1 (op +) (reg arg1) (reg arg2)) ; (assign arg2 (const 3)) ; (assign val (op +) (reg arg1) (reg arg2)) ; ; That is, the first operand gets assign to arg1 and every other gets assigned ; to arg2 and subsequently added to arg1. ; The compiled factorial is below. The differences are highlighted. (define compiled-factorial '( (assign val (op make-compiled-procedure) (label entry1) (reg env)) (goto (label after-lambda2)) entry1 (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const (n)) (reg argl) (reg env)) ; ; We don't need to do a call here, which removes a bunch of instructions ; and a save/restore of continue and env (assign arg1 (op lookup-variable-value) (const n) (reg env)) (assign arg2 (const 1)) (assign val (op =) (reg arg1) (reg arg2)) ; (test (op false?) (reg val)) (branch (label false-branch4)) true-branch3 (assign val (const 1)) (goto (reg continue)) false-branch4 ; ; We skip another call, which saves a save/restore of proc and argl and ; another bunch of instruction (save continue) (save env) ; Saving env happens here, instead of when entering the procedure (assign proc (op lookup-variable-value) (const factorial) (reg env)) (assign arg1 (op lookup-variable-value) (const n) (reg env)) (assign arg2 (const 1)) (assign val (op -) (reg arg1) (reg arg2)) ; (assign argl (op list) (reg val)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch6)) compiled-branch7 (assign continue (label proc-return9)) ; Different return label (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) proc-return9 ; This is different, since we store result in arg1, not val. (assign arg1 (reg val)) (goto (label after-call8)) primitive-branch6 (assign arg1 (op apply-primitive-procedure) (reg proc) (reg argl)) after-call8 ; ; We save another call, including a save/restore of argl. (restore env) (restore continue) (assign arg2 (op lookup-variable-value) (const n) (reg env)) (assign val (op *) (reg arg1) (reg arg2)) ; (goto (reg continue)) after-if5 after-lambda2 (perform (op define-variable!) (const factorial) (reg val) (reg env)) (assign val (const ok)))) ; I need to modify compile-exp to check if an operation should be open-coded. (define (compile-exp exp target linkage) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage)) ((assignment? exp) (compile-assignment exp target linkage)) ((definition? exp) (compile-definition exp target linkage)) ((if? exp) (compile-if exp target linkage)) ((lambda? exp) (compile-lambda exp target linkage)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage)) ((cond? exp) (compile-exp (cond->if exp) target linkage)) ((open-coded? exp) (compile-open-coded exp target linkage)) ((application? exp) (compile-application exp target linkage)) (else (error "Unknown expression type -- COMPILE" exp)))) ; I need to add arg1 and arg2 to all-regs, so they will be preserved when ; there is a function call. (define all-regs (append '(arg1 arg2) all-regs)) ; Methods to check open coding (define (open-coded? exp) (and (pair? exp) (memq (car exp) '(+ * - =)))) (define (vararg-open-coded-exp? exp) (and (pair? exp) (memq (car exp) '(+ *)))) ; The real work (define (compile-open-coded exp target linkage) (when (and (not (vararg-open-coded-exp? exp)) (not (= (length exp) 3))) (error "Expression should be binary" exp)) (let ((code (car exp)) (first-operand (cadr exp)) (rest-operands (cddr exp))) (preserving '(env continue) (compile-exp first-operand 'arg1 'next) (compile-open-coded-rest-args code rest-operands target linkage)))) (define (compile-open-coded-rest-args code operands target linkage) (if (null? (cdr operands)) (preserving '(arg1 continue) (compile-exp (car operands) 'arg2 'next) (end-with-linkage linkage (make-instruction-sequence '(arg1 arg2) (list target) `((assign ,target (op ,code) (reg arg1) (reg arg2)))))) (preserving '(env continue) (preserving '(arg1) (compile-exp (car operands) 'arg2 'next) (make-instruction-sequence '(arg1 arg2) '(arg1) `((assign arg1 (op ,code) (reg arg1) (reg arg2))))) (compile-open-coded-rest-args code (cdr operands) target linkage)))) (define factorial-code '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) ;(pretty-print (statements (compile-exp factorial-code 'val 'next))) ================================================ FILE: scheme/sicp/05/39.scm ================================================ ; SICP exercise 5.39 ; ; Write a procedure lexical-address-lookup that implements the new lookup ; operation. It should take two arguments -- a lexical address and a run-time ; environment -- and return the value of the variable stored at the specified ; lexical address. lexical-address-lookup should signal an error if the value ; of the variable is the symbol *unassigned*. Also, write a procedure ; lexical-address-set! that implements the operation that changes the value of ; the variable at a specified lexical address. (define (lexical-address-lookup address env) (define (env-ref offset env) (if (= offset 0) (frame-values (first-frame env)) (env-ref (- offset 1) (enclosing-environment env)))) (define (frame-ref offset vals) (if (= offset 0) (mcar vals) (frame-ref (- offset 1) (mcdr vals)))) (let ((result (frame-ref (cadr address) (env-ref (car address) env)))) (if (eq? result '*unassigned*) (error "Unassigned variable" address) result))) (define (lexical-address-set! address val env) (define (env-ref offset env) (if (= offset 0) (frame-values (first-frame env)) (env-ref (- offset 1) (enclosing-environment env)))) (define (frame-set! offset vals) (if (= offset 0) (set-mcar! vals val) (frame-set! (- offset 1) (mcdr vals)))) (frame-set! (cadr address) (env-ref (car address) env))) ================================================ FILE: scheme/sicp/05/40.scm ================================================ ; SICP exercise 5.40 ; ; Modify the compiler to maintain the compile-time environment as described ; above. That is, add a compile-time-environment argument to compile and the ; various code-generators, and extend it in compile-lambda-body (load-relative "39.scm") ; Construction of the compile-time environment (define (empty-compile-time-env) '()) (define (extend-compile-time-environment formals env) (cons formals env)) ; The modifications of the compiler (define (compile-exp exp target linkage env) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage env)) ((assignment? exp) (compile-assignment exp target linkage env)) ((definition? exp) (compile-definition exp target linkage env)) ((if? exp) (compile-if exp target linkage env)) ((lambda? exp) (compile-lambda exp target linkage env)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage env)) ((cond? exp) (compile-exp (cond->if exp) target linkage env)) ((application? exp) (compile-application exp target linkage env)) (else (error "Unknown expression type -- COMPILE" exp)))) (define (compile-variable exp target linkage env) (end-with-linkage linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op lookup-variable-value) (const ,exp) (reg env)))))) (define (compile-assignment exp target linkage env) (let ((var (assignment-variable exp)) (get-value-code (compile-exp (assignment-value exp) 'val 'next env))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op set-variable-value!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))))) (define (compile-definition exp target linkage env) (let ((var (definition-variable exp)) (get-value-code (compile-exp (definition-value exp) 'val 'next env))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op define-variable!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))))) (define (compile-if exp target linkage env) (let ((t-branch (make-label 'true-branch)) (f-branch (make-label 'false-branch)) (after-if (make-label 'after-if))) (let ((consequent-linkage (if (eq? linkage 'next) after-if linkage))) (let ((p-code (compile-exp (if-predicate exp) 'val 'next env)) (c-code (compile-exp (if-consequent exp) target consequent-linkage env)) (a-code (compile-exp (if-alternative exp) target linkage env))) (preserving '(env continue) p-code (append-instruction-sequences (make-instruction-sequence '(val) '() `((test (op false?) (reg val)) (branch (label ,f-branch)))) (parallel-instruction-sequences (append-instruction-sequences t-branch c-code) (append-instruction-sequences f-branch a-code)) after-if)))))) (define (compile-sequence seq target linkage env) (if (last-exp? seq) (compile-exp (first-exp seq) target linkage env) (preserving '(env continue) (compile-exp (first-exp seq) target 'next env) (compile-sequence (rest-exps seq) target linkage env)))) (define (compile-lambda exp target linkage env) (let ((proc-entry (make-label 'entry)) (after-lambda (make-label 'after-lambda))) (let ((lambda-linkage (if (eq? linkage 'next) after-lambda linkage))) (append-instruction-sequences (tack-on-instruction-sequence (end-with-linkage lambda-linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op make-compiled-procedure) (label ,proc-entry) (reg env))))) (compile-lambda-body exp proc-entry env)) after-lambda)))) (define (compile-lambda-body exp proc-entry env) (let ((formals (lambda-parameters exp))) (append-instruction-sequences (make-instruction-sequence '(env proc argl) '(env) `(,proc-entry (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const ,formals) (reg argl) (reg env)))) (compile-sequence (lambda-body exp) 'val 'return (extend-compile-time-environment formals env))))) (define (compile-application exp target linkage env) (let ((proc-code (compile-exp (operator exp) 'proc 'next env)) (operand-codes (map (lambda (operand) (compile-exp operand 'val 'next env)) (operands exp)))) (preserving '(env continue) proc-code (preserving '(proc continue) (construct-arglist operand-codes) (compile-procedure-call target linkage env))))) (define (compile-procedure-call target linkage env) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (after-call (make-label 'after-call))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() `((test (op primitive-procedure?) (reg proc)) (branch (label ,primitive-branch)))) (parallel-instruction-sequences (append-instruction-sequences compiled-branch (compile-proc-appl target compiled-linkage env)) (append-instruction-sequences primitive-branch (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl))))))) after-call)))) (define (compile-proc-appl target linkage env) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,linkage)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val))))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((proc-return (make-label 'proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,proc-return)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) ,proc-return (assign ,target (reg val)) (goto (label ,linkage)))))) ((and (eq? target 'val) (eq? linkage 'return)) (make-instruction-sequence '(proc continue) all-regs `((assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val))))) ((and (not (eq? target 'val)) (eq? linkage 'return)) (error "return linkage, target not val -- COMPILE-EXP" target)) (else (error "How did we get here?")))) ; Some of the helpers, needed in subsequent exercises (define extra-operations (list (list 'lexical-address-lookup lexical-address-lookup) (list 'lexical-address-set! lexical-address-set!) (list 'the-global-environment get-global-environment))) (define extra-registers '()) (define (make-explicit+compile-machine) (make-machine (append ec-registers extra-registers) (append cm-operations extra-operations) explicit+compile-text)) (define (compile-in-machine machine expression) (let ((instructions (assemble (statements (compile-exp expression 'val 'return (empty-compile-time-env))) machine))) (set-register-contents! machine 'env the-global-environment) (set-register-contents! machine 'val instructions) (set-register-contents! machine 'flag true) (start machine))) (define (compiled-instructions expression) (statements (compile-exp expression 'val 'return (empty-compile-time-env)))) ================================================ FILE: scheme/sicp/05/41.scm ================================================ ; SICP exercise 5.41 ; ; Write a procedure find-variable that takes as arguments a variable and a ; compile-time environment and returns the lexical address of the variable ; with respect to that environment. For example, in the program fragment shown ; above, the compile-time environment during the compilation of expression ; is ((y z) (a b c d e) (x y)). find-variable should produce ; ; (find-variable 'c '((y z) (a b c d e) (x y))) ; (1 2) ; ; (find-variable 'x '((y z) (a b c d e) (x y))) ; (2 0) ; ; (find-variable 'w '((y z) (a b c d e) (x y))) ; not-found (define (find-variable var env) (define (loop frame position vars env) (cond ((and (null? vars) (null? (cdr env))) 'not-found) ((null? vars) (loop (+ frame 1) 0 (cadr env) (cdr env))) ((eq? (car vars) var) (list frame position)) (else (loop frame (+ position 1) (cdr vars) env)))) (if (null? env) 'not-found (loop 0 0 (car env) env))) ================================================ FILE: scheme/sicp/05/42.scm ================================================ ; SICP exercise 5.42 ; ; Using find-variable from exercise 5.41, rewrite compile-variable and ; compile-assignment to output lexical address instructions. In cases where ; find-variable returns not-found (that is, where the variable is not in the ; compile-time environment), you should have the code generators use the ; evaluator operations, as before, to search for the binding. (The only place ; a variable that is not found at compile time can be is the global ; environment, which is part of the run-time environment but is not part of ; the compile-time environment. Thus, if you wish, you may have the evaluator ; operations look directly in the global environment, which can be obtained ; with the operation (op get-global-environment), instead of having them ; search the whole run-time environment found in env.) Test the modified ; compiler of a few simple cases, such as the nested lambda combination at the ; beginning of this section. (load-relative "40.scm") (load-relative "41.scm") (define (compile-variable exp target linkage env) (let ((address (find-variable exp env))) (if (eq? address 'not-found) (end-with-linkage linkage (make-instruction-sequence '(env) (list target 'env) `((assign env (op the-global-environment)) (assign ,target (op lookup-variable-value) (const ,exp) (reg env))))) (end-with-linkage linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op lexical-address-lookup) (const ,address) (reg env)))))))) (define (compile-assignment exp target linkage env) (let ((var (assignment-variable exp)) (get-value-code (compile-exp (assignment-value exp) 'val 'next env))) (let ((address (find-variable var env))) (if (eq? address 'not-found) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target 'env) `((assign env (op the-global-environment)) (perform (op set-variable-value!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op lexical-address-set!) (const ,address) (reg val) (reg env)) (assign ,target (const ok)))))))))) ================================================ FILE: scheme/sicp/05/43.scm ================================================ ; SICP exercise 5.43 ; ; We argued in section 4.1.6 that internal definitions for block structure ; should not be considered "real" defines. Rather, a procedure body should be ; interpreted as if the internal variables being defined were installed as ; ordinary lambda variables initialized to their correct values using set!. ; Section 4.1.6 and exercise 4.16 showed how to modify the metacircular ; interpreter to accomplish this by scanning out internal definitions. Modify ; the compiler to perform the same transformations before it compiles a ; procedure body. (load-relative "42.scm") ; First, here is the support for let. (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) ; Second, here is scan-out-defines. (define (scan-out-defines body) (define (definitions-in body) (cond ((null? body) '()) ((definition? (car body)) (cons (car body) (definitions-in (cdr body)))) (else (definitions-in (cdr body))))) (define (body-without-definitions body) (cond ((null? body) '()) ((definition? (car body)) (body-without-definitions (cdr body))) (else (cons (car body) (body-without-definitions (cdr body)))))) (define (definition->unassigned-pair definition) (list (definition-variable definition) ''*unassigned*)) (define (definition->set! definition) (list 'set! (definition-variable definition) (definition-value definition))) (define (defines->let definitions body) (list (cons 'let (cons (map definition->unassigned-pair definitions) (append (map definition->set! definitions) body))))) (let ((internal-definitions (definitions-in body))) (if (null? internal-definitions) body (defines->let internal-definitions (body-without-definitions body))))) ; This time we hook it to lambda-body (define (lambda-body exp) (scan-out-defines (cddr exp))) ; We also need to modify compile in order to pick up lets (define (compile-exp exp target linkage env) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage env)) ((assignment? exp) (compile-assignment exp target linkage env)) ((definition? exp) (compile-definition exp target linkage env)) ((if? exp) (compile-if exp target linkage env)) ((lambda? exp) (compile-lambda exp target linkage env)) ((let? exp) (compile-exp (let->combination exp) target linkage env)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage env)) ((cond? exp) (compile-exp (cond->if exp) target linkage env)) ((application? exp) (compile-application exp target linkage env)) (else (error "Unknown expression type -- COMPILE" exp)))) ================================================ FILE: scheme/sicp/05/44.scm ================================================ ; SICP exercise 5.44 ; ; In this section we have focused on the use of the compile-time environment ; to produce lexical addresses. But there are other uses for compile-time ; environments. For instance, in exercise 5.38 we increased the efficiency of ; compiled code by open-coding primitive procedures. Our implementation ; treated the names of open-coded procedures as reserved words. If a program ; were to rebind such a name, the mechanism described in exercise 5.38 would ; still open-code it as a primitive, ignoring the new binding. For example, ; consider the procedure ; ; (lambda (+ * a b x y) ; (+ (* a x) (* b y))) ; ; which computes a linear combination of x and y. We might call it with ; arguments +matrix, *matrix, and four matrices, but the open-coded compiler ; would still open-code the + and the * in (+ (* a x) (* b y)) as primitive + ; and *. Modify the open-coding compiler to consult the compile-time ; environment in order to compile the correct code for expressions involving ; the names of primitive procedures. (The code will work correctly as long as ; the program does not define or set! these names.) (load-relative "43.scm") ; We just lift the code from 4.38 and modify it: (define extra-registers '(arg1 arg2)) (define extra-operations (append extra-operations `((+ ,+) (- ,-) (* ,*) (= ,=)))) (define all-regs (append '(arg1 arg2) all-regs)) (define (open-coded? exp env) (and (pair? exp) (memq (car exp) '(+ * - =)) (eq? (find-variable (car exp) env) 'not-found))) (define (vararg-open-coded-exp? exp) (and (pair? exp) (memq (car exp) '(+ *)))) (define (compile-open-coded exp target linkage env) (when (and (not (vararg-open-coded-exp? exp)) (not (= (length exp) 3))) (error "Expression should be binary" exp)) (let ((code (car exp)) (first-operand (cadr exp)) (rest-operands (cddr exp))) (preserving '(env continue) (compile-exp first-operand 'arg1 'next env) (compile-open-coded-rest-args code rest-operands target linkage env)))) (define (compile-open-coded-rest-args code operands target linkage env) (if (null? (cdr operands)) (preserving '(arg1 continue) (compile-exp (car operands) 'arg2 'next env) (end-with-linkage linkage (make-instruction-sequence '(arg1 arg2) (list target) `((assign ,target (op ,code) (reg arg1) (reg arg2)))))) (preserving '(env continue) (preserving '(arg1) (compile-exp (car operands) 'arg2 'next env) (make-instruction-sequence '(arg1 arg2) '(arg1) `((assign arg1 (op ,code) (reg arg1) (reg arg2))))) (compile-open-coded-rest-args code (cdr operands) target linkage env)))) ; We also need to modify compile from 4.43 (define (compile-exp exp target linkage env) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage env)) ((assignment? exp) (compile-assignment exp target linkage env)) ((definition? exp) (compile-definition exp target linkage env)) ((if? exp) (compile-if exp target linkage env)) ((lambda? exp) (compile-lambda exp target linkage env)) ((let? exp) (compile-exp (let->combination exp) target linkage env)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage env)) ((cond? exp) (compile-exp (cond->if exp) target linkage env)) ((open-coded? exp env) (compile-open-coded exp target linkage env)) ((application? exp) (compile-application exp target linkage env)) (else (error "Unknown expression type -- COMPILE" exp)))) ================================================ FILE: scheme/sicp/05/45.scm ================================================ ; SICP exercise 5.45 ; ; By comparing the stack operations used by compiled code to the stack ; operations used by the evaluator for the same computation, we can determine ; the extent to which the compiler optimizes use of the stack, both in speed ; (reducing the total number of stack operations) and in space (reducing the ; maximum stack depth). Comparing this optimized stack use to performance of a ; special-purpose machine for the same computation gives some indication of ; the quality of the compiler. ; ; a. Exercise 5.27 asked you to determine, as a function of n, the number of ; pushes and the number of maximum stack depth needed by the evaluator to ; compute n! using the recursive factorial procedure given above. Exercise ; 5.14 asked you to do the same measurements for the special-purpose factorial ; machine shown in figure 5.11. Now perform the same analysis using the ; compiled factorial procedure. ; ; Take the ratio of the number of pushes in the compiled version to the number ; of pushes in the interpreted version, and do the same for the maximum stack ; depth. Since the number of operations and the stack depth used to compute n! ; are linear in n, these ratios should approach constants as n becomes large. ; What are these constants? Similarly, find the ratios of the stack usage in a ; special-purpose machine to the usage in the interpreted version. ; ; Compare the ratios for the special-purpose versus interpreted code to the ; ratios for compiled versus interpreted code. You should find that the ; special-purpose machine does much better than the compiled code, since the ; hand-tailored controller code should be much better than what is produced by ; our rudimentary general-purpose compiler. ; ; b. Can you suggest improvements to the compiler that would help it generate ; code that would come closer in performance to the hand-tailored version? ; a. Let's compare both the open-coding compiler and the simpler one. ; ; Without open-coding optimizations: ; 1! takes (total-pushes = 7 maximum-depth = 3) ; 2! takes (total-pushes = 13 maximum-depth = 5) ; 3! takes (total-pushes = 19 maximum-depth = 8) ; 4! takes (total-pushes = 25 maximum-depth = 11) ; 5! takes (total-pushes = 31 maximum-depth = 14) ; 6! takes (total-pushes = 37 maximum-depth = 17) ; 7! takes (total-pushes = 43 maximum-depth = 20) ; 8! takes (total-pushes = 49 maximum-depth = 23) ; 9! takes (total-pushes = 55 maximum-depth = 26) ; With open-coding optimizations: ; 1! takes (total-pushes = 5 maximum-depth = 3) ; 2! takes (total-pushes = 7 maximum-depth = 3) ; 3! takes (total-pushes = 9 maximum-depth = 4) ; 4! takes (total-pushes = 11 maximum-depth = 6) ; 5! takes (total-pushes = 13 maximum-depth = 8) ; 6! takes (total-pushes = 15 maximum-depth = 10) ; 7! takes (total-pushes = 17 maximum-depth = 12) ; 8! takes (total-pushes = 19 maximum-depth = 14) ; 9! takes (total-pushes = 21 maximum-depth = 16) ; ; As usual, code to reproduce is below. ; ; Now we can do a table ; +----+-----------------------+-----------------------+ ; | | total-pushes | maximum-depth | ; | +-----+-----+-----+-----+-----+-----+-----+-----+ ; | | int | cmp | opc | sht | int | cmp | opc | sht | ; +----+-----+-----+-----+-----+-----+-----+-----+-----+ ; | 1! | 16 | 7 | 5 | 0 | 8 | 3 | 3 | 0 | ; | 2! | 48 | 13 | 7 | 2 | 13 | 5 | 3 | 2 | ; | 3! | 80 | 19 | 9 | 4 | 18 | 8 | 4 | 4 | ; | 4! | 112 | 25 | 11 | 6 | 23 | 11 | 6 | 6 | ; | 5! | 144 | 31 | 13 | 8 | 28 | 14 | 8 | 8 | ; | 6! | 176 | 37 | 15 | 10 | 33 | 17 | 10 | 10 | ; | 7! | 208 | 43 | 17 | 12 | 38 | 20 | 12 | 12 | ; | 8! | 240 | 49 | 19 | 14 | 43 | 23 | 14 | 14 | ; | 9! | 272 | 55 | 21 | 16 | 48 | 26 | 16 | 16 | ; +----+-----+-----+-----+-----+-----+-----+-----+-----+ ; Legend: * int - interpreted ; * cmp - compiled with the 5.5 compiler ; * opc - compiled with open-coding primitives ; * sht - special hand-tailored version ; ; We can compare ratios by comparing the ratio of the differences between ; computing n! and (n + 1)! ; ; total pushes: ; int / cmp is 32 / 6 ≈ 5.333 ; int / opc is 32 / 2 = 16.0 ; cmp / sht is 6 / 2 = 3.0 ; opc / sht is 2 / 2 = 1.0 ; ; That is, the compiled code is 5.3 times faster than the interpreted (16 ; times if open-coding instructions) and the hand-tailored version is 3 times ; faster than the copmiled (or as fast with the hand-tailored version). ; ; maximum-depth ; int / cmp is 5 / 3 ≈ 1.666 ; int / opc is 5 / 2 = 2.5 ; cmp / sht is 3 / 2 = 1.5 ; opc / sht is 2 / 2 = 1.0 ; ; That is, the compiled code uses 1.66 less space than the interpreted (2.5 ; times less if open-coding instructions) and the hand-tailored version uses ; 1.5 less space than the compiled (or as much if open-coding instructions). ; ; Note that we're speaking asymptotically and we're ignoring the number of ; performed instructions as opposed to checking stack pushes. ; ; b. Open-coding comes pretty near. Of course, this assumes that the ; instruction count does not matter. There are two thinks we can do to get ; even closer. ; ; First, we can do away with storing variables in environments and just use ; the registers. That way we will eliminate environment lookup for n and ; factorial. ; ; Second, we can replace the check if factorial is a primitive procedure with ; a jump to the beginning of the function. ; ; Those two along with open-coding will come to pretty much the same code as ; the hand-tailored version. (load-relative "showcase/compiler/helpers.scm") (load-relative "tests/helpers/monitored-stack.scm") (define code '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) (define (report-stats) (define machine (make-machine (append '(arg1 arg2) ec-registers) (append `((+ ,+) (- ,-) (* ,*) (= ,=)) cm-operations) explicit+compile-text)) (compile-in-machine machine code) (for ([n (in-range 1 10)]) (set-register-contents! machine 'flag false) (printf " ~a! takes ~a\n" n (stack-stats-for machine (list 'factorial n))))) (printf "Without open-coding optimizations:\n") (report-stats) (load-relative "38.scm") (printf "With open-coding optimizations:\n") (report-stats) ================================================ FILE: scheme/sicp/05/46.scm ================================================ ; SICP exercise 5.46 ; ; Carry out an analysis like the one in exercise 5.45 to determine the ; effectiveness of compiling the tree-recursive Fibonacci procedure ; ; (define (fib n) ; (if (< n 2) ; n ; (+ (fib (- n 1)) (fib (- n 2))))) ; ; compared to the effectiveness of using the special-purpose Fibonacci machine ; of figure 5.12. (For measurement of the interpreted performance, see ; exercise 5.29). For Fibonacci, the time resource used is not linear in n; ; hence the ratios of stack operations will not approach a limiting value that ; is independent of n. ; Here are the results in a table (this time generated with Racket): ; ; +--------+------------------------+-----------------------+ ; | | total-pushes | maximum-depth | ; | +------+-----+-----+-----+-----+-----+-----+-----+ ; | | int | cmp | opc | sh | int | cmp | opc | sht | ; +--------+------+-----+-----+-----+-----+-----+-----+-----+ ; | fib(1) | 16 | 7 | 7 | 0 | 8 | 3 | 3 | 0 | ; | fib(2) | 72 | 17 | 15 | 3 | 13 | 5 | 4 | 2 | ; | fib(3) | 128 | 27 | 23 | 6 | 18 | 8 | 6 | 4 | ; | fib(4) | 240 | 47 | 39 | 12 | 23 | 11 | 8 | 6 | ; | fib(5) | 408 | 77 | 63 | 21 | 28 | 14 | 10 | 8 | ; | fib(6) | 688 | 127 | 103 | 36 | 33 | 17 | 12 | 10 | ; | fib(7) | 1136 | 207 | 167 | 60 | 38 | 20 | 14 | 12 | ; | fib(8) | 1864 | 337 | 271 | 99 | 43 | 23 | 16 | 14 | ; | fib(9) | 3040 | 547 | 439 | 162 | 48 | 26 | 18 | 16 | ; +--------+------+-----+-----+-----+-----+-----+-----+-----+ ; Legend: * int - interpreted ; * cmp - compiled with the 5.5 compiler ; * opc - compiled with open-coding primitives ; * sht - special hand-tailored version ; ; If we stare at the total pushes for a while, we figure out that: ; - int grows with 56 * fib(n) on each iteration ; - cmp grows with 10 * fib(n) on each iteration ; - opc grows with 8 * fib(n) on each iteration ; - sht grows with 3 * fib(n) on each iteration ; ; As for the maximum-depth: ; - int takes 5n + 3 ; - cmp takes 3n - 1 (except for 1 and 2) ; - opc takes 2n (except for 1 and 2) ; - sht takes 2n - 2 ; ; It is worth noting that this time opc is around 2.66 slower than sht (in ; comparison to the previous exercise) because the exponential growth of the ; function makes those extra saves and restores really count. (require (prefix-in srfi: srfi/48)) (load-relative "showcase/compiler/helpers.scm") (load-relative "tests/helpers/monitored-stack.scm") ; This is the recursive procedure: (define code '(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))) ; Let's use the 5.06 version of the Fibonacci machine (define sht-machine (make-machine '(n val continue) (list (list '< <) (list '- -) (list '+ +)) '( (assign continue (label fib-done)) fib-loop (test (op <) (reg n) (const 2)) (branch (label immediate-answer)) (save continue) (assign continue (label after-fib-n-1)) (save n) (assign n (op -) (reg n) (const 1)) (goto (label fib-loop)) after-fib-n-1 (restore n) (assign n (op -) (reg n) (const 2)) (assign continue (label after-fib-n-2)) (save val) (goto (label fib-loop)) after-fib-n-2 (assign n (reg val)) (restore val) (restore continue) (assign val (op +) (reg val) (reg n)) (goto (reg continue)) immediate-answer (assign val (reg n)) (goto (reg continue)) fib-done))) ; Code that gathers stats (define (gather-stats machine name callback) (printf "~a:\n" name) (for/list ([n (in-range 1 10)]) (set-register-contents! machine 'flag false) (let ((stats (callback n))) (printf " fib(~a) takes ~a\n" n stats) (list (third stats) (sixth stats))))) (define (build-machine) (make-machine (append '(arg1 arg2) ec-registers) (append `((+ ,+) (- ,-) (* ,*) (= ,=)) cm-operations) explicit+compile-text)) ; Stats for interpretation (define int-machine (build-machine)) (eval-in-machine int-machine code) (define int-stats (gather-stats int-machine "Interpreted code" (lambda (n) (stack-stats-for int-machine (list 'fib n))))) ; Stats for compilation (define cmp-machine (build-machine)) (compile-in-machine cmp-machine code) (define cmp-stats (gather-stats cmp-machine "Compiled code" (lambda (n) (stack-stats-for cmp-machine (list 'fib n))))) ; Stats for compilation with open-coding primitives (load-relative "38.scm") (define opc-machine (build-machine)) (compile-in-machine opc-machine code) (define opc-stats (gather-stats opc-machine "Compiled code with open-coding" (lambda (n) (stack-stats-for opc-machine (list 'fib n))))) ; Stats for the special hand-tailored version (define sht-stats (gather-stats sht-machine "Special hand-tailored version" (lambda (n) (set-register-contents! sht-machine 'n n) ((sht-machine 'stack) 'initialize) (start sht-machine) ((sht-machine 'stack) 'statistics)))) ; Printing the results in a nice table (define (pad n . args) (srfi:format "~3F" n)) (newline) (printf "The final results:\n") (printf "+--------+------------------------+-----------------------+\n") (printf "| | total-pushes | maximum-depth |\n") (printf "| +------+-----+-----+-----+-----+-----+-----+-----+\n") (printf "| | int | cmp | opc | sh | int | cmp | opc | sht |\n") (printf "+--------+------+-----+-----+-----+-----+-----+-----+-----+\n") (for ([n (in-range 1 10)] [int int-stats] [cmp cmp-stats] [opc opc-stats] [sht sht-stats]) (printf "| fib(~a) | ~a | ~a | ~a | ~a | ~a | ~a | ~a | ~a |\n" n (srfi:format "~4F" (first int)) (pad (first cmp)) (pad (first opc)) (pad (first sht)) (pad (second int)) (pad (second cmp)) (pad (second opc)) (pad (second sht)))) (printf "+--------+------+-----+-----+-----+-----+-----+-----+-----+\n") ================================================ FILE: scheme/sicp/05/47.scm ================================================ ; SICP exercise 5.47 ; ; This section described how to modify the explicit-control evaluator so that ; interpreted code can call compiled procedures. Show how to modify the ; compiler so that compiled procedures can call not only primitive procedures ; and compiled procedures, but interpreted procedures as well. This requires ; modifying compile-procedure-call to handle the case of compound ; (interpreted) procedures. Be sure to handle all the same target and linkage ; combinations as in compile-proc-argl. To do the actual procedure ; application, the code needs to jump to the evaluator's compound-apply entry ; point. This label cannot be directly referenced in object code (since the ; assmebler requires that all labels referenced by the code it is assembling ; be defined there), so we will add a register called compapp to the evaluator ; machine to hold this entry point, and add an instruction to initialize it: ; ; (assign compapp (label compound-apply)) ; (branch (label external-entry)) ; read-eval-print-loop ; ... ; ; To test your code, start by defining a proceudre f that calls a procedure g. ; Use compile-and-go to compile the definition of f and start the evaluator. ; Now, typing at the evalutor, define g and try to call f. ; Yeah, typing in the evalutor. Right. (define ec-registers (cons 'compapp ec-registers)) (define explicit+compile-text (append '((assign compapp (label compound-apply))) explicit+compile-text)) (define (compile-procedure-call target linkage) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (compound-branch (make-label 'compound-branch)) (after-call (make-label 'after-call))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() `((test (op primitive-procedure?) (reg proc)) (branch (label ,primitive-branch)) (test (op compound-procedure?) (reg proc)) (branch (label ,compound-branch)))) (parallel-instruction-sequences (append-instruction-sequences compiled-branch (compile-proc-appl target compiled-linkage)) (parallel-instruction-sequences (append-instruction-sequences compound-branch (compile-compound-appl target compiled-linkage)) (append-instruction-sequences primitive-branch (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl)))))))) after-call)))) (define (compile-compound-appl target linkage) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,linkage)) (save continue) (goto (reg compapp))))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((proc-return (make-label 'proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,proc-return)) (save continue) (goto (reg compapp)) ,proc-return (assign ,target (reg val)) (goto (label ,linkage)))))) ((and (eq? target 'val) (eq? linkage 'return)) (make-instruction-sequence '(proc continue) all-regs `((save continue) (goto (reg compapp))))) ((and (not (eq? target 'val)) (eq? linkage 'return)) (error "return linkage, target not val -- COMPILE-EXP" target)) (else (error "How did we get here?")))) ================================================ FILE: scheme/sicp/05/48.scm ================================================ ; SICP exercise 5.48 ; ; The compile-and-go interface implemented in this section is awkward, since ; the compile cna be called only once (when the evaluator machine is started). ; Augment the compiler-interpreter interface by providing a compile-and-run ; primitive that can be called form within the explicit-control evaluator as ; follows: ; ; ;;; EC-Eval input; ; (compile-and-run ; '(define (factorial n) ; (if (= n 1) ; 1 ; (* (factorial (- n 1)) n)))) ; ;;; EC-Eval value: ; ok ; ;;; EC-Eval input: ; (factorial 5) ; ;;; EC-Eval value: ; 120 (load-relative "showcase/compiler/helpers.scm") (define (compile-and-run? exp) (tagged-list? exp 'compile-and-run)) (define (compile-and-run-body exp) (cadadr exp)) (define (compile-in-machine exp) (assemble (statements (compile-exp exp 'val 'return)) eceval)) (define cm-operations (append cm-operations `((compile-and-run? ,compile-and-run?) (compile-and-run-body ,compile-and-run-body) (compile ,compile-in-machine)))) (define explicit+compile-text '(read-eval-print-loop (perform (op initialize-stack)) (perform (op prompt-for-input) (const ";;; EC-Eval input:")) (assign exp (op read)) (assign env (op get-global-environment)) (assign continue (label print-result)) (goto (label eval-dispatch)) print-result (perform (op announce-output) (const ";;; EC-Eval value:")) (perform (op user-print) (reg val)) (goto (label read-eval-print-loop)) unknown-expression-type (assign val (const unknown-expression-type-error)) (goto (label signal-error)) unknown-procedure-type (restore continue) (assign val (const unknown-procedure-type-error)) (goto (label signal-error)) signal-error (perform (op user-print) (reg val)) (goto (label read-eval-print-loop)) eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) (test (op variable?) (reg exp)) (branch (label ev-variable)) (test (op quoted?) (reg exp)) (branch (label ev-quoted)) (test (op assignment?) (reg exp)) (branch (label ev-assignment)) (test (op definition?) (reg exp)) (branch (label ev-definition)) (test (op if?) (reg exp)) (branch (label ev-if)) (test (op lambda?) (reg exp)) (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) (test (op compile-and-run?) (reg exp)) (branch (label ev-compile-and-run)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ; Compile and run ev-compile-and-run (save continue) (assign exp (op compile-and-run-body) (reg exp)) (assign val (op compile) (reg exp)) (goto (reg val)) ; Evaluating simple expressions ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value) (reg exp) (reg env)) (goto (reg continue)) ev-quoted (assign val (op text-of-quotation) (reg exp)) (goto (reg continue)) ev-lambda (assign unev (op lambda-parameters) (reg exp)) (assign exp (op lambda-body) (reg exp)) (assign val (op make-procedure) (reg unev) (reg exp) (reg env)) (goto (reg continue)) ; Evaluating procedure applications ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) ; Procedure application apply-dispatch (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) (test (op compiled-procedure?) (reg proc)) (branch (label compiled-apply)) (goto (label unknown-procedure-type)) primitive-apply (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (restore continue) (goto (reg continue)) compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) compiled-apply (restore continue) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) ; Sequence evaluation ev-begin (assign unev (op begin-actions) (reg exp)) (save continue) (goto (label ev-sequence)) ev-sequence (assign exp (op first-exp) (reg unev)) (test (op last-exp?) (reg unev)) (branch (label ev-sequence-last-exp)) (save unev) (save env) (assign continue (label ev-sequence-continue)) (goto (label eval-dispatch)) ev-sequence-continue (restore env) (restore unev) (assign unev (op rest-exps) (reg unev)) (goto (label ev-sequence)) ev-sequence-last-exp (restore continue) (goto (label eval-dispatch)) ; Conditionals ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ; Assignments and definitions ev-assignment (assign unev (op assignment-variable) (reg exp)) (save unev) (assign exp (op assignment-value) (reg exp)) (save env) (save continue) (assign continue (label ev-assignment-1)) (goto (label eval-dispatch)) ev-assignment-1 (restore continue) (restore env) (restore unev) (perform (op set-variable-value!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ev-definition (assign unev (op definition-variable) (reg exp)) (save unev) (assign exp (op definition-value) (reg exp)) (save env) (save continue) (assign continue (label ev-definition-1)) (goto (label eval-dispatch)) ev-definition-1 (restore continue) (restore env) (restore unev) (perform (op define-variable!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ; Error handling unknown-expression-type (perform (op error) (const "Unknown expression type") (reg exp)) unknown-procedure-type (perform (op error) (const "Unknown procedure type") (reg proc)) ; External entries external-entry (perform (op initialize-stack)) (assign env (op get-global-environment)) (assign continue (label done)) (goto (reg val)) done)) (define eceval (make-explicit+compile-machine)) (set-register-contents! eceval 'env the-global-environment) (start eceval) ================================================ FILE: scheme/sicp/05/49.scm ================================================ ; SICP exercise 5.49 ; ; As an alternative to using the explicit-control evaluator's read-eval-print ; loop, design a register machine that performs a read-compile-execute-print ; loop. That is, the machine should run a loop that reads an expression, ; compiles it, assembles and executes the resulting code, and prints the ; result. This is easy to run in our simulated setup, wince we can arrange to ; call the procedures compile and assemble as "register-machine operations". (load-relative "showcase/compiler/helpers.scm") (define (compile-in-machine exp) (assemble (statements (compile-exp exp 'val 'return)) eceval)) (define cm-operations (append cm-operations `((compile ,compile-in-machine)))) (define explicit+compile-text '(read-eval-print-loop (perform (op initialize-stack)) (perform (op prompt-for-input) (const ";;; EC-Eval input:")) (assign exp (op read)) (assign env (op get-global-environment)) (assign continue (label print-result)) (assign val (op compile) (reg exp)) (goto (reg val)) print-result (perform (op announce-output) (const ";;; EC-Eval value:")) (perform (op user-print) (reg val)) (goto (label read-eval-print-loop)) unknown-expression-type (assign val (const unknown-expression-type-error)) (goto (label signal-error)) unknown-procedure-type (restore continue) (assign val (const unknown-procedure-type-error)) (goto (label signal-error)) signal-error (perform (op user-print) (reg val)) (goto (label read-eval-print-loop)) unknown-expression-type (perform (op error) (const "Unknown expression type") (reg exp)) unknown-procedure-type (perform (op error) (const "Unknown procedure type") (reg proc)))) (define eceval (make-explicit+compile-machine)) (set-register-contents! eceval 'env the-global-environment) (start eceval) ================================================ FILE: scheme/sicp/05/50.scm ================================================ ; SICP exercise 5.50 ; ; Use the compiler to compile the metacircular evaluator of section 4.1 and ; run this program using the register-machine simulator. (To compile more than ; one definition at a time, you can package the definitions in a begin.) The ; resulting interpreter will run very slowly because of the multiple levels of ; interpretation, but getting all the details to work is an instructive ; exercise. ; Oh boy. This is going to be so much fun! ; ; r5rs makes a return. It is required in the tests. I can probably work it out ; of this, but it will be too much work. ; ; Running the tests of the evaluator results in a whooping amount of 215 524 ; instructions, 8036 pushes and a maximum stack depth of 22. If that is not ; cool, I don't know what is. ; ; Let's start with using the open-coding compiler, just because it's cooler ; that way. (load-relative "tests/helpers/monitored-stack.scm") (load-relative "38.scm") ; This is the code of the metacircular evaluator. Note that it has some ; modifications. They are at the end of the code and are highlighted. (define metacircular-evaluator '(begin (define (evaluate exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'evaluator-primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '+ +) (list '- -) (list '* *) (list '/ /) (list '< <))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'evaluator-primitive (cadr proc))) primitive-procedures)) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) ; These are the additions. Those procedures are used by the evaluator. ; Instead of adding them as primitives, I have implemented them here for ; additional fun. (define (map proc lst) (if (null? lst) '() (cons (proc (car lst)) (map proc (cdr lst))))) (define (cadr lst) (car (cdr lst))) (define (cddr lst) (cdr (cdr lst))) (define (caadr lst) (car (car (cdr lst)))) (define (caddr lst) (car (cdr (cdr lst)))) (define (cdadr lst) (cdr (car (cdr lst)))) (define (cdddr lst) (cdr (cdr (cdr lst)))) (define (cadddr lst) (car (cdr (cdr (cdr lst))))) (define (not x) (if x false true)) (define (length lst) (if (null? lst) 0 (+ 1 (length (cdr lst))))) (define the-global-environment (setup-environment)))) ; The compiler also needs some modifications. ; ; First, it needs to understand let expressions. (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) ; Here is the modified compile-exp. It just has let (define (compile-exp exp target linkage) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage)) ((assignment? exp) (compile-assignment exp target linkage)) ((definition? exp) (compile-definition exp target linkage)) ((if? exp) (compile-if exp target linkage)) ((lambda? exp) (compile-lambda exp target linkage)) ((let? exp) (compile-exp (let->combination exp) target linkage)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage)) ((cond? exp) (compile-exp (cond->if exp) target linkage)) ((open-coded? exp) (compile-open-coded exp target linkage)) ((application? exp) (compile-application exp target linkage)) (else (error "Unknown expression type -- COMPILE" exp)))) ; The compiler requires a bunch of additional primitive procedures. (define (apply-primitive proc args) (apply (car (cdr proc)) args)) (define extra-primitives `((number? ,number?) (string? ,string?) (symbol? ,symbol?) (< ,<) (error ,error) (eq? ,eq?) (list ,list) (set-car! ,set-car!) (set-cdr! ,set-cdr!) (apply-in-underlying-scheme ,apply-primitive))) (set! primitive-procedures (append extra-primitives primitive-procedures)) (set! the-global-environment (setup-environment)) ; Since we're using the open-coding compiler, we need some additional ; operations too: (define extra-operations `((= ,=) (+ ,+) (- ,-) (* ,*))) ; This is a little trick to count the number of instructions. ; instruction-execution-proc gets called only when the instruction is about to ; be executed, the count is genuine. (define total-instructions 0) (define (instruction-execution-proc inst) (set! total-instructions (+ total-instructions 1)) (cdr inst)) ; This is our machine: (define machine (make-machine '(arg1 arg2 val env exp continue proc argl unev) (append cm-operations extra-operations) explicit+compile-text)) ; Finally, let's compile the evaluator in it. (compile-in-machine machine metacircular-evaluator) ================================================ FILE: scheme/sicp/05/51.scm ================================================ ; SICP exercise 5.51 ; ; Develop a rudimentary implementation of Scheme in C (or some other low-level ; language of your choice) by translating the explicit-control evaluator of ; section 5.4 into C. In order to run this code, you will need to also provide ; appropriate storage-allocation routines and other run-time support. ; That was a journey. It took me three days to implement this fully. More ; commentary can be found in 05/support/51/evaluator.c, which contains the ; actual C code to do it. ; ; This file provides with some necessary code in order to compile and run the ; interpreter. Note that it depends on cc --std=c99. (require racket/runtime-path) (define-runtime-path base-path ".") (define (relative-path path) (find-relative-path (current-directory) (simplify-path (build-path base-path path)))) (define source-path (relative-path "support/51/evaluator.c")) (define tests-path (relative-path "support/51/tests.scm")) (define target-path (relative-path "support/bin/51")) (define compile-call (format "cc --std=c99 ~a -o ~a" (path->string source-path) (path->string target-path))) (define run-tests-call (format "~a ~a" (path->string target-path) (path->string tests-path))) (define (compile-interpreter) (let ((exit-code (system/exit-code compile-call))) (when (not (zero? exit-code)) (error "Failed to compile the interpreter ;(")))) (define (run-interpreter-tests) (system run-tests-call)) (define (interpreter-test-results) (with-output-to-string run-interpreter-tests)) ================================================ FILE: scheme/sicp/05/52.scm ================================================ ; SICP exercise 5.52 ; ; As a counterpoint to exercise 5.51, modify the compiler so that it compiles ; Scheme procedures into sequences of C instructions. Compile the metacircular ; evaluator of section 4.1 to produce a Scheme written in C. ; This exercise marks and end of a long journey. It uses an approach similar ; to the previous one. The code used to compile everything is in build.scm. ; There are modified versions of the metacircular evaluator and the compiler ; too (but noting noteworthy). ; ; Let's bring up some Racket-fu and use pattern matching. (load-relative "support/52/metacircular-evaluator.scm") (load-relative "support/52/compiler.scm") (load-relative "support/52/syntax.scm") (load-relative "support/52/build.scm") ; Some utility string transformation functions. (define (dash-to-underscore str) (regexp-replace* (regexp "-") str "_")) (define (question-mark-to-p str) (regexp-replace* (regexp "\\?$") str "_p")) (define (exclamation-mark-to-bang str) (regexp-replace* (regexp "!") str "_bang")) ; Translates an instruction to a single line of C. (define (translate inst) (match inst ; Assign [`(assign ,reg (op ,op) . ,args) (format "~a = ~a(~a);" (c-reg reg) (c-func-name op) (c-args args))] [`(assign ,reg ,val) (format "~a = ~a;" (c-reg reg) (c-val val))] ; Perform [`(perform (op ,op) . ,args) (format "~a(~a);" (c-func-name op) (c-args args))] ; Save [`(save ,reg) (format "push(~a);" (c-reg reg))] ; Restore [`(restore ,reg) (format "~a = pop();" (c-reg reg))] ; Test [`(test (op ,op) . ,args) (format "test = ~a(~a);" (c-func-name op) (c-args args))] ; Branch [`(branch (label ,label)) (format "if (test) goto ~a;" (c-label-name label))] ; Goto [`(goto (label ,reg)) (format "goto ~a;" (c-label-name reg))] [`(goto (reg ,reg)) (format "goto *value_to_label(~a);" (c-reg reg))] ; Labels [(app symbol? #t) (format "~a:" (c-label-name inst))] [else (error "Unrecognized instruction:" inst)])) ; A bunch of utility procedures that know how to convert different fragments ; into the C code required. (define (c-val val) (match val [`(reg ,reg) (c-reg reg)] [`(const ,const) (c-const const)] [`(label ,label) (format "label(&&~a)" (c-label-name label))] [else (error "Unknown c-val" val)])) (define (c-const const) (cond ((symbol? const) (format "sym(\"~a\")" const)) ((string? const) (format "str(~s)" const)) ((number? const) (format "num(~a)" const)) ((pair? const) (format "cons(~a, ~a)" (c-const (car const)) (c-const (cdr const)))) ((null? const) (format "null()")) (else (error "Unknown c-const" const)))) (define (c-reg reg) (match reg ['continue "cont"] [else (symbol->string reg)])) (define c-label-name (compose dash-to-underscore symbol->string)) (define c-func-name (compose exclamation-mark-to-bang dash-to-underscore question-mark-to-p symbol->string)) (define (c-args args) (string-join (map c-val args) ", ")) ; Indents everything but the labels, so the compiled C code can look nicer. (define (ident text) (if (regexp-match (regexp ":$") text) text (string-append " " text))) ; Finally, the C code for the interpreter. (define interpreter-in-c (let* ((instructions (compile-exp metacircular-evaluator 'val 'next)) (statements (statements instructions)) (lines (map (compose ident translate) statements))) (string-join lines "\n"))) ================================================ FILE: scheme/sicp/05/showcase/compiler/compiler.scm ================================================ ; The procedure compile is renamed to compile-exp, because it is ; already defined in Racket. ; The compile procedure (define (compile-exp exp target linkage) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage)) ((assignment? exp) (compile-assignment exp target linkage)) ((definition? exp) (compile-definition exp target linkage)) ((if? exp) (compile-if exp target linkage)) ((lambda? exp) (compile-lambda exp target linkage)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage)) ((cond? exp) (compile-exp (cond->if exp) target linkage)) ((application? exp) (compile-application exp target linkage)) (else (error "Unknown expression type -- COMPILE" exp)))) ; Compiling linkage code (define (compile-linkage linkage) (cond ((eq? linkage 'return) (make-instruction-sequence '(continue) '() '((goto (reg continue))))) ((eq? linkage 'next) (empty-instruction-sequence)) (else (make-instruction-sequence '() '() `((goto (label ,linkage))))))) (define (end-with-linkage linkage instruction-sequence) (preserving '(continue) instruction-sequence (compile-linkage linkage))) ; Compiling simple expressions (define (compile-self-evaluating exp target linkage) (end-with-linkage linkage (make-instruction-sequence '() (list target) `((assign ,target (const ,exp)))))) (define (compile-quoted exp target linkage) (end-with-linkage linkage (make-instruction-sequence '() (list target) `((assign ,target (const ,(text-of-quotation exp))))))) (define (compile-variable exp target linkage) (end-with-linkage linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op lookup-variable-value) (const ,exp) (reg env)))))) (define (compile-assignment exp target linkage) (let ((var (assignment-variable exp)) (get-value-code (compile-exp (assignment-value exp) 'val 'next))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op set-variable-value!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))))) (define (compile-definition exp target linkage) (let ((var (definition-variable exp)) (get-value-code (compile-exp (definition-value exp) 'val 'next))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op define-variable!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))))) ; Compiling conditional expressions (define (compile-if exp target linkage) (let ((t-branch (make-label 'true-branch)) (f-branch (make-label 'false-branch)) (after-if (make-label 'after-if))) (let ((consequent-linkage (if (eq? linkage 'next) after-if linkage))) (let ((p-code (compile-exp (if-predicate exp) 'val 'next)) (c-code (compile-exp (if-consequent exp) target consequent-linkage)) (a-code (compile-exp (if-alternative exp) target linkage))) (preserving '(env continue) p-code (append-instruction-sequences (make-instruction-sequence '(val) '() `((test (op false?) (reg val)) (branch (label ,f-branch)))) (parallel-instruction-sequences (append-instruction-sequences t-branch c-code) (append-instruction-sequences f-branch a-code)) after-if)))))) ; Compiling sequences (define (compile-sequence seq target linkage) (if (last-exp? seq) (compile-exp (first-exp seq) target linkage) (preserving '(env continue) (compile-exp (first-exp seq) target 'next) (compile-sequence (rest-exps seq) target linkage)))) ; Compiling lambda expressions (define (compile-lambda exp target linkage) (let ((proc-entry (make-label 'entry)) (after-lambda (make-label 'after-lambda))) (let ((lambda-linkage (if (eq? linkage 'next) after-lambda linkage))) (append-instruction-sequences (tack-on-instruction-sequence (end-with-linkage lambda-linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op make-compiled-procedure) (label ,proc-entry) (reg env))))) (compile-lambda-body exp proc-entry)) after-lambda)))) (define (compile-lambda-body exp proc-entry) (let ((formals (lambda-parameters exp))) (append-instruction-sequences (make-instruction-sequence '(env proc argl) '(env) `(,proc-entry (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const ,formals) (reg argl) (reg env)))) (compile-sequence (lambda-body exp) 'val 'return)))) ; Compiling combinations (define (compile-application exp target linkage) (let ((proc-code (compile-exp (operator exp) 'proc 'next)) (operand-codes (map (lambda (operand) (compile-exp operand 'val 'next)) (operands exp)))) (preserving '(env continue) proc-code (preserving '(proc continue) (construct-arglist operand-codes) (compile-procedure-call target linkage))))) (define (construct-arglist operand-codes) (let ((operand-codes (reverse operand-codes))) (if (null? operand-codes) (make-instruction-sequence '() '(argl) '((assign argl (const ())))) (let ((code-to-get-last-arg (append-instruction-sequences (car operand-codes) (make-instruction-sequence '(val) '(argl) '((assign argl (op list) (reg val))))))) (if (null? (cdr operand-codes)) code-to-get-last-arg (preserving '(env) code-to-get-last-arg (code-to-get-rest-args (cdr operand-codes)))))))) (define (code-to-get-rest-args operand-codes) (let ((code-for-next-arg (preserving '(argl) (car operand-codes) (make-instruction-sequence '(val argl) '(argl) '((assign argl (op cons) (reg val) (reg argl))))))) (if (null? (cdr operand-codes)) code-for-next-arg (preserving '(env) code-for-next-arg (code-to-get-rest-args (cdr operand-codes)))))) ; Applying procedures (define (compile-procedure-call target linkage) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (after-call (make-label 'after-call))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() `((test (op primitive-procedure?) (reg proc)) (branch (label ,primitive-branch)))) (parallel-instruction-sequences (append-instruction-sequences compiled-branch (compile-proc-appl target compiled-linkage)) (append-instruction-sequences primitive-branch (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl))))))) after-call)))) ; Applying compiled procedures (define all-regs '(env proc val argl continue)) (define (compile-proc-appl target linkage) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,linkage)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val))))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((proc-return (make-label 'proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,proc-return)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) ,proc-return (assign ,target (reg val)) (goto (label ,linkage)))))) ((and (eq? target 'val) (eq? linkage 'return)) (make-instruction-sequence '(proc continue) all-regs `((assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val))))) ((and (not (eq? target 'val)) (eq? linkage 'return)) (error "return linkage, target not val -- COMPILE-EXP" target)) (else (error "How did we get here?")))) ; Combining Instruction Sequences (define (registers-needed s) (if (symbol? s) '() (car s))) (define (registers-modified s) (if (symbol? s) '() (cadr s))) (define (statements s) (if (symbol? s) (list s) (caddr s))) (define (needs-register? seq reg) (memq reg (registers-needed seq))) (define (modifies-register? seq reg) (memq reg (registers-modified seq))) (define (append-instruction-sequences . seqs) (define (append-2-sequences seq1 seq2) (make-instruction-sequence (list-union (registers-needed seq1) (list-difference (registers-needed seq2) (registers-modified seq1))) (list-union (registers-modified seq1) (registers-modified seq2)) (append (statements seq1) (statements seq2)))) (define (append-seq-list seqs) (if (null? seqs) (empty-instruction-sequence) (append-2-sequences (car seqs) (append-seq-list (cdr seqs))))) (append-seq-list seqs)) (define (list-union s1 s2) (cond ((null? s1) s2) ((memq (car s1) s2) (list-union (cdr s1) s2)) (else (cons (car s1) (list-union (cdr s1) s2))))) (define (list-difference s1 s2) (cond ((null? s1) '()) ((memq (car s1) s2) (list-difference (cdr s1) s2)) (else (cons (car s1) (list-difference (cdr s1) s2))))) (define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) (if (and (needs-register? seq2 first-reg) (modifies-register? seq1 first-reg)) (preserving (cdr regs) (make-instruction-sequence (list-union (list first-reg) (registers-needed seq1)) (list-difference (registers-modified seq1) (list first-reg)) (append `((save ,first-reg)) (statements seq1) `((restore ,first-reg)))) seq2) (preserving (cdr regs) seq1 seq2))))) (define (tack-on-instruction-sequence seq body-seq) (make-instruction-sequence (registers-needed seq) (registers-modified seq) (append (statements seq) (statements body-seq)))) (define (parallel-instruction-sequences seq1 seq2) (make-instruction-sequence (list-union (registers-needed seq1) (registers-needed seq2)) (list-union (registers-modified seq1) (registers-modified seq2)) (append (statements seq1) (statements seq2)))) ; Instruction sequences (define (make-instruction-sequence needs modifies statements) (list needs modifies statements)) (define (empty-instruction-sequence) (make-instruction-sequence '() '() '())) ; Make label (define label-counter 0) (define (new-label-number) (set! label-counter (+ 1 label-counter)) label-counter) (define (make-label name) (string->symbol (string-append (symbol->string name) (number->string (new-label-number))))) ; Compiled procedure operations (define (make-compiled-procedure entry env) (list 'compiled-procedure entry env)) (define (compiled-procedure? proc) (tagged-list? proc 'compiled-procedure)) (define (compiled-procedure-entry c-proc) (cadr c-proc)) (define (compiled-procedure-env c-proc) (caddr c-proc)) ================================================ FILE: scheme/sicp/05/showcase/compiler/explicit-evaluator-text.scm ================================================ (define explicit+compile-text '( (branch (label external-entry)) (assign continue (label done)) eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) (test (op variable?) (reg exp)) (branch (label ev-variable)) (test (op quoted?) (reg exp)) (branch (label ev-quoted)) (test (op assignment?) (reg exp)) (branch (label ev-assignment)) (test (op definition?) (reg exp)) (branch (label ev-definition)) (test (op if?) (reg exp)) (branch (label ev-if)) (test (op lambda?) (reg exp)) (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ; Evaluating simple expressions ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value) (reg exp) (reg env)) (goto (reg continue)) ev-quoted (assign val (op text-of-quotation) (reg exp)) (goto (reg continue)) ev-lambda (assign unev (op lambda-parameters) (reg exp)) (assign exp (op lambda-body) (reg exp)) (assign val (op make-procedure) (reg unev) (reg exp) (reg env)) (goto (reg continue)) ; Evaluating procedure applications ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) ; Procedure application apply-dispatch (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) (test (op compiled-procedure?) (reg proc)) (branch (label compiled-apply)) (goto (label unknown-procedure-type)) primitive-apply (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (restore continue) (goto (reg continue)) compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) compiled-apply (restore continue) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) ; Sequence evaluation ev-begin (assign unev (op begin-actions) (reg exp)) (save continue) (goto (label ev-sequence)) ev-sequence (assign exp (op first-exp) (reg unev)) (test (op last-exp?) (reg unev)) (branch (label ev-sequence-last-exp)) (save unev) (save env) (assign continue (label ev-sequence-continue)) (goto (label eval-dispatch)) ev-sequence-continue (restore env) (restore unev) (assign unev (op rest-exps) (reg unev)) (goto (label ev-sequence)) ev-sequence-last-exp (restore continue) (goto (label eval-dispatch)) ; Conditionals ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ; Assignments and definitions ev-assignment (assign unev (op assignment-variable) (reg exp)) (save unev) (assign exp (op assignment-value) (reg exp)) (save env) (save continue) (assign continue (label ev-assignment-1)) (goto (label eval-dispatch)) ev-assignment-1 (restore continue) (restore env) (restore unev) (perform (op set-variable-value!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ev-definition (assign unev (op definition-variable) (reg exp)) (save unev) (assign exp (op definition-value) (reg exp)) (save env) (save continue) (assign continue (label ev-definition-1)) (goto (label eval-dispatch)) ev-definition-1 (restore continue) (restore env) (restore unev) (perform (op define-variable!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ; Error handling unknown-expression-type (perform (op error) (const "Unknown expression type") (reg exp)) unknown-procedure-type (perform (op error) (const "Unknown procedure type") (reg proc)) ; External entries external-entry (perform (op initialize-stack)) (assign env (op get-global-environment)) (assign continue (label done)) (goto (reg val)) done)) ================================================ FILE: scheme/sicp/05/showcase/compiler/helpers.scm ================================================ (load-relative "syntax.scm") (load-relative "operations.scm") (load-relative "compiler.scm") (load-relative "explicit-evaluator-text.scm") (load-relative "../simulator/simulator.scm") (load-relative "../explicit/controller-text.scm") (define (make-explicit+compile-machine) (make-machine ec-registers cm-operations explicit+compile-text)) (define (compile-in-machine machine expression) (let ((instructions (assemble (statements (compile-exp expression 'val 'return)) machine))) (set-register-contents! machine 'env the-global-environment) (set-register-contents! machine 'val instructions) (set-register-contents! machine 'flag true) (start machine))) (define (eval-in-machine machine expression) (set-register-contents! machine 'env the-global-environment) (set-register-contents! machine 'exp expression) (set-register-contents! machine 'flag false) (start machine)) (define (compiled-instructions expression) (statements (compile-exp expression 'val 'return))) ================================================ FILE: scheme/sicp/05/showcase/compiler/main.scm ================================================ (display "There is no executable for this showcase.") (newline) (display "Just use the compiler as you see fit.") (newline) ================================================ FILE: scheme/sicp/05/showcase/compiler/operations.scm ================================================ (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (list->mlist lst) (if (null? lst) '() (mcons (car lst) (list->mlist (cdr lst))))) (define (text-of-quotation exp) (cadr exp)) (define (last-operand? ops) (null? (cdr ops))) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (empty-arglist) '()) (define (adjoin-arg arg arglist) (append arglist (list arg))) (define (true? x) (not (eq? x false))) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (mcons variables values)) (define (frame-variables frame) (mcar frame)) (define (frame-values frame) (mcdr frame)) (define (add-binding-to-frame! var val frame) (set-mcar! frame (cons var (mcar frame))) (set-mcdr! frame (mcons val (mcdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars (list->mlist vals)) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (mcar vals)) (else (scan (cdr vars) (mcdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-mcar! vals val)) (else (scan (cdr vars) (mcdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-mcar! vals val)) (else (scan (cdr vars) (mcdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '> >) (list '< <) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define (get-global-environment) the-global-environment) (define (reset-the-global-environment!) (set! the-global-environment (setup-environment))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) (define (make-compiled-procedure entry env) (list 'compiled-procedure entry env)) (define (compiled-procedure? proc) (tagged-list? proc 'compiled-procedure)) (define (compiled-procedure-entry c-proc) (cadr c-proc)) (define (compiled-procedure-env c-proc) (caddr c-proc)) ; The list of registers (define cm-registers '(exp env val proc argl continue unev)) ; The list of all operations (define cm-operations (list (list 'self-evaluating? self-evaluating?) (list 'variable? variable?) (list 'quoted? quoted?) (list 'text-of-quotation text-of-quotation) (list 'assignment? assignment?) (list 'assignment-value assignment-value) (list 'assignment-variable assignment-variable) (list 'definition? definition?) (list 'definition-variable definition-variable) (list 'definition-value definition-value) (list 'if? if?) (list 'if-predicate if-predicate) (list 'if-consequent if-consequent) (list 'if-alternative if-alternative) (list 'lambda? lambda?) (list 'lambda-parameters lambda-parameters) (list 'lambda-body lambda-body) (list 'begin? begin?) (list 'begin-actions begin-actions) (list 'first-exp first-exp) (list 'last-exp? last-exp?) (list 'rest-exps rest-exps) (list 'application? application?) (list 'operands operands) (list 'operator operator) (list 'no-operands? no-operands?) (list 'last-operand? last-operand?) (list 'first-operand first-operand) (list 'rest-operands rest-operands) (list 'lookup-variable-value lookup-variable-value) (list 'define-variable! define-variable!) (list 'set-variable-value! set-variable-value!) (list 'extend-environment extend-environment) (list 'primitive-procedure? primitive-procedure?) (list 'apply-primitive-procedure apply-primitive-procedure) (list 'compound-procedure? compound-procedure?) (list 'procedure-parameters procedure-parameters) (list 'procedure-environment procedure-environment) (list 'procedure-body procedure-body) (list 'make-procedure make-procedure) (list 'empty-arglist empty-arglist) (list 'adjoin-arg adjoin-arg) (list 'true? true?) (list 'false? false?) (list 'list list) (list 'cons cons) (list 'compiled-procedure? compiled-procedure?) (list 'make-compiled-procedure make-compiled-procedure) (list 'compiled-procedure-env compiled-procedure-env) (list 'compiled-procedure-entry compiled-procedure-entry) (list 'prompt-for-input prompt-for-input) (list 'read read) (list 'get-global-environment get-global-environment) (list 'announce-output announce-output) (list 'user-print user-print) (list 'error error))) ================================================ FILE: scheme/sicp/05/showcase/compiler/syntax.scm ================================================ (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (quoted? exp) (tagged-list? exp 'quote)) (define (variable? exp) (symbol? exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) ================================================ FILE: scheme/sicp/05/showcase/compiler/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers.scm") (define (run exp) (let ((machine (make-explicit+compile-machine))) (compile-in-machine machine exp) (get-register-contents machine 'val))) (define evaluator-tests (test-suite "Tests for the metacircular evaluator" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/05/showcase/explicit/controller-text.scm ================================================ (define ec-registers '(exp env val proc argl continue unev)) (define ec-core '(eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) (test (op variable?) (reg exp)) (branch (label ev-variable)) (test (op quoted?) (reg exp)) (branch (label ev-quoted)) (test (op assignment?) (reg exp)) (branch (label ev-assignment)) (test (op definition?) (reg exp)) (branch (label ev-definition)) (test (op if?) (reg exp)) (branch (label ev-if)) (test (op lambda?) (reg exp)) (branch (label ev-lambda)) (test (op begin?) (reg exp)) (branch (label ev-begin)) (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ; Evaluating simple expressions ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value) (reg exp) (reg env)) (goto (reg continue)) ev-quoted (assign val (op text-of-quotation) (reg exp)) (goto (reg continue)) ev-lambda (assign unev (op lambda-parameters) (reg exp)) (assign exp (op lambda-body) (reg exp)) (assign val (op make-procedure) (reg unev) (reg exp) (reg env)) (goto (reg continue)) ; Evaluating procedure applications ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) ; Procedure application apply-dispatch (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) (goto (label unknown-procedure-type)) primitive-apply (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (restore continue) (goto (reg continue)) compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) ; Sequence evaluation ev-begin (assign unev (op begin-actions) (reg exp)) (save continue) (goto (label ev-sequence)) ev-sequence (assign exp (op first-exp) (reg unev)) (test (op last-exp?) (reg unev)) (branch (label ev-sequence-last-exp)) (save unev) (save env) (assign continue (label ev-sequence-continue)) (goto (label eval-dispatch)) ev-sequence-continue (restore env) (restore unev) (assign unev (op rest-exps) (reg unev)) (goto (label ev-sequence)) ev-sequence-last-exp (restore continue) (goto (label eval-dispatch)) ; Conditionals ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ; Assignments and definitions ev-assignment (assign unev (op assignment-variable) (reg exp)) (save unev) (assign exp (op assignment-value) (reg exp)) (save env) (save continue) (assign continue (label ev-assignment-1)) (goto (label eval-dispatch)) ev-assignment-1 (restore continue) (restore env) (restore unev) (perform (op set-variable-value!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)) ev-definition (assign unev (op definition-variable) (reg exp)) (save unev) (assign exp (op definition-value) (reg exp)) (save env) (save continue) (assign continue (label ev-definition-1)) (goto (label eval-dispatch)) ev-definition-1 (restore continue) (restore env) (restore unev) (perform (op define-variable!) (reg unev) (reg val) (reg env)) (assign val (const ok)) (goto (reg continue)))) (define ec-repl-head '(read-eval-print-loop (perform (op initialize-stack)) (perform (op prompt-for-input) (const ";;; EC-Eval input:")) (assign exp (op read)) (assign env (op get-global-environment)) (assign continue (label print-result)) (goto (label eval-dispatch)) print-result (perform (op announce-output) (const ";;; EC-Eval value:")) (perform (op user-print) (reg val)) (goto (label read-eval-print-loop)) unknown-expression-type (assign val (const unknown-expression-type-error)) (goto (label signal-error)) unknown-procedure-type (restore continue) (assign val (const unknown-procedure-type-error)) (goto (label signal-error)) signal-error (perform (op user-print) (reg val)) (goto (label read-eval-print-loop)))) (define ec-controller-text (append '((assign continue (label done))) ec-core '(unknown-expression-type unknown-procedure-type done))) (define ec-repl-controller-text (append ec-repl-head ec-core)) ================================================ FILE: scheme/sicp/05/showcase/explicit/evaluator.scm ================================================ (load-relative "../simulator/simulator.scm") (load-relative "controller-text.scm") (load-relative "operations.scm") (define (make-explicit-control-machine) (make-machine ec-registers ec-operations ec-controller-text)) (define (make-explicit-control-repl-machine) (make-machine ec-registers ec-operations ec-repl-controller-text)) ================================================ FILE: scheme/sicp/05/showcase/explicit/main.scm ================================================ (load-relative "evaluator.scm") (define ec-repl-machine (make-explicit-control-repl-machine)) (start ec-repl-machine) ================================================ FILE: scheme/sicp/05/showcase/explicit/operations.scm ================================================ ; This file contains all the "primitive" operations required by the explicit ; control evaluator. They are lifted from the metacircular evaluator, with the ; addition that it is converted to use Racket instead of R5RS. (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (list->mlist lst) (if (null? lst) '() (mcons (car lst) (list->mlist (cdr lst))))) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (last-operand? ops) (null? (cdr ops))) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (empty-arglist) '()) (define (adjoin-arg arg arglist) (append arglist (list arg))) (define (true? x) (not (eq? x false))) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (mcons variables values)) (define (frame-variables frame) (mcar frame)) (define (frame-values frame) (mcdr frame)) (define (add-binding-to-frame! var val frame) (set-mcar! frame (cons var (mcar frame))) (set-mcdr! frame (mcons val (mcdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars (list->mlist vals)) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (mcar vals)) (else (scan (cdr vars) (mcdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-mcar! vals val)) (else (scan (cdr vars) (mcdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-mcar! vals val)) (else (scan (cdr vars) (mcdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'pair? pair?) (list '= =) (list '> >) (list '< <) (list '+ +) (list '- -) (list '* *) (list '/ /))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'primitive (cadr proc))) primitive-procedures)) (define apply-in-underlying-scheme apply) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define the-global-environment (setup-environment)) (define (get-global-environment) the-global-environment) (define (reset-the-global-environment!) (set! the-global-environment (setup-environment))) (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) ')) (display object))) ; The list of all operations (define ec-operations (list (list 'self-evaluating? self-evaluating?) (list 'variable? variable?) (list 'quoted? quoted?) (list 'text-of-quotation text-of-quotation) (list 'assignment? assignment?) (list 'assignment-value assignment-value) (list 'assignment-variable assignment-variable) (list 'definition? definition?) (list 'definition-variable definition-variable) (list 'definition-value definition-value) (list 'if? if?) (list 'if-predicate if-predicate) (list 'if-consequent if-consequent) (list 'if-alternative if-alternative) (list 'lambda? lambda?) (list 'lambda-parameters lambda-parameters) (list 'lambda-body lambda-body) (list 'begin? begin?) (list 'begin-actions begin-actions) (list 'first-exp first-exp) (list 'last-exp? last-exp?) (list 'rest-exps rest-exps) (list 'application? application?) (list 'operands operands) (list 'operator operator) (list 'no-operands? no-operands?) (list 'last-operand? last-operand?) (list 'first-operand first-operand) (list 'rest-operands rest-operands) (list 'lookup-variable-value lookup-variable-value) (list 'define-variable! define-variable!) (list 'set-variable-value! set-variable-value!) (list 'extend-environment extend-environment) (list 'primitive-procedure? primitive-procedure?) (list 'apply-primitive-procedure apply-primitive-procedure) (list 'compound-procedure? compound-procedure?) (list 'procedure-parameters procedure-parameters) (list 'procedure-environment procedure-environment) (list 'procedure-body procedure-body) (list 'make-procedure make-procedure) (list 'empty-arglist empty-arglist) (list 'adjoin-arg adjoin-arg) (list 'true? true?) (list 'prompt-for-input prompt-for-input) (list 'read read) (list 'get-global-environment get-global-environment) (list 'announce-output announce-output) (list 'user-print user-print) )) ================================================ FILE: scheme/sicp/05/showcase/explicit/tests.scm ================================================ (require rackunit rackunit/text-ui) (load-relative "evaluator.scm") (define ec-machine (make-explicit-control-machine)) (define (run exp) (set-register-contents! ec-machine 'env (setup-environment)) (set-register-contents! ec-machine 'exp exp) (start ec-machine) (get-register-contents ec-machine 'val)) (define evaluator-tests (test-suite "Tests for the explicit control evaluator" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests evaluator-tests) ================================================ FILE: scheme/sicp/05/showcase/simulator/sample-machines.scm ================================================ (define gcd-machine (make-machine '(a b t) (list (list 'rem remainder) (list '= =)) '(test-b (test (op =) (reg b) (const 0)) (branch (label gcd-done)) (assign t (op rem) (reg a) (reg b)) (assign a (reg b)) (assign b (reg t)) (goto (label test-b)) gcd-done))) (define factorial-machine (make-machine '(n val continue) (list (list '= =) (list '- -) (list '* *)) '( (assign continue (label fact-done)) fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) after-fact (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) (goto (reg continue)) base-case (assign val (const 1)) (goto (reg continue)) fact-done))) (define fibonacci-machine (make-machine '(n val continue) (list (list '< <) (list '- -) (list '+ +)) '( (assign continue (label fib-done)) fib-loop (test (op <) (reg n) (const 2)) (branch (label immediate-answer)) (save continue) (assign continue (label after-fib-n-1)) (save n) (assign n (op -) (reg n) (const 1)) (goto (label fib-loop)) after-fib-n-1 (restore n) (restore continue) (assign n (op -) (reg n) (const 2)) (save continue) (assign continue (label after-fib-n-2)) (save val) (goto (label fib-loop)) after-fib-n-2 (assign n (reg val)) (restore val) (restore continue) (assign val (op +) (reg val) (reg n)) (goto (reg continue)) immediate-answer (assign val (reg n)) (goto (reg continue)) fib-done))) ================================================ FILE: scheme/sicp/05/showcase/simulator/simulator.scm ================================================ ; The simulator from section 5.2. ; ; Notes: ; * There are small variations - I don't want to use r5rs, so I'm using mcons ; to be able to do set-car (define (make-machine register-names ops controller-text) (let ((machine (make-new-machine))) (for-each (lambda (register-name) ((machine 'allocate-register) register-name)) register-names) ((machine 'install-operations) ops) ((machine 'install-instruction-sequence) (assemble controller-text machine)) machine)) ; Registers (define (make-register name) (let ((contents '*unassigned*)) (define (dispatch message) (cond ((eq? message 'get) contents) ((eq? message 'set) (lambda (value) (set! contents value))) (else (error "Unknown request -- REGISTER" message)))) dispatch)) (define (get-contents register) (register 'get)) (define (set-contents! register value) ((register 'set) value)) ; The stack (define (make-stack) (let ((s '())) (define (push x) (set! s (cons x s))) (define (pop) (if (null? s) (error "Empty stack -- POP") (let ((top (car s))) (set! s (cdr s)) top))) (define (initialize) (set! s '()) 'done) (define (dispatch message) (cond ((eq? message 'push) push) ((eq? message 'pop) (pop)) ((eq? message 'initialize) (initialize)) (else (error "Unknown request -- STACK" message)))) dispatch)) (define (pop stack) (stack 'pop)) (define (push stack value) ((stack 'push) value)) ; The basic machine (define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '())) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined register: " name) (set! register-table (cons (list name (make-register name)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin ((instruction-execution-proc (car insts))) (execute))))) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) (else (error "Unknown request -- MACHINE" message)))) dispatch))) (define (start machine) (machine 'start)) (define (get-register-contents machine register-name) (get-contents (get-register machine register-name))) (define (set-register-contents! machine register-name value) (set-contents! (get-register machine register-name) value) 'done) (define (get-register machine reg-name) ((machine 'get-register) reg-name)) ; The Assembler (define (assemble controller-text machine) (extract-labels controller-text (lambda (insts labels) (update-insts! insts labels machine) insts))) (define (extract-labels text receive) (if (null? text) (receive '() '()) (extract-labels (cdr text) (lambda (insts labels) (let ((next-inst (car text))) (if (symbol? next-inst) (receive insts (cons (make-label-entry next-inst insts) labels)) (receive (cons (make-instruction next-inst) insts) labels))))))) (define (update-insts! insts labels machine) (let ((pc (get-register machine 'pc)) (flag (get-register machine 'flag)) (stack (machine 'stack)) (ops (machine 'operations))) (for-each (lambda (inst) (set-instruction-execution-proc! inst (make-execution-procedure (instruction-text inst) labels machine pc flag stack ops))) insts))) (define (make-instruction text) (mcons text '())) (define (instruction-text inst) (mcar inst)) (define (instruction-execution-proc inst) (mcdr inst)) (define (set-instruction-execution-proc! inst proc) (set-mcdr! inst proc)) (define (make-label-entry label-name insts) (cons label-name insts)) (define (lookup-label labels label-name) (let ((val (assoc label-name labels))) (if val (cdr val) (error "Undefined label -- ASSEMBLE" label-name)))) ; Generating Execution Procedures for Instructions (define (make-execution-procedure inst labels machine pc flag stack ops) (cond ((eq? (car inst) 'assign) (make-assign inst machine labels ops pc)) ((eq? (car inst) 'test) (make-test inst machine labels ops flag pc)) ((eq? (car inst) 'branch) (make-branch inst machine labels flag pc)) ((eq? (car inst) 'goto) (make-goto inst machine labels pc)) ((eq? (car inst) 'save) (make-save inst machine stack pc)) ((eq? (car inst) 'restore) (make-restore inst machine stack pc)) ((eq? (car inst) 'perform) (make-perform inst machine labels ops pc)) (else (error "Unknown instruction type -- ASSEMBLE" inst)))) ; Assign instructions (define (make-assign inst machine labels operations pc) (let ((target (get-register machine (assign-reg-name inst))) (value-exp (assign-value-exp inst))) (let ((value-proc (if (operation-exp? value-exp) (make-operation-exp value-exp machine labels operations) (make-primitive-exp (car value-exp) machine labels)))) (lambda () (set-contents! target (value-proc)) (advance-pc pc))))) (define (assign-reg-name assign-instruction) (cadr assign-instruction)) (define (assign-value-exp assign-instruction) (cddr assign-instruction)) (define (advance-pc pc) (set-contents! pc (cdr (get-contents pc)))) ; Test, branch, and goto instructions (define (make-test inst machine labels operations flag pc) (let ((condition (test-condition inst))) (if (operation-exp? condition) (let ((condition-proc (make-operation-exp condition machine labels operations))) (lambda () (set-contents! flag (condition-proc)) (advance-pc pc))) (error "Bad TEST instruction -- ASSEMBLE" inst)))) (define (test-condition test-instruction) (cdr test-instruction)) (define (make-branch inst machine labels flag pc) (let ((dest (branch-dest inst))) (if (label-exp? dest) (let ((insts (lookup-label labels (label-exp-label dest)))) (lambda () (if (get-contents flag) (set-contents! pc insts) (advance-pc pc)))) (error "Bad BRANCH instruction -- ASSEMBLE" inst)))) (define (branch-dest branch-instruction) (cadr branch-instruction)) (define (make-goto inst machine labels pc) (let ((dest (goto-dest inst))) (cond ((label-exp? dest) (let ((insts (lookup-label labels (label-exp-label dest)))) (lambda () (set-contents! pc insts)))) ((register-exp? dest) (let ((reg (get-register machine (register-exp-reg dest)))) (lambda () (set-contents! pc (get-contents reg))))) (error (error "Bad GOTO instruction -- ASSEMBLE" inst))))) (define (goto-dest goto-instruction) (cadr goto-instruction)) ; Other instructions (define (make-save inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (push stack (get-contents reg)) (advance-pc pc)))) (define (make-restore inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (set-contents! reg (pop stack)) (advance-pc pc)))) (define (stack-inst-reg-name stack-instruction) (cadr stack-instruction)) (define (make-perform inst machine labels operations pc) (let ((action (perform-action inst))) (if (operation-exp? action) (let ((action-proc (make-operation-exp action machine labels operations))) (lambda () (action-proc) (advance-pc pc))) (error "Bad PERFORM instruction -- ASSEMBLE" inst)))) (define (perform-action inst) (cdr inst)) ; Execution procedures for subexpressions (define (make-primitive-exp exp machine labels) (cond ((constant-exp? exp) (let ((c (constant-exp-value exp))) (lambda () c))) ((label-exp? exp) (let ((insts (lookup-label labels (label-exp-label exp)))) (lambda () insts))) ((register-exp? exp) (let ((r (get-register machine (register-exp-reg exp)))) (lambda () (get-contents r)))) (else (error "Unknown expression type -- ASSEMBLE" exp)))) (define (register-exp? exp) (tagged-list? exp 'reg)) (define (register-exp-reg exp) (cadr exp)) (define (constant-exp? exp) (tagged-list? exp 'const)) (define (constant-exp-value exp) (cadr exp)) (define (label-exp? exp) (tagged-list? exp 'label)) (define (label-exp-label exp) (cadr exp)) (define (make-operation-exp exp machine labels operations) (let ((op (lookup-prim (operation-exp-op exp) operations)) (aprocs (map (lambda (e) (make-primitive-exp e machine labels)) (operation-exp-operands exp)))) (lambda () (apply op (map (lambda (p) (p)) aprocs))))) (define (operation-exp? exp) (and (pair? exp) (tagged-list? (car exp) 'op))) (define (operation-exp-op operation-exp) (cadr (car operation-exp))) (define (operation-exp-operands operation-exp) (cdr operation-exp)) (define (lookup-prim symbol operations) (let ((val (assoc symbol operations))) (if val (cadr val) (error "Unknown operation -- ASSEMBLE" symbol)))) (define (tagged-list? exp tag) (and (pair? exp) (eq? (car exp) tag))) ================================================ FILE: scheme/sicp/05/showcase/simulator/tests.scm ================================================ (require rackunit rackunit/text-ui) (load "simulator.scm") (load "sample-machines.scm") (define simulator-tests (test-suite "Register machine simulator tests" (test-case "(gcd 206 40)" (set-register-contents! gcd-machine 'a 206) (set-register-contents! gcd-machine 'b 40) (start gcd-machine) (check-eq? (get-register-contents gcd-machine 'a) 2)) (test-case "(gcd 54 24)" (set-register-contents! gcd-machine 'a 54) (set-register-contents! gcd-machine 'b 24) (start gcd-machine) (check-eq? (get-register-contents gcd-machine 'a) 6)) (test-case "(gcd 13 7)" (set-register-contents! gcd-machine 'a 13) (set-register-contents! gcd-machine 'b 7) (start gcd-machine) (check-eq? (get-register-contents gcd-machine 'a) 1)) (test-case "(factorial 5)" (set-register-contents! factorial-machine 'n 5) (start factorial-machine) (check-eq? (get-register-contents factorial-machine 'val) 120)) (test-case "(fibonacci 8)" (set-register-contents! fibonacci-machine 'n 8) (start fibonacci-machine) (check-eq? (get-register-contents fibonacci-machine 'val) 21)) )) (run-tests simulator-tests) ================================================ FILE: scheme/sicp/05/support/51/evaluator.c ================================================ /* * This is the rudimentary scheme interpreter, I had to write for exercise * 5.51. This is very exciting for me for several reasons. * * For starters, it is the first actual C code I have written since school. I * had a very different memory of the language and it certainly is contrasted * by using Vim and gcc (or clang). It is very far from the best C code that * I'm able to produce, but I wanted to keep it simple and rudimentary. * * Second, it includes know-how from every part of Structure and * Interpretation of Computer Programs, excluding 5.5 Compilation, which is * the next exercise. * * Finally, it was just tons of fun writing it. I did not use my usual method * and I did not use a debugger to make up for it, which made it way harder. * More reflections can be found in the notes. * * As for what this is, it a Scheme evaluator based on the explicit-control * evaluator (translated line-by-line) with a garbage collector (based on the * one in section 5.3). It supports the functionality of the explicit-control * evaluator (no conds) and has tail recursion. It has a hand-written parser * that I care not to classify and a memory implementation like the one in * section 5.3. It memory leaks symbols and strings, but apart from that, * everything is (supposed to be) nicely collected. * * More details and commentary are intermingled with the code in comments. */ #include #include #include #include #include /* * Some constants that set up the boundaries of the interpreter. */ #define MAX_FILE_SIZE 10000 #define MAX_LINE_LENGTH 1024 #define MAX_TOKEN_LENGTH 128 #define MEMORY_SIZE 512 #define MEMORY_WIGGLE_ROOM 20 #define STACK_SIZE 100 /* * Various typedefs for all the types we're using. There are special * structures for the symbol table and the memory. Everything else is stored * in pairs. */ typedef enum p_type p_type; typedef struct symbol_node symbol_node; typedef struct pairs memory; typedef struct value value; typedef const char* symbol; typedef value (*primitive_function)(value); /* * Definitions for values and memory. * * They need to be up here in order to get the file to compile. The different * types of values are represented by p_type. A value is a pair of a type and * a long. Depending on the value, the long can contain a pointer, a number or * some other value. */ enum p_type { p_null, p_boolean, p_number, p_symbol, p_string, p_pair, p_procedure, p_primitive, p_label, p_broken_heart }; struct value { p_type type; unsigned long value; }; /* * Memory declarations * * Since we use stop and copy garbage collection, modelled after section 5.3, * we allocate two segments of memory for the working memory and the free * memory. Each segment contains space for the cars and cdrs of the pairs * stored. */ struct pairs { value cars[MEMORY_SIZE]; value cdrs[MEMORY_SIZE]; }; unsigned int free_ptr = 0; memory *working_mem; memory *free_mem; memory block1; memory block2; /* * The main interface * * Those functions are the C interface to the evaluator. They are used to * build the read-eval-print loop */ value read(const char *); value eval(value); void print(value); /* * The number of times the garbage collector has run * * This is declared up here, since it is tricky to organize the code the way I * want it and not have it declared first. */ int gc_runs = 0; /* * Error reporting * * A couple of functions used to report errors. They are not that much to look * at. */ void error(const char *message) { printf("%s\n", message); exit(0); } void errorc(const char *message, char c) { printf("%s: %c\n", message, c); exit(0); } void errorv(const char *message, value val) { printf("%s: ", message); print(val); printf("\n"); exit(0); } void errort(const char *message, char *token) { token[MAX_TOKEN_LENGTH] = '\0'; printf("%s: %s\n", message, token); exit(0); } void errors(const char *message, symbol sym) { printf("%s: %s\n", message, sym); exit(0); } /* * Symbols * * The interpreter maintains a symbole table (more like a symbol linked list) * in order to intern symbols so they can be compared with == (and also take * less memory). intern() checks if the passed symbol is already allocated and * returns it if so. If not, it allocated a new one, copies the symbol in it * and returns the copy. */ symbol_node *symbol_table_head; struct symbol_node { symbol symbol; symbol_node* next; }; symbol_node* allocate_symbol_node(const char *name) { char *copy = calloc(sizeof(char), 1 + strlen(name)); strcpy(copy, name); symbol_node *node = malloc(sizeof(node)); node->symbol = copy; node->next = NULL; return node; } symbol intern(const char *name) { if (!symbol_table_head) { symbol_table_head = allocate_symbol_node(name); return symbol_table_head->symbol; } symbol_node* current = symbol_table_head; while (true) { if (strcmp(name, current->symbol) == 0) return current->symbol; if (!current->next) { symbol_node *new = allocate_symbol_node(name); current->next = new; return new->symbol; } current = current->next; } } /* * Preallocated symbols * * Some symbols that we will preallocate to avoid looking up the symbol table * every time */ symbol s_quote; symbol s_begin; symbol s_if; symbol s_define; symbol s_set_bang; symbol s_lambda; symbol s_ok; void initialize_symbols() { s_quote = intern("quote"); s_begin = intern("begin"); s_if = intern("if"); s_define = intern("define"); s_set_bang = intern("set!"); s_lambda = intern("lambda"); s_ok = intern("ok"); } /* * Values * * This section defines the values that the interpreter works with. They can * be pointers to memory (in the case of pairs), self contained (in the case * of booleans and numbers) or have a C pointer to some address in the heap * (in the case of primitive procedures and strings). * * Procedures are implemented as a special case of pairs. They are essentially * the same, but with a different type. I've chosen to go that way in order to * have the procedures (and environments they generate) garbage collected. * * Strings, symbols and primitives are implemented as pointers to the C * memory. That causes a memory leak for unneeded strings. Symbols don't * really need to be garbage collected and primitive procedures don't allocate * extra memory. * * Broken hearts are something that is used when garbage collecting. * * This section contains all the basic constructors and selectors for the * primitives. There are other selectors, implemented in terms of them, that * are defined later. */ // Type predicates bool null_p(value val) { return val.type == p_null; } bool boolean_p(value val) { return val.type == p_boolean; } bool number_p(value val) { return val.type == p_number; } bool symbol_p(value val) { return val.type == p_symbol; } bool string_p(value val) { return val.type == p_string; } bool pair_p(value val) { return val.type == p_pair; } bool procedure_p(value val) { return val.type == p_procedure; } bool primitive_p(value val) { return val.type == p_primitive; } bool label_p(value val) { return val.type == p_label; } bool broken_heart_p(value val) { return val.type == p_broken_heart; } // Null value null() { return (value) { p_null, 0 }; } // Booleans value truev() { return (value) { p_boolean, 1 }; } value falsev() { return (value) { p_boolean, 0 }; } value booleanv(bool val) { return val ? truev() : falsev(); } // Numbers value num(long n) { return (value) { p_number, n }; } long value_to_long(value val) { if (val.type != p_number) errorv("Expected a number", val); return (long) val.value; } // Symbols value sym(const char *s) { return (value) { p_symbol, (unsigned long) intern(s) }; } symbol value_to_sym(value val) { if (val.type != p_symbol) errorv("Expected a symbol", val); return (symbol) val.value; } // Strings value str(const char *s) { char *copy = calloc(sizeof(char), strlen(s) + 1); strcpy(copy, s); return (value) { p_string, (unsigned long) copy }; } // Pairs value cons(value car, value cdr) { if (free_ptr == MEMORY_SIZE) { error("Ran out of memory"); } working_mem->cars[free_ptr] = car; working_mem->cdrs[free_ptr] = cdr; value pair = (value) { p_pair, free_ptr }; free_ptr++; return pair; } value car(value pair) { if (pair.type != p_pair) errorv("Expected carable value", pair); return working_mem->cars[pair.value]; } value cdr(value pair) { if (pair.type != p_pair) errorv("Expected cdrable value", pair); return working_mem->cdrs[pair.value]; } void set_car(value pair, value val) { if (pair.type != p_pair) errorv("set_car expects a pair", pair); unsigned int offset = (unsigned int) pair.value; working_mem->cars[offset] = val; } void set_cdr(value pair, value val) { if (pair.type != p_pair) errorv("set_cdr expects a pair", pair); unsigned int offset = (unsigned int) pair.value; working_mem->cdrs[offset] = val; } // Procedures value pcons(value car, value cdr) { value pair = cons(car, cdr); // A little hack to reuse the cons() code. pair.type = p_procedure; return pair; } value pcdr(value proc) { if (proc.type != p_procedure) errorv("Expected a pcdrable value", proc); return working_mem->cdrs[proc.value]; } value pcar(value proc) { if (proc.type != p_procedure) errorv("Expected a pcarable value", proc); return working_mem->cars[proc.value]; } // Primitives value primitive(primitive_function function) { return (value) { p_primitive, (unsigned long) function }; } // Labels value label(void *label) { return (value) { p_label, (unsigned long) label }; } void *value_to_label(value label) { if (!label_p(label)) errorv("Expected a label", label); return (void *) label.value; } // Broken heart value broken_heart() { return (value) { p_broken_heart }; } /* * Memory initialization * * Memory is organized as in chapter 5.3. A struct represents two arrays of * cars and cdrs. There are two such structs that get rotated with a * stop-and-copy garbage collector. */ void wipe_memory(memory *memory) { for (int i = 0; i < MEMORY_SIZE; i++) { memory->cars[i] = (value) { p_null, 0 }; } } void initialize_memory() { wipe_memory(&block1); wipe_memory(&block2); working_mem = &block1; free_mem = &block2; } /* * The stack * * This is a straightforward implementation of a stack. */ int stack_ptr = 0; value stack[STACK_SIZE]; void push(value v) { if (stack_ptr == STACK_SIZE) error("Stack overflow"); stack[stack_ptr++] = v; } value pop() { if (!stack_ptr) error("Stack is empty"); return stack[--stack_ptr]; } /* * The registers * * Those are the registers that the explicit-control evaluator uses. */ value cont; value val; value expr; value unev; value proc; value argl; value env; void initialize_registers() { cont = null(); val = null(); expr = null(); unev = null(); proc = null(); argl = null(); env = null(); } /* * Utility functions for working with lists * * Simle convenience functions, used in C. */ value first(value pair) { return car(pair); } value second(value pair) { return car(cdr(pair)); } value third(value pair) { return car(cdr(cdr(pair))); } value fourth(value pair) { return car(cdr(cdr(cdr(pair)))); } /* * Standard functions * * Some of the standard Scheme functions, implemented in C. They are wrapped * as primitives to be available to the evaluator. */ int length(value list) { int result = 0; while (!null_p(list)) { list = cdr(list); result++; } return result; } bool eq(value v1, value v2) { return v1.type == v2.type && v1.value == v2.value; } bool equal(value v1, value v2) { if (v1.type != v2.type) return false; if (eq(v1, v2)) return true; switch (v1.type) { case p_string: return strcmp((char *) v1.value, (char *) v2.value) == 0; case p_pair: return equal(car(v1), car(v2)) && equal(cdr(v1), cdr(v2)); default: return false; } } /* * Environments * * Environments are implemented simply as lists, using the same structure as * the metacircular evaluator. This way they get to be garbage collected, even * if they are not optimal in variable lookup. * * Environments cannot be obtained with Scheme code, since they get * constructed only in the explicit-evaluator and are stored in registers or * stack. The only case when environments are stored in memory is when there * is a procedure in memory, but the environment cannot be obtained from * within the interpreter. */ value empty_environment() { return cons(cons(null(), cons(null(), null())), null()); } value extend_environment(value vars, value vals, value enclosing) { if (length(vars) != length(vals)) errorv("Argument count mismatch", cons(vars, cons(vals, null()))); value frame = cons(vars, cons(vals, null())); return cons(frame, enclosing); } value lookup_variable(symbol name, value env) { while (!null_p(env)) { value frame = car(env); value vars = car(frame); value vals = car(cdr(frame)); while (!null_p(vars)) { if (value_to_sym(car(vars)) == name) return car(vals); vars = cdr(vars); vals = cdr(vals); } env = cdr(env); } errors("Variable not found", name); exit(0); } void define_variable(symbol name, value val, value env) { value frame = car(env); value vars = car(frame); value vals = car(cdr(frame)); set_car(frame, cons(sym(name), vars)); set_car(cdr(frame), cons(val, vals)); } void set_variable_value(symbol name, value val, value env) { while (!null_p(env)) { value frame = car(env); value vars = car(frame); value vals = car(cdr(frame)); while (!null_p(vars)) { if (value_to_sym(car(vars)) == name) { set_car(vals, val); return; } vars = cdr(vars); vals = cdr(vals); } env = cdr(env); } errors("Variable not set", name); exit(0); } /* * The functions used by the explicit control evaluator. * * Those functions are used in the explicit control evaluator. */ bool true_p(value val) { return !boolean_p(val) || val.value != 0; } value make_procedure(value params, value body, value env) { return pcons(params, cons(body, cons(env, null()))); } value procedure_parameters(value proc) { return pcar(proc); } value procedure_body(value proc) { return first(pcdr(proc)); } value procedure_environment(value proc) { return second(pcdr(proc)); } value empty_arglist() { return null(); } value adjoin_arg(value arg, value arglist) { if (null_p(arglist)) return cons(arg, null()); else return cons(car(arglist), adjoin_arg(arg, cdr(arglist))); } value apply_primitive_procedure(value proc, value args) { if (!primitive_p(proc)) errorv("Trying to apply a non-primitive procedure", proc); primitive_function function = (primitive_function) proc.value; return function(args); } /* * The primitive procedures * * Below are the C functions that represent all the primitive procedures in * the language */ value prim_add(value args) { long result = 0; while (!null_p(args)) { result += value_to_long(car(args)); args = cdr(args); } return num(result); } value prim_sub(value args) { long result = value_to_long(car(args)); args = cdr(args); if (null_p(args)) return num(-result); while (!null_p(args)) { result -= value_to_long(car(args)); args = cdr(args); } return num(result); } value prim_mul(value args) { long result = 1; while (!null_p(args)) { result *= value_to_long(car(args)); args = cdr(args); } return num(result); } value prim_equal_sign(value args) { long num1 = value_to_long(first(args)); long num2 = value_to_long(second(args)); return booleanv(num1 == num2); } value prim_less_than_sign(value args) { long num1 = value_to_long(first(args)); long num2 = value_to_long(second(args)); return booleanv(num1 < num2); } value prim_eq_p(value args) { return booleanv(eq(first(args), second(args))); } value prim_equal_p(value args) { return booleanv(equal(first(args), second(args))); } value prim_number_p(value args) { return booleanv(number_p(first(args))); } value prim_string_p(value args) { return booleanv(string_p(first(args))); } value prim_symbol_p(value args) { return booleanv(symbol_p(first(args))); } value prim_pair_p(value args) { return booleanv(pair_p(first(args))); } value prim_null_p(value args) { return booleanv(null_p(first(args))); } value prim_car(value args) { return car(first(args)); } value prim_cdr(value args) { return cdr(first(args)); } value prim_cons(value args) { return cons(first(args), second(args)); } value prim_list(value args) { return args; } value prim_set_car_bang(value args) { set_car(first(args), second(args)); return sym(s_ok); } value prim_set_cdr_bang(value args) { set_cdr(first(args), second(args)); return sym(s_ok); } value prim_display(value args) { print(first(args)); return sym(s_ok); } value prim_newline(value args) { printf("\n"); return sym(s_ok); } value prim_gc_runs(value args) { return num(gc_runs); } value prim_stack_max_depth(value args) { return num(STACK_SIZE); } /* * The global environment * * The code below initializes the global environment */ value global_env; void add_primitive_to_env(value env, const char *name, primitive_function function) { define_variable(intern(name), primitive(function), env); } void initialize_global_environment() { global_env = empty_environment(); define_variable(intern("true"), truev(), global_env); define_variable(intern("false"), falsev(), global_env); add_primitive_to_env(global_env, "+", prim_add); add_primitive_to_env(global_env, "-", prim_sub); add_primitive_to_env(global_env, "*", prim_mul); add_primitive_to_env(global_env, "=", prim_equal_sign); add_primitive_to_env(global_env, "<", prim_less_than_sign); add_primitive_to_env(global_env, "eq?", prim_eq_p); add_primitive_to_env(global_env, "equal?", prim_equal_p); add_primitive_to_env(global_env, "number?", prim_number_p); add_primitive_to_env(global_env, "string?", prim_string_p); add_primitive_to_env(global_env, "symbol?", prim_symbol_p); add_primitive_to_env(global_env, "pair?", prim_pair_p); add_primitive_to_env(global_env, "null?", prim_null_p); add_primitive_to_env(global_env, "car", prim_car); add_primitive_to_env(global_env, "cdr", prim_cdr); add_primitive_to_env(global_env, "cons", prim_cons); add_primitive_to_env(global_env, "list", prim_list); add_primitive_to_env(global_env, "set-car!", prim_set_car_bang); add_primitive_to_env(global_env, "set-cdr!", prim_set_cdr_bang); add_primitive_to_env(global_env, "display", prim_display); add_primitive_to_env(global_env, "newline", prim_newline); add_primitive_to_env(global_env, "gc-runs", prim_gc_runs); add_primitive_to_env(global_env, "stack-max-depth", prim_stack_max_depth); } /* * The garbage collector * * This is based on the stop-and-copy garbage collector of section 5.3. It * uses a few modifications, namely how root is handled. * * Instead of having a root, we start by relocating all the registers and * stack. Afterwards, we run the garbage collection as usual. When it scan * overtakes free, we update the registers and stack pointers before flipping * the memory. If there are pairs in the stack or registers, they point to an * address in the old memory. Since it is already relocated, it will contain * broken hearts and forwarding addresses. All those pairs get updated with * the forwarding address. * * Note that procedures are treated as pairs for the purpose of garbage * collection. * * There is a fine point when the garbage collector is run. Before evaluating * an expressing, the explicit-control evaluator checks to see if there is * enough free memory (where "enough" is defined by MEMORY_WIGGLE_ROOM). If * not, garbage collection is triggered. * * The alternative approach will be to do that in the cons() call when we're * running out of memory. While that would be better, it poses two problems. * * First, the car and cdr passed to cons will contain addresses to the old * memory. This can be solved simply by pushing them on the stack, garbage * collecting and poping. That would solve the problem. * * The second is more subtle. Since the C code calls cons(), that might * trigger garbage collection. Let's say there is a call like this: * * cons(cons(num(1), num(2)), cons(num(3), num(4))) * * The third call to cons takes two pairs as arguments - (1 . 2) and (3 . 4). * If the second call triggers garbage collection, the result will be an * address in the new memory (provided we solved the first problem), but the * first pair will still have the old address. That will result to an invalid * pair. * * A solution I can think of is if the C cons function does not take its * arguments directly, but from the Scheme stack instead. That way if a cons * triggers garbage collection, all the intermediate pairs will be in the * stack and relocated from the garbage collecter. * * This is an interesting change to the code that I might revisit some day. * Until then, there is a preemptive check if garbage collection needs to run * on each evaluation of an expression. * * Garbage collection is triggered by the gc() function. I've always wanted to * write a function called "gc"; */ int gc_scan; int gc_free; void relocate(value); void update(value *); void relocate_registers_and_stack(); void update_registers_and_stack(); void update_value_from_old_memory(value *); void gc() { gc_scan = 0; gc_free = 0; relocate_registers_and_stack(); while (gc_scan < gc_free) { update(&free_mem->cars[gc_scan]); update(&free_mem->cdrs[gc_scan]); gc_scan++; } update_registers_and_stack(); memory *tmp = working_mem; working_mem = free_mem; free_mem = tmp; free_ptr = gc_free; gc_runs += 1; } void relocate(value val) { if (!pair_p(val) && !procedure_p(val)) return; int old_address = val.value; if (broken_heart_p(working_mem->cars[old_address])) return; free_mem->cars[gc_free] = working_mem->cars[old_address]; free_mem->cdrs[gc_free] = working_mem->cdrs[old_address]; working_mem->cars[old_address] = broken_heart(); working_mem->cdrs[old_address] = num(gc_free); gc_free++; } void update(value *val) { if (!pair_p(*val) && !procedure_p(*val)) return; relocate(*val); int old_address = val->value; int new_address = working_mem->cdrs[old_address].value; val->value = new_address; } void relocate_registers_and_stack() { relocate(val); relocate(expr); relocate(unev); relocate(proc); relocate(argl); relocate(env); relocate(cont); relocate(global_env); for(int i = 0; i < stack_ptr; i++) { relocate(stack[i]); } } void update_registers_and_stack() { update_value_from_old_memory(&val); update_value_from_old_memory(&expr); update_value_from_old_memory(&unev); update_value_from_old_memory(&proc); update_value_from_old_memory(&argl); update_value_from_old_memory(&env); update_value_from_old_memory(&cont); update_value_from_old_memory(&global_env); for(int i = 0; i < stack_ptr; i++) { update_value_from_old_memory(&stack[i]); } } void update_value_from_old_memory(value *val) { if (!pair_p(*val) && !procedure_p(*val)) return; val->value = working_mem->cdrs[val->value].value; } void gc_if_necessary() { if (MEMORY_SIZE - free_ptr < MEMORY_WIGGLE_ROOM) { gc(); } } /* * The printer * * This is based on the code in exercise 4.34. It was nice to be able to reuse * an algorithm I though about on a piece of paper. */ void print_cdr(value v) { switch (v.type) { case p_null: printf(")"); break; case p_pair: printf(" "); print(car(v)); print_cdr(cdr(v)); break; default: printf(" . "); print(v); printf(")"); } } void print(value v) { switch (v.type) { case p_null: printf("()"); break; case p_boolean: if (v.value) printf("#t"); else printf("#f"); break; case p_number: printf("%ld", (long) v.value); break; case p_symbol: printf("%s", (symbol) v.value); break; case p_string: printf("%s", (const char *) v.value); break; case p_pair: printf("("); print(car(v)); print_cdr(cdr(v)); break; case p_procedure: printf("", (int) v.value); break; case p_primitive: printf("", (long) v.value); break; case p_label: printf("", (unsigned long) v.value); break; case p_broken_heart: printf(""); break; } } /* * The parser * * It is a simple, hand-written parser. I managed to whip it up why almost * asleep and without consulting the Dragon Book. I'm not extremely proud, so * I will gloss over details. * * It calls sym() and str(), which makes it allocate strings and symbols * freely. If pointers to those strings are garbage collected, this will * result to memory leaks. */ const char *input; char lookahead; int pos = 0; value parse_sexp(); value read(const char *string) { input = string; pos = 0; lookahead = input[pos]; return parse_sexp(); } char advance() { if (lookahead == '\0') error("Unexpected end of input"); char result = input[pos]; lookahead = input[++pos]; return result; } void match(char c) { if (lookahead != c) errorc("Expected character", c); advance(); } void whitespace() { while (lookahead == ' ' || lookahead == '\n' || lookahead == ';') { if (lookahead == ';') { match(';'); while (lookahead != '\n') advance(); match('\n'); } else { advance(); } } } value parse_symbol() { char buffer[MAX_TOKEN_LENGTH + 1]; int i = 0; while (lookahead != ' ' && lookahead != '\n' && lookahead != ')' && lookahead != '\0') { buffer[i++] = advance(); if (i > MAX_TOKEN_LENGTH) errort("Parser encountered a token that is too long", buffer); } buffer[i] = '\0'; return sym(buffer); } value parse_number() { char buffer[MAX_TOKEN_LENGTH + 1]; int i = 0; while ('0' <= lookahead && lookahead <= '9') { buffer[i++] = advance(); if (i > MAX_TOKEN_LENGTH) errort("Parser encountered a token that is too long", buffer); } buffer[i] = '\0'; return num(atoi(buffer)); } value parse_string() { char buffer[MAX_TOKEN_LENGTH + 1]; int i = 0; match('"'); while (lookahead != '"') { buffer[i++] = advance(); if (i > MAX_TOKEN_LENGTH) errort("Parser encountered a token that is too long...", buffer); } match('"'); buffer[i] = '\0'; return str(buffer); } value parse_quote() { match('\''); value quoted = parse_sexp(); return cons(sym("quote"), cons(quoted, null())); } value parse_list() { whitespace(); if (lookahead == ')') { match(')'); return null(); } else if (lookahead == '.') { match('.'); value sexp = parse_sexp(); whitespace(); match(')'); return sexp; } else { value car = parse_sexp(); whitespace(); value cdr = parse_list(); return cons(car, cdr); } } value parse_sexp() { whitespace(); if (lookahead == '(') { match('('); return parse_list(); } else if (lookahead == '\'') { return parse_quote(); } else if ('0' <= lookahead && lookahead <= '9') { return parse_number(); } else if (lookahead == '"') { return parse_string(); } else { return parse_symbol(); } } /* * Syntax functions * * The familiar syntax functions that are used to figure out what to evaluate. */ bool tagged_list_p(value expr, symbol tag) { if (expr.type == p_pair) { value head = car(expr); return head.type == p_symbol && ((const char *) head.value) == tag; } else { return false; } } bool self_evaluating_p(value expr) { return number_p(expr) || string_p(expr); } bool variable_p(value expr) { return symbol_p(expr); } bool quoted_p(value expr) { return tagged_list_p(expr, s_quote); } bool begin_p(value expr) { return tagged_list_p(expr, s_begin); } bool if_p(value expr) { return tagged_list_p(expr, s_if); } bool definition_p(value expr) { return tagged_list_p(expr, s_define); } bool assignment_p(value expr) { return tagged_list_p(expr, s_set_bang); } bool lambda_p(value expr) { return tagged_list_p(expr, s_lambda); } bool application_p(value expr) { return pair_p(expr); } value text_of_quotation(value expr) { return car(cdr(expr)); } value if_predicate(value expr) { return second(expr); } value if_consequent(value expr) { return third(expr); } value if_alternative(value expr) { return fourth(expr); } value operator(value expr) { return car(expr); } value operands(value expr) { return cdr(expr); } bool no_operands_p(value expr) { return null_p(expr); } value lambda_parameters(value expr) { return car(cdr(expr)); } value lambda_body(value expr) { return cdr(cdr(expr)); } value assignment_variable(value expr) { return second(expr); } value assignment_value(value expr) { return third(expr); } value make_lambda(value parameters, value body) { return cons(sym(s_lambda), cons(parameters, body)); } value definition_variable(value expr) { if (symbol_p(car(cdr(expr)))) return car(cdr(expr)); else return car(car(cdr(expr))); } value definition_value(value expr) { if (symbol_p(car(cdr(expr)))) return car(cdr(cdr(expr))); else return make_lambda(cdr(car(cdr(expr))), cdr(cdr(expr))); } value begin_actions(value expr) { return cdr(expr); } value first_exp(value expr) { return car(expr); } value rest_exps(value expr) { return cdr(expr); } int last_exp_p(value expr) { return pair_p(expr) && null_p(cdr(expr)); } value first_operand(value expr) { return car(expr); } value rest_operands(value expr) { return cdr(expr); } int last_operand_p(value expr) { return pair_p(expr) && null_p(cdr(expr)); } /* * The explicit-control evaluator * * I've chosen to translate this line-by-line for two reasons. First, I get * one more chance to write the explicit evaluator, using C this time, which * was an interesting exercise. Second, this gives me tail-call optimizations * for free, which is way better than figuring out a way to implement them * myself. * * As a fun note, we're storing pointers to labels, which I did not know was * possible. */ value start() { cont = label(&&done); eval_dispatch: gc_if_necessary(); if (self_evaluating_p(expr)) goto ev_self_eval; if (variable_p(expr)) goto ev_variable; if (quoted_p(expr)) goto ev_quoted; if (assignment_p(expr)) goto ev_assignment; if (if_p(expr)) goto ev_if; if (definition_p(expr)) goto ev_definition; if (begin_p(expr)) goto ev_begin; if (lambda_p(expr)) goto ev_lambda; if (application_p(expr)) goto ev_application; errorv("Unrecognized expression", expr); ev_self_eval: val = expr; goto *value_to_label(cont); ev_variable: val = lookup_variable(value_to_sym(expr), env); goto *value_to_label(cont); ev_quoted: val = text_of_quotation(expr); goto *value_to_label(cont); ev_lambda: unev = lambda_parameters(expr); expr = lambda_body(expr); val = make_procedure(unev, expr, env); goto *value_to_label(cont); ev_application: push(cont); push(env); unev = operands(expr); push(unev); expr = operator(expr); cont = label(&&ev_appl_did_operator); goto eval_dispatch; ev_appl_did_operator: unev = pop(); env = pop(); argl = empty_arglist(); proc = val; if (no_operands_p(unev)) goto apply_dispatch; push(proc); ev_appl_operand_loop: push(argl); expr = first_operand(unev); if (last_operand_p(unev)) goto ev_appl_last_arg; push(env); push(unev); cont = label(&&ev_appl_accumulate_arg); goto eval_dispatch; ev_appl_accumulate_arg: unev = pop(); env = pop(); argl = pop(); argl = adjoin_arg(val, argl); unev = rest_operands(unev); goto ev_appl_operand_loop; ev_appl_last_arg: cont = label(&&ev_appl_accum_last_arg); goto eval_dispatch; ev_appl_accum_last_arg: argl = pop(); argl = adjoin_arg(val, argl); proc = pop(); goto apply_dispatch; apply_dispatch: if (primitive_p(proc)) goto primitive_apply; if (procedure_p(proc)) goto compound_apply; errorv("Unknown procedure type", proc); primitive_apply: val = apply_primitive_procedure(proc, argl); cont = pop(); goto *value_to_label(cont); compound_apply: unev = procedure_parameters(proc); env = procedure_environment(proc); env = extend_environment(unev, argl, env); unev = procedure_body(proc); goto ev_sequence; ev_begin: unev = begin_actions(expr); push(cont); ev_sequence: expr = first_exp(unev); if (last_exp_p(unev)) goto ev_sequence_last_exp; push(unev); push(env); cont = label(&&ev_sequence_continue); goto eval_dispatch; ev_sequence_continue: env = pop(); unev = pop(); unev = rest_exps(unev); goto ev_sequence; ev_sequence_last_exp: cont = pop(); goto eval_dispatch; ev_if: push(expr); push(env); push(cont); cont = label(&&ev_if_decide); expr = if_predicate(expr); goto eval_dispatch; ev_if_decide: cont = pop(); env = pop(); expr = pop(); if (true_p(val)) goto ev_if_consequent; ev_if_alternative: expr = if_alternative(expr); goto eval_dispatch; ev_if_consequent: expr = if_consequent(expr); goto eval_dispatch; ev_assignment: unev = assignment_variable(expr); push(unev); expr = assignment_value(expr); push(env); push(cont); cont = label(&&ev_assignment_1); goto eval_dispatch; ev_assignment_1: cont = pop(); env = pop(); unev = pop(); set_variable_value(value_to_sym(unev), val, env); val = sym(s_ok); goto *value_to_label(cont); ev_definition: unev = definition_variable(expr); push(unev); expr = definition_value(expr); push(env); push(cont); cont = label(&&ev_definition_1); goto eval_dispatch; ev_definition_1: cont = pop(); env = pop(); unev = pop(); define_variable(value_to_sym(unev), val, env); val = sym(s_ok); goto *value_to_label(cont); done: return val; } /* * The eval function */ value eval(value expression) { env = global_env; expr = expression; start(); return val; } /* * Running a file * * The file is read in a buffer and then the buffer is read and evaluated. The * buffer has a maximum size, over which the program will error out. Of * course, the buffer can be allocated dynamically, but this is just simpler. */ void run_file(const char *filename) { int chars_read; char buffer[MAX_FILE_SIZE]; FILE *file = fopen(filename, "r"); if (!file) { printf("Failed to open %s: %s\n", filename, strerror(errno)); exit(0); } chars_read = fread(buffer, sizeof(char), MAX_FILE_SIZE, file); fclose(file); if (chars_read == MAX_FILE_SIZE) { printf("File %s is too big (more than %d bytes)\n", filename, MAX_FILE_SIZE); exit(0); } buffer[chars_read] = '\0'; eval(read(buffer)); } /* * The read-eval-print loop * * There is not much needed to explain here. repl() is another name I've * always wanted to give to a function. */ char line[MAX_LINE_LENGTH + 1]; value read_line() { if (!fgets(line, MAX_LINE_LENGTH, stdin)) error("Line too long"); return read(line); } void repl() { value input, result; printf("Structure and Interpretation of Computer Programs\n"); printf("Exercise 5.51 - Scheme evaluator in C\n"); while (true) { printf("> "); input = read_line(); result = eval(input); print(result); printf("\n"); } } /* * The main function * * It initializes everything first. Afterwards, it runs any files if passed as * command line arguments. Otherwise, it runs the REPL. */ int main(int argc, char *argv[]) { initialize_memory(); initialize_symbols(); initialize_registers(); initialize_global_environment(); if (argc > 1) { for (int i = 1; i < argc; i++) { run_file(argv[i]); } } else { repl(); } } ================================================ FILE: scheme/sicp/05/support/51/tests.scm ================================================ (begin (define passed-tests 0) (define failed-tests 0) (define (test actual expected) (if (equal? actual expected) (set! passed-tests (+ 1 passed-tests)) (set! failed-tests (+ 1 failed-tests)))) (test 1 1) (test "something" "something") (test (quote foo) 'foo) (test (begin 1 2) 2) (test (define x1 1) 'ok) (test (begin (define x2 1) x2) 1) (test (define (x3) 1) 'ok) (test (begin (define (x3) 1) (x3)) 1) (test (begin (define x4 1) (set! x4 2)) 'ok) (test (begin (define x5 1) (set! x5 2) x5) 2) (test (if true 1 2) 1) (test (if false 1 2) 2) (test ((lambda () 1)) 1) (test ((lambda (x) x) 1) 1) (test ((lambda (a b) (cons a b)) 1 2) '(1 . 2)) (test (begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3)) '(3 . 2)) (test (begin (define (a) 1) (a)) 1) (test (begin (define (pair1 a b) (cons a b)) (pair1 1 2)) '(1 . 2)) (test (begin (define a 1) (define (pair2 b) (cons a b)) (pair2 2)) '(1 . 2)) (test (begin (define (append1 x y) (if (null? x) y (cons (car x) (append1 (cdr x) y)))) (append1 '(a b c) '(d e f))) '(a b c d e f)) (test (begin (define (factorial1 n) (if (= n 1) 1 (* n (factorial1 (- n 1))))) (factorial1 5)) 120) (test (begin (define (factorial2 n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial2 5)) 120) (test (< 1 (gc-runs)) true) (test (begin (define (countdown n) (if (= n 0) 'done (countdown (- n 1)))) (countdown (+ 1 (stack-max-depth)))) 'done) (display (list 'passed '= passed-tests 'failed '= failed-tests))) ================================================ FILE: scheme/sicp/05/support/52/build.scm ================================================ ; The necessary code to compile the compiled interpreter and run the tests ; withn it (require racket/runtime-path) (define-runtime-path base-path ".") (define (relative-path path) (find-relative-path (current-directory) (simplify-path (build-path base-path path)))) (define source-path (relative-path "runtime.c")) (define tests-path (relative-path "tests.scm")) (define compiled-code-path (relative-path "../bin/compiled_interpreter")) (define target-path (relative-path "../bin/52")) (define compile-call (format "cc --std=c99 ~a -o ~a" (path->string source-path) (path->string target-path))) (define run-tests-call (format "~a ~a" (path->string target-path) (path->string tests-path))) (define (write-interpreter c-code) (with-output-to-file compiled-code-path (lambda () (display c-code)) #:mode 'text #:exists 'truncate)) (define (compile-runtime) (let ((exit-code (system/exit-code compile-call))) (when (not (zero? exit-code)) (error "Failed to compile the runtime ;(")))) (define (run-interpreter-tests) (system run-tests-call)) (define (interpreter-test-results) (with-output-to-string run-interpreter-tests)) ================================================ FILE: scheme/sicp/05/support/52/compiler.scm ================================================ ; The section 5.5 compiler. ; ; The only difference is the introduction of let expressions. (define (compile-exp exp target linkage) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage)) ((assignment? exp) (compile-assignment exp target linkage)) ((definition? exp) (compile-definition exp target linkage)) ((if? exp) (compile-if exp target linkage)) ((let? exp) (compile-exp (let->combination exp) target linkage)) ((lambda? exp) (compile-lambda exp target linkage)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage)) ((cond? exp) (compile-exp (cond->if exp) target linkage)) ((application? exp) (compile-application exp target linkage)) (else (error "Unknown expression type -- COMPILE" exp)))) ; Compiling linkage code (define (compile-linkage linkage) (cond ((eq? linkage 'return) (make-instruction-sequence '(continue) '() '((goto (reg continue))))) ((eq? linkage 'next) (empty-instruction-sequence)) (else (make-instruction-sequence '() '() `((goto (label ,linkage))))))) (define (end-with-linkage linkage instruction-sequence) (preserving '(continue) instruction-sequence (compile-linkage linkage))) ; Compiling simple expressions (define (compile-self-evaluating exp target linkage) (end-with-linkage linkage (make-instruction-sequence '() (list target) `((assign ,target (const ,exp)))))) (define (compile-quoted exp target linkage) (end-with-linkage linkage (make-instruction-sequence '() (list target) `((assign ,target (const ,(text-of-quotation exp))))))) (define (compile-variable exp target linkage) (end-with-linkage linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op lookup-variable-value) (const ,exp) (reg env)))))) (define (compile-assignment exp target linkage) (let ((var (assignment-variable exp)) (get-value-code (compile-exp (assignment-value exp) 'val 'next))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op set-variable-value!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))))) (define (compile-definition exp target linkage) (let ((var (definition-variable exp)) (get-value-code (compile-exp (definition-value exp) 'val 'next))) (end-with-linkage linkage (preserving '(env) get-value-code (make-instruction-sequence '(env val) (list target) `((perform (op define-variable!) (const ,var) (reg val) (reg env)) (assign ,target (const ok)))))))) ; Compiling conditional expressions (define (compile-if exp target linkage) (let ((t-branch (make-label 'true-branch)) (f-branch (make-label 'false-branch)) (after-if (make-label 'after-if))) (let ((consequent-linkage (if (eq? linkage 'next) after-if linkage))) (let ((p-code (compile-exp (if-predicate exp) 'val 'next)) (c-code (compile-exp (if-consequent exp) target consequent-linkage)) (a-code (compile-exp (if-alternative exp) target linkage))) (preserving '(env continue) p-code (append-instruction-sequences (make-instruction-sequence '(val) '() `((test (op false?) (reg val)) (branch (label ,f-branch)))) (parallel-instruction-sequences (append-instruction-sequences t-branch c-code) (append-instruction-sequences f-branch a-code)) after-if)))))) ; Compiling sequences (define (compile-sequence seq target linkage) (if (last-exp? seq) (compile-exp (first-exp seq) target linkage) (preserving '(env continue) (compile-exp (first-exp seq) target 'next) (compile-sequence (rest-exps seq) target linkage)))) ; Compiling lambda expressions (define (compile-lambda exp target linkage) (let ((proc-entry (make-label 'entry)) (after-lambda (make-label 'after-lambda))) (let ((lambda-linkage (if (eq? linkage 'next) after-lambda linkage))) (append-instruction-sequences (tack-on-instruction-sequence (end-with-linkage lambda-linkage (make-instruction-sequence '(env) (list target) `((assign ,target (op make-compiled-procedure) (label ,proc-entry) (reg env))))) (compile-lambda-body exp proc-entry)) after-lambda)))) (define (compile-lambda-body exp proc-entry) (let ((formals (lambda-parameters exp))) (append-instruction-sequences (make-instruction-sequence '(env proc argl) '(env) `(,proc-entry (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const ,formals) (reg argl) (reg env)))) (compile-sequence (lambda-body exp) 'val 'return)))) ; Compiling combinations (define (compile-application exp target linkage) (let ((proc-code (compile-exp (operator exp) 'proc 'next)) (operand-codes (map (lambda (operand) (compile-exp operand 'val 'next)) (operands exp)))) (preserving '(env continue) proc-code (preserving '(proc continue) (construct-arglist operand-codes) (compile-procedure-call target linkage))))) (define (construct-arglist operand-codes) (let ((operand-codes (reverse operand-codes))) (if (null? operand-codes) (make-instruction-sequence '() '(argl) '((assign argl (const ())))) (let ((code-to-get-last-arg (append-instruction-sequences (car operand-codes) (make-instruction-sequence '(val) '(argl) '((assign argl (op list) (reg val))))))) (if (null? (cdr operand-codes)) code-to-get-last-arg (preserving '(env) code-to-get-last-arg (code-to-get-rest-args (cdr operand-codes)))))))) (define (code-to-get-rest-args operand-codes) (let ((code-for-next-arg (preserving '(argl) (car operand-codes) (make-instruction-sequence '(val argl) '(argl) '((assign argl (op cons) (reg val) (reg argl))))))) (if (null? (cdr operand-codes)) code-for-next-arg (preserving '(env) code-for-next-arg (code-to-get-rest-args (cdr operand-codes)))))) ; Applying procedures (define (compile-procedure-call target linkage) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (after-call (make-label 'after-call))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() `((test (op primitive-procedure?) (reg proc)) (branch (label ,primitive-branch)))) (parallel-instruction-sequences (append-instruction-sequences compiled-branch (compile-proc-appl target compiled-linkage)) (append-instruction-sequences primitive-branch (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl))))))) after-call)))) ; Applying compiled procedures (define all-regs '(env proc val argl continue)) (define (compile-proc-appl target linkage) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,linkage)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val))))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((proc-return (make-label 'proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,proc-return)) (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) ,proc-return (assign ,target (reg val)) (goto (label ,linkage)))))) ((and (eq? target 'val) (eq? linkage 'return)) (make-instruction-sequence '(proc continue) all-regs `((assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val))))) ((and (not (eq? target 'val)) (eq? linkage 'return)) (error "return linkage, target not val -- COMPILE-EXP" target)) (else (error "How did we get here?")))) ; Combining Instruction Sequences (define (registers-needed s) (if (symbol? s) '() (car s))) (define (registers-modified s) (if (symbol? s) '() (cadr s))) (define (statements s) (if (symbol? s) (list s) (caddr s))) (define (needs-register? seq reg) (memq reg (registers-needed seq))) (define (modifies-register? seq reg) (memq reg (registers-modified seq))) (define (append-instruction-sequences . seqs) (define (append-2-sequences seq1 seq2) (make-instruction-sequence (list-union (registers-needed seq1) (list-difference (registers-needed seq2) (registers-modified seq1))) (list-union (registers-modified seq1) (registers-modified seq2)) (append (statements seq1) (statements seq2)))) (define (append-seq-list seqs) (if (null? seqs) (empty-instruction-sequence) (append-2-sequences (car seqs) (append-seq-list (cdr seqs))))) (append-seq-list seqs)) (define (list-union s1 s2) (cond ((null? s1) s2) ((memq (car s1) s2) (list-union (cdr s1) s2)) (else (cons (car s1) (list-union (cdr s1) s2))))) (define (list-difference s1 s2) (cond ((null? s1) '()) ((memq (car s1) s2) (list-difference (cdr s1) s2)) (else (cons (car s1) (list-difference (cdr s1) s2))))) (define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) (if (and (needs-register? seq2 first-reg) (modifies-register? seq1 first-reg)) (preserving (cdr regs) (make-instruction-sequence (list-union (list first-reg) (registers-needed seq1)) (list-difference (registers-modified seq1) (list first-reg)) (append `((save ,first-reg)) (statements seq1) `((restore ,first-reg)))) seq2) (preserving (cdr regs) seq1 seq2))))) (define (tack-on-instruction-sequence seq body-seq) (make-instruction-sequence (registers-needed seq) (registers-modified seq) (append (statements seq) (statements body-seq)))) (define (parallel-instruction-sequences seq1 seq2) (make-instruction-sequence (list-union (registers-needed seq1) (registers-needed seq2)) (list-union (registers-modified seq1) (registers-modified seq2)) (append (statements seq1) (statements seq2)))) ; Instruction sequences (define (make-instruction-sequence needs modifies statements) (list needs modifies statements)) (define (empty-instruction-sequence) (make-instruction-sequence '() '() '())) ; Make label (define label-counter 0) (define (new-label-number) (set! label-counter (+ 1 label-counter)) label-counter) (define (make-label name) (string->symbol (string-append (symbol->string name) (number->string (new-label-number))))) ; Compiled procedure operations (define (make-compiled-procedure entry env) (list 'compiled-procedure entry env)) (define (compiled-procedure? proc) (tagged-list? proc 'compiled-procedure)) (define (compiled-procedure-entry c-proc) (cadr c-proc)) (define (compiled-procedure-env c-proc) (caddr c-proc)) ================================================ FILE: scheme/sicp/05/support/52/metacircular-evaluator.scm ================================================ (define metacircular-evaluator '(begin (define (evaluate exp env) (gc-if-necessary) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (evaluate (cond->if exp) env)) ((application? exp) (apply-procedure (evaluate (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type - EVALUATE" exp)))) (define (apply-procedure procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type - APPLY-PROCEDURE" procedure)))) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (evaluate (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (evaluate (if-predicate exp) env)) (evaluate (if-consequent exp) env) (evaluate (if-alternative exp) env))) (define (eval-sequence exps env) (cond ((last-exp? exps) (evaluate (first-exp exps) env)) (else (evaluate (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (evaluate (assignment-value exp) env) env) 'ok) (define (eval-definition exp env) (define-variable! (definition-variable exp) (evaluate (definition-value exp) env) env) 'ok) (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable - SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? proc) (tagged-list? proc 'evaluator-primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'list list) (list 'display display) (list 'null? null?) (list 'equal? equal?) (list 'stack-max-depth stack-max-depth) (list 'gc-runs gc-runs) (list '= =) (list '+ +) (list '- -) (list '* *) (list '< <))) (define (primitive-procedure-names) (map car primitive-procedures)) (define (primitive-procedure-objects) (map (lambda (proc) (list 'evaluator-primitive (cadr proc))) primitive-procedures)) (define (apply-primitive-procedure proc args) (apply-primitive (primitive-implementation proc) args)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env)) (define (map proc lst) (if (null? lst) '() (cons (proc (car lst)) (map proc (cdr lst))))) (define (cadr lst) (car (cdr lst))) (define (cddr lst) (cdr (cdr lst))) (define (caadr lst) (car (car (cdr lst)))) (define (caddr lst) (car (cdr (cdr lst)))) (define (cdadr lst) (cdr (car (cdr lst)))) (define (cdddr lst) (cdr (cdr (cdr lst)))) (define (cadddr lst) (car (cdr (cdr (cdr lst))))) (define (not x) (if x false true)) (define (length lst) (if (null? lst) 0 (+ 1 (length (cdr lst))))) (define the-global-environment (setup-environment)) (define (eval* exp) (evaluate exp the-global-environment)))) ================================================ FILE: scheme/sicp/05/support/52/runtime.c ================================================ /* * The code for exercise 5.52. * * I wrote it by copying the code for 5.51, removing the unneeded parts and * adding the required primitive operations. The new code is at the end of the * file, after the main function. * * All this code here is necessary as a runtime for the compiled Scheme * interpreter. * * It's noteworthy that the call to gc_if_necessary() is triggered from the * interpreter. There is a primitive procedure gc-if-necessary that wraps the * call and it is called before evaluating an expression. */ #include #include #include #include #include #define MAX_FILE_SIZE 10000 #define MAX_LINE_LENGTH 50 #define MAX_TOKEN_LENGTH 128 #define MEMORY_SIZE 10000 #define MEMORY_WIGGLE_ROOM 1000 #define STACK_SIZE 400 typedef enum p_type p_type; typedef struct symbol_node symbol_node; typedef struct pairs memory; typedef struct value value; typedef const char* symbol; typedef value (*primitive_function)(value); /* * Definitions for values and memory. */ enum p_type { p_null, p_boolean, p_number, p_symbol, p_string, p_pair, p_procedure, p_primitive, p_label, p_broken_heart }; struct value { p_type type; unsigned long value; }; /* * Memory declarations */ struct pairs { value cars[MEMORY_SIZE]; value cdrs[MEMORY_SIZE]; }; unsigned int free_ptr = 0; memory *working_mem; memory *free_mem; memory block1; memory block2; /* * The main interface */ value read(const char *); value eval(value); void print(value); void gc_if_necessary(); /* * The number of times the garbage collector has run */ int gc_runs = 0; /* * Error reporting */ void error(const char *message) { printf("%s\n", message); exit(0); } void errorc(const char *message, char c) { printf("%s: %c\n", message, c); exit(0); } void errorv(const char *message, value val) { printf("%s: ", message); print(val); printf("\n"); exit(0); } void errort(const char *message, char *token) { token[MAX_TOKEN_LENGTH] = '\0'; printf("%s: %s\n", message, token); exit(0); } void errors(const char *message, symbol sym) { printf("%s: %s\n", message, sym); exit(0); } /* * Symbols */ symbol_node *symbol_table_head; struct symbol_node { symbol symbol; symbol_node* next; }; symbol_node* allocate_symbol_node(const char *name) { char *copy = calloc(sizeof(char), 1 + strlen(name)); strcpy(copy, name); symbol_node *node = malloc(sizeof(node)); node->symbol = copy; node->next = NULL; return node; } symbol intern(const char *name) { if (!symbol_table_head) { symbol_table_head = allocate_symbol_node(name); return symbol_table_head->symbol; } symbol_node* current = symbol_table_head; while (true) { if (strcmp(name, current->symbol) == 0) return current->symbol; if (!current->next) { symbol_node *new = allocate_symbol_node(name); current->next = new; return new->symbol; } current = current->next; } } /* * Preallocated symbols */ symbol s_quote; symbol s_begin; symbol s_if; symbol s_define; symbol s_set_bang; symbol s_lambda; symbol s_ok; void initialize_symbols() { s_quote = intern("quote"); s_begin = intern("begin"); s_if = intern("if"); s_define = intern("define"); s_set_bang = intern("set!"); s_lambda = intern("lambda"); s_ok = intern("ok"); } /* * Values */ // Type predicates bool null_p(value val) { return val.type == p_null; } bool boolean_p(value val) { return val.type == p_boolean; } bool number_p(value val) { return val.type == p_number; } bool symbol_p(value val) { return val.type == p_symbol; } bool string_p(value val) { return val.type == p_string; } bool pair_p(value val) { return val.type == p_pair; } bool procedure_p(value val) { return val.type == p_procedure; } bool primitive_p(value val) { return val.type == p_primitive; } bool label_p(value val) { return val.type == p_label; } bool broken_heart_p(value val) { return val.type == p_broken_heart; } // Null value null() { return (value) { p_null, 0 }; } // Booleans value truev() { return (value) { p_boolean, 1 }; } value falsev() { return (value) { p_boolean, 0 }; } value booleanv(bool val) { return val ? truev() : falsev(); } // Numbers value num(long n) { return (value) { p_number, n }; } long value_to_long(value val) { if (val.type != p_number) errorv("Expected a number", val); return (long) val.value; } // Symbols value sym(const char *s) { return (value) { p_symbol, (unsigned long) intern(s) }; } symbol value_to_sym(value val) { if (val.type != p_symbol) errorv("Expected a symbol", val); return (symbol) val.value; } // Strings value str(const char *s) { char *copy = calloc(sizeof(char), strlen(s) + 1); strcpy(copy, s); return (value) { p_string, (unsigned long) copy }; } // Pairs value cons(value car, value cdr) { if (free_ptr == MEMORY_SIZE) { error("Ran out of memory"); } working_mem->cars[free_ptr] = car; working_mem->cdrs[free_ptr] = cdr; value pair = (value) { p_pair, free_ptr }; free_ptr++; return pair; } value car(value pair) { if (pair.type != p_pair) errorv("Expected carable value", pair); return working_mem->cars[pair.value]; } value cdr(value pair) { if (pair.type != p_pair) errorv("Expected cdrable value", pair); return working_mem->cdrs[pair.value]; } void set_car(value pair, value val) { if (pair.type != p_pair) errorv("set_car expects a pair", pair); unsigned int offset = (unsigned int) pair.value; working_mem->cars[offset] = val; } void set_cdr(value pair, value val) { if (pair.type != p_pair) errorv("set_cdr expects a pair", pair); unsigned int offset = (unsigned int) pair.value; working_mem->cdrs[offset] = val; } // Procedures value pcons(value car, value cdr) { value pair = cons(car, cdr); // A little hack to reuse the cons() code. pair.type = p_procedure; return pair; } value pcdr(value proc) { if (proc.type != p_procedure) errorv("Expected a pcdrable value", proc); return working_mem->cdrs[proc.value]; } value pcar(value proc) { if (proc.type != p_procedure) errorv("Expected a pcarable value", proc); return working_mem->cars[proc.value]; } // Primitives value primitive(primitive_function function) { return (value) { p_primitive, (unsigned long) function }; } // Labels value label(void *label) { return (value) { p_label, (unsigned long) label }; } void *value_to_label(value label) { if (!label_p(label)) errorv("Expected a label", label); return (void *) label.value; } // Broken heart value broken_heart() { return (value) { p_broken_heart }; } /* * Memory initialization */ void wipe_memory(memory *memory) { for (int i = 0; i < MEMORY_SIZE; i++) { memory->cars[i] = (value) { p_null, 0 }; } } void initialize_memory() { wipe_memory(&block1); wipe_memory(&block2); working_mem = &block1; free_mem = &block2; } /* * The stack */ int stack_ptr = 0; value stack[STACK_SIZE]; void push(value v) { if (stack_ptr == STACK_SIZE) error("Stack overflow"); stack[stack_ptr++] = v; } value pop() { if (!stack_ptr) error("Stack is empty"); return stack[--stack_ptr]; } /* * The registers */ bool test; value cont; value val; value proc; value argl; value env; void initialize_registers() { cont = null(); val = null(); proc = null(); argl = null(); env = null(); } /* * Utility functions for working with lists */ value first(value pair) { return car(pair); } value second(value pair) { return car(cdr(pair)); } value third(value pair) { return car(cdr(cdr(pair))); } value fourth(value pair) { return car(cdr(cdr(cdr(pair)))); } /* * Standard functions */ int length(value list) { int result = 0; while (!null_p(list)) { list = cdr(list); result++; } return result; } bool eq(value v1, value v2) { return v1.type == v2.type && v1.value == v2.value; } bool equal(value v1, value v2) { if (v1.type != v2.type) return false; if (eq(v1, v2)) return true; switch (v1.type) { case p_string: return strcmp((char *) v1.value, (char *) v2.value) == 0; case p_pair: return equal(car(v1), car(v2)) && equal(cdr(v1), cdr(v2)); default: return false; } } /* * Environments */ value empty_environment() { return cons(cons(null(), cons(null(), null())), null()); } value extend_environment(value vars, value vals, value enclosing) { if (length(vars) != length(vals)) errorv("Argument count mismatch", cons(vars, cons(vals, null()))); value frame = cons(vars, cons(vals, null())); return cons(frame, enclosing); } value lookup_variable(symbol name, value env) { while (!null_p(env)) { value frame = car(env); value vars = car(frame); value vals = car(cdr(frame)); while (!null_p(vars)) { if (value_to_sym(car(vars)) == name) return car(vals); vars = cdr(vars); vals = cdr(vals); } env = cdr(env); } errors("Variable not found", name); exit(0); } void define_variable(symbol name, value val, value env) { value frame = car(env); value vars = car(frame); value vals = car(cdr(frame)); set_car(frame, cons(sym(name), vars)); set_car(cdr(frame), cons(val, vals)); } void set_variable_value(symbol name, value val, value env) { while (!null_p(env)) { value frame = car(env); value vars = car(frame); value vals = car(cdr(frame)); while (!null_p(vars)) { if (value_to_sym(car(vars)) == name) { set_car(vals, val); return; } vars = cdr(vars); vals = cdr(vals); } env = cdr(env); } errors("Variable not set", name); exit(0); } /* * Applying a primitive procedure */ value apply_primitive_procedure(value proc, value args) { if (!primitive_p(proc)) errorv("Trying to apply a non-primitive procedure", proc); primitive_function function = (primitive_function) proc.value; return function(args); } /* * The primitive procedures */ value prim_add(value args) { long result = 0; while (!null_p(args)) { result += value_to_long(car(args)); args = cdr(args); } return num(result); } value prim_sub(value args) { long result = value_to_long(car(args)); args = cdr(args); if (null_p(args)) return num(-result); while (!null_p(args)) { result -= value_to_long(car(args)); args = cdr(args); } return num(result); } value prim_mul(value args) { long result = 1; while (!null_p(args)) { result *= value_to_long(car(args)); args = cdr(args); } return num(result); } value prim_equal_sign(value args) { long num1 = value_to_long(first(args)); long num2 = value_to_long(second(args)); return booleanv(num1 == num2); } value prim_less_than_sign(value args) { long num1 = value_to_long(first(args)); long num2 = value_to_long(second(args)); return booleanv(num1 < num2); } value prim_eq_p(value args) { return booleanv(eq(first(args), second(args))); } value prim_equal_p(value args) { return booleanv(equal(first(args), second(args))); } value prim_number_p(value args) { return booleanv(number_p(first(args))); } value prim_string_p(value args) { return booleanv(string_p(first(args))); } value prim_symbol_p(value args) { return booleanv(symbol_p(first(args))); } value prim_pair_p(value args) { return booleanv(pair_p(first(args))); } value prim_null_p(value args) { return booleanv(null_p(first(args))); } value prim_car(value args) { return car(first(args)); } value prim_cdr(value args) { return cdr(first(args)); } value prim_cons(value args) { return cons(first(args), second(args)); } value prim_list(value args) { return args; } value prim_set_car_bang(value args) { set_car(first(args), second(args)); return sym(s_ok); } value prim_set_cdr_bang(value args) { set_cdr(first(args), second(args)); return sym(s_ok); } value prim_display(value args) { print(first(args)); return sym(s_ok); } value prim_newline(value args) { printf("\n"); return sym(s_ok); } value prim_gc_if_necessary(value args) { gc_if_necessary(); return sym(s_ok); } value prim_gc_runs(value args) { return num(gc_runs); } value prim_stack_max_depth(value args) { return num(STACK_SIZE); } value prim_apply_primitive(value args) { value proc = first(args); value arguments = second(args); if (!primitive_p(proc)) errorv("Expected a primitive procedure", proc); return apply_primitive_procedure(proc, arguments); } value prim_error(value args) { value message = car(args); value info = cdr(args); errorv((const char *) message.value, info); exit(0); } /* * The global environment */ value global_env; void add_primitive_to_env(value env, const char *name, primitive_function function) { define_variable(intern(name), primitive(function), env); } void initialize_global_environment() { global_env = empty_environment(); define_variable(intern("true"), truev(), global_env); define_variable(intern("false"), falsev(), global_env); add_primitive_to_env(global_env, "+", prim_add); add_primitive_to_env(global_env, "-", prim_sub); add_primitive_to_env(global_env, "*", prim_mul); add_primitive_to_env(global_env, "=", prim_equal_sign); add_primitive_to_env(global_env, "<", prim_less_than_sign); add_primitive_to_env(global_env, "eq?", prim_eq_p); add_primitive_to_env(global_env, "equal?", prim_equal_p); add_primitive_to_env(global_env, "number?", prim_number_p); add_primitive_to_env(global_env, "string?", prim_string_p); add_primitive_to_env(global_env, "symbol?", prim_symbol_p); add_primitive_to_env(global_env, "pair?", prim_pair_p); add_primitive_to_env(global_env, "null?", prim_null_p); add_primitive_to_env(global_env, "car", prim_car); add_primitive_to_env(global_env, "cdr", prim_cdr); add_primitive_to_env(global_env, "cons", prim_cons); add_primitive_to_env(global_env, "list", prim_list); add_primitive_to_env(global_env, "set-car!", prim_set_car_bang); add_primitive_to_env(global_env, "set-cdr!", prim_set_cdr_bang); add_primitive_to_env(global_env, "display", prim_display); add_primitive_to_env(global_env, "newline", prim_newline); add_primitive_to_env(global_env, "apply-primitive", prim_apply_primitive); add_primitive_to_env(global_env, "error", prim_error); add_primitive_to_env(global_env, "gc-runs", prim_gc_runs); add_primitive_to_env(global_env, "gc-if-necessary", prim_gc_if_necessary); add_primitive_to_env(global_env, "stack-max-depth", prim_stack_max_depth); } /* * The garbage collector */ int gc_scan; int gc_free; void relocate(value); void update(value *); void relocate_registers_and_stack(); void update_registers_and_stack(); void update_value_from_old_memory(value *); bool repeat = true; void gc() { gc_scan = 0; gc_free = 0; relocate_registers_and_stack(); while (gc_scan < gc_free) { update(&free_mem->cars[gc_scan]); update(&free_mem->cdrs[gc_scan]); gc_scan++; } update_registers_and_stack(); memory *tmp = working_mem; working_mem = free_mem; free_mem = tmp; free_ptr = gc_free; gc_runs += 1; } void relocate(value val) { if (!pair_p(val) && !procedure_p(val)) return; int old_address = val.value; if (broken_heart_p(working_mem->cars[old_address])) return; free_mem->cars[gc_free] = working_mem->cars[old_address]; free_mem->cdrs[gc_free] = working_mem->cdrs[old_address]; working_mem->cars[old_address] = broken_heart(); working_mem->cdrs[old_address] = num(gc_free); gc_free++; } void update(value *val) { if (!pair_p(*val) && !procedure_p(*val)) return; relocate(*val); int old_address = val->value; int new_address = working_mem->cdrs[old_address].value; val->value = new_address; } void relocate_registers_and_stack() { relocate(val); relocate(proc); relocate(argl); relocate(env); relocate(cont); relocate(global_env); for(int i = 0; i < stack_ptr; i++) { relocate(stack[i]); } } void update_registers_and_stack() { update_value_from_old_memory(&val); update_value_from_old_memory(&proc); update_value_from_old_memory(&argl); update_value_from_old_memory(&env); update_value_from_old_memory(&cont); update_value_from_old_memory(&global_env); for(int i = 0; i < stack_ptr; i++) { update_value_from_old_memory(&stack[i]); } } void update_value_from_old_memory(value *val) { if (!pair_p(*val) && !procedure_p(*val)) return; val->value = working_mem->cdrs[val->value].value; } void gc_if_necessary() { if (MEMORY_SIZE - free_ptr < MEMORY_WIGGLE_ROOM) { repeat = true; gc(); } } /* * The printer */ void print_cdr(value v) { switch (v.type) { case p_null: printf(")"); break; case p_pair: printf(" "); print(car(v)); print_cdr(cdr(v)); break; default: printf(" . "); print(v); printf(")"); } } void print(value v) { switch (v.type) { case p_pair: printf("("); print(car(v)); print_cdr(cdr(v)); break; case p_null: printf("()"); break; case p_symbol: printf("%s", (symbol) v.value); break; case p_number: printf("%ld", (long) v.value); break; case p_string: printf("%s", (const char *) v.value); break; case p_procedure: printf("", (int) v.value); break; case p_primitive: printf("", (long) v.value); break; case p_label: printf("", (unsigned long) v.value); return; case p_boolean: if (v.value) printf("#t"); else printf("#f"); break; case p_broken_heart: printf(""); break; } } /* * The parser */ const char *input; char lookahead; int pos = 0; value parse_sexp(); value read(const char *string) { input = string; pos = 0; lookahead = input[pos]; return parse_sexp(); } char advance() { if (lookahead == '\0') error("Unexpected end of input"); char result = input[pos]; lookahead = input[++pos]; return result; } void match(char c) { if (lookahead != c) errorc("Expected character", c); advance(); } void whitespace() { while (lookahead == ' ' || lookahead == '\n' || lookahead == ';') { if (lookahead == ';') { match(';'); while (lookahead != '\n') advance(); match('\n'); } else { advance(); } } } value parse_symbol() { char buffer[MAX_TOKEN_LENGTH + 1]; int i = 0; while (lookahead != ' ' && lookahead != '\n' && lookahead != ')' && lookahead != '\0') { buffer[i++] = advance(); if (i > MAX_TOKEN_LENGTH) errort("Parser encountered a token that is too long", buffer); } buffer[i] = '\0'; return sym(buffer); } value parse_number() { char buffer[MAX_TOKEN_LENGTH + 1]; int i = 0; while ('0' <= lookahead && lookahead <= '9') { buffer[i++] = advance(); if (i > MAX_TOKEN_LENGTH) errort("Parser encountered a token that is too long", buffer); } buffer[i] = '\0'; return num(atoi(buffer)); } value parse_string() { char buffer[MAX_TOKEN_LENGTH + 1]; int i = 0; match('"'); while (lookahead != '"') { buffer[i++] = advance(); if (i > MAX_TOKEN_LENGTH) errort("Parser encountered a token that is too long...", buffer); } match('"'); buffer[i] = '\0'; return str(buffer); } value parse_quote() { match('\''); value quoted = parse_sexp(); return cons(sym("quote"), cons(quoted, null())); } value parse_list() { whitespace(); if (lookahead == ')') { match(')'); return null(); } else if (lookahead == '.') { match('.'); value sexp = parse_sexp(); whitespace(); match(')'); return sexp; } else { value car = parse_sexp(); whitespace(); value cdr = parse_list(); return cons(car, cdr); } } value parse_sexp() { whitespace(); if (lookahead == '(') { match('('); return parse_list(); } else if (lookahead == '\'') { return parse_quote(); } else if ('0' <= lookahead && lookahead <= '9') { return parse_number(); } else if (lookahead == '"') { return parse_string(); } else { return parse_symbol(); } } /* * Running a file */ void run_file(const char *filename) { int chars_read; char buffer[MAX_FILE_SIZE]; FILE *file = fopen(filename, "r"); if (!file) { printf("Failed to open %s: %s\n", filename, strerror(errno)); exit(0); } chars_read = fread(buffer, sizeof(char), MAX_FILE_SIZE, file); fclose(file); if (chars_read == MAX_FILE_SIZE) { printf("File %s is too big (more than %d bytes)\n", filename, MAX_FILE_SIZE); exit(0); } buffer[chars_read] = '\0'; eval(read(buffer)); } /* * The read-eval-print loop */ char line[MAX_LINE_LENGTH + 1]; value read_line() { if (!fgets(line, MAX_LINE_LENGTH, stdin)) error("Line too long"); return read(line); } void repl() { value input, result; printf("Structure and Interpretation of Computer Programs\n"); printf("Exercise 5.52 - (Compiled) Scheme in C\n"); while (true) { printf("> "); input = read_line(); result = eval(input); print(result); printf("\n"); } } /* * The main function */ int main(int argc, char *argv[]) { initialize_memory(); initialize_symbols(); initialize_registers(); initialize_global_environment(); if (argc > 1) { for (int i = 1; i < argc; i++) { run_file(argv[i]); } } else { repl(); } } /* * Primitive operations * * Those correspond to the primitive operations that the compiler expects. * They are, of course, implemented in C. */ bool primitive_procedure_p(value proc) { return primitive_p(proc); } value lookup_variable_value(value name, value env) { return lookup_variable(value_to_sym(name), env); } value list(value singleton) { return cons(singleton, null()); } value make_compiled_procedure(value entry, value env) { return pcons(entry, env); } value compiled_procedure_entry(value proc) { return pcar(proc); } value compiled_procedure_env(value proc) { return pcdr(proc); } void set_variable_value_bang(value name, value val, value env) { set_variable_value(value_to_sym(name), val, env); } void define_variable_bang(value name, value val, value env) { define_variable(value_to_sym(name), val, env); } bool true_p(value val) { return !boolean_p(val) || val.value != 0; } bool false_p(value val) { return !true_p(val); } /* * The eval function * * The function is similar to what we do in section 5.5, except that the * read-eval-print loop is written in C. The first time the function is called * it runs the compiled interpreter in order to populate the global * environment. Afterwards the interpreter code is skipped and the function * jumps directly to evaluating the passed expression. * * The expression is evaluated in a tricky way. The C code knows that the * compiled interpreter defines a procedure eval* that evalutes and expression * in the global environment. It finds that procedure in the environment and * calls it. That happens by assigning it to proc, assigning its argument * (wrapped in a list) to argl and jumping to its entry point. Upon completion * the result is in val. */ bool interpreter_loaded = false; value eval(value expr) { push(expr); env = global_env; if (interpreter_loaded) goto evaluate_expression; #include "../bin/compiled_interpreter" interpreter_loaded = true; evaluate_expression: cont = label(&&done); proc = lookup_variable(intern("eval*"), env); val = compiled_procedure_entry(proc); argl = list(expr); goto *value_to_label(val); done: pop(); return val; } ================================================ FILE: scheme/sicp/05/support/52/syntax.scm ================================================ ; The usual syntax functions. ; ; It's noteworthy that lambda body are scanning out defines. (define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) (else false))) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (variable? exp) (symbol? exp)) (define (assignment? exp) (tagged-list? exp 'set!)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp 'define)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (let? exp) (tagged-list? exp 'let)) (define (let->combination exp) (let ((names (map car (cadr exp))) (values (map cadr (cadr exp))) (body (cddr exp))) (cons (cons 'lambda (cons names body)) values))) (define (lambda? exp) (tagged-list? exp 'lambda)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (scan-out-defines (cddr exp))) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (begin? exp) (tagged-list? exp 'begin)) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last - COND->IF" clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest)))))) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) false)) (define (scan-out-defines body) (define (definitions-in body) (cond ((null? body) '()) ((definition? (car body)) (cons (car body) (definitions-in (cdr body)))) (else (definitions-in (cdr body))))) (define (body-without-definitions body) (cond ((null? body) '()) ((definition? (car body)) (body-without-definitions (cdr body))) (else (cons (car body) (body-without-definitions (cdr body)))))) (define (definition->unassigned-pair definition) (list (definition-variable definition) ''*unassigned*)) (define (definition->set! definition) (list 'set! (definition-variable definition) (definition-value definition))) (define (defines->let definitions body) (list (cons 'let (cons (map definition->unassigned-pair definitions) (append (map definition->set! definitions) body))))) (let ((internal-definitions (definitions-in body))) (if (null? internal-definitions) body (defines->let internal-definitions (body-without-definitions body))))) ================================================ FILE: scheme/sicp/05/support/52/tests.scm ================================================ (begin (define passed-tests 0) (define failed-tests 0) (define (test actual expected) (if (equal? actual expected) (set! passed-tests (+ 1 passed-tests)) (set! failed-tests (+ 1 failed-tests)))) (test 1 1) (test "something" "something") (test (quote foo) 'foo) (test (begin 1 2) 2) (test (define x1 1) 'ok) (test (begin (define x2 1) x2) 1) (test (define (x3) 1) 'ok) (test (begin (define (x3) 1) (x3)) 1) (test (begin (define x4 1) (set! x4 2)) 'ok) (test (begin (define x5 1) (set! x5 2) x5) 2) (test (if true 1 2) 1) (test (if false 1 2) 2) (test ((lambda () 1)) 1) (test ((lambda (x) x) 1) 1) (test ((lambda (a b) (cons a b)) 1 2) '(1 . 2)) (test (begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3)) '(3 . 2)) (test (cond (true 1)) 1) (test (cond (false 1) (true 2)) 2) (test (cond (false 1) (else 2)) 2) (test (begin (define (a) 1) (a)) 1) (test (begin (define (pair1 a b) (cons a b)) (pair1 1 2)) '(1 . 2)) (test (begin (define a 1) (define (pair2 b) (cons a b)) (pair2 2)) '(1 . 2)) (test (begin (define (append1 x y) (if (null? x) y (cons (car x) (append1 (cdr x) y)))) (append1 '(a b c) '(d e f))) '(a b c d e f)) (test (begin (define (factorial1 n) (if (= n 1) 1 (* n (factorial1 (- n 1))))) (factorial1 5)) 120) (test (begin (define (factorial2 n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial2 5)) 120) (test (< 1 (gc-runs)) true) (test (begin (define (countdown n) (if (= n 0) 'done (countdown (- n 1)))) (countdown (+ 1 (stack-max-depth)))) 'done) (display (list 'passed '= passed-tests 'failed '= failed-tests)))) ================================================ FILE: scheme/sicp/05/support/bin/.gitignore ================================================ 51 52 compiled_interpreter ================================================ FILE: scheme/sicp/05/tests/02-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../02.scm") (define sicp-5.02-tests (test-suite "Tests for SICP exercise 5.02" (test-case "(factorial 5)" (set-register-contents! factorial-machine 'n 5) (start factorial-machine) (check-eq? (get-register-contents factorial-machine 'p) 120)) )) (run-tests sicp-5.02-tests) ================================================ FILE: scheme/sicp/05/tests/03-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../03.scm") (define sicp-5.03-tests (test-suite "Tests for SICP exercise 5.03" (test-case "(simple-sqrt 2.0)" (set-register-contents! simple-sqrt-machine 'x 2.0) (start simple-sqrt-machine) (check-= (get-register-contents simple-sqrt-machine 'g) 1.41421 0.00001)) (test-case "(simple-sqrt 4.0)" (set-register-contents! simple-sqrt-machine 'x 4.0) (start simple-sqrt-machine) (check-= (get-register-contents simple-sqrt-machine 'g) 2.0 0.00001)) (test-case "(complex-sqrt 2.0)" (set-register-contents! complex-sqrt-machine 'x 2.0) (start complex-sqrt-machine) (check-= (get-register-contents complex-sqrt-machine 'g) 1.41421 0.00001)) (test-case "(complex-sqrt 4.0)" (set-register-contents! complex-sqrt-machine 'x 4.0) (start complex-sqrt-machine) (check-= (get-register-contents complex-sqrt-machine 'g) 2.0 0.00001)) )) (run-tests sicp-5.03-tests) ================================================ FILE: scheme/sicp/05/tests/04-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../04.scm") (define sicp-5.04-tests (test-suite "Tests for SICP exercise 5.04" (test-case "(recursive-expt 2 8)" (set-register-contents! recursive-expt-machine 'b 2) (set-register-contents! recursive-expt-machine 'n 8) (start recursive-expt-machine) (check-eq? (get-register-contents recursive-expt-machine 'val) 256)) (test-case "(iterative-expt 2 8)" (set-register-contents! iterative-expt-machine 'b 2) (set-register-contents! iterative-expt-machine 'n 8) (start iterative-expt-machine) (check-eq? (get-register-contents iterative-expt-machine 'val) 256)) )) (run-tests sicp-5.04-tests) ================================================ FILE: scheme/sicp/05/tests/06-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../06.scm") (define sicp-5.06-tests (test-suite "Tests for SICP exercise 5.06" (test-case "(fibonacci 8)" (set-register-contents! fibonacci-machine 'n 8) (start fibonacci-machine) (check-eq? (get-register-contents fibonacci-machine 'val) 21)) )) (run-tests sicp-5.06-tests) ================================================ FILE: scheme/sicp/05/tests/08-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../08.scm") (define sicp-5.08-tests (test-suite "Tests for SICP exercise 5.08" (check-exn (regexp "Duplicate label: here") (lambda () (make-machine '(a) '() '( (goto (label here)) here (assign a (const 3)) (goto (label there)) here (assign a (const 4)) (goto (label there)) there)))) )) (run-tests sicp-5.08-tests) ================================================ FILE: scheme/sicp/05/tests/09-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../09.scm") (define sicp-5.09-tests (test-suite "Tests for SICP exercise 5.09" (check-exn (regexp "Operations are not applicable to labels") (lambda () (make-machine '(a) (list (list '+ +)) '(foo (assign a (op +) (label foo) (label bar)) bar)))) )) (run-tests sicp-5.09-tests) ================================================ FILE: scheme/sicp/05/tests/10-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../10.scm") (define sicp-5.10-tests (test-suite "Tests for SICP exercise 5.10" (test-case "(fibonacci 8)" (set-register-contents! fibonacci-machine 'n 8) (start fibonacci-machine) (check-eq? (get-register-contents fibonacci-machine 'val) 21)) )) (run-tests sicp-5.10-tests) ================================================ FILE: scheme/sicp/05/tests/11-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../11.scm") (define sicp-5.11-tests (test-suite "Tests for SICP exercise 5.11" (test-case "a. Shorter Fibonacci machine" (use-version-a!) (let ((fibonacci-machine (make-shorter-fibonacci-machine))) (set-register-contents! fibonacci-machine 'n 8) (start fibonacci-machine) (check-eq? (get-register-contents fibonacci-machine 'val) 21))) (test-case "b. Erroring out on restoring wrong register" (use-version-b!) (check-exn (regexp "Mismatching registers: x \\(restore y\\)") (lambda () (start (make-machine '(x y) '() '((assign x (const 1)) (save x) (restore y))))))) (test-case "c. A stack per register" (use-version-c!) (let ((machine (make-machine '(x y) '() '((assign x (const 1)) (assign y (const 2)) (save x) (save y) (assign x (const 3)) (assign y (const 4)) (restore x) (restore y))))) (start machine) (check-eq? (get-register-contents machine 'x) 1) (check-eq? (get-register-contents machine 'y) 2))) )) (run-tests sicp-5.11-tests) ================================================ FILE: scheme/sicp/05/tests/12-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../12.scm") (load "helpers/sample-machines.scm") (define sicp-5.12-tests (test-suite "Tests for SICP exercise 5.12" (check-equal? (fibonacci-machine 'data-path-instructions) '((assign continue (label after-fib-n-1)) (assign continue (label after-fib-n-2)) (assign continue (label fib-done)) (assign n (op -) (reg n) (const 1)) (assign n (op -) (reg n) (const 2)) (assign n (reg val)) (assign val (op +) (reg val) (reg n)) (assign val (reg n)) (branch (label immediate-answer)) (goto (label fib-loop)) (goto (reg continue)) (restore continue) (restore n) (restore val) (save continue) (save n) (save val) (test (op <) (reg n) (const 2)))) (check-equal? (fibonacci-machine 'data-path-entry-point-registers) '(continue)) (check-equal? (fibonacci-machine 'data-path-stack-registers) '(continue n val)) (check-equal? (fibonacci-machine 'data-path-register-sources) '((continue (label after-fib-n-1) (label after-fib-n-2) (label fib-done)) (n ((op -) (reg n) (const 1)) ((op -) (reg n) (const 2)) (reg val)) (val ((op +) (reg val) (reg n)) (reg n)))) (check-equal? (factorial-machine 'data-path-register-sources) '((continue (label after-fact) (label fact-done)) (n ((op -) (reg n) (const 1))) (val ((op *) (reg n) (reg val)) (const 1)))) )) (run-tests sicp-5.12-tests) ================================================ FILE: scheme/sicp/05/tests/13-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../13.scm") (define fibonacci-machine (make-machine (list (list '< <) (list '- -) (list '+ +)) '( (assign continue (label fib-done)) fib-loop (test (op <) (reg n) (const 2)) (branch (label immediate-answer)) (save continue) (assign continue (label after-fib-n-1)) (save n) (assign n (op -) (reg n) (const 1)) (goto (label fib-loop)) after-fib-n-1 (restore n) (restore continue) (assign n (op -) (reg n) (const 2)) (save continue) (assign continue (label after-fib-n-2)) (save val) (goto (label fib-loop)) after-fib-n-2 (assign n (reg val)) (restore val) (restore continue) (assign val (op +) (reg val) (reg n)) (goto (reg continue)) immediate-answer (assign val (reg n)) (goto (reg continue)) fib-done))) (define sicp-5.13-tests (test-suite "Tests for SICP exercise 5.13" (test-case "(fibonacci 8)" (set-register-contents! fibonacci-machine 'n 8) (start fibonacci-machine) (check-eq? (get-register-contents fibonacci-machine 'val) 21)) )) (run-tests sicp-5.13-tests) ================================================ FILE: scheme/sicp/05/tests/15-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../15.scm") (define sicp-5.15-tests (test-suite "Tests for SICP exercise 5.15" (test-begin "Counting instructions" (let ((machine (make-machine '(a) '() '(begin (goto (label middle)) (assign a (const 1)) middle (assign a (const 2)) (assign a (const 3)) end)))) (start machine) (check-eq? (machine 'instruction-count) 3) (check-eq? (machine 'instruction-count) 0))) )) (run-tests sicp-5.15-tests) ================================================ FILE: scheme/sicp/05/tests/16-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../16.scm") (define instructions '()) (define (get-instructions) (reverse instructions)) (define (collect-instructions inst) (set! instructions (cons inst instructions))) (define (reset-tracing!) (set! instructions '())) (define machine (make-machine '(a) '() '(begin (goto (label middle)) (assign a (const 1)) middle (assign a (const 2)) (assign a (const 3)) end))) (define sicp-5.16-tests (test-suite "Tests for SICP exercise 5.16" (test-begin "Tracing instructions" (reset-tracing!) (machine 'trace-on) ((machine 'install-trace-proc) collect-instructions) (start machine) (check-equal? (get-instructions) '((goto (label middle)) (assign a (const 2)) (assign a (const 3))))) (test-begin "Tracing turned off" (reset-tracing!) (machine 'trace-off) ((machine 'install-trace-proc) collect-instructions) (start machine) (check-equal? (get-instructions) '())) )) (run-tests sicp-5.16-tests) ================================================ FILE: scheme/sicp/05/tests/17-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../17.scm") (define instructions '()) (define (get-instructions) (reverse instructions)) (define (collect-instructions inst) (set! instructions (cons inst instructions))) (define (reset-tracing!) (set! instructions '())) (define machine (make-machine '(a) '() '(begin (goto (label middle)) (assign a (const 1)) middle (assign a (const 2)) (assign a (const 3)) end))) (define sicp-5.17-tests (test-suite "Tests for SICP exercise 5.17" (test-begin "Tracing labels" (reset-tracing!) (machine 'trace-on) ((machine 'install-trace-proc) collect-instructions) (start machine) (check-eq? (machine 'instruction-count) 3) (check-equal? (get-instructions) '(begin (goto (label middle)) middle (assign a (const 2)) (assign a (const 3))))) )) (run-tests sicp-5.17-tests) ================================================ FILE: scheme/sicp/05/tests/18-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../18.scm") (define traces '()) (define (get-traces) (reverse traces)) (define (collect-traces name old new) (set! traces (cons `(,name old = ,old new = ,new) traces))) (define (reset-tracing!) (set! traces '())) (define machine (make-machine '(a) '() '((assign a (const 1)) (assign a (const 2))))) (define sicp-5.18-tests (test-suite "Tests for SICP exercise 5.18" (test-case "Tracing a register" (reset-tracing!) ((machine 'install-register-trace-proc) collect-traces) ((machine 'register-trace-on) 'a) (start machine) (check-equal? (get-traces) '((a old = *unassigned* new = 1) (a old = 1 new = 2)))) (test-case "Tracing turned off" (reset-tracing!) ((machine 'install-register-trace-proc) collect-traces) ((machine 'register-trace-off) 'a) (start machine) (check-equal? (get-traces) '())) )) (run-tests sicp-5.18-tests) ================================================ FILE: scheme/sicp/05/tests/19-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/simulator.scm") (load "../19.scm") (define (test-machine) (make-machine '(a) '() '(start (assign a (const 1)) (assign a (const 2)) (assign a (const 3)) (assign a (const 4)) (assign a (const 5)) before-six (assign a (const 6)) (assign a (const 7)) (assign a (const 8)) (assign a (const 9)) (assign a (const 10))))) (define sicp-5.19-tests (test-suite "Tests for SICP exercise 5.19" (test-case "Checking breakpoints" (define machine (test-machine)) (set-breakpoint machine 'start 3) (set-breakpoint machine 'start 5) (set-breakpoint machine 'before-six 3) (start machine) (check-eq? (get-register-contents machine 'a) 2) (proceed-machine machine) (check-eq? (get-register-contents machine 'a) 4) (proceed-machine machine) (check-eq? (get-register-contents machine 'a) 7)) (test-case "Canceling breakpoints" (define machine (test-machine)) (set-breakpoint machine 'start 3) (set-breakpoint machine 'start 5) (set-breakpoint machine 'before-six 3) (cancel-breakpoint machine 'start 3) (start machine) (check-eq? (get-register-contents machine 'a) 4) (cancel-all-breakpoints machine) (proceed-machine machine) (check-eq? (get-register-contents machine 'a) 10)) )) (run-tests sicp-5.19-tests) ================================================ FILE: scheme/sicp/05/tests/21-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/memory.scm") (load "../21.scm") (define sicp-5.21-tests (test-suite "Tests for SICP exercise 5.21" (test-case "recursive count-leaves" (set-register-contents! count-leaves-machine 'tree (allocate-list count-leaves-machine '((1 (2 3) (4 5)) ((6) 7)))) (start count-leaves-machine) (check-equal? (get-register-contents count-leaves-machine 'result) '(n 7))) (test-case "count-leaves with explicit counter" (set-register-contents! count-leaves-explicit-counter-machine 'tree (allocate-list count-leaves-explicit-counter-machine '((1 (2 3) (4 5)) ((6) 7)))) (start count-leaves-explicit-counter-machine) (check-equal? (get-register-contents count-leaves-explicit-counter-machine 'result) '(n 7))) )) (run-tests sicp-5.21-tests) ================================================ FILE: scheme/sicp/05/tests/22-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/memory.scm") (load "../22.scm") (define sicp-5.22-tests (test-suite "Tests for SICP exercise 5.22" (test-suite "append" (set-register-contents! append-machine 'x (allocate-list append-machine '(1 2 3))) (set-register-contents! append-machine 'y (allocate-list append-machine '(4 5 6))) (check-equal? (memory-dump append-machine) '((n1 n2 n3 n4 n5 n6 __ __ __ __ __ __ __ __ __ __ __ __ __ __) (p1 p2 e0 p4 p5 e0 __ __ __ __ __ __ __ __ __ __ __ __ __ __))) (check-equal? (list-in-memory append-machine (get-register-contents append-machine 'x)) '(1 2 3)) (check-equal? (list-in-memory append-machine (get-register-contents append-machine 'y)) '(4 5 6)) (start append-machine) (check-equal? (list-in-memory append-machine (get-register-contents append-machine 'result)) '(1 2 3 4 5 6)) (check-equal? (memory-dump append-machine) '((n1 n2 n3 n4 n5 n6 n1 n2 n3 __ __ __ __ __ __ __ __ __ __ __) (p1 p2 e0 p4 p5 e0 p7 p8 p3 __ __ __ __ __ __ __ __ __ __ __)))) (test-suite "append!" (set-register-contents! append!-machine 'x (allocate-list append!-machine '(1 2 3))) (set-register-contents! append!-machine 'y (allocate-list append!-machine '(4 5 6))) (check-equal? (memory-dump append!-machine) '((n1 n2 n3 n4 n5 n6 __ __ __ __ __ __ __ __ __ __ __ __ __ __) (p1 p2 e0 p4 p5 e0 __ __ __ __ __ __ __ __ __ __ __ __ __ __))) (start append!-machine) (check-equal? (memory-dump append!-machine) '((n1 n2 n3 n4 n5 n6 __ __ __ __ __ __ __ __ __ __ __ __ __ __) (p1 p2 p3 p4 p5 e0 __ __ __ __ __ __ __ __ __ __ __ __ __ __)))) )) (run-tests sicp-5.22-tests) ================================================ FILE: scheme/sicp/05/tests/23-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/evaluator.scm") (load "../23.scm") (define (run exp) (run-controller ec-cond-and-let extra-operations exp)) (define sicp-5.23-tests (test-suite "Tests for SICP exercise 5.23" (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Let" (check-equal? (run '(let ((x 1)) x)) 1) (check-equal? (run '(let ((a 1) (b 2)) (+ a b))) 3) (check-equal? (run '(let ((a 1) (b 2)) a b)) 2) (check-equal? (run '(begin (define a 1) (let ((b 2) (c 3)) (+ a b c)))) 6)) )) (run-tests sicp-5.23-tests) ================================================ FILE: scheme/sicp/05/tests/24-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/evaluator.scm") (load "../24.scm") (define (run exp) (run-controller ec-cond extra-operations exp)) (define sicp-5.24-tests (test-suite "Tests for SICP exercise 5.24" (test-suite "Cond" (check-equal? (run '(cond (false 1))) #f) (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-equal? (run '(begin (define a 1) (cond (true a)))) 1) (check-equal? (run '(begin (define a 1) (define b 2) (cond (false a) (true b)))) 2) (check-equal? (run '(begin (define a 1) (define b 2) (cond (false a) (else b)))) 2)) )) (run-tests sicp-5.24-tests) ================================================ FILE: scheme/sicp/05/tests/25-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/evaluator.scm") (load "../25.scm") (define (run exp) (run-controller ec-core extra-operations exp)) (define sicp-5.25-tests (test-suite "Tests for SICP exercise 5.25" (check-equal? (run '(begin (define count 0) (define (two) (set! count (+ 1 count)) 2) (define (square n) (* n n)) (square (two)) count)) 2) (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false) (check-equal? (run '(begin (define (x arg) arg) (if (x true) 1 2))) 1) (check-equal? (run '(begin (define (x arg) arg) (if (x false) 1 2))) 2) ) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (+ 0 (factorial 5)))) 120)) )) (run-tests sicp-5.25-tests) ================================================ FILE: scheme/sicp/05/tests/30-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/evaluator.scm") (load "../30.scm") (define (run exp) (run-controller ec-error-support extra-operations exp)) (define sicp-5.30-tests (test-suite "Tests for SICP exercise 5.30" (check-equal? (run 'x) 'unbound-variable) (check-equal? (run '(+ 1 x)) 'unbound-variable) (check-equal? (run '(car '(a))) 'a) (check-equal? (run '(car '())) 'car-on-null) (check-equal? (run '(car 1)) 'car-on-non-pair) (check-equal? (run '(+ 1 (car '()))) 'car-on-null) (check-equal? (run '(+ 1 (car 1))) 'car-on-non-pair) (check-equal? (run '(/ 10 5)) 2) (check-equal? (run '(/ 10 0)) 'zero-division-error) (check-equal? (run '(+ 1 (/ 10 0))) 'zero-division-error) (check-equal? (run '(+ 2 3)) 5) )) (run-tests sicp-5.30-tests) ================================================ FILE: scheme/sicp/05/tests/32-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/evaluator.scm") (load "../32.scm") (define (run exp) (run-controller ec-core-optimized extra-operations exp)) (define sicp-5.32-tests (test-suite "Tests for SICP exercise 5.32" (check-equal? (run '(begin (define (twice x) (+ x x)) (twice 2))) 4) (check-equal? (run '(begin (define (twice x) (+ x x)) (define (op) twice) ((op) 2))) 4) (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests sicp-5.32-tests) ================================================ FILE: scheme/sicp/05/tests/36-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../36.scm") (define (run exp) (run-compiler-with-text explicit+compile-text extra-operations exp)) (define sicp-5.36-tests (test-suite "Tests for SICP exercise 5.36" (check-equal? (run '(begin (define order 'unknown) (define (f a b) 'done) (f (set! order 'right-to-left) (set! order 'left-to-right)) order)) 'left-to-right) (check-equal? (run '(+ 1)) 1) (check-equal? (run '(- 2 1)) 1) )) (run-tests sicp-5.36-tests) ================================================ FILE: scheme/sicp/05/tests/38-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../38.scm") (define (run exp) (let ((machine (make-machine (append '(arg1 arg2) ec-registers) (append `((+ ,+) (- ,-) (* ,*) (= ,=)) cm-operations) explicit+compile-text))) (compile-in-machine machine exp) (get-register-contents machine 'val))) (define sicp-5.38-tests (test-suite "Tests for SICP exercise 5.38" (check-equal? (run '(+ 1 2)) 3) (check-equal? (run '(+ 1 2 3)) 6) (check-equal? (run '(+ (+ 1 2 3) (+ 4 5 6) (+ 7 8 9))) 45) (check-equal? (run '(begin (define a 1) (define b 2) (+ a b))) 3) (check-equal? (run '(begin (define (a) 1) (+ (a) (a)))) 2) (check-equal? (run '(begin (define (twice n) (+ n n)) (define n 4) (+ (twice 1) n (twice 1)))) 8) (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* product counter) (+ counter 1)))) (iter 1 1)) (factorial 5))) 120) )) (run-tests sicp-5.38-tests) ================================================ FILE: scheme/sicp/05/tests/39-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../39.scm") (define (env mappings) (if (null? mappings) the-empty-environment (extend-environment (caar mappings) (cadar mappings) (env (cdr mappings))))) (define sicp-5.39-tests (test-suite "Tests for SICP exercise 5.39" (check-equal? (lexical-address-lookup '(0 0) (env '(((a b) (1 2))))) 1) (check-equal? (lexical-address-lookup '(0 1) (env '(((a b) (1 2))))) 2) (check-equal? (lexical-address-lookup '(1 0) (env '(((a b) (1 2)) ((c d) (3 4))))) 3) (check-equal? (lexical-address-lookup '(1 1) (env '(((a b) (1 2)) ((c d) (3 4))))) 4) (check-equal? (lexical-address-lookup '(2 0) (env '(((a b) (1 2)) ((c d) (3 4)) ((e f) (5 6))))) 5) (check-equal? (lexical-address-lookup '(2 1) (env '(((a b) (1 2)) ((c d) (3 4)) ((e f) (5 6))))) 6) (check-exn exn? (lambda () (lexical-address-lookup '(0 0) (env '(((a) (*unassigned*))))))) (test-case "setting a lexical variable in the top frame" (let ((environment (env '(((a b) (1 2)))))) (lexical-address-set! '(0 1) 3 environment) (check-equal? (lexical-address-lookup '(0 1) environment) 3))) (test-case "setting a lexical variable in the top frame" (let ((environment (env '(((a b) (1 2)) ((c d) (3 4)))))) (lexical-address-set! '(1 1) 5 environment) (check-equal? (lexical-address-lookup '(1 1) environment) 5))) ;(test-case "setting a lexical variable in a frame, other than the top") )) (run-tests sicp-5.39-tests) ================================================ FILE: scheme/sicp/05/tests/40-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../40.scm") (define (run exp) (let ((machine (make-explicit+compile-machine))) (compile-in-machine machine exp) (get-register-contents machine 'val))) (define sicp-5.40-tests (test-suite "Tests for SICP exercise 5.40" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) )) (run-tests sicp-5.40-tests) ================================================ FILE: scheme/sicp/05/tests/41-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../41.scm") (define sicp-5.41-tests (test-suite "Tests for SICP exercise 5.41" (check-equal? (find-variable 'z '((y z) (a b c d e) (x y))) '(0 1)) (check-equal? (find-variable 'c '((y z) (a b c d e) (x y))) '(1 2)) (check-equal? (find-variable 'x '((y z) (a b c d e) (x y))) '(2 0)) (check-equal? (find-variable 'w '((y z) (a b c d e) (x y))) 'not-found) (check-equal? (find-variable 'x '()) 'not-found) )) (run-tests sicp-5.41-tests) ================================================ FILE: scheme/sicp/05/tests/42-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../42.scm") (define (run exp) (let ((machine (make-explicit+compile-machine))) (compile-in-machine machine exp) (get-register-contents machine 'val))) (define sicp-5.42-tests (test-suite "Tests for SICP exercise 5.42" (check-equal? (run '(begin (define a 42) ((lambda () a)))) 42) (check-equal? (run '((lambda (a b) b) 1 2)) 2) (let ((not-so-simple-expression '(((lambda (x y) (lambda (a b c d e) ((lambda (y z) (* x y z)) (* a b x) (+ c d x)))) 3 4) 5 6 7 8 9))) (check-equal? (run not-so-simple-expression) (eval not-so-simple-expression))) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2) (check-equal? (run '(begin (define (foo x) (set! x 2) x) (foo 1))) 2) (check-equal? (run '(begin ((lambda (a) ((lambda (b) (set! a b)) 2) a) 1))) 2) )) (run-tests sicp-5.42-tests) ================================================ FILE: scheme/sicp/05/tests/43-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../43.scm") (define (run exp) (let ((machine (make-explicit+compile-machine))) (compile-in-machine machine exp) (get-register-contents machine 'val))) (define sicp-5.43-tests (test-suite "Tests for SICP exercise 5.43" (check-equal? (run '(begin (define (foo) (define x 1) (set! x 2) x) (foo))) 2) )) (run-tests sicp-5.43-tests) ================================================ FILE: scheme/sicp/05/tests/44-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../44.scm") (define (run exp) (let ((machine (make-explicit+compile-machine))) (compile-in-machine machine exp) (get-register-contents machine 'val))) (define sicp-5.44-tests (test-suite "Tests for SICP exercise 5.44" (check-equal? (run '(begin (define (vect+ v1 v2) (cons (+ (car v1) (car v2)) (+ (cdr v1) (cdr v2)))) (define (vect* n v) (cons (* n (car v)) (* n (cdr v)))) (define (linear + * a b x y) (+ (* a x) (* b y))) (linear vect+ vect* 2 3 '(5 . 7) '(11 . 13)))) '(43 . 53)) )) (run-tests sicp-5.44-tests) ================================================ FILE: scheme/sicp/05/tests/47-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "helpers/compiler.scm") (load "../47.scm") (define (run machine exp) (eval-in-machine machine exp) (get-register-contents machine 'val)) (define sicp-5.47-tests (test-suite "Tests for SICP exercise 5.47" (test-case "target = val, linkage != return" (define machine (make-explicit+compile-machine)) (compile-in-machine machine '(define (f n) (+ 1 (g n)))) (eval-in-machine machine '(define (g n) (* n n))) (check-equal? (run machine '(f 3)) 10)) (test-case "target != val, linkage != return" (define machine (make-explicit+compile-machine)) (compile-in-machine machine '(define (twice n) (+ n n))) (eval-in-machine machine '(define (get-twice) twice)) (compile-in-machine machine '(define (ten) ((get-twice) 5))) (check-equal? (run machine '(ten)) 10)) (test-case "target = val, linkage = return" (define machine (make-explicit+compile-machine)) (compile-in-machine machine '(define (twice-1+ n) (twice (+ n 1)))) (eval-in-machine machine '(define (twice n) (+ n n))) (check-equal? (run machine '(twice-1+ 4)) 10)) )) (run-tests sicp-5.47-tests) ================================================ FILE: scheme/sicp/05/tests/50-tests.scm ================================================ (require rackunit rackunit/text-ui) (require r5rs/init) (load "helpers/compiler.scm") (load "../50.scm") (define (run exp) (compile-in-machine machine `(evaluate ',exp the-global-environment)) (get-register-contents machine 'val)) (define sicp-5.50-tests (test-suite "Tests for SICP exercise 5.50" (test-suite "Self-evaluating expressions" (check-equal? (run '1) 1) (check-equal? (run '"something") "something")) (test-suite "Quotation" (check-equal? (run '(quote foo)) 'foo)) (test-suite "Begin" (check-equal? (run '(begin 1 2)) 2)) (test-suite "Define" (check-equal? (run '(define x 1)) 'ok) (check-equal? (run '(begin (define x 1) x)) 1) (check-equal? (run '(define (x) 1)) 'ok) (check-equal? (run '(begin (define (x) 1) (x))) 1)) (test-suite "Set!" (check-equal? (run '(begin (define x 1) (set! x 2))) 'ok) (check-equal? (run '(begin (define x 1) (set! x 2) x)) 2)) (test-suite "If" (check-equal? (run '(if true 1 2)) 1) (check-equal? (run '(if false 1 2)) 2) (check-equal? (run '(if true 1)) 1) (check-equal? (run '(if false 1)) false)) (test-suite "Lambda" (check-equal? (run '((lambda () 1))) 1) (check-equal? (run '((lambda (x) x) 1)) 1) (check-equal? (run '((lambda (a b) (cons a b)) 1 2)) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define b 2) ((lambda (a) (cons a b)) 3))) '(3 . 2))) (test-suite "Cond" (check-equal? (run '(cond (true 1))) 1) (check-equal? (run '(cond (false 1) (true 2))) 2) (check-equal? (run '(cond (false 1) (else 2))) 2) (check-exn exn? (lambda () (run '(cond (else 1) (true 2)))))) (test-suite "Procedure application" (check-equal? (run '(begin (define (a) 1) (a))) 1) (check-equal? (run '(begin (define (pair a b) (cons a b)) (pair 1 2))) '(1 . 2)) (check-equal? (run '(begin (define a 1) (define (pair b) (cons a b)) (pair 2))) '(1 . 2))) (test-suite "Defining append" (check-equal? (run '(begin (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (append '(a b c) '(d e f)))) '(a b c d e f))) (test-suite "Factorial" (check-equal? (run '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) 120) (check-equal? (run '(begin (define (factorial n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result n)))) (iter n 1)) (factorial 5))) 120)) ; Those are just some sanity checks. It is not necessary that it takes ; that many instructions and stack operations to run the tests, but makes ; sure that if I did not short-circuit something when this number changes. (check-equal? total-instructions 215524) (check-equal? ((machine 'stack) 'statistics) '(total-pushes = 8036 maximum-depth = 22)) ; The numbers get way cooler when we do a lame recursive version of ; Fibonacci 10. (test-case "The tenth Fibonacci number" (set! total-instructions 0) ((machine 'stack) 'initialize) (check-equal? (run '(begin (define (fib n) (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2))))) (fib 10))) 89) (check-equal? total-instructions 1561470) (check-equal? ((machine 'stack) 'statistics) '(total-pushes = 190611 maximum-depth = 76))) )) (run-tests sicp-5.50-tests) ================================================ FILE: scheme/sicp/05/tests/51-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../51.scm") (define sicp-5.51-tests (test-suite "Tests for SICP exercise 5.51" (compile-interpreter) (check-equal? (interpreter-test-results) "(passed = 24 failed = 0)") )) (run-tests sicp-5.51-tests) ================================================ FILE: scheme/sicp/05/tests/52-tests.scm ================================================ (require rackunit rackunit/text-ui) (load "../52.scm") (define sicp-5.52-tests (test-suite "Tests for SICP exercise 5.52" (write-interpreter interpreter-in-c) (compile-runtime) (check-equal? (interpreter-test-results) "(passed = 27 failed = 0)") )) (run-tests sicp-5.52-tests) ================================================ FILE: scheme/sicp/05/tests/helpers/compiler.scm ================================================ (load-relative "../../showcase/compiler/helpers.scm") (define (run-compiler-with-text controller-text extra-operations exp) (let ((machine (make-machine ec-registers (append cm-operations extra-operations) controller-text))) (compile-in-machine machine exp) (get-register-contents machine 'val))) ================================================ FILE: scheme/sicp/05/tests/helpers/evaluator.scm ================================================ (load-relative "../../showcase/explicit/evaluator.scm") (define (make-explicit-machine controller-text additional-operations) (make-machine ec-registers (append ec-operations additional-operations) controller-text)) (define (run-controller controller-text additional-operations exp) (let ((machine (make-explicit-machine controller-text additional-operations))) (set-register-contents! machine 'exp exp) (set-register-contents! machine 'env (setup-environment)) (start machine) (get-register-contents machine 'val))) ================================================ FILE: scheme/sicp/05/tests/helpers/memory.scm ================================================ (load-relative "simulator.scm") (define (add-pointers p1 p2) (let ((type1 (car p1)) (type2 (car p2)) (value1 (cadr p1)) (value2 (cadr p2))) (if (eq? type1 type2) (list type1 (+ value1 value2)) (error "Attempting to add incompatible pointers" p1 p2)))) (define (vector-ref-pointer vector pointer) (if (eq? (car pointer) 'p) (vector-ref vector (cadr pointer)) (error "Cannot index vector with this pointer" pointer))) (define (vector-set!-pointer vector pointer value) (if (eq? (car pointer) 'p) (vector-set! vector (cadr pointer) value) (error "Cannot modify vector with this pointer" pointer))) (define (null?-pointers pointer) (equal? pointer '(e 0))) (define (pair?-pointers pointer) (eq? (car pointer) 'p)) (define (allocate-list machine lst) (define the-cars (get-register-contents machine 'the-cars)) (define the-cdrs (get-register-contents machine 'the-cdrs)) (define saved-pairs '()) (define (save-pair pair offset) (set! saved-pairs (cons (cons pair (list 'p offset)) saved-pairs))) (define (saved-pair-offset pair) (define (lookup pairs) (cond ((null? pairs) #f) ((eq? pair (caar pairs)) (cdar pairs)) (else (lookup (cdr pairs))))) (lookup saved-pairs)) (define (saved? pair) (not (eq? (saved-pair-offset pair) #f))) (define (allocate item) (cond ((number? item) (list 'n item)) ((null? item) (list 'e 0)) ((saved? item) (saved-pair-offset item)) ((pair? item) (let ((offset (cadr (get-register-contents machine 'free)))) (set-register-contents! machine 'free (list 'p (+ offset 1))) (save-pair item offset) (vector-set! the-cars offset (allocate (car item))) (vector-set! the-cdrs offset (allocate (cdr item))) (list 'p offset))) (else (error "Don't know how to allocate this -- ALLOCATE-LIST" item)))) (allocate lst)) (define (list-in-memory machine pointer) (define the-cars (get-register-contents machine 'the-cars)) (define the-cdrs (get-register-contents machine 'the-cdrs)) (define (build pointer) (cond ((eq? (car pointer) 'n) (cadr pointer)) ((equal? pointer '(e 0)) '()) ((eq? (car pointer) 'p) (cons (build (vector-ref the-cars (cadr pointer))) (build (vector-ref the-cdrs (cadr pointer))))) (else (error "Don't know how to build -- LIST-IN-MEMORY" pointer)))) (build pointer)) (define (memory-dump machine) (define (shorten pointer) (if (pair? pointer) (string->symbol (string-append (symbol->string (car pointer)) (number->string (cadr pointer)))) '__)) (list (map shorten (vector->list (get-register-contents machine 'the-cars))) (map shorten (vector->list (get-register-contents machine 'the-cdrs))))) (define (make-machine-with-memory registers controller-text) (let ((machine (make-machine (append registers '(free the-cars the-cdrs)) (list (list 'vector-ref vector-ref-pointer) (list 'vector-set! vector-set!-pointer) (list '+ add-pointers) (list 'null? null?-pointers) (list 'pair? pair?-pointers)) controller-text))) (set-register-contents! machine 'the-cars (make-vector 20)) (set-register-contents! machine 'the-cdrs (make-vector 20)) (set-register-contents! machine 'free '(p 0)) machine)) ================================================ FILE: scheme/sicp/05/tests/helpers/monitored-stack.scm ================================================ (define (make-stack) (let ((s '()) (number-pushes 0) (max-depth 0) (current-depth 0)) (define (push x) (set! s (cons x s)) (set! number-pushes (+ 1 number-pushes)) (set! current-depth (+ 1 current-depth)) (set! max-depth (max current-depth max-depth))) (define (pop) (if (null? s) (error "Empty stack -- POP") (let ((top (car s))) (set! s (cdr s)) (set! current-depth (- current-depth 1)) top))) (define (initialize) (set! s '()) (set! number-pushes 0) (set! max-depth 0) (set! current-depth 0) 'done) (define (statistics) (list 'total-pushes '= number-pushes 'maximum-depth '= max-depth)) (define (dispatch message) (cond ((eq? message 'push) push) ((eq? message 'pop) (pop)) ((eq? message 'initialize) (initialize)) ((eq? message 'statistics) (statistics)) (else (error "Unknown request -- STACK" message)))) dispatch)) (define (stack-stats-for machine exp) (set-register-contents! machine 'exp exp) ((machine 'stack) 'initialize) (start machine) ((machine 'stack) 'statistics)) ================================================ FILE: scheme/sicp/05/tests/helpers/sample-machines.scm ================================================ (load-relative "../../showcase/simulator/sample-machines.scm") ================================================ FILE: scheme/sicp/05/tests/helpers/simulator.scm ================================================ (load-relative "../../showcase/simulator/simulator.scm") ================================================ FILE: scheme/sicp/README.markdown ================================================ # Structure and Interpretation of Computer Programs I'm doing a SICP study group with a couple of friends. This is where I will kepp the solutions to the exercises. ## Scheme implementation Despite this being SICP, I've chosen to use [Racket](http://racket-lang.org/). The people there have their own opinion on how to do an introductionary course in Scheme, called [How to Design Programs](http://www.htdp.org/). This is beside the point, though - the idea here is to read through SICP, not to learn Scheme or programming. At the time, Racket does not have a decent sicp language pack. Instead of trying to figure out a way to restrict the language, I will try to stick at the R5S5 subset, using Racket. If that fails for some reason, I might reconsider. ## Tests I like to keep a bunch of tests for each exercise. I'm just that kind of person. Although I will do the solutions in SICP-level Scheme, I will not hesitate to use full-blown Racket in the tests. This will give me a nice opportunity to do some cargo-culting, which might be useful if I want to learn Racket in the future. ## Tools I'm not just interested in solving the exercise. I'm interested in building an environment that is up for the task, tailored to me. If Racket was a bit more modern, I would have tried to go with its own tools. Since this is not the case (IMHO), I will just use Ruby. ### Generating scaffolds It is fairly simple. If you want to generate a scaffold for exercise 1.01, just run: rake exercise[1,1] If you want to generate the scaffold for the next unsolved task, just do: rake next ### Running tests Tests can be run the following way: rake run:exercise[1,1] If you want to run all tests do: rake run:all You can also use watchr to do continuous testing. Just run: rake watch ## Showcases Some of the chapters require chunks of work that don't fit as exercises. Instead, I need a larger program that can show something meaningful. Occasionally, I will create a "showcase" for those. You can see a list of showcases by running `rake -T`. The showcases have a specific directory structure, that's pretty easy to grok. Note, that if you want to run a showcase with a different version of Racket, you need to specify the `RACKET` environment variable to point to an executable. For example: RACKET=/path/to/racket rake run:showcase:example ### The Picture Language (section 2.2.4) This is the Escher-like picture library, introduced when talking about data abstraction and robust design. Note, that this might not run with the Racket that you install from Homebrew. It has a bunch of problems with depending on `libcairo` that I don't care to debug. Downloading a pre-compiled distribution from the Racket site is enough. RACKET=~/Code/runtime/racket/bin/racket rake run:showcase:picturelang ### The metacircular evaluator (section 4.1) This is the basic metacircular evaluator explored in Chapter 4 for the book. It is very basic and featureless. It is fairly easy to run it, although you should be careful what you are typing in. Run it with: rake run:showcase:evaluator ================================================ FILE: scheme/sicp/Rakefile ================================================ require 'pathname' ROOT = Pathname(File.dirname(__FILE__)) def run_racket(file) executable = ENV['RACKET'] || 'racket' command = [executable, '-r', file.to_s] system(*command) or raise "Failed to execute #{command * ' '}" end class Exercise attr_reader :chapter, :number def initialize(chapter, number) @chapter = chapter.to_i @number = number.to_i end def valid? chapter.nonzero? and number.nonzero? end def test_file ROOT.join '%02d/tests/%02d-tests.scm' % [chapter, number] end def file ROOT.join '%02d/%02d.scm' % [chapter, number] end def name "%1d.%02d" % [chapter, number] end def having_a_test? test_file.exist? end def run run_racket file end def run_test Dir.chdir File.dirname(test_file) do run_racket test_file end end def generate_scaffold FileUtils.mkdir_p File.dirname(test_file) open(file, 'w') { |f| f.write(<<-END) } ; SICP exercise #{name} END open(test_file, 'w') { |f| f.write(<<-END) } (require rackunit rackunit/text-ui) (load "../#{sprintf('%02d', number)}.scm") (define sicp-#{name}-tests (test-suite "Tests for SICP exercise #{name}" )) (run-tests sicp-#{name}-tests) END end class << self def each_with_a_test Dir.chdir ROOT do Dir.glob('0*').sort.each do |chapter| Dir.glob("#{chapter}/tests/*.scm").sort.each do |test_file| test_file =~ %r{(\d)/tests/(\d+)-tests.scm} yield Exercise.new $1, $2 end end end end def next Dir.chdir ROOT do chapter = Dir.glob('0*').max number = '%02d' % Dir.glob("#{chapter}/*.scm").grep(/(\d+)\.scm/) { $1.to_i }.max.succ Exercise.new chapter, number end end end end class Showcase attr_reader :name, :chapter def initialize(name, chapter) @name = name.to_sym @chapter = chapter.to_i end def directory ROOT.join "%02d/showcase/%s" % [chapter, name] end def run Dir.chdir directory do run_racket 'main.scm' end end class << self def all Dir.chdir ROOT do Dir['0*/showcase/*/main.scm'].map do |path| path =~ %r[(\d+)/showcase/(.+)/] new $2, $1 end.compact end end end end desc 'Scaffolds an exercise solution and its unit test' task :exercise, :chapter, :exercise do |task, args| exercise = Exercise.new args[:chapter], args[:exercise] raise ArgumentError, <<-END unless exercise.valid? You need to supply chapter and exercise numbers. If you want to generate exercise 2.23: rake exericse[2,23] END exercise.generate_scaffold end desc 'Generates the next exercise' task :next do exercise = Exercise.next puts "Generating files for exercise #{exercise.name}" exercise.generate_scaffold end namespace :run do desc "Runs a specific exercise" task :exercise, :chapter, :exercise do |task, args| exercise = Exercise.new args[:chapter], args[:exercise] exercise.run end desc 'Runs the test of a specific exercise' task :test, :chapter, :exercise do |task, args| exercise = Exercise.new args[:chapter], args[:exercise] raise ArgumentError, <<-END unless exercise.valid? You need to supply chapter and exercise numbers. If you want to run exercise 2.23: rake run:exericse[2,23] END raise "Test for #{exercise.name} does not exist" unless exercise.having_a_test? exercise.run_test end desc 'Runs the tests of all exercises' task :all do Exercise.each_with_a_test do |exercise| print "#{exercise.name}: " exercise.run_test end end namespace :showcase do Showcase.all.each do |showcase| desc "Run the #{showcase.name} showcase" task showcase.name do showcase.run end end end end desc 'Runs watchr on the tests' task :watch do exec 'watchr tests.watchr' end ================================================ FILE: scheme/sicp/notes/week-01.markdown ================================================ # Week 1 (2012-02-27 - 2012-03-06) Notes on my first week with SICP. We have just started the study group. ## Questions * Is [Nikolay's `good-enough?`][nb-01-07] different? * What is the time complexity of 1.14? * What is the time complexity of normal-order in 1.20? [nb-01-07]: https://github.com/nb/sicp/blob/a468e7e08c03cde42b317d94b5cf0e4db7613212/1.7.scm ## Various * I enjoy writing text on the side of the code. I don't do that in my day job, since I consider it an anti-pattern. It makes me more reflective. * I enjoy reaching a certain depth in my fiddling with Scheme. It makes the experience nicer. * I take a lot of time to ensure nice commit message and nice looking solutions. That way the code should be a pleasure to read. * Consider giving me the thumbs up, if you are following along and enjoying it ;) * Building tools is interesting, although it turned into yak shaving - I spent and hour and something on the Rakefile. * Fib(n) can be calculated in o(log(n)). I knew it, but I still find it freaky. ## How to Design Programs The Racket community has its own introductory-level book that teaches Scheme (called [How to Design Programs](http://htdp.org/). It takes a different approach from SICP and even criticizes it a bit. It looks promising - it is using DrRacket a lot and it even combines pictures and code in a cool way. The book is even more basic than SICP, which doesn't make it very interesting to me. Besides, the point of the study group is to finish SICP, not HtDP. I might take a look at it once we're finished. ## Concepts, Techniques and Models of Computer Programming There is another book that looks promising - [Concepts, Techniques and Models of Computer Programming][ctm]. It is dubbed by some people as "the book to read after SICP". It looks promising and there are some [nice comments about it on c2][ctm-on-c2]. I learned about it form a [thread on Hacker News][sicp-vs-htdp-hn] that is also worth taking a look at. [ctm]: http://mitpress.mit.edu/catalog/item/default.asp?ttype=2&tid=10142 [ctm-on-c2]: http://c2.com/cgi/wiki?ConceptsTechniquesAndModelsOfComputerProgramming [sicp-vs-htdp-hn]: http://news.ycombinator.com/item?id=428651 ## Why MIT switched from Scheme to Python? Sussman has an [interesting comment][why-python] on why MIT switched to Python. It is short and I cannot pick up a representative quote. To sum it up, programming has changed fundamentally and while in the past you could understand your program all the way down, now you have to do basic science on some of the libraries you are using. Definitelly worth reading it. [why-python]: http://www.wisdomandwonder.com/link/2110/why-mit-switched-from-scheme-to-python ## Invariant quantity There is an interesting idea in exercise 1.16. We're designing an iterative algoright to do fast exponentiation. For each iteration we are keeping three state variables (a, b and n) and we require that an invariant holds on each iteration (namely abⁿ is constant). The three of them change on each iteration, but the abⁿ remains unchanged. n is reduced on every iteration and when it finaly reaches 0, the result is in a. Invariant quantities appear to be an interesting way to design algorithms. ## Tail recursion and normal-order evaluation Normal-order evaluation can dramatically change the order of growth when combined with tail recursion. I thought it just changes the constant, but it can actually change the function. Exercise 1.20 shows a nice example. In applicative-order evaluation, gcd has log(n) order of growth, but in normal-order evaluation it becomes a lot slower. I'm not sure what the new order of growth is, but it is at least linear. I doubt it happens in practice, but it is still an interesting observation. ## Some school-level algebra I just love it when I discover something neat in algebra I learned in school. Namely, there is a neat way to geometrically explain (n + 1)². Assume we have a square with size n and we want to increase its size with n. Here's a nice ASCII graphic: +---+---+---+---+---+---+ . + Each "small square" has area of 1. The "thick" squares | | | | | | | x . make up the original square with size n, while the +---+---+---+---+---+---+ . + "thin" ones make up the extra areas we need to add | | | | | | | x . to increase the size with 1. Let's count the added +---+---+---+---+---+---+ . + squares. We add n squares on the right (marked with x) | | | | | | | x . and another n squares on the bottom (marked with x). +---+---+---+---+---+---+ . + We need to add an extra square, diagonally to complete | | | | | | | x . the shape, marked with o. Thus, we end up adding 2n + 1 +---+---+---+---+---+---+ . + squares. When we take all together, we get: | | | | | | | x . +---+---+---+---+---+---+ . + n² + 2n + 1 | | | | | | | x . +---+---+---+---+---+---+ . + which of course is: . x . x . x . x . x . x . o . + - + - + - + - + - + - + . + (n + 1)² It's easy enough to generalize this to (a + b)². The number of times we add a to each side is b, which makes it 2ab for the x squares. We need to add b² to complete the o squares. It ends up as: a² + 2ab + b² There is probably some Greek person that wrote this down a couple of thousand years ago, but somehow I managed to miss it. Anyway, it's still fun when I discover something simple about school math that I did not know. ## Meetup summary We established that we the target for next week is 1.3.2. One of my question was answered, but the other two remain a mystery to me. ### Notes * Is [Nikolay's `good-enough?`][nb-01-07] different? * Nikolay says that he is doing multiplication, while I'm doing divisions. He claims that multiplication is (1) faster and (2) more accurate. He does not quote sources. * Ackermann's function seems pretty useless to me, but apparently it has some interesting properties. It is mostly theoretical, though. [nb-01-07]: https://github.com/nb/sicp/blob/a468e7e08c03cde42b317d94b5cf0e4db7613212/1.7.scm ================================================ FILE: scheme/sicp/notes/week-02.markdown ================================================ # Week 2 (2012-03-06 - 2012-03-13) This is my second week in the book. I'm still very excited, but I am also gotten the farthest in the exercise from all the people in the study group. Thus, I will attempt to take it slower. It will not be that hard, since I have travelling involved. ## Questions * What is the time complexity of 1.14? * What is the time complexity of normal-order in 1.20? * Am I getting the Robin-Miller test from 1.28 wrong? I expected all numbers a < n to fail the simple test (the one without the non-trivial square root test). * In 1.29, my implementation of Simpson's rule appears to be less precise. Am I doing something wrong? ## Various ### Uncle Bob's method ordering convention I'm following Uncle Bob's approach to ordering procedures in Scheme. I am putting the most important function on top. It will refer undefined (yet) procedures. I find the first such procedure in the body and put it afterwards. If the second procedure has undefined names, I define them before continuing with the remaining undefined names from the first procedures. Essentially, this orders the procedures depth-first. The argument is that this way the code reads from top to bottom. I don't find it optimal, but I believe it works great in this case. ### Recursive process vs. recursive procedure This is from chapter 1.2.1, and while I've known it all along, it took me a while to appreciate the subtlety. Consider a tail-recursive and a non-tail-recursive implementations of factorial. Both of them are recursive procedures. But the first generates an iterative process, while the latter - a recursive one. It's curious that recursive definitions do not always imply recursive processes. As far as I can tell, this totally depends on the tail recursion call. Which got me thinking about tail recursion. While it's extremely nice, there is the risk of modifying a tail-recursive function in a way that preserves correctness, but makes it non-tail-recursive. This can happen accidentally and can be a regression, because the function will run out of stack space for larger inputs. That's why I find it extremely nice that Scala has a `@tailrec` annotation that enforces tail recursion. ## Meetup summary It was rather quick. I found out that some of my thoughts were utterly invalid and that some of my solutions were wrong. Here are some assorted thouhgts: * Plamen claims that it is proven that n.log(n) is the fastest a sorting algorithm can get. I'm not so certain about this, but hey - what do I know about sorting. * I should check out what Radix sort is. It is purported to be constrained, but faster. * My note from Week 1 on tail recursion + normal-order evaluation needs some clarification. I claimed that the time gets worse when both are present. It is actually not true, since normal-order evaluation is sufficient to degrade performance. Tail recursion is a factor, however, in the way you write programs. I would claim that if you had no tail recursion in your language, you would not go with a recursive procedure. Therefore, it is very unlikely that you stumble in that kind of degradation. Normal-order would still be slower, however. * I got 1.15 wrong. Time is Θ(logn). * I sill have questions from earlier. I will not carry them over to Chapter 2, but I will still keep them around in hope that somebody would provide a satisfactory answer. ================================================ FILE: scheme/sicp/notes/week-03.markdown ================================================ # Week 3 (2012-03-13 - 2012-03-20) This is the third week of our humble study group. Some of us are lagging behind, but nontheless, we decided that we will complete Chapter 1. ## Questions * What is the time complexity of 1.14? * What is the time complexity of normal-order in 1.20? * Am I getting the Robin-Miller test from 1.28 wrong? I expected all numbers a < n to fail the simple test (the one without the non-trivial square root test). * In 1.29, my implementation of Simpson's rule appears to be less precise. Am I doing something wrong? ## Ruby, lambdas and procedures as general methods Chapter 1.3.3 makes a very nice point about procedures. When a procedure is parametrized with functions (as opposed to values), it can create a more powerful abstraction. The `fixed-point` function is a nice example of that - it is a general abstraction for Newton's method of finding square roots (exercise 1.07). This is cool, but I would say that it is not used in Ruby. Ruby is pretty decent, when your method needs just one lambda - it can be passed as a block. When you need too lambdas, however, it becomes rather awkward. Ruby has the `lambda` keyword, but it has at least two problems - (1) multiline lambdas are tricky (you have to use `{`/`}` instead of `do`/`end`) and (2) it feels awkward to pass lambdas to functions an invoke them. In such cases, I would probably go with a Template Method instead. While Ruby has all the power and flexibility to do this, I feel that the Ruby culture frowns upon it. Thus, Ruby feels less powerful in that sense. Note that it just **feels** that way. ## First-class citizens and Ruby This is a continuation of the previous thought. Section 1.3.4 talks about procedures as first-class citizens and what the term means. It says, that when more elements are first-class, this provides for more powerful abstractions. It is curious how this question looks in Ruby. Are methods first-class in Ruby or not? On one hand, they are, since they (1) may be named as variables, (2) may be passed as arguments to procedures, (3) can be returned as the result of procedures and (4) may be included in data structures. Working with them, however, is slightly awkward, since they are obtained with `#method` and need special handling (invoking with `#call`). The awkwardness is very apparent when you compare with Python. I find the following interesting: the slight awkwardness in Ruby makes Ruby programmers avoid those constructs. Nobody really ever passes a method or returns a lambda to be called. I find two reasons for this. First, the code appears un-Rubyic, which is a cultural reason. Second, and more to the point, this is not orthogonal to blocks - most of those things can be accomplished by blocks, which makes such use of the constructs unpopular. Bottom line, I find the concept of "first-class citizens" blurry at best. It might be useful to explain the differences of procedures in C and those in LISP, but it is very imprecise in Ruby. Methods there appear to be first-class in letter, but not in spirit. Which is a useful insight on its own. ## Meetup summary It was a longer, nicer meeting. We still need to be way more structured. I also believe that we should try to make them longer. Here are some assorted notes: * There is a book called [Structure and Interpretation of Classical Mechanics][sicm] from one of the authors. I find this equally disturbing and fascinating. * Slavena did a couple of neat algebraic tricks. Nothing fancy - just straightforward formula transformations that simplify the Scheme code. In [1.39][slav-1-39] she divides the whole expression by x, which makes an `if` in the numerator unnecessary. This reminds me of negotiating requirements to simplify code - when done properly, both sides win. * Somebody said that the next study group should be on a Haskell group. I'm quite happy that (1) we're talking about a next study group and (2) that it is Haskell. I personally prefer Introduction to Algorithms, though. * I promised everybody dinner after we complete Chapter 2. Either I take them out or I cook. * I don't like how the meetup summary of a week ends up in the notes from the next, so I rearranged all the notes [sicm]: http://mitpress.mit.edu/sicm/ [slav-1-39]: https://github.com/slavv/sicp-exercises/blob/master/01/39.scm ================================================ FILE: scheme/sicp/notes/week-04.markdown ================================================ # Week 4 (2012-03-20 - 2012-03-27) We are finally starting Chapter 2. It goes into data structures and I'm super excited. Plus, I really, really, REALLY like using `car` and `cdr` for recreation. ## Questions * There is a quote in the foreword - "In Pascal the plethora of declarable data structures induces a specialization within functions that inhibits and penalizes casual cooperation. It is better to have 100 functions operate on one data structure than to have 10 functions operate on 10 data structure.". I'm not sure what it means, because of the ambiguity - "It is better in Pascal" or "It is better in general"? * How do you put more than one call in an if branch? (2.23) * Can 2.28 be done with a simple recursion, without reverse and append? ## Various * With the rational numbers example, calculating the `gcd` can be done either in construction time (`make-rat`) or in selection time (`numer` and `denom`). This is a good example of the flexibility in data abstraction. I didn't occur to me that doing it in selection time can be faster in some cases. * The parts of subtraction are called "minuend", "subtrahend" and "difference". Neat. * "The names car and cdr persist because simple combinations like cadr are pronounceable." This even sounds true. Wow. ## Constructors, selectors and abstraction barriers There is an interesting difference in how SICP advocates designing compound data and classical OOP wisdom. It is easy to show when implementing rational numbers. In an object-oriented fashion, we will have two levels of abstraction - (1) the clients of the `Rational` class and the (2) implementation of its operations (as methods). The methods use the private representation of the class. In contrast, the book talks about three levels - (1) the clients that use rational numbers, (2) the rational number operations (addition, subtraction, multiplication, divison) and (3) a set of constructors and selectors, what the operations are implemented with. That way representation can change without affecting the operations. If we have a class `Rational`, the operations (2nd layer) and the internal representation (3rd layer) are naturally grouped in the same context (the class). Usually there is no separation - the operations access the private state directly. This makes changing the representation harder. Introducing a layer of _constructors and selectors_ in a Ruby class seems a neat idea. I wonder if there is a good way to make it explicit. ## Procedural representation of pairs I know what procedural representation of data is, but this caught me off guard - you can implement LISP pairs with lambdas. Like this: (define (cons x y) (define (dispatch m) (cond ((= m 0) x) ((= m 1) y) (else (error "Argument not 0 or 1 -- CONS" m)))) dispatch) (define (car z) (z 0)) (define (car z) (z 1)) While I never gave serious thought about it, I always assumed pairs have to be implemented in C. Interestingly, this will be a sufficient implementation for a lot of LISP code. I'm curious how `pair?` will be implemented in this approach. ## Mathematics and naïveté The extended exercise of 2.1.4 shows an interesting insight: you can rarely approch mathematics naïvely. The idea was generally sound in the beginning, but the accumulated error in tolerance quickly makes the code untrustworthy. Furthermore, in order to minimize the error, one has to devise a way of simplifying arithmetic expressions. This is a task, way larger than the original. Another interesting aspect of the exercise, is that the accumulated error was not immediatelly obvious from the initial design. ## Meetup summary This time I was in London and we held a brief meeting over Skype. Everybody was in the beginning of the material, except for me and Plamen. * Plamen seems to enjoy the video lectures. I should check them out. * I should show the real-time aspect of how I implement the exercises. * Veselin said he will show us the group annotation software next time. We decided to keep the scope to 2.2.2, although Plamen and I might race a bit forward. ================================================ FILE: scheme/sicp/notes/week-05.markdown ================================================ # Week 5 (2012-03-25 - 2012-04-03) I was ahead of everybody else, so I took a small break this week. I was in London too - I did some reading and some exercise, but not entirely enough. ## Meetup summary Everybody was busy, sick or having special plans, so we decided to skip a meeting. ================================================ FILE: scheme/sicp/notes/week-06.markdown ================================================ # Week 6 (2012-04-02 - 2012-04-10) I had no time at all to dedicate to SICP this week. I'm still up with everybody else, but I'm starting to feel guilty. ## Meetup summary We did the meetup in initLab this time. * Nikolay highlights the following quote: > As programmers, we should be alert to opportunities to identify the underlying abstractions in our programs and to build upon them and generalize them to create more powerful abstractions. This is not to say that one should always write programs in the most abstract way possible; expert programmers know how to choose the level of abstraction appropriate to their task. But it is important to be able to think in terms of these abstractions, so that we can be ready to apply them in new contexts. The significance of higher-order procedures is that they enable us to represent these abstractions explicitly as elements in our programming language, so that they can be handled just like other computational elements. * I've got 1.29 totally wrong and I should revisit * Firefox can show a 3D view of DOM? Really?! * I should clean up trailing whitespace * You can transpose with `(apply map list matrix)` ================================================ FILE: scheme/sicp/notes/week-07.markdown ================================================ # Week 07 (2012-04-10 - 2012-04-17) This week I barely did anything. I just managed to complete 3 exercises, once of which in a very poor fashion. I was planning to have tons of free time around Easter, but that's life for you - making plans is the surest way to make your deity laugh. ## Notes * `queens` in 2.42 is written independent of the presentation. `empty-board` contributes to that. Neat. However, this forces a crappy implementation. * I can't help but think that 2.42 can be written way better if the required functions are implemented via another layer of data abstraction. ## Top-down versus bottom-up test-driving It is hard to test-drive 2.42 (eight queens puzzle) in an outside-in fashion. There are three reasons for that: * There is a scaffold of the procedure that gets in the way of writing it incrementally. * It will force us to decide on representation, which we don't want to do. * We don't know the solutions. In this sense, it makes to do a bottom-up test-drive. The upsides are obvious. There are downsides, though - (1) we can throw away a function we just test-drove or (2) we can invalidate all our tests by changing representation. Both of them happened to me. The take away is: when doing up bottom-up test-driving, do more up-front planning. ## Meetup summary * Veselin suggests to check out [(fluxus)][fluxus]. * Plamen is playing a lot with Gimp and visualizing the painters in it. * I suggest that this should all happen with shelling out to ImageMagick. Or the Racket Drawing Kit. * My eight queens suck. I should redo them nicely. [fluxus]: http://www.pawfal.org/fluxus/ ================================================ FILE: scheme/sicp/notes/week-08.markdown ================================================ # Week 08 (2012-04-17 - 2012-04-24) This week was BaconConf. I was very productive and did a lot of progress. ## Notes * My estimate on 2.43 is a bit off. I should check or ask around. * I'm testing 2.44 in a funky way. I'm replacing below and besides with procedures that construct lists and am asserting on the resulting list. * Racket has a plt-r5rs executable. Maybe I can use it instead? ** Plamen said it did not really live up to its name. * Matrix transformations are fun! ## The Rakefile Writing the Rakefile was immense fun. It also optimized a lot of things in my process. I realize, that spending time in order to build an environment where you can be effective is very, very important and totally worth investing in. For two reasons. First, you get the productivity boost. You automate repetative tasks and you reduce the time to accomplish your goal. Second, and more important, you create an environment you can keep growing. If you need a new feature, you won't have to start from scratch - you have a place to put it and you probably have some code to build ontop of. It's pretty similar to the dotfiles and the Vim configuration. There is a general, underlying concept here, that I need to pinpoint. ## Procedural representation is a hack While it is a very nice showcase of the power of programming languages, procedural representation feels like a hack to me. Consider implementing pairs as lambdas. It has a bunch of problems: * No types. There is no way to define `pair?`. * Either it is limited to one selector or it has some awkwardness. * There is no way to introspect it. * It is hard to manipulate the underlying structure. You can just invoke the selector. There might be a deeper application I have not thought of. And it is occasionally very pragmatic (e.g. the picture language). But it feels hacky for me. ## Meetup summary We did not hold a meetup, because half of us were ill. ================================================ FILE: scheme/sicp/notes/week-09.markdown ================================================ # Week 09 (2012-04-24 - 2012-05-01) The weekend after BaconConf we did not do any progress, unfortunatelly. ## Meetup summary We had a small meetup with half of us missing. I showed my Rakefile to Plamen and Veselin, but apart from that, it was not very productive. ================================================ FILE: scheme/sicp/notes/week-10.markdown ================================================ # Week 10 (2012-05-01 - 2012-05-08) No progress again. ## Meetup summary No meetup. Everybody had an excuse. ================================================ FILE: scheme/sicp/notes/week-11.markdown ================================================ # Week 11 (2012-05-08 - 2012-05-15) We decided that this is going to be the week we finish chapter 2. Whatever happens by the end of the week, we move to chapter 03 in the next week. To note the occasion, I gathered everybody at home and cooked some dinner. ## Meetup summary It was me, Veselin, Plamen and Slavena. Nobody had any progress in the past weeks. We decided that we should not keep strugling with the rest of chapter 02 - we should move forward instead. We decided that we will skip the next Tuesday and have a very simple, achievable target for after two weeks. ================================================ FILE: scheme/sicp/notes/week-12.markdown ================================================ # Week 12 (2012-08-21 - 2012-08-28) As the git history clearly indicates, we dropped the ball at some point and I stopped solving exercises. This I picked it up. Nikolay started a new trend since Chapter 3 - now when we meet we don't discuss the exercise, but we read the text instead. That's actually a lot of fun. On the downside, we the progress is slower. I just finished a huge chunk of exercise and I am going to make some points. ## Meetup summary We read 3.3.5 Propagation of Constraints. The model there is quite interesting, although there was nothing groundbreaking in it. ## Data-directed programming The data-directed programming introduced in 2.4.3 is a very interesting idea. It is quite similar to multi-dispatch. It involves building a lot of infrastructure and slowing down the execution, but in the end, it has some interesting advantages. First, it solves the structures vs. classes problem to some extend. It allows adding both a new operation and a new type without resulting to Shotgun Surgery. It gets a bit more complicated when there are two separate packages, where the first one introduces a new type while the second - a new operation. The new types does not support the new operation if one of the package does not know about the other. This is a curious issue, but I don't think there is a good solution. ## Systems with Generic Operations Section 2.5 was a lot of fun. I had to implement generic arithmetic operations over a bunch of numbers, including complex numbers with multiple representations and polynomials with both multiple representations and mixed-type coefficients. An interesting thing to note is when the types and operations are not organized in classes, they are way nicer to implement. For example, there is no need to have Python's `__radd__` and `__rmul`__ to support `3 * Vector(1, 2)`. It still feels that there can be more abstraction on operations (symmetrical opreations for example) but I don't dare venture there without knowing how to write macros. Or rather, I dare, but I'm too lazy to build complex procedures that take too many lambdas. ## Coercion Coercion was implemented in a suboptimal way, since it involved raising types and getting arguments to the same type. This makes sense if we're extremely duck-typed and we don't know what types the operation is defined for. Our table, however, allows us to inspect what types an operation is defined for and we should be able to determine which procedure to invoke and what type conversion to do. This is an interesting problem I don't know much about, but I'm guessing that they avoided it because (1) it can be quite fat and (2) we don't know enough about state in order to inspect the table. I'm curious whether this topic will be revisited. I should also consider creating a showcase for this system once I learn how to do macros (since they are never introduced in this book). ================================================ FILE: scheme/sicp/notes/week-13.markdown ================================================ # Week 13 (2012-08-28 - 2012-09-03) ## Notes * Racket does not support `set-car!` and `set-cdr!`. There is a [blog post][getting-rid] explaining why. While certainly unnice, it can be performed either with `mcons` and friends or by using "legacy Scheme" by doing `(require r5rs/init)`. * Dynamic scoping is very cool, because it allows doing `with-output-to-string`. This allows overriding the default print port, thus capturing the output from `display`. That way the printing side-effect can be tested. I just love that. ================================================ FILE: scheme/sicp/notes/week-14.markdown ================================================ # Week 14 (2012-09-03 - 2012-09-11) ## On Scheme and VimScript I tweeted that reading the book made me a VimScript programmer. That is a very awkward statement, yet anyway, it highlights a fundamental truth - spending all my time in OOP languages, I've lost confidence in writing structured, non-OO code. In that sense, the book provides a freash breath of air - I get to excercise my "structured programming muscles" and I can later apply them in a suboptimal environment like VimScript (or possibly Emacs Lisp?). There is a more general notion here about going with the current, being intuitive or analyzing everything I do. ================================================ FILE: scheme/sicp/notes/week-15.markdown ================================================ # Week 15 (2012-09-18 - 2012-09-25) ## Meetups We have been very slow on doing our meetups. On the other hand, I've been quite quick in progressing through the book. Currently I'm running far infront of everybody, since the book is finally starting to get interesting. ## On namespaces and objects This is not related to SICP, but an interesting thought nontheless. Once you get back to procedural/functional programming, you get into a nightmare of managing names in each namespace. If you are using a bunch of modules, you need to import the names you need and make sure they are available in a maintainable way. Think about `from foo import bar as baz` in Python or the imports in Scala. Object-oriented programming gets that out of the way, since it namespaces all operations under the type. This is obviosly limiting (for example, no "global" functions in Java), but makes name handling a lot easier - you just import the class and Robert's your uncle. ================================================ FILE: scheme/sicp/notes/week-16.markdown ================================================ # Week 16 (2012-12-04 - 2012-12-11) ## Meetups We haven't met in ages. I'm venturing forward by myself. So far, it has been an interesting experience. ## Progress I implemented the lazy evaluator and the nondeterministic evaluator. ## Abstractions in Scheme It becomes apparent to me, that builting a lot of small abstractions is really important in order to make scheme code readable. For example, exercise 4.49 requires generation instead of parsing of sentences. I modified the parse-word procedure in the following way: (define (parse-word word-list) (if (null? (cdr word-list)) (amb) (amb (list (car word-list) (cadr word-list)) (parse-word (cons (car word-list) (cddr word-list)))))) This obviously works, but it is far from optimal. The text defined the procedure an-element-of, which I could use to rewrite it as: (define (parse-word word-list) (list (car word-list) (an-element-of (cdr word-list)))) The result is obviously way simpler. Instead, I went for recursion. I'm not sure why I lack the discipline to introduce such small nice abstractions. On one hand, this follows naturally from the TDD process - you first beat the code until it works and only then you introduce abstractions. On the other hand, I'm rarely carrying this through - once I've gotten the tests of the exercises to pass, I continue with the next one. There is a take-away on TDD, design and disciple here, that I've not yet formulated. ## Macros and functions It is kind of obvious, but I realized that macros have a certain inferiority in comparison to function. Namely, they cannot be passed in as first order functions (or combined in some dynamic way). That indeed makes them "merely syntax", as Alyssa points out in 4.26. This trade-off is makes them a tiny bit less useful. It is curious that Io manages to implement macro-like functions, without sacrificing this ability. ================================================ FILE: scheme/sicp/notes/week-17.markdown ================================================ # Week 17 (2012-12-11 - 2012-12-18) ## Notes This week was all abount implementing the logic programming environments. I don't have much insight to share. I have, however, written a lot of code. I got a lot of pleasant flashbacks to the time in FMI when we were learning Prolog. I wanted to write a Prolog implementation in the summer after the second year, but I never got around to do it. I still want to do it some time. There is a book that might be useful - [An Introduction to Logic Programming through Prolog][logic-programming]. [logic-programming]: http://spivey.oriel.ox.ac.uk/corner/Logic_Programming ## The predicate? convention and the query language Every time I write a rule or assertion in the query language, I have the urge to postfix it with a question mark (?) to indicate that it is a predicate. This makes no sense, since all the rules and assertions are in fact predicates. This is an important point about notation - you introduce it to distinguish between different things. Since there are no non-predicates in the query data base, the question mark does not indicate anything and therefore it is a useless notation. ================================================ FILE: scheme/sicp/notes/week-18.markdown ================================================ # Week 18 (2012-12-18 - 2012-12-25) ## Notes This week is about the first four sections of the final chapter - everything but compilation. ## Recursive vs. Iterative Exercuse 5.27 shows some interesting results. The recursive factorial is not bound in the stack size it consumes, but it performs the computation with less pushes. I'm curious whether this is a weirdness of the explicit control evaluator, or whether it is actually true in general. The idea that recursive functions can be faster than iterative in some cases is interesting. I did not spend much time researching, but there is an interesting [answer on Stack Overflow][answer]. [answer]: http://stackoverflow.com/questions/2651112/is-recursion-ever-faster-than-looping/2651200#2651200 ================================================ FILE: scheme/sicp/notes/week-19.markdown ================================================ # Week 19 (2012-12-25 - 2012-12-31) I finally finished the book. By the end it was a huge crunch. I finished chapter 5 in two weeks and I was working really hard to do so. ## Internal defines revisited The discussion on why internal defines need to be scanned out finally started making sense when we wen't into lexical addressing. Basically, if internal defines are not scanned out (and converted to a let statement), lexical addressing just won't work. ## Writing C again I had not written C since high school and revisiting it was an interesting experience. I could automate a lot of things with rake and watchr, but debugging it was still very hard. I did not use a debugger and just scattered `printf()` calls in the code. In retrospective, I should have taken some time to figure out gdb and used it instead. A huge pain point was debugging the garbage collector. I could not figure out why some memory got collected and I modified the C code to dump the memory and used a Ruby program to analyze it. The lack of introspection in C is really hurtful. Furthermore, C code tends to be very verbose and the lack of nice types (namely hashes and lists) makes it tricky to write code to figure out why something happens. Jakob said that he likes C because "it punishes you really hard if you don't think a lot before you write" and I've started to see what he means by that. ## Prototyping, C and refactorability I've developed a new appreciation of the idea of writing a prototype in a higher-level language. Doing exploratory development with C is just too hard. You end up defining a lot of stuff and then changing it because you discover a better design. I'm starting to think that "refactorability" is an important feature of the language and the more less refactorable a language is, the more up-front design you have to do. It's easy to refactor Ruby, since there is not that much to write and you can get through the intermediate states with consice (if cryptic) expressions. In C, you have to write a lot. ================================================ FILE: scheme/sicp/tests.watchr ================================================ watch(%r{^(\d+)/(\d+).scm$}) { |m| run_file m[1], m[2] } watch(%r{^(\d+)/tests/(\d+)-tests.scm$}) { |m| racket_test m[1], m[2] } def run_file(chapter, exercise) if File.exists? "#{chapter}/tests/#{exercise}-tests.scm" racket_test chapter, exercise else system 'clear' system "rake run:exercise[#{chapter},#{exercise}]" end end def racket_test(chapter, exercise) system 'clear' system "rake run:test[#{chapter},#{exercise}]" end ================================================ FILE: textmate/PLT Scheme.tmbundle/README ================================================ I decided to switch from Vim to TextMate when playing with PLT Scheme. Since I wanted to learn about making TextMate bundles, I decided to let go of the Scheme bundle and create one of my own for the experience. You should definitelly not use this. I'm adding only stuff that I need. Since I am using a subset of the language (a rather weird one, I might add), you'll get strange highlighting, lack of features and so on. TextMate has a nice Scheme bundle, that I'm shamelessly ripping code off (to give credit where due). You can find it here: http://svn.textmate.org/trunk/Bundles/Scheme.tmbundle/ ================================================ FILE: textmate/PLT Scheme.tmbundle/Syntaxes/Scheme.tmLanguage ================================================ fileTypes ss keyEquivalent ^~P name PLT Scheme patterns include #comment include #constants include #keywords repository comment captures 1 name punctuation.definition.comment.scheme match (;).*$\n? name comment.line.semicolon.scheme constants patterns match #[t|f] name constant.language.boolean.scheme match (?<=[\(\s])((#e|#i)?[0-9]+(\.[0-9]+)?|(#x)[0-9a-fA-F]+|(#o)[0-7]+|(#b)[01]+)(?=[\s;()'",\[\]]) name constant.numeric.scheme keywords patterns match (?x) (?<=(\s|\(|\[)) ( define|module|let|cond|if|require|provide|lambda ) (?=(\s|\(|\[)) name keyword.control.scheme scopeName source.scheme uuid 7AF4CBF5-CF08-4855-8BAB-CBDBFB1F429D ================================================ FILE: textmate/PLT Scheme.tmbundle/info.plist ================================================ changed deleted isDelta uuid 79867339-0358-4314-96AE-E4EC68DADF10