Find a key by having its value using Data.Map in Haskell - dictionary

I just started using Haskell some weeks ago and I lack of imagination to resolve a function in this situation.
So I am trying to find the predecessors of a vertex in a graph implemented in Haskell.
My graph :
-- | A directed graph
data Graph v = Graph
{ arcsMap :: Map v [v] -- A map associating a vertex with its successors
, labelMap :: Map v String -- The Graphviz label of each node
, styleMap :: Map v String -- The Graphviz style of each node
}
The function successors :
-- | Returns the successors of a vertex in a graph in ascending order
--
-- We say that `v` is a successor of `u` in a graph `G` if the arc `(u,v)`
-- belongs to `G`.
-- Note: Returns the empty list if the vertex does not belong to the graph.
successors :: Ord v => v -> Graph v -> [v]
successors v (Graph arcs _ _) = findWithDefault [] v arcs
And the function I'm currently trying to resolve :
-- | Returns the predecessors of a vertex in a graph in ascending order
--
-- We say that `u` is a predecessor of `v` in a graph `G` if the arc `(u,v)`
-- belongs to `G`.
-- Note: Returns the empty list if the vertex does not belong to the graph.
predecessors :: Ord v => v -> Graph v -> [v]
predecessors v (Graph arcs _ _) =
map (fst) (filter (\(x,[y]) -> elem v [y]) (assocs arcs) )
I need to find a way to get the keys (the vertices) by having the value (the successor) of those vertices. For example :
-- >>> predecessors 3 $ addArcs emptyGraph [(1,2),(2,3),(1,3)]
-- [1,2]
But when I run that line, I get Non-exhaustive patterns in lambda.
What is that and how can I fix it?
Thank you!
Edit : Never mind I corrected it but I still do not really understand how haha

Haskell's Maps and Hashmap don't have efficient key lookups. The best you can do is O(n), and you have to write it yourself. I have something like this in my projects, which we can edit a bit to find all keys:
lookupKey :: Eq v => v -> Map.Map k v -> [k]
lookupKey val = Map.foldrWithKey go [] where
go key value found =
if value == val
then key:found
else found
You might want to use strict folds if you use strict maps.

Related

How do I check if the path from a node to another has a depth equal to a given one in a graph in OCaml?

First of all, I'm sorry for how I wrote my question.
Anyway, I'm trying to write a function in OCaml that, given a graph, a max depth, a starting node, and another node, returns the list of the nodes that make the path but only if the depth of it is equal to the given one. However, I can't implement the depth part.
This is what I did:
let m = [(1, 2, "A"); (2, 3, "A");
(3, 1, "A"); (2, 4, "B");
(4, 5, "B"); (4, 6, "C");
(6, 3, "C"); (5, 7, "D");
(6, 7, "D")]
let rec vicini n = function
[] -> []
| (x, y, _)::rest ->
if x = n then y :: vicini n rest
else if y = n then x :: vicini n rest
else vicini n rest
exception NotFound
let raggiungi m maxc start goal =
let rec from_node visited n =
if List.mem n visited then raise NotFound
else if n = goal then [n]
else n :: from_list (n :: visited) (vicini n m)
and from_list visited = function
[] -> raise NotFound
| n::rest ->
try from_node visited n
with NotFound -> from_list visited rest
in start :: from_list [] (vicini start m)
I know I have to add another parameter that increases with every recursion and then check if its the same as the given one, but I don't know where
I am not going to solve your homework, but I will try to teach you how to use recursion.
In programming, especially functional programming, we use recursion to express iteration. In an iterative procedure, there are things that change with each step and things that remain the same on each step. An iteration is well-founded if it has an end, i.e., at some point in time, the thing that changes reaches its foundation and stops. The thing that changes on each step, is usually called an induction variable as the tribute to the mathematical induction. In mathematical induction, we take a complex construct and deconstruct it step by step. For example, consider how we induct over a list to understand its length,
let rec length xs = match xs with
| [] -> 0
| _ :: xs -> 1 + length xs
Since the list is defined inductively, i.e., a list is either an empty list [] or a pair of an element x and a list, x :: list called a cons. So to discover how many elements in the list we follow its recursive definition, and deconstruct it step by step until we reach the foundation, which is, in our case, the empty list.
In the example above, our inductive variable was the list and we didn't introduce any variable that will represent the length itself. We used the program stack to store the length of the list, which resulted in an algorithm that consumes memory equivalent to the size of the list to compute its length. Doesn't sound very efficient, so we can try to devise another version that will use a variable passed to the function, which will track the length of the list, let's call it cnt,
let rec length cnt xs = match xs with
| [] -> cnt
| _ :: xs -> length (cnt+1) xs
Notice, how on each step we deconstruct the list and increment the cnt variable. Here, call to the length (cnt+1) xs is the same as you would see in an English-language explanation of an algorithm that will state something like, increment cnt by one, set xs to the tail xs and goto step 1. The only difference with the imperative implementation is that we use arguments of a function and change them on each call, instead of changing them in place.
As the final example, let's devise a function that checks that there's a letter in the first n letters in the word, which is represented as a list of characters. In this function, we have two parameters, both are inductive (note that a natural number is also an inductive type that is defined much like a list, i.e., a number is zero or the successor of a number). Our recursion is also well-founded, in fact, it even has two foundations, the 0 length and the empty list, whatever comes first. It also has a parameter that doesn't change.
let rec has_letter_in_prefix letter length input =
length > 0 && match input with
| [] -> false
| char :: input ->
char = letter || has_letter_in_prefix letter (length-1) input
I hope that this will help you in understanding how to encode iterations with recursion.

