# type'acell={info:'a;mutableprev:'adlist;mutablenext:'adlist}
and'adlist=Empty|Cellof'acell;;type 'a cell = { info: 'a; mutable prev: 'a dlist; mutable next: 'a dlist }type 'a dlist = | Empty | Cell of 'a cell
# letaddx=functionEmpty->Cell{info=x;prev=Empty;next=Empty}|Cellcasl->letnew_cell={info=x;prev=c.prev;next=l}inletnew_dlist=Cellnew_cellinc.prev<-new_dlist;(matchnew_cell.prevwithEmpty->()|Cellpl->pl.next<-new_dlist);new_dlist;;val add : 'a -> 'a dlist -> 'a dlist = <fun>
# letremove_cell=functionEmpty->failwith"enleve"|Cellc->match(c.prev,c.next)withEmpty,Empty->Empty|Cellc1asl,Empty->c1.next<-Empty;l|Empty,((Cellc2)asl)->c2.prev<-Empty;l|Cellc1asl1,(Cellc2asl2)->c1.next<-l2;c2.prev<-l1;l1;;val remove_cell : 'a dlist -> 'a dlist = <fun>
# letrecremovexl=letrecremove_left=functionEmpty->()|Cellcasl->letpl=c.previnifc.info=xthenignore(remove_celll);remove_leftplandremove_right=functionEmpty->()|Cellcasl->letnl=c.nextinifc.info=xthenignore(remove_celll);remove_rightnlinmatchlwithEmpty->Empty|Cellcasl->ifc.info=xthenremovex(remove_celll)else(remove_leftc.prev;remove_rightc.next;l);;val remove : 'a -> 'a dlist -> 'a dlist = <fun>
# typevect=floatarray;;type vect = float array
# typemat=vectarray;;type mat = vect array
# typesyst={m:mat;v:vect};;type syst = { m: mat; v: vect }
# letmy_print_floats=letx=string_of_floatsinlety=matchString.lengthxwith5->x|nwhenn<5->(String.make(5-n)' ')^x|n->String.subx05inprint_stringy;;val my_print_float : float -> unit = <fun>
# letprint_systs=letl=Array.lengths.minfori=0tol-1doprint_string" | ";forj=0tol-1domy_print_floats.m.(i).(j);print_string" "done;ifi=l/2thenprint_string" | * | x"elseprint_string" | | x";print_int(i+1);ifi=l/2thenprint_string" | = | "elseprint_string" | | ";my_print_floats.v.(i);print_string" |";print_newline()done;;val print_syst : syst -> unit = <fun>
# letadd_vectv1v2=letl=Array.lengthv1inletres=Array.createl0.0infori=0tol-1dores.(i)<-v1.(i)+.v2.(i)done;res;;val add_vect : float array -> float array -> float array = <fun>
# letmult_scal_vectxv=letl=Array.lengthvinletres=Array.createl0.0infori=0tol-1dores.(i)<-v.(i)*.xdone;res;;val mult_scal_vect : float -> float array -> float array = <fun>
# letmult_matm1m2=letl1=Array.lengthm1andl2=Array.lengthm2.(0)andl3=Array.lengthm2inletres=Array.create_matrixl1l20.0infori=0tol1-1doforj=0tol2-1dofork=0tol3-1dores.(i).(j)<-res.(i).(j)+.m1.(i).(k)*.m2.(k).(j)donedonedone;res;;val mult_mat : float array array -> float array array -> float array array =<fun>
# letmult_mat_vectmv=letl1=Array.lengthmandl2=Array.lengthvinletres=Array.createl10.0infori=0tol1-1doforj=0tol2-1dores.(i)<-res.(i)+.m.(i).(j)*.v.(j)donedone;res;;val mult_mat_vect : float array array -> float array -> float array = <fun>
# letdiv_systsi=letp=s.m.(i).(i)ins.m.(i).(i)<-1.0;forj=i+1to(Array.lengths.m.(0))-1dos.m.(i).(j)<-s.m.(i).(j)/.pdone;s.v.(i)<-s.v.(i)/.p;;val div_syst : syst -> int -> unit = <fun>
# letpermut_systsij=letaux1=s.m.(i)andaux2=s.v.(i)ins.m.(i)<-s.m.(j);s.v.(i)<-s.v.(j);s.m.(j)<-aux1;s.v.(j)<-aux2;;val permut_syst : syst -> int -> int -> unit = <fun>
# exceptionNot_linear;;exception Not_linear
# lettrigonalizes=ifs.m=[||]||s.v=[||]thenraiseNot_linear;letl=Array.lengths.minifl<>Array.lengths.m.(0)||l<>Array.lengths.vthenraiseNot_linear;fori=0tol-1doifs.m.(i).(i)=0.0thenbeginletj=ref(i+1)inwhile!j<l&&s.m.(!j).(i)=0.0doincrjdone;if!j=lthenraiseNot_linear;permut_systsi!jend;div_systsi;forj=i+1tol-1dos.v.(j)<-s.v.(j)-.s.m.(j).(i)*.s.v.(i);s.m.(j)<-add_vects.m.(j)(mult_scal_vect(-.s.m.(j).(i))s.m.(i))donedone;;val trigonalize : syst -> unit = <fun>
# letsolves=trigonalizes;letl=Array.lengths.vinletres=Array.copys.vinfori=l-1downto0doletx=refres.(i)inforj=i+1tol-1dox:=!x-.s.m.(i).(j)*.res.(j)done;res.(i)<-!xdone;res;;val solve : syst -> float array = <fun>
| AX = |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
* |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
= |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
= Y |
| AX = |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
* |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
= |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
= Y |
| AX = |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
* |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
= |
æ ç ç ç è |
|
ö ÷ ÷ ÷ ø |
= Y |
# letax1={m=[|[|10.0;7.0;8.0;7.0|];[|7.0;5.0;6.0;5.0|];[|8.0;6.0;10.0;9.0|];[|7.0;5.0;9.0;10.0|]|];v=[|32.0;23.0;33.0;31.0|]};;val ax1 : syst ={m=[|[|10; 7; 8; 7|]; [|7; 5; 6; 5|]; [|8; 6; 10; ...|]; ...|]; v=...}
# letr1=solveax1;;val r1 : float array = [|1; 1; 1; 1|]
# letax2={m=[|[|10.0;7.0;8.0;7.0|];[|7.0;5.0;6.0;5.0|];[|8.0;6.0;10.0;9.0|];[|7.0;5.0;9.0;10.0|]|];v=[|32.1;22.9;33.1;30.9|]};;val ax2 : syst ={m=[|[|10; 7; 8; 7|]; [|7; 5; 6; 5|]; [|8; 6; 10; ...|]; ...|]; v=...}
# letr2=solveax2;;val r2 : float array = [|9.2; -12.6; 4.5; -1.1|]
# letax3={m=[|[|10.0;7.0;8.1;7.2|];[|7.08;5.04;6.0;5.0|];[|8.0;5.98;9.89;9.0|];[|6.99;4.99;9.0;9.98|]|];v=[|32.0;23.0;33.0;31.0|]};;val ax3 : syst ={m=[|[|10; 7; 8.1; 7.2|]; [|7.08; 5.04; 6; 5|]; [|8; 5.98; 9.89; ...|];...|];v=...}
# letr3=solveax3;;val r3 : float array = [|-80.9999999999; 137; -33.9999999999; 22|]