From 01ce990c404c3050fa816bf88c0dae98360536cb Mon Sep 17 00:00:00 2001 From: Leandro Lucarella Date: Sun, 23 Mar 2003 07:10:16 +0000 Subject: [PATCH 1/1] =?utf8?q?Import=20inicial=20despu=C3=A9s=20del=20"/va?= =?utf8?q?r=20incident".=20:(?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- doc/Caratulas.sxw | Bin 0 -> 6582 bytes doc/Conclusiones.sxw | Bin 0 -> 9786 bytes doc/Errata.sxw | Bin 0 -> 6449 bytes informes/9C-C-INFORME.TXT | 54 ++ informes/9C-D-INFORME.TXT | 54 ++ informes/9D-C-INFORME.TXT | 54 ++ informes/9D-D-INFORME.TXT | 54 ++ informes/C-C-INFORME.TXT | 54 ++ informes/C-D-INFORME.TXT | 54 ++ informes/D-C-INFORME.TXT | 54 ++ informes/D-D-INFORME.TXT | 54 ++ informes/R-C-INFORME.TXT | 54 ++ informes/R-D-INFORME.TXT | 54 ++ src/comp-dbg.pas | 1662 ++++++++++++++++++++++++++++++++++++ src/comp.pas | 1667 +++++++++++++++++++++++++++++++++++++ test/IRDnames.pas | 319 +++++++ test/ORDnames.pas | 332 ++++++++ test/RNDnames.pas | 244 ++++++ test/SORTINGMetodos.pas | 435 ++++++++++ test/cargar.pas | 244 ++++++ test/comp_.pas | 1002 ++++++++++++++++++++++ test/msdemo.pas | 240 ++++++ test/qsdemo.pas | 187 +++++ test/qsort.pas | 57 ++ test/shellsort.pas | 39 + test/temp.pas | 40 + test/testrnd.cpp | 10 + test/testrnd.pas | 94 +++ test/tsrndnms.pas | 229 +++++ test/turbo.dsk | Bin 0 -> 1834 bytes 30 files changed, 7341 insertions(+) create mode 100644 doc/Caratulas.sxw create mode 100644 doc/Conclusiones.sxw create mode 100644 doc/Errata.sxw create mode 100644 informes/9C-C-INFORME.TXT create mode 100644 informes/9C-D-INFORME.TXT create mode 100644 informes/9D-C-INFORME.TXT create mode 100644 informes/9D-D-INFORME.TXT create mode 100644 informes/C-C-INFORME.TXT create mode 100644 informes/C-D-INFORME.TXT create mode 100644 informes/D-C-INFORME.TXT create mode 100644 informes/D-D-INFORME.TXT create mode 100644 informes/R-C-INFORME.TXT create mode 100644 informes/R-D-INFORME.TXT create mode 100644 src/comp-dbg.pas create mode 100644 src/comp.pas create mode 100644 test/IRDnames.pas create mode 100644 test/ORDnames.pas create mode 100644 test/RNDnames.pas create mode 100644 test/SORTINGMetodos.pas create mode 100644 test/cargar.pas create mode 100644 test/comp_.pas create mode 100644 test/msdemo.pas create mode 100644 test/qsdemo.pas create mode 100644 test/qsort.pas create mode 100644 test/shellsort.pas create mode 100644 test/temp.pas create mode 100644 test/testrnd.cpp create mode 100644 test/testrnd.pas create mode 100644 test/tsrndnms.pas create mode 100644 test/turbo.dsk diff --git a/doc/Caratulas.sxw b/doc/Caratulas.sxw new file mode 100644 index 0000000000000000000000000000000000000000..4bc84e1f8466b81b8ac24182c23cf923ab47fe5a GIT binary patch literal 6582 zcma)B2UL^G5=NR7MWjp75IPtVs(=tW(mMi53rT=rNRWhH1f+w2G(mb(KspK{O{t0k z3er0ws5DWeio68H>%Hf`ci!gw|M_S3o86h&&F<{1p$-{26A7^du_S|11s9K>Cwvp1 z6NCp1^TxX4L2ww{33-e_y9yFsrYA{AsE8Et`Av`#2t#TT5^|!P;bE&(Bvgm35*WV= zE#V7}#o&<`yr`E8deEZBZCskZc}vKU(=rkm5MTqo%^ZPH%Ti z^Wp9l|Bz-2RuU~E2CXhLi9{rQ#El1d)ZEd znxz@emQ243y8%8or1th_xe}r&qCY@V-pJ*)lHX>c49E+=pN++q)6=znh8E6EJ(DvA zwYkcr0}r4*W%TXTZJy^Kty8uF(qdULcQeQ?<%Zi_>=c3b!`QT`csyadlb8z|YcdyJ zJG>lUr!#tb(qFpFiB|9#;zuwxTyUleXelyAnzKL=z^#K%L1v<7;+vwQqd(VmjeovU z5|U(0$!P+vkv~9Osg;e7xC3NM!4C;0Vp^X zM)KAJF>-ci*!DFS;~VX~tF=~VHkyStPJiAQsYx~k^4ET&gI_jfK4rskzBngJ9bSr1 zY1cYop(3@bB(d?Pp`>r0cxmSgQZVLtH;!mi8asO-XE&VFT-X|zi$+k z+ZgEl!G8Meyp(|j=ORyP!pIaksXpt|;_;8)j&CxWNp=sEnVd-ro>P*!Lpg>L$kt&V z59KY$$7Rmg$#i} zckao7^_?H!>9>@~8(TWn%75%!bkK<`AKujcUOVuSRXda6dTF=>S{%8{D22>pk?}_M zn`zOeDSy-WWRP7sYfF}R(( za}H^K$Jt4C*sR#4bmfPnN}V7mjM=AVG)DRoyKGvI!z^~|!mQN0GbMiBy43qMtQCbU z+R^Bsok{`CyvsK2J|B%S43EpLVlPLWS~TGK6vNr!EAGa06++(diTbl-BSr3y#m#&A z=lUpCB zn7q1cLU+o7g#*|QeVKbR`+aef8P2f zSfg5rLEE|VnAqpLf-cF&o%L8bd1U58$md>0g}Oc`wYC&x>hp}WJozYMpQ&~+f@h^D zdiB8ML%JcAarM}Oi0jY;N-%gkBi-S+9;GK)zdqvnX2;BqKQ0vbpg9JCs zGY1sv{Q@VvXj!mZ{EU<(v^q035ehq$rzF~gz{lv1>6d~kx1~&&8nocgOBfb~jZtM`mEEj`m+S8)^ z-6?16iYS{pOovE78{PrAQt z;8`~J?3wLaEy!Iky%_g4?FCtV&-HZSrT3%o`r)^0SN9r*?4uqB-xn%pUl&)`PJJg+ z^e}SuSuUg!YFZs^J}LU zn)}ClpmI)|>&i6-ba(f^=Zu2s?)v+@ULIAh5qQ`95e6n>?Bqo<(3&kXRG)vm`hv@c z|NW>#7SE6%s8VjckxQ!5B;xIwzwAb7nd}0@5PMQP+rO^7wM{bMu0Z=r6``=k581ZuiPxmM+TYHj-qVt0y3wL$xb-owx^UwdMGlyO1UTm zmcsiP0InDVW!12CCwbYjwyFybu1qO5@7$liizK_r0LWnswjbo+2<8||zbzJ#aHJdp3wL)R zgux(ULjXfF6p|qYm0M&d17o~cv~@Xu$UMaB5o^oK~73WPD}y>g32S{a(EOTjf86H zYZw^oshh}yf3tpSg~FilC>R<9cS9cPri+AO5N=q2t~(s&hD4)bzZCi>?x*yj6k#rb z5HLIvN^~~}asdR9GKGlAiOb4CAit#ljw7n|Kl=NlmWcdk(_+$cVv>hVA5{`jXc)%P z9p;FHB5|N!X8vaV)D?*!Sc-83!M)*x_zf!YOSONn|Bgkt6Gn_+AJouPS`R|--r?XJ ziTtkpDddhrx`7Z#2NVX002~4_Fc+i(Pz&RL1&9H`zvjXJgo*!uFp2*UCixro`yY(M z6AZ%PQShG{;$ik^BnXam$KVO;0q`dig(o5zufv!E?V_7MCR|{p%ktN9_79>bDh#?EijpC!XtZ zNIY@44+Hfc%WK$iQ??(y6;!7+0ZuEt*277)1J_0M`}uqJDg9(>4Y(?5nM>?B%wjU!BH%&gBn`wDkmFQuej^|^I)YhBJ*plztYYync*<_bmFA2KY zo%$FSGWgBT={6l@d^cR#xZ|5$VTP3jwavH}c4dFtqjciA0I8SbrMWjHf!;dGCG~cI z0p3~-fGw=Hze>q9D6dwk0JG;2ZNVxeY!iE&a(I3AAqjV0k(wwQ6&(pHg$Wg=^p?7S zO-bh`J1>P1aXpvhJjm=btXHd~p2^Ln8CR7{DQ_nk_dFV!Mq;;XbDbo$ck;XL$zS&5 zT_;_pmx55AU7RT^&D;)H{?a-2)Q_qWkfymlM}4B@a;^$+G|_O6w|k~Y7CUYpsqp&r zc{s>R-rhq>99Zn&%7YKJ$?t_*o%N($NzD(uA5x|jJjx!*K^Oi(sLDi>;VMriU1)iE zsV=3B^Q^~d>H;OhQVO%vXB??yVvyv6GhxM7o!nxXf=T@^^EyRldb-m*|Ofx z^MkS&vCtHr+aKmD-wg#IP&=Orio)7oI4wj^U&?GU-Kp%j{s78(FQ2h|ms|3t9-~M; zGatKU)`^D5Dr0_4N1d|JZ!b)igZR0z_WqK~?Q?gfwKX*wBSQ-Gn^WzC;gl52HLd*%D} zIOU#sfh5`@9YX~X6;;zulV8v9Y75s}zRUAJXp2*{w%T7FyEEMwu)ABqvscHnH+x$T z`rRLKfWv=%U4@m|41!O)Enke?&xGGt8&QF}g#<@<*dd+akfuW#~B+{B%@N%I@JDXAgC zR`f&1&-wr87_P`}3J5?P_#hNrm&arG%iz=Q%f7Mu`S63~P0W*~am-ric+1*m_LGXN z#}!$9mylDIGF^pSZBh4l+OBOomd`bxP13|5lAcYB=;LVAKcD$xsOn?frA?hSG^*h3 zaNdUTb~p}|>hEWJcadau62)l2e^ziYqcILv*KYMxCo)RD}4%E;R03f6~N!Ttj*YC z)(h`9oq;mjj$>B5b*HYK$+xt3Zm%$`$+FfLnBHz?hF9MjOSXn)Tw6y|1e&r-(!@~P zi{#Amfo55id4%x{E@48fZr9}!1R((RFN?PzQ(p31J?;#Xere#&lj}?^LrH8+meb5I z1rcfIw0-^;*X7LG+p{Mf%0?NSx#W7f_wM@xb0`7L+uP}R25znA;==s`=4>}Z&e>u8 zBy6{KUfzybSeN{yev1~YF2WnGB0LcMjg+K{uX4~~^Oy+fPkvy zdaa)J>Gte1UutfdtatTKJ(irWh_`Y>BX_Jagj%E}^=H*ZC+O=nlNU_PzyTte_6VC7 zFEXyk2-$pSsywS`k*z`+SYki0=G%4Q2IH!U(!e~XL&=BpuInaEN>cp!S0+I^uBXh7 zhkJ}W>vndcV+DH?E5#Rb{QO2fK6>|cqCaU*KS)1OXFDMc-Lxq*-I znm1aL^^I=Tv8zw?tKSc%)WN*h_|PA}r%Hce*#G9L^D6U3paMqSvH)m3N2dBxD8-t= zqw}lPkokcwT)$@^Lg1=hif;eLt76s{OCzu867uR5L5hCe73pp1Y(@MjJNCRyB8^_4`_DPfpZmU@>c03y{QGsR*r#ziQ=6?p_eDT zX-rUWyy$-nUEU4g#3I(@^pi}b^mOgyBs#fcZYI}orXSqHn`36C3?E;t5qQ;D_GZ zd+&Sey|@0%I%g$2-%fVENmg>QH&_u7i2&{)SrerIY(5@4lHcba9?bj44&v$H<_a)_ zm{~#L@5_$F_b>1xI5;G<-L~)I6uf(P3ubqXbQ<7{dM1%IC>2>2z#Xd8wDHMzF3Bsln}#WX0=~>48MQd)!Z{+JX7mP%WxpU(7$zj>IM}Ys6y@?xZ++R$ zyI>F?_~^dj^uAWc*%sS#-~afK5mP$KPHFi^`Ah0@kCi3#lSFKo*-5>;K^&H$@6nzC zE()9U6wA@;y`j<^uRTPfig-bWTJU!+-3Wxk>hKne%XQRRP41(72w_HfCP(p(lb7ph za^^d4O6lqsFwIYeu($GPJYG%vb#Fl~G{+x-U5mxQ>Q9g^6!R8}olF~%I>@3Thl$NrjV#$=AJwzPW|9$d4% zIX+wU1CQLKENn0Jv(fX@YMb7fQ@4641)syptJIGbz8~GBSd9*=< zMJRof-_%pzL@j5XVKF5fHwe;?_+q&k!T?18qjn)4?lHXyJKajl16jQ`pD8W5kRPmu z!FIZ(&4t-9GkCTWeLr>=jvM!OqXs_X?7!8s!g}7~G4gy#^My%}A#jdi4tjchxNCOK z)rx|Z>Gl+w>L*pNvZ#1u+vw(12MPKf%GF%lWhz`hShDA&z3nT+tjB&{Dh*HEE{|+i zM4}fZ!^T^lz`evH#G_nh*!Q7ev81xlLXvD!TrRA>0FeyGoW6a!R=Oe%w1eT!C4MA= zg(?J2uKy4eOB4^|so^ahOW;pd5EJha?OZFB44$xhtK^a?lY!FY;&<2w>z^GpnySK% zeO5WQYatUwmE(oye>eeCwZYW|Z=&}a`w#%TlG4|W{fzxLDmlBG^y*4gcAwIx+V2%j z%@`%pA6%-j;u_g(T*?!izELxh&+)@X!TO*Me2(Eb|0B|{uGHevl*N$JE@OD!YhPol zn~K0RqmNZN9yGiqR+Y;;3vL24r6-jZSfK$JL?J%$G&*AZ_T|v^Wpwt_V zuJ`W4Z~EST&ntO{6)DbQuvPpPIqgF-_AnkCk(lke#(0UKD@lsk3ynUzsTbqZ%)YCQ z__UtY6q_@wQ>B~QQBHMH`S>YRT#`0q2s67OW740i>LrIho*b=j0Oy2@zmfE8Drt)q zW?0hKHq9v+bM)D3!z+7laZOYaU%+v1sCkLG)K)p!qkoeA_(9ucjGoLWm!cr-jq|NB zS{nc349N~JZus6{oRw>2<7X3mdE$9u=Q{!PPxE6rf=ntYvq+|6iTIxy#)%3qBkYyn z3Eyg(8cB_-cI)1>f;zRdi7XN}Y%qkq{b2pO$4pC`QR}qc&(*Usnci1@J2MA~N}6e1 zu%6p<4UVc_ekYt}ZE}~}4RU0i9IENaEQ&<-nZeM0)QgH4=MjTceT339xN>Yie0X7g zJJh7G#Z^0rbt&}qxwWLgnau4+VMa|kwHiMbiQ7k?#$d-viGbKQe&fW?;wxdR{(KF+ zB$OO(x?Gc zqWcd?(9nA5n^T62Jt(JfsqL5$=xplnlF+f5i3lDt0^4ddL?$KIo11!I|NA zU5;Y@3Rjr)_lsx2S7=M9m}(=H#?2N|+zgp{)7rT6P zIHa2WfzO!*1V@lzU1W_8rKa3ARu>WM;`8p-QG^MlO8Xrgs z8DBKG5_iv831!D9=w_Wjaaw`vHQMc3xO>!)$5c%wE!Bha$Q^Q>i{{iyEFN6@8m(_m z>dmR=`qnIe}69f?gM_mG8H5Vru{lG(7q=P6zhA-tMn6jV)YX7g(fG`RdFFB|2U?PoNsd#&mk)a zQ03SV9YS!xGv%8|jS`S)Z03^LA(jn%{OQR#UgX!yWcqH|mAk<6P9Zc*d2kVAt>;lg zr*XE-bjs|ZBkEix84|UBr_7I{OLLRZiiptQ8hOF4YSNdgosWN-OXct(Q5&qUX6I<_ zzcUqlD(=g6o^Se{3f?UK#U`#!j+9%?h|lV2KeI`E(u(8SH&x9+;VF{n5cE_sWdDtU zi4=zHul)VFe%VoL>J`q>qu3^a6c|Okp}Ei_UxbgZ!3Q{cVjeU%F|i$KQcp8Z9(y36 zMu2^bM#y)29C;$ao@#4BOGcz6E39aEeX&;bN=e~Y z@=(_mY=rjOXl%pSkVLNN?T%2P0Y%F1rU^Qa^odg-QNFHeg+jC`^$|V%&)tr(C%2yl zU}Kob5WKEg3o}8Ju60aC@`3aABVMm%B%D-bhsBkO*70@cD0p2w)oOV~OFE=^jUkge z^0UKa;#%1l&Sbv3I4Ln6GXft!fhwfYtg+DM1q_V5JhH(xA;KvRr$+q(u7saIt_Z}E zNvUN5R`y9qetOyY4smyI^fIMSF?lo>Yp#claz!=Izj0_H7F}GA1%a9MgR(=AJXRC@^89{i4$t?1;yG~d<G!Rtg?rDhtnBHjn`4|{nWW|> zffS{}1ZFZXVVwBnca#-K2V1g{{0Im&4BKSFFb7XL`IH7HfpXmGL?D>6u%)R-ebUSZ zsn>)7eeavq06O;GdWY(X_)32gnaJFfPSt$ii2`pc20-Xzl7B*Tr<0fJ;=z-2?*#*k zj+c!xOWkz~pKBm=oi3=#=j;x8Rf`7H%}KOP_D?7;v}wFB-X7{_?td}F{cNl}`T5|J zZ26maS2#r?h7r3#05#wEcUK)%_R4OXRVP~+>&sV#nUSJI`3vaqM&|?tyH7#sd&Ao1fOx)h|yyk?dxq|H$_hJ2g?lHa740 zE?R{1orAb{{N%w4HSe%fD+ir5R1x@v&q$3y(2J@*kA@Vv$wLDBkB4#wKX)yIHZcbl zAVk&*x)tU4Zt24;S5_?Ig)U&v*fjd}t0f6z2mf8z&B({4uF()7R|3M1B157b@VUp3 z8l2Cqgo7eOtY$-IAr^&tRLxVGcTc;BCOc0G;st@NdM*;WiA5>zlK_T%ruKU11a$%g zpM2c_Hj7k`hKd&QAtJC&&!&B zis!Gi85et77Tz`t@BMn-)Mol9Rh`ADv74)b5Bo&znB=L$H3rw3Tm*uY(74a_&DCi; zx}Z8RBouxWEpwEL9epP!CjwoQ<)ac>gJuN^GOS4vUM3k+4~eCbwU>OOqdR#)M`H>q&pi(eO5kbS-r*3$ON`#Dbgk@5RROtf=$5sT#OLVJb zIasl~?EWOk-5^HyC_{23D|7!c_a&_y*~TQ4O0*zo@5{bYuG5O5V3cLa^(2(nOup6` zgkkhnn?|bYm<<8`IwuV}p&L3?=RGvz8dll4UIPXAnHoyHJn6`GuS}iZH+WVN1S+;q z_?N36gS(b}aJAq@WYLC_?oQK@2$`s+?4@}%>_ zJn0X-GrMTHWGhq$#OqZqutl>K@mg?FGt*PjsvDIr7oVjD0VB$jv9J>>8hWy(u zyvR<2Q@W3*WL#RV%kcYS{k>lT<4o=;{gB4NH zIA|+SZ*kz@XkGr-wF&zDwTX+XrybPg*R6@(sPiHZPTM7uuEhemv_cjBaBYUQnV@xl zEN3mJbsWwk1uJ=f#Q4ON`km^t-X=J-+rUJ_+QyneC5q>wtS?0O*@%vN_X@e3X45db zwwIp7A=?~|A1l;spRzFI2Irlia5en$dj+Psk`1FbD26Iev*PGuo3 z?kQXIjYpiiAu}aPfmFxm^#&^7YWFq5t`3)<$wyL(V#qR4!cF%@+E^aJk9cs=r1%~(yWlE2A z!jCppscmEmK2pjQB)|t%m%yWr{}jY||MC!Kd*#uj(TJpZ8+xeTcwZDl zDrFbkEoErTh_Ht%`%)uWV#H_skwQjXvREQy>#)=9c|k5nLB1-pdHHR0#8DHU@U8&X zXVO7QDvKC6=69pZttZX(V^4BdBl+vi8;3HpLsJjo<4mrddii4FF-s29vD74kQoR(F zKn$x(8?4f2j2Lq0wd=xP_(W~BUMvf;M{V6TKy3=IFOs_jwTZ}SdfHNa6@5}Ao7%{} z(onpkVJaz8(_g4sXEaCvH=txV$q{7XuPDs2fsqFf#7jG~2Eb^wBSH4`*$}nlk@Fgu*8=#o6wJHykqVT7n?SROltrBapk6j_o5CVKCahxEWbxOd(HW^v?|98@_p` zp485#6!<@dHzac%v>_BP!qBT%$q|f;%G0NW4Mh-m#{#7nTg|(~+#uif$t%MgBvS;M zpd^t5^by2wm2}e%YcSK7Bfc5N*jIeOb#d=Zw2EgH&ZnNPj@BJVjuAk`s|xPK5$atU zxhloskEqW{Ve7oa`kEj=w{^NNRupgnlyr~e%PV}fLZXX4beKc2o-WAkMe<`bkQW>) zD3m(#M9iF9V+!%grr8{FqTjWZ2qc%@!b-!e?p@Apd-aU|l6@p0#>X1wNv!qcO%a6_ zo)+V%7Pm(k!x4KVnbxIVtZwnAEoDN~tJVN9TZJyk6L6`aO!(_s214(t5)Bt!ab$kB zH+Q8**Jp#xOnJDE&j{wTUpmG<-!!L?CBYy0NiQVt=%&TOl-PwSYn-oqW`Ge9aFff=;?Y|`^m;f7^-}dX z9V!gpFW;@5U!W$q=bbn^@ntL2Rcy5L`f}Fsnx5Z*Cw?5dD;N6Ma`X1$s$DViB$TkR zEy17T$>X>;NrL8<^>$vny(Kv0gMk_0A%jg8TZcXdW1sezRLNZz(&P z^@Q7-0#o@Cm6qLtwUD)6f~Yx-6{8GhPbB>H#BK^(+cud%H_Ki{7Rwxca3;zTr9OR@ z!k1)VjH~u>wgyj>LarkXHT=FSACU$5 z0p)j*_AE7-COTBIQi9Z{#w_3UsT*fT#Izh*T^_VIxBkR<*zc%VsYDx4;NVOtfA4n> zzJUi{g9q~&ejE}U+{5$WO|XZ$LLPQIA<_F6)eESzi?stxmQ*)gNW4KUJviI{^ZvRcNSa{%DNN+|`^$MCd=Zd~Y4hMc|JrVHzt} zS4ROL(BZz1KUE+4;9zHG2mVo}q54C?!_FFJ`xoBb-JQ*y^Orp!etv%7uiD>GbF;s2 zj&9C&zfk68K&Tz`VSFw?5E}^i8~ZTWztI25iU$DAZ;t+j)xXB~01**-cnerUVNhp? ztAn%1zq0ng5F3b!QOO$S=D{Qc{5P-=H2|QYF3H0MGBM!g;o&qgQIc2D(lwD+(Uev) zF>$eixWh~!t|lN3AP59x=P&{B3UKoYfH(nwKRdRDS-V<8>;PuY&|lpvK_M`6X9p@J zH#3Mc)Xom_XP^I$`@`&CTKCfhU=DGGiaan1VCMy}b7_LO1VH=(?CgJP|0_<&+)Ut? z!u{XH0RV9TIM_8gI0d*t0w6vi;P1)@lpO?S=?1Zcia=ce(i*?&{u2FR0o457ewZb| z%+u`t)F#65XNUhL{#UHI+db9yR*Qf&x#T$bmD%rG{zdF>t-k<&=()K-odM=h3u_qE zoaz@42C;_<)5yat9H>Avz(1+{pD>R9AB^+=2jlt+_SfojalIdti>tNS9~Qbop4&kI zW)5yJ*ZZ|h^M}yd{+`Req ze1F!sJ2;#F7V`1_mYP}JE10?7llN!i+#tSRJp8#t1s?hr5&B*FYbd|O|J}Fw;2?E@ zx<35vzmDmndIm0wQUrcmIwV*l9bz=|dGZu^?%H)5e8m0k{V0^PlYQDON9aat4VauZ zlVdet^pOtC33B@#LBzP)#n(TRw^6r&6^RFV@*lWT4oJ^(7PD@~=Bq8+U262(n c zn&qaTfjVi&to^|_L=kjf`_MI*(K(|=W5+61;X7GWkC5Xp@}>Ej8iFm2XRaxw5KQ4_hWI2 zuE{QMIlFQ<_?2!dSa@AZHTWxE-Q5VLz&;a4n;+{ktln}l+p}ubifhQLR8lQrIx z{EM`MD0a#Fo4Y#P}78> zk&52!q8jNw6nuklHrDDb5L;Yxz>8?LjwO!@LOqW3caF3P?7Yt|m=noI6J)}=F``a8 zJ1~?d$7mx^&?0%MVN^HKfdbU%foTz>=@Ef@y3$|?{d^{t@HshyLdZ&?6)N);Njj25 z^p35988(GI-XmoszXIeLQc^`LZ27INmuHFJuE19l0{*&2eMFh* z7saGBZwcc2Fusu8&O!W`E*-z9-1 z3Lf#Tj9iIa!dR$&l2xbCejqxSE1ZXnhrO}j96>$aib{TBI|@$GvuBuhF5l$Tv^b6^ zC*s7}y7tc0W+La&mC*@Hd>-qxDefdYV-dK;pFRlxWolJaf-LODe@uOxPR=7Jm788G zu#b_9Ql{@a5-UzAn<8Ghv;qoAf#EIDFu z619k;1fu4}!Hws1JSda3{bSqRYJc_^o3Gz_i34`_lUrZ&8$WYlfvW9MQQ6sc+4{$J zdj<9fi?jBNO|}Nhi?i5u=kM%q>_z8wW@ z=lAjZzBX`mFyLin;BL1kxY%TAaB08Cuz1zG^ToNzJ>yWZ@Umk^*u_}X&A2`7@o)>b zV`%OZ27s1ilfkiSMz634BY2t7DrVZ3WfVlxITatmJc$%jgFe7MzPTP@?GzQxnxW9S zzv?|LgzV^EfMrUSH=dzUC8AtkSLU^>@sL}Ymr zGr60t-|s1H=YO}Mwnmp*bR2TBD9r+AH>tSbZ8|Sa>2DG6%Mn5z-RXaS)20oYqMG%bpD*7D+sEl1Zc!rHx<7mD+T?3rf5 zVaCIyQ6;3Ubw(PynujqLXdldlMiM(1ToQ_Gr!p+PRYtW~64fIaPix-}S$^q^)4EJv z$3Ghh`j8++Zl5ekWwJJ=@J#noZi2;>7{9+1In1D{;Dg^AHuNjZL2P**tn%@+neA-$-qxw*sekb>qgKmP&l7 z*4$kypD=&yDekE+n@DKWfXtF#p#Lf(pfMP&9V){_&bEkYv-u)mn`YVQhidgaMc7+3 zJRS9XEPC_#%e&~}X^z#ld`$C2vQoN!gRg_B*4uVul2cF1Uke$&c|Vqxmttt?@1Mlc z#}uNyh1L9QpO`1e6c>WB}l!XpsC{r5PgdusoY{u$NuTl07D(m(I# z9)g$tPSW?;e}ppqyW&4TbRMqn{!Tu)|Gdomt@lv>pFV^B*0Uq|`=jW$)^9WaIi()X uA%7?8C;xgX`FG8K()KXr{!Wgx|78M#6_M{}FB}}o{m=NG@jkkT(*FT)xJn-Y literal 0 HcmV?d00001 diff --git a/doc/Errata.sxw b/doc/Errata.sxw new file mode 100644 index 0000000000000000000000000000000000000000..1f739fdb7737cda4a61928a0ead00c7513f0f959 GIT binary patch literal 6449 zcma)B2Rz$d_YXCS4qH*Ps;G$Ao7!rH+FC>s8Y9sps8y@>YK^K{t48hGHEXu^rf8{A zRa9+?`b*c-=lMVH`+09Z`F(QF`JQ{my}x_zJ%MPRBBBMHKKZ!P#{mIVhoFf zK;Z=LIy$r&zeF*MQ`YZZ9S1^MeT?nR6_TnS`HAQ-F}PT_p6kD;cGIryktRyL2)>QR ztfc2mxsOCS2TsNDYffYt`dTrT@v|n)`0(fwQHg-QuFKcn+nrlz!#>I~-N~l@s_nBK z4t&0HxRczr?p78GP3HGlmx5|+jdgjYp6PRuREwNQQC((FxNDhWlkif|hVH}s$B#T= zb6KV{hc}()PGtmm+*yXT=hRZ>m=1WO-SQ7nYvKm2-W~V1%rFo-|3GZN^e5SfQ z`sL#lxSC&7*;SE1dE@x2`wnlGk^x>GB0ZKZ+K%bybB(#EBM>pbKx&M_sWA^qT3{T|ZSRS?GA7NwiX+T*g* zaa$MLk_Z*^ILki2D!ylJtiKrojeq|5?#^aWKXcO&Y+5ILL=v(j8}8PJ>r*Pv4(M;b zE~j3=du^>v;Zbwxn05O*RpUvlH()Y)-@A7ufyp-&O>MU*ZC#syLluu3Aj}mzmb@<6 zn)j*-6IZCct(!+WmCA^`Ut?-po zDvR0A)|HpX6+aCp**&t5fF2tHQfRx{71;)0^+Of#!emmP|O!!gNrsJ)0+yxk$ zw1utR60T_P#?bX^uL;dZiYqoTb^NI|kEPB8q}#Sz2eJBNtSj_CU3@M2c~)p53)gdD z%(IlcirIrfYI(;%DenG8x_S}OQ~h&s6tp#ZBd>~BE(F(Z&LKIGB8 z!uqF1n=Zoe$}$a+z=y9FTZBVhKeYxiO;=>Bf|6qRwH5{q$v@=fd5uFaXDdQ0t_)nn zzJQSHhPFLWr75gWep~72BoE^H)S%OwB+kQIZ(hMCP&1uclm}{iL%x;Ga(?d%qg*1t zQ_WtM`C9O*g-i4q-La;1*O7um2PkF`KFk&DJ54T7dX?;J2Ic!X5>2~x(tJ^xQKqmP zT0DVq!MCdKv(~Dnc9V5=wyAZrvN)m7kqtJnG_3f(FAMAJ74oEbu0J0Q6SZROOECA; z&t4~gCTR3^u!LeYw?D#0y!|Vy$G}&tpB|8)g*2Ja=K7L47Zaz7HHBm|Yfl0l>lz;u z%L5N0V|q5uSM*Uf>6z7Ms=_^We8Pgb&M_9RHw(jyn+OP z+L$s@kTXgTf-vWJt@Yyc$2OaiUG1zUOJF_J&-nRJmA5TA~<~JbXy%>ic=E1zVULqUwXvB21owi{go|$@u`k z>08XSh-X09xcMs)LkM_+lxz;H+wNvuMbDcLnfTJpXIN8!u`BouafbwqC7vkVn z7)u8I`!HXZGe{!{nR7oZ{v+MKlY^ih1DB6^=^o7%N0K<1RaP3%U3n*%V!kl$l0+JD zb$C|XI8mvZwl=zpF|pvQtwYS4$f&jV(-2M4(>CBlc@|;-;1VSO0Qrx*D*4H-ip9A( zAh7sNb=7ndGbu*twPsw>U5=)8E~V+JNY;Q!BRe96OJ$L49MrM>4*;Zq%U8XJ&`VLy z1Yh|4VreSfkTD4ot*k2oF6Zef_Er{P)Y8n|#8BLO9aY%aOA#xM^!$JWC+~%nYEWOJ z^uf2;o$aHwH4qEE3RhDO2gP%u8%tz0VWm#*t*l|x5g{#8LBs1Z4ft5gw?#a&W#4|cIaMu7Tn!@iYg(1_yT?HXOo!_ z?^B9LeLc=}a;aN<#y%J?f-A_zMUq+iDfG&t=nAS+?ST@(ZTku5tVCxYqeH1@y07X$ zR%9TANoSUghlp$eVMtmrR_ zEqZMSOtGxhs`6=ZoGxa};m|Lis4}G)5xJ08)l7?}=D*oXtxW2sK%IMe?aS!CmBE{_ z2GX*EL$=)&!#ZW$m`m=3wNhZEa`3fEx-S0go-dHD1_XLuDZ7%PH$XzsG}-u25&5|* zG!v&y_?~_ywuO5kS|QcoEs-I_L?#zIPQy!{7U{0QyTKTqarb?s+E9!s;GmwOPOsBX zjCSZto|!o$OegqGlQqf0?i-V1q;fGf>GTF8QA{46f*}2+7oGj&fhDh;Z45BMLkqVw z(}Rev4Zqm5S4X5PFiESLJm!PP4q&1_7&&Hix;I6Ov`1AYR-qg2o3Zdb6=Nt+bT;we ziP5@DNdIebGqB4>nu z3P}-bW9X~iR__2vM$hhIq-Q*hfYkpg?gHZJ_0V3$l8-`y??}CR5k`# zJ4bszI0$tmC#eL|9S82^q527 z!mVLYf#A6}=^5&KkDBmDUA~OK8%6K1V`B(%BVltJ~^(*FT7Cwu#|KQr) z8ffPy7V~+lNs`G!lbg>)+edw>Eqo_wnJ8p{fdi|u^PXftL$>c;M>cVrW=#DB$$3#s;HO&bl=Msy}&fYKeF)XYfpv?OS_T5=cn1&2!YU&@jH`BJ~6)BMjv=nqvGaB?Yz)!^7kZp(*AQ_H4{dS z>Z9}I2yxL(SBX@*h>a(R$ausem=d{TB6l?Ud_02PHJ<3Gc5K%956;;;Fy$_V4IJiT z^#aTY-%=WgIk7Gv;WshLS+&zPx?$`UlMZ38%3Xx*?Zxx!LI=*>{!}PI7AF0^%&Oqq z1f?6fZJ%TFW$KYxL)EAio4b`$BTg}yAuRC<*mp7}W@e8hY$oeJJUut~e)VCCsBFNR zta53M4^32D<_vuMYtktqov<7I51=wkx;oDmX!`&&JXscV+tD2~6eKDN3Rj5&yy1#W ze#{d|cO*zP=~<5<^(`W-6)PaS{RHwcYQzn%z3q_^lA}@XJTVgwwFSacQfp~h+_Gbx$xHj{CyywPIIDy2mru;PoK~n z5jZG5Z^_7?JlI_j7%UQvlH~*o2y(I`P%tzciL#aDG&E2JN^r`{k;`x>>na(TLR8q% zHa18YLJE$CIXj+QD1i8Z*dd0BS{h31oInsr*9n2r{f-epV{AbnWdmjQAARMYBJ3wh zKp+(zPIk^8g9*TKa85aye;xV6Iuusw2TPXoHV)?`1p=W@bo>;>>ktwY6a@X~bF%*s zxa)vK+5g77y1ELu3V*i;EGa1o`p*3Yg~NX1oSZQZ-%)TF2;qRh`-cUA1;C(RSiG~p z(f?)z9>Do4Mt_UyZ~yQRIT`#@$`*k_V4yfOM(*!X!$(K}%+8~QL^z+&EW-f= z-q2SP69HSAi;IZ~-?G%w&@nWz)X*_d(XzC}-iErOETK3{un-6g1_=sTg2kmoC8WT@ zK;TcsNE8x>ggO9W7{qt=S_mi#jzP0)Im4hBgo6Y0r_O)kewh7T>SVb9;ZPhx4j)mV zpg2%a)Ibm{B_bpxDEL$Q?>HGaOzOYr`-6)|{=cD5#ufcO^e-kJtyCMWdMw11HQj)gm)Ov;IWau5R{u(sgIxZfw>m&|YW z4=HCX0t192Y>+4foc%ix1$9Koa%!M#(ClDN(9e+nSD4WM1{40@U?RU^zu!_U?!+T3 z4hj2VAr5NofB?eK&M2HL=gAxY-E5@eNhJSCL|fY-V7Px$o&G?Ae~LRnF;H6!)amvw zu+UG2D;fj;MFR`}(gwSIf`{QwV)xSwabZck-9KMsDZEL4^?p0@o&28<vwBtxaua6R)m6y;W+~20kNfH`rSa zA@6QF(=R_U=s_Z2UnT5DyG*b}UI4Ex4~Zk`Vy#wSsLYZ*NO_xCHoaeNR#%7qSSqW| ze>U?n3S~57P5Ihn;K7Sl!_L9(%bzhDg>Be`2%KAO$;B3F>BKV(wEUAK%D8sFSRwPP zM!8v|n57HiEt|~T%FMoR`MLS}Y&#Q7j-`Y@(!(O}-jnQWtCpK7P^1&6xe(f`8d4B& zZh-;3N-7UxJ3H)r+M%9f^+noBrtJ)RiV5uhyckv5x_Idh*2EN>IOe1RDe zh?5yed>qbZ&1OI-)CLz>86Qq8yABBw3J6smj{wte1Sb_2b(Va1smSKo)H(kq)b6;M z+voYlq3*N%TpnTt1;!E)o&*KCfJ+@YM}%|qX7?N1eL6yHscGxlm9^Up04yraE#1L7 zjnv#{we{Gow;z^p!G}V$+U*MlClqAC9|>62{MI?6+bh@PiJU70xo-h72yn^wNpcU9 z4sz0-aqN^d+jx9V*_C^IYwzPmjwP$C+}HZW!zt|N-HR?8YJK}UCV<(rV)}+HSxLbrbLeBI*tdWObGhR2AkWTC>U>7%_EP-N;w*;PsT z?PQN4?2vNhnQt-K z8QOQANal!q6|o5k*+vqRMnCMMH*xx=cwNay&uY+U?A;=<3i`r`SZ-l{T%2K%LaM-B!Tm5Z`(va=o<1lJ=8% zjWXDxV%a?ZgNt+pFY}8+c>ZenL#tIo7Xh-gMQq+tE-6uSrLb+$s^ADSl{>a zu2uF2?&G%Sx`IdDUyN)Vh&~T-ku`VZH5DywsC84Z zcx}F2_~Mmc#?8>Rr__I| zTGO3u<=QF+*MJ&2svt)w3TcDDey?8_4wl-r2vU;F)a$0dL!}Jm5lQ>D^3qOB_zUA` zcOG5clFj4JZeU63%CCk5z|SHmDSrSjb-P zGi?AihNXOr9XRV|p+l;-BF?sEPC#Y-`PIC3=GEv*d3GBFw_MH(t4p676q>fU?29;N z#%xX_4i^%eAHD%nIeuAPX>465%*g||6*@mo^kU-iw=a;f&GBe& ziAk#b4%^EgN-E>a$t-}QpBV4~Bv7NJ`gRhYFNF925)je?{wn ''); + end; { function ExisteArchivo } + + (*********************************************************) + + procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer ); + + var + i: integer; + void: string[2]; + + begin + for i:= 1 to tam do + begin + readln( ar, datos[i].ap ); + readln( ar, datos[i].dni ); + readln( ar, void ); + end; + end; { procedure CargarTabla } + + (*********************************************************) + + procedure Intercambiar( var a, b: PERSONA; var int: longint ); + + var + aux: PERSONA; + + begin + int := int + 1; + Retardar( RETARDO ); + aux := a; + int := int + 1; + Retardar( RETARDO ); + a := b; + int := int + 1; + Retardar( RETARDO ); + b := aux; + end; { procedure Intercambiar } + + (*********************************************************) + + procedure GetHora( var hor: HORA ); + + var + h, m, s, c: word; + + begin + gettime( h, m, s, c ); + hor.h := h; + hor.m := m; + hor.s := s; + hor.c := c; + end; { procedure GetHora } + + (*********************************************************) + + function GetTiempo( h1, h2: HORA ): longint; + + var + t: longint; + aux: HORA; + + begin + if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 } + begin + if h1.h < h2.h then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.m <> h2.m then + begin + if h1.m < h2.m then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.s <> h2.s then + begin + if h1.s < h2.s then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.c <> h2.c then + if h1.c < h2.c then + begin + aux := h1; + h1 := h2; + h2 := aux; + end; + t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c ); + GetTiempo := t; + end; { function GetTiempo } + + (*********************************************************) + + procedure EvaluarCre( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], m.Int); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap > datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], m.Int); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, d, j, tmp: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + i := 2; + d := tam; + tmp := tam; + repeat + for j := d downto i do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + i := tmp + 1; + for j := i to d do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + d := tmp - 1; + until i >= d; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShakeSort } + + (*********************************************************) + + procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 1 to tam do + begin + for j := i + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure RippleSort } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[sel].ap > datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], m.Int); + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j, k: integer; + tmp: PERSONA; + terminar: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 2 to tam do + begin + tmp := datos[i]; + j := i - 1; + terminar := false; + while ( j >= 1 ) and ( not terminar ) do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( tmp.ap < datos[j].ap ) then + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := datos[j]; + j := j - 1; + end + else terminar := true; + end; + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := tmp; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure InsertionSort } + + (*********************************************************) + + procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + hueco, i, j: integer; + huboint: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + huboint := true; + while huboint do + begin + huboint := false; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + huboint := true; + end; + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSort } + + (*********************************************************) + + procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint ); + var + j: integer; + + begin + j := i + hueco; + comp := comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, comp, int ); + end; + end; { procedure Shell } + + (*********************************************************) + + var { procedure ShellSortMej } + h1, h2: HORA; + hueco, i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, m.Comp, m.Int ); + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSortMej } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[i].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[j].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, m.Comp, m.Int ); + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + { rewrite( arch ); + CargarArchivo( datos, arch, 1000 ); + close( arch ); } + end; { procedure QuickSort } + + (*********************************************************) + + begin { procedure EvaluarCre } + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bs ); + BubbleSortMej( arch, datos, 1000, bsm ); + ShakeSort( arch, datos, 1000, shs ); + RippleSort( arch, datos, 1000, rs ); + SelectionSort( arch, datos, 1000, ss ); + InsertionSort( arch, datos, 1000, is ); + ShellSort( arch, datos, 1000, sls ); + ShellSortMej( arch, datos, 1000, slsm ); + QuickSort( arch, datos, 1000, qs ); + CrearInforme( CRECIENTE ); + end + else + NoExisteArch; + end; { procedure EvaluarCre } + + (*********************************************************) + + procedure EvaluarDec( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], m.Int); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap < datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], m.Int); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, d, j, tmp: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + i := 2; + d := tam; + tmp := tam; + repeat + for j := d downto i do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + i := tmp + 1; + for j := i to d do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + d := tmp - 1; + until i >= d; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShakeSort } + + (*********************************************************) + + procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 1 to tam do + begin + for j := i + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure RippleSort } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[sel].ap < datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], m.Int); + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j, k: integer; + tmp: PERSONA; + terminar: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 2 to tam do + begin + tmp := datos[i]; + j := i - 1; + terminar := false; + while ( j >= 1 ) and ( not terminar ) do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( tmp.ap > datos[j].ap ) then + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := datos[j]; + j := j - 1; + end + else terminar := true; + end; + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := tmp; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure InsertionSort } + + (*********************************************************) + + procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + hueco, i, j: integer; + huboint: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + huboint := true; + while huboint do + begin + huboint := false; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + huboint := true; + end; + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSort } + + (*********************************************************) + + procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure Shell( var datos: TABLA; hueco, i: integer; + var comp: longint; var int: longint ); + var + j: integer; + + begin + j := i + hueco; + comp := comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, comp, int ); + end; + end; { procedure Shell } + + (*********************************************************) + + var { procedure ShellSortMej } + h1, h2: HORA; + hueco, i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, m.Comp, m.Int ); + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSortMej } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + procedure QSort( var datos: TABLA; min, max: integer; + var comp: longint; var int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[i].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[j].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, m.Comp, m.Int ); + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure QuickSort } + + (*********************************************************) + + begin { procedure EvaluarDec } + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bs ); + BubbleSortMej( arch, datos, 1000, bsm ); + ShakeSort( arch, datos, 1000, shs ); + RippleSort( arch, datos, 1000, rs ); + SelectionSort( arch, datos, 1000, ss ); + InsertionSort( arch, datos, 1000, is ); + ShellSort( arch, datos, 1000, sls ); + ShellSortMej( arch, datos, 1000, slsm ); + QuickSort( arch, datos, 1000, qs ); + CrearInforme( DECRECIENTE ); + end + else + NoExisteArch; + end; { procedure EvaluarDec } + + (*********************************************************) + + var { procedure MenuEvaluar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Evaluar Algoritmos:' ); + writeln( ' ------- ----------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Ordenando en forma creciente.' ); + writeln( ' 2.- Ordenando en forma decreciente.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch ) + else NoExisteArch; + '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch ) + else NoExisteArch; + '0': ; + end; + end; + +(*********************************************************) +(*********************************************************) + + procedure MenuGenerar( var arch: text ); + + (*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + (*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; { function GetVocal } + + (*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; { procedure GetRNDVocal } + + (*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedure GetRNDConsonante } + + (*********************************************************) + + var { function GetRNDApellido } + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; { function GetRNDApellido } + + (*********************************************************) + + function GetRNDLetra( min, max: char ): char; + + begin + GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); + end; + + (*********************************************************) + + procedure GetOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 10000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'A' to 'Z' do + begin + ap := letra; + for letra1 := 'A' to 'Z' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { procedure GetOrdApellidos } + + (*********************************************************) + + procedure GetInvOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 34000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'Z' downto 'A' do + begin + ap := letra; + for letra1 := 'Z' downto 'A' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni - random( 40000 ) - 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { GetInvOrdApellidos } + + + (*********************************************************) + + procedure GenerarRND( var arch: text; n: integer; reabrir: boolean ); + + var + i: integer; + ap: APELLIDO; + dni: DOCUMENTO; + + begin + if reabrir then rewrite( arch ); + dni := 10000000 + (random( 15000 ) * 100); + + for i := 1 to n do + begin + ap := GetRNDApellido( 8, 4 ); + dni := dni + random( 50000 ) + 1; + writeln( arch, ap ); + writeln( arch, dni ); + writeln( arch ); + end; + if reabrir then close( arch ); + end; { procedure GenerarRND } + + (*********************************************************) + + procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetInvOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure Generar90Ord( var arch: text ); + + begin + rewrite( arch ); + GenerarOrd( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + procedure Generar90OrdDec( var arch: text ); + + begin + rewrite( arch ); + GenerarOrdDec( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + var { procedure MenuGenerar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Generar Archivo (''DATOS.TXT''):' ); + writeln( ' ------- ------- -------------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Con datos desordenados.' ); + writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' ); + writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' ); + writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1 a 5 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': GenerarRND( arch, 1000, true ); + '2': GenerarOrd( arch, 1000, true ); + '3': GenerarOrdDec( arch, 1000, true ); + '4': Generar90Ord( arch ); + '5': Generar90OrdDec( arch ); + '0': ; + end; + end; { procedure MenuGenerar } + +(*********************************************************) + + procedure PantallaSalida; + + begin + writeln; + NormVideo; + clrscr; + writeln; + textcolor( white ); + writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' ); + NormVideo; + writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' ); + writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' ); + writeln; + textcolor( LightMagenta ); + write( ' lluca@cnba.uba.ar' ); + NormVideo; + write( ' o ' ); + textcolor( LightMagenta ); + writeln( 'lluca@geocities.com' ); + NormVideo; + writeln; + writeln( ' (c) 1999 - Todos los derechos reservados.' ); + delay( 750 ); + end; + +(*********************************************************) + +var { programa } + datos: TABLA; + arch: text; + tecla: char; + salir: boolean; + +begin + randomize; + assign( arch, 'DATOS.TXT' ); + salir := false; + textbackground( Blue ); + + while not salir do + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + gotoxy( 1, 7 ); + textcolor( LightCyan ); + writeln( ' Men£ Principal:' ); + writeln( ' ---- ---------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' ); + writeln( ' 2.- Evaluar Algoritmos.' ); + writeln( ' 0.- Salir.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': MenuGenerar( arch ); + '2': MenuEvaluar( datos, arch ); + '0': salir := true; + end; + end; + PantallaSalida; +end. \ No newline at end of file diff --git a/src/comp.pas b/src/comp.pas new file mode 100644 index 0000000..e69bd46 --- /dev/null +++ b/src/comp.pas @@ -0,0 +1,1667 @@ +program Comparacion_De_Algoritmos_De_Ordenamiento; + +uses + CRT, DOS; + +const + MAX_APE = 15; + RETARDO = 50; + VERSION = '1.2.8'; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = longint; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + TABLA = array[1..1000] of PERSONA; + +(*********************************************************) + + procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer ); + + var + i: integer; + + begin + for i:= 1 to tam do + begin + writeln( ar, datos[i].ap ); + writeln( ar, datos[i].dni ); + writeln( ar ); + end; + end; { procedure CargarArchivo } + +(*********************************************************) + + procedure Retardar( centenas: longint ); + + var + i: integer; + + begin + for i:= 1 to centenas * 100 do ; + end; { procedure Retardar } + +(*********************************************************) +(*********************************************************) + + procedure MenuEvaluar( var datos: TABLA; var arch: text ); + + type + HORA = record + h, + m, + s, + c: longint; + end; + ORDEN = ( CRECIENTE, DECRECIENTE ); + MEDICION = record + Comp, + Int, + Tiem: longint; + end; + var + bs, bsm, shs, rs, ss, is, sls, slsm, qs: MEDICION; + + (*********************************************************) + + procedure CrearInforme( ord: ORDEN ); + + (*********************************************************) + + procedure InfMetodo( var info: text; metodo: string; sort: MEDICION ); + + begin + writeln( info ); + writeln( info, metodo, ':' ); + writeln( info, ' Comparaciones: ', sort.Comp: 1 ); + writeln( info, ' Intercambios: ', sort.Int div 3: 1, ' (', sort.Int: 1, ' asignaciones)' ); + writeln( info, ' Tiempo (seg): ', sort.Tiem / 100: 2: 2 ); + end; { procedure InfMetodo } + + (*********************************************************) + + var { procedure CrearInforme } + info: text; + + begin + assign( info, 'INFORME.TXT' ); + rewrite( info ); + writeln( info ); + if ord = DECRECIENTE then + begin + writeln( info, 'INFORME: Orden Decreciente.' ); + writeln( info, '======= ~~~~~ ~~~~~~~~~~~' ); + end + else + begin + writeln( info, 'INFORME: Orden Creciente.' ); + writeln( info, '======= ~~~~~ ~~~~~~~~~' ); + end; + writeln( info ); + InfMetodo( info, 'Bubble Sort', bs ); + InfMetodo( info, 'Bubble Sort Mejorado', bsm ); + InfMetodo( info, 'Shake Sort', shs ); + InfMetodo( info, 'Ripple Sort', rs ); + InfMetodo( info, 'Selection Sort', ss ); + InfMetodo( info, 'Insertion Sort', is ); + InfMetodo( info, 'Shell''s Sort', sls ); + InfMetodo( info, 'Shell''s Sort Mejorado', slsm ); + InfMetodo( info, 'Quick Sort', qs ); + writeln( info ); + writeln( info ); + writeln( info, 'NOTA: La cantidad de intercambios medida se tom¢ a partir de la cantidad de' ); + writeln( info, '==== asignaciones, ya que en el Insertion Sort no hay intercambios. De esta' ); + writeln( info, ' manera, un intercambio equivales a 3 asignaciones.' ); + close( info ); + end; { procedure CrearInforme } + + (*********************************************************) + + procedure NoExisteArch; + + begin + clrscr; + gotoxy( 20, 10 ); + textcolor( LightMagenta + Blink ); + writeln( 'ERROR: No existe el archivo a evaluar!' ); + textcolor( LightGray ); + writeln; + writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' ); + delay( 4000 ); + end; { procedure NoExisteArch } + + (*********************************************************) + + function ExisteArchivo( nombre: String ): boolean; + + { funcion extrida de la ayuda del Turbo Pascal 7 } + + var + arch: text; + + begin + {$I-} + Assign( arch, nombre ); + FileMode := 0; { Solo lectura } + Reset( arch ); + Close( arch ); + {$I+} + ExisteArchivo := (IOResult = 0) and (nombre <> ''); + end; { function ExisteArchivo } + + (*********************************************************) + + procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer ); + + var + i: integer; + void: string[2]; + + begin + for i:= 1 to tam do + begin + readln( ar, datos[i].ap ); + readln( ar, datos[i].dni ); + readln( ar, void ); + end; + end; { procedure CargarTabla } + + (*********************************************************) + + procedure Intercambiar( var a, b: PERSONA; var int: longint ); + + var + aux: PERSONA; + + begin + int := int + 1; + Retardar( RETARDO ); + aux := a; + int := int + 1; + Retardar( RETARDO ); + a := b; + int := int + 1; + Retardar( RETARDO ); + b := aux; + end; { procedure Intercambiar } + + (*********************************************************) + + procedure GetHora( var hor: HORA ); + + var + h, m, s, c: word; + + begin + gettime( h, m, s, c ); + hor.h := h; + hor.m := m; + hor.s := s; + hor.c := c; + end; { procedure GetHora } + + (*********************************************************) + + function GetTiempo( h1, h2: HORA ): longint; + + var + t: longint; + aux: HORA; + + begin + if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 } + begin + if h1.h < h2.h then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.m <> h2.m then + begin + if h1.m < h2.m then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.s <> h2.s then + begin + if h1.s < h2.s then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.c <> h2.c then + if h1.c < h2.c then + begin + aux := h1; + h1 := h2; + h2 := aux; + end; + t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c ); + GetTiempo := t; + end; { function GetTiempo } + + (*********************************************************) + + procedure EvaluarCre( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], m.Int); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap > datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], m.Int); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, d, j, tmp: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + i := 2; + d := tam; + tmp := tam; + repeat + for j := d downto i do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + i := tmp + 1; + for j := i to d do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + d := tmp - 1; + until i >= d; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShakeSort } + + (*********************************************************) + + procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 1 to tam do + begin + for j := i + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap > datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure RippleSort } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[sel].ap > datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], m.Int); + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j, k: integer; + tmp: PERSONA; + terminar: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 2 to tam do + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + tmp := datos[i]; + j := i - 1; + terminar := false; + while ( j >= 1 ) and ( not terminar ) do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( tmp.ap < datos[j].ap ) then + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := datos[j]; + j := j - 1; + end + else terminar := true; + end; + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := tmp; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure InsertionSort } + + (*********************************************************) + + procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + hueco, i, j: integer; + huboint: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + huboint := true; + while huboint do + begin + huboint := false; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + huboint := true; + end; + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSort } + + (*********************************************************) + + procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure Shell( var datos: TABLA; hueco, i: integer; var comp, int: longint ); + var + j: integer; + + begin + j := i + hueco; + comp := comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, comp, int ); + end; + end; { procedure Shell } + + (*********************************************************) + + var { procedure ShellSortMej } + h1, h2: HORA; + hueco, i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap > datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, m.Comp, m.Int ); + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSortMej } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure QSort( var datos: TABLA; min, max: integer; var comp, int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[i].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[j].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, m.Comp, m.Int ); + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure QuickSort } + + (*********************************************************) + + begin { procedure EvaluarCre } + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bs ); + BubbleSortMej( arch, datos, 1000, bsm ); + ShakeSort( arch, datos, 1000, shs ); + RippleSort( arch, datos, 1000, rs ); + SelectionSort( arch, datos, 1000, ss ); + InsertionSort( arch, datos, 1000, is ); + ShellSort( arch, datos, 1000, sls ); + ShellSortMej( arch, datos, 1000, slsm ); + QuickSort( arch, datos, 1000, qs ); + CrearInforme( CRECIENTE ); + end + else + NoExisteArch; + end; { procedure EvaluarCre } + + (*********************************************************) + + procedure EvaluarDec( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap < datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], m.Int); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap < datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], m.Int); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure ShakeSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, d, j, tmp: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + i := 2; + d := tam; + tmp := tam; + repeat + for j := d downto i do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + i := tmp + 1; + for j := i to d do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[j].ap > datos[j-1].ap then + begin + Intercambiar( datos[j], datos[j-1], m.Int ); + tmp := j; + end; + end; + d := tmp - 1; + until i >= d; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShakeSort } + + (*********************************************************) + + procedure RippleSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 1 to tam do + begin + for j := i + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[i].ap < datos[j].ap then Intercambiar( datos[i], datos[j], m.Int ); + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure RippleSort } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if datos[sel].ap < datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], m.Int); + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure InsertionSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + i, j, k: integer; + tmp: PERSONA; + terminar: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := 2 to tam do + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + tmp := datos[i]; + j := i - 1; + terminar := false; + while ( j >= 1 ) and ( not terminar ) do + begin + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( tmp.ap > datos[j].ap ) then + begin + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := datos[j]; + j := j - 1; + end + else terminar := true; + end; + m.Int := m.Int + 1; + Retardar( RETARDO ); + datos[j+1] := tmp; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure InsertionSort } + + (*********************************************************) + + procedure ShellSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + var + h1, h2: HORA; + hueco, i, j: integer; + huboint: boolean; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + huboint := true; + while huboint do + begin + huboint := false; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + huboint := true; + end; + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSort } + + (*********************************************************) + + procedure ShellSortMej( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + (*********************************************************) + + procedure Shell( var datos: TABLA; hueco, i: integer; + var comp: longint; var int: longint ); + var + j: integer; + + begin + j := i + hueco; + comp := comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, comp, int ); + end; + end; { procedure Shell } + + (*********************************************************) + + var { procedure ShellSortMej } + h1, h2: HORA; + hueco, i, j: integer; + + begin + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + hueco := tam; + while hueco > 1 do + begin + hueco := hueco div 2; + for i := 1 to tam - hueco do + begin + j := i + hueco; + m.Comp := m.Comp + 1; + Retardar( RETARDO ); + if ( datos[i].ap < datos[j].ap ) then + begin + Intercambiar( datos[i], datos[j], m.Int ); + if (i - hueco) > 0 then + Shell( datos, hueco, i - hueco, m.Comp, m.Int ); + end; + end; + end; + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure ShellSortMej } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; var m: MEDICION ); + + procedure QSort( var datos: TABLA; min, max: integer; + var comp: longint; var int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[i].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + Retardar( RETARDO ); + flag := false; + while datos[j].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + Retardar( RETARDO ); + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + m.Comp := 0; + m.Int := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, m.Comp, m.Int ); + GetHora( h2 ); + m.Tiem := GetTiempo( h1, h2 ); + end; { procedure QuickSort } + + (*********************************************************) + + begin { procedure EvaluarDec } + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bs ); + BubbleSortMej( arch, datos, 1000, bsm ); + ShakeSort( arch, datos, 1000, shs ); + RippleSort( arch, datos, 1000, rs ); + SelectionSort( arch, datos, 1000, ss ); + InsertionSort( arch, datos, 1000, is ); + ShellSort( arch, datos, 1000, sls ); + ShellSortMej( arch, datos, 1000, slsm ); + QuickSort( arch, datos, 1000, qs ); + CrearInforme( DECRECIENTE ); + end + else + NoExisteArch; + end; { procedure EvaluarDec } + + (*********************************************************) + + var { procedure MenuEvaluar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Evaluar Algoritmos:' ); + writeln( ' ------- ----------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Ordenando en forma creciente.' ); + writeln( ' 2.- Ordenando en forma decreciente.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch ) + else NoExisteArch; + '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch ) + else NoExisteArch; + '0': ; + end; + end; + +(*********************************************************) +(*********************************************************) + + procedure MenuGenerar( var arch: text ); + + type + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + + (*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + (*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; { function GetVocal } + + (*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; { procedure GetRNDVocal } + + (*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedure GetRNDConsonante } + + (*********************************************************) + + var { function GetRNDApellido } + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; { function GetRNDApellido } + + (*********************************************************) + + function GetRNDLetra( min, max: char ): char; + + begin + GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); + end; + + (*********************************************************) + + procedure GetOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 10000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'A' to 'Z' do + begin + ap := letra; + for letra1 := 'A' to 'Z' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { procedure GetOrdApellidos } + + (*********************************************************) + + procedure GetInvOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 34000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'Z' downto 'A' do + begin + ap := letra; + for letra1 := 'Z' downto 'A' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni - random( 40000 ) - 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { GetInvOrdApellidos } + + + (*********************************************************) + + procedure GenerarRND( var arch: text; n: integer; reabrir: boolean ); + + var + i: integer; + ap: APELLIDO; + dni: DOCUMENTO; + + begin + if reabrir then rewrite( arch ); + dni := 10000000 + (random( 15000 ) * 100); + + for i := 1 to n do + begin + ap := GetRNDApellido( 8, 4 ); + dni := dni + random( 50000 ) + 1; + writeln( arch, ap ); + writeln( arch, dni ); + writeln( arch ); + end; + if reabrir then close( arch ); + end; { procedure GenerarRND } + + (*********************************************************) + + procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetInvOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure Generar90Ord( var arch: text ); + + begin + rewrite( arch ); + GenerarOrd( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + procedure Generar90OrdDec( var arch: text ); + + begin + rewrite( arch ); + GenerarOrdDec( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + var { procedure MenuGenerar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Generar Archivo (''DATOS.TXT''):' ); + writeln( ' ------- ------- -------------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Con datos desordenados.' ); + writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' ); + writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' ); + writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1 a 5 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': GenerarRND( arch, 1000, true ); + '2': GenerarOrd( arch, 1000, true ); + '3': GenerarOrdDec( arch, 1000, true ); + '4': Generar90Ord( arch ); + '5': Generar90OrdDec( arch ); + '0': ; + end; + end; { procedure MenuGenerar } + +(*********************************************************) + + procedure PantallaSalida; + + begin + writeln; + NormVideo; + clrscr; + writeln; + textcolor( white ); + writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n ', VERSION, ' <-o-o-> Luca - Soft' ); + NormVideo; + writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' ); + writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' ); + writeln; + textcolor( LightMagenta ); + write( ' lluca@cnba.uba.ar' ); + NormVideo; + write( ' o ' ); + textcolor( LightMagenta ); + writeln( 'lluca@geocities.com' ); + NormVideo; + writeln; + writeln( ' (c) 1999 - Todos los derechos reservados.' ); + delay( 750 ); + end; + +(*********************************************************) + +var { programa } + datos: TABLA; + arch: text; + tecla: char; + salir: boolean; + +begin + randomize; + assign( arch, 'DATOS.TXT' ); + salir := false; + textbackground( Blue ); + + while not salir do + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + gotoxy( 1, 7 ); + textcolor( LightCyan ); + writeln( ' Men£ Principal:' ); + writeln( ' ---- ---------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' ); + writeln( ' 2.- Evaluar Algoritmos.' ); + writeln( ' 0.- Salir.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': MenuGenerar( arch ); + '2': MenuEvaluar( datos, arch ); + '0': salir := true; + end; + end; + PantallaSalida; +end. \ No newline at end of file diff --git a/test/IRDnames.pas b/test/IRDnames.pas new file mode 100644 index 0000000..9edf442 --- /dev/null +++ b/test/IRDnames.pas @@ -0,0 +1,319 @@ +program Generador_De_Nombres_Ordenados_Alfabeticamente; + +uses + CRT; + +const + MAX_APE = 15; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = 10000000..40000000; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + TABLA = array[1..1000] of PERSONA; + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + +(*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; + +(*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; + +(*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedimiento } + +(*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + var + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; + +(*********************************************************) + + function GetRNDLetra( min, max: char ): char; + + begin + GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); + end; + + +(*********************************************************) + procedure GetInvOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 34000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'Z' downto 'A' do + begin + ap := letra; + for letra1 := 'Z' downto 'A' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni - random( 50000 ) - 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { procedure } + +(*********************************************************) + +var + datos: TABLA; + arch: text; + dni: DOCUMENTO; + i, n: integer; + +begin + randomize; + + n := 1000; + assign( arch, 'DATOS.TXT' ); + rewrite( arch ); + readln( n ); + GetInvOrdApellidos( arch, n ); + close( arch ); +end. \ No newline at end of file diff --git a/test/ORDnames.pas b/test/ORDnames.pas new file mode 100644 index 0000000..945994a --- /dev/null +++ b/test/ORDnames.pas @@ -0,0 +1,332 @@ +program Generador_De_Nombres_Ordenados_Alfabeticamente; + +uses + CRT; + +const + MAX_APE = 15; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = 10000000..40000000; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + TABLA = array[1..1000] of PERSONA; + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + +(*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; + +(*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; + +(*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedimiento } + +(*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + var + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; + +(*********************************************************) + + function GetRNDLetra( min, max: char ): char; + + begin + GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); + end; + + +(*********************************************************) + procedure GetOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 10000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'A' to 'Z' do + begin + ap := letra; + for letra1 := 'A' to 'Z' do + begin + { + writeln( ar, 'ciclo for letra1 := ''A'' to ''Z'' do. letra1: ', letra1 ); + } + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + + {writeln( ar, 'apel := NADA' );} + {delay( 500 );} + end; + ape := ''; + + {writeln( ar, 'ape := NADA' );} + {delay( 500 );} + + end; { for letra1 := 'A' to 'Z' do } + + {writeln( ar, 'En AP: ', ap );} + + ap := ''; + + {writeln( ar, 'ap := NADA' );} + {delay( 500 );} + + end; { for letra := 'A' to 'Z' do } + + end; { procedure } + +(*********************************************************) + +var + datos: TABLA; + arch: text; + dni: DOCUMENTO; + i, n: integer; + +begin + randomize; + + n := 1000; + assign( arch, 'DATOS.TXT' ); + rewrite( arch ); + readln( n ); + GetOrdApellidos( arch, n ); + close( arch ); +end. \ No newline at end of file diff --git a/test/RNDnames.pas b/test/RNDnames.pas new file mode 100644 index 0000000..f6d9f8b --- /dev/null +++ b/test/RNDnames.pas @@ -0,0 +1,244 @@ +program RNDNames; + +const + MAX_APE = 15; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = 10000000..40000000; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + TABLA = array[1..1000] of PERSONA; + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + +(*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; + +(*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; + +(*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedimiento } + +(*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + var + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; + +var + n, i: integer; + arch: text; + ap: APELLIDO; + dni: DOCUMENTO; + +begin + randomize; + n := 1000; + assign( arch, 'DATOS.TXT' ); + rewrite( arch ); + dni := 10000000 + (random( 15000 ) * 100); + + for i := 1 to n do + begin + ap := GetRNDApellido( 7, 4 ); + dni := dni + random( 50000 ) + 1; + writeln( arch, ap ); + writeln( arch, dni ); + writeln( arch ); + end; + close( arch ); +end. diff --git a/test/SORTINGMetodos.pas b/test/SORTINGMetodos.pas new file mode 100644 index 0000000..4b334c0 --- /dev/null +++ b/test/SORTINGMetodos.pas @@ -0,0 +1,435 @@ +{ Updated SORTING.SWG on May 26, 1995 } + +{ +>I've been programming for a couple years now, but there are certain things +>that you seldom just figure out on your own. One of them is the multitude +>of standard sorting techniques. I did learn these, however, in a class I +>took last year in Turbo Pascal. Let's see, Bubble Sort, Selection Sort, +>Quick Sort.. I think that's what they were called. Anyway, if anyone +>has the time and desire I'd appreciate a quick run-down of each and if +>possible some source for using them on a linked list. I remember most of +>the code to do them on arrays, but I forget which are the most efficient +>for each type of data. + +Here is a program that I was given to demonstrate 8 different types of sorts. +I don't claim to know how they work, but it does shed some light on what the +best type probably is. BTW, it can be modified to allow for a random number +of sort elements (up to maxint div 10 I believe). + + ALLSORT.PAS: Demonstration of various sorting methods. + Released to the public domain by Wayel A. Al-Wohaibi. + + ALLSORT.PAS was written in Turbo Pascal 3.0 (but compatible with + TP6.0) while taking a pascal course in 1988. It is provided as is, + to demonstrate how sorting algorithms work. Sorry, no documentation + (didn't imagine it would be worth releasing) but bugs are included + too! + + ALLSORT simply shows you how elements are rearranged in each + iteration of each of the eight popular sorting methods. +} + +program SORTINGMETHODS; +uses + Crt; + +const + N = 14; (* NO. OF DATA TO BE SORTED *) + Digits = 3; (* DIGITAL SIZE OF THE DATA *) + Range = 1000; (* RANGE FOR THE RANDOM GENERATOR *) + +type + ArrayType = array[1..N] of integer; + TwoDimension = array[0..9, 1..N] of integer; (* FOR RADIX SORT ONLY *) + +var + Data : ArrayType; + D : integer; + + (*--------------------------------------------------------------------*) + + procedure GetSortMethod; + begin + clrscr; + writeln; + writeln(' CHOOSE: '); + writeln(' '); + writeln(' 1 FOR SELECT SORT '); + writeln(' 2 FOR INSERT SORT '); + writeln(' 3 FOR BUBBLE SORT '); + writeln(' 4 FOR SHAKE SORT '); + writeln(' 5 FOR HEAP SORT '); + writeln(' 6 FOR QUICK SORT '); + writeln(' 7 FOR SHELL SORT '); + writeln(' 8 FOR RADIX SORT '); + writeln(' 9 TO EXIT ALLSORT '); + writeln(' '); + writeln; + readln(D) + end; + + procedure LoadList; + var + I : integer; + begin + for I := 1 to N do + Data[I] := random(Range) + end; + + procedure ShowInput; + var + I : integer; + begin + clrscr; + write('INPUT :'); + for I := 1 to N do + write(Data[I]:5); + writeln + end; + + procedure ShowOutput; + var + I : integer; + begin + write('OUTPUT:'); + for I := 1 to N do + write(Data[I]:5) + end; + + procedure Swap(var X, Y : integer); + var + Temp : integer; + begin + Temp := X; + X := Y; + Y := Temp + end; + + (*-------------------------- R A D I X S O R T ---------------------*) + + function Hash(Number, H : integer) : integer; + begin + case H of + 3 : Hash := Number mod 10; + 2 : Hash := (Number mod 100) div 10; + 1 : Hash := Number div 100 + end + end; + + procedure CleanArray(var TwoD : TwoDimension); + var + I, J : integer; + begin + for I := 0 to 9 do + for J := 1 to N do + TwoD[I, J] := 0 + end; + + procedure PlaceIt(var X : TwoDimension; Number, I : integer); + var + J : integer; + Empty : boolean; + begin + J := 1; + Empty := false; + repeat + if (X[I, J] > 0) then + J := J + 1 + else + Empty := true; + until (Empty) or (J = N); + X[I, J] := Number + end; + + procedure UnLoadIt(X : TwoDimension; var Passed : ArrayType); + var + I, + J, + K : integer; + begin + K := 1; + for I := 0 to 9 do + for J := 1 to N do + begin + if (X[I, J] > 0) then + begin + Passed[K] := X[I, J]; + K := K + 1 + end + end + end; + + procedure RadixSort(var Pass : ArrayType; N : integer); + var + Temp : TwoDimension; + Element, + Key, + Digit, + I : integer; + begin + for Digit := Digits downto 1 do + begin + CleanArray(Temp); + for I := 1 to N do + begin + Element := Pass[I]; + Key := Hash(Element, Digit); + PlaceIt(Temp, Element, Key) + end; + UnLoadIt(Temp, Pass); + ShowOutput; + readln + end + end; + + (*-------------------------- H E A P S O R T -----------------------*) + + procedure ReHeapDown(var HEAPData : ArrayType; Root, Bottom : integer); + var + HeapOk : boolean; + MaxChild : integer; + begin + HeapOk := false; + while (Root * 2 <= Bottom) + and not HeapOk do + begin + if (Root * 2 = Bottom) then + MaxChild := Root * 2 + else + if (HEAPData[Root * 2] > HEAPData[Root * 2 + 1]) then + MaxChild := Root * 2 + else + MaxChild := Root * 2 + 1; + if (HEAPData[Root] < HEAPData[MaxChild]) then + begin + Swap(HEAPData[Root], HEAPData[MaxChild]); + Root := MaxChild + end + else + HeapOk := true + end + end; + + procedure HeapSort(var Data : ArrayType; NUMElementS : integer); + var + NodeIndex : integer; + begin + for NodeIndex := (NUMElementS div 2) downto 1 do + ReHeapDown(Data, NodeIndex, NUMElementS); + for NodeIndex := NUMElementS downto 2 do + begin + Swap(Data[1], Data[NodeIndex]); + ReHeapDown(Data, 1, NodeIndex - 1); + ShowOutput; + readln; + end + end; + + (*-------------------------- I N S E R T S O R T -------------------*) + + procedure StrInsert(var X : ArrayType; N : integer); + var + J, + K, + Y : integer; + Found : boolean; + begin + for J := 2 to N do + begin + Y := X[J]; + K := J - 1; + Found := false; + while (K >= 1) + and (not Found) do + if (Y < X[K]) then + begin + X[K + 1] := X[K]; + K := K - 1 + end + else + Found := true; + X[K + 1] := Y; + ShowOutput; + readln + end + end; + + (*-------------------------- S H E L L S O R T ---------------------*) + + procedure ShellSort(var A : ArrayType; N : integer); + var + Done : boolean; + Jump, + I, + J : integer; + begin + Jump := N; + while (Jump > 1) do + begin + Jump := Jump div 2; + repeat + Done := true; + for J := 1 to (N - Jump) do + begin + I := J + Jump; + if (A[J] > A[I]) then + begin + Swap(A[J], A[I]); + Done := false + end; + end; + until Done; + ShowOutput; + readln + end + end; + + (*-------------------------- B U B B L E S O R T -------------------*) + + procedure BubbleSort(var X : ArrayType; N : integer); + var + I, + J : integer; + begin + for I := 2 to N do + begin + for J := N downto I do + if (X[J] < X[J - 1]) then + Swap(X[J - 1], X[J]); + ShowOutput; + readln + end + end; + + (*-------------------------- S H A K E S O R T ---------------------*) + + procedure ShakeSort(var X : ArrayType; N : integer); + var + L, + R, + K, + J : integer; + begin + L := 2; + R := N; + K := N; + repeat + for J := R downto L do + if (X[J] < X[J - 1]) then + begin + Swap(X[J], X[J - 1]); + K := J + end; + L := K + 1; + for J := L to R do + if (X[J] < X[J - 1]) then + begin + Swap(X[J], X[J - 1]); + K := J + end; + R := K - 1; + ShowOutput; + readln; + until L >= R + end; + + (*-------------------------- Q W I C K S O R T ---------------------*) + + procedure Partition(var A : ArrayType; First, Last : integer); + var + Right, + Left : integer; + V : integer; + begin + V := A[(First + Last) div 2]; + Right := First; + Left := Last; + repeat + while (A[Right] < V) do + Right := Right + 1; + while (A[Left] > V) do + Left := Left - 1; + if (Right <= Left) then + begin + Swap(A[Right], A[Left]); + Right := Right + 1; + Left := Left - 1 + end; + until Right > Left; + ShowOutput; + readln; + if (First < Left) then + Partition(A, First, Left); + if (Right < Last) then + Partition(A, Right, Last) + end; + + procedure QuickSort(var List : ArrayType; N : integer); + var + First, + Last : integer; + begin + First := 1; + Last := N; + if (First < Last) then + Partition(List, First, Last) + end; + + (*-------------------------- S E L E C T S O R T -------------------*) + + procedure StrSelectSort(var X : ArrayType; N : integer); + var + I, + J, + K, + Y : integer; + begin + for I := 1 to N - 1 do + begin + K := I; + Y := X[I]; + for J := (I + 1) to N do + if (X[J] < Y) then + begin + K := J; + Y := X[J] + end; + X[K] := X[J]; + X[I] := Y; + ShowOutput; + readln + end + end; + + (*--------------------------------------------------------------------*) + + procedure Sort; + begin + case D of + 1 : StrSelectSort(Data, N); + 2 : StrInsert(Data, N); + 3 : BubbleSort(Data, N); + 4 : ShakeSort(Data, N); + 5 : HeapSort(Data, N); + 6 : QuickSort(Data, N); + 7 : ShellSort(Data, N); + 8 : RadixSort(Data, N); + else + writeln('BAD INPUT') + end + end; + + (*-------------------------------------------------------------------*) + +BEGIN + GetSortMethod; + while (D <> 9) do + begin + LoadList; + ShowInput; + Sort; + writeln('PRESS ENTER TO RETURN'); + readln; + GetSortMethod + end +END. \ No newline at end of file diff --git a/test/cargar.pas b/test/cargar.pas new file mode 100644 index 0000000..f6d9f8b --- /dev/null +++ b/test/cargar.pas @@ -0,0 +1,244 @@ +program RNDNames; + +const + MAX_APE = 15; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = 10000000..40000000; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + TABLA = array[1..1000] of PERSONA; + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + +(*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; + +(*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; + +(*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedimiento } + +(*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + var + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; + +var + n, i: integer; + arch: text; + ap: APELLIDO; + dni: DOCUMENTO; + +begin + randomize; + n := 1000; + assign( arch, 'DATOS.TXT' ); + rewrite( arch ); + dni := 10000000 + (random( 15000 ) * 100); + + for i := 1 to n do + begin + ap := GetRNDApellido( 7, 4 ); + dni := dni + random( 50000 ) + 1; + writeln( arch, ap ); + writeln( arch, dni ); + writeln( arch ); + end; + close( arch ); +end. diff --git a/test/comp_.pas b/test/comp_.pas new file mode 100644 index 0000000..91def5d --- /dev/null +++ b/test/comp_.pas @@ -0,0 +1,1002 @@ +program Comparacion_De_Algoritmos_De_Ordenamiento; + +uses + CRT, DOS; + +const + MAX_APE = 15; + +type + APELLIDO = string[MAX_APE]; + DOCUMENTO = longint; + PERSONA = record + ap: APELLIDO; + dni: DOCUMENTO; + end; + HORA = record + h, + m, + s, + c: longint; + end; + TABLA = array[1..1000] of PERSONA; + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + +(*********************************************************) + + procedure CargarArchivo( var datos: TABLA; var ar: text; tam: integer ); + + var + i: integer; + + begin + for i:= 1 to tam do + begin + writeln( ar, datos[i].ap ); + writeln( ar, datos[i].dni ); + writeln( ar ); + end; + end; + +(*********************************************************) +(*********************************************************) + + procedure MenuEvaluar( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure NoExisteArch; + + begin + clrscr; + gotoxy( 20, 10 ); + textcolor( LightMagenta + Blink ); + writeln( 'ERROR: No existe el archivo a evaluar!' ); + textcolor( LightGray ); + writeln; + writeln( ' Creelo seleccionando la opci¢n 1 del Men£ Principal.' ); + delay( 4000 ); + end; { procedure NoExisteArch } + + (*********************************************************) + + function ExisteArchivo( nombre: String ): boolean; + { funcion extrido de la ayuda del pascal } + var + arch: text; + + begin + {$I-} + Assign( arch, nombre ); + FileMode := 0; { Solo lectura } + Reset( arch ); + Close( arch ); + {$I+} + ExisteArchivo := (IOResult = 0) and (nombre <> ''); + end; { function ExisteArchivo } + + (*********************************************************) + + procedure CargarTabla( var ar: text; var datos: TABLA; tam: integer ); + + var + i: integer; + void: string[2]; + + begin + for i:= 1 to tam do + begin + readln( ar, datos[i].ap ); + readln( ar, datos[i].dni ); + readln( ar, void ); + end; + end; { procedure CargarTabla } + + (*********************************************************) + + procedure Intercambiar( var a, b: PERSONA; var int: longint ); + + var + aux: PERSONA; + + begin + int := int + 1; + aux := a; + a := b; + b := aux; + { delay( 1 );} + end; { procedure Intercambiar } + + (*********************************************************) + + procedure GetHora( var hor: HORA ); + + var + h, m, s, c: word; + + begin + gettime( h, m, s, c ); + hor.h := h; + hor.m := m; + hor.s := s; + hor.c := c; + end; { procedure GetHora } + + (*********************************************************) + + function GetTiempo( h1, h2: HORA ): longint; + + var + t: longint; + aux: HORA; + + begin + if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 } + begin + if h1.h < h2.h then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.m <> h2.m then + begin + if h1.m < h2.m then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.s <> h2.s then + begin + if h1.s < h2.s then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.c <> h2.c then + if h1.c < h2.c then + begin + aux := h1; + h1 := h2; + h2 := aux; + end; + t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c ); + GetTiempo := t; + end; { function GetTiempo } + + (*********************************************************) + + procedure EvaluarCre( var datos: TABLA; var arch: text ); + + (*********************************************************) + + procedure BubbleSort( var arch: text; var datos: TABLA; tam: integer; + var comparaciones: longint; var intercambios: longint; var tiempo: longint ); + + var + i, j: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + comparaciones := 0; + intercambios := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for i := tam - 1 downto 1 do + begin + for j := tam - 1 downto 1 do + begin + comparaciones := comparaciones + 1; + { delay( 1 );} + if datos[j].ap > datos[j+1].ap then + Intercambiar( datos[j], datos[j+1], intercambios); + end; + end; + GetHora( h2 ); + tiempo := GetTiempo( h1, h2 ); + end; { procedure BubbleSort } + + (*********************************************************) + + procedure BubbleSortMej( var arch: text; var datos: TABLA; tam: integer; + var comparaciones: longint; var intercambios: longint; var tiempo: longint ); + + var + huboint: boolean; + i, n: integer; + h1, h2: HORA; + + begin + GetHora( h1 ); + comparaciones := 0; + intercambios := 0; + n := 1; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + huboint := true; + while huboint do + begin + huboint := false; + for i := tam - 1 downto n do + begin + comparaciones := comparaciones + 1; + { delay( 1 );} + if datos[i].ap > datos[i+1].ap then + begin + Intercambiar( datos[i], datos[i+1], intercambios); + huboint := true; + end; + end; + n := n + 1; + end; + GetHora( h2 ); + tiempo := GetTiempo( h1, h2 ); + end; { procedure BubbleSortMej } + + (*********************************************************) + + procedure SelectionSort( var arch: text; var datos: TABLA; tam: integer; + var comparaciones: longint; var intercambios: longint; var tiempo: longint ); + var + i, sel, n: integer; + hubosel: boolean; + h1, h2: HORA; + + begin + GetHora( h1 ); + comparaciones := 0; + intercambios := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + for n := 1 to tam - 1 do + begin + hubosel := false; + sel := n; + for i := n + 1 to tam do + begin + comparaciones := comparaciones + 1; + { delay( 1 ); } + if datos[sel].ap > datos[i].ap then + begin + sel := i; + hubosel := true; + end; + end; + if hubosel then Intercambiar( datos[n], datos[sel], intercambios); + end; + GetHora( h2 ); + tiempo := GetTiempo( h1, h2 ); + end; { procedure SelectionSort } + + (*********************************************************) + + procedure QuickSort( var arch: text; var datos: TABLA; tam: integer; + var comparaciones: longint; var intercambios: longint; var tiempo: longint ); + + procedure QSort( var datos: TABLA; min, max: integer; + var comp: longint; var int: longint ); + + var + i, j: integer; + sel: PERSONA; + flag: boolean; + + begin + sel := datos[( min + max ) div 2]; + i := min; + j := max; + repeat + comp := comp + 1; + { delay( 1 );} + flag := false; + while datos[i].ap < sel.ap do + begin + if flag then begin + comp := comp + 1; + { delay( 1 );} + end + else flag := true; + i := i + 1; + end; + comp := comp + 1; + { delay( 1 );} + flag := false; + while datos[j].ap > sel.ap do + begin + if flag then begin + comp := comp + 1; + { delay( 1 );} + end + else flag := true; + j := j - 1; + end; + if i <= j then + begin + if i < j then Intercambiar( datos[i], datos[j], int ); + i := i + 1; + j := j - 1; + end; + until i > j; + if min < j then QSort( datos, min, j, comp, int); + if i < max then QSort( datos, i, max, comp, int); + end; { procedure QSort } + + (*********************************************************) + + var + h1, h2: HORA; + + begin { procedure QuickSort } + GetHora( h1 ); + comparaciones := 0; + intercambios := 0; + reset( arch ); + CargarTabla( arch, datos, 1000 ); + close( arch ); + QSort( datos, 1, 1000, comparaciones, intercambios ); + GetHora( h2 ); + tiempo := GetTiempo( h1, h2 ); + rewrite( arch ); + CargarArchivo( datos, arch, 1000 ); + close( arch ); + end; { procedure QuickSort } + + (*********************************************************) + + var { procedure EvaluarCre } + bsComp, bsInt, bsTiem, + bsmComp, bsmInt, bsmTiem, + ssComp, ssInt, ssTiem, + qsComp, qsInt, qsTiem: longint; + info: text; + + begin + assign( info, 'INFORME.TXT' ); + if ExisteArchivo( 'DATOS.TXT' ) then + begin + BubbleSort( arch, datos, 1000, bsComp, bsInt, bsTiem ); + BubbleSortMej( arch, datos, 1000, bsmComp, bsmInt, bsmTiem ); + SelectionSort( arch, datos, 1000, ssComp, ssInt, ssTiem ); + QuickSort( arch, datos, 1000, qsComp, qsInt, qsTiem ); + rewrite( info ); + writeln( info, 'Bubble Sort:' ); + writeln( info, ' Comparaciones: ', bsComp: 1 ); + writeln( info, ' Intercambios: ', bsInt: 1 ); + writeln( info, ' Tiempo (seg): ', bsTiem / 100: 2: 2 ); + writeln( info ); + writeln( info, 'Bubble Sort Mejorado:' ); + writeln( info, ' Comparaciones: ', bsmComp: 1 ); + writeln( info, ' Intercambios: ', bsmInt: 1 ); + writeln( info, ' Tiempo (seg): ', bsmTiem / 100: 2: 2 ); + writeln( info ); + writeln( info, 'Selection Sort:' ); + writeln( info, ' Comparaciones: ', ssComp: 1 ); + writeln( info, ' Intercambios: ', ssInt: 1 ); + writeln( info, ' Tiempo (seg): ', ssTiem / 100: 2: 2 ); + writeln( info ); + writeln( info, 'Quick Sort:' ); + writeln( info, ' Comparaciones: ', qsComp: 1 ); + writeln( info, ' Intercambios: ', qsInt: 1 ); + writeln( info, ' Tiempo (seg): ', qsTiem / 100: 2: 2 ); + writeln( info ); + close( info ); + end + else + NoExisteArch; + end; { procedure EvaluarCre } + + (*********************************************************) + + procedure EvaluarDec( var datos: TABLA; var arch: text ); + + var nada: integer; + + begin + for nada := 1 to 1000 do + writeln( datos[nada].ap, ' ', datos[nada].dni ); + delay( 3000 ); + end; + + (*********************************************************) + + var { procedure MenuEvaluar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Evaluar Algoritmos:' ); + writeln( ' ------- ----------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Ordenando en forma creciente.' ); + writeln( ' 2.- Ordenando en forma decreciente.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarCre( datos, arch ) + else NoExisteArch; + '2': if ExisteArchivo( 'DATOS.TXT' ) then EvaluarDec( datos, arch ) + else NoExisteArch; + '0': ; + end; + end; + +(*********************************************************) +(*********************************************************) + + procedure MenuGenerar( var arch: text ); + + (*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + (*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal := 'E'; + 8..10: GetVocal := 'I'; + 11..13: GetVocal := 'O'; + 14..15: GetVocal := 'U'; + end; + end; { function GetVocal } + + (*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case indic of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; { procedure GetRNDVocal } + + (*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 10 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 5 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 10 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 5 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 15 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 5 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 5 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 3 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 10 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; { case random( 55 ) of } + + end; { case indic of } + end; { procedure GetRNDConsonante } + + (*********************************************************) + + var { function GetRNDApellido } + tam, i: integer; + aux: char; + apel: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apel := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apel := apel + aux; + end; + GetRNDApellido := apel; + end; { function GetRNDApellido } + + (*********************************************************) + + function GetRNDLetra( min, max: char ): char; + + begin + GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) ); + end; + + (*********************************************************) + + procedure GetOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 10000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'A' to 'Z' do + begin + ap := letra; + for letra1 := 'A' to 'Z' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j = 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { procedure GetOrdApellidos } + + (*********************************************************) + + procedure GetInvOrdApellidos( var ar: text; cant: integer ); + + var + mil: boolean; + letra, letra1: char; + i, j, veces: integer; + dni: DOCUMENTO; + ap, ape, apel: APELLIDO; + + begin + mil := false; + if cant = 1000 then mil := true; + dni := 34000000 + (random( 15000 ) * 100); + ap := ''; + ape := ''; + apel := ''; + for letra := 'Z' downto 'A' do + begin + ap := letra; + for letra1 := 'Z' downto 'A' do + begin + if mil then + case letra of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': + case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2; + else veces := 1; + end; + else case letra1 of + 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2; + else veces := 1; + end; + end + else + case letra of + 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V': + case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2; + else veces := 1; + end; + else case letra1 of + 'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2; + else veces := 1; + end; + end; + ape := ap + letra1; + for j := 1 to veces do + begin + if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 ) + else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 ); + dni := dni - random( 40000 ) - 1; + writeln( ar, apel ); + writeln( ar, dni ); + writeln( ar ); + apel := ''; + end; + + ape := ''; + + end; { for letra1 := 'A' to 'Z' do } + + ap := ''; + + end; { for letra := 'A' to 'Z' do } + + end; { GetInvOrdApellidos } + + + (*********************************************************) + + procedure GenerarRND( var arch: text; n: integer; reabrir: boolean ); + + var + i: integer; + ap: APELLIDO; + dni: DOCUMENTO; + + begin + if reabrir then rewrite( arch ); + dni := 10000000 + (random( 15000 ) * 100); + + for i := 1 to n do + begin + ap := GetRNDApellido( 8, 4 ); + dni := dni + random( 50000 ) + 1; + writeln( arch, ap ); + writeln( arch, dni ); + writeln( arch ); + end; + if reabrir then close( arch ); + end; { procedure GenerarRND } + + (*********************************************************) + + procedure GenerarOrd( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure GenerarOrdDec( var arch: text; n: integer; reabrir: boolean ); + + begin + if reabrir then rewrite( arch ); + GetInvOrdApellidos( arch, n ); + if reabrir then close( arch ); + end; + + (*********************************************************) + + procedure Generar90Ord( var arch: text ); + + begin + rewrite( arch ); + GenerarOrd( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + procedure Generar90OrdDec( var arch: text ); + + begin + rewrite( arch ); + GenerarOrdDec( arch, 900, false ); + GenerarRND( arch, 100, false ); + close( arch ); + end; + + (*********************************************************) + + var { procedure MenuGenerar } + tecla: char; + + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + textcolor( LightCyan ); + gotoxy( 1, 7 ); + writeln( ' Generar Archivo (''DATOS.TXT''):' ); + writeln( ' ------- ------- -------------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Con datos desordenados.' ); + writeln( ' 2.- Con datos en orden creciente (APELLIDO, DNI).' ); + writeln( ' 3.- Con datos en orden decreciente (APELLIDO, DNI).' ); + writeln( ' 4.- Con 90% datos en orden creciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 5.- Con 90% datos en orden decreciente (APELLIDO, DNI) + 10% desordenado.' ); + writeln( ' 0.- Men£ Anterior.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '5' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1 a 5 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': GenerarRND( arch, 1000, true ); + '2': GenerarOrd( arch, 1000, true ); + '3': GenerarOrdDec( arch, 1000, true ); + '4': Generar90Ord( arch ); + '5': Generar90OrdDec( arch ); + '0': ; + end; + end; { procedure MenuGenerar } + +(*********************************************************) + +{ procedure MenuPrincipal( var arch: text; var datos: TABLA );} + + var + datos: TABLA; + arch: text; + tecla: char; + salir: boolean; + + begin + randomize; + assign( arch, 'DATOS.TXT' ); + salir := false; + textbackground( Blue ); + + while not salir do + begin + clrscr; + textcolor( Yellow ); + gotoxy( 19, 3 ); + writeln( 'COMPARACION DE ALGORITMOS DE ORDENAMIENTO' ); + gotoxy( 19, 4 ); + writeln( '~~~~~~~~~~~ ~~ ~~~~~~~~~~ ~~ ~~~~~~~~~~~~' ); + gotoxy( 1, 7 ); + textcolor( LightCyan ); + writeln( ' Men£ Principal:' ); + writeln( ' ---- ---------' ); + textcolor( LightGray ); + writeln; + writeln; + writeln( ' 1.- Generar Archivo (''DATOS.TXT'').' ); + writeln( ' 2.- Evaluar Algoritmos.' ); + writeln( ' 0.- Salir.' ); + gotoxy( 1, 20 ); + textcolor( White ); + write( ' Ingrese su opci¢n: ' ); + textcolor( Yellow ); + tecla := readkey; + while ( ( tecla < '1' ) or ( tecla > '2' ) ) and ( tecla <> '0' ) do + begin + textcolor( White ); + gotoxy( 1, 20 ); + write( ' Ingrese su opci¢n (1, 2 o 0): ' ); + textcolor( Yellow ); + tecla := readkey; + end; + case tecla of + '1': MenuGenerar( arch ); + '2': MenuEvaluar( datos, arch ); + '0': salir := true; + end; + end; + writeln; + NormVideo; + clrscr; + writeln; + textcolor( white ); + writeln( ' COMPARACION DE ALGORITMOS DE ORDENAMIENTO versi¢n 1.1.0 <-o-o-> Luca - Soft' ); + NormVideo; + writeln( ' Desarrollado por Leandro Lucarella para la Facultad de Ingenier¡a de la' ); + writeln( ' Universidad de Buenos Aires. Consultas, sugerencias y/o reprobaciones a:' ); + writeln; + textcolor( LightMagenta ); + write( ' lluca@cnba.uba.ar' ); + NormVideo; + write( ' o ' ); + textcolor( LightMagenta ); + writeln( 'lluca@geocities.com' ); + NormVideo; + writeln; + writeln( ' (c) 1999 - Todos los derechos reservados.' ); + delay( 750 ); + + {close( arch );} + end. \ No newline at end of file diff --git a/test/msdemo.pas b/test/msdemo.pas new file mode 100644 index 0000000..aa9abc8 --- /dev/null +++ b/test/msdemo.pas @@ -0,0 +1,240 @@ +program SortDemo ( Input, Output ); +uses + Crt; + +const + Max = 16; + +type + ArrayType = array [ 1 .. Max ] of Integer; + +var + A : ArrayType; + + procedure DisplayArray ( var A : ArrayType ); + var + I : Integer; + begin + ClrScr; + GotoXY( 1, 5 ); + Write( '(' ); + for I := 1 to Max do + begin + Write( A[ I ] : 3 ); + if I <> Max then + Write( ',' ) + else + Write( ')' ) + end + end; + + procedure FillArray( var A : ArrayType ); + var + I : Integer; + begin + Randomize; + for I := 1 to Max do + A[ I ] := Random( 100 ) + end; + + procedure WriteLT ( Position : Integer; + Level : Integer ); + begin + GoToXY( 4 * Position - 2, Level ); + TextColor( White ); + Write( ' >' ); + TextColor( LightGray ); + end; + + procedure WriteBlank ( Position : Integer; + Level : Integer ); + begin + GoToXY( 4 * Position - 2, Level ); + TextColor( Black ); + Write( ' ' ); + TextColor( LightGray ); + end; + + procedure WriteColor ( I : Integer; + Value : Integer; + Color : Integer; + Row : Integer ); + var + X : Integer; + begin + X := 4 * I - 2; + GoToXY( X, Row ); + TextColor( Color ); + Write( Value : 3 ); + TextColor( LightGray ) + end; + + procedure WriteNormal ( I : Integer; + Value : Integer ); + var + X : Integer; + begin + X := 4 * I - 2; + TextColor( LightGray ); + GoToXY( X, 5 ); + Write( Value : 3 ) + end; + + + procedure MergeSort ( var A : ArrayType ); + {V} var + {V} Level : Integer; + {V} I : Integer; + + procedure Transfer( var F, T : ArrayType; + FromFirst, + FromLast, + ToFirst : Integer ); + var + I : Integer; + begin + for I := FromFirst to FromLast do + T[ ToFirst + ( I - FromFirst ) ] := F[ I ]; + end; {Transfer} + + procedure Merge ( var A : ArrayType; + First, + Last : Integer ); + var + MidPoint, + Left, + Right, + Count : Integer; + Temp : ArrayType; + + {V} I : Integer; + {V} Ch : Char; + + begin + Count := First; + MidPoint := ( First + Last ) div 2; + Left := First; + Right := Midpoint + 1; + + {V} for I := First to Midpoint do + {V} WriteColor( I, A[ I ], LightRed, 5 ); + {V} for I := Right to Last do + {V} WriteColor( I, A[ I ], LightBlue, 5 ); + {V} Ch := ReadKey; + + {V} for I := First to Last do + {V} WriteBlank( I, 5 ); + {V} for I := First to Midpoint do + {V} WriteColor( I, A[ I ], LightRed, 10 ); + {V} for I := Right to Last do + {V} WriteColor( I, A[ I ], LightBlue, 11 ); + {V} Ch := ReadKey; + + while ( Left <= Midpoint ) and ( Right <= Last ) do + begin + if A[ Left ] < A[ Right ] then + begin + Temp[ Count ] := A[ Left ]; + + {V} WriteColor( Count, A[ Left ], LightRed, 5 ); + {V} WriteBlank( Left, 10 ); + {V} Ch := ReadKey; + + Inc( Left ); + end + else + begin + Temp[ Count ] := A[ Right ]; + + {V} WriteColor( Count, A[ Right ], LightBlue, 5 ); + {V} WriteBlank( Right, 11 ); + {V} Ch := ReadKey; + + Inc( Right ); + end; + Inc( Count ) + end; + + if ( Left <= MidPoint ) then + {V} begin + Transfer( A, Temp, Left, Midpoint, Count ); + {V} for I := Left to Midpoint do + {V} begin + {V} WriteColor( Count, A[ I ], LightRed, 5 ); + {V} WriteBlank( I, 10 ); + {V} Inc( Count ); + {V} Ch := ReadKey; + {V} end; + {V} end + + else + {V} begin + Transfer( A, Temp, Right, Last, Count ); + {V} for I := Right to Last do + {V} begin + {V} WriteColor( Count, A[ I ], LightBlue, 5 ); + {V} WriteBlank( I, 11 ); + {V} Inc( Count ); + {V} Ch := ReadKey; + {V} end; + {V} end; + + Transfer( Temp, A, First, Last, First ); + + + end; {Merge} + + procedure MSort ( var A : ArrayType; + First, + Last : Integer ); + var + MidPoint : Integer; + {V} I : Integer; + {V} Ch : Char; + begin + if First < Last then + begin + MidPoint := ( First + Last ) div 2; + MSort( A, First, MidPoint ); + + {V} for I := First to MidPoint do + {V} WriteLT( I, Level ); + {V} Inc( Level ); + + MSort( A, MidPoint + 1, Last ); + + {V} for I := MidPoint + 1 to Last do + {V} WriteLT( I, Level ); + {V} Inc( Level ); + + Merge( A, First, Last ); + + {V} for I := MidPoint + 1 to Last do + {V} begin + {V} WriteBlank( I, Level ); + {V} WriteBlank( I, Level - 1 ); + {V} WriteLT( I, Level - 2 ); + {V} end; + {V} Dec( Level, 2 ); + + {V} for I := First to Last do + {V} WriteNormal( I, A[ I ] ); + {V} Ch := ReadKey + end + end; {MSort} + + begin + {V} Level := 6; + + MSort( A, 1, Max ); + + {V} for I := 1 to Max do + {V} WriteLT( I, Level ); + end; {MergeSort} + +begin + FillArray( A ); + DisplayArray( A ); + MergeSort( A ); +end. + diff --git a/test/qsdemo.pas b/test/qsdemo.pas new file mode 100644 index 0000000..f33b5c3 --- /dev/null +++ b/test/qsdemo.pas @@ -0,0 +1,187 @@ +program SortDemo ( Input, Output ); +uses + Crt; + +const + Max = 12; + +type + ArrayType = array [ 1 .. Max ] of Integer; + +var + A : ArrayType; + + procedure DisplayArray ( var A : ArrayType ); + var + I : Integer; + begin + ClrScr; + GotoXY( 1, 5 ); + Write( '(' ); + for I := 1 to Max do + begin + Write( A[ I ] : 4 ); + if I <> Max then + Write( ',' ) + else + Write( ')' ) + end + end; + + procedure FillArray( var A : ArrayType ); + var + I : Integer; + begin + Randomize; + for I := 1 to Max do + A[ I ] := Random( 100 ) + end; + + + procedure WriteColor ( I : Integer; + Value : Integer; + Color : Integer ); + var + X : Integer; + begin + X := 5 * I - 3; + GoToXY( X, 5 ); + TextColor( Color ); + Write( Value : 4 ); + TextColor( LightGray ) + end; + + procedure WriteChColor ( I, J : Integer ); + var + X : Integer; + begin + X := 5 * I - 1; + TextColor( White ); + GotoXY( X, 7 ); + Write( 'Lo' ); + X := 5 * J - 1; + GoToXY( X, 7 ); + Write( 'Hi' ); + end; + + + procedure WriteNormal ( I : Integer; + Value : Integer ); + var + X : Integer; + begin + X := 5 * I - 3; + TextColor( LightGray ); + GoToXY( X, 5 ); + Write( Value : 4 ) + end; + + procedure SetDisplay ( Pivot, Lo, Hi : Integer ); + var + Ch : Char; + begin + GoToXY( 1, 9 ); + TextColor( Green ); + Write( 'Pivot Value = ', Pivot : 3 ); + TextColor( LightRed ); + Write( ' Lo Index = ', Lo : 3 ); + TextColor( LightBlue ); + Write( ' Hi Index = ', Hi : 3 ); + WriteChColor( Lo, Hi ); + Ch := ReadKey; + GoToXY( 1, 9 ); + ClrEol; + GoToXY( 1, 7 ); + Write(' '); + GoToXY( 1, 8 ); + Write(' '); + GoToXY( 1, 9 ); + Write(' '); + TextColor( LightGray ); + end; + + procedure QuickSort ( var A : ArrayType; + Lower, + Upper : Integer ); + + var + PivotPoint : Integer; + Ch : Char; + I : Integer; + + PPos : Integer; + + Procedure Partition ( var A : ArrayType; + Lo, + Hi : Integer; + var PivotPoint : Integer ); + var + Pivot : Integer; + begin + Pivot := A[ Lo ]; + PPos := Lo; + WriteColor( PPos, Pivot, Cyan + Black + Blink ); + SetDisplay( Pivot, Lo, Hi ); + while Lo < Hi do + begin + while ( Pivot < A[ Hi ] ) and ( Lo < Hi ) do + begin + Hi := Hi - 1; + SetDisplay( Pivot, Lo, Hi ); + end; + if Hi <> Lo then + begin + WriteColor( Lo, A[ Hi ], LightRed ); + A[ Lo ] := A[ Hi ]; + if Lo = PPos then + begin + WriteColor( Hi, Pivot, Cyan + Black + Blink ); + PPos := Hi; + end; + Lo := Lo + 1; + SetDisplay( Pivot, Lo, Hi ); + end; + + while ( Pivot > A[ Lo ] ) and ( Lo < Hi ) do + begin + Lo := Lo + 1; + SetDisplay( Pivot, Lo, Hi ); + end; + if Hi <> Lo then + begin + WriteColor( Hi, A[ Lo ], LightBlue ); + A[ Hi ] := A[ Lo ]; + if Hi = PPos then + begin + WriteColor( Lo, Pivot, Cyan + Black + Blink ); + PPos := Lo; + end; + Hi := Hi - 1; + SetDisplay( Pivot, Lo, Hi ); + end; + + end; + WriteColor( Hi, Pivot, Yellow ); + Ch := ReadKey; + A[ Hi ] := Pivot; + PivotPoint := Hi + end; + + begin + Partition( A, Lower, Upper, PivotPoint ); + for I := Lower to Upper do + if I <> PivotPoint then + WriteNormal( I, A[ I ] ); + if Lower < PivotPoint then + QuickSort( A, Lower, PivotPoint - 1 ); + if Upper > PivotPoint then + QuickSort( A, PivotPoint + 1, Upper ) + end; + +begin + FillArray( A ); + DisplayArray( A ); + QuickSort( A, 1, Max ); + ClrScr +end. + diff --git a/test/qsort.pas b/test/qsort.pas new file mode 100644 index 0000000..759aaf3 --- /dev/null +++ b/test/qsort.pas @@ -0,0 +1,57 @@ +program qsort; + +uses crt,dos; + +const + max = 1000; + +type + list = array[1..max] of integer; + +var + data : list; + i : integer; + h,m,s,hun : word; + + procedure quicksort(var a : list; Lo,Hi: integer); + + procedure sort(l,r : integer); + + var + i,j,x,y : integer; + + begin + i := l; j := r; x := a[( l+r ) div 2]; + repeat + while a[i] < x do i := i+1; + while x < a[j] do j := j-1; + if i < j then + begin + y := a[i]; a[i] := a[j]; a[j] := y; + i := i+1; j := j-1; + end; + until i > j; + if l < j then sort( l , j ); + if i < r then sort( i , r ); + end; + + begin {quicksort}; + sort( Lo , Hi ); + end; + + + +begin {qsort}; + write('Now generating 1000 random numbers...'); + randomize; + for i := 1 to max do data[i] := random(30000); + writeln; + writeln('Now sorting random numbers...'); + gettime(h,m,s,hun); + writeln('Start time is : ',h,' : ',m,' : ',s,' : ',hun); + quicksort( data, 1, max ); + writeln; + {for i := 1 to max do write(data[i] ); } + gettime(h,m,s,hun); + writeln('Finish time is : ',h,' : ',m,' : ',s,' : ',hun); +end. \ No newline at end of file diff --git a/test/shellsort.pas b/test/shellsort.pas new file mode 100644 index 0000000..656d8d5 --- /dev/null +++ b/test/shellsort.pas @@ -0,0 +1,39 @@ +PROCEDURE Shell( Var Item : DataArray; Count: Integer ); + +CONST + N=5; + +VAR + I,J,K,S,Q : Integer ; + P : Array[1..N] OF Integer; + X : DataItem ; + +BEGIN + P[1] := 9; + P[2] := 5; + P[3] := 3; + P[4] := 3; + P[5] := 1; + FOR Q := 1 TO N DO + BEGIN + K := P[Q]; + S := K; + FOR I := K + 1 TO Count DO + BEGIN + X := Item[I] ; + J := I - K; + IF S = 0; + BEGIN + S := K; + S := S + 1; + Item[S] := X; + END; + WHILE ( X < Item[J] ) and ( J > O ) and ( J <= Count ) DO + BEGIN + Item[J+K]:=Item[J]; + J := J - K; + END; + Item[J+K] := X; + END; + END; + END; diff --git a/test/temp.pas b/test/temp.pas new file mode 100644 index 0000000..1dffd19 --- /dev/null +++ b/test/temp.pas @@ -0,0 +1,40 @@ + {for i := 1 to veces do + begin + + writeln( ar, 'ciclo for i := 1 to veces do. i: ', i ); + } + + + {if veces1 = 1 then + begin + ape := ap + letra1 + GetRNDApellido( 5, 2 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, ap ); + writeln( ar, dni ); + writeln( ar ); + writeln( 'En ape(completo): ', ape,' ', dni ); + delay( 500 ); + end + else + begin} + + {if veces1 = 1 then + begin + ape := ap + letra1 + GetRNDApellido( 5, 2 ); + dni := dni + random( 50000 ) + 1; + writeln( ar, ap ); + writeln( ar, dni ); + writeln( ar ); + writeln( 'En ape(completo): ', ape,' ', dni ); + delay( 500 ); + end + else + begin} + + + if cant = 1000 then begin + char1 := 38; + mil := true; + end + else char1 := 34; + char2 := char1 + 1; diff --git a/test/testrnd.cpp b/test/testrnd.cpp new file mode 100644 index 0000000..e8d77ac --- /dev/null +++ b/test/testrnd.cpp @@ -0,0 +1,10 @@ +#include +#include +#include + +int main( void ) +{ + srandom( time(0) ); + + cout << random() << "\t" << time(0) << endl; +} diff --git a/test/testrnd.pas b/test/testrnd.pas new file mode 100644 index 0000000..0a438e2 --- /dev/null +++ b/test/testrnd.pas @@ -0,0 +1,94 @@ +program rndnames; + +uses CRT, DOS; + +type + HORA = record + h, + m, + s, + c: longint; + end; + + function GetTiempo( h1, h2: HORA ): longint; + + var + t: longint; + aux: HORA; + + begin + if h1.h <> h2.h then { pone al menor como h2 y al mayor como h1 } + begin + if h1.h < h2.h then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.m <> h2.m then + begin + if h1.m < h2.m then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.s <> h2.s then + begin + if h1.s < h2.s then + begin + aux := h1; + h1 := h2; + h2 := aux; + end + end + else if h1.c <> h2.c then + if h1.c < h2.c then + begin + aux := h1; + h1 := h2; + h2 := aux; + end; + t := ( ( ( h1.h - h2.h ) * 60 + ( h1.m - h2.m ) ) * 60 + ( h1.s - h2.s ) ) * 100 + ( h1.c - h2.c ); + GetTiempo := t; + end; { function GetTiempo } + + + function GetRNDLetra( min, max: char ): char; + var i: longint; + begin + i := ord( max ) - ord( min ) + 1; + writeln( 'i: ', i ); + GetRNDLetra := chr( random( i ) + ord( min ) ); + end; + + +var + cad: string; + i: integer; + h1, h2: HORA; + t: longint; + +begin + randomize; + + h1.h := 10; h1.m := 10; h1.s := 10; h1.c := 10; + h2.h := 10; h2.m := 10; h2.s := 9; h2.c := 13; + t := GetTiempo( h2, h1 ); + writeln( 'T: ', t ); + writeln( 'Numero: ', random( 10 ) ); + writeln( GetRNDLetra( 'A', 'Z' ) ); + for i := 1 to 5 do + begin + cad[i] := 'A'; + cad[0] := chr(i); + writeln( cad ); + end; + if 'LUCA' > 'LUCALAMIDAS' then + writeln( '''LUCA'' > ''LUCALAMIDAS''' ) + else + writeln( '''LUCA'' < ''LUCALAMIDAS''' ); + writeln ('FIN'); +end. diff --git a/test/tsrndnms.pas b/test/tsrndnms.pas new file mode 100644 index 0000000..8bc3d9b --- /dev/null +++ b/test/tsrndnms.pas @@ -0,0 +1,229 @@ +program RNDNames; + +const + MAX_APE = 30; + +type + TIPO_LETRA = ( TL_VOCAL, TL_CONSO ); + TIPO_VOCAL = ( TV_AEIOU, TV_EI ); + INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST ); + APELLIDO = string[MAX_APE]; + +(*********************************************************) + + function GetVocal( tipo: TIPO_VOCAL ): char; + + var + valor: integer; + + begin + if tipo = TV_AEIOU then valor := random( 16 ) + else valor := random( 6 ) + 5; + case valor of + 0..4: GetVocal := 'A'; + 5..7: GetVocal :+ 'E'; + 8..10: GetVocal :+ 'I'; + 11..13: GetVocal :+ 'O'; + 14..15: GetVocal :+ 'U'; + end; + end; + +(*********************************************************) + + procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char ); + + var + valor: integer; + + begin + proxl := TL_VOCAL; + indic := I_NADA; + + case indic of + I_ESF, I_ESR, I_ESG, I_EST: conso := 'R'; + I_ESB: case random( 2 ) of + 0: conso := 'R'; + 1: conso := 'L'; + end; + I_ESC: case random( 4 ) of + 0: conso := 'C'; + 1: conso := 'H'; + 2: conso := 'R'; + 3: conso := 'L'; + end; + I_ESL: case random( 6 ) of + 0: conso := 'T'; + 1..5: conso := 'L'; + end; + I_ESM: case random( 3 ) of + 0: conso := 'P'; + 1: conso := 'B'; + 2: conso := 'L'; + end; + I_ESN: case random( 3 ) of + 0: conso := 'R'; + 1: conso := 'V'; + 2: conso := 'C'; + end; + else case random( 55 ) of + 0..3: begin + conso := 'B'; + if random( 20 ) = 0 then begin + indic := I_ESB; + proxl := TL_CONSO; + end; + end; + 4..7: begin + conso := 'C'; + if random( 15 ) = 0 then begin + indic := I_ESC; + proxl := TL_CONSO; + end; + end; + 8..11: conso := 'D'; + 12..14: begin + conso := 'F'; + if random( 20 ) = 0 then begin + indic := I_ESF; + proxl := TL_CONSO; + end; + end; + 15..17: begin + conso := 'G'; + if random( 15 ) = 0 then + begin + indic := I_ESG; + if random( 4 ) = 0 then proxl := TL_CONSO; + end; + end; + 18..19: conso := 'H'; + 20..22: conso := 'J'; + 23..24: conso := 'K'; + 25..27: begin + conso := 'L'; + if random( 35 ) = 0 then + begin + indic := I_ESL; + proxl := TL_CONSO; + end; + end; + 28..30: begin + conso := 'M'; + if random( 15 ) = 0 then + begin + indic := I_ESM; + proxl := TL_CONSO; + end; + end; + 31..33: begin + conso := 'N'; + if random( 15 ) = 0 then + begin + indic := I_ESN; + proxl := TL_CONSO; + end; + end; + 34..36: conso := 'P'; + 37..38: begin + conso := 'Q'; + indic := I_ESQ; + end; + 39..41: begin + conso := 'R'; + if random( 10 ) = 0 then + begin + indic := I_ESR; + proxl := TL_CONSO; + end; + end; + 42..44: conso := 'S'; + 45..47: begin + conso := 'T'; + if random( 20 ) = 0 then + begin + indic := I_EST; + proxl := TL_CONSO; + end; + end; + 48..50: conso := 'V'; + 51: conso := 'W'; + 52: conso := 'X'; + 53: conso := 'Y'; + 54: conso := 'Z'; + end; + end; + end; { case indic of } + end; + +(*********************************************************) + + procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char ); + + var + valor: integer; + + begin + case proxl of + I_ESQ: + begin + vocal := 'U'; + indic := I_ESQU; + proxl := TL_VOCAL; + end; + I_ESQU: + begin + vocal := GetVocal( TV_EI ); + indic := I_NADA; + if random( 25 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + else + begin + vocal := GetVocal( TV_AEIOU ); + indic := I_NADA; + if random( 40 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + end; + end; + end; + +(*********************************************************) + + function GetRNDApellido( max, min: integer ): APELLIDO; + + var + tam, i: integer; + aux: char; + apellido: APELLIDO; + indic: INDICADOR; + proxl: TIPO_LETRA; + + begin + if max > MAX_APE then max := MAX_APE; + tam := random( max + 1 ) + min; + indic := I_NADA; + apellido := ''; + if random( 5 ) = 0 then proxl := TL_VOCAL + else proxl := TL_CONSO; + for i := 1 to tam do + begin + if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux ) + else GetRNDVocal( indic, proxl, aux ); + apellido := apellido + aux; + end; + GetRNDApellido := apellido; + end; + +var + n, i: integer; + +begin + randomize; (* inicializa la semilla del random *) + + write( 'Ingrese la cantidad de apellidos a generar: ' ); + readln( n ); + for i := 1 to n do + writeln( GetRNDApellido( 30, 4 ) ); + writeln; + writeln( ' FIN!!!' ); +end; diff --git a/test/turbo.dsk b/test/turbo.dsk new file mode 100644 index 0000000000000000000000000000000000000000..ec5f93f268545683caeaac204f9da08267f244d1 GIT binary patch literal 1834 zcmbtVO-~a+7=E@(X~9aV9855g#un5?Td7S*(1ZIyOU;&Dx7!Puq-ohk8X8L4+Pi0 z>}|W9-DIKFZq6btrPAq?l$Ig|#k9VU0|zw4MfIk-!pfzJW~lp1tRSmZ-Ig^b>qWyV z?cZfftCm`|$z+>Rn0er7{#oex!RM*@R1zBtFAor!Pfb{1gaJgY8^f~YC`pdVO2(8c z0`f?pL?KdeNYRq@L6CrJn5Ljx!9lWO)cjg+a0zcmsl{wr(d9uc2~p%mITO=0brA9Z zbJ)NaNx&pMA2NgqOx)ow%q7E^z-t^Ihw&~WK)^cs4v3LOq;(=YM(+^v!wz@mldwk> zZMAIp*zlzPGbHzYCWI{FUY^M$`cgs=VUQ$v8@~8U&vmazE8yzf;g2JcaL(dBE%}%_ z<8~yjlRhy`ZlS)}2PWpbi2?=F;0B(7Unvs4N*_hQ`6pE1WJd>6;yA(?dbdu&@42Uj z7x27h|LElz6Q_-yE=oF2jFVWkOZsZX*UX$~Wb2`?y?mmztCnJz%bsQHe9M*JW0Yda zi<@DaD{Rjt0_icAbIa~BYdmhPwnk5S zJE%M}ErY14+~*HCe?e?;M&GeB^uqZNI17Qh^=?=2v1ChKtEpve&>q459EMua>QgqH z#lVf2C0(xd8T6aPyFN