Isabelle function to find the longest sequence of members of a relation

I have a relation R :: w => w => bool that is both transitive an irreflexive.
I have the axiom Ax1: "finite {x::w. True}". Therefore, for each x there is always a longest sequence of wn R ... R w2 R w1 R x.
I need a function F:: w => nat, that -for a given x - gives back the "lenght" of this sequence (or 0 if there is no y such that xRy). How would I go about building one in isabelle.
Also: Is Ax1 a good way to axiomatize the "finiteness of type w" or is there a better one?
First of all, a more idiomatic way of writing {x::w. True} is UNIV :: w set. I suggest writing finite (UNIV :: w set), or possibly using the finite type class, although that might make your theorem more difficult to apply because you need a finite instance for your type. I think it's not really necessary or helpful for your use case.
I then suggest the following approach:
Define an inductive predicate (using inductive) on lists of type w list stating that the first element is x and for each two successive list elements y and z, R y z holds, i.e. the list is an ascending chain w.r.t. R.
Show that any list that is such a chain must have distinct elements (cf. distinct :: 'a list ⇒ bool).
Show that there are finitely many distinct lists over a finite set.
Use the Max operator to find the biggest n such that there exists a list of length n that is an ascending chain w.r.t. R. That this works should be easy since there is at least one such chain, and you've already shown that there are only finitely many chains.

So: what's the point?

What is the intended purpose of the So type? Transliterating into Agda:
data So : Bool → Set where
oh : So true
So lifts a Boolean proposition up to a logical one. Oury and Swierstra's introductory paper The Power of Pi gives an example of a relational algebra indexed by the tables' columns. Taking the product of two tables requires that they have different columns, for which they use So:
Schema = List (String × U) -- U is the universe of SQL types
-- false iff the schemas share any column names
disjoint : Schema -> Schema -> Bool
disjoint = ...
data RA : Schema → Set where
-- ...
Product : ∀ {s s'} → {So (disjoint s s')} → RA s → RA s' → RA (append s s')
I'm used to constructing evidence terms for the things I want to prove about my programs. It seems more natural to construct a logical relation on Schemas to ensure disjointedness:
Disjoint : Rel Schema _
Disjoint s s' = All (λ x -> x ∉ cols s) (cols s')
where cols = map proj₁
So seems to have serious disadvantages compared to a "proper" proof-term: pattern matching on oh doesn't give you any information with which you could make another term type-check (Does it?) - which would mean So values can't usefully participate in interactive proving. Contrast this with the computational usefulness of Disjoint, which is represented as a list of proofs that each column in s' doesn't appear in s.
I don't really believe that the specification So (disjoint s s') is simpler to write than Disjoint s s' - you have to define the Boolean disjoint function without help from the type-checker - and in any case Disjoint pays for itself when you want to manipulate the evidence contained therein.
I am also sceptical that So saves effort when you're constructing a Product. In order to give a value of So (disjoint s s'), you still have to do enough pattern matching on s and s' to satisfy the type checker that they are in fact disjoint. It seems like a waste to discard the evidence thus generated.
So seems unwieldy for both authors and users of code in which it's deployed. 'So', under what circumstances would I want to use So?
If you already have a b : Bool, you can turn it into proposition: So b, which is a bit shorther than b ≡ true. Sometimes (I don't remember any actual case) there is no need to bother with a proper data type, and this quick solution is enough.
So seems to have serious disadvantages compared to a "proper"
proof-term: pattern matching on oh doesn't give you any information
with which you could make another term type-check. As a corollary,
So values can't usefully participate in interactive proving.
Contrast this with the computational usefulness of Disjoint, which
is represented as a list of proofs that each column in s' doesn't
appear in s.
So does give you the same information as Disjoint — you just need to extract it. Basically, if there is no inconsistency between disjoint and Disjoint, then you should be able to write a function So (disjoint s) -> Disjoint s using pattern matching, recursion and impossible cases elimination.
However, if you tweak the definition a bit:
So : Bool -> Set
So true = ⊤
So false = ⊥
So becomes a really useful data type, because x : So true immediately reduces to tt due to the eta-rule for ⊤. This allows to use So like a constraint: in pseudo-Haskell we could write
forall n. (n <=? 3) => Vec A n
and if n is in canonical form (i.e. suc (suc (suc ... zero))), then n <=? 3 can be checked by the compiler and no proofs are needed. In actual Agda it is
∀ {n} {_ : n <=? 3} -> Vec A n
I used this trick in this answer (it is {_ : False (m ≟ 0)} there). And I guess it would be impossible to write a usable version of the machinery decribed here without this simple definition:
Is-just : ∀ {α} {A : Set α} -> Maybe A -> Set
Is-just = T ∘ isJust
where T is So in the Agda's standard library.
Also, in the presence of instance arguments So-as-a-data-type can be used as So-as-a-constraint:
open import Data.Bool.Base
open import Data.Nat.Base
open import Data.Vec
data So : Bool -> Set where
oh : So true
instance
oh-instance : So true
oh-instance = oh
_<=_ : ℕ -> ℕ -> Bool
0 <= m = true
suc n <= 0 = false
suc n <= suc m = n <= m
vec : ∀ {n} {{_ : So (n <= 3)}} -> Vec ℕ n
vec = replicate 0
ok : Vec ℕ 2
ok = vec
fail : Vec ℕ 4
fail = vec

How to implement a binary heap using list in OCaml?

I am implementing a binary heap using list in OCaml, just to sharpen my OCaml skills.
I feel it very difficult using list and after struggling for 2 days, I have to come here for suggestions and hints.
Here is my thought so far
Obviously, I can't use the orignal array based algorithm to implement it using list.
What I am trying to utilise is binary tree. I have keep the invariant that a node should be bigger than any node whose level is lower than its.
I roughly figured out how to implement insert, although I am not sure whether it is correct or not.
For the binary tree, each node has two children, value and size n which is the total number of offsprings it has. This n is used to balance the tree.
When inserting x, I compare with a node (from root, recursively). Assume x < the value of the node, then
If one or both of the node's children are Leaf, then I insert the x to that Leaf place.
If none of the node's children are Leaf, then I will choose the child whose n is less and then recursively insert.
Here is my code
type 'a heap =
| Node of 'a * 'a heap * 'a heap * int
| Leaf
exception EmptyHeapException
let create_heap () = Leaf;;
let rec insert x = function
| Leaf -> Node (x, Leaf, Leaf, 0)
| Node (v, l, r, n) ->
let (stay, move) = if x > v then (x, v) else (v, x)
in
match (l, r) with
| (Leaf, Leaf) ->
Node (stay, Node (move, Leaf, Leaf, 0), Leaf, 1)
| (Leaf, _) ->
Node (stay, Node (move, Leaf, Leaf, 0), r, n+1)
| (_, Leaf) ->
Node (stay, l, Node (move, Leaf, Leaf, 0), n+1)
| (Node (_, _, _, n1), Node (_, _, _, n2)) ->
if n1 <= n2 then
Node (stay, (insert move l), r, n1+1)
else
Node (stay, l, (insert move r), n2+1);;
Ok, I have following questions.
Am I heading to the correct direction? Is my thought or implementation correct?
I get stuck in implementing get_top function. I don't know how to continue. any hints?
ocaml batteries implemented an efficient batHeap.ml. I have had a look, but I feel its way is totally different from mine and I can't understand it. Any one can help me understanding it?
This insertion code looks pretty nice to me. (I was confused by the counts for a while, but now I see they're counting the number of offspring.)
The function to remove the largest element (the root) is basically a deletion, which is always the most difficult. In essence you need to merge two trees while maintaining your invariant. I don't have time right now to work through it in detail, but I think it will turn out to be possible.
If you look in Okasaki (which you can do if you get stuck!) you'll see his trees have an extra invariant that makes it easier to do these operations. I'm pretty sure it's not something I would come up with right away. His implementation is based on an operation that merges two trees. It's used for insertion and deletion.
At a quick glance the Batteries heap code is based on "binomial trees", which are in fact a lot more complicated. They're explained in Okasaki also.
Update
Okasaki's book Purely Functional Data Structures is an elaboration of his PhD thesis. It appears that priority queues appear only in the book--sorry. If you're really interested in FP and not too strapped for cash the book is really worth owning.
As I said, your insert code looks great to me. It seems to me you actually have two invariants:
The value in a node is less than or equal to the values at the roots of its subtrees (ordering invariant).
The populations of the subtrees of a node differ by at most 1 (balance invariant).
As I said, I don't have time to verify in detail, but it looks to me like your insert code maintains the invariants and thus is O(log n).
The usefulness of this structure depends on your being able to delete the root in O(log n) while maintaining these two invariants.
The sketch of delete would be something like this:
let pop = function Leaf -> 0 | Node (_, _, _, p) -> p
let rec merge a b =
(* populations of a, b differ by at most one. pop a >= pop b *)
match a, b with
| Leaf, Leaf -> Leaf
| Leaf, _ -> b
| _, Leaf -> a
| Node (av, al, ar, ap), Node (bv, bl, br, bp) ->
if av >= bv then Node (av, merge al ar, b, ap + bp)
else Node (bv, merge al ar, insert av (delete_min b), ap + bp)
and delete_min = function
| Leaf -> Leaf
| Node (_, Leaf, Leaf, _) -> Leaf
| Node (_, l, Leaf, _) -> l
| Node (_, Leaf, r, _) -> r
| Node (_, l, r, _) ->
if pop l >= pop r then merge l r else merge r l
I still don't have a lot of time, so this might need some fixing up for correctness or for complexity.
Update
Being a purely cerebral guy, I (truly) never wondered what Chris Okasaki is like in real life. He teaches at West Point, and it's not too difficult to find his personal page there. It might satisfy some of your curiosity.

In which functional programming function would one grow a set of items?

Which of the three (if any (please provide an alternative)) would be used to add elements to a list of items?
Fold
Map
Filter
Also; how would items be added? (appended to the end / inserted after working item / other)
A list in functional programming is usually defined as a recursive data structure that is either a special empty value, or is composed of a value (dubbed "head") and another list (dubbed "tail"). In Haskell:
-- A* = 1 + A x A*
-- there is a builtin list type:
data [a] = [] | (a : [a])
To add an element at the head, you can use "cons": the function that takes a head and a tail, and produces the corresponding list.
-- (:) is "cons" in Haskell
(:) :: a -> [a] -> [a]
x = [1,2,3] -- this is short for (1:(2:(3:[])))
y = 0 : x -- y = [0,1,2,3]
To add elements at the end, you need to recurse down the list to add it. You can do this easily with a fold.
consAtEnd :: a -> [a] -> [a]
consAtEnd x = foldr [x] (:)
-- this "rebuilds" the whole list with cons,
-- but uses [x] in the place of []
-- effectively adding to the end
To add elements in the middle, you need to use a similar strategy:
consAt :: Int -> a -> [a] -> [a]
consAt n x l = consAtEnd (take n l) ++ drop n l
-- ++ is the concatenation operator: it joins two lists
-- into one.
-- take picks the first n elements of a list
-- drop picks all but the first n elements of a list
Notice that except for insertions at the head, these operations cross the whole list, which may become a performance issue.
"cons" is the low-level operation used in most functional programming languages to construct various data structure including lists. In lispy syntax it looks like this:
(cons 0 (cons 1 (cons 2 (cons 3 nil))))
Visually this is a linked list
0 -> 1 -> 2 -> 3 -> nil
Or perhaps more accurately
cons -- cons -- cons -- cons -- nil
| | | |
0 1 2 3
Of course you could construct various "tree"-like data structures with cons as well.
A tree like structure might look something like this
(cons (cons 1 2) (cons 3 4))
I.e. Visually:
cons
/ \
cons cons
/ \ / \
1 2 3 4
However most functional programming languages will provide many "higher level" functions for manipulating lists.
For example, in Haskell there's
Append: (++) :: [a] -> [a] -> [a]
List comprehension: [foo c | c <- s]
Cons: (:) :: a -> [a] -> [a] (as Martinho already mentioned)
And many many more
Just to offer a concluding remark, you wouldn't often operate on individual elements in a list in the way that you're probably thinking, this is an imperative mindset. You're more likely to copy the entire structure using a recursive function or something in that line. The compiler/virtual machine is responsible recognizing when the memory can be modified in place and updating pointers etc.

Resources