F# adding polynomials recursively - recursion

I'm trying to write a function in F# that adds polynomials recursively. My polynomials can be represented as a list of tuples.
For example, 2x^4 + 3x^2 + x + 5 is equal to [(2.0,4);(3.0,2);(1.0,1);(5.0,0)]
All polynomials are properly structured (no repeated terms with the same degree, no terms with zero coefficients unless it is the zero polynomial, terms sorted by decreasing exponent no empty input list).
I'm having trouble doing this. Here is my code
type term = float * int
type poly = term list
let rec atp(t:term,p:poly):poly =
match p with
| [] -> []
| (a, b) :: tail -> if snd t = b then (fst t + a, b) :: [] elif snd t > b then t :: [] else ([]) :: atp(t, tail)
(* val atp : t:term * p:poly -> poly *)
let rec addpolys(p1:poly,p2:poly):poly =
match p1 with
| [] -> []
| (a,b) :: tail -> atp((a,b), p2) # addpolys(tail, p2)
I have two polynomials
val p2 : poly = [(4.5, 7); (3.0, 4); (10.5, 3); (2.25, 2)]
val p1 : poly = [(3.0, 5); (2.0, 2); (7.0, 1); (1.5, 0)]
and when I call the function, my result is
val p4 : poly =
[(4.5, 7); (3.0, 5); (3.0, 4); (3.0, 5); (10.5, 3); (3.0, 5); (4.25, 2)]
When the correct answer is
[(4.5, 7); (3.0, 5); (3.0, 4); (10.5, 3); (4.25, 2); (7.0, 1); (1.5, 0)]

Unfortunately your code does not compile therefore it is difficult for me to understand your intentions. But I've got an own implementation for your problem. Maybe it will help you:
// addpoly: (float * 'a) list -> (float * 'a) list -> (float * 'a) list
let rec addpoly p1 p2 =
match (p1, p2) with
| [], p2 -> p2
| p1, [] -> p1
| (a1, n1)::p1s, (a2, n2)::p2s ->
if n1 < n2 then (a2, n2) :: addpoly p1 p2s
elif n1 > n2 then (a1, n1) :: addpoly p1s p2
else (a1+a2, n1) :: addpoly p1s p2s
let p1 = [(3.0, 5); (2.0, 2); ( 7.0, 1); (1.5, 0)]
let p2 = [(4.5, 7); (3.0, 4); (10.5, 3); (2.25, 2)]
let q = addpoly p1 p2
// val q : (float * int) list =
// [(4.5, 7); (3.0, 5); (3.0, 4); (10.5, 3); (4.25, 2); (7.0, 1); (1.5, 0)]
I would like to make a little note. When you change the representation of the
polynomials a little bit then you can simplify the implementation of your function. You can express a polynomial as a list of its coefficients.
For example when you have this polynomial
p1 = 5.0x^5 + 2.0x^2 + 7.0x
you can write it also like this
p1 = 1.5x^0 + 7.0x^1 + 2.0x^2 + 0.0x^3 + 0.0x^4 + 5.0x^5
Therefore you are able to define the polynomial with this list:
let p1 = [1.5; 7.0; 2.0; 0.0; 0.0; 5.0]
Here are two functions which operates on the representation. polyval calculates the result for a given value and polyadd adds two polynomials. There implementation are rather simple:
// p1 = 1.5x^0 + 7.0x^1 + 2.0x^2 + 0.0x^3 + 0.0x^4 + 5.0x^5
let p1 = [1.5; 7.0; 2.0; 0.0; 0.0; 5.0]
// p2 = 0.0x^0 + 0.0x^1 + 2.25x^2 + 10.5x^3 + 3.0x^4 + 0.0x^5 + 0.0x^6 + 4.5x^7
let p2 = [0.0; 0.0; 2.25; 10.5; 3.0; 0.0; 0.0; 4.5]
// polyval: float list -> float -> float
let rec polyval ps x =
match ps with
| [] -> 0.0
| p::ps -> p + x * (polyval ps x)
// polyadd: float int -> float int -> float int
let rec polyadd ps qs =
match (ps, qs) with
| [], ys -> ys
| xs, [] -> xs
| x::xs, y::ys -> (x+y)::polyadd xs ys
let v = polyval p1 2.3
// val v : float = 349.99715
let p = polyadd p1 p2
// val p : float list = [1.5; 7.0; 4.25; 10.5; 3.0; 5.0; 0.0; 4.5]

