From dac20e1e41bbe12b178870d368e7fc56fc12815b Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Tue, 11 Oct 2016 12:29:53 +0000 Subject: Added simple examples --- Makefile | 2 +- acker.icl | 13 ++++++++++ copyfile.icl | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ e.icl | 45 ++++++++++++++++++++++++++++++++ fsieve.icl | 53 ++++++++++++++++++++++++++++++++++++++ hamming.icl | 44 +++++++++++++++++++++++++++++++ invperm.icl | 65 ++++++++++++++++++++++++++++++++++++++++++++++ lqueen.icl | 52 +++++++++++++++++++++++++++++++++++++ mulmat.icl | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ nfib.icl | 17 ++++++++++++ pascal.icl | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ reverse.icl | 27 +++++++++++++++++++ revtwice.icl | 26 +++++++++++++++++++ rfib.icl | 24 +++++++++++++++++ sieve.icl | 17 ++++++++++++ squeen.icl | 58 +++++++++++++++++++++++++++++++++++++++++ str_arit.icl | 46 +++++++++++++++++++++++++++++++++ stwice.icl | 22 ++++++++++++++++ tak.icl | 21 +++++++++++++++ twice.icl | 18 +++++++++++++ war_seq.icl | 63 +++++++++++++++++++++++++++++++++++++++++++++ 21 files changed, 857 insertions(+), 1 deletion(-) create mode 100644 acker.icl create mode 100644 copyfile.icl create mode 100644 e.icl create mode 100644 fsieve.icl create mode 100644 hamming.icl create mode 100644 invperm.icl create mode 100644 lqueen.icl create mode 100644 mulmat.icl create mode 100644 nfib.icl create mode 100644 pascal.icl create mode 100644 reverse.icl create mode 100644 revtwice.icl create mode 100644 rfib.icl create mode 100644 sieve.icl create mode 100644 squeen.icl create mode 100644 str_arit.icl create mode 100644 stwice.icl create mode 100644 tak.icl create mode 100644 twice.icl create mode 100644 war_seq.icl diff --git a/Makefile b/Makefile index 75bbeb6..99bb71e 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -EXE:=test +EXE:=test acker copyfile e fsieve hamming invperm lqueen mulmat nfib pascal reverse revtwice rfib sieve squeen str_arit stwice tak twice war_seq OBJ:=$(addsuffix .o,$(EXE)) ASM:=$(addsuffix .s,$(EXE)) DEPS_O:=cgopts.o _system.o diff --git a/acker.icl b/acker.icl new file mode 100644 index 0000000..675c47c --- /dev/null +++ b/acker.icl @@ -0,0 +1,13 @@ +module acker + +// The Ackermann function. + +import StdInt + +Acker::Int Int -> Int +Acker 0 j = j + 1 +Acker i 0 = Acker (i - 1) 1 +Acker i j = Acker (i - 1) (Acker i (j - 1)) + +Start::Int +Start = Acker 3 7 diff --git a/copyfile.icl b/copyfile.icl new file mode 100644 index 0000000..8cf70f2 --- /dev/null +++ b/copyfile.icl @@ -0,0 +1,84 @@ +module copyfile + +/* +Commandline version of a file copying program. + +Run the program using the "Basic Values Only" option. + +*/ + +import StdEnv, StdFile + +Start::*World -> *File +Start world = fwrites "\nGoodbye.\n" stdinout` +where + (stdinout`,_) = accFiles (CommandLoop stdinout) world` + (stdinout ,world`) = stdio world + + +CommandLoop::*File *Files -> (*File,*Files) +CommandLoop stdio files = CommandLoop` stdio` files` +where + (files`,stdio`) = Copy files stdio + + +CommandLoop`::*File *Files -> (*File,*Files) +CommandLoop` stdio files + | answer<>'y' && answer<>'Y' = (stdio2,files) + = CommandLoop` stdio` files` +where + (files`,stdio`) = Copy files stdio2 + answer = FirstChar answ + (answ ,stdio2) = freadline stdio1 + stdio1 = fwrites "\nCopy another file (y/n)? " stdio + + +Copy::*Files *File -> (*Files,*File) +Copy files io + | source == dest = (files, fwrites "\nCopying succeeded.\n" io4) + = CopyFile (StripNewline source) (StripNewline dest) files io4 +where + (dest,io4) = freadline io3 + io3 = fwrites "\nDestination file: " io2 + (source,io2) = freadline io1 + io1 = fwrites "\nSource file: " io + +CopyFile::String String *Files *File -> (*Files,*File) +CopyFile source dest files io + | not sopen = (files1,alert1) + | not dopen = (files2,alert2) + | io_error = (files4,alert3) + | not dclose = (files4,alert4) + | not sclose = (files4,alert5) + = (files4,alert6) +where + (sclose,files4) = fclose sfile` files3 + (dclose,files3) = fclose dfile` files2 + (io_error,sfile`,dfile`) = CopyFiles sfile dfile + (dopen,dfile,files2) = fopen dest FWriteText files1 + (sopen,sfile,files1) = fopen source FReadData files + + alert1 = fwrites "\nCopying failed.\nSource file could not be opened.\n" io + alert2 = fwrites "Copying failed.\nDestination file could not be opened.\n" io + alert3 = fwrites "Copying failed.\nFile I/O error.\n" io + alert4 = fwrites "Copying failed.\nDestination file could not be closed.\n" io + alert5 = fwrites "Copying failed.\nSource file could not be closed.\n" io + alert6 = fwrites "\nCopying succeeded.\n" io + + +CopyFiles::*File *File -> (Bool, *File, *File) +CopyFiles source dest + | srcend || wrterror = (wrterror,source1,dest1) + = CopyFiles source2 (fwritec byte dest1) +where + (_,byte,source2) = freadc source1 + (srcend,source1) = fend source + (wrterror,dest1) = ferror dest + +StripNewline::String -> String +StripNewline "" = "" +StripNewline str = str % (0, size str - 2) + +FirstChar::String -> Char +FirstChar "" = ' ' +FirstChar str = str.[0] diff --git a/e.icl b/e.icl new file mode 100644 index 0000000..32c8333 --- /dev/null +++ b/e.icl @@ -0,0 +1,45 @@ +module e + +/* +Approximation of the number e. + +Result: A list containing the first NrDigits digits of e = [2,7,1,8,2,8,1,8,2,8,...]. +*/ + +import StdEnv + +NrDigits :== 200 // The number of digits of the approximation of e + +// Approximating e: + +Approx_e::[Int] +Approx_e = [2:Expan ones] where ones= [1:ones] + +// Expan expects an infinite list of ones and returns an infinite +// list containing the digits of the fraction of e ([7,1,8,2,8,...]). + +Expan::[Int] -> [Int] +Expan f = [hd ten:Expan (tl ten)] + where + ten = Ten 2 f + + Ten::Int [Int] -> [Int] + Ten c [p:q] | Safe k c = [k / c, k rem c + a1 : b1] + = [(k + a1) / c, (k + a1) rem c : b1] + where + a1 = hd ten + b1 = tl ten + ten = Ten (c+1) q + k = 10 * p + +Safe::Int Int -> Bool +Safe k c = k/c == (k + 9)/c + +/* +The Start rule returns the first NrDigits elements of the + list of digits returned by the function + 'Approx_e' by means of the function take. +*/ + +Start::[Int] +Start = take NrDigits Approx_e diff --git a/fsieve.icl b/fsieve.icl new file mode 100644 index 0000000..58bcf60 --- /dev/null +++ b/fsieve.icl @@ -0,0 +1,53 @@ +module fsieve + +/* +The Fast Sieve of Eratosthenes. + +A sequential and optimized version of the sieve of Eratosthenes. +The program calculates a list of the first NrOfPrime primes. +The result of the program is the NrOfPrimes'th prime. + +Strictness annotations have been added because the strictness analyser +is not able to deduce all strictness information. Removal of these !'s +will make the program about 20% slower. + +On a machine without a math coprocessor the execution of this +program might take a (very) long time. Set NrOfPrimes to a smaller value. +*/ + +import StdClass; // RWS +import StdInt, StdReal + +NrOfPrimes :== 10 + +// The sieve algorithm: generate an infinite list of all primes. + +Primes::[Int] +Primes = pr where pr = [5 : Sieve 7 4 pr] + +Sieve::Int !Int [Int] -> [Int] +Sieve g i prs + | IsPrime prs g (toInt (sqrt (toReal g))) = [g : Sieve` g i prs] + = Sieve (g + i) (6 - i) prs + +Sieve`::Int Int [Int] -> [Int] +Sieve` g i prs = Sieve (g + i) (6 - i) prs + +IsPrime::[Int] !Int Int -> Bool +IsPrime [f:r] pr bd | f>bd = True + | pr rem f==0 = False + = IsPrime r pr bd + +// Select is used to get the NrOfPrimes'th prime from the infinite list. + +Select::[x] Int -> x +Select [f:r] 1 = f +Select [f:r] n = Select r (n - 1) + + +/* The Start rule: Select the NrOfPrimes'th prime from the list of primes + generated by Primes. +*/ + +Start::Int +Start = Select [2, 3 : Primes] NrOfPrimes diff --git a/hamming.icl b/hamming.icl new file mode 100644 index 0000000..e623d7b --- /dev/null +++ b/hamming.icl @@ -0,0 +1,44 @@ +module hamming + +/* +The Hamming Function. + +The result of this program is a list of the first NrElements numbers +having only 2, 3 and 5 as prime factors. Result: + + [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,...]. + +Run the program with the Show Constructors option on (Application options) +*/ + +import StdEnv + +/* Ham (the Hamming function) returns an infinite list of numbers + having two, three and five as only prime factors by recursively + mapping the functions ((*) 2), ((*) 3) and ((*) 5) over the list of + Hamming numbers found sofar and merging these lists into one. + + The definition of y specifies a cyclic graph to be used yielding a + polynomial complexity in stead of an exponential one. + + The argument lists of merge never end with a Nil + and they are not Nil initially, so + the definition of merge can be specified for 'infinite' lazy lists + leaving out special cases for empty lists. +*/ + +Ham::[Int] +Ham = y +where + y = [1:merge (merge (map ((*) 2) y) (map ((*) 3) y)) (map ((*) 5) y)] + + merge f=:[a:b] g=:[c:d] + | a Perm +InvPerm p = Ip 1 [] p + +/* Ip inverts a permutation (3rd arg) by using the i'th element of + the initial permutation as index for i, which becomes the element + of the inverse permutation ('imperative': ip[p[i]] := i). At the + end the indices have to be removed from the inverse by means of + the function Strip. +*/ +Ip::Index_new TPerm Perm -> Perm +Ip i ip [] = Strip ip +Ip i ip [e:pr] = Ip (i + 1) (Update_new ip e i) pr + + +/* Update adds an element to a list of (index,value)-pairs (a TPerm) + that is sorted on index. +*/ +Update_new::TPerm Index_new Int -> TPerm +Update_new [] i x = [(i,x)] +Update_new [e=:(j,y) : ar] i x | i Perm +Strip [] = [] +Strip [(i,x):ar] = [x : Strip ar] + + +// The Start rule: invert the initial permutation. + +Start::Perm +Start = InvPerm InitPerm diff --git a/lqueen.icl b/lqueen.icl new file mode 100644 index 0000000..f2762a2 --- /dev/null +++ b/lqueen.icl @@ -0,0 +1,52 @@ +module lqueen + +// The Queens Problem, slow version. + +import StdEnv + +BoardSize :== 8 // The size of the chessboard. + +// Finding all solutions for the queens problem. + +Queens::Int [Int] [[Int]] -> [[Int]] +Queens row board boards + | row>BoardSize = [board:boards] + | otherwise = TryCols BoardSize row board boards + +// The second alternative of TryCols is added to make sure Save is never +// called with an empty list. + +TryCols::Int Int [Int] [[Int]] -> [[Int]] +TryCols 0 row board boards = boards +TryCols col row [] boards = TryCols (col-1) row [] queens +where + queens = Queens (row+1) [col] boards + +TryCols col row board boards + | Save col 1 board = TryCols (col-1) row board queens + | otherwise = TryCols (col-1) row board boards +where + queens = Queens (row+1) [col : board] boards + + +Save::Int Int [Int] -> Bool +Save c1 rdiff [c2] = cdiff<>0 && cdiff<>rdiff && cdiff<> 0 - rdiff +where + cdiff = c1 - c2 + +Save c1 rdiff [c2:cols] + | cdiff==rdiff || cdiff==0 || cdiff==0-rdiff = False + | otherwise = Save c1 (inc rdiff) cols +where + cdiff = c1 - c2 + + +/* The Start Rule: Calculate the list of solutions, show the first + solution and the length of that list. +*/ + +Start::(Int,[Int]) +Start = (length solutions, hd solutions) + where + solutions = Queens 1 [] [] + diff --git a/mulmat.icl b/mulmat.icl new file mode 100644 index 0000000..dbf1bad --- /dev/null +++ b/mulmat.icl @@ -0,0 +1,84 @@ +module mulmat + +/* +Matrix Multiplication. + +This program performs matrix multiplication on matrices of integers. +Lists are used to simulate matrices +The initial matrices (Mat1 & Mat2) can have arbitrary size (Size). The +second matrix is transposed first, in order to avoid traversing a matrix +by column, which is very inefficient. The result of the program shows the +initial matrices and the resulting matrix. Run the program with the +"Show Constructors" option on (Application Options). +*/ + +import StdInt, StdString + +::Row :== [Int] // A row is a list of integers. +::Col :== [Int] // A column is a list of integers. +::Mat :== [Row] // A matrix is a list of rows. +::TMat :== [Col] // A transposed matrix is a list of columns. +::Index_new :== Int // An index is an integer. + +Size :== 6 // The size of the matrices. + +// The initial matrices + +Mat1::Mat +Mat1 = [[ 1, 2, 3, 4, 5, 6 ] // + ,[ 0, 1, 2, 3, 4, 5 ] // + ,[ -1, 0, 1, 2, 3, 4 ] // The product of these matrices: + ,[ -2,-1, 0, 1, 2, 3 ] // + ,[ -3,-2,-1, 0, 1, 2 ] // + ,[ -4,-3,-2,-1, 0, 1 ]] // [ 0 -9 0 5 1 7 ] + // [ 0 -8 -1 4 1 6 ] +Mat2::Mat // [ 0 -7 -2 3 1 5 ] +Mat2 = [[ 0, 1, 0, 0, 0,-1 ] // [ 0 -6 -3 2 1 4 ] + ,[ 1, 0, 1, 1, 0, 1 ] // [ 0 -5 -4 1 1 3 ] + ,[ -1, 0, 1,-1, 0, 0 ] // [ 0 -4 -5 0 1 2 ] + ,[ -1,-1,-1, 0,-1, 0 ] // + ,[ 1, 0, 1, 0, 1, 0 ] // + ,[ 0,-1,-1, 1, 0, 1 ]] // + + +// Multiplying two matrices. + +MulMat::Mat Mat -> Mat +MulMat m1 m2 = TMulMat m1 (Transpose m2) + +TMulMat::Mat TMat -> Mat +TMulMat [r] m2 = [ MulRow r m2 ] +TMulMat [r:rs] m2 = [ MulRow r m2 : TMulMat rs m2 ] + +MulRow::Row TMat -> Row +MulRow r [c] = [ Inprodukt r c ] +MulRow r [c:cs] = [ Inprodukt r c : MulRow r cs ] + +Inprodukt::Row Col -> Int +Inprodukt [] [] = 0 +Inprodukt [a:as] [b:bs] = a * b + Inprodukt as bs + +// Transposing a matrix. + +Transpose::Mat -> TMat +Transpose m = Transp m 1 + +Transp::Mat Index_new -> TMat +Transp m i | i == Size = [ Column m i ] + = [ Column m i : Transp m (i + 1) ] + +Column::Mat Index_new -> Col +Column [] i = [] +Column [r:rs] i = [ Select r i : Column rs i ] + +Select::Row Index_new -> Int +Select [a:as] 1 = a +Select [a:as] i = Select as (i - 1) + +// The Start rule: show the initial matrices and their product. + +Start::(Mat,String,Mat,String,Mat) +Start = (m1,"\ntimes\n",m2,"\nbecomes\n",MulMat m1 m2) +where + m1 = Mat1; m2 = Mat2 + \ No newline at end of file diff --git a/nfib.icl b/nfib.icl new file mode 100644 index 0000000..cc7ecda --- /dev/null +++ b/nfib.icl @@ -0,0 +1,17 @@ +module nfib + +/* +The nfib function. + +To obtain maximum performance guards are used instead of +pattern matching. +*/ + +import StdInt + +Nfib::Int -> Int +Nfib n | n < 2 = 1 + = Nfib (n - 1) + Nfib (n - 2) + 1 + +Start::Int +Start = Nfib 30 diff --git a/pascal.icl b/pascal.icl new file mode 100644 index 0000000..74e15b5 --- /dev/null +++ b/pascal.icl @@ -0,0 +1,77 @@ +module pascal + +/* +The Triangle of Pascal. + +The result of this program is a real triangle of Pascal of height +Height, not just a list representing such a triangle: + + 1 + 1 1 + 1 2 1 + 1 3 3 1 + 1 4 6 4 1 etc. + +Run the program using the "Basic Values Only" option (Application options). +Use a non-proportional font for the output (e.g. Monaco 9). +*/ + +import StdEnv + +/* A row of the triangle is represented by a list of integers, + the triangle as a list of rows: +*/ + +::Row :== [Int] +::Triangle :== [Row] + +// Some constants + +NrRows :== 18 // Number of rows to be shown. +Middle :== 40 // The middle of a 80 character line. + +// Miscellaneous functions + +NrOfDigits:: Int -> Int +NrOfDigits 0 = 0 +NrOfDigits n = NrOfDigits (n / 10) + 1 + +// Calculating the Triangle. + +Pascal::Triangle +Pascal = p +where + p = [[1] : [Next a \\ a <- p]] + + Next x = AddRows [0:x] x + + AddRows::Row Row -> Row + AddRows [a:x] [b:y] = [a + b : AddRows x y] + AddRows [a] [] = [a] + AddRows [] [] = [] + +// Formatting the list representing the triangle as a real triangle. + +FormatRows::Triangle -> [String] +FormatRows [f:r] = [ FormatRow f +++ "\n" : FormatRows r] +where + FormatRow::Row -> String + FormatRow row + = toString (spaces (Middle - Length_new row/2 )) +++ FormatElems row + + FormatElems::Row -> String + FormatElems [f:r] = " " +++ toString f +++ FormatElems r + FormatElems [] = "" + + Length_new::Row -> Int + Length_new [f:r] = NrOfDigits f + Length_new r + 1 + Length_new [] = -1 +FormatRows [] = [] + +/* The Start rule: The first NrRows rows of the (infinite) triangle + returned by Pascal are taken and shown on the screen as a + triangle by means of FormatRows. +*/ + +Start::[String] +Start = FormatRows (take NrRows Pascal) diff --git a/reverse.icl b/reverse.icl new file mode 100644 index 0000000..e2200b5 --- /dev/null +++ b/reverse.icl @@ -0,0 +1,27 @@ +module reverse + +// A list containing n elements will be reversed n times. + +import StdEnv + +NrOfTimes :== 1000 + +// Reversing a list of n integers n times. + +MyReverse::Int -> Int +MyReverse n = last (Rev_n n [1..n]) +where + Rev_n::Int [Int] -> [Int] + Rev_n 1 list = Rev list [] + Rev_n n list = Rev_n (n - 1) (Rev list []) + + Rev::[Int] [Int] -> [Int] + Rev [x:r] list = Rev r [x : list] + Rev [] list = list + + +// The Start rule. + +Start::Int +Start = MyReverse NrOfTimes + diff --git a/revtwice.icl b/revtwice.icl new file mode 100644 index 0000000..e5186d4 --- /dev/null +++ b/revtwice.icl @@ -0,0 +1,26 @@ +module revtwice + +/* +Reversing a list a number of times using Twice. + +Increase stack size to 1m and heap size to 2m to run this program. + +A list containing 25 integers is reversed 65536 times by means +of four applications of the higher order function Twice. +*/ + +import StdInt, StdEnum + +Revv:: [Int] -> [Int] +Revv l = Rev l [] +where + Rev::[Int] [Int] -> [Int] + Rev [x:r] list = Rev r [x : list] + Rev [] list = list + +Twice::(x -> x) x -> x +Twice f x = f (f x) + +Start::[Int] +Start = Twice Twice Twice Twice Revv [1..25] + diff --git a/rfib.icl b/rfib.icl new file mode 100644 index 0000000..a48344b --- /dev/null +++ b/rfib.icl @@ -0,0 +1,24 @@ +module rfib + +/* +The Nfib function using reals. + +To obtain maximum performance guards are used instead of +pattern matching. + +To generate an application for this program the Clean 0.8 +application should be set to at least 1.1 Mb. To launch the +generated application another 150K of free memory is needed. + +On a machine without a math coprocessor the execution of this +program might take a (very) long time. Use a smaller start value. +*/ + +import StdReal + +Nfib::Real -> Real +Nfib n | n < 1.5 = 1.0 + = Nfib (n - 1.0) + Nfib (n - 2.0) + 1.0 + +Start::Real +Start = Nfib 26.0 diff --git a/sieve.icl b/sieve.icl new file mode 100644 index 0000000..5e1681e --- /dev/null +++ b/sieve.icl @@ -0,0 +1,17 @@ +module sieve + +// The standard Sieve of Eratosthenes. + +import StdEnv + +NrOfPrimes :== 1000 + +// The sieve algorithm: generate an infinite list of all primes. + +Start = take NrOfPrimes (sieve [2..]) +where + sieve [prime:rest] = [prime : sieve (filter prime rest)] + + filter p [h:tl] | h rem p == 0 = filter p tl + = [h : filter p tl] + filter p [] = [] diff --git a/squeen.icl b/squeen.icl new file mode 100644 index 0000000..cd67c16 --- /dev/null +++ b/squeen.icl @@ -0,0 +1,58 @@ +module squeen + +/* +The Queens Problem. + +Or: How to put n queens on a n*n chessboard in such a way that they +cannot attack each other. + +The result of this program is the number of possible solutions for +the queens problem for a certain boardsize together with one solution. +When BoardSize is 8 the result will be: (92,[4,2,7,3,6,8,5,1]), +which means the queens are on a4, b2, c7, d3, e6, f8, g5 and h1. + +Strictness annotations are used at certain points, because that makes +this program more than twice as fast (the strictness analyzer is not +able to deduce this strictness information). However, other Clean programs +for the Queens problem exist without strictness annotations added by the +programmer that are only 40% slower than this solution (lqueen.icl). + +*/ + +import StdEnv + +BoardSize :== 8 // The size of the chessboard. + +// Finding all solutions for the queens problem. + +Queens::Int [Int] [[Int]] -> [[Int]] +Queens row board boards + | row>BoardSize = [board : boards] + | otherwise = TryCols BoardSize row board boards + +TryCols::Int Int [Int] [[Int]] -> [[Int]] +TryCols 0 row board boards = boards +TryCols col row board boards + | Save col 1 board = TryCols (col-1) row board queens + | otherwise = TryCols (col-1) row board boards +where queens = Queens (row+1) [col : board] boards + +/* The strictness analyzer can't derive strictness for the first and second + argument of Save, because they are not used in the first alternative + of that function. However, Save is strict in these arguments (in the + context of this program) and adding the strictness annotations speeds + up this program considerably. */ + +Save::!Int !Int [Int] -> Bool +Save c1 rdiff [] = True +Save c1 rdiff [c2:cols] + | cdiff==0 || cdiff==rdiff || cdiff==0-rdiff = False + | otherwise = Save c1 (rdiff+1) cols +where cdiff = c1 - c2 + +/* The Start Rule: Calculate the list of solutions, show the first + solution and the length of that list. */ + +Start::(Int,[Int]) +Start = (length solutions, hd solutions) +where solutions = Queens 1 [] [] diff --git a/str_arit.icl b/str_arit.icl new file mode 100644 index 0000000..a85d9f8 --- /dev/null +++ b/str_arit.icl @@ -0,0 +1,46 @@ +module str_arit + +/* +String Arithmetic. + +This program demonstrates string arithmetic by mergesorting the characters of a large string. +*/ + +import StdEnv + +// *S is needed to create the large string. + +mul_S::Int String -> String +mul_S 0 string = "" +mul_S n string = string +++ mul_S (n-1) string + +// The mergesort algorithm on strings. + +MergeSort::String -> String +MergeSort str + | len<=1 = str + | otherwise = Merge (MergeSort first) (MergeSort second) +where + first = str%(0,middle - 1) + second = str%(middle,len - 1) + middle = len /2 + len = size str + +Merge::String String -> String +Merge str "" = str +Merge "" str = str +Merge str1 str2 + | ch1 String +RemoveFirstChar string = string%(1,size string-1) + +// The Start rule: sort a large string (30*40 characters). + +Start::String +Start = MergeSort (mul_S 30 "Sort this garbage properly, please :-). ") diff --git a/stwice.icl b/stwice.icl new file mode 100644 index 0000000..4c9a2df --- /dev/null +++ b/stwice.icl @@ -0,0 +1,22 @@ +module stwice + +/* +The strict Twice function. + +An integer (0) is incremented 65536 times using the higher +order function Twice. The Twice function has a local +strictness annotation which makes it more efficient. + +To generate an application for this program the Clean 0.8 +application should be set to at least 1.1 Mb. To launch the +generated application another 400K of free memory is needed. +*/ + +import StdEnv + +Twice::(a -> a) a -> a +Twice f x #! evalfx = f x + = f evalfx + +Start::Int +Start = Twice Twice Twice Twice inc 0 diff --git a/tak.icl b/tak.icl new file mode 100644 index 0000000..31815d7 --- /dev/null +++ b/tak.icl @@ -0,0 +1,21 @@ +module tak + +/* +The Takeuchi function. + +To generate an application for this program the Clean 0.8 +application should be set to at least 1.1 Mb. To launch the +generated application another 150K of free memory is needed. +*/ + +import StdClass; // RWS +import StdInt + +Tak::Int Int Int -> Int +Tak x y z | x<=y = z + = Tak (Tak (dec x) y z) + (Tak (dec y) z x) + (Tak (dec z) x y) + +Start::Int +Start = Tak 24 16 8 diff --git a/twice.icl b/twice.icl new file mode 100644 index 0000000..bdc5bba --- /dev/null +++ b/twice.icl @@ -0,0 +1,18 @@ +module twice + +/* +The Twice function. + +Increase stack size and heap size to 1m to run this program. + +An integer (0) is incremented 65536 times using the higher +order function Twice. +*/ + +import StdClass, StdInt + +Twice::(x -> x) x -> x +Twice f x = f (f x) + +Start::Int +Start = Twice Twice Twice Twice inc 0 diff --git a/war_seq.icl b/war_seq.icl new file mode 100644 index 0000000..353b184 --- /dev/null +++ b/war_seq.icl @@ -0,0 +1,63 @@ +module war_seq + +/* +Sequential version of Warshall's shortest path algorithm + +Calculates the lenghts of the shortest paths between all nodes of +a directed graph represented by its adjacency matrix using Warshall's +algorithm. The result of the program will be a matrix containing the +length of the shortest path between node i and node j on index (i,j). + +Run the program with the Show Constructors option on (Application options) +*/ + +import StdClass; // RWS +import StdInt + +::Row :== [Int] // A row is represented as a list of integers. +::Mat :== [Row] // A matrix is represented as a list of rows. + +Size :== 6 // The size of the initial matrix. + +// The initial matrix. + +InitMat::Mat // Shortest path matrix: +InitMat = [[ 0,100,100, 13,100,100 ], // [ 0, 16,100, 13, 20, 20 ] + [ 100, 0,100,100, 4, 9 ], // [ 19, 0,100, 5, 4, 9 ] + [ 11,100, 0,100,100,100 ], // [ 11, 27, 0, 24, 31, 31 ] + [ 100, 3,100, 0,100, 7 ], // [ 18, 3,100, 0, 7, 7 ] + [ 15, 5,100, 1, 0,100 ], // [ 15, 4,100, 1, 0, 8 ] + [ 11,100,100, 14,100, 0 ]] // [ 11, 17,100, 14, 21, 0 ] + + +// Miscellaneous functions. + +Min::Int Int -> Int +Min i j | i>j = j + = i + +Select::[x] Int -> x +Select [f:r] 1 = f +Select [f:r] k = Select r (k - 1) + +// Warshall's shortest path algorithm. + +Warshall::Mat -> Mat +Warshall mat = Iterate 1 mat + +Iterate::Int Mat -> Mat +Iterate i mat | i>Size = mat + = Iterate (i+1) (WarRows i mat (Select mat i)) + +WarRows::Int Mat Row -> Mat +WarRows i [] rowi = [] +WarRows i [rowj:rs] rowi = [ UpdateRow (Select rowj i) rowj rowi : WarRows i rs rowi ] + +UpdateRow::Int Row Row -> Row +UpdateRow ji [] [] = [] +UpdateRow ji [jk:rjs] [ik:ris] = [ Min jk (ji + ik) : UpdateRow ji rjs ris ] + +// The Start rule: apply Warshall's algorithm on the initial matrix. + +Start::Mat +Start = Warshall InitMat -- cgit v1.2.3