Et paf ! Un sujet de tp d'algorithimie !
This commit is contained in:
parent
5ddf3c740c
commit
800a3a7e6e
559
ppvoisin.ml
Normal file
559
ppvoisin.ml
Normal 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;;
|
||||
Loading…
x
Reference in New Issue
Block a user