Exercise Categories
Lists
Tail of a List Last Two Elements of a List N'th Element of a List Length of a List Reverse a List Palindrome Flatten a List Eliminate Duplicates Pack Consecutive Duplicates Run-Length Encoding Modified Run-Length Encoding Decode a Run-Length Encoded List Run-Length Encoding of a List (Direct Solution) Duplicate the Elements of a List Replicate the Elements of a List a Given Number of Times Drop Every N'th Element From a List Split a List Into Two Parts; The Length of the First Part Is Given Extract a Slice From a List Rotate a List N Places to the Left Remove the K'th Element From a List Insert an Element at a Given Position Into a List Create a List Containing All Integers Within a Given Range Extract a Given Number of Randomly Selected Elements From a List Lotto: Draw N Different Random Numbers From the Set 1..M Generate a Random Permutation of the Elements of a List Generate the Combinations of K Distinct Objects Chosen From the N Elements of a List Group the Elements of a Set Into Disjoint Subsets Sorting a List of Lists According to Length of SublistsArithmetic
Determine Whether a Given Integer Number Is Prime Determine the Greatest Common Divisor of Two Positive Integer Numbers Determine Whether Two Positive Integer Numbers Are Coprime Calculate Euler's Totient Function Φ(m) Determine the Prime Factors of a Given Positive Integer Determine the Prime Factors of a Given Positive Integer (2) Calculate Euler's Totient Function Φ(m) (Improved) Compare the Two Methods of Calculating Euler's Totient Function A List of Prime Numbers Goldbach's Conjecture A List of Goldbach CompositionsLogic and Codes
Truth Tables for Logical Expressions (2 Variables) Truth Tables for Logical Expressions Gray Code Huffman CodeBinary Trees
Construct Completely Balanced Binary Trees Symmetric Binary Trees Binary Search Trees (Dictionaries) Generate-and-Test Paradigm Construct Height-Balanced Binary Trees Construct Height-Balanced Binary Trees With a Given Number of Nodes Count the Leaves of a Binary Tree Collect the Leaves of a Binary Tree in a List Collect the Internal Nodes of a Binary Tree in a List Collect the Nodes at a Given Level in a List Construct a Complete Binary Tree Layout a Binary Tree (1) Layout a Binary Tree (2) Layout a Binary Tree (3) A String Representation of Binary Trees Preorder and Inorder Sequences of Binary Trees Dotstring Representation of Binary TreesMultiway Trees
Tree Construction From a Node String Count the Nodes of a Multiway Tree Determine the Internal Path Length of a Tree Construct the Bottom-Up Order Sequence of the Tree Nodes Lisp-Like Tree RepresentationGraphs
Conversions Path From One Node to Another One Cycle From a Given Node Construct All Spanning Trees Construct the Minimal Spanning Tree Graph Isomorphism Node Degree and Graph Coloration Depth-First Order Graph Traversal Connected Components Bipartite Graphs Generate K-Regular Simple Graphs With N NodesExercises
This section is inspired by Ninety-Nine Lisp Problems which in turn was based on “Prolog problem list” by Werner Hett. For each of these questions, some simple tests are shown—they may also serve to make the question clearer if needed. To work on these problems, we recommend you firstinstall OCaml or use itinside your browser. The source of the following problems is available onGitHub.
Every exercise has a difficulty level, ranging from beginner to advanced.
Tail of a List
Write a functionlast : 'a list -> 'a option that returns the last element of a list
#last["a";"b";"c";"d"];;-:stringoption=Some"d"#last[];;-:'aoption=None#letreclast=function|[]->None|[x]->Somex|_::t->lastt;;vallast:'alist->'aoption=<fun>Last Two Elements of a List
Find the last two (last and penultimate) elements of a list.
#last_two["a";"b";"c";"d"];;-:(string*string)option=Some("c","d")#last_two["a"];;-:(string*string)option=None#letreclast_two=function|[]|[_]->None|[x;y]->Some(x,y)|_::t->last_twot;;vallast_two:'alist->('a*'a)option=<fun>N'th Element of a List
Find the N'th element of a list.
#at2["a";"b";"c";"d";"e"];;-:stringoption=Some"c"#at2["a"];;-:stringoption=NoneRemark: OCaml hasList.nth which numbers elements from0 andraises an exception if the index is out of bounds.
#List.nth["a";"b";"c";"d";"e"]2;;-:string="c"#List.nth["a"]2;;Exception:Failure"nth".#letrecatk=function|[]->None|h::t->ifk=0thenSomehelseat(k-1)t;;valat:int->'alist->'aoption=<fun>Length of a List
Find the number of elements of a list.
OCaml standard library hasList.length but we ask that you reimplementit. Bonus for atail recursivesolution.
#length["a";"b";"c"];;-:int=3#length[];;-:int=0This function is tail-recursive: it uses a constant amount of stack memory regardless of list size.
#letlengthlist=letrecauxn=function|[]->n|_::t->aux(n+1)tinaux0list;;vallength:'alist->int=<fun>Reverse a List
Reverse a list.
OCaml standard library hasList.rev but we ask that you reimplementit.
#rev["a";"b";"c"];;-:stringlist=["c";"b";"a"]#letrevlist=letrecauxacc=function|[]->acc|h::t->aux(h::acc)tinaux[]list;;valrev:'alist->'alist=<fun>Palindrome
Find out whether a list is a palindrome.
Hint: A palindrome is its own reverse.
#is_palindrome["x";"a";"m";"a";"x"];;-:bool=true#not(is_palindrome["a";"b"]);;-:bool=true#letis_palindromelist=(* One can use either the rev function from the previous problem, or the built-in List.rev*)list=List.revlist;;valis_palindrome:'alist->bool=<fun>Flatten a List
Flatten a nested list structure.
type'anode=|Oneof'a|Manyof'anodelist#flatten[One"a";Many[One"b";Many[One"c";One"d"];One"e"]];;-:stringlist=["a";"b";"c";"d";"e"]#type'anode=|Oneof'a|Manyof'anodelist;;type'anode=Oneof'a|Manyof'anodelist#(* This function traverses the list, prepending any encountered elements to an accumulator, which flattens the list in inverse order. It can then be reversed to obtain the actual flattened list.*);;#letflattenlist=letrecauxacc=function|[]->acc|Onex::t->aux(x::acc)t|Manyl::t->aux(auxaccl)tinList.rev(aux[]list);;valflatten:'anodelist->'alist=<fun>Eliminate Duplicates
Eliminate consecutive duplicates of list elements.
#compress["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;-:stringlist=["a";"b";"c";"a";"d";"e"]#letreccompress=function|a::(b::_ast)->ifa=bthencompresstelsea::compresst|smaller->smaller;;valcompress:'alist->'alist=<fun>Pack Consecutive Duplicates
Pack consecutive duplicates of list elements into sublists.
#pack["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"d";"e";"e";"e";"e"];;-:stringlistlist=[["a";"a";"a";"a"];["b"];["c";"c"];["a";"a"];["d";"d"];["e";"e";"e";"e"]]#letpacklist=letrecauxcurrentacc=function|[]->[](* Can only be reached if original list is empty*)|[x]->(x::current)::acc|a::(b::_ast)->ifa=bthenaux(a::current)acctelseaux[]((a::current)::acc)tinList.rev(aux[][]list);;valpack:'alist->'alistlist=<fun>Run-Length Encoding
If you need so, refresh your memory aboutrun-length encoding.
Here is an example:
#encode["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;-:(int*string)list=[(4,"a");(1,"b");(2,"c");(2,"a");(1,"d");(4,"e")]#letencodelist=letrecauxcountacc=function|[]->[](* Can only be reached if original list is empty*)|[x]->(count+1,x)::acc|a::(b::_ast)->ifa=bthenaux(count+1)acctelseaux0((count+1,a)::acc)tinList.rev(aux0[]list);;valencode:'alist->(int*'a)list=<fun>An alternative solution, which is shorter but requires more memory, is to usethepack function declared in problem 9:
#letpacklist=letrecauxcurrentacc=function|[]->[](* Can only be reached if original list is empty*)|[x]->(x::current)::acc|a::(b::_ast)->ifa=bthenaux(a::current)acctelseaux[]((a::current)::acc)tinList.rev(aux[][]list);;valpack:'alist->'alistlist=<fun>#letencodelist=List.map(funl->(List.lengthl,List.hdl))(packlist);;valencode:'alist->(int*'a)list=<fun>Modified Run-Length Encoding
Modify the result of the previous problem in such a way that if anelement has no duplicates it is simply copied into the result list. Onlyelements with duplicates are transferred as (N E) lists.
Since OCaml lists are homogeneous, one needs to define a type to holdboth single elements and sub-lists.
type'arle=|Oneof'a|Manyofint*'a#encode["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;-:stringrlelist=[Many(4,"a");One"b";Many(2,"c");Many(2,"a");One"d";Many(4,"e")]#type'arle=|Oneof'a|Manyofint*'a;;type'arle=Oneof'a|Manyofint*'a#letencodel=letcreate_tuplecntelem=ifcnt=1thenOneelemelseMany(cnt,elem)inletrecauxcountacc=function|[]->[]|[x]->(create_tuple(count+1)x)::acc|hd::(snd::_astl)->ifhd=sndthenaux(count+1)acctlelseaux0((create_tuple(count+1)hd)::acc)tlinList.rev(aux0[]l);;valencode:'alist->'arlelist=<fun>Decode a Run-Length Encoded List
Given a run-length code list generated as specified in the previousproblem, construct its uncompressed version.
#decode[Many(4,"a");One"b";Many(2,"c");Many(2,"a");One"d";Many(4,"e")];;-:stringlist=["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"e";"e";"e";"e"]#letdecodelist=letrecmanyaccnx=ifn=0thenaccelsemany(x::acc)(n-1)xinletrecauxacc=function|[]->acc|Onex::t->aux(x::acc)t|Many(n,x)::t->aux(manyaccnx)tinaux[](List.revlist);;valdecode:'arlelist->'alist=<fun>Run-Length Encoding of a List (Direct Solution)
Implement the so-called run-length encoding data compression methoddirectly. I.e. don't explicitly create the sublists containing theduplicates, as in problem "Pack consecutive duplicates of list elements into sublists", but only count them. As in problem"Modified run-length encoding", simplify the result list by replacing the singleton lists (1 X) by X.
#encode["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;-:stringrlelist=[Many(4,"a");One"b";Many(2,"c");Many(2,"a");One"d";Many(4,"e")]#letencodelist=letrlecountx=ifcount=0thenOnexelseMany(count+1,x)inletrecauxcountacc=function|[]->[](* Can only be reached if original list is empty*)|[x]->rlecountx::acc|a::(b::_ast)->ifa=bthenaux(count+1)acctelseaux0(rlecounta::acc)tinList.rev(aux0[]list);;valencode:'alist->'arlelist=<fun>Duplicate the Elements of a List
Duplicate the elements of a list.
#duplicate["a";"b";"c";"c";"d"];;-:stringlist=["a";"a";"b";"b";"c";"c";"c";"c";"d";"d"]#letrecduplicate=function|[]->[]|h::t->h::h::duplicatet;;valduplicate:'alist->'alist=<fun>Remark: this function is not tail recursive. Can you modify it soit becomes so?
Replicate the Elements of a List a Given Number of Times
Replicate the elements of a list a given number of times.
#replicate["a";"b";"c"]3;;-:stringlist=["a";"a";"a";"b";"b";"b";"c";"c";"c"]#letreplicatelistn=letrecprependnaccx=ifn=0thenaccelseprepend(n-1)(x::acc)xinletrecauxacc=function|[]->acc|h::t->aux(prependnacch)tin(* This could also be written as: List.fold_left (prepend n) [] (List.rev list)*)aux[](List.revlist);;valreplicate:'alist->int->'alist=<fun>Note that
List.rev listis needed only because we wantauxto betail recursive.
Drop Every N'th Element From a List
Drop every N'th element from a list.
#drop["a";"b";"c";"d";"e";"f";"g";"h";"i";"j"]3;;-:stringlist=["a";"b";"d";"e";"g";"h";"j"]#letdroplistn=letrecauxi=function|[]->[]|h::t->ifi=nthenaux1telseh::aux(i+1)tinaux1list;;valdrop:'alist->int->'alist=<fun>Split a List Into Two Parts; The Length of the First Part Is Given
Split a list into two parts; the length of the first part is given.
If the length of the first part is longer than the entire list, then thefirst part is the list and the second part is empty.
#split["a";"b";"c";"d";"e";"f";"g";"h";"i";"j"]3;;-:stringlist*stringlist=(["a";"b";"c"],["d";"e";"f";"g";"h";"i";"j"])#split["a";"b";"c";"d"]5;;-:stringlist*stringlist=(["a";"b";"c";"d"],[])#letsplitlistn=letrecauxiacc=function|[]->List.revacc,[]|h::tasl->ifi=0thenList.revacc,lelseaux(i-1)(h::acc)tinauxn[]list;;valsplit:'alist->int->'alist*'alist=<fun>Extract a Slice From a List
Given two indices,i andk, the slice is the list containing theelements between thei'th andk'th element of the original list(both limits included). Start counting the elements with 0 (this is theway theList module numbers elements).
#slice["a";"b";"c";"d";"e";"f";"g";"h";"i";"j"]26;;-:stringlist=["c";"d";"e";"f";"g"]#letslicelistik=letrectaken=function|[]->[]|h::t->ifn=0then[]elseh::take(n-1)tinletrecdropn=function|[]->[]|h::tasl->ifn=0thenlelsedrop(n-1)tintake(k-i+1)(dropilist);;valslice:'alist->int->int->'alist=<fun>This solution has a drawback, namely that thetake function is nottail recursive so it mayexhaust the stack when given a very long list. You may also notice thatthe structure oftake anddrop is similar and you may want toabstract their common skeleton in a single function. Here is a solution.
#letrecfold_untilfaccn=function|[]->(acc,[])|h::tasl->ifn=0then(acc,l)elsefold_untilf(facch)(n-1)tletslicelistik=let_,list=fold_until(fun__->[])[]ilistinlettaken,_=fold_until(funacch->h::acc)[](k-i+1)listinList.revtaken;;valfold_until:('a->'b->'a)->'a->int->'blist->'a*'blist=<fun>valslice:'alist->int->int->'alist=<fun>Rotate a List N Places to the Left
Rotate a list N places to the left.
#rotate["a";"b";"c";"d";"e";"f";"g";"h"]3;;-:stringlist=["d";"e";"f";"g";"h";"a";"b";"c"]#letsplitlistn=letrecauxiacc=function|[]->List.revacc,[]|h::tasl->ifi=0thenList.revacc,lelseaux(i-1)(h::acc)tinauxn[]listletrotatelistn=letlen=List.lengthlistin(* Compute a rotation value between 0 and len - 1*)letn=iflen=0then0else(nmodlen+len)modleninifn=0thenlistelseleta,b=splitlistninb@a;;valsplit:'alist->int->'alist*'alist=<fun>valrotate:'alist->int->'alist=<fun>Remove the K'th Element From a List
Remove the K'th element from a list.
The first element of the list is numbered 0, the second 1,...
#remove_at1["a";"b";"c";"d"];;-:stringlist=["a";"c";"d"]#letrecremove_atn=function|[]->[]|h::t->ifn=0thentelseh::remove_at(n-1)t;;valremove_at:int->'alist->'alist=<fun>Insert an Element at a Given Position Into a List
Start counting list elements with 0. If the position is larger orequal to the length of the list, insert the element at the end. (Thebehavior is unspecified if the position is negative.)
#insert_at"alfa"1["a";"b";"c";"d"];;-:stringlist=["a";"alfa";"b";"c";"d"]#letrecinsert_atxn=function|[]->[x]|h::tasl->ifn=0thenx::lelseh::insert_atx(n-1)t;;valinsert_at:'a->int->'alist->'alist=<fun>Create a List Containing All Integers Within a Given Range
If first argument is greater than second, produce a list in decreasingorder.
#range49;;-:intlist=[4;5;6;7;8;9]#letrangeab=letrecauxab=ifa>bthen[]elsea::aux(a+1)binifa>bthenList.rev(auxba)elseauxab;;valrange:int->int->intlist=<fun>A tail recursive implementation:
#letrangeab=letrecauxacchighlow=ifhigh>=lowthenaux(high::acc)(high-1)lowelseaccinifa<bthenaux[]baelseList.rev(aux[]ab);;valrange:int->int->intlist=<fun>Extract a Given Number of Randomly Selected Elements From a List
The selected items shall be returned in a list. We use theRandommodule but and initialise it withRandom.init 0 at the start ofthe function for reproducibility and validate the solution. To make the function truly random, however,one should remove the call toRandom.init 0
#rand_select["a";"b";"c";"d";"e";"f";"g";"h"]3;;-:stringlist=["e";"c";"g"]#letrand_selectlistn=Random.init0;letrecextractaccn=function|[]->raiseNot_found|h::t->ifn=0then(h,acc@t)elseextract(h::acc)(n-1)tinletextract_randlistlen=extract[](Random.intlen)listinletrecauxnacclistlen=ifn=0thenaccelseletpicked,rest=extract_randlistleninaux(n-1)(picked::acc)rest(len-1)inletlen=List.lengthlistinaux(minnlen)[]listlen;;valrand_select:'alist->int->'alist=<fun>Lotto: Draw N Different Random Numbers From the Set 1..M
Draw N different random numbers from the set1..M.
The selected numbers shall be returned in a list.
#lotto_select649;;-:intlist=[20;28;45;16;24;38]#(* [range] and [rand_select] defined in problems above*)letlotto_selectnm=rand_select(range1m)n;;vallotto_select:int->int->intlist=<fun>Generate a Random Permutation of the Elements of a List
Generate a random permutation of the elements of a list.
#permutation["a";"b";"c";"d";"e";"f"];;-:stringlist=["c";"d";"f";"e";"b";"a"]#letpermutationlist=letrecextractaccn=function|[]->raiseNot_found|h::t->ifn=0then(h,acc@t)elseextract(h::acc)(n-1)tinletextract_randlistlen=extract[](Random.intlen)listinletrecauxacclistlen=iflen=0thenaccelseletpicked,rest=extract_randlistleninaux(picked::acc)rest(len-1)inaux[]list(List.lengthlist);;valpermutation:'alist->'alist=<fun>Generate the Combinations of K Distinct Objects Chosen From the N Elements of a List
Generate the combinations of K distinct objects chosen from the N elements of a list.
In how many ways can a committee of 3 be chosen from a group of 12people? We all know that there are C(12,3) = 220 possibilities (C(N,K)denotes the well-known binomial coefficients). For pure mathematicians,this result may be great. But we want to really generate all thepossibilities in a list.
#extract2["a";"b";"c";"d"];;-:stringlistlist=[["a";"b"];["a";"c"];["a";"d"];["b";"c"];["b";"d"];["c";"d"]]#letrecextractklist=ifk<=0then[[]]elsematchlistwith|[]->[]|h::tl->letwith_h=List.map(funl->h::l)(extract(k-1)tl)inletwithout_h=extractktlinwith_h@without_h;;valextract:int->'alist->'alistlist=<fun>Group the Elements of a Set Into Disjoint Subsets
Group the elements of a set into disjoint subsets
- In how many ways can a group of 9 people work in 3 disjoint subgroupsof 2, 3 and 4 persons? Write a function that generates all thepossibilities and returns them in a list.
- Generalize the above function in a way that we can specify a list ofgroup sizes and the function will return a list of groups.
#group["a";"b";"c";"d"][2;1];;-:stringlistlistlist=[[["a";"b"];["c"]];[["a";"c"];["b"]];[["b";"c"];["a"]];[["a";"b"];["d"]];[["a";"c"];["d"]];[["b";"c"];["d"]];[["a";"d"];["b"]];[["b";"d"];["a"]];[["a";"d"];["c"]];[["b";"d"];["c"]];[["c";"d"];["a"]];[["c";"d"];["b"]]]#(* This implementation is less streamlined than the one-extraction version, because more work is done on the lists after each transform to prepend the actual items. The end result is cleaner in terms of code, though.*)letgrouplistsizes=letinitial=List.map(funsize->size,[])sizesin(* The core of the function. Prepend accepts a list of groups, each with the number of items that should be added, and prepends the item to every group that can support it, thus turning [1,a ; 2,b ; 0,c] into [ [0,x::a ; 2,b ; 0,c ]; [1,a ; 1,x::b ; 0,c]; [ 1,a ; 2,b ; 0,c ]] Again, in the prolog language (for which these questions are originally intended), this function is a whole lot simpler.*)letprependplist=letemitlacc=l::accinletrecauxemitacc=function|[]->emit[]acc|(n,l)ash::t->letacc=ifn>0thenemit((n-1,p::l)::t)accelseaccinaux(funlacc->emit(h::l)acc)acctinauxemit[]listinletrecaux=function|[]->[initial]|h::t->List.concat_map(prependh)(auxt)inletall=auxlistin(* Don't forget to eliminate all group sets that have non-full groups*)letcomplete=List.filter(List.for_all(fun(x,_)->x=0))allinList.map(List.mapsnd)complete;;valgroup:'alist->intlist->'alistlistlist=<fun>Sorting a List of Lists According to Length of Sublists
Sorting a list of lists according to length of sublists.
We suppose that a list contains elements that are lists themselves.The objective is to sort the elements of this list according to theirlength. E.g. short lists first, longer lists later, or vice versa.
Again, we suppose that a list contains elements that are liststhemselves. But this time the objective is to sort the elements of thislist according to theirlength frequency; i.e., in the default,where sorting is done ascendingly, lists with rare lengths are placedfirst, others with a more frequent length come later.
#length_sort[["a";"b";"c"];["d";"e"];["f";"g";"h"];["d";"e"];["i";"j";"k";"l"];["m";"n"];["o"]];;-:stringlistlist=[["o"];["d";"e"];["d";"e"];["m";"n"];["a";"b";"c"];["f";"g";"h"];["i";"j";"k";"l"]]#frequency_sort[["a";"b";"c"];["d";"e"];["f";"g";"h"];["d";"e"];["i";"j";"k";"l"];["m";"n"];["o"]];;-:stringlistlist=[["i";"j";"k";"l"];["o"];["a";"b";"c"];["f";"g";"h"];["d";"e"];["d";"e"];["m";"n"]](* We might not be allowed to use built-in List.sort, so here's an eight-line implementation of insertion sort — O(n²) time complexity.*)letrecinsertcmpe=function|[]->[e]|h::tasl->ifcmpeh<=0thene::lelseh::insertcmpetletrecsortcmp=function|[]->[]|h::t->insertcmph(sortcmpt)(* Sorting according to length : prepend length, sort, remove length*)letlength_sortlists=letlists=List.map(funlist->List.lengthlist,list)listsinletlists=sort(funab->compare(fsta)(fstb))listsinList.mapsndlists;;(* Sorting according to length frequency : prepend frequency, sort, remove frequency. Frequencies are extracted by sorting lengths and applying RLE to count occurrences of each length (see problem"Run-length encoding of a list.")*)letrlelist=letrecauxcountacc=function|[]->[](* Can only be reached if original list is empty*)|[x]->(x,count+1)::acc|a::(b::_ast)->ifa=bthenaux(count+1)acctelseaux0((a,count+1)::acc)tinaux0[]listletfrequency_sortlists=letlengths=List.mapList.lengthlistsinletfreq=rle(sortcomparelengths)inletby_freq=List.map(funlist->List.assoc(List.lengthlist)freq,list)listsinletsorted=sort(funab->compare(fsta)(fstb))by_freqinList.mapsndsortedDetermine Whether a Given Integer Number Is Prime
Determine whether a given integer number is prime.
#not(is_prime1);;-:bool=true#is_prime7;;-:bool=true#not(is_prime12);;-:bool=trueRecall thatd dividesn if and only ifn mod d = 0. This is a naivesolution. See theSieve ofEratosthenes for amore clever one.
#letis_primen=letn=absninletrecis_not_divisord=d*d>n||(nmodd<>0&&is_not_divisor(d+1))inn>1&&is_not_divisor2;;valis_prime:int->bool=<fun>Determine the Greatest Common Divisor of Two Positive Integer Numbers
Determine the greatest common divisor of two positive integer numbers.
Use Euclid's algorithm.
#gcd1327;;-:int=1#gcd205367826;;-:int=2#letrecgcdab=ifb=0thenaelsegcdb(amodb);;valgcd:int->int->int=<fun>Determine Whether Two Positive Integer Numbers Are Coprime
Determine whether two positive integer numbers are coprime.
Two numbers are coprime if their greatest common divisor equals 1.
#coprime1327;;-:bool=true#not(coprime205367826);;-:bool=true#(* [gcd] is defined in the previous question*)letcoprimeab=gcdab=1;;valcoprime:int->int->bool=<fun>Calculate Euler's Totient Function Φ(m)
Euler's so-called totient function φ(m) is defined as the number ofpositive integers r (1 ≤ r < m) that are coprime to m. We let φ(1) = 1.
Find out what the value of φ(m) is if m is a prime number. Euler'stotient function plays an important role in one of the most widely usedpublic key cryptography methods (RSA). In this exercise you should usethe most primitive method to calculate this function (there are smarterways that we shall discuss later).
#phi10;;-:int=4#(* [coprime] is defined in the previous question*)letphin=letreccount_coprimeaccd=ifd<nthencount_coprime(ifcoprimendthenacc+1elseacc)(d+1)elseaccinifn=1then1elsecount_coprime01;;valphi:int->int=<fun>Determine the Prime Factors of a Given Positive Integer
Construct a flat list containing the prime factors in ascending order.
#factors315;;-:intlist=[3;3;5;7]#(* Recall that d divides n iff [n mod d = 0]*)letfactorsn=letrecauxdn=ifn=1then[]elseifnmodd=0thend::auxd(n/d)elseaux(d+1)ninaux2n;;valfactors:int->intlist=<fun>Determine the Prime Factors of a Given Positive Integer (2)
Construct a list containing the prime factors and their multiplicity.
Hint: The problem is similar to problemRun-length encoding of a list (direct solution).
#factors315;;-:(int*int)list=[(3,2);(5,1);(7,1)]#letfactorsn=letrecauxdn=ifn=1then[]elseifnmodd=0thenmatchauxd(n/d)with|(h,n)::twhenh=d->(h,n+1)::t|l->(d,1)::lelseaux(d+1)ninaux2n;;valfactors:int->(int*int)list=<fun>Calculate Euler's Totient Function Φ(m) (Improved)
See problem "Calculate Euler's totient function φ(m)" forthe definition of Euler's totient function. If the list of the primefactors of a number m is known in the form of the previous problem thenthe function phi(m) can be efficiently calculated as follows: Let[(p1, m1); (p2, m2); (p3, m3); ...] be the list of prime factors(and their multiplicities) of a given number m. Then φ(m) can becalculated with the following formula:
φ(m) = (p1 - 1) × p1m1 - 1 × (p2 - 1) ×p2m2 - 1 × (p3 - 1) × p3m3 - 1 × ⋯
#phi_improved10;;-:int=4#phi_improved13;;-:int=12(* Naive power function.*)letrecpownp=ifp<1then1elsen*pown(p-1)(* [factors] is defined in the previous question.*)letphi_improvedn=letrecauxacc=function|[]->acc|(p,m)::t->aux((p-1)*powp(m-1)*acc)tinaux1(factorsn)Compare the Two Methods of Calculating Euler's Totient Function
Use the solutions of problems"Calculate Euler's totient function φ(m)" and"Calculate Euler's totient function φ(m) (improved)"to compare the algorithms. Take the number of logical inferences as a measure for efficiency. Try to calculate φ(10090) as an example.
timeitphi10090#(* Naive [timeit] function. It requires the [Unix] module to be loaded.*)lettimeitfa=lett0=Unix.gettimeofday()inignore(fa);lett1=Unix.gettimeofday()int1-.t0;;valtimeit:('a->'b)->'a->float=<fun>A List of Prime Numbers
Given a range of integers by its lower and upper limit, construct a listof all prime numbers in that range.
#List.length(all_primes27920);;-:int=1000#letis_primen=letn=maxn(-n)inletrecis_not_divisord=d*d>n||(nmodd<>0&&is_not_divisor(d+1))inis_not_divisor2letrecall_primesab=ifa>bthen[]elseletrest=all_primes(a+1)binifis_primeathena::restelserest;;valis_prime:int->bool=<fun>valall_primes:int->int->intlist=<fun>Goldbach's Conjecture
Goldbach's conjecture says that every positive even number greater than2 is the sum of two prime numbers. Example: 28 = 5 + 23. It is one ofthe most famous facts in number theory that has not been proved to becorrect in the general case. It has beennumerically confirmed up tovery large numbers. Write a function to find the two prime numbers thatsum up to a given even integer.
#goldbach28;;-:int*int=(5,23)#(* [is_prime] is defined in the previous solution*)letgoldbachn=letrecauxd=ifis_primed&&is_prime(n-d)then(d,n-d)elseaux(d+1)inaux2;;valgoldbach:int->int*int=<fun>A List of Goldbach Compositions
Given a range of integers by its lower and upper limit, print a list ofall even numbers and their Goldbach composition.
In most cases, if an even number is written as the sum of two primenumbers, one of them is very small. Very rarely, the primes are bothbigger than say 50. Try to find out how many such cases there are in therange 2..3000.
#goldbach_list920;;-:(int*(int*int))list=[(10,(3,7));(12,(5,7));(14,(3,11));(16,(3,13));(18,(5,13));(20,(3,17))]#(* [goldbach] is defined in the previous question.*)letrecgoldbach_listab=ifa>bthen[]elseifamod2=1thengoldbach_list(a+1)belse(a,goldbacha)::goldbach_list(a+2)bletgoldbach_limitablim=List.filter(fun(_,(a,b))->a>lim&&b>lim)(goldbach_listab);;valgoldbach_list:int->int->(int*(int*int))list=<fun>valgoldbach_limit:int->int->int->(int*(int*int))list=<fun>Truth Tables for Logical Expressions (2 Variables)
Let us define a small "language" for boolean expressions containingvariables:
#typebool_expr=|Varofstring|Notofbool_expr|Andofbool_expr*bool_expr|Orofbool_expr*bool_expr;;typebool_expr=Varofstring|Notofbool_expr|Andofbool_expr*bool_expr|Orofbool_expr*bool_exprA logical expression in two variables can then be written in prefixnotation. For example,(a ∨ b) ∧ (a ∧ b) is written:
#And(Or(Var"a",Var"b"),And(Var"a",Var"b"));;-:bool_expr=And(Or(Var"a",Var"b"),And(Var"a",Var"b"))Define a function,table2 which returns the truth table of a givenlogical expression in two variables (specified as arguments). The returnvalue must be a list of triples containing(value_of_a, value_of_b, value_of_expr).
#table2"a""b"(And(Var"a",Or(Var"a",Var"b")));;-:(bool*bool*bool)list=[(true,true,true);(true,false,true);(false,true,false);(false,false,false)]#letreceval2aval_abval_b=function|Varx->ifx=athenval_aelseifx=bthenval_belsefailwith"The expression contains an invalid variable"|Note->not(eval2aval_abval_be)|And(e1,e2)->eval2aval_abval_be1&&eval2aval_abval_be2|Or(e1,e2)->eval2aval_abval_be1||eval2aval_abval_be2lettable2abexpr=[(true,true,eval2atruebtrueexpr);(true,false,eval2atruebfalseexpr);(false,true,eval2afalsebtrueexpr);(false,false,eval2afalsebfalseexpr)];;valeval2:string->bool->string->bool->bool_expr->bool=<fun>valtable2:string->string->bool_expr->(bool*bool*bool)list=<fun>Truth Tables for Logical Expressions
Generalize the previous problem in such a way that the logicalexpression may contain any number of logical variables. Definetablein a way thattable variables expr returns the truth table for theexpressionexpr, which contains the logical variables enumerated invariables.
#table["a";"b"](And(Var"a",Or(Var"a",Var"b")));;-:((string*bool)list*bool)list=[([("a",true);("b",true)],true);([("a",true);("b",false)],true);([("a",false);("b",true)],false);([("a",false);("b",false)],false)]#(* [val_vars] is an associative list containing the truth value of each variable. For efficiency, a Map or a Hashtlb should be preferred.*)letrecevalval_vars=function|Varx->List.assocxval_vars|Note->not(evalval_varse)|And(e1,e2)->evalval_varse1&&evalval_varse2|Or(e1,e2)->evalval_varse1||evalval_varse2(* Again, this is an easy and short implementation rather than an efficient one.*)letrectable_makeval_varsvarsexpr=matchvarswith|[]->[(List.revval_vars,evalval_varsexpr)]|v::tl->table_make((v,true)::val_vars)tlexpr@table_make((v,false)::val_vars)tlexprlettablevarsexpr=table_make[]varsexpr;;valeval:(string*bool)list->bool_expr->bool=<fun>valtable_make:(string*bool)list->stringlist->bool_expr->((string*bool)list*bool)list=<fun>valtable:stringlist->bool_expr->((string*bool)list*bool)list=<fun>Gray Code
An n-bit Gray code is a sequence of n-bit strings constructed accordingto certain rules. For example,
n = 1: C(1) = ['0', '1'].n = 2: C(2) = ['00', '01', '11', '10'].n = 3: C(3) = ['000', '001', '011', '010', '110', '111', '101', '100'].Find out the construction rules and write a function with the followingspecification:gray n returns then-bit Gray code.
#gray1;;-:stringlist=["0";"1"]#gray2;;-:stringlist=["00";"01";"11";"10"]#gray3;;-:stringlist=["000";"001";"011";"010";"110";"111";"101";"100"]#letgrayn=letrecgray_next_levelkl=ifk<nthen(* This is the core part of the Gray code construction. * first_half is reversed and has a"0" attached to every element. * Second part is reversed (it must be reversed for correct gray code). * Every element has"1" attached to the front.*)let(first_half,second_half)=List.fold_left(fun(acc1,acc2)x->(("0"^x)::acc1,("1"^x)::acc2))([],[])lin(* List.rev_append turns first_half around and attaches it to second_half. * The result is the modified first_half in correct order attached to * the second_half modified in reversed order.*)gray_next_level(k+1)(List.rev_appendfirst_halfsecond_half)elselingray_next_level1["0";"1"];;valgray:int->stringlist=<fun>Huffman Code
First of all, consult a good book on discrete mathematics or algorithmsfor a detailed description of Huffman codes (you can start with theWikipedia page)!
We consider a set of symbols with their frequencies.For example, if the alphabet is"a",...,"f"(represented as the positions 0,...5) andrespective frequencies are 45, 13, 12, 16, 9, 5:
#letfs=[("a",45);("b",13);("c",12);("d",16);("e",9);("f",5)];;valfs:(string*int)list=[("a",45);("b",13);("c",12);("d",16);("e",9);("f",5)]Our objective is to construct theHuffman codec word for all symbolss. In our example, the result couldbehs = [("a", "0"); ("b", "101"); ("c", "100"); ("d", "111"); ("e", "1101"); ("f", "1100")](orhs = [("a", "1");...]). The task shall be performed by the functionhuffman defined as follows:huffman(fs) returns the Huffman codetable for the frequency tablefs
#huffmanfs;;-:(string*string)list=[("a","0");("c","100");("b","101");("f","1100");("e","1101");("d","111")]#(* Simple priority queue where the priorities are integers 0..100. The node with the lowest probability comes first.*)modulePq=structtype'at={data:'alistarray;mutablefirst:int}letmake()={data=Array.make101[];first=101}letaddqpx=q.data.(p)<-x::q.data.(p);q.first<-minpq.firstletget_minq=ifq.first=101thenNoneelsematchq.data.(q.first)with|[]->assertfalse|x::tl->letp=q.firstinq.data.(q.first)<-tl;whileq.first<101&&q.data.(q.first)=[]doq.first<-q.first+1done;Some(p,x)endtypetree=|Leafofstring|Nodeoftree*treeletrechuffman_treeq=matchPq.get_minq,Pq.get_minqwith|Some(p1,t1),Some(p2,t2)->Pq.addq(p1+p2)(Node(t1,t2));huffman_treeq|Some(_,t),None|None,Some(_,t)->t|None,None->assertfalse(* Build the prefix-free binary code from the tree*)letrecprefixes_of_treeprefix=function|Leafs->[(s,prefix)]|Node(t0,t1)->prefixes_of_tree(prefix^"0")t0@prefixes_of_tree(prefix^"1")t1lethuffmanfs=ifList.fold_left(funs(_,p)->s+p)0fs<>100thenfailwith"huffman: sum of weights must be 100";letq=Pq.make()inList.iter(fun(s,f)->Pq.addqf(Leafs))fs;prefixes_of_tree""(huffman_treeq);;modulePq:sigtype'at = { data : 'a list array;mutable first : int; }valmake : unit -> 'a tvaladd : 'a t -> int -> 'a -> unitvalget_min : 'a t -> (int * 'a) optionendtypetree=Leafofstring|Nodeoftree*treevalhuffman_tree:treePq.t->tree=<fun>valprefixes_of_tree:string->tree->(string*string)list=<fun>valhuffman:(string*int)list->(string*string)list=<fun>Construct Completely Balanced Binary Trees
A binary tree is either empty or it is composed of a root element andtwo successors, which are binary trees themselves.
In OCaml, one can define a new typebinary_tree that carries anarbitrary value of type'a (thus is polymorphic) at each node.
#type'abinary_tree=|Empty|Nodeof'a*'abinary_tree*'abinary_tree;;type'abinary_tree=Empty|Nodeof'a*'abinary_tree*'abinary_treeAn example of tree carryingchar data is:
#letexample_tree=Node('a',Node('b',Node('d',Empty,Empty),Node('e',Empty,Empty)),Node('c',Empty,Node('f',Node('g',Empty,Empty),Empty)));;valexample_tree:charbinary_tree=Node('a',Node('b',Node('d',Empty,Empty),Node('e',Empty,Empty)),Node('c',Empty,Node('f',Node('g',Empty,Empty),Empty)))In OCaml, the strict type disciplineguarantees that, if you get avalue of typebinary_tree, then it must have been created with the twoconstructorsEmpty andNode.
In a completely balanced binary tree, the following property holds forevery node: The number of nodes in its left subtree and the number ofnodes in its right subtree are almost equal, which means theirdifference is not greater than one.
Write a functioncbal_tree to construct completely balanced binarytrees for a given number of nodes. The function should generate allsolutions via backtracking. Put the letter'x' as information into allnodes of the tree.
#cbal_tree4;;-:charbinary_tree/2list=[Node('x',Node('x',Empty,Empty),Node('x',Node('x',Empty,Empty),Empty));Node('x',Node('x',Empty,Empty),Node('x',Empty,Node('x',Empty,Empty)));Node('x',Node('x',Node('x',Empty,Empty),Empty),Node('x',Empty,Empty));Node('x',Node('x',Empty,Node('x',Empty,Empty)),Node('x',Empty,Empty))]#(* Build all trees with given [left] and [right] subtrees.*)letadd_trees_withleftrightall=letadd_right_treealll=List.fold_left(funar->Node('x',l,r)::a)allrightinList.fold_leftadd_right_treeallleftletreccbal_treen=ifn=0then[Empty]elseifnmod2=1thenlett=cbal_tree(n/2)inadd_trees_withtt[]else(* n even: n-1 nodes for the left & right subtrees altogether.*)lett1=cbal_tree(n/2-1)inlett2=cbal_tree(n/2)inadd_trees_witht1t2(add_trees_witht2t1[]);;valadd_trees_with:charbinary_treelist->charbinary_treelist->charbinary_treelist->charbinary_treelist=<fun>valcbal_tree:int->charbinary_treelist=<fun>Symmetric Binary Trees
Let us call a binary tree symmetric if you can draw a vertical linethrough the root node and then the right subtree is the mirror image ofthe left subtree. Write a functionis_symmetric to check whether agiven binary tree is symmetric.
Hint: Write a functionis_mirror first to check whether one treeis the mirror image of another. We are only interested in thestructure, not in the contents of the nodes.
#letrecis_mirrort1t2=matcht1,t2with|Empty,Empty->true|Node(_,l1,r1),Node(_,l2,r2)->is_mirrorl1r2&&is_mirrorr1l2|_->falseletis_symmetric=function|Empty->true|Node(_,l,r)->is_mirrorlr;;valis_mirror:'abinary_tree->'bbinary_tree->bool=<fun>valis_symmetric:'abinary_tree->bool=<fun>Binary Search Trees (Dictionaries)
Construct abinary search treefrom a list of integer numbers.
#construct[3;2;5;7;1];;-:intbinary_tree=Node(3,Node(2,Node(1,Empty,Empty),Empty),Node(5,Empty,Node(7,Empty,Empty)))Then use this function to test the solution of the previous problem.
#is_symmetric(construct[5;3;18;1;4;12;21]);;-:bool=true#not(is_symmetric(construct[3;2;5;7;4]));;-:bool=true#letrecinserttreex=matchtreewith|Empty->Node(x,Empty,Empty)|Node(y,l,r)->ifx=ythentreeelseifx<ythenNode(y,insertlx,r)elseNode(y,l,insertrx)letconstructl=List.fold_leftinsertEmptyl;;valinsert:'abinary_tree->'a->'abinary_tree=<fun>valconstruct:'alist->'abinary_tree=<fun>Generate-and-Test Paradigm
Apply the generate-and-test paradigm to construct all symmetric,completely balanced binary trees with a given number of nodes.
#sym_cbal_trees5;;-:charbinary_treelist=[Node('x',Node('x',Node('x',Empty,Empty),Empty),Node('x',Empty,Node('x',Empty,Empty)));Node('x',Node('x',Empty,Node('x',Empty,Empty)),Node('x',Node('x',Empty,Empty),Empty))]How many such trees are there with 57 nodes? Investigate about how manysolutions there are for a given number of nodes? What if the number iseven? Write an appropriate function.
#List.length(sym_cbal_trees57);;-:int=256#letsym_cbal_treesn=List.filteris_symmetric(cbal_treen);;valsym_cbal_trees:int->charbinary_treelist=<fun>Construct Height-Balanced Binary Trees
In a height-balanced binary tree, the following property holds for everynode: The height of its left subtree and the height of its right subtreeare almost equal, which means their difference is not greater than one.
Write a functionhbal_tree to construct height-balanced binary treesfor a given height. The function should generate all solutions viabacktracking. Put the letter'x' as information into all nodes of thetree.
#lett=hbal_tree3;;valt:charbinary_treelist=[Node('x',Node('x',Empty,Node('x',Empty,Empty)),Node('x',Empty,Node('x',Empty,Empty)));Node('x',Node('x',Empty,Node('x',Empty,Empty)),Node('x',Node('x',Empty,Empty),Empty));Node('x',Node('x',Empty,Node('x',Empty,Empty)),Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)));Node('x',Node('x',Node('x',Empty,Empty),Empty),Node('x',Empty,Node('x',Empty,Empty)));Node('x',Node('x',Node('x',Empty,Empty),Empty),Node('x',Node('x',Empty,Empty),Empty));Node('x',Node('x',Node('x',Empty,Empty),Empty),Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)));Node('x',Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)),Node('x',Empty,Node('x',Empty,Empty)));Node('x',Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)),Node('x',Node('x',Empty,Empty),Empty));Node('x',Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)),Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)));Node('x',Node('x',Empty,Node('x',Empty,Empty)),Node('x',Empty,Empty));Node('x',Node('x',Node('x',Empty,Empty),Empty),Node('x',Empty,Empty));Node('x',Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)),Node('x',Empty,Empty));Node('x',Node('x',Empty,Empty),Node('x',Empty,Node('x',Empty,Empty)));Node('x',Node('x',Empty,Empty),Node('x',Node('x',Empty,Empty),Empty));Node('x',Node('x',Empty,Empty),Node('x',Node('x',Empty,Empty),Node('x',Empty,Empty)))]The functionadd_trees_with is defined in the solution ofConstruct completely balanced binary trees.
#letrechbal_treen=ifn=0then[Empty]elseifn=1then[Node('x',Empty,Empty)]else(* [add_trees_with left right trees] is defined in a question above.*)lett1=hbal_tree(n-1)andt2=hbal_tree(n-2)inadd_trees_witht1t1(add_trees_witht1t2(add_trees_witht2t1[]));;valhbal_tree:int->charbinary_treelist=<fun>Construct Height-Balanced Binary Trees With a Given Number of Nodes
Consider a height-balanced binary tree of heighth. What is themaximum number of nodes it can contain? Clearly,max_nodes = 2h - 1.
#letmax_nodesh=1lslh-1;;valmax_nodes:int->int=<fun>Minimum of nodes
However, what is the minimum number min_nodes? This question is moredifficult. Try to find a recursive statement and turn it into a functionmin_nodes defined as follows:min_nodes h returns the minimum numberof nodes in a height-balanced binary tree of heighth.
Minimum height
On the other hand, we might ask: what are the minimum (resp. maximum)height H aheight-balanced binary tree with N nodes can have?min_height (resp.max_height n) returnsthe minimum (resp. maximum) height of a height-balanced binary treewithn nodes.
Constructing trees
Now, we can attack the main problem: construct all the height-balancedbinary trees with a given number of nodes.hbal_tree_nodes n returns alist of all height-balanced binary tree withn nodes.
Find out how many height-balanced trees exist forn = 15.
#List.length(hbal_tree_nodes15);;-:int=1553Minimum of nodes
The following solution comes directly from translating the question.
#letrecmin_nodesh=ifh<=0then0elseifh=1then1elsemin_nodes(h-1)+min_nodes(h-2)+1;;valmin_nodes:int->int=<fun>It is not the more efficient one however. One should use the lasttwo values as the state to avoid the double recursion.
#letrecmin_nodes_loopm0m1h=ifh<=1thenm1elsemin_nodes_loopm1(m1+m0+1)(h-1)letmin_nodesh=ifh<=0then0elsemin_nodes_loop01h;;valmin_nodes_loop:int->int->int->int=<fun>valmin_nodes:int->int=<fun>It is not difficult to show thatmin_nodes h = Fh+2 - 1,where (Fn) is theFibonacci sequence.
Minimum height
Inverting the formula max_nodes = 2h - 1, one directlyfind that Hₘᵢₙ(n) = ⌈log₂(n+1)⌉ which is readily implemented:
#letmin_heightn=int_of_float(ceil(log(float(n+1))/.log2.));;valmin_height:int->int=<fun>Let us give a proof that the formula for Hₘᵢₙ is valid. First, if h=min_height n, there exists a height-balanced tree of height hwith n nodes. Thus 2ʰ - 1 =max_nodes h ≥ n i.e., h ≥ log₂(n+1).To establish equality for Hₘᵢₙ(n), one has to show that, for any n,there exists a height-balanced tree with height Hₘᵢₙ(n). This isdue to the relation Hₘᵢₙ(n) = 1 + Hₘᵢₙ(n/2) where n/2 is the integerdivision. For n odd, this is readily proved — so one can build atree with a top node and two sub-trees with n/2 nodes of heightHₘᵢₙ(n) - 1. For n even, the same proof works if one first remarksthat, in that case, ⌈log₂(n+2)⌉ = ⌈log₂(n+1)⌉ — use log₂(n+1) ≤ h ∈ℕ ⇔ 2ʰ ≥ n + 1 and the fact that 2ʰ is even for that. This allowsto have a sub-tree with n/2 nodes. For the other sub-tree withn/2-1 nodes, one has to establish that Hₘᵢₙ(n/2-1) ≥ Hₘᵢₙ(n) - 2which is easy because, if h = Hₘᵢₙ(n/2-1), then h+2 ≥ log₂(2n) ≥log₂(n+1).
The above function is not the best one however. Indeed, not every64 bits integer can be represented exactly as a floating pointnumber. Here is one that only uses integer operations:
#letrecceil_log2_looplogplus1n=ifn=1thenifplus1thenlog+1elselogelseceil_log2_loop(log+1)(plus1||nland1<>0)(n/2)letceil_log2n=ceil_log2_loop0falsen;;valceil_log2_loop:int->bool->int->int=<fun>valceil_log2:int->int=<fun>This algorithm is still not the fastest however. See for exampletheHacker's Delight, section 5-3(and 11-4).
Following the same idea as above, if h =max_height n, then oneeasily deduces thatmin_nodes h ≤ n <min_nodes(h+1). Thisyields the following code:
#letrecmax_height_searchhn=ifmin_nodesh<=nthenmax_height_search(h+1)nelseh-1letmax_heightn=max_height_search0n;;valmax_height_search:int->int->int=<fun>valmax_height:int->int=<fun>Of course, sincemin_nodes is computed recursively, there is noneed to recompute everything to go frommin_nodes h tomin_nodes(h+1):
#letrecmax_height_searchhm_hm_h1n=ifm_h<=nthenmax_height_search(h+1)m_h1(m_h1+m_h+1)nelseh-1letmax_heightn=max_height_search001n;;valmax_height_search:int->int->int->int->int=<fun>valmax_height:int->int=<fun>Constructing trees
First, we define some convenience functionsfold_range that foldsa functionf on the rangen0...n1 i.e., it computesf (... f (f (f init n0) (n0+1)) (n0+2) ...) n1. You can think itas performing the assignmentinit ← f init n forn = n0,..., n1except that there is no mutable variable in the code.
#letrecfold_range~f ~initn0n1=ifn0>n1theninitelsefold_range ~f ~init:(finitn0)(n0+1)n1;;valfold_range:f:('a->int->'a)->init:'a->int->int->'a=<fun>When constructing trees, there is an obvious symmetry: if one swapsthe left and right sub-trees of a balanced tree, we still have abalanced tree. The following function returns all trees intreestogether with their permutation.
#letrecadd_swap_left_righttrees=List.fold_left(funan->matchnwith|Node(v,t1,t2)->Node(v,t2,t1)::a|Empty->a)treestrees;;valadd_swap_left_right:'abinary_treelist->'abinary_treelist=<fun>Finally we generate all trees recursively, using a priori the boundscomputed above. It could be further optimized but our aim is tostraightforwardly express the idea.
#letrechbal_tree_nodes_heighthn=assert(min_nodesh<=n&&n<=max_nodesh);ifh=0then[Empty]elseletacc=add_hbal_tree_node[](h-1)(h-2)ninletacc=add_swap_left_rightaccinadd_hbal_tree_nodeacc(h-1)(h-1)nandadd_hbal_tree_nodelh1h2n=letmin_n1=max(min_nodesh1)(n-1-max_nodesh2)inletmax_n1=min(max_nodesh1)(n-1-min_nodesh2)infold_rangemin_n1max_n1 ~init:l ~f:(funln1->lett1=hbal_tree_nodes_heighth1n1inlett2=hbal_tree_nodes_heighth2(n-1-n1)inList.fold_left(funlt1->List.fold_left(funlt2->Node('x',t1,t2)::l)lt2)lt1)lethbal_tree_nodesn=fold_range(min_heightn)(max_heightn) ~init:[] ~f:(funlh->List.rev_append(hbal_tree_nodes_heighthn)l);;valhbal_tree_nodes_height:int->int->charbinary_treelist=<fun>valadd_hbal_tree_node:charbinary_treelist->int->int->int->charbinary_treelist=<fun>valhbal_tree_nodes:int->charbinary_treelist=<fun>Count the Leaves of a Binary Tree
A leaf is a node with no successors. Write a functioncount_leaves tocount them.
#count_leavesEmpty;;-:int=0#letreccount_leaves=function|Empty->0|Node(_,Empty,Empty)->1|Node(_,l,r)->count_leavesl+count_leavesr;;valcount_leaves:'abinary_tree->int=<fun>Collect the Leaves of a Binary Tree in a List
A leaf is a node with no successors. Write a functionleaves tocollect them in a list.
#leavesEmpty;;-:'alist=[]#(* Having an accumulator acc prevents using inefficient List.append. * Every Leaf will be pushed directly into accumulator. * Not tail-recursive, but that is no problem since we have a binary tree and * and stack depth is logarithmic.*)letleavest=letrecleaves_auxtacc=matchtwith|Empty->acc|Node(x,Empty,Empty)->x::acc|Node(x,l,r)->leaves_auxl(leaves_auxracc)inleaves_auxt[];;valleaves:'abinary_tree->'alist=<fun>Collect the Internal Nodes of a Binary Tree in a List
An internal node of a binary tree has either one or two non-emptysuccessors. Write a functioninternals to collect them in a list.
#internals(Node('a',Empty,Empty));;-:charlist=[]#(* Having an accumulator acc prevents using inefficient List.append. * Every internal node will be pushed directly into accumulator. * Not tail-recursive, but that is no problem since we have a binary tree and * and stack depth is logarithmic.*)letinternalst=letrecinternals_auxtacc=matchtwith|Empty->acc|Node(x,Empty,Empty)->acc|Node(x,l,r)->internals_auxl(x::internals_auxracc)ininternals_auxt[];;valinternals:'abinary_tree->'alist=<fun>Collect the Nodes at a Given Level in a List
A node of a binary tree is at level N if the path from the root to thenode has length N-1. The root node is at level 1. Write a functionat_level t l to collect all nodes of the treet at levell in alist.
#letexample_tree=Node('a',Node('b',Node('d',Empty,Empty),Node('e',Empty,Empty)),Node('c',Empty,Node('f',Node('g',Empty,Empty),Empty)));;valexample_tree:charbinary_tree=Node('a',Node('b',Node('d',Empty,Empty),Node('e',Empty,Empty)),Node('c',Empty,Node('f',Node('g',Empty,Empty),Empty)))#at_levelexample_tree2;;-:charlist=['b';'c']Usingat_level it is easy to construct a functionlevelorder whichcreates the level-order sequence of the nodes. However, there are moreefficient ways to do that.
#(* Having an accumulator acc prevents using inefficient List.append. * Every node at level N will be pushed directly into accumulator. * Not tail-recursive, but that is no problem since we have a binary tree and * and stack depth is logarithmic.*)letat_leveltlevel=letrecat_level_auxtacccounter=matchtwith|Empty->acc|Node(x,l,r)->ifcounter=levelthenx::accelseat_level_auxl(at_level_auxracc(counter+1))(counter+1)inat_level_auxt[]1;;valat_level:'abinary_tree->int->'alist=<fun>Construct a Complete Binary Tree
Acomplete binary tree with height H is defined as follows: The levels1,2,3,...,H-1 contain the maximum number of nodes (i.e 2i-1at the level i, note that we start counting the levels from 1 at theroot). In level H, which may contain less than the maximum possiblenumber of nodes, all the nodes are "left-adjusted". This means that in alevelorder tree traversal all internal nodes come first, the leaves comesecond, and empty successors (the nil's which are not really nodes!)come last.
Particularly, complete binary trees are used as data structures (oraddressing schemes) for heaps.
We can assign an address number to each node in a complete binary treeby enumerating the nodes in levelorder, starting at the root withnumber 1. In doing so, we realize that for every node X with address Athe following property holds: The address of X's left and rightsuccessors are 2*A and 2*A+1, respectively, supposed the successors doexist. This fact can be used to elegantly construct a complete binarytree structure. Write a functionis_complete_binary_tree with thefollowing specification:is_complete_binary_tree n t returnstrueifft is a complete binary tree withn nodes.
#complete_binary_tree[1;2;3;4;5;6];;-:intbinary_tree=Node(1,Node(2,Node(4,Empty,Empty),Node(5,Empty,Empty)),Node(3,Node(6,Empty,Empty),Empty))#letrecsplit_nlstaccn=match(n,lst)with|(0,_)->(List.revacc,lst)|(_,[])->(List.revacc,[])|(_,h::t)->split_nt(h::acc)(n-1)letrecmyflattenpc=match(p,c)with|(p,[])->List.map(funx->Node(x,Empty,Empty))p|(x::t,[y])->Node(x,y,Empty)::myflattent[]|(ph::pt,x::y::t)->(Node(ph,x,y))::myflattenptt|_->invalid_arg"myflatten"letcomplete_binary_tree=function|[]->Empty|lst->letrecauxl=function|[]->[]|lst->letp,c=split_nlst[](1lsll)inmyflattenp(aux(l+1)c)inList.hd(aux0lst);;valsplit_n:'alist->'alist->int->'alist*'alist=<fun>valmyflatten:'alist->'abinary_treelist->'abinary_treelist=<fun>valcomplete_binary_tree:'alist->'abinary_tree=<fun>Layout a Binary Tree (1)
As a preparation for drawing the tree, a layout algorithm is required todetermine the position of each node in a rectangular grid. Severallayout methods are conceivable, one of them is shown in the illustration.
In this layout strategy, the position of a node v is obtained by thefollowing two rules:
- x(v) is equal to the position of the node v in theinordersequence;
- y(v) is equal to the depth of the nodev in the tree.
In order to store the position of the nodes, we will enrich the valueat each node with the position(x,y).
The tree pictured above is
#letexample_layout_tree=letleafx=Node(x,Empty,Empty)inNode('n',Node('k',Node('c',leaf'a',Node('h',Node('g',leaf'e',Empty),Empty)),leaf'm'),Node('u',Node('p',Empty,Node('s',leaf'q',Empty)),Empty));;valexample_layout_tree:charbinary_tree=Node('n',Node('k',Node('c',Node('a',Empty,Empty),Node('h',Node('g',Node('e',Empty,Empty),Empty),Empty)),Node('m',Empty,Empty)),Node('u',Node('p',Empty,Node('s',Node('q',Empty,Empty),Empty)),Empty))#layout_binary_tree_1example_layout_tree;;-:(char*int*int)binary_tree=Node(('n',8,1),Node(('k',6,2),Node(('c',2,3),Node(('a',1,4),Empty,Empty),Node(('h',5,4),Node(('g',4,5),Node(('e',3,6),Empty,Empty),Empty),Empty)),Node(('m',7,3),Empty,Empty)),Node(('u',12,2),Node(('p',9,3),Empty,Node(('s',11,4),Node(('q',10,5),Empty,Empty),Empty)),Empty))#letlayout_binary_tree_1t=letreclayoutdepthx_left=function(* This function returns a pair: the laid out tree and the first * free x location*)|Empty->(Empty,x_left)|Node(v,l,r)->let(l',l_x_max)=layout(depth+1)x_leftlinlet(r',r_x_max)=layout(depth+1)(l_x_max+1)rin(Node((v,l_x_max,depth),l',r'),r_x_max)infst(layout11t);;vallayout_binary_tree_1:'abinary_tree->('a*int*int)binary_tree=<fun>Layout a Binary Tree (2)
An alternative layout method is depicted in this illustration. Findout the rules and write the corresponding OCaml function.
Hint: On a given level, the horizontal distance betweenneighbouring nodes is constant.
The tree shown is
#letexample_layout_tree=letleafx=Node(x,Empty,Empty)inNode('n',Node('k',Node('c',leaf'a',Node('e',leaf'd',leaf'g')),leaf'm'),Node('u',Node('p',Empty,leaf'q'),Empty));;valexample_layout_tree:charbinary_tree=Node('n',Node('k',Node('c',Node('a',Empty,Empty),Node('e',Node('d',Empty,Empty),Node('g',Empty,Empty))),Node('m',Empty,Empty)),Node('u',Node('p',Empty,Node('q',Empty,Empty)),Empty))#layout_binary_tree_2example_layout_tree;;-:(char*int*int)binary_tree=Node(('n',15,1),Node(('k',7,2),Node(('c',3,3),Node(('a',1,4),Empty,Empty),Node(('e',5,4),Node(('d',4,5),Empty,Empty),Node(('g',6,5),Empty,Empty))),Node(('m',11,3),Empty,Empty)),Node(('u',23,2),Node(('p',19,3),Empty,Node(('q',21,4),Empty,Empty)),Empty))#letlayout_binary_tree_2t=letrecheight=function|Empty->0|Node(_,l,r)->1+max(heightl)(heightr)inlettree_height=heighttinletrecfind_missing_leftdepth=function|Empty->tree_height-depth|Node(_,l,_)->find_missing_left(depth+1)linlettranslate_dst=1lsl(find_missing_left0t)-1in(* remember than 1 lsl a = 2ᵃ*)letreclayoutdepthx_root=function|Empty->Empty|Node(x,l,r)->letspacing=1lsl(tree_height-depth-1)inletl'=layout(depth+1)(x_root-spacing)landr'=layout(depth+1)(x_root+spacing)rinNode((x,x_root,depth),l',r')inlayout1((1lsl(tree_height-1))-translate_dst)t;;vallayout_binary_tree_2:'abinary_tree->('a*int*int)binary_tree=<fun>Layout a Binary Tree (3)
Yet another layout strategy is shown in the above illustration. Themethod yields a very compact layout while maintaining a certain symmetryin every node. Find out the rules and write the correspondingpredicate.
Hint: Consider the horizontal distance between a node and its successornodes. How tight can you pack together two subtrees to construct thecombined binary tree? This is a difficult problem. Don't give up tooearly!
#letexample_layout_tree=letleafx=Node(x,Empty,Empty)inNode('n',Node('k',Node('c',leaf'a',Node('h',Node('g',leaf'e',Empty),Empty)),leaf'm'),Node('u',Node('p',Empty,Node('s',leaf'q',Empty)),Empty));;valexample_layout_tree:charbinary_tree=Node('n',Node('k',Node('c',Node('a',Empty,Empty),Node('h',Node('g',Node('e',Empty,Empty),Empty),Empty)),Node('m',Empty,Empty)),Node('u',Node('p',Empty,Node('s',Node('q',Empty,Empty),Empty)),Empty))#layout_binary_tree_3example_layout_tree;;-:(char*int*int)binary_tree=Node(('n',5,1),Node(('k',3,2),Node(('c',2,3),Node(('a',1,4),Empty,Empty),Node(('h',3,4),Node(('g',2,5),Node(('e',1,6),Empty,Empty),Empty),Empty)),Node(('m',4,3),Empty,Empty)),Node(('u',7,2),Node(('p',6,3),Empty,Node(('s',7,4),Node(('q',6,5),Empty,Empty),Empty)),Empty))Which layout do you like most?
In order to pack the tree tightly, the layout function will returnin addition to the layout of the tree the left and right profiles ofthe tree, that is lists of offsets relative to the position of theroot node of the tree.
#letlayout_binary_tree_3=letrectranslate_xd=function|Empty->Empty|Node((v,x,y),l,r)->Node((v,x+d,y),translate_xdl,translate_xdr)in(* Distance between a left subtree given by its right profile [lr] and a right subtree given by its left profile [rl].*)letrecdistlrrl=matchlr,rlwith|lrx::ltl,rlx::rtl->max(lrx-rlx)(distltlrtl)|[],_|_,[]->0inletrecmerge_profilesp1p2=matchp1,p2with|x1::tl1,_::tl2->x1::merge_profilestl1tl2|[],_->p2|_,[]->p1inletreclayoutdepth=function|Empty->([],Empty,[])|Node(v,l,r)->let(ll,l',lr)=layout(depth+1)linlet(rl,r',rr)=layout(depth+1)rinletd=1+distlrrl/2inletll=List.map(funx->x-d)llandlr=List.map(funx->x-d)lrandrl=List.map((+)d)rlandrr=List.map((+)d)rrin(0::merge_profilesllrl,Node((v,0,depth),translate_x(-d)l',translate_xdr'),0::merge_profilesrrlr)infunt->let(l,t',_)=layout1tinletx_min=List.fold_leftmin0lintranslate_x(1-x_min)t';;vallayout_binary_tree_3:'abinary_tree->('a*int*int)binary_tree=<fun>A String Representation of Binary Trees
Somebody represents binary trees as strings of the following type (seeexample):"a(b(d,e),c(,f(g,)))".
- Write an OCaml function
string_of_treewhich generates thisstring representation,if the tree is given as usual (asEmptyorNode(x,l,r)term).Then write a functiontree_of_stringwhich does this inverse;i.e. given the stringrepresentation, construct the tree in the usual form. Finally,combine the two predicates in a single functiontree_stringwhichcan be used in both directions. - Write the same predicate
tree_stringusing difference lists and asingle predicatetree_dlistwhich does the conversion between atree and a difference list in both directions.
For simplicity, suppose the information in the nodes is a single letterand there are no spaces in the string.
#letexample_layout_tree=letleafx=Node(x,Empty,Empty)in(Node('a',Node('b',leaf'd',leaf'e'),Node('c',Empty,Node('f',leaf'g',Empty))));;valexample_layout_tree:charbinary_tree=Node('a',Node('b',Node('d',Empty,Empty),Node('e',Empty,Empty)),Node('c',Empty,Node('f',Node('g',Empty,Empty),Empty)))A simple solution is:
#letrecstring_of_tree=function|Empty->""|Node(data,l,r)->letdata=String.make1datainmatchl,rwith|Empty,Empty->data|_,_->data^"("^(string_of_treel)^","^(string_of_treer)^")";;valstring_of_tree:charbinary_tree->string=<fun>One can also use a buffer to allocate a lot less memory:
#letrecbuffer_add_treebuf=function|Empty->()|Node(data,l,r)->Buffer.add_charbufdata;matchl,rwith|Empty,Empty->()|_,_->Buffer.add_charbuf'(';buffer_add_treebufl;Buffer.add_charbuf',';buffer_add_treebufr;Buffer.add_charbuf')'letstring_of_treet=letbuf=Buffer.create128inbuffer_add_treebuft;Buffer.contentsbuf;;valbuffer_add_tree:Buffer.t->charbinary_tree->unit=<fun>valstring_of_tree:charbinary_tree->string=<fun>For the reverse conversion, we assume that the string is well formedand do not deal with error reporting.
#lettree_of_string=letrecmakeofss=ifofs>=String.lengths||s.[ofs]=','||s.[ofs]=')'then(Empty,ofs)elseletv=s.[ofs]inifofs+1<String.lengths&&s.[ofs+1]='('thenletl,ofs=make(ofs+2)sin(* skip"v("*)letr,ofs=make(ofs+1)sin(* skip","*)(Node(v,l,r),ofs+1)(* skip")"*)else(Node(v,Empty,Empty),ofs+1)infuns->fst(make0s);;valtree_of_string:string->charbinary_tree=<fun>Preorder and Inorder Sequences of Binary Trees
We consider binary trees with nodes that are identified by singlelower-case letters, as in the example of the previous problem.
- Write functions
preorderandinorderthat construct thepreorderandinordersequence of a given binary tree, respectively. Theresults should be atoms, e.g. 'abdecfg' for the preorder sequence ofthe example in the previous problem. - Can you use
preorderfrom problem part 1 in the reversedirection; i.e. given a preorder sequence, construct a correspondingtree? If not, make the necessary arrangements. - If both the preorder sequence and the inorder sequence of the nodesof a binary tree are given, then the tree is determinedunambiguously. Write a function
pre_in_treethat does the job. - Solve problems 1 to 3 usingdifference lists.Cool! Use thefunction
timeit(defined in problem “Compare the two methods ofcalculating Euler's totient function.”) to compare thesolutions.
What happens if the same character appears in more than one node. Tryfor instancepre_in_tree "aba" "baa".
#preorder(Node(1,Node(2,Empty,Empty),Empty));;-:intlist=[1;2]We use lists to represent the result. Note thatpreorder andinorder can be made more efficient by avoiding list concatenations.
#letrecpreorder=function|Empty->[]|Node(v,l,r)->v::(preorderl@preorderr)letrecinorder=function|Empty->[]|Node(v,l,r)->inorderl@(v::inorderr)letrecsplit_pre_inpixaccpacci=match(p,i)with|[],[]->(List.revaccp,List.revacci),([],[])|h1::t1,h2::t2->ifx=h2then(List.tl(List.rev(h1::accp)),t1),(List.rev(List.tl(h2::acci)),t2)elsesplit_pre_int1t2x(h1::accp)(h2::acci)|_->assertfalseletrecpre_in_treepi=match(p,i)with|[],[]->Empty|(h1::t1),(h2::t2)->let(lp,rp),(li,ri)=split_pre_inpih1[][]inNode(h1,pre_in_treelpli,pre_in_treerpri)|_->invalid_arg"pre_in_tree";;valpreorder:'abinary_tree->'alist=<fun>valinorder:'abinary_tree->'alist=<fun>valsplit_pre_in:'alist->'alist->'a->'alist->'alist->('alist*'alist)*('alist*'alist)=<fun>valpre_in_tree:'alist->'alist->'abinary_tree=<fun>Solution usingdifference lists.
(* solution pending*)Dotstring Representation of Binary Trees
We consider again binary trees with nodes that are identified by singlelower-case letters, as in the example of problem “A stringrepresentation of binary trees”. Such a tree can berepresented by the preorder sequence of its nodes in which dots (.) areinserted where an empty subtree (nil) is encountered during the treetraversal. For example, the tree shown in problem “A stringrepresentation of binary trees” is represented as'abd..e..c.fg...'. First, try to establish a syntax (BNF or syntaxdiagrams) and then write a functiontree_dotstring which does theconversion in both directions. Use difference lists.
(* solution pending*)Tree Construction From a Node String
A multiway tree is composed of a root element and a (possibly empty)set of successors which are multiway trees themselves. A multiway treeis never empty. The set of successor trees is sometimes called aforest.
To represent multiway trees, we will use the following type which is adirect translation of the definition:
#type'amult_tree=Tof'a*'amult_treelist;;type'amult_tree=Tof'a*'amult_treelistThe example tree depicted opposite is therefore represented by thefollowing OCaml expression:
#T('a',[T('f',[T('g',[])]);T('c',[]);T('b',[T('d',[]);T('e',[])])]);;-:charmult_tree=T('a',[T('f',[T('g',[])]);T('c',[]);T('b',[T('d',[]);T('e',[])])])We suppose that the nodes of a multiway tree contain single characters.In the depth-first order sequence of its nodes, a special character^has been inserted whenever, during the tree traversal, the move is abacktrack to the previous level.
By this rule, the tree in the figure opposite is represented as:afg^^c^bd^e^^^.
Write functionsstring_of_tree : char mult_tree -> string to constructthe string representing the tree andtree_of_string : string -> char mult_tree to construct the tree whenthe string is given.
#lett=T('a',[T('f',[T('g',[])]);T('c',[]);T('b',[T('d',[]);T('e',[])])]);;valt:charmult_tree=T('a',[T('f',[T('g',[])]);T('c',[]);T('b',[T('d',[]);T('e',[])])])#(* We could build the final string by string concatenation but this is expensive due to the number of operations. We use a buffer instead.*)letrecadd_string_of_treebuf(T(c,sub))=Buffer.add_charbufc;List.iter(add_string_of_treebuf)sub;Buffer.add_charbuf'^';;valadd_string_of_tree:Buffer.t->charmult_tree->unit=<fun>#letstring_of_treet=letbuf=Buffer.create128inadd_string_of_treebuft;Buffer.contentsbuf;;valstring_of_tree:charmult_tree->string=<fun>#lettree_of_strings=letrecparse_nodechars=matchcharswith|[]->failwith"Unexpected end of input (expecting node)"|c::rest->let(children,rest')=parse_childrenrestin(T(c,children),rest')andparse_childrenchars=matchcharswith|[]->failwith"Unexpected end of input (expecting ^)"|'^'::rest->([],rest)|_->let(child,rest')=parse_nodecharsinlet(siblings,rest'')=parse_childrenrest'in(child::siblings,rest'')inlet(tree,remaining)=parse_node(List.of_seq(String.to_seqs))inmatchremainingwith|[]->tree|_->failwith"Extra input after tree";;valtree_of_string:string->charmult_tree=<fun>Count the Nodes of a Multiway Tree
#count_nodes(T('a',[T('f',[])]));;-:int=2#letreccount_nodes(T(_,sub))=List.fold_left(funnt->n+count_nodest)1sub;;valcount_nodes:'amult_tree->int=<fun>Determine the Internal Path Length of a Tree
We define the internal path length of a multiway tree as the total sumof the path lengths from the root to all nodes of the tree. By thisdefinition, the treet in the figure of the previous problem has aninternal path length of 9. Write a functionipl tree that returns theinternal path length oftree.
#iplt;;-:int=9#letrecipl_sublen(T(_,sub))=(* [len] is the distance of the current node to the root. Add the distance of all sub-nodes.*)List.fold_left(funsumt->sum+ipl_sub(len+1)t)lensubletiplt=ipl_sub0t;;valipl_sub:int->'amult_tree->int=<fun>valipl:'amult_tree->int=<fun>Construct the Bottom-Up Order Sequence of the Tree Nodes
Write a functionbottom_up t which constructs the bottom-up sequenceof the nodes of the multiway treet.
#bottom_up(T('a',[T('b',[])]));;-:charlist=['b';'a']#bottom_upt;;-:charlist=['g';'f';'c';'d';'e';'b';'a']#letrecprepend_bottom_up(T(c,sub))l=List.fold_right(funtl->prepend_bottom_uptl)sub(c::l)letbottom_upt=prepend_bottom_upt[];;valprepend_bottom_up:'amult_tree->'alist->'alist=<fun>valbottom_up:'amult_tree->'alist=<fun>Lisp-Like Tree Representation
There is a particular notation for multiway trees in Lisp. Thepicture shows how multiway tree structures are represented in Lisp.
Note that in the "lispy" notation a node with successors (children) inthe tree is always the first element in a list, followed by itschildren. The "lispy" representation of a multiway tree is a sequence ofatoms and parentheses '(' and ')'. This is very close to the way treesare represented in OCaml, except that no constructorT is used. Writea functionlispy : char mult_tree -> string that returns thelispy notation of the tree.
#lispy(T('a',[]));;-:string="a"#lispy(T('a',[T('b',[])]));;-:string="(a b)"#lispyt;;-:string="(a (f g) c (b d e))"#letrecadd_lispybuf=function|T(c,[])->Buffer.add_charbufc|T(c,sub)->Buffer.add_charbuf'(';Buffer.add_charbufc;List.iter(funt->Buffer.add_charbuf' ';add_lispybuft)sub;Buffer.add_charbuf')'letlispyt=letbuf=Buffer.create128inadd_lispybuft;Buffer.contentsbuf;;valadd_lispy:Buffer.t->charmult_tree->unit=<fun>vallispy:charmult_tree->string=<fun>Conversions
A graph is defined as a set of nodes and a set of edges, where eachedge is a pair of different nodes.
There are several ways to represent graphs in OCaml.
- One method is to list all edges, an edge being a pair of nodes. Inthis form, the graph depicted above is represented as thefollowing expression:
#[('h','g');('k','f');('f','b');('f','c');('c','b')];;-:(char*char)list=[('h','g');('k','f');('f','b');('f','c');('c','b')]We call thisedge-clause form. Obviously, isolated nodes cannotbe represented.
- Another method is to represent the whole graph as one data object.According to the definition of the graph as a pair of two sets(nodes and edges), we may use the following OCaml type:
#type'agraph_term={nodes:'alist;edges:('a*'a)list};;type'agraph_term={nodes:'alist;edges:('a*'a)list;}Then, the above example graph is represented by:
#letexample_graph={nodes=['b';'c';'d';'f';'g';'h';'k'];edges=[('h','g');('k','f');('f','b');('f','c');('c','b')]};;valexample_graph:chargraph_term={nodes=['b';'c';'d';'f';'g';'h';'k'];edges=[('h','g');('k','f');('f','b');('f','c');('c','b')]}We call thisgraph-term form. Note, that the lists are keptsorted, they are really sets, without duplicated elements. Each edgeappears only once in the edge list; i.e. an edge from a node x toanother node y is represented as(x, y), the couple(y, x) is notpresent. Thegraph-term form is our default representation. Youmay want to define a similar type using sets instead of lists.
- A third representation method is to associate with each node the setof nodes that are adjacent to that node. We call this theadjacency-list form. In our example:
letadjacency_example=['b',['c';'f'];'c',['b';'f'];'d',[];'f',['b';'c';'k'];'g',['h'];'h',['g'];'k',['f']];;valadjacency_example:(char*charlist)list=[('b',['c';'f']);('c',['b';'f']);('d',[]);('f',['b';'c';'k']);('g',['h']);('h',['g']);('k',['f'])]- The representations we introduced so far are well suited for automatedprocessing, but their syntax is not very user-friendly. Typing theterms by hand is cumbersome and error-prone. We can define a morecompact and "human-friendly" notation as follows: A graph (with charlabelled nodes) is represented by a string of atoms and terms of thetype X-Y. The atoms stand for isolated nodes, the X-Y terms describeedges. If an X appears as an endpoint of an edge, it isautomatically defined as a node. Our example could be written as:
#"b-c f-c g-h d f-b k-f h-g";;-:string="b-c f-c g-h d f-b k-f h-g"We call this thehuman-friendly form. As the example shows, thelist does not have to be sorted and may even contain the same edgemultiple times. Notice the isolated noded.
Write functions to convert between the different graph representations.With these functions, all representations are equivalent; i.e. for thefollowing problems you can always pick freely the most convenient form.This problem is not particularly difficult, but it's a lot of work todeal with all the special cases.
(* example pending*)Path From One Node to Another One
Write a functionpaths g a b that returns all acyclic pathp fromnodea to nodeb ≠ a in the graphg. The function should returnthe list of all paths via backtracking.
#letexample_graph={nodes=['b';'c';'d';'f';'g';'h';'k'];edges=[('h','g');('k','f');('f','b');('f','c');('c','b')]};;valexample_graph:chargraph_term={nodes=['b';'c';'d';'f';'g';'h';'k'];edges=[('h','g');('k','f');('f','b');('f','c');('c','b')]}#pathsexample_graph'f''b';;-:charlistlist=[['f';'c';'b'];['f';'b']]#(* The datastructures used here are far from the most efficient ones but allow for a straightforward implementation.*)(* Returns all neighbors satisfying the condition.*)letneighborsgacond=letedgel(b,c)=ifb=a&&condcthenc::lelseifc=a&&condbthenb::lelselinList.fold_leftedge[]g.edgesletreclist_pathgato_b=matchto_bwith|[]->assertfalse(* [to_b] contains the path to [b].*)|a'::_->ifa'=athen[to_b]elseletn=neighborsga'(func->not(List.memcto_b))inList.concat_map(func->list_pathga(c::to_b))nletpathsgab=assert(a<>b);list_pathga[b];;valneighbors:'agraph_term->'a->('a->bool)->'alist=<fun>vallist_path:'agraph_term->'a->'alist->'alistlist=<fun>valpaths:'agraph_term->'a->'a->'alistlist=<fun>Cycle From a Given Node
Write a functionscycle g a that returns a closed path (cycle)pstarting at a given nodea in the graphg. The predicate shouldreturn the list of all cycles via backtracking.
#letexample_graph={nodes=['b';'c';'d';'f';'g';'h';'k'];edges=[('h','g');('k','f');('f','b');('f','c');('c','b')]};;valexample_graph:chargraph_term={nodes=['b';'c';'d';'f';'g';'h';'k'];edges=[('h','g');('k','f');('f','b');('f','c');('c','b')]}#cyclesexample_graph'f';;-:charlistlist=[['f';'b';'c';'f'];['f';'c';'f'];['f';'c';'b';'f'];['f';'b';'f'];['f';'k';'f']]#letcyclesga=letn=neighborsga(fun_->true)inletp=List.concat_map(func->list_pathga[c])ninList.map(funp->p@[a])p;;valcycles:'agraph_term->'a->'alistlist=<fun>Construct All Spanning Trees
Write a functions_tree g to construct (by backtracking) allspanningtrees of a given graphg.With this predicate, find out how many spanning trees there are for thegraph depicted to the left. The data of this example graph can be foundin the test below. When you have a correct solution for thes_treefunction, use it to define two other useful functions:is_tree graphandis_connected Graph. Both are five-minutes tasks!
#letg={nodes=['a';'b';'c';'d';'e';'f';'g';'h'];edges=[('a','b');('a','d');('b','c');('b','e');('c','e');('d','e');('d','f');('d','g');('e','h');('f','g');('g','h')]};;valg:chargraph_term={nodes=['a';'b';'c';'d';'e';'f';'g';'h'];edges=[('a','b');('a','d');('b','c');('b','e');('c','e');('d','e');('d','f');('d','g');('e','h');('f','g');('g','h')]}(* solution pending*);;Construct the Minimal Spanning Tree
Write a functionms_tree graph to construct the minimal spanning treeof a given labelled graph. A labelled graph will be represented asfollows:
#type('a,'b)labeled_graph={nodes:'alist;labeled_edges:('a*'a*'b)list};;type('a,'b)labeled_graph={nodes:'alist;labeled_edges:('a*'a*'b)list;}(Beware that from now onnodes andedges mask the previous fields ofthe same name.)
Hint: Use thealgorithm of Prim.A small modification of the solution of P83 does the trick. The data of theexample graph to the right can be found below.
#letg={nodes=['a';'b';'c';'d';'e';'f';'g';'h'];labeled_edges=[('a','b',5);('a','d',3);('b','c',2);('b','e',4);('c','e',6);('d','e',7);('d','f',4);('d','g',3);('e','h',5);('f','g',4);('g','h',1)]};;valg:(char,int)labeled_graph={nodes=['a';'b';'c';'d';'e';'f';'g';'h'];labeled_edges=[('a','b',5);('a','d',3);('b','c',2);('b','e',4);('c','e',6);('d','e',7);('d','f',4);('d','g',3);('e','h',5);('f','g',4);('g','h',1)]}(* solution pending*);;Graph Isomorphism
Two graphs G1(N1,E1) and G2(N2,E2) are isomorphic if there is abijection f: N1 → N2 such that for any nodes X,Y of N1, X and Y areadjacent if and only if f(X) and f(Y) are adjacent.
Write a function that determines whether two graphs are isomorphic.
Hint: Use an open-ended list to represent the function f.
#letg={nodes=[1;2;3;4;5;6;7;8];edges=[(1,5);(1,6);(1,7);(2,5);(2,6);(2,8);(3,5);(3,7);(3,8);(4,6);(4,7);(4,8)]};;valg:intgraph_term={nodes=[1;2;3;4;5;6;7;8];edges=[(1,5);(1,6);(1,7);(2,5);(2,6);(2,8);(3,5);(3,7);(3,8);(4,6);(4,7);(4,8)]}(* solution pending*);;Node Degree and Graph Coloration
- Write a function
degree graph nodethat determines the degree of agiven node. - Write a function that generates a list of all nodes of a graphsorted according to decreasing degree.
- UseWelsh-Powell'salgorithmto paint the nodes of a graph in such a way that adjacent nodes havedifferent colors.
(* example pending*);;Depth-First Order Graph Traversal
Write a function that generates adepth-first order graph traversalsequence. The starting point should be specified, and the output shouldbe a list of nodes that are reachable from this starting point (indepth-first order).
Specifically, the graph will be provided by itsadjacency-list representationand you must create a moduleM with the following signature:
#moduletypeGRAPH=sigtypenode = chartypetvalof_adjacency : (node * node list) list -> tvaldfs_fold : t -> node -> ('a -> node -> 'a) -> 'a -> 'aend;;moduletypeGRAPH=sigtypenode = chartypetvalof_adjacency : (node * node list) list -> tvaldfs_fold : t -> node -> ('a -> node -> 'a) -> 'a -> 'aendwhereM.dfs_fold g n f a appliesf on the nodes of the graphg in depth first order, starting with noden.
#letg=M.of_adjacency['u',['v';'x'];'v',['y'];'w',['z';'y'];'x',['v'];'y',['x'];'z',['z'];];;valg:M.t=<abstr>In a depth-first search you fully explore the edges of the mostrecently discovered nodev before 'backtracking' to explore edgesleaving the node from whichv was discovered. To do a depth-firstsearch means keeping careful track of what vertices have been visitedand when.
We compute timestamps for each vertex discovered in the search. Adiscovered vertex has two timestamps associated with it : itsdiscovery time (in mapd) and its finishing time (in mapf) (avertex is finished when its adjacency list has been completelyexamined). These timestamps are often useful in graph algorithms andaid in reasoning about the behavior of depth-first search.
We color nodes during the search to help in the bookkeeping (mapcolor). All vertices of the graph are initiallyWhite. When avertex is discovered it is markedGray and when it is finished, itis markedBlack.
If vertexv is discovered in the adjacency list of previouslydiscovered nodeu, this fact is recorded in the predecessor subgraph(mappred).
#moduleM:GRAPH=structmoduleChar_map=Map.Make(Char)typenode=chartypet=(nodelist)Char_map.tletof_adjacencyl=List.fold_right(fun(x,y)->Char_map.addxy)lChar_map.emptytypecolors=White|Gray|Blacktype'astate={d:intChar_map.t;(*discovery time*)f:intChar_map.t;(*finishing time*)pred:charChar_map.t;(*predecessor*)color:colorsChar_map.t;(*vertex colors*)acc:'a;(*user specified type used by 'fold'*)}letdfs_foldgcfnacc=letrecdfs_visittu{d;f;pred;color;acc}=letedge(t,state)v=ifChar_map.findvstate.color=Whitethendfs_visittv{statewithpred=Char_map.addvustate.pred}else(t,state)inlett,{d;f;pred;color;acc}=lett=t+1inList.fold_leftedge(t,{d=Char_map.addutd;f;pred;color=Char_map.adduGraycolor;acc=fnaccu})(Char_map.findug)inlett=t+1int,{d;f=Char_map.addutf;pred;color=Char_map.adduBlackcolor;acc}inletv=List.fold_left(funk(x,_)->x::k)[](Char_map.bindingsg)inletinitial_state={d=Char_map.empty;f=Char_map.empty;pred=Char_map.empty;color=List.fold_right(funx->Char_map.addxWhite)vChar_map.empty;acc}in(snd(dfs_visit0cinitial_state)).accend;;moduleM:GRAPHConnected Components
Write a predicate that splits a graph into itsconnectedcomponents.
(* example pending*);;Bipartite Graphs
Write a predicate that finds out whether a given graph isbipartite.
(* example pending*);;Generate K-Regular Simple Graphs With N Nodes
In aK-regular graph allnodes have a degree of K; i.e. the number of edges incident in each nodeis K. How many (non-isomorphic!) 3-regular graphs with 6 nodes arethere?
See also thetable of results.
(* example pending*);;Eight Queens Problem
This is a classical problem in computer science. The objective is toplace eight queens on a chessboard so that no two queens are attackingeach other; i.e., no two queens are in the same row, the same column, oron the same diagonal.
Hint: Represent the positions of the queens as a list of numbers 1..N.Example:[4; 2; 7; 3; 6; 8; 5; 1] means that the queen in the first column isin row 4, the queen in the second column is in row 2, etc. Use thegenerate-and-test paradigm.
#queens_positions4;;-:intlistlist=[[3;1;4;2];[2;4;1;3]]This is a brute force algorithm enumerating all possible solutions.For a deeper analysis, look for example toWikipedia.
#letpossiblerowcolused_rowsusedD1usedD2=not(List.memrowused_rows||List.mem(row+col)usedD1||List.mem(row-col)usedD2)letqueens_positionsn=letrecauxrowcolused_rowsusedD1usedD2=ifcol>nthen[List.revused_rows]else(ifrow<nthenaux(row+1)colused_rowsusedD1usedD2else[])@(ifpossiblerowcolused_rowsusedD1usedD2thenaux1(col+1)(row::used_rows)(row+col::usedD1)(row-col::usedD2)else[])inaux11[][][];;valpossible:int->int->intlist->intlist->intlist->bool=<fun>valqueens_positions:int->intlistlist=<fun>Knight's Tour
Another famous problem is this one: How can a knight jump on an N×Nchessboard in such a way that it visits every square exactly once?
Hint: Represent the squares by pairs of their coordinates(x,y),where bothx andy are integers between 1 and N. Define the functionjump n (x,y) that returns all coordinates(u,v) to which aknight can jump from(x,y) to on an×n chessboard. And finally,represent the solution of our problem as a list knight positions (theknight's tour).
(* example pending*);;Von Koch's Conjecture
Several years ago I met a mathematician who was intrigued by a problemfor which he didn't know a solution. His name was Von Koch, and I don'tknow whether the problem has been solved since.
Anyway, the puzzle goes like this: Given a tree with N nodes (and henceN-1 edges). Find a way to enumerate the nodes from 1 to N and,accordingly, the edges from 1 to N-1 in such a way, that for each edge Kthe difference of its node numbers equals to K. The conjecture is thatthis is always possible.
For small trees the problem is easy to solve by hand. However, forlarger trees, and 14 is already very large, it is extremely difficult tofind a solution. And remember, we don't know for sure whether there isalways a solution!
Write a function that calculates a numbering scheme for a given tree.What is the solution for the larger tree pictured here?
(* example pending*);;An Arithmetic Puzzle
Given a list of integer numbers, find a correct way of insertingarithmetic signs (operators) such that the result is a correct equation.Example: With the list of numbers[2; 3; 5; 7; 11] we can form theequations 2 - 3 + 5 + 7 = 11 or 2 = (3 * 5 + 7) / 11 (and ten others!).
(* example pending*);;English Number Words
On financial documents, like cheques, numbers must sometimes be writtenin full words. Example: 175 must be written as one-seven-five. Write afunctionfull_words to print (non-negative) integer numbers in fullwords.
#full_words175;;-:string="one-seven-five"#letfull_words=letdigit=[|"zero";"one";"two";"three";"four";"five";"six";"seven";"eight";"nine"|]inletrecwordswn=ifn=0then(matchwwith[]->[digit.(0)]|_->w)elsewords(digit.(nmod10)::w)(n/10)infunn->String.concat"-"(words[]n);;valfull_words:int->string=<fun>Syntax Checker
In a certain programming language (Ada) identifiers are defined by thesyntax diagram (railroad chart) opposite. Transform the syntax diagraminto a system of syntax diagrams which do not contain loops; i.e. whichare purely recursive. Using these modified diagrams, write a functionidentifier : string -> bool that can check whether or not a givenstring is a legal identifier.
#identifier"this-is-a-long-identifier";;-:bool=true#letidentifier=letis_letterc='a'<=c&&c<='z'inletis_letter_or_digitc=is_letterc||('0'<=c&&c<='9')inletrecis_validsinot_after_dash=ifi<0thennot_after_dashelseifis_letter_or_digits.[i]thenis_valids(i-1)trueelseifs.[i]='-'&¬_after_dashthenis_valids(i-1)falseelsefalseinfuns->(letn=String.lengthsinn>0&&is_letters.[n-1]&&is_valids(n-2)true);;validentifier:string->bool=<fun>Sudoku
Sudoku puzzles go like this:
Problem statement Solution . . 4 | 8 . . | . 1 7 9 3 4 | 8 2 5 | 6 1 7 | | | | 6 7 . | 9 . . | . . . 6 7 2 | 9 1 4 | 8 5 3 | | | | 5 . 8 | . 3 . | . . 4 5 1 8 | 6 3 7 | 9 2 4 --------+---------+-------- --------+---------+-------- 3 . . | 7 4 . | 1 . . 3 2 5 | 7 4 8 | 1 6 9 | | | | . 6 9 | . . . | 7 8 . 4 6 9 | 1 5 3 | 7 8 2 | | | | . . 1 | . 6 9 | . . 5 7 8 1 | 2 6 9 | 4 3 5 --------+---------+-------- --------+---------+-------- 1 . . | . 8 . | 3 . 6 1 9 7 | 5 8 2 | 3 4 6 | | | | . . . | . . 6 | . 9 1 8 5 3 | 4 7 6 | 2 9 1 | | | | 2 4 . | . . 1 | 5 . . 2 4 6 | 3 9 1 | 5 7 8Every spot in the puzzle belongs to a (horizontal) row and a (vertical)column, as well as to one single 3x3 square (which we call "square" forshort). At the beginning, some of the spots carry a single-digit numberbetween 1 and 9. The problem is to fill the missing spots with digits insuch a way that every number between 1 and 9 appears exactly once ineach row, in each column, and in each square.
#(* The board representation is not imposed. Here"0" stands for"."*);;A simple way of resolving this is to use brute force.The idea is to start filling with available values in each case andtest if it works. When there is no available values, it means wemade a mistake so we go back to the last choice we made, and try adifferent choice.
#openPrintfmoduleBoard=structtypet=intarray(* 9×9, row-major representation. A value of 0 means undecided.*)letis_validc=c>=1letget(b:t)(x,y)=b.(x+y*9)letget_as_string(b:t)pos=leti=getbposinifis_validithenstring_of_intielse"."letwith_val(b:t)(x,y)v=letb=Array.copybinb.(x+y*9)<-v;bletof_listl:t=letb=Array.make810inList.iteri(funyr->List.iteri(funxe->b.(x+y*9)<-ife>=0&&e<=9theneelse0)r)l;bletprintb=fory=0to8doforx=0to8doprintf(ifx=0then"%s"elseifxmod3=0then" |%s"else"%s")(get_as_stringb(x,y))done;ify<8thenifymod3=2thenprintf"\n--------+---------+--------\n"elseprintf"\n | |\n"elseprintf"\n"doneletavailableb(x,y)=letavail=Array.make10trueinfori=0to8doavail.(getb(x,i))<-false;avail.(getb(i,y))<-false;done;letsq_x=x-xmod3andsq_y=y-ymod3inforx=sq_xtosq_x+2dofory=sq_ytosq_y+2doavail.(getb(x,y))<-false;done;done;letav=ref[]infori=1(* not 0*)to9doifavail.(i)thenav:=i::!avdone;!avletnext(x,y)=ifx<8then(x+1,y)else(0,y+1)(** Try to fill the undecided entries.*)letrecfillb((x,y)aspos)=ify>8thenSomeb(* filled all entries*)elseifis_valid(getbpos)thenfillb(nextpos)elsematchavailablebposwith|[]->None(* no solution*)|l->try_valuesbposlandtry_valuesbpos=function|v::l->(matchfill(with_valbposv)(nextpos)with|Some_asres->res|None->try_valuesbposl)|[]->Noneendletsudokub=matchBoard.fillb(0,0)with|Someb->b|None->failwith"sudoku: no solution";;moduleBoard:sigtypet = int arrayvalis_valid : int -> boolvalget : t -> int * int -> intvalget_as_string : t -> int * int -> stringvalwith_val : t -> int * int -> int -> int arrayvalof_list : int list list -> tvalprint : t -> unitvalavailable : t -> int * int -> int listvalnext : int * int -> int * intvalfill : t -> int * int -> t optionvaltry_values : t -> int * int -> int list -> t optionendvalsudoku:Board.t->Board.t=<fun>Nonograms
Around 1994, a certain kind of puzzles was very popular in England. The"Sunday Telegraph" newspaper wrote: "Nonograms are puzzles from Japanand are currently published each week only in The Sunday Telegraph.Simply use your logic and skill to complete the grid and reveal apicture or diagram." As an OCaml programmer, you are in a bettersituation: you can have your computer do the work!
The puzzle goes like this: Essentially, each row and column of arectangular bitmap is annotated with the respective lengths of itsdistinct strings of occupied cells. The person who solves the puzzlemust complete the bitmap given only these lengths.
Problem statement: Solution: |_|_|_|_|_|_|_|_| 3 |_|X|X|X|_|_|_|_| 3 |_|_|_|_|_|_|_|_| 2 1 |X|X|_|X|_|_|_|_| 2 1 |_|_|_|_|_|_|_|_| 3 2 |_|X|X|X|_|_|X|X| 3 2 |_|_|_|_|_|_|_|_| 2 2 |_|_|X|X|_|_|X|X| 2 2 |_|_|_|_|_|_|_|_| 6 |_|_|X|X|X|X|X|X| 6 |_|_|_|_|_|_|_|_| 1 5 |X|_|X|X|X|X|X|_| 1 5 |_|_|_|_|_|_|_|_| 6 |X|X|X|X|X|X|_|_| 6 |_|_|_|_|_|_|_|_| 1 |_|_|_|_|X|_|_|_| 1 |_|_|_|_|_|_|_|_| 2 |_|_|_|X|X|_|_|_| 2 1 3 1 7 5 3 4 3 1 3 1 7 5 3 4 3 2 1 5 1 2 1 5 1For the example above, the problem can be stated as the two lists[[3]; [2; 1]; [3; 2]; [2; 2]; [6]; [1; 5]; [6]; [1]; [2]] and[[1; 2]; [3; 1]; [1; 5]; [7; 1]; [5]; [3]; [4]; [3]] which give the "solid"lengths of the rows and columns, top-to-bottom and left-to-right,respectively. Published puzzles are larger than this example, e.g.25×20, and apparently always have unique solutions.
#solve[[3];[2;1];[3;2];[2;2];[6];[1;5];[6];[1];[2]][[1;2];[3;1];[1;5];[7;1];[5];[3];[4];[3]];;Brute force solution: construct boards trying all the fillpossibilities for the columns given the prescribed patterns for themand reject the solution if it does not satisfy the row patterns.
#typeelement=Empty|X(* ensure we do not miss cases in patterns*);;typeelement=Empty|XYou may want to look atmore efficient algorithmsand implement them so you can solve the following within reasonable time:
solve[[14];[1;1];[7;1];[3;3];[2;3;2];[2;3;2];[1;3;6;1;1];[1;8;2;1];[1;4;6;1];[1;3;2;5;1;1];[1;5;1];[2;2];[2;1;1;1;2];[6;5;3];[12]][[7];[2;2];[2;2];[2;1;1;1;1];[1;2;4;2];[1;1;4;2];[1;1;2;3];[1;1;3;2];[1;1;1;2;2;1];[1;1;5;1;2];[1;1;7;2];[1;6;3];[1;1;3;2];[1;4;3];[1;3;1];[1;2;2];[2;1;1;1;1];[2;2];[2;2];[7]]Crossword Puzzle
Given an empty (or almost empty) framework of a crossword puzzle and aset of words. The problem is to place the words into the framework.
The particular crossword puzzle is specified in a text file which firstlists the words (one word per line) in an arbitrary order. Then, afteran empty line, the crossword framework is defined. In this frameworkspecification, an empty character location is represented by a dot (.).In order to make the solution easier, character locations can alsocontain predefined character values. The puzzle above is defined in thefilep7_09a.dat,other examples arep7_09b.datandp7_09d.dat.There is also an example of a puzzle(p7_09c.dat)which does not have a solution.
Words are strings (character lists) of at least two characters. Ahorizontal or vertical sequence of character places in the crosswordpuzzle framework is called a site. Our problem is to find a compatibleway of placing words onto sites.
Hints:
- The problem is not easy. You will need some time to thoroughlyunderstand it. So, don't give up too early! And remember that theobjective is a clean solution, not just a quick-and-dirty hack!
- For efficiency reasons it is important, at least for larger puzzles,to sort the words and the sites in a particular order.
(* example pending*);;Never-Ending Sequences
Lists are finite, meaning they always contain a finite number of elements. Sequences maybe finite or infinite.
The goal of this exercise is to define a type'a stream which only containsinfinite sequences. Using this type, define the following functions:
valhd:'astream->'a(** Returns the first element of a stream*)valtl:'astream->'astream(** Removes the first element of a stream*)valtake:int->'astream->'alist(** [take n seq] returns the n first values of [seq]*)valunfold:('a->'b*'a)->'a->'bstream(** Similar to Seq.unfold*)valbang:'a->'astream(** [bang x] produces an infinitely repeating sequence of [x] values.*)valints:int->intstream(* Similar to Seq.ints*)valmap:('a->'b)->'astream->'bstream(** Similar to List.map and Seq.map*)valfilter:('a->bool)->'astream->'astream(** Similar to List.filter and Seq.filter*)valiter:('a->unit)->'astream->'b(** Similar to List.iter and Seq.iter*)valto_seq:'astream->'aSeq.t(** Translates an ['a stream] into an ['a Seq.t]*)valof_seq:'aSeq.t->'astream(** Translates an ['a Seq.t] into an ['a stream] @raise Failure if the input sequence is finite.*)Tip: Uselet ... = patterns.
type'acons=Consof'a*'astreamand'astream=unit->'aconslethd(seq:'astream)=let(Cons(x,_))=seq()inxlettl(seq:'astream)=let(Cons(_,seq))=seq()inseqletrectakenseq=ifn=0then[]elselet(Cons(x,seq))=seq()inx::take(n-1)seqletrecunfoldfx()=let(y,x)=fxinCons(y,unfoldfx)letbangx=unfold(funx->(x,x))xletintsx=unfold(funx->(x,x+1))xletrecmapfseq()=let(Cons(x,seq))=seq()inCons(fx,mapfseq)letrecfilterpseq()=let(Cons(x,seq))=seq()inletseq=filterpseqinifpxthenCons(x,seq)elseseq()letreciterfseq=let(Cons(x,seq))=seq()infx;iterfseqletto_seqseq=Seq.unfold(funseq->Some(hdseq,tlseq))seqletrecof_seqseq()=matchseq()with|Seq.Nil->failwith"Not a infinite sequence"|Seq.Cons(x,seq)->Cons(x,of_seqseq)Diagonal of a Sequence of Sequences
Write a functiondiag : 'a Seq.t Seq.t -> 'a Seq that returns thediagonalof a sequence of sequences. The returned sequence is formed as follows:The first element of the returned sequence is the first element of the firstsequence; the second element of the returned sequence is the second element ofthe second sequence; the third element of the returned sequence is the thirdelement of the third sequence; and so on.
letrecdiagseq_seq()=lethds,tls=Seq.filter_mapSeq.unconsseq_seq|>Seq.splitinlethd,tl=Seq.unconshds|>Option.mapfst,Seq.unconstls|>Option.mapsndinletd=Option.fold ~none:Seq.empty ~some:diagtlinOption.fold ~none:Fun.id ~some:Seq.conshdd()[8]ページ先頭