Difficulty in writing Red Black Tree in F# - algorithm

I am writing a red black tree in F#.
the code which I have written is below. I am facing 2 problems with this code
The rules of balancing the tree state that when the tree has a XYr or rXY type of imbalance I must recolor the 2 parent nodes and IF the grand parent node is not ROOT of the tree then it should be recolored as well.
The difficulty here is that in the recursive approach I only get the next node to work on.. so its hard to know what is the root node.
IN order to solve the above, I added another integer called height to my Node type (type node = Node of int * int * color). That made my pattern matching code in balanceTree function pretty long... but the problem is that when I recolor the grandparent the tree becomes imbalanced because the grand-grand-parent and grand-parent can be red in color which is not allowed.
Can someone recommend a clean way of resolving the issue.
type Color =
| R
| B
type tree =
| Node of int * Color * tree * tree
| Empty
let countNodes tree =
let rec incrCount = function
| Empty -> 0
| Node(_, _, n1, n2) -> 1 + (incrCount n1) + (incrCount n2)
incrCount tree
let isTreeValid tree =
let getTreeBlackNodeHeight tree =
let rec getNodeHeight acc = function
| Empty -> acc + 1
| Node(_, R, n1, _) -> getNodeHeight acc n1
| Node(_, B, n1, _) -> getNodeHeight (acc + 1) n1
getNodeHeight 0 tree
let isRootNodeBlack = function
| Empty -> true
| Node(_, B, _, _) -> true
| Node(_, R, _, _) -> false
let rec areAllBlackHeightsSame height acc = function
| Empty ->
if (acc + 1) = height then true else false
| Node(_, R, n1, n2) -> areAllBlackHeightsSame height acc n1 && areAllBlackHeightsSame height acc n2
| Node(_, B, n1, n2) -> areAllBlackHeightsSame height (acc + 1) n1 && areAllBlackHeightsSame height (acc + 1) n2
let allRedsMustHaveBlackChildren tree =
let getRootNodeColor = function
| Empty -> Color.B
| Node(_, y, _, _) -> y
let rec checkChildColor = function
| Empty -> true
| Node(_, R, n1, n2) -> getRootNodeColor n1 = Color.B && getRootNodeColor n2 = Color.B && checkChildColor n1 && checkChildColor n2
| Node(_, B, n1, n2) -> (checkChildColor n1) && (checkChildColor n2)
checkChildColor tree
(areAllBlackHeightsSame (getTreeBlackNodeHeight tree) 0 tree) && (isRootNodeBlack tree) && (allRedsMustHaveBlackChildren tree)
let insert x tree =
let rec createNode = function
| Empty -> if (countNodes tree) = 0 then Node(x, B, Empty, Empty) else Node(x, R, Empty, Empty)
| Node(i, c, n1, n2) when x > i -> Node(i, c, n1, (createNode n2))
| Node(i, c, n1, n2) when x < i -> Node(i, c, (createNode n1), n2)
| Node(i, _, _, _) when x = i -> failwith "Node already exists"
| _ -> failwith "unknown"
createNode tree
let colorToggle = function
| (i, B) -> (i, R)
| (i, R) -> (i, B)
let balanceTree tree =
let rec balance = function
| Node(gpv, B, Node(p1v, R, Node(c1v, R, a, b), c), Node(p2v, R, d, e)) -> balance (Node(gpv, B, Node(p1v, B, Node(c1v, R, a, b), c), Node(p2v, B, d, e)))
| Node(gpv, B, Node(p1v, R, a, Node(c2v, R, b, c)), Node(p2v, R, d, e)) -> balance (Node(gpv, B, Node(p1v, B, a, Node(c2v, R, b, c)), Node(p2v, B, e, e)))
| Node(gpv, B, Node(p1v, R, a, b), Node(p2v, R, Node(c1v, R, c, d), e)) -> balance (Node(gpv, B, Node(p1v, B, a, b), Node(p2v, B, Node(c1v, R, c, d), e)))
| Node(gpv, B, Node(p1v, R, a, b), Node(p2v, R, c, Node(c2v, R, d, e))) -> balance (Node(gpv, B, Node(p1v, B, a, b), Node(p2v, B, c, Node(c2v, R, d, e))))
| Node(gpv, B, x4, Node(pv, R, x1, Node(cv, R, x2, x3))) -> balance (Node(pv, B, Node(gpv, R, x4, x1), Node(cv, R, x2, x3)))
| Node(gpv, B, x4, Node(pv, R, Node(cv, R, x1, x2), x3)) -> balance (Node(pv, B, Node(gpv, R, x4, Node(cv, B, x1, x2)), x3))
| Node(gpv, B, Node(pv, R, x1, Node(cv, R, x2, x3)), x4) -> balance (Node(pv, B, x1, Node(gpv, R, Node(cv, R, x2, x3), x4)))
| Node(gpv, B, Node(pv, R, Node(cv, R, x1, x2), x3), x4) -> balance (Node(pv, B, (Node(cv, R, x1, x2)), Node(gpv, R, x3, x4)))
| Node(i, x, n1, n2) -> Node(i, x, (balance n1), (balance n2))
| Empty -> Empty
balance tree
[<EntryPoint>]
let main args =
//let t1 = Node((35, B), Node((20, R), Node((10, B), Node((5, R), Empty, Empty), Empty), Node((25, B), Empty, Empty)), Node((85, R), Node((55, B), Node((40, R), Empty, Empty), Node((70, R), Empty, Empty)), Node((100, B), Empty, Empty)))
let t2 = [1 .. 6] |> List.fold (fun acc i-> insert i acc) Empty
printfn "Is Tree Valid : %b" (isTreeValid t2)
let t3 = balanceTree t2
printfn "is Tree Valid : %b" (isTreeValid t3)
0

