I would like to find out, how to write a function, that would accept two parameters i.e. a' and b' (that are functions), as well as a list of lists;
And then if the sum of elements in any list in the list of int-lists (containing integers I mean) is an odd number, it would perform an operation of multiplication - function a'
(mult. with the same integer -> x * x), over each element in that list.
Otherwise, in case if the sum of elements in any list in the list of int-lists is even, it would perform an operation of addition - function b'
(add. with the same integer -> x + x), over each of the elements in that list.
So, the call of the function with the input would as such be:
func a b [[1;3];[8;3]];;
... and then the output should look like this:
- : int list list = [[2; 6]; [64; 9]]
The sum of elements in the first list is even number, so the first list will be additioned
and the sum of elements in the second list is odd number, which means that the second list will be multiplied.
I've written this function in Ocaml as an exercise and I'm really struggling to understand this language; I'd like to know what I'm doing wrong...
Also, strategic help would be much appreciated! - that is, an explanation of how things
actually work here in Ocaml, although I'm not exactly a complete newbie to Ocaml, I'e already learned a lot about tail-recursive functions, it's just the exchange of parameters between functions that's bothering me.
OK, here's the code:
let a = List.map (List.fold_left ( + ) 0)
let b = List.map (List.fold_left ( * ) 0)
let rec func a b lists = if lists = [] then []
else if ((List.map (List.fold_left ( + ) 0)) mod 2 = 0) then List.map
(List.fold_left ( + ) 0)
else List.map (List.fold_left ( * ) 0)
(* Function call: *)
func (fun x -> x*x) (fun x -> x+x) [[1;3];[5;7]];;
You are dealing with lists of lists here. So you need to List.map the list of lists, and also List.map each individual list.
When you do List.map (List.fold_left ( + ) 0) you have partial application to two function:
For List.fold_left you give the function to be applied, and the initial element, and are left with a function that still takes a list.
For List.map the first argument (function to be applied) is given, and you end up with a function that would still take the list of lists: So at this point, it is still an unevaluated function. You can't do mod 2 with it, because you don't have an integer.
Your a and b defined at the top aren't actually used, because they will be shadowed by the function arguments in your func.
When you call func (fun x -> x*x) (fun x -> x+x) [[1;3];[5;7]];;, the a will be (fun x -> x*x), the b will be (fun x -> x+x) and your lists will be [[1;3];[5;7]].
Your func is not a recursive function, it does not call itself. The List.map you are using is not tail recursive, and the List.fold_left is.
See:
https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html#VALmap
https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html#VALfold_left
This might be useful for understanding tail recursion: https://www.cs.cornell.edu/courses/cs3110/2020sp/textbook/data/tail_recursion.html
I'd minimally change your code to this:
let func a b lists =
let is_even l = List.fold_left ( + ) 0 l mod 2 = 0 in
List.map (fun l -> if is_even l then List.map b l else List.map a l) lists
(* Function call: *)
let _ = func (fun x -> x*x) (fun x -> x+x) [[1;4];[5;7]]
It maps the list of lists, so l is a list. Then it checks if the sum of that list is even, and if so, applies the function b to each individual element, otherwise a.
EDIT:
If you wanted to make it tail-recursive, you can switch out the List.map with List.rev_map, then reverse the mapped list with List.rev.
I'm facing a syntax error in the code below:
let sum list =
let current_sum = List.hd list in
for i = 1 to List.length list - 1 do
let counter = List.nth list i
current_sum = current_sum + counter
done;;
The error that I'm facing is here
done;
^^^^
Error: Syntax error
The code is supposed to sum up the current values of the list at each iteration, for example
sum [1;2;3;4];;
- : int list = [1; 3; 6; 10]
So I think I'm going about this in the right direction, what I don't understand is why this error keeps popping up?
The keyword in is missing in the let counter statement.
Another error that will pop after : current_sum is immutable. You will have to change this.
Another way to achieve your sum : use List.fold function.
Putting in shape the comments below :
let sum_l l =
let (r,_) = List.fold_left
(fun (a_l, a_i) x -> ((a_i + x) :: a_l , a_i+x))
([],0) l in
List.rev r;;
You have simply forgotten the in keywork in your line 4.
However, OCaml is a functional language, and you're trying to use an imperative method here.
Even though it will work when you solve your syntax error, it is not the way you would do this in OCaml. For example, a function summing up the elements of a integer list can be done with the following:
let sum = List.fold_left (+) 0;;
or even
let sum = List.reduce ~f:(+);;
if you're using the Core library.
EDIT
After reading the comments under another answer, I've understood what you're really trying to do:
# sum [1;2;3;4];;
- : int list = [1; 3; 6; 10]
And here is a way to do so, using OCaml's functional features:
let sum l =
let sums =
List.fold_left (fun l x -> match l with
| [] -> [x]
| h::t -> (x+h)::l) [] l
in List.rev sums;;
The code is more complicated than just computing the sum itself, but it does the trick.
I am beginner level of the Haskell Language and I was trying to implement Insertion Sort function in Haskell in ghci environment.
here's my code.
prelude> let insert x [] = x:[]
insert :: t1 -> [t] -> [t1]
prelude> let insert x (y:ys) =
if x < y then x:y:ys else y : insert ys
insert :: Ord a => a -> [a] -> [a]
I tried
insert 1 []
the result was [1], It worked well.
and I tried
insert 1 ([2,3])
the result was [1,2,3], Still it works well.
(Actually, I don't know why I have to parse on second argument list.
but if I try insert 1 [2,3], it doesn't work.)
it worked well until this. but when I tried
insert 4 ([1,2,3])
It happened like this.
[1,2,3*** Exception: <interactive>:165:5-61: Non-exhaustive patterns in function
I don't why it did happen like this.please help me.
you are overwriting your first function let insert x [] = x:[] with another one (in your next let insert ... - this happens because you use let ... inside GHCi)
Instead you should create .hs file and load this into GHCi instead.
So fire up your favorite editor and insert this:
module MyInsertSort where
insert :: Ord a => a -> [a] -> [a]
insert x [] = x:[]
insert x (y:ys) = if x < y then x:y:ys else y : insert x ys
save it (I did as MyInsert.hs), start ghci and load it into it:
λ> :l MyInsert.hs
[1 of 1] Compiling MyInsertSort ( MyInsert.hs, interpreted )
Ok, modules loaded: MyInsertSort.
λ> insert 4 ([1,2,3])
[1,2,3,4]
λ> insert 1 ([2,3])
[1,2,3]
now it should work :D
remarks
you had a small error in your second line insert ys instead of insert x ys
Suppose I have the following matrix:
The matrix can be broken down into chunks such that each chunk must, for all rows, have the same number of columns where the value is marked true for that row.
For example, the following chunk is valid:
This means that rows do not have to be contiguous.
Columns do not have to be contiguous either, as the following is a valid chunk:
However, the following is invalid:
That said, what is an algorithm that can be used to select chunks such that the minimal number of chunks will be used when finding all the chunks?
Given the example, above, the proper solution is (items with the same color represent a valid chunk):
In the above example, three is the minimal number of chunks that this can be broken down into.
Note that the following is also a valid solution:
There's not a preference to the solutions, really, just to get the least number of chunks.
I thought of counting using adjacent cells, but that doesn't account for the fact that the column values don't have to be contiguous.
I believe the key lies in finding the chunks with the largest area given the constraints, removing those items, and then repeating.
Taking that approach, the solution is:
But how to traverse the matrix and find the largest area is eluding me.
Also note, that if you want to reshuffle the rows and/or columns during the operations, that's a valid operation (in order to find the largest area), but I'd imagine you can only do it after you remove the largest areas from the matrix (after one area is found and moving onto the next).
You are doing circuit minimization on a truth table. For 4x4 truth tables, you can use a K map. The Quine-McCluskey algorithm is a generalization that can handle larger truth tables.
Keep in mind the problem is NP-Hard, so depending on the size of your truth tables, this problem can quickly grow to a size that is intractable.
This problem is strongly related to Biclustering, for which there are many efficient algorithms (and freely available implementations). Usually you will have to specify the number K of clusters you expect to find; if you don't have a good idea what K should be, you can proceed by binary search on K.
In case the biclusters don't overlap, you are done, otherwise you need to do some geometry to cut them into "blocks".
The solution I propose is fairly straightforward, but very time consuming.
It can be decomposed in 4 major steps:
find all the existing patterns in the matrix,
find all the possible combinations of these patterns,
remove all the incomplete pattern sets,
scan the remaining list to get the set with the minimum number of elements
First of, the algorithm below works on either column or row major matrices. I chose column for the explanations, but you may swap it for rows at your convenience, as long as it remains consistent accross the whole process.
The sample code accompanying the answer is in OCaml, but doesn't use any specific feature of the language, so it should be easy to port to other ML dialects.
Step 1:
Each column can be seen as a bit vector. Observe that a pattern (what you call chunk in your question) can be constructed by intersecting (ie. and ing) all the columns, or all the rows composing it, or even a combinations. So the first step is really about producing all the combinations of rows and columns (the powerset of the matrix' rows and columns if you will), intersecting them at the same time, and filter out the duplicates.
We consider the following interface for a matrix datatype:
module type MATRIX = sig
type t
val w : int (* the width of the matrix *)
val h : int (* the height ........ *)
val get : t -> int -> int -> bool (* cell value getter *)
end
Now let's have a look at this step's code:
let clength = M.h
let rlength = M.w
(* the vector datatype used throughought the algorithm
operator on this type are in the module V *)
type vector = V.t
(* a pattern description and comparison operators *)
module Pattern = struct
type t = {
w : int; (* width of thd pattern *)
h : int; (* height of the pattern *)
rows : vector; (* which rows of the matrix are used *)
cols : vector; (* which columns... *)
}
let compare a b = Pervasives.compare a b
let equal a b = compare a b = 0
end
(* pattern set : let us store patterns without duplicates *)
module PS = Set.Make(Pattern)
(* a simple recursive loop on #f #k times *)
let rec fold f acc k =
if k < 0
then acc
else fold f (f acc k) (pred k)
(* extract a column/row of the given matrix *)
let cr_extract mget len =
fold (fun v j -> if mget j then V.set v j else v) (V.null len) (pred len)
let col_extract m i = cr_extract (fun j -> M.get m i j) clength
let row_extract m i = cr_extract (fun j -> M.get m j i) rlength
(* encode a single column as a pattern *)
let col_encode c i =
{ w = 1; h = count c; rows = V.set (V.null clength) i; cols = c }
let row_encode r i =
{ h = 1; w = count r; cols = V.set (V.null rlength) i; rows = r }
(* try to add a column to a pattern *)
let col_intersect p c i =
let col = V.l_and p.cols c in
let h = V.count col in
if h > 0
then
let row = V.set (V.copy p.rows) i in
Some {w = V.count row; h = h; rows = row; clos = col}
else None
let row_intersect p r i =
let row = V.l_and p.rows r in
let w = V.count row in
if w > 0
then
let col = V.set (V.copy p.cols) i in
Some { w = w; h = V.count col; rows = row; cols = col }
else None
let build_patterns m =
let bp k ps extract encode intersect =
let build (l,k) =
let c = extract m k in
let u = encode c k in
let fld p ps =
match intersect p c k with
None -> l
| Some npc -> PS.add npc ps
in
PS.fold fld (PS.add u q) q, succ k
in
fst (fold (fun res _ -> build res) (ps, 0) k)
in
let ps = bp (pred rlength) PS.empty col_extract col_encode col_intersect in
let ps = bp (pred clength) ps row_extract row_encode row_intersect in
PS.elements ps
The V module must comply with the following signature for the whole algorithm:
module type V = sig
type t
val null : int -> t (* the null vector, ie. with all entries equal to false *)
val copy : t -> t (* copy operator *)
val get : t -> int -> bool (* get the nth element *)
val set : t -> int -> t (* set the nth element to true *)
val l_and : t -> t -> t (* intersection operator, ie. logical and *)
val l_or : t -> t -> t (* logical or *)
val count : t -> int (* number of elements set to true *)
val equal : t -> t -> bool (* equality predicate *)
end
Step 2:
Combining the patterns can also be seen as a powerset construction, with some restrictions: A valid pattern set may only contain patterns which don't overlap. The later can be defined as true for two patterns if both contain at least one common matrix cell.
With the pattern data structure used above, the overlap predicate is quite simple:
let overlap p1 p2 =
let nullc = V.null h
and nullr = V.null w in
let o v1 v2 n = not (V.equal (V.l_and v1 v2) n) in
o p1.rows p2.rows nullr && o p1.cols p2.cols nullc
The cols and rows of the pattern record indicate which coordinates in the matrix are included in the pattern. Thus a logical and on both fields will tell us if the patterns overlap.
For including a pattern in a pattern set, we must ensure that it does not overlap with any pattern of the set.
type pset = {
n : int; (* number of patterns in the set *)
pats : pattern list;
}
let overlap sp p =
List.exists (fun x -> overlap x p) sp.pats
let scombine sp p =
if overlap sp p
then None
else Some {
n = sp.n + 1;
pats = p::sp.pats;
}
let build_pattern_sets l =
let pset l p =
let sp = { n = 1; pats = [p] } in
List.fold_left (fun l spx ->
match scombine spx p with
None -> l
| Some nsp -> nsp::l
) (sp::l) l
in List.fold_left pset [] l
This step produces a lot of sets, and thus is very memory and computation intensive. It's certainly the weak point of this solution, but I don't see yet how to reduce the fold.
Step 3:
A pattern set is incomplete if when rebuilding the matrix with it, we do not obtain the original one. So the process is rather simple.
let build_matrix ps w =
let add m p =
let rec add_col p i = function
| [] -> []
| c::cs ->
let c =
if V.get p.rows i
then V.l_or c p.cols
else c
in c::(add_col p (succ i) cs)
in add_col p 0 m
in
(* null matrix as a list of null vectors *)
let m = fold (fun l _ -> V.null clength::l) [] (pred rlength) in
List.fold_left add m ps.pats
let drop_incomplete_sets m l =
(* convert the matrix to a list of columns *)
let m' = fold (fun l k -> col_extract m k ::l) [] (pred rlength) in
let complete m sp =
let m' = build_matrix sp in
m = m'
in List.filter (fun x -> complete m' x) l
Step 4:
The last step is just selecting the set with the smallest number of elements:
let smallest_set l =
let smallest ps1 ps2 = if ps1.n < ps2.n then ps1 else ps2 in
match l with
| [] -> assert false (* there should be at least 1 solution *)
| h::t -> List.fold_left smallest h t
The whole computation is then just the chaining of each steps:
let compute m =
let (|>) f g = g f in
build_patterns m |> build_pattern_sets |> drop_incomplete_sets m |> smallest_set
Notes
The algorithm above constructs a powerset of a powerset, with some limited filtering. There isn't as far as I know a way to reduce the search (as mentioned in a comment, if this is a NP hard problem, there isn't any).
This algorithm checks all the possible solutions, and correctly returns an optimal one (tested with many matrices, including the one given in the problem description.
One quick remark regarding the heuristic you propose in your question:
it could be easily implemented using the first step, removing the largest pattern found, and recursing. That would yeld a solution much more rapidly than my algorithm. However, the solution found may not be optimal.
For instance, consider the following matrix:
.x...
.xxx
xxx.
...x.
The central 4 cell chunck is the largest which may be found, but the set using it would comprise 5 patterns in total.
.1...
.223
422.
...5.
Yet this solution uses only 4:
.1...
.122
334.
...4.
Update:
Link to the full code I wrote for this answer.
I have written a sudoku solver in Haskell. It goes through a list and when it finds '0' (an empty cell) it will get the numbers that could fit and try them:
import Data.List (group, (\\), sort)
import Data.Maybe (fromMaybe)
row :: Int -> [Int] -> [Int]
row y grid = foldl (\acc x -> (grid !! x):acc) [] [y*9 .. y*9+8]
where y' = y*9
column :: Int -> [Int] -> [Int]
column x grid = foldl (\acc n -> (grid !! n):acc) [] [x,x+9..80]
box :: Int -> Int -> [Int] -> [Int]
box x y grid = foldl (\acc n -> (grid !! n):acc) [] [x+y*9*3+y' | y' <- [0,9,18], x <- [x'..x'+2]]
where x' = x*3
isValid :: [Int] -> Bool
isValid grid = and [isValidRow, isValidCol, isValidBox]
where isValidRow = isValidDiv row
isValidCol = isValidDiv column
isValidBox = and $ foldl (\acc (x,y) -> isValidList (box x y grid):acc) [] [(x,y) | x <- [0..2], y <- [0..2]]
isValidDiv f = and $ foldl (\acc x -> isValidList (f x grid):acc) [] [0..8]
isValidList = all (\x -> length x <= 1) . tail . group . sort -- tail removes entries that are '0'
isComplete :: [Int] -> Bool
isComplete grid = length (filter (== 0) grid) == 0
solve :: Maybe [Int] -> Maybe [Int]
solve grid' = foldl f Nothing [0..80]
where grid = fromMaybe [] grid'
f acc x
| isValid grid = if isComplete grid then grid' else f' acc x
| otherwise = acc
f' acc x
| (grid !! x) == 0 = case guess x grid of
Nothing -> acc
Just x -> Just x
| otherwise = acc
guess :: Int -> [Int] -> Maybe [Int]
guess x grid
| length valid /= 0 = foldl f Nothing valid
| otherwise = Nothing
where valid = [1..9] \\ (row rowN grid ++ column colN grid ++ box (fst boxN) (snd boxN) grid) -- remove numbers already used in row/collumn/box
rowN = x `div` 9 -- e.g. 0/9=0 75/9=8
colN = x - (rowN * 9) -- e.g. 0-0=0 75-72=3
boxN = (colN `div` 3, rowN `div` 3)
before x = take x grid
after x = drop (x+1) grid
f acc y = case solve $ Just $ before x ++ [y] ++ after x of
Nothing -> acc
Just x -> Just x
For some puzzles this works, for example this one:
sudoku :: [Int]
sudoku = [5,3,0,6,7,8,0,1,2,
6,7,0,0,0,0,3,4,8,
0,0,8,0,0,0,5,0,7,
8,0,0,0,0,1,0,0,3,
4,2,6,0,0,3,7,9,0,
7,0,0,9,0,0,0,5,0,
9,0,0,5,0,7,0,0,0,
2,8,7,4,1,9,6,0,5,
3,0,0,2,8,0,1,0,0]
Took under a second, however this one:
sudoku :: [Int]
sudoku = [5,3,0,0,7,0,0,1,2,
6,7,0,0,0,0,3,4,8,
0,0,0,0,0,0,5,0,7,
8,0,0,0,0,1,0,0,3,
4,2,6,0,0,3,7,9,0,
7,0,0,9,0,0,0,5,0,
9,0,0,5,0,7,0,0,0,
2,8,7,4,1,9,6,0,5,
3,0,0,2,8,0,1,0,0]
I have not seen finish. I don't think this is a problem with the method, as it does return correct results.
Profiling showed that most of the time was spent in the "isValid" function. Is there something obviously inefficient/slow about that function?
The implementation is of course improvable, but that's not the problem. The problem is that for the second grid, the simple guess-and-check algorithm needs a lot of backtracking. Even if you speed up each of your functions 1000-fold, there will be grids where it still needs several times the age of the universe to find the (first, if the grid is not unique) solution.
You need a better algorithm to avoid that. A fairly efficient method to avoid such cases is to guess the square with the least number of possibilities first. That doesn't avoid all bad cases, but reduces them much.
One thing that you should also do is replace the length thing == 0 check with null thing. With the relatively short lists occurring here, the effect is limited, but in general it can be dramatic (and in general you should also not use length list <= 1, use null $ drop 1 list instead).
isValidList = all (\x -> length x <= 1) . tail . group . sort -- tail removes entries that are '0'
If the original list does not contain any zeros, tail will remove something else, perhaps a list of two ones. I'd replace tail . group. sort with group . sort . filter (/= 0).
I don't understand why isValidBox and isValidDiv use foldl as map appears to be adequate. Have I missed something / are they doing something terribly clever?