Et paf ! Un sujet de tp d'algorithimie !

This commit is contained in:
Mysaa 2021-03-06 18:48:56 +01:00
parent 5ddf3c740c
commit 800a3a7e6e

559
ppvoisin.ml Normal file
View File

@ -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;;