Standard ML-style implementation in F# looks like this:
type color = R | B
type 'a tree = E | T of color * 'a tree * 'a * 'a tree
let balance = function
| B, T (R, T (R,a,x,b), y, c), z, d
| B, T (R, a, x, T (R,b,y,c)), z, d
| B, a, x, T (R, T (R,b,y,c), z, d)
| B, a, x, T (R, b, y, T (R,c,z,d)) -> T (R, T (B,a,x,b), y, T (B,c,z,d))
| col, a, x, b -> T (col, a, x, b)
let insert x s =
let rec ins = function
| E -> T (R,E,x,E)
| T (col,a,y,b) as s ->
if x < y then
balance (col, ins a, y, b)
elif x > y then
balance (col, a, y, ins b)
else
s
match ins s with
| T (_,a,y,b) -> T (B,a,y,b)
| t -> t

Related

Prolog finding target number in a list by applying operations (+,-,/,*)

The task is to find if there exists at least one combination of numbers from given list and operators to obtain target number. No usemodule allowed
numbers([3,4,1,2], 7) → true. (cause 4 + 3 = 7)
numbers([1,7,7,3], 24) → true. (cause (7 - 3) * (7 - 1) = 24)
Tried member if target is already in the list. But lost further
Building upon https://professor-fish.blogspot.com/2009/11/countdown-with-prolog.html
solve_countdown(Ns, SumWanted, TsUniq) :-
findall(T, (
any_comb(Ns, Sub),
num_combs(Sub, T),
SumWanted is T
), Ts),
sort(Ts, TsUniq).
any_comb(_, []).
any_comb([H|T], [E|Comb]) :-
select(E, [H|T], Lst0),
any_comb(Lst0, Comb).
num_combs([N], N).
num_combs(As, T) :-
split_list_in_2(As, As1, As2),
num_combs(As1, T1),
num_combs(As2, T2),
% Break symmetry, since 5+2 is same as 2+5
( T1 #=< T2,
( T = T1 + T2
; T1 > 1, T = T1 * T2
)
; T = T1 - T2
; T = T1 / T2
),
R is T,
integer(R),
R #> 0.
split_list_in_2([H1, H2|T], [H1|Start], Remainder) :-
split_list_in_2_(T, H2, Start, Remainder).
split_list_in_2_(L, H2, [], [H2|L]).
split_list_in_2_([H|T], H2, [H2|Start], Remainder) :-
split_list_in_2_(T, H, Start, Remainder).
Result in swi-prolog:
?- time(solve_countdown([1,7,7,3], 24, Ts)).
% 10,996 inferences, 0.002 CPU in 0.002 seconds (99% CPU, 5236642 Lips)
Ts = [3*(1+7), (7-1)*(7-3)].
select/3 code is here.
Squeezing the lemon. I get a slightly faster version.
The logic replicates this paper:
https://www.cs.nott.ac.uk/~pszgmh/countdown.pdf
But adds forward checking:
% solve(+Integer, -Term, +Integer, +List, -List)
solve(1, N, N, P, Q) :- !, select(N, P, Q).
solve(K, G, N, P, Q) :-
J is K-1,
between(1, J, I),
L is K-I,
solve2(I, E, A, P, H),
forward(E, A, F, B, G, N),
solve(L, F, B, H, Q).
forward(E, A, F, B, E+F, N) :- N > A, B is N-A, A =< B.
forward(E, A, F, B, E-F, N) :- A > N, B is A-N.
forward(E, A, F, B, E*F, N) :- N mod A =:= 0, B is N div A, A =< B, A =\= 1.
forward(E, A, F, B, E/F, N) :- A mod N =:= 0, B is A div N, B =\= 1.
% solve2(+Integer, -Term, -Integer, +List, -List)
solve2(1, N, N, P, Q) :- !, select(N, P, Q).
solve2(K, G, N, P, Q) :-
J is K-1,
between(1, J, I),
L is K-I,
solve2(I, E, A, P, H),
solve2(L, F, B, H, Q),
combine(E, A, F, B, G, N).
combine(E, A, F, B, E+F, N) :- A =< B, N is A+B.
combine(E, A, F, B, E-F, N) :- A > B, N is A-B.
combine(E, A, F, B, E*F, N) :- A =< B, A =\= 1, N is A*B.
combine(E, A, F, B, E/F, N) :- B =\= 1, A mod B =:= 0, N is A div B.
Example run with SWI-Prolog 9.1.4:
% time((between(1,6,N), solve(N, E, 999, [1,3,5,10,25,50], _), fail; true)).
% % 2,618,953 inferences, 0.234 CPU in 0.242 seconds (97% CPU, 11174199 Lips)
% true.