Here's a completely generic, tail-recursive implementation:
let inline addPolys xs ys =
let rec imp acc = function
| (coeffx, degx)::xt, (coeffy, degy)::yt when degx = degy ->
imp ((coeffx + coeffy, degx)::acc) (xt, yt)
| (coeffx, degx)::xt, (coeffy, degy)::yt when degx > degy ->
imp ((coeffx, degx)::acc) (xt, (coeffy, degy)::yt)
| xs, yh::yt -> imp (yh::acc) (xs, yt)
| xh::xt, [] -> imp (xh::acc) (xt, [])
| [], yh::yt -> imp (yh::acc) ([], yt)
| [], [] -> acc
imp [] (xs, ys) |> List.rev
It has the type:
xs:( ^a * 'b) list -> ys:( ^a * 'b) list -> ( ^a * 'b) list
when ^a : (static member ( + ) : ^a * ^a -> ^a) and 'b : comparison
Since float has the member +, and int supports comparison, the type float * int matches these generic constraints:
> addPolys p1 p2;;
val it : (float * int) list =
[(4.5, 7); (3.0, 5); (3.0, 4); (10.5, 3); (4.25, 2); (7.0, 1); (1.5, 0)]

Related

Swapping Elements of a Slice (in-place)

I have posted my solution in the answers below.
The question will not be updated with even more code to not further increase clutter.
I'm trying to rotate all elements in a Vec<Vec<T>> clockwise.
The vector is guaranteed to be square, as in v.len() == v[0].len().
The idea is to
find all elements that are equivalent under rotational symmetry to
v's center
swap these elements in place, using std::mem::swap
My current code does not change the state of the vec. How do I fix this?
fn rotate<T>(v: &mut Vec<Vec<T>>) {
// swap elements equivalent to position i on each ring r
// limit l = side length of current ring
//
// + 0 - - - - + r = 0 -> l = 6
// | + 1 - - + | r = 1 -> l = 4
// | | + 2 + | | r = 2 -> l = 2
// | | | | | |
// | | + - + | | swap:
// | + - - - + | a b c d
// + - - - - - + > b a c d
// > c a b d
// > d a b c
for r in 0..((v.len() + 1) / 2 {
let l = v.len() - 1 - r;
for i in r..l {
let mut a = & pieces[ r ][ r+i ];
let mut b = & pieces[ r+i ][ l-r ];
let mut c = & pieces[ l-r ][l-r-i];
let mut d = & pieces[l-r-i][ r ];
_rot_cw(&mut a, &mut b, &mut c, &mut d)},
}
}
fn _rot_cw<T>(a: &mut T, b: &mut T, c: &mut T, d: &mut T) {
//rotates a->b, b->c, c->d, d->a
std::mem::swap(a, b);
std::mem::swap(a, c);
std::mem::swap(a, d);
}
}
Edit:
Fixed minor issues in the original code above, thanks to #Jmb.
Here's my current code, again running into borrowing issues:
fn rotate_square_slice<T>(slice: &mut Vec<T>, rows: usize) {
for r in 0..(slice.len()+1)/2 {
let l = slice.len() -1 - r;
for i in r..l {
let a = &mut slice.get_mut(rows * r + r+i ).unwrap();
let b = &mut slice.get_mut(rows * (r+i) + l-r ).unwrap();
let c = &mut slice.get_mut(rows * (l-r) + l-r-i).unwrap();
let d = &mut slice.get_mut(rows * (l-r-i) + r ).unwrap();
std::mem::swap(a, b);
std::mem::swap(a, c);
std::mem::swap(a, d);
}
}
}
Swapping elements in a slice can be done by using the slice's swap() method.
Solving that problem, the code now looks like this:
fn rotate_square_slice<T>(slice: &mut [T], size: usize) {
for r in 0..(size + 1) / 2 {
let l = size - 1 - r;
for i in r..l {
// b, c & d are the indices with rotational symmetry to a,
// shifted by 90°, 180° & 270° respectively
let a = size * r + r+i ;
let b = size * (r+i) + l-r ;
let c = size * (l-r) + l-r-i;
let d = size * (l-r-i) + r ;
slice.swap(a, b);
slice.swap(a, c);
slice.swap(a, d);
}
}
}
I have, however, run into an issue with correctly indexing the slice. The question can be found here:
Rotational Symmetry Indexing in a 1D "Square" Array

3d line-intersection code not working properly

I created this piece of code to get the intersection of two 3d line-segments.
Unfortunately the result of this code is inaccurate, the intersection-point is not always on both lines.
I am confused and unsure what I'm doing wrong.
Here is my code:
--dir = direction
--p1,p2 = represents the line
function GetIntersection(dirStart, dirEnd, p1, p2)
local s1_x, s1_y, s2_x, s2_y = dirEnd.x - dirStart.x, dirEnd.z - dirStart.z, p2.x - p1.x, p2.z - p1.z
local div = (-s2_x * s1_y) + (s1_x * s2_y)
if div == 0 then return nil end
local s = (-s1_y * (dirStart.x - p1.x) + s1_x * (dirStart.z - p1.z)) / div
local t = ( s2_x * (dirStart.z - p1.z) - s2_y * (dirStart.x - p1.x)) / div
if (s >= 0 and s <= 1 and t >= 0 and t <= 1) and (Vector(dirStart.x + (t * s1_x), 0, dirStart.z + (t * s1_y)) or nil) then
local v = Vector(dirStart.x + (t * s1_x),0,dirStart.z + (t * s1_y))
return v
end
end
This is example of Delphi code to find a distance between two skew lines in 3D. For your purposes it is necessary to check that result if small enough value (intersection does exist), check that s and t parameters are in range 0..1, then
calculate point using parameter s
Math of this approach is described in 'the shortest line...' section of Paul Bourke page
VecDiff if vector difference function, Dot id scalar product function
function LineLineDistance(const L0, L1: TLine3D; var s, t: Double): Double;
var
u: TPoint3D;
a, b, c, d, e, det, invdet:Double;
begin
u := VecDiff(L1.Base, L0.Base);
a := Dot(L0.Direction, L0.Direction);
b := Dot(L0.Direction, L1.Direction);
c := Dot(L1.Direction, L1.Direction);
d := Dot(L0.Direction, u);
e := Dot(L1.Direction, u);
det := a * c - b * b;
if det < eps then
Result := -1
else begin
invdet := 1 / det;
s := invdet * (b * e - c * d);
t := invdet * (a * e - b * d);
Result := Distance(PointAtParam(L0, s), PointAtParam(L1, t));
end;
end;
As far as I can tell your code is good. I've implemented this in javascript at https://jsfiddle.net/SalixAlba/kkrc9kcf/
and it seems to work for all the cases I can think of.
The only changes I've done is to change things to work in javascript rather than lua. The final condition was commented out
function GetIntersection(dirStart, dirEnd, p1, p2) {
var s1_x = dirEnd.x - dirStart.x;
var s1_y = dirEnd.z - dirStart.z;
var s2_x = p2.x - p1.x;
var s2_y = p2.z - p1.z;
var div = (-s2_x * s1_y) + (s1_x * s2_y);
if (div == 0)
return new Vector(0,0);
var s = (-s1_y * (dirStart.x - p1.x) + s1_x * (dirStart.z - p1.z)) / div;
var t = ( s2_x * (dirStart.z - p1.z) - s2_y * (dirStart.x - p1.x)) / div;
if (s >= 0 && s <= 1 && t >= 0 && t <= 1) {
//and (Vector(dirStart.x + (t * s1_x), 0, dirStart.z + (t * s1_y)) or nil) then
var v = new Vector(
dirStart.x + (t * s1_x),
dirStart.z + (t * s1_y));
return v;
}
return new Vector(0,0);
}
Mathmatically it makes sense. If A,B and C,D are your two lines. Let s1 = B-A, s2 = C-D. A point of the line AB is given by A + t s1 and a point on the line CD is given by C + s s2. For an intersection we require
A + t s1 = C + s s2
or
(A-C) + t s1 = s s2
You two formula for s, t are found by taking the 2D cross product with each of the vectors s1 and s2
(A-C)^s1 + t s1^s1 = s s2^s1
(A-C)^s2 + t s1^s2 = s s2^s2
recalling s1^s1=s2^s2=0 and s2^s1= - s1^s2 we get
(A-C)^s1 = s s2^s1
(A-C)^s2 + t s1^s2 = 0
which can be solved to get s and t. This matches your equations.

F# closures on mailbox processor threading failure

So I am doing a some batch computation very cpu intensive on books. And I built a tracker to track the computation of tasks. I close on a mailboxprocesser which all runs fine without parallelizaton but when I put a array.parallel.map or and async workflow the mailboxprocesser fails. I want to know why?
type timerMessage =
| Start of int
| Tick of bool
let timer = MailboxProcessor.Start(fun mbox ->
let inputloop() = async {
let progress = ref 0
let amount = ref 0
let start = ref System.DateTime.UtcNow
while true do
let! msg = mbox.Receive()
match msg with
| Start(i) -> amount := i
progress := 0
start := System.DateTime.UtcNow
| Tick(b) -> if !amount = 0 then ()
else
progress := !progress + 1
let el = System.DateTime.UtcNow - !start
let eta = int ((el.TotalSeconds/float !progress)*(float (!amount - !progress)))
let etas = (int (eta / 3600)).ToString() + ":" + (int ((eta % 3600) / 60)).ToString() + ":" + (eta % 60).ToString()
System.Console.Clear()
System.Console.Write((!progress).ToString() + "/" + (!amount).ToString() + " Completed [] Estimated Time Remaining:" + etas)
} inputloop() )
let computeBook (author :string) path =
let rs = ReadToStrings(path)
let bk = StringsToBook rs
let mt = createMatrix bk 100 10 //size 100 //span 10
let res = GetResults mt
//do stuff
timer.Post(Tick(true))
(author,path,res)
let partAopA = //clip head clip foot no word mods
let lss = seq {for x in processtree do
for y in (snd x) do
yield ((fst x),y) }
let ls = Seq.toArray lss //task list
timer.Post(Start(ls.Length)) //start counter
let compls = Array.map (fun l -> computeBook (fst l) (snd l) ) ls //Array.Parallel.map fails here the same as below async if I put async blcoks around the computbook call
//let res = compls |> Async.Parallel |> Async.RunSynchronously
writeResults compls outputfolder |> ignore
compls

Pattern match against existing variables

I have a structure of nested maps:
[<RequireQualifiedAccess>]
type NestedMap =
| Object of Map<string,NestedMap>
| Value of int
I need to prune the structure.
The purpose of the code is to maintain intact the nested structure of the maps and of the map where the key value pair is found, pruning the branches where the key value pair is not found.
Here is the test NestedMap:
let l2' = NestedMap.Object ( List.zip ["C"; "S"; "D"] [NestedMap.Value(10); NestedMap.Value(20); NestedMap.Value(30)] |> Map.ofList)
let l3 = NestedMap.Object ( List.zip ["E"; "S"; "F"] [NestedMap.Value(100); NestedMap.Value(200); NestedMap.Value(300)] |> Map.ofList)
let l2'' = NestedMap.Object ( List.zip ["G"; "H"; "I"; "S"] [NestedMap.Value(30); l3; NestedMap.Value(40); NestedMap.Value(50)] |> Map.ofList)
let l1 = NestedMap.Object ( List.zip ["Y"; "A"; "B"] [NestedMap.Value(1); l2'; l2''] |> Map.ofList)
This is my code:
let rec pruneWithKeyValue (keyvalue: string * int) (json: NestedMap) =
let condition ck cv =
let tgtKey = (fst keyvalue)
let tgtVal = (snd keyvalue)
match (ck, cv) with
| (tgtKey, NestedMap.Value(tgtVal)) ->
printfn ">>> Found match : "
printfn " ck = %s " ck
printfn " tgtKey and tgtVal == %s, %i" tgtKey tgtVal
true
| _ -> false
match json with
| NestedMap.Object nmap ->
if (nmap |> Map.exists (fun k v -> condition k v)) then
json
else
printfn "Expanding w keyvalue: (%s,%i): " (fst keyvalue) (snd keyvalue)
let expanded = nmap |> Map.map (fun k v -> pruneWithKeyValue keyvalue v)
NestedMap.Object(expanded |> Map.filter (fun k v -> v <> NestedMap.Object (Map.empty)))
| _ -> NestedMap.Object (Map.empty)
let pruned = pruneWithKeyValue ("S",20) l1
let res = (pruned = l1)
The result is not what desired:
>>> Found match :
ck = Y
tgtKey and tgtVal == Y, 1
val pruneWithKeyValue : string * int -> json:NestedMap -> NestedMap
val pruned : NestedMap =
Object
(map
[("A", Object (map [("C", Value 10); ("D", Value 30); ("S", Value 20)]));
("B",
Object
(map
[("G", Value 30);
("H",
Object
(map [("E", Value 100); ("F", Value 300); ("S", Value 200)]));
("I", Value 40); ("S", Value 50)])); ("Y", Value 1)])
val remainsTheSame : bool = true
The code says that the output data structure remains unchanged (val remainsTheSame : bool = true). Even more interestingly, somehow the keyvalue tuple that contains the key-value pair the function is searching got modified:
>>> Found match :
ck = Y
tgtKey and tgtVal == Y, 1
This is the problem. In fact, if I hardcode the keyvalue tuple:
let rec pruneWithKeyValue (keyvalue: string * int) (json: NestedMap) =
let condition ck cv =
let tgtKey = (fst keyvalue)
let tgtVal = (snd keyvalue)
match (ck, cv) with
| ("S", NestedMap.Value(20)) ->
printfn ">>> Found match : "
printfn " ck = %s " ck
printfn " tgtKey and tgtVal == %s, %i" tgtKey tgtVal
true
| _ -> false
match json with
| NestedMap.Object nmap ->
if (nmap |> Map.exists (fun k v -> condition k v)) then
json
else
printfn "Expanding w keyvalue: (%s,%i): " (fst keyvalue) (snd keyvalue)
let expanded = nmap |> Map.map (fun k v -> pruneWithKeyValue keyvalue v)
NestedMap.Object(expanded |> Map.filter (fun k v -> v <> NestedMap.Object (Map.empty)))
| _ -> NestedMap.Object (Map.empty)
let pruned = pruneWithKeyValue ("S",20) l1
let remainsTheSame = (pruned = l1)
results in (yeah) the desired result:
Expanding w keyvalue: (S,20):
>>> Found match :
ck = S
tgtKey and tgtVal == S, 20
Expanding w keyvalue: (S,20):
Expanding w keyvalue: (S,20):
val pruneWithKeyValue : string * int -> json:NestedMap -> NestedMap
val pruned : NestedMap =
Object
(map
[("A", Object (map [("C", Value 10); ("D", Value 30); ("S", Value 20)]))])
val remainsTheSame : bool = false
It may be trivial but I don't understand where and how keyvalue ends up being modified, preventing me from getting the right output with parametric key-value tuple.
You can't pattern match against existing variables, in your original code tgtKey and tgtVal will be new bindings, not related to the existing ones which will be shadowed.
So change your match:
match (ck, cv) with
| (tgtKey, NestedMap.Value(tgtVal)) ->
to:
match (ck, cv) with
| (k, NestedMap.Value v) when (k, v) = (tgtKey, tgtVal) ->
or just:
match (ck, cv) with
| x when x = (tgtKey, NestedMap.Value(tgtVal)) ->

Find unique array of tuples

I have 4 arrays of different data. For the first array of string, I want to delete the duplicate element and get the results of array of unique tuples with 4 elements.
For example, let's say the arrays are:
let dupA1 = [| "A"; "B"; "C"; "D"; "A" |]
let dupA2 = [| 1; 2; 3; 4; 1 |]
let dupA3 = [| 1.0M; 2.0M; 3.0M; 4.0M; 1.0M |]
let dupA4 = [| 1L; 2L; 3L; 4L; 1L |]
I want the result to be:
let uniqueArray = [| ("A", 1, 1.0M, 1L); ("B", 2, 2.0M, 2L); ("C", 3, 3.0M, 3L); ("D",4, 4.0M, 4L) |]
You will first need to write a zip4 function which will zip the arrays:
// the function assumes the 4 arrays are of the same length
let zip4 a (b : _ []) (c : _ []) (d : _ []) =
Array.init (Array.length a) (fun i -> a.[i], b.[i], c.[i], d.[i])
Then a distinct function for arrays, using Seq.distinct:
let distinct s = Seq.distinct s |> Array.ofSeq
And the result would be:
> zip4 dupA1 dupA2 dupA3 dupA4 |> distinct;;
val it : (string * int * decimal * int64) [] =
[|("A", 1, 1.0M, 1L); ("B", 2, 2.0M, 2L); ("C", 3, 3.0M, 3L);
("D", 4, 4.0M, 4L)|]
let zip4 s1 s2 s3 s4 =
Seq.map2 (fun (a,b)(c,d) ->a,b,c,d) (Seq.zip s1 s2)(Seq.zip s3 s4)
let uniqueArray = zip4 dupA1 dupA2 dupA3 dupA4 |> Seq.distinct |> Seq.toArray

Resources