From 800a3a7e6e7e66c2acaf996e49d892d9edf08a51 Mon Sep 17 00:00:00 2001
From: Mysaa <mysaa@debitude2.home>
Date: Sat, 6 Mar 2021 18:48:56 +0100
Subject: [PATCH] Et paf ! Un sujet de tp d'algorithimie !

---
 ppvoisin.ml | 559 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 559 insertions(+)
 create mode 100644 ppvoisin.ml

diff --git a/ppvoisin.ml b/ppvoisin.ml
new file mode 100644
index 0000000..d399666
--- /dev/null
+++ b/ppvoisin.ml
@@ -0,0 +1,559 @@
+let u0 = 1917546;;
+let u0 = 42;;
+
+let rec u n = match n with
+	| 0 -> u0
+	| n -> u (n-1);;
+	
+let nu=100000000;;
+let uu = let out = Array.make nu u0 in
+	for i=1 to (nu-1) do
+		out.(i) <- (out.(i-1)*19999999) mod 19999981
+	done;
+	out;;
+let u n = uu.(n);;
+
+let getxy d n m = 
+	let xx = Array.make n [||] in
+	let yy = Array.make m [||] in
+	for i=0 to (n-1)
+	do
+		xx.(i) <- Array.make d 0;
+		for k=0 to (d-1)
+		do
+			xx.(i).(k) <- (u ((i*d)+k)) mod 1000
+		done
+	done;
+	for j=0 to (m-1) do
+		yy.(j) <- Array.make d 0;
+		for k=0 to (d-1)
+		do
+			yy.(j).(k) <- (u ((n+j)*d+k)) mod 1000
+		done
+	done;
+	(xx,yy);;
+
+let xa,ya=getxy 128 1000 10000;;
+let xb,yb=getxy 200 1000 10000;;
+let xc,yc=getxy 128 100 10000;;
+
+print_endline "###############################";
+print_int xa.(33).(13);
+print_string ";";
+print_int ya.(123).(43);
+print_endline "";
+print_int xb.(33).(13);
+print_string ";";
+print_int yb.(123).(43);
+print_endline "";
+print_int xc.(33).(13);
+print_string ";";
+print_int yc.(123).(43);
+print_endline "";;
+
+(* Q2 *)
+
+let xa,ya = getxy 1 100000 1;;
+let xb,yb = getxy 32 100000 1;;
+let xc,yc = getxy 128 100000 1;;
+
+let carre x = x*x;;
+
+let dist x y = 
+	let d = Array.length x in
+	let sum = ref 0 in
+	for i=0 to (d-1) do
+		sum := !sum + (carre (x.(i)-y.(i)))
+	done;
+	!sum;;
+let minindex tab =
+	let n = Array.length tab in
+	let minidx = ref 0 in
+	for i=1 to (n-1)
+	do
+		if tab.(i) < tab.(!minidx)
+		then minidx := i
+	done;
+	!minidx;;
+let ppvnaif0 xx y =
+	let n = Array.length xx in
+	let dists = Array.make n (-1) in
+	for i=0 to (n-1)
+	do
+		dists.(i) <- dist xx.(i) y
+	done;
+	minindex dists;;
+
+
+print_endline "###############################";
+print_endline (string_of_int (ppvnaif0 xa ya.(0)));
+print_endline (string_of_int (ppvnaif0 xb yb.(0)));
+print_endline (string_of_int (ppvnaif0 xc yc.(0)));;
+
+(* Q3 *)
+
+let count tab v = 
+	let n = Array.length tab in
+	let cnt = ref 0 in
+	for i=0 to (n-1)
+	do
+		if (tab.(i) = v)
+		then incr cnt
+	done;
+	!cnt;;
+
+let ppvnaif xx yy =
+	let m = Array.length yy in
+	let ppidx = Array.make m (-1) in
+	for j=0 to m-1
+	do
+		ppidx.(j) <- (ppvnaif0 xx yy.(j))
+	done;
+	ppidx;;
+
+let xx,yy = getxy 32 100 10000;;
+let rstxy = ppvnaif xx yy;;
+print_endline "###############################";
+print_endline (string_of_int (count rstxy 12));
+print_endline (string_of_int (count rstxy 34));
+print_endline (string_of_int (count rstxy 56));;
+
+(* Q4 *)
+
+let xa,ya = getxy 1 3 1000;;
+let xb,yb = getxy 1 3 10000;;
+let xc,yc = getxy 1 3 100000;;
+let maxindex tab =
+	let n = Array.length tab in
+	let maxidx = ref 0 in
+	for i=1 to (n-1)
+	do
+		if tab.(i) > tab.(!maxidx)
+		then maxidx := i
+	done;
+	!maxidx;;
+
+let maxz xx yy =
+	let n = Array.length xx in
+	let xpg = Array.make (n+1) [||] in
+	for i=0 to n-1 do
+		xpg.(i) <- xx.(i)
+	done;
+	let valz = Array.make 1000 (-1) in
+	for z=0 to 999
+	do
+		print_endline (string_of_int z);
+		xpg.(n) <- [|z|];
+		let rstxy = ppvnaif xpg yy in
+		let vl = count rstxy n in
+		valz.(z) <- vl
+	done;
+	valz.(maxindex valz);;
+
+print_endline "###############################";
+print_endline (string_of_int (maxz xa ya));;
+print_endline (string_of_int (maxz xb yb));;
+print_endline (string_of_int (maxz xc yc));;
+
+
+(* Q5 *)
+type graphe = bool array array;;
+
+exception NoHeadException;;
+let beheadList lst = match lst with
+	| [] -> raise NoHeadException
+	| e::s -> e,s;;
+
+exception NotForAllException;;
+let forall tab = 
+	let n = Array.length tab in
+	try
+	for i=0 to n-1 do
+		if not tab.(i) then raise NotForAllException
+	done;true
+	with NotForAllException -> false;;
+	
+let isEmpty lst = match lst with
+	| [] -> true
+	| e::s -> false;;
+let estConnexe grphe = 
+	let n = Array.length grphe in
+	let dejavu = Array.make n false in
+	let queue = ref [0] in
+	dejavu.(0) <- true;
+	while (not (isEmpty !queue)) do
+		let e,s = beheadList !queue in
+		queue := s;
+		for k=0 to n-1 do
+			if (grphe.(e).(k)||grphe.(k).(e)) && not dejavu.(k)
+			then begin
+				dejavu.(k) <- true;
+				queue := k::!queue
+			end
+		done
+	done;
+	forall dejavu;;
+	
+let depile lst = match !lst with
+	| [] -> raise NoHeadException
+	| e::s -> lst := s;e;;
+let empile lst e = lst := e::!lst;;
+let estConnexe grphe =
+	let n = Array.length grphe in
+	let visitePrevue = Array.make n false in
+	let avoir = ref [0] in
+	
+	
+	while (not (isEmpty !avoir))
+	do
+		let e = depile avoir in
+		for k=0 to n-1 do
+			if (k<>e) && (grphe.(k).(e) || grphe.(e).(k)) && (not visitePrevue.(k))
+			then	(empile avoir k;visitePrevue.(k) <- true)
+		done;
+	done;
+	forall visitePrevue;;
+
+let getdistmat xx = 
+	let n = Array.length xx in
+	let distmat = Array.make_matrix n n (-1) in
+	for i=0 to n-1 do
+	for j=0 to n-1 do
+		distmat.(i).(j) <- dist xx.(i) xx.(j)
+	done
+	done;
+	distmat
+	;;
+
+let getppv dstcol burntIndex = 
+	let n = Array.length dstcol in
+	let out = ref [] in
+	let currentmaxindex = ref ((burntIndex+1) mod n) in (* Faut pas qu'on prenne le burntindex *)
+	for i=0 to n-2 do
+		for k=0 to n-1 do
+			if dstcol.(!currentmaxindex)<dstcol.(k) && k<>burntIndex(* L'inégalité stricte match quand la valeur est -1=déjàvu *)
+			then currentmaxindex := k
+		done;
+		out := !currentmaxindex::!out;
+		dstcol.(!currentmaxindex) <- (-1);
+		currentmaxindex := ((burntIndex+1) mod n)
+	done;
+	!out;;
+
+
+
+let growgraph grph ppv =
+	let n = Array.length grph in
+	for i=0 to n-1
+	do
+		let e,s = beheadList ppv.(i) in
+			ppv.(i) <- s;
+			grph.(i).(e) <- true;
+			grph.(e).(i) <- true
+	done;;
+
+let getppvlist xx distmat = 
+	let n = Array.length xx in
+	let out = Array.make n [] in
+	for i=0 to (n-1)
+	do
+		out.(i) <- getppv distmat.(i) i
+	done;
+	out;;
+
+let rec growUntilConnexe grph ppv k =
+	if estConnexe grph then k
+	else begin
+		growgraph grph ppv;
+		growUntilConnexe grph ppv (k+1)
+	end;;
+
+let getidgrph n = 
+	let out = Array.make_matrix n n false in
+	for i=0 to n-1 do
+		out.(i).(i) <- true
+	done;
+	out;;
+
+
+let getmink xx =
+	let n=Array.length xx in
+	let distmat = getdistmat xx in
+	let ppv = getppvlist xx distmat in
+	growUntilConnexe (getidgrph n) ppv 0;;
+
+
+let xa,ya = getxy 128 100 1;;
+let xb,yb = getxy 30 200 1;;
+let xc,yc = getxy 26 300 1;;
+let xd,yd = getxy 1 1000 1;;
+
+let xx,yy = getxy 5 7 1;;
+getmat xx 2;;
+let n=Array.length xx;;
+let distmat = getdistmat xx;; 
+let ppv = getppvlist xx distmat ;; 
+let mat =  getidgrph n;;
+estConnexe mat;;
+growgraph mat ppv;;
+mat;;
+
+
+print_endline "###############################";;
+getmink xa;;
+getmink xb;;
+getmink xc;;
+getmink xd;;
+
+
+(* Q6 *)
+
+exception AUnAttracteurException;;
+let aAttracteur grph =
+	let n = Array.length grph in
+	try
+		for i=0 to n-1 do
+		if forall grph.(i) then raise AUnAttracteurException
+		done;
+		false
+	with AUnAttracteurException -> true;;
+
+let rec growUntilAttracteur grph ppv k =
+	if aAttracteur grph then k
+	else begin
+		growgraph grph ppv;
+		growUntilAttracteur grph ppv (k+1)
+	end;;
+
+
+let getminkattr xx =
+	let n=Array.length xx in
+	let distmat = getdistmat xx in
+	let ppv = getppvlist xx distmat in
+	growUntilAttracteur (getidgrph n) ppv 0;;
+
+let xa,ya = getxy 128 100 1;;
+let xb,yb = getxy 300 300 1;;
+let xc,yc = getxy 1000 500 1;;
+
+print_endline "###############################";;
+getminkattr xa;;
+getminkattr xb;;
+getminkattr xc;;
+
+
+
+(* Q7 *)
+
+let pgconn grphe = 
+	let n = Array.length grphe in
+	let dejavu = Array.make n false in
+	let queue = ref [] in
+	let maxclkk = ref 0 in
+	let thisclkk = ref 0 in
+	for clk = 0 to n-1 do
+		if not dejavu.(clk) then
+		begin
+			(queue := [clk];
+			dejavu.(clk) <- true;
+			thisclkk := 1;
+			while (not (isEmpty !queue)) do
+				let e,s = beheadList !queue in
+				queue := s;
+				for k=0 to n-1 do
+					if (grphe.(e).(k)||grphe.(k).(e)) && not dejavu.(k)
+					then begin
+						dejavu.(k) <- true;
+						queue := k::!queue;
+						incr thisclkk
+					end
+				done
+			done;
+			print_endline (string_of_int clk);
+			if !thisclkk > !maxclkk
+			then maxclkk := !thisclkk)
+		end
+	done;
+	!maxclkk;;
+
+let rec touchtous k lst grphe = match lst with
+	| [] -> true
+	| e::s -> (grphe.(k).(e)) && (touchtous k s grphe);;
+let pgclique grphe = 
+	let n = Array.length grphe in
+	let dejavu = Array.make n false in
+	let queue = ref [] in
+	let maxclkk = ref 0 in
+	let thisclik = ref [] in
+	for clk = 0 to n-1 do
+		if not dejavu.(clk) then
+		begin
+			(queue := [clk];
+			dejavu.(clk) <- true;
+			thisclik := [clk];
+			while (not (isEmpty !queue)) do
+				let e,s = beheadList !queue in
+				queue := s;
+				for k=0 to n-1 do
+					if not dejavu.(k) && (touchtous k !thisclik grphe) 
+					then begin
+						dejavu.(k) <- true;
+						queue := k::!queue;
+						thisclik := k::!thisclik
+					end
+				done
+			done;
+			if (List.length !thisclik) > !maxclkk
+			then maxclkk := (List.length !thisclik))
+		end
+	done;
+	!maxclkk;;
+
+
+let cliqueRecherche grphe visitePrevue k0 =
+	let n = Array.length grphe in
+	let avoir = ref [k0] in
+	let laclique = ref [k0] in
+	visitePrevue.(k0) <- true;
+	while (not (isEmpty !avoir))
+	do
+		let e = depile avoir in
+		for k=0 to n-1 do
+			if (k<>e) && (touchtous k !laclique grphe) && (not visitePrevue.(k))
+			then	(empile laclique k;empile avoir k;visitePrevue.(k) <- true)
+		done;
+	done;
+	List.length !laclique;;
+
+exception ForAllException;;
+exception OneFalseException of int;;
+let onefalse tab =
+	let n = Array.length tab in
+	try
+		for i=0 to n-1
+		do
+			if not tab.(i) then raise (OneFalseException i)
+		done;
+		raise ForAllException
+	with OneFalseException(k) -> k;;
+
+let pgclique grphe =
+	let n = Array.length grphe in
+	let visitePrevue = Array.make n false in
+	let maxi = ref 0 in
+	while (not (forall visitePrevue))
+	do
+		let k = onefalse visitePrevue in
+		let thisi = cliqueRecherche grphe visitePrevue k in
+			if (!maxi < thisi)
+			then maxi := thisi
+	done;
+	!maxi;;
+
+let getmat xx kk =
+	let n=Array.length xx in
+	let distmat = getdistmat xx in
+	let ppv = getppvlist xx distmat in
+	let grph = getidgrph n in
+	for k=1 to kk do
+		growgraph grph ppv
+	done;
+	grph;;
+
+let xa,ya = getxy 128 100 1;;
+let xb,yb = getxy 200 100 1;;
+let xc,yc = getxy 222 100 1;;
+let xx,yy = getxy 5 10 1;;
+
+getmat xx 1;;
+pgclique (getmat xx 3);;
+print_endline "###############################";;
+pgclique (getmat xa 1);;
+pgclique (getmat xb 20);;
+pgclique (getmat xc 30);;
+
+
+(* Q8 *)
+
+let xa,ya = getxy 2 100_000 10_000;;
+let xb,yb = getxy 2 1_000_000 100_000;;
+let xc,yc = getxy 2 1_000_000 1_000_000;;
+
+(*Solution brute-force*)
+let rstxy = ppvnaif xa ya;;
+let maxrpz tab n =
+	let cnt = Array.make n 0 in
+	let m = Array.length tab in
+	for i=0 to m-1 do
+		cnt.(tab.(i)) <- cnt.(tab.(i))+1
+	done;
+	maxindex cnt;;
+maxrpz rstxy 100000;;
+
+(* Idée: séparer les X en sections puis rechercher dans les sections petit à petit *)
+let sectionnage xx ns =
+	let out = Array.make_matrix ns ns [] in
+	let n = Array.length xx in
+	for i=0 to n-1 do
+		let thex,they = xx.(i).(0)*ns/1000,xx.(i).(1)*ns/1000 in
+		out.(thex).(they) <- (i,xx.(i))::out.(thex).(they)
+	done;
+	out;;
+sectionnage xa 4;;
+
+
+
+
+
+
+
+
+(****** FIN ******)
+
+
+
+
+
+
+let estPlusPresEls yy a b = let ia,va = a and ib,vb = b in
+	(dist va yy < dist vb yy) || (dist va yy = dist vb yy && ia<ib);;
+exception EmptyException;;
+let rec mindistlst yy lst = 
+	match lst with
+		| [] -> raise EmptyException
+		| [e] -> e
+		| e::s -> 
+			let md = mindistlst yy s in
+				if estPlusPresEls yy e md
+				then e
+				else md;;
+
+let ppvmoinsnaif0 sections ns y =
+	(* On suppose pour l'instant que toutes les sections sont remplies *)
+	let tnx,tny = y.(0)*ns/1000,y.(1)*ns/1000 in
+	let mins = ref [] in
+	for i=(if tnx<>0 then -1 else 0) to (if tnx<(ns-1) then 1 else 0) do
+	for j=(if tny<>0 then -1 else 0) to (if tny<(ns-1) then 1 else 0) do
+		try
+			empile mins (mindistlst y sections.(tnx+i).(tny+j))
+		with EmptyException -> ()
+	done
+	done;
+	mindistlst y !mins;;
+let ppvmoinsnaif ns xx yy =
+	let m = Array.length yy in
+	let ppidx = Array.make m (-1) in
+	let sects = sectionnage xx ns in
+	for j=0 to m-1
+	do
+		ppidx.(j) <- fst (ppvmoinsnaif0 sects ns yy.(j))
+	done;
+	ppidx;;
+
+(* J'utilise le fait que vu qu'il y a énormément de valeurs,
+ il est extrèmement peu probable que aucune des sections, ni des huit alentours soient vides.
+ Afin que cet algorithme fonctionne toujours, on pourait réécrire un peu ppvmoinsnaif0 pour qu'il
+  cherche plus loin autour pour trouver le résultat*)
+maxrpz (ppvmoinsnaif 50 xa ya) 100_000;;
+maxrpz (ppvmoinsnaif 500 xb yb) 1_000_000;;
+maxrpz (ppvmoinsnaif 1000 xc yc) 1_000_000;;
\ No newline at end of file