Getting array/list element index

I was trying to solve this little problem from LeetCode:
-module(two_sum).
-export([main/2]).
-spec main(List :: list(), Target :: non_neg_integer()) -> list().
%%%==================================================================
%%% Export
%%%==================================================================
main(List, Target) ->
P = [{string:str(List, [X]), string:str(List, [Y]), X + Y} || X <- List, Y <- List, Y > X andalso X + Y =:= Target],
io:format("Result: ~w~n", [P]).
%%[X + Y || X <- List, Y <- List, Y > X].
%%iterate(List, Target, 0, {}).
%%%==================================================================
%%% Internal
%%%==================================================================
iterate([], _Target, _Sum, _Result) -> {};
iterate([H | T], Target, Sum, Result) ->
%%io:format("H >> ~w; T >> ~w, Target >> ~w~n", [H, T, Target]).
Acc = Sum + H,
case Acc =:= Target of
true -> erlang:append_element(Result, H);
false -> iterate(T, Target, Acc, Result)
end.
My questions are:
Is there a more efficient way to get the element's index from an array/list? Currently I'm using this: {string:str(List, [X]), but I'm not sure if that's correct, although it gets the job done.
If I happen to get, for instance, a result like this: R = [{1,2,9},{1,3,13},{1,4,17},{2,3,18},{2,4,22},{3,4,26}], how do I pattern match for {1,2,9}, knowing that 9 is Target? I tried [{X1, X2, Target}] = R...but it didn't like it!
How about this. For each element, check its sum with each subsequent element in the list, carrying along the two indices, to be used to report to the user if a match is found.
find_indices(Target, [_H | T] = L) ->
find_indices(Target, L, T, 0, 1).
find_indices(_Target, [_], [], _I, _J) ->
io:format("No match~n");
find_indices(Target, [_Curr | LeftRest], [], I, _J) ->
find_indices(Target, LeftRest, tl(LeftRest), I + 1, I + 2);
find_indices(Target, [Curr | _LeftRest], [Other | _RightRest], I, J)
when Target =:= Curr + Other ->
io:format("Match at indices ~p and ~p: ~p + ~p = ~p~n",
[I, J, Curr, Other, Target]),
ok;
find_indices(Target, L, [_Other | RightRest], I, J) ->
find_indices(Target, L, RightRest, I, J + 1).
Example:
1> index:find_indices(7, [1,2,3,4,5,6]).
Match at indices 2 and 3: 3 + 4 = 7
ok
2> index:find_indices(11, [1,2,3,4,5,6]).
Match at indices 4 and 5: 5 + 6 = 11
ok
3> index:find_indices(12, [1,2,3,4,5,6]).
No match
ok
4> index:find_indices(4, [1,2,3,4,5,6]).
Match at indices 0 and 2: 1 + 3 = 4
ok

How to get the value of many elements of a matrix (list of lists)

I have problems because I want to get the values of many grids of a matrix
Example:
I have this matrix (list of lists)
[[g,z,n,d,o,g,r,o,y,c],
[a,u,u,d,p,o,x,s,t,b],
[u,y,z,r,r,e,m,e,e,o],
[g,v,j,m,x,e,j,e,h,l],
[e,r,u,y,d,z,k,b,r,x],
[e,d,h,n,c,y,q,e,x,i],
[w,f,m,w,x,n,n,m,h,i],
[y,d,g,u,q,d,z,o,n,d],
[g,p,o,u,c,o,n,f,x,q],
[c,y,z,r,i,c,a,t,x,v]]
I want to get the word "dog" from this matrix, this word is in the coordinates (0 3) (0 4) (0 5).
Now the problem is how I can do this in prolog?
My code so far:
selectElementList(0,[H|_],H).
selectElementList(P,[H|T],E):-
length([H|T],Len),
( P < Len
-> P1 is P - 1,
selectElementList(P1,T,E),
!
; E = false,
!
).
With this predicate I get one value of the matrix.
selectGridMatrix(Matrix,X,Y,R):-
selectElementList(X,Matrix,Row), selectElementList(Y,Row,R).
Example:
?- selectGridMatrix([[0,1,2],[3,4,5]],0,0,R).
R = 0 ;
an example, using builtin nth0/3 and library(yall):
?- M= [[g,z,n,d,o,g,r,o,y,c],
[a,u,u,d,p,o,x,s,t,b],
[u,y,z,r,r,e,m,e,e,o],
[g,v,j,m,x,e,j,e,h,l],
[e,r,u,y,d,z,k,b,r,x],
[e,d,h,n,c,y,q,e,x,i],
[w,f,m,w,x,n,n,m,h,i],
[y,d,g,u,q,d,z,o,n,d],
[g,p,o,u,c,o,n,f,x,q],
[c,y,z,r,i,c,a,t,x,v]], maplist({M}/[(R,C),V]>>(nth0(R,M,Row),nth0(C,Row,V)),[(0,3),(0,4),(0,5)],Word).
M = [[g, z, n, d, o, g, r, o|...], [a, u, u, d, p, o, x|...], [u, y, z, r, r, e|...], [g, v, j, m, x|...], [e, r, u, y|...], [e, d, h|...], [w, f|...], [y|...], [...|...]|...],
Word = [d, o, g].
HTH

Bertrand Russell Puzzle

Solve the following Caliban problem, translating each clue
'loyally' into Prolog, i.e. as loyally as possible.
As a simple exercise in abstraction suppose that four meaningless
symbols a, b, c, and d correspond in one order or another to the
equally meaningless symbols w, x, y, and z, and suppose further that
If a is not x, then c is not y.
If b is either y or z, then a is x.
If c is not w, then b is z.
If d is y, then b is not x.
If d is not x, then b is x.
In what order do the two sets of symbols correspond?
I tried the following code:
vban(L) :-
L=[[a,C1],[b,C2],[c,C3],[d,C4]],
( member(C1,[w,y,z]) -> member(C3,[w,x,z])),
( member(C2,[y,z]) -> member(C1,[x])),
( member(C3,[x,y,z]) -> member(C2,[z])),
( member(C4,[y]) -> member(C2,[w,y,z])),
( member(C4,[w,y,z]) -> member(C2,[x])).
But it shows fail.Any help would be appreciated.
Using CLP(B) in SICStus Prolog or SWI:
:- use_module(library(clpb)).
:- use_module(library(lists)).
:- use_module(library(clpfd)).
corresponding(Matrix) :-
Matrix = [[ _,AX, _, _],
[ _,BX,BY,BZ],
[CW, _,CY, _],
[ _,DX,DY, _]],
maplist(card1, Matrix),
transpose(Matrix, TMatrix),
maplist(card1, TMatrix),
sat(~AX =< ~CY),
sat(BY + BZ =< AX),
sat(~CW =< BZ),
sat(DY =< ~BX),
sat(~DX =< BX).
card1(Vs) :- sat(card([1], Vs)).
Example query:
?- corresponding(Vs),
pairs_keys_values(Pairs, [t,a,b,c,d], [[w,x,y,z]|Vs]),
maplist(writeln, Pairs).
Yielding (1 denotes corresponding elements):
t-[w,x,y,z]
a-[0,0,1,0]
b-[0,1,0,0]
c-[1,0,0,0]
d-[0,0,0,1]
and bindings for Vs and Pairs.
Direct translation of the problem statement to ECLiPSe Prolog with ic_symbolic constraint programming library:
:- lib(ic).
:- lib(ic_symbolic).
:- local domain(symbol(w,x,y,z)).
russel(A, B, C, D) :-
[A, B, C, D] &:: symbol,
(A &\= x) => (C &\= y),
(B &= y or B &= z) => (A &= x),
(C &\= w) => (B &= z),
(D &= y) => (B &\= x),
(D &\= x) => (B &= x),
ic_symbolic:alldifferent([A, B, C, D]),
ic_symbolic:indomain(A),
ic_symbolic:indomain(B),
ic_symbolic:indomain(C),
ic_symbolic:indomain(D).
Solution:
[eclipse]: russel(A,B,C,D).
A = y
B = x
C = w
D = z
Yes
I like Mat's solution, but to solve the problem, we can write logical expressions with "and" and "or".
a, b, c et d can be symbolised with [0,0], [0,1], [1,0] and [1,1].
Two numbers M and N are equals if (M1 = N1 and M2 = N2)
Two numbers are differents if (M1 \= N1) or (M2 \= N2) (or not(equals) )
Implication u => v is translated in not(u) or v
So we get :
:- use_module(library(clpb)).
:- use_module(library(lambda)).
or(A,B,A+B).
and(A,B,A*B).
% two numbers are equal
equal(A, B, Eq) :-
foldl(\X^Y^Z^T^and(Z, (X =:= Y), T), A, B, 1, Eq).
% two numbers are different
different(A, B, Diff) :-
equal(A,B,Eq),
Diff = ~Eq.
% foldl(\X^Y^Z^T^or(Z, (X =\= Y), T), A, B, 0, Diff).
puzzle :-
A = [0,0],
B = [0,1],
C = [1,0],
D = [1,1],
W = [_,_],
X = [_,_],
Y = [_,_],
Z = [_,_],
% If a is not x, then c is not y.
% (a is x) or (c is not y)
equal(A, X, Eq1),
different(C, Y, Di1),
or(Eq1, Di1, P1),
% If b is either y or z, then a is x.
% (b is not y) and (b is not z) or (a is x)
different(B, Y, Di2),
different(B, Z, Di3),
equal(A, X, Eq2),
and(Di2, Di3, P2),
or(Eq2, P2, P3),
% If c is not w, then b is z.
% (c is w) or (b is z)
equal(C, W, Eq3),
equal(B, Z, Eq4),
or(Eq3, Eq4, P4),
% If d is y, then b is not x.
% (d is not y) or (b is not x)
different(D, Y, Di4),
different(B, X, Di5),
or(Di4, Di5, P5),
% If d is not x, then b is x.
%(d is x) or (b is x)
equal(D, X, Eq5),
equal(B, X, Eq6),
or(Eq5, Eq6, P6),
% we must express that W,X,Y,Z are differents
% W is different from X, Y, Z
foldl(W +\R^S^T^(different(W, R, U),
and(S, U, T)),
[X,Y,Z], 1, Dif1),
% X is different from Y, Z
foldl(X +\R^S^T^(different(X, R, U),
and(S, U, T)),
[Y,Z], 1, Dif2),
% Y is different from Z
different(Y, Z, Dif3),
% now we join all these expressions with an and
Expr = *([P1,P3,P4,P5,P6, Dif1,Dif2, Dif3]),
% we ask Prolog to count the number of solutions
sat_count(Expr, N),
writeln(N : ' solution(s)'),
% we ask Prolog to satisfy the expr
sat(Expr),
maplist(writeln, [A, B, C, D]), nl,
maplist(writeln, [W, X, Y, Z]).
We get :
?- puzzle.
1: solution(s)
[0,0]
[0,1]
[1,0]
[1,1]
[1,0]
[0,1]
[0,0]
[1,1]
true.

Red Black Tree contains too many black nodes and too few red nodes

This is further to the question I had asked here
Difficulty in writing Red Black Tree in F#
Based on previous inputs, I have created this program.
open System;
type Color = | R | B
type tree =
| Node of int * Color * tree * tree
| Leaf
let blackHeight tree =
let rec innerBlackHeight accm = function
| Leaf -> accm + 1
| Node(_, B, l, r) -> List.max [(innerBlackHeight (accm + 1) l); (innerBlackHeight (accm + 1) r)]
| Node(_, R, l, r) -> List.max [(innerBlackHeight accm l); (innerBlackHeight accm r)]
innerBlackHeight 0 tree
let isTreeBalanced tree =
let rec isBlackHeightSame = function
| Node(n, c, l, r) ->
if (blackHeight l) = (blackHeight r) then
true && (isBlackHeightSame l) && (isBlackHeightSame r)
else
false
| Leaf -> true
let isRootBlack = function
| Node(n, c, _, _) ->
if c = B then
true
else
false
| _ -> false
let rec twoConsequtiveReds = function
| Leaf -> true
| Node(_, R, Node(_, R, _, _), _) -> false
| Node(_, R, _, Node(_, R, _, _)) -> false
| Node(_, _, l, r) -> (twoConsequtiveReds l) && (twoConsequtiveReds r)
((isBlackHeightSame tree) && (isRootBlack tree) && (twoConsequtiveReds tree))
let balance = function
| Node (gpn, B, Node(pn, R, Node(cn, R, a, b), c), d) -> Node(pn, R, Node(cn, B, a, b), Node(gpn, B, c, d))
| Node (gpn, B, a, Node(pn, R, b, Node(cn, R, c, d))) -> Node(pn, R, Node(gpn, B, a, b), Node(cn, B, c, d))
| Node (gpn, B, Node(pn, R, a, Node(cn, R, b, c)), d) -> Node(cn, R, Node(pn, B, a, b), Node(gpn, B, c, d))
| Node (gpn, B, a, Node(pn, R, Node(cn, R, b, c), d)) -> Node(cn, R, Node(gpn, B, a, b), Node(pn, B, c, d))
| Node (n, c, l, r) -> Node(n, c, l, r)
| _ -> failwith "unknown pattern"
let rec insert x tree =
let rec insertInner = function
| Node(n, c, l, r) when x < n -> balance (Node(n, c, insertInner l, r))
| Node(n, c, l, r) when x > n -> balance (Node(n, c, l, insertInner r))
| Node(n, c, l, r) as node when x = n -> node
| Leaf -> Node(x, R, Leaf, Leaf)
| _ -> failwith "unknown pattern"
match (insertInner tree) with
| Node(n, _, l, r) -> Node(n, B, l, r)
| t -> t
let rec findLowest = function
| Node(n, _, Leaf, _) -> n
| Node(_, _, l, _) -> findLowest l
| _ -> failwith "Unknown pattern"
let rec countNodes = function
| Node(_, c, l, r) ->
let (x1, y1, z1) = countNodes l
let (x2, y2, z2) = countNodes r
if c = B then
(1 + x1 + x2, y1 + y2, z1 + z2)
else
(x1 + x2, 1 + y1 + y2, z1 + z2)
| Leaf -> (0, 0, 1)
let rec delete x tree =
let rec innerDelete = function
| Node(n, c, l, r) when x < n -> balance (Node(n, c, innerDelete l, r))
| Node(n, c, l, r) when x > n -> balance (Node(n, c, l, innerDelete r))
| Node(n, c, Leaf, Leaf) when x = n -> Leaf
| Node(n, c, l, Leaf) when x = n -> balance l
| Node(n, c, Leaf, r) when x = n -> balance r
| Node(n, c, l, r) when x = n -> balance (Node((findLowest r), c, l, r))
| _ -> failwith "unexpected pattern"
match (innerDelete tree) with
| Node(n, _, l, r) -> Node(n, B, l, r)
| t -> t
let generateNums n =
seq {for i in 0 .. n - 1 -> i}
[<EntryPoint>]
let main args =
let mutable tree = Leaf
for i in generateNums 100000 do
tree <-insert i tree
printfn "%A" tree
printfn "%i" (blackHeight tree)
printfn "%b" (isTreeBalanced tree)
let (bc, rc, lc) = countNodes tree
printfn "black nodes %i red nodes %i leaf nodes %i" bc rc lc
0
The problems which I am facing is
For a tree of 0 to 99999 it produces a tree with 99994 black nodes 6 red nodes and 100001 leaf nodes.
Is this normal? that the tree has so few red nodes?
I have written a function to validate if the tree is valid based on the 3 rules (root is always black, black height is same for all branches and red nodes don't have red children) and my method says that the generated tree is indeed valid.
the problem with too many black nodes is that is that certain branches are full of black nodes and if i try to delete a node, then rotations don't help in balancing the tree and the black height of that branch is always less than the other branches of the tree.
So my questions are... is it normal for a red black tree to have too few red nodes? in that case how do you keep the tree balanced in case of deletions?
There's no such thing as "too many black nodes". No red nodes at all means the tree is the most balanced. Introducing new red nodes into an all-black tree increases its imbalance (at first).
When deleting a black node in an all-black tree you follow the deletion algorithm, which ensures that the properties are preserved.

Resources