I am creating a prisoner's dilemma simulation and I have two functions that are counting cooperations and defections done by the two players and outputting them as a tuple. I see a lot of similarities and would like some guidance on how to consolidate the two functions into another function that the two can call upon so I am not reusing code. I am very new in OCaml so I am struggling to find a way to do this!
Here is the necessary information:
type action = bool ;;
type play = action * action ;;
type history = play list
let rec count_defections (history : history) : (int * int) =
match history with
| [] -> (0, 0)
| play :: rest ->
match play with
| (player1, player2) ->
match count_defections rest with
| (d1, d2) ->
if (player1, player2) = (false, false) then (d1 + 1, d2 + 1)
else if (player1, player2) = (false, true) then (d1 + 1, d2)
else if (player1, player2) = (true, false) then (d1, d2 + 1)
else (d1, d2) ;;
let rec count_cooperations (history : history) : (int * int) =
match history with
| [] -> (0, 0)
| play :: rest ->
match play with
| (player1, player2) ->
match count_cooperations rest with
| (d1, d2) ->
if (player1, player2) = (true, true) then (d1 + 1, d2 + 1)
else if (player1, player2) = (true, false) then (d1 + 1, d2)
else if (player1, player2) = (false, true) then (d1, d2 + 1)
else (d1, d2) ;;
My first thoughts were:
let count_common (history : history) : (int * int) =
match history with
| [] -> (0, 0)
| play :: rest ->
match play with
| (player1, player2) ->
match .....
But I don't really understand how to do the rest.
Here's a function that counts the two parts of a pair separately, counting elements that equal a given value.
let count_val_in_pairs value pairs =
List.fold_left
(fun (cta, ctb) (a, b) ->
((if a = value then cta + 1 else cta),
(if b = value then ctb + 1 else ctb)))
(0, 0)
pairs
Your count_defections is this:
let count_defections history =
count_val_in_pairs false history
Your count_cooperations is this:
let count_cooperations history =
count_val_in_pairs true history
Related
I'm trying to make a function working out (and then outputting as a String) the difference between two elements in a list - 1st and 2nd, then 2nd and 3rd, and so on - I think I'm giving it a good go, but I currently keep running into error whack-a-mole, I've put the current error below, but first, obligatory code dump:
type Name = String
type Coordinates = (Int, Int)
type Pop = Int
type TotalPop = [Pop]
type City = (Name, (Coordinates, TotalPop))
testData :: [City]
testData = [("New York City", ((1,1), [5, 4, 3, 2])),
("Washingotn DC", ((3,3), [3, 2, 1, 1])),
("Los Angeles", ((2,2), [7, 7, 7, 5]))]
getPopGrowth :: [City] -> Name -> String
getPopGrowth cs name = concat
[getPercentages z ++ "\n" | (x,z) <- maybeToList (lookup name cs)] where
getPercentages z = unwords (map show z1) ++ "% " where
z1 = percentageIncrease z
percentageIncrease :: [Int] -> [Float]
percentageIncrease (x:xs)
| length (x:xs) > 2 = percentageIncrease (tail xs)
| otherwise = (a / b - 1) * 100.0 where
a = fromIntegral x :: Float
b = fromIntegral (head xs) :: Float
And the error I'm getting at the moment is:
error:
• Couldn't match expected type ‘[Float]’ with actual type ‘Float’
• In the expression: (a / b - 1) * 100.0
In an equation for ‘percentageIncrease’:
percentageIncrease (x : xs)
| length (x : xs) > 2 = percentageIncrease (tail xs)
| otherwise = (a / b - 1) * 100.0
where
a = fromIntegral x :: Float
b = fromIntegral (head xs) :: Float
|
92 | | otherwise = (a / b - 1) * 100.0 where
| ^^^^^^^^^^^^^^^^^^^
I would like to emphasise, I understand the error, but I do not know how to resolve it in such a way that I get the desired outcome of the function.
Just for some clarity around what I'm trying to do.
Input: getPopGrowth testData "New York City"
should Output: 25% 33.333% 50%
So far, you only calculate the percentage when the list has exactly two elements left. Less elements are not covered, and for longer lists, in all the steps before, the elements get dropped without further action. In the last step, however, you return a single Float instead of a list.
The following example creates an increase percentage in every step, concatenating it with the list resulting from applying the function to the tail of the list. Also, the base cases are all covered:
percentageIncrease :: [Int] -> [Float]
percentageIncrease [] = []
percentageIncrease (x:[]) = []
percentageIncrease (x:y:xs) = ((a / b - 1) * 100.0) : percentageIncrease (y:xs) where
a = fromIntegral x :: Float
b = fromIntegral y :: Float
Console output:
*Main> getPopGrowth testData "New York City"
"25.0 33.333336 50.0% \n"
I am trying to run the following code on a coding question website and it says there is a runtime error, but running it on the top-level ocaml seems to work fine. Could there be any source of error in the code? Thanks in advance
The question is to find the number of 'good segments' within the given list and a specific number. A good segment is defined as follows:
A and B are positive integers such that A < B.
x that satisfies A <= x <= B is not an element of the given list.
The following are the inputs.
n, which is the number of elements in the list that will be given.
a, b, c, ... which are the elements of the list.
t, which is the number that must be included in the segment.
The output should be a single number printed out.
Edited Code:
let rec drop_value l to_drop =
match l with
| [] -> []
| hd :: tl ->
let new_tl = drop_value tl to_drop in
if hd = to_drop then new_tl else hd :: new_tl
;;
let rec find_start li t cur_min =
match li with
| [] -> cur_min
| hd :: tl -> let new_min = abs (t - hd) in
if new_min = 0 then find_start tl t new_min
else if new_min < cur_min && t > hd then find_start tl t new_min
else find_start tl t cur_min
;;
let rec find_end li t cur_min =
match li with
| [] -> cur_min
| hd :: tl -> let new_min = abs (t - hd) in
if new_min = 0 then find_end tl t new_min
else if new_min < cur_min && t < hd then find_end tl t new_min
else find_end tl t cur_min
;;
let rec contains_value l value =
match l with
| [] -> false
| hd :: tl -> if hd = value then true else contains_value tl value
;;
let nums = ref [];;
let n = read_int () in
for i = 1 to n do
Scanf.scanf " %d" (fun a ->
nums := a :: !nums)
done;
Scanf.scanf " %d" (fun t ->
if contains_value !nums t then print_int 0
else let start = if List.length !nums = 1 then 1 else abs (find_start !nums t 1001 - t) in
let finish = find_end (drop_value !nums start) t 1001 + t in
if t > start && t < finish then (if start = 1 && List.length ! nums = 1 then print_int ((t - start + 1) * (finish - t) - 1) else print_int ((t - start) * (finish - t) - 1))
else let start = 1 in print_int ((t - start + 1) * (finish - t) - 1))
;;
eg.
5
4 8 13 24 30
10
should give
5
=> [9, 10], [9, 11], [9, 12], [10, 11], [10, 12]
You don't describe the exact input format that your code is going to get. This makes it pretty much impossible to debug your code.
When I compile and run your code (as m.ml) using the input you describe I see this:
$ ./m
5 4 8 13 24 30 10
Fatal error: exception Failure("int_of_string")
In fact no matter what format I try for the input I get the same result.
So that is probably what is happening at the website.
In my experience it always causes more harm than good to use scanf. Combining it with other input functions is probably going to make things worse.
If you describe the expected format of the input carefully, somebody on StackOverflow can recommend a way to get your numbers.
In the meantime here's a way to read all the numbers on one line:
let rec split_at list n =
if n = 0 then
([], list)
else
match list with
| [] -> ([], [])
| h :: t ->
let (a, b) = split_at t (n - 1) in (h :: a, b)
in
let (nums, t) =
let line = read_line () in
let nstrs = Str.split (Str.regexp "[ \t][ \t]*") line in
match List.map int_of_string nstrs with
| [] -> failwith "no numbers"
| n :: rest ->
if List.length rest <> n + 1 then
failwith "bad count"
else
let (nums, tlist) = split_at rest n in
(nums, List.hd tlist)
in
. . .
I have a quadTree type defined by that :
type 'a quadtree =
| Empty
| Leaf of 'a
| Node of 'a quadtree * 'a quadtree * 'a quadtree * 'a quadtree;;
Rooms defined by
type room = {
n : bool;
e : bool;
s : bool;
w : bool;
ps : coord;
exit : bool
}
Coordinates defined by
type coord = {
x : int;
y : int;
}
So TLDR of all that, I have a Quadtree of rooms that have or don't have exits up, down, left and right.
The objective now is to create a function that will find a way (if it exists) from one room to another (from its coordinates), the problem is that I don't see how to do it in OCaml...
Anyway, thanks for your time, have a good day.
Edit :
To clarify, I am the one defining the types and can alter them if needed.
Also, I tried implementing Dijkstra's algorithm (from Wikipedia's pseudo code), but being quite unfamiliar with both graphs, and OCaml's arrays and lists. To be precise, my problem -I think- comes from the fact that I'm not able to modify variables in a function, so for instance in Wikipedia's pseudo code, in this line:
u ← Q.extract_min() // Remove and return best vertex
I see how to remove the best vertex, and I see how to return it, but not both at the same time.
Or, here:
for each neighbor v of u: // where v is still in Q.
alt ← dist[u] + length(u, v)
if alt < dist[v]: // A shorter path to v has been found
dist[v] ← alt
prev[v] ← u
How do I modify dist and prev outside of the 'for' loop? Can I use a for loop or is it simpler / better to use a recursive function?
Also I should make clear that the maze is "directional", meaning that being able to go from room A to room B does not mean you'll be able to go from room B to room A.
Edit 2 :
I should have clarified this in the beginning, sorry :
The quadtree follows this rule :
| Node of North West * North East * South West * South East
Edit 3 :
Okay change of plan, turns out I was doing things very stupidly. I don't need to find the way to a certain room, just to an exit. So I tried this :
let rec contains_exit = function
| [] -> false
| e::l' when (getCell e.x e.y maze).exit -> true
| e::l' when (getCell e.x e.y maze).exit = false -> contains_exit l'
;;
let rec find_exit start way =
if is_exit start then
way
else
(let a = find_exit (northp start) way#[start] in
if contains_exit a then
way
else
(
let b = find_exit (eastp start) way#[start] in
if contains_exit b then
way
else
(
let c = find_exit (southp start) way#[start] in
if contains_exit c then
way
else
(
let d = find_exit (westp start) way#[start] in
if contains_exit d then
way
else
way
)
)
)
)
;;
But it gives me a stack overflow. After a bit of research, it seems that the line "contains_exit a" is never true, so the way is never returned and it loops !
Any idea why that is ? Is the problem my contains_exit function ?
Edit 4 :
Ended up doing this function :
let rec find_exit start way =
sleep 50000000;
let r = (Random.int 180) in
set_color (rgb r r r);
fill_rect (start.x * sizeCell + doorWidth * 2) (start.y * sizeCell + doorWidth * 2) (sizeCell - 4 * doorWidth) (sizeCell - 4 * doorWidth);
if is_exit start then
way#[start]
else
(let a = if (getCell start.x start.y maze).n && ((mem (northp start) way) = false) then find_exit (northp start) way#[start] else [] in
if a != [] then
a
else
(
let b = if (getCell start.x start.y maze).e && ((mem (eastp start) way) = false) then find_exit (eastp start) way#[start] else [] in
if b != [] then
b
else
(
let c = if (getCell start.x start.y maze).w && ((mem (westp start) way) = false) then find_exit (westp start) way#[start] else [] in
if c != [] then
c
else
(
let d = if (getCell start.x start.y maze).s && ((mem (southp start) way) = false) then find_exit (southp start) way#[start] else [] in
if d != [] then
d
else
[]
)
)
)
)
;;
it sometimes works... But other times it blocks and it goes from one room to the one below then up again then down again... I don't understand why !?
If you want to try the whole program, here it is : link
Then you can go for some thing like this:
type 'a quadtree =
| Empty
| Leaf of 'a
| Node of 'a * 'a quadtree * 'a quadtree * 'a quadtree * 'a quadtree;;
type room = {
n : bool;
e : bool;
s : bool;
w : bool;
ps : coord;
exit : bool
};;
type coord = {
x : int;
y : int;
};;
let rec treeForRoom(tree, room) =
match tree with
| Empty -> Empty
| Leaf l -> if l.ps == room.ps then l else Empty
| Node (r, n, e, s, w) as node ->
if r == room
then node
else
match ((r.ps.x - room.ps.x), (r.ps.y - room.ps.y)) with
| (0, n) -> if n > 0 then treeForRoom(w) else treeForRoom(e)
| (n, 0) -> if n > 0 then treeForRoom(s) else treeForRoom(n)
(* Assuming the root of the tree is the room we start from *)
let rec searchPath(tree, r) =
match tree with
| Empty -> (false, 0, [])
| Leaf l -> if l == r then (true, 0) else (false, 0, [])
| Node (r, n, e, s, w) as node ->
let pn = searchPath(n, r)
and pe = searchPath(e, r)
and ps = searchPath(s, r)
and pw = searchPath(w, r)
in
find_best_path(p1, p2, p3, p4)
let find_best_path(p1, p2, p3, p4) =
match (p1, p2, p3, p4) with
| ((false,_,_), (false,_,_), (false,_,_), (false,_,_)) -> (false, -1, [])
| ((true, w, p), (false,_,_), (false,_,_), (false,_,_)) -> (true, w, p)
| ((false,_,_), (true, w, p)), (false,_,_), (false,_,_)) -> (true, w, p)
| ((false,_,_), (false,_,_), (true, w, p)), (false,_,_)) -> (true, w, p)
| ((false,_,_), (false,_,_), (false,_,_),(true, w, p)) -> (true, w, p)
| ((p1ok, p1w, p1p), (p2ok, p2w, p2p),(p3ok, p3w, p3p),(p4ok, p4w, p4p)) ->
if p1ok && p2ok && p3ok && p4ok
then
min_weight([(p1ok, p1w, p1p), (p2ok, p2w, p2p),(p3ok, p3w, p3p),(p4ok, p4w, p4p)])
else
....
let rec min_weight(l) =
match l with
| [] -> (false, -1, [])
| [t] -> t
| [(to, tw, tp) as t::q] -> let (mo, mw, mp) as minw = min_weight(q) in
if tw < mw
then
t
else
minw
I added the root to the type definition ('a* ...) so I can make a function to find the good tree to go through. I also assume that the tree respect the following rule: (root, north room, east room, south room, west room) for each node (you can make an add function to ensure this property).
Then you go through the tree exploring from the end and getting the minimal weight path for then end to the start point. (It is the same weight as it goes through the same paths under the same conditions (cause you explore the tree from the start but compute the path from then end)).
This code does not take into account the possibility to pass through doors but it is a just a check to add as the way of going through the tree is already correctly oriented.
I let you complete and correct the code.
Hope it will help you.
I'm trying to make the function which takes string and transforms it to boolean expression. For example:for input ((x10+~1)*x132) it should give times(plus(var 10,compl 1),var 132), but it gives times(plus(var #,compl #),var 132). Where do hashtags come from??
datatype boolexp = zero
| one
| plus of boolexp * boolexp
| times of boolexp * boolexp
| var of int
| compl of boolexp
exception InvalidInput
(* takes the first n elements *)
fun take (_, 0) = nil
| take (nil, _) = raise InvalidInput
| take (h::t, n) = if n < 0
then raise InvalidInput
else h::take(t, n-1)
(* drops the frist n elements *)
fun drop (xs, 0) = xs
| drop (nil, _) = raise InvalidInput
| drop (h::t,n) = if n < 0
then raise InvalidInput
else drop (t, n-1)
(* converts string to integer *)
fun charlist_to_int (nil) = raise InvalidInput
| charlist_to_int (xs) =
let fun helper_int_rev (nil) = 0
| helper_int_rev (h::t) = if h >= #"0" andalso h <= #"9"
then helper_int_rev t * 10 + (ord h - ord #"0")
else raise InvalidInput
in helper_int_rev (rev xs) end;
(* finds the operator and its position *)
fun searchfor_oper (nil,_,_) = raise InvalidInput
| searchfor_oper (#"("::t, np, pos) = searchfor_oper (t, np+1, pos+1)
| searchfor_oper (#")"::t, np, pos) = searchfor_oper(t, np-1, pos+1)
| searchfor_oper (#"+"::t, 0, pos) = (pos, #"+")
| searchfor_oper (#"*"::t, 0, pos) = (pos, #"*")
| searchfor_oper (h::t, np, pos) = searchfor_oper (t, np, pos+1)
fun beparse_helper (nil) = raise InvalidInput
| beparse_helper (h::t) =
if h = #"x" then if hd(t)= #"0" then raise InvalidInput
else var (charlist_to_int (t))
else if h = #"0" then if t = nil then zero else raise InvalidInput
else if h = #"1" then if t = nil then one else raise InvalidInput
else if h = #"~" then compl(beparse_helper(t))
else if h = #"(" then
let
val lst = if hd (rev t)= #")" then take(t, length(t)-1) else raise InvalidInput
val (pos, oper) = searchfor_oper (lst, 0, 1)
in
if oper = (#"+")
then plus(beparse_helper(take(lst,pos-1)), beparse_helper(drop(lst,pos)))
else if oper = (#"*")
then times(beparse_helper(take(lst,pos-1)),beparse_helper(drop(lst,pos)))
else raise InvalidInput
end
else raise InvalidInput;
fun beparse(s) = beparse_helper(explode(s));
(*TESTING*)
beparse ("((x10+~1)*x132)");
I don't think that it is SML per se so much as SML/NJ default REPL output. In the grand scheme of things the REPL is for development/debugging -- not the environment for the finished program to run it. Recursive data structures such as trees can give quickly give rise to values which are too big to conveniently print. The REPL truncates the output in a couple of ways. For lists it will print around a dozen elements and then use .... For things like trees it will print down a few levels and then use a # to indicate that you have reached the level where the truncation happens. If you find this inconvenient you can do one of two things:
1) The logical printing depth in SML/NJ can be altered by evaluating Control.Print.printDepth := 20; (or however much you want) in the REPL
2) Perhaps a little more principled but more work -- write a custom pretty-printer (say pprint) for your values and evaluate e.g. pprint v; in the REPL rather than just v;
Also, consider using pattern matching more:
fun beparse_helper [] = raise InvalidInput
| beparse_helper (#"x"::cs) = var (charlist_to_int cs)
| beparse_helper (#"0"::[]) = zero
| beparse_helper (#"1"::[]) = one
| beparse_helper (#"~"::cs) = compl (beparse_helper cs)
| beparse_helper (#"("::(cs as (_::_))) =
let val lst = if List.last cs = #")"
then take (cs, length cs - 1)
else raise InvalidInput
in case searchfor_oper (lst, 0, 1) of
(pos, #"+") => plus (beparse_helper (take (lst, pos-1)),
beparse_helper(drop (lst, pos)))
| (pos, #"*") => times (beparse_helper (take (lst, pos-1)),
beparse_helper(drop (lst, pos)))
end
| beparse_helper _ = raise InvalidInput
How can I modify this code to accept lists of different lengths?
Modify the function rippleCarryAdder to accept lists of different lengths. For example, the call (rippleCarryAdder [true] [false; true]) should evaluate to ([true; false], false), i.e., 1 + 01 evaluates to 2 with no overflow.
let xor a b = (a || b) && (not (a && b))
(* fullAdder : bool -> bool -> bool -> (bool * bool)
*
* The call (fullAdder a b carryIn) adds the bits a, b and carryIn
* producing the sum and the carry out.
*)
let fullAdder a b cin =
let c = xor a b in
let sum = xor c cin in
let carryOut = (c && cin) || (a && b)
in
(sum, carryOut)
(* rippleCarryAdder : bool list -> bool list -> bool -> (bool list * bool)
*
* The call (rippleCarryAdder ms ns carryIn) implements a ripple carry
* adder.
*)
let rippleCarryAdder ms ns =
let rec repeat ms ns carryIn acc =
match (ms, ns) with
| ([], []) -> (acc, carryIn)
| (m::ms, n::ns) -> let (sum, carryOut) = fullAdder m n carryIn
in
repeat ms ns carryOut (sum::acc)
in
repeat (List.rev ms) (List.rev ns) false []
let fill_in a (ms,ns) =
let rec fill_left a = function
([],[]) -> []
| ([],_::ns) -> a::fill_left a ([],ns)
| (m::ms,[]) -> m::fill_left a (ms,[])
| (m::ms,_::ns) -> m::fill_left a (ms,ns)
in
let rec fill_right a = function
([],[]) -> []
| (_::ms,[]) -> a::fill_right a (ms,[])
| ([],n::ns) -> n::fill_right a ([],ns)
| (_::ms,n::ns) -> n::fill_right a (ms,ns)
in
(fill_left a (ms,ns),fill_right a (ms,ns))
let rippleCarryAdder2 ms ns =
let (ms,ns)=fill_in false (List.rev ms,List.rev ns) in
rippleCarryAdder (List.rev ms) (List.rev ns)
Test:
# fill_in false ([true;false],[true;false;true;true]);;
- : bool list * bool list =
([true; false; false; false], [true; false; true; true])
# fill_in 0 ([1;1;0;1],[2;3]);;
- : int list * int list = ([1; 1; 0; 1], [2; 3; 0; 0])
# rippleCarryAdder2 [true] [false;true];;
- : bool list * bool = ([true; false], false)