API tools faq
paste
Janilabo

Integer Commands [20.07.2013]

Janilabo
Jul 17th, 2013
74
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 58.82 KB | None | 0 0
raw download clone embed print report
  1. [SIZE="0"][url=http://villavu.com/forum/showthread.php?t=82205]String Handling Commands[/url] | [url=http://villavu.com/forum/showthread.php?t=104687]Point Commands[/url] | [url=http://villavu.com/forum/showthread.php?t=104649]Box Commands[/url] |[/SIZE] [SIZE="5"][COLOR="red"]Integer Commands[/COLOR][/SIZE]
  2.  
  3. Collection of commands for playing around with integers / integer arrays. :sasmokin:
  4.  
  5. Added small examples for all commands, just to show how they work (due to missing those code comments), although most of the functions/procedures are pretty much self-explanatory...
  6. Also most (if not all) will have small explanations included aswell.
  7.  
  8. [b]List of [color=blue]Functions[/color] & [color=blue]Procedures[/color]:[/b]
  9.  
  10. [code][u]### / Date Added / Command Name[/u]
  11.  
  12. 000 / 07-14-2013 / IntDigits()
  13. 001 / 07-14-2013 / IntSetMin()
  14. 002 / 07-14-2013 / IntSetMax()
  15. 003 / 07-14-2013 / IntSetRange()
  16. 004 / 07-14-2013 / TIASetMin()
  17. 005 / 07-14-2013 / TIASetMax()
  18. 006 / 07-14-2013 / TIASetRange()
  19. 007 / 07-14-2013 / TIACombine()
  20. 008 / 07-14-2013 / TIAAppend()
  21. 009 / 07-14-2013 / TIAAdd()
  22. 010 / 07-14-2013 / TIAInsert()
  23. 011 / 07-14-2013 / TIAPlant()
  24. 012 / 07-14-2013 / TIADelete()
  25. 013 / 07-14-2013 / TIARemove()
  26. 014 / 07-14-2013 / TIAGet()
  27. 015 / 07-14-2013 / TIAPickEx()
  28. 016 / 07-14-2013 / TIAClone()
  29. 017 / 07-14-2013 / TIACopy()
  30. 018 / 07-14-2013 / TIACopyEx()
  31. 019 / 07-14-2013 / TIACreate()
  32. 020 / 07-14-2013 / TIACreateEx()
  33. 021 / 07-14-2013 / TIAFill()
  34. 022 / 07-14-2013 / TIAFillEx()
  35. 023 / 07-14-2013 / TIAFillIDs()
  36. 024 / 07-14-2013 / TIAFillIDsEx()
  37. 025 / 07-14-2013 / TIAReplace()
  38. 026 / 07-14-2013 / TIAReplaceEx()
  39. 027 / 07-14-2013 / TIAMove()
  40. 028 / 07-14-2013 / TIAExtractEveryX()
  41. 029 / 07-14-2013 / TIAExtractEveryXEx()
  42. 030 / 07-14-2013 / TIAFilterEveryX()
  43. 031 / 07-14-2013 / TIAFilterEveryXEx()
  44. 032 / 07-14-2013 / TIAContains()
  45. 033 / 07-17-2013 / TIAContainsEx()
  46. 034 / 07-17-2013 / TIAContainsTIA()
  47. 035 / 07-14-2013 / TIAPos()
  48. 036 / 07-14-2013 / TIAPositions()
  49. 037 / 07-14-2013 / TIAPositionsEx()
  50. 038 / 07-14-2013 / TIAPositionsMulti()
  51. 039 / 07-14-2013 / TIABuiltWith()
  52. 040 / 07-14-2013 / TIADensity()
  53. 041 / 07-14-2013 / TIANumberline()
  54. 042 / 07-14-2013 / TIANumberlineSize()
  55. 043 / 07-14-2013 / TIAByRange()
  56. 044 / 07-14-2013 / TIAByRange2bit()
  57. 045 / 07-14-2013 / TIARangeFrom()
  58. 046 / 07-17-2013 / TIARange()
  59. 047 / 07-14-2013 / TIAReverse()
  60. 048 / 07-18-2013 / TIAInvert()
  61. 048 / 07-14-2013 / TIAUnique()
  62. 049 / 07-14-2013 / TIASplitEx()
  63. 050 / 07-14-2013 / TIAGroupEx()
  64. 051 / 07-17-2013 / TIAMean()
  65. 052 / 07-17-2013 / TIASum()
  66. 053 / 07-17-2013 / TIARandomRange()
  67. 054 / 07-14-2013 / TIAToParts() [*]
  68. 055 / 07-14-2013 / ATIAMerge()
  69. 056 / 07-14-2013 / ATIAClone()
  70. 057 / 07-14-2013 / ATIASetLength()
  71.  
  72. [i]* = Amount of custom types required.[/i][/code]
  73.  
  74. [spoiler="IntDigits"]
  75. [simba]{==============================================================================]
  76. Explanation: Converts integer value (int) to digits of it.
  77. Example: 1234 => 1,2,3,4, -999 => 9,9,9
  78. [==============================================================================}
  79. function IntDigits(int: Int64): TIntegerArray;
  80. var
  81. s: string;
  82. l, i: Integer;
  83. begin
  84. {$IFDEF Lape}
  85. s := IntToStr(Abs(int));
  86. {$ELSE}
  87. s := IntToStr(iAbs(int));
  88. {$ENDIF}
  89. l := Length(s);
  90. SetLength(Result, l);
  91. for i := 0 to (l - 1) do
  92. Result[i] := StrToInt(s[(i + 1)]);
  93. end;
  94.  
  95. begin
  96. ClearDebug;
  97. WriteLn(ToStr(IntDigits(-12345)));
  98. end.[/simba]
  99. [/spoiler]
  100. [spoiler="IntSetMin"]
  101. [simba]{==============================================================================]
  102. Explanation: Sets minimum value (x) to val.
  103. [==============================================================================}
  104. procedure IntSetMin(var val: Integer; x: Integer);
  105. begin
  106. if (val < x) then
  107. val := Integer(x);
  108. end;
  109.  
  110. var
  111. test: Integer;
  112.  
  113. begin
  114. test := 1234;
  115. IntSetMin(test, 1500);
  116. WriteLn(test);
  117. end.[/simba]
  118. [/spoiler]
  119. [spoiler="IntSetMax"]
  120. [simba]{==============================================================================]
  121. Explanation: Sets maximum value (x) to val.
  122. [==============================================================================}
  123. procedure IntSetMax(var val: Integer; x: Integer);
  124. begin
  125. if (val > x) then
  126. val := Integer(x);
  127. end;
  128.  
  129. var
  130. test: Integer;
  131.  
  132. begin
  133. test := 1234;
  134. IntSetMax(test, 1000);
  135. WriteLn(test);
  136. end.[/simba]
  137. [/spoiler]
  138. [spoiler="IntSetRange"]
  139. [simba]{==============================================================================]
  140. Explanation: Sets val inside range (mn = minimum, mx = maximum)
  141. [==============================================================================}
  142. procedure IntSetRange(var val: Integer; mn, mx: Integer);
  143. begin
  144. if (mn > mx) then
  145. Swap(mn, mx);
  146. if (mn <> mx) then
  147. begin
  148. if (val < mn) then
  149. val := Integer(mn);
  150. if (val > mx) then
  151. val := Integer(mx);
  152. end else
  153. if ((val < mn) or (val > mx)) then
  154. val := Integer(mn);
  155. end;
  156.  
  157. var
  158. test: Integer;
  159.  
  160. begin
  161. test := 1234;
  162. IntSetRange(test, 1000, 1500);
  163. WriteLn(test);
  164. test := 999;
  165. IntSetRange(test, 1000, 1500);
  166. WriteLn(test);
  167. test := 1501;
  168. IntSetRange(test, 1000, 1500);
  169. WriteLn(test);
  170. end.[/simba]
  171. [/spoiler]
  172. [spoiler="TIASetMin"]
  173. [simba]{==============================================================================]
  174. Explanation: Sets minimum value (x) to TIA items.
  175. [==============================================================================}
  176. procedure TIASetMin(var TIA: TIntegerArray; x: Integer);
  177. var
  178. h, i: Integer;
  179. begin
  180. h := High(TIA);
  181. for i := 0 to h do
  182. if (TIA[i] < x) then
  183. TIA[i] := Integer(x);
  184. end;
  185.  
  186. var
  187. test: TIntegerArray;
  188.  
  189. begin
  190. test := [-1, 999, 1234, 1501];
  191. TIASetMin(test, 1000);
  192. WriteLn(test);
  193. end.[/simba]
  194. [/spoiler]
  195. [spoiler="TIASetMax"]
  196. [simba]{==============================================================================]
  197. Explanation: Sets maximum value (x) to TIA items.
  198. [==============================================================================}
  199. procedure TIASetMax(var TIA: TIntegerArray; x: Integer);
  200. var
  201. h, i: Integer;
  202. begin
  203. h := High(TIA);
  204. for i := 0 to h do
  205. if (TIA[i] > x) then
  206. TIA[i] := Integer(x);
  207. end;
  208.  
  209. var
  210. test: TIntegerArray;
  211.  
  212. begin
  213. test := [-1, 999, 1234, 1501];
  214. TIASetMax(test, 1000);
  215. WriteLn(test);
  216. end.[/simba]
  217. [/spoiler]
  218. [spoiler="TIASetRange"]
  219. [simba]{==============================================================================]
  220. Explanation: Sets TIA values inside range (mn = minimum, mx = maximum)
  221. [==============================================================================}
  222. procedure TIASetRange(var TIA: TIntegerArray; mn, mx: Integer);
  223. var
  224. h, i: Integer;
  225. begin
  226. if (mn > mx) then
  227. Swap(mn, mx);
  228. h := High(TIA);
  229. for i := 0 to h do
  230. if (TIA[i] < mn) then
  231. TIA[i] := Integer(mn)
  232. else
  233. if (TIA[i] > mx) then
  234. TIA[i] := Integer(mx);
  235. end;
  236.  
  237. var
  238. test: TIntegerArray;
  239.  
  240. begin
  241. test := [-1, 999, 1234, 1501, 9999];
  242. TIASetRange(test, 1000, 1500);
  243. WriteLn(test);
  244. end.[/simba]
  245. [/spoiler]
  246. [spoiler="TIACombine"]
  247. [simba]{==============================================================================]
  248. Explanation: Returns TIA1 and TIA2 combined together.
  249. [==============================================================================}
  250. function TIACombine(TIA1, TIA2: TIntegerArray): TIntegerArray;
  251. var
  252. l1, l2, i: Integer;
  253. begin
  254. l1 := Length(TIA1);
  255. l2 := Length(TIA2);
  256. SetLength(Result, (l1 + l2));
  257. for i := 0 to (l1 - 1) do
  258. Result[i] := Integer(TIA1[i]);
  259. for i := 0 to (l2 - 1) do
  260. Result[(l1 + i)] := Integer(TIA2[i]);
  261. end;
  262.  
  263. begin
  264. WriteLn(ToStr(TIACombine([0, 1, 2, 3], [4, 5, 6, 7, 8, 9])));
  265. end.[/simba]
  266. [/spoiler]
  267. [spoiler="TIAAppend"]
  268. [simba]{==============================================================================]
  269. Explanation: Appends TIA with x.
  270. [==============================================================================}
  271. procedure TIAAppend(var TIA: TIntegerArray; x: Integer);
  272. var
  273. aL: Integer;
  274. begin
  275. aL := (Length(TIA) + 1);
  276. SetLength(TIA, aL);
  277. TIA[(aL - 1)] := Integer(x);
  278. end;
  279.  
  280. var
  281. TIA: TIntegerArray;
  282.  
  283. begin
  284. ClearDebug;
  285. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8];
  286. TIAAppend(TIA, 9);
  287. WriteLn(ToStr(TIA));
  288. end.[/simba]
  289. [/spoiler]
  290. [spoiler="TIAAdd"]
  291. [simba]{==============================================================================]
  292. Explanation: Adds all addTIA items to TIA. Returns the highest index in the end.
  293. [==============================================================================}
  294. function TIAAdd(var TIA: TIntegerArray; addTIA: TIntegerArray): Integer;
  295. var
  296. h, l, i: Integer;
  297. begin
  298. h := High(addTIA);
  299. if (h > -1) then
  300. begin
  301. l := Length(TIA);
  302. SetLength(TIA, (l + (h + 1)));
  303. for i := 0 to h do
  304. TIA[(i + l)] := Integer(addTIA[i]);
  305. end;
  306. Result := High(TIA);
  307. end;
  308.  
  309. var
  310. TIA: TIntegerArray;
  311.  
  312. begin
  313. ClearDebug;
  314. TIA := [0, 1, 2, 3];
  315. TIAAdd(TIA, [4, 5, 6, 7, 8, 9]);
  316. WriteLn(ToStr(TIA));
  317. end.[/simba]
  318. [/spoiler]
  319. [spoiler="TIAInsert"]
  320. [simba]{==============================================================================]
  321. Explanation: Inserts x to index position in TIA.
  322. [==============================================================================}
  323. procedure TIAInsert(var TIA: TIntegerArray; index, x: Integer);
  324. var
  325. i, l: Integer;
  326. begin
  327. l := Length(TIA);
  328. SetLength(TIA, (l + 1));
  329. if (index < 0) then
  330. index := 0;
  331. if (index > l) then
  332. index := l;
  333. if (l > index) then
  334. for i := (l - 1) downto index do
  335. TIA[(i + 1)] := Integer(TIA[i]);
  336. TIA[index] := Integer(x);
  337. end;
  338.  
  339. var
  340. TIA: TIntegerArray;
  341.  
  342. begin
  343. ClearDebug;
  344. TIA := [0, 1, 2, 3, 5, 6, 7, 8, 9];
  345. TIAInsert(TIA, 4, 4);
  346. WriteLn(ToStr(TIA));
  347. end.[/simba]
  348. [/spoiler]
  349. [spoiler="TIAPlant"]
  350. [simba]{==============================================================================]
  351. Explanation: Plants/places ints to index position in TIA.
  352. Like TIAInsert(), with an exception that this inserts array of points.
  353. Returns the highest index from TIA in the end.
  354. [==============================================================================}
  355. function TIAPlant(var TIA: TIntegerArray; index: Integer; ints: TIntegerArray): Integer;
  356. var
  357. i, l, h: Integer;
  358. begin
  359. h := High(ints);
  360. if (h > -1) then
  361. begin
  362. l := Length(TIA);
  363. SetLength(TIA, (l + (h + 1)));
  364. if (index < 0) then
  365. index := 0;
  366. if (index > l) then
  367. index := l;
  368. for i := (l + (h + 1) - 1) downto (index + (h + 1)) do
  369. TIA[i] := TIA[(i - (h + 1))];
  370. for i := 0 to h do
  371. TIA[(i + index)] := Integer(ints[i]);
  372. end;
  373. Result := High(TIA);
  374. end;
  375.  
  376. var
  377. TIA: TIntegerArray;
  378.  
  379. begin
  380. TIA := [0, 1, 8, 9];
  381. TIAPlant(TIA, 2, [2, 3, 4, 5, 6, 7]);
  382. WriteLn(ToStr(TIA));
  383. end.[/simba]
  384. [/spoiler]
  385. [spoiler="TIADelete"]
  386. [simba]{==============================================================================]
  387. Explanation: Deletes a point from TIA, x = index. Returns true with success.
  388. [==============================================================================}
  389. function TIADelete(var TIA: TIntegerArray; x: Integer): Boolean;
  390. var
  391. i, h: Integer;
  392. begin
  393. h := High(TIA);
  394. Result := ((x <= h) and (x > -1));
  395. if not Result then
  396. Exit;
  397. for i := x to (h - 1) do
  398. TIA[i] := TIA[(i + 1)];
  399. SetLength(TIA, h);
  400. end;
  401.  
  402. var
  403. TIA: TIntegerArray;
  404.  
  405. begin
  406. TIA := [0, 1, 2, 123456789, 3, 4, 5, 6, 7, 8, 9];
  407. if TIADelete(TIA, 3) then
  408. WriteLn(ToStr(TIA));
  409. end.[/simba]
  410. [/spoiler]
  411. [spoiler="TIARemove"]
  412. [simba]{==============================================================================]
  413. Explanation: Removes integers from TIA, x = array of indexes.
  414. NOTE: RECURSIVE/DYNAMIC! Pay attention to IDs.. In most cases you'll need to use reversed order.
  415. Also, being dynamic means that this doesn't pay attention to duplicate indexes in x,
  416. so this will delete any of those duplicate IDs then multiple times, when it is possible!
  417. [==============================================================================}
  418. procedure TIARemove(var TIA: TIntegerArray; x: TIntegerArray);
  419. var
  420. i, i2, h, h2: Integer;
  421. begin
  422. h := High(TIA);
  423. h2 := High(x);
  424. if ((h < 0) or (h2 < 0)) then
  425. Exit;
  426. for i2 := 0 to h2 do
  427. if ((x[i2] <= h) and (x[i2] > -1)) then
  428. begin
  429. for i := x[i2] to (h - 1) do
  430. TIA[i] := TIA[(i + 1)];
  431. Dec(h);
  432. end;
  433. SetLength(TIA, (h + 1));
  434. end;
  435.  
  436. var
  437. TIA: TIntegerArray;
  438.  
  439. begin
  440. ClearDebug;
  441. TIA := [-1, 0, -1, 1, 2, -1, -1, 3, -1, 4, 5, 6, 7, 8, 9];
  442. TIARemove(TIA, [0, 2, 5, 6, 8]);
  443. WriteLn(ToStr(TIA) + ' [Without reversed order]');
  444. SetLength(TIA, 0);
  445. TIA := [-1, 0, -1, 1, 2, -1, -1, 3, -1, 4, 5, 6, 7, 8, 9];
  446. TIARemove(TIA, [8, 6, 5, 2, 0]);
  447. WriteLn(ToStr(TIA) + ' [With reversed order]');
  448. SetLength(TIA, 0);
  449. end.[/simba]
  450. [/spoiler]
  451. [spoiler="TIAGet"]
  452. [simba]{==============================================================================]
  453. Explanation: Returns array of items from TIA by IDs. Ignores invalid ID's.
  454. [==============================================================================}
  455. function TIAGet(TIA: TIntegerArray; IDs: TIntegerArray): TIntegerArray;
  456. var
  457. i, h, h2, r: Integer;
  458. begin
  459. h := High(TIA);
  460. h2 := High(IDs);
  461. if ((h2 > -1) and (h > -1)) then
  462. begin
  463. SetLength(Result, (h2 + 1));
  464. for i := 0 to h2 do
  465. if ((IDs[i] <= h) and (IDs[i] > -1)) then
  466. begin
  467. Result[r] := Integer(TIA[IDs[i]]);
  468. Inc(r);
  469. end;
  470. end;
  471. SetLength(Result, r);
  472. end;
  473.  
  474. var
  475. TIA: TIntegerArray;
  476. i: Integer;
  477.  
  478. begin
  479. ClearDebug;
  480. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  481. WriteLn(TIAGet(TIA, [-111, 0, 1, 2, 3, 4, 5, 6, 7, 8, 1234, 9, 9999, 8, 7, 6, 5, 4, 3, 2, 1, 0, -1]));
  482. end.[/simba]
  483. [/spoiler]
  484. [spoiler="TIAPickEx"]
  485. [simba]{==============================================================================]
  486. Explanation: Returns integers (by pick_IDs) from TIA and then deletes em.
  487. NOTE: Ignores invalid indexes. DYNAMIC (so place indexes in reversed order to get em correctly)!
  488. [==============================================================================}
  489. function TIAPickEx(var TIA: TIntegerArray; pick_IDs: TIntegerArray): TIntegerArray;
  490. var
  491. h, h2, t, i, r: Integer;
  492. begin
  493. h2 := High(TIA);
  494. h := High(pick_IDs);
  495. if ((h2 > -1) and (h > -1)) then
  496. begin
  497. SetLength(Result, (h2 + 1));
  498. for i := 0 to h do
  499. if ((pick_IDs[i] <= h2) and (pick_IDs[i] > -1)) then
  500. begin
  501. Result[r] := Integer(TIA[pick_IDs[i]]);
  502. Inc(r);
  503. for t := pick_IDs[i] to (h2 - 1) do
  504. TIA[t] := TIA[(t + 1)];
  505. SetLength(TIA, h2);
  506. Dec(h2);
  507. if (h2 < 0) then
  508. Break;
  509. end;
  510. SetLength(Result, r);
  511. end else
  512. SetLength(Result, 0);
  513. end;
  514.  
  515. var
  516. TIA, TIA2: TIntegerArray;
  517.  
  518. begin
  519. ClearDebug;
  520. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  521. WriteLn('TIA (Before picking): ' + ToStr(TIA));
  522. TIA2 := TIAPickEx(TIA, [8, 6, 4, 2, 0]);
  523. WriteLn('TIA (After picking): ' + ToStr(TIA));
  524. WriteLn('TIA2 (Picked points): ' + ToStr(TIA2));
  525. SetLength(TIA, 0);
  526. SetLength(TIA2, 0);
  527. end.[/simba]
  528. [/spoiler]
  529. [spoiler="TIAClone"]
  530. [simba]{==============================================================================]
  531. Explanation: Returns copy ("clone") of TIA safely
  532. [==============================================================================}
  533. function TIAClone(TIA: TIntegerArray): TIntegerArray;
  534. var
  535. i, l: Integer;
  536. begin
  537. l := Length(TIA);
  538. SetLength(Result, l);
  539. for i := 0 to (l - 1) do
  540. Result[i] := Integer(TIA[i]);
  541. end;
  542.  
  543. var
  544. TIA: TIntegerArray;
  545.  
  546. begin
  547. ClearDebug;
  548. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  549. WriteLn(TIAClone(TIA));
  550. end.[/simba]
  551. [/spoiler]
  552. [spoiler="TIACopy"]
  553. [simba]{==============================================================================]
  554. Explanation: Version of Copy() function for TIntegerArrays.
  555. [==============================================================================}
  556. function TIACopy(TIA: TIntegerArray; startIndex, count: Integer): TIntegerArray;
  557. var
  558. i, l, t: Integer;
  559. begin
  560. l := Length(TIA);
  561. if (startIndex < 0) then
  562. startIndex := 0;
  563. if ((l >= startIndex) and (count > 0)) then
  564. begin
  565. t := (l - startIndex);
  566. if (count > t) then
  567. count := t;
  568. SetLength(Result, count);
  569. for i := startIndex to ((startIndex + count) - 1) do
  570. Result[(i - startIndex)] := Integer(TIA[i]);
  571. end else
  572. SetLength(Result, 0);
  573. end;
  574.  
  575. var
  576. TIA: TIntegerArray;
  577.  
  578. begin
  579. TIA := [-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
  580. WriteLn(ToStr(TIACopy(TIA, 1, 10)));
  581. end.[/simba]
  582. [/spoiler]
  583. [spoiler="TIACopyEx"]
  584. [simba]{==============================================================================]
  585. Explanation: Copies TIA from pos1 to pos2. Reverse copies with pos1>pos2 (flexible!).
  586. [==============================================================================}
  587. function TIACopyEx(TIA: TIntegerArray; pos1, pos2: Integer): TIntegerArray;
  588. var
  589. i, l: Integer;
  590. begin
  591. l := Length(TIA);
  592. if (l > 0) then
  593. begin
  594. if (pos1 < 0) then
  595. pos1 := 0;
  596. if (pos1 > (l - 1)) then
  597. pos1 := (l - 1);
  598. if (pos2 < 0) then
  599. pos2 := 0;
  600. if (pos2 > (l - 1)) then
  601. pos2 := (l - 1);
  602. if (pos1 <> pos2) then
  603. begin
  604. {$IFNDEF Lape}
  605. SetLength(Result, (iAbs(pos1 - pos2) + 1));
  606. {$ELSE}
  607. SetLength(Result, Integer(Abs(pos1 - pos2) + 1));
  608. {$ENDIF}
  609. if (pos1 < pos2) then
  610. begin
  611. for i := pos1 to pos2 do
  612. Result[(i - pos1)] := Integer(TIA[i]);
  613. end else
  614. for i := pos1 downto pos2 do
  615. Result[(pos1 - i)] := Integer(TIA[i]);
  616. end else
  617. Result := [Integer(TIA[pos1])];
  618. end else
  619. SetLength(Result, 0);
  620. end;
  621.  
  622. var
  623. TIA: TIntegerArray;
  624.  
  625. begin
  626. ClearDebug;
  627. TIA := [-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
  628. WriteLn(ToStr(TIACopyEx(TIA, 1, 10)));
  629. WriteLn(ToStr(TIACopyEx(TIA, 10, 1)));
  630. end.[/simba]
  631. [/spoiler]
  632. [spoiler="TIACreate"]
  633. [simba]{==============================================================================]
  634. Explanation: Creates TIA with x (for every index) where size is length of the array.
  635. [==============================================================================}
  636. function TIACreate(x: Integer; size: Integer): TIntegerArray;
  637. var
  638. i: Integer;
  639. begin
  640. if (size > 0) then
  641. begin
  642. SetLength(Result, size);
  643. for i := 0 to (size - 1) do
  644. Result[i] := Integer(x);
  645. end else
  646. SetLength(Result, 0);
  647. end;
  648.  
  649. var
  650. TIA: TIntegerArray;
  651.  
  652. begin
  653. TIA := TIACreate(123, 3);
  654. WriteLn(ToStr(TIA));
  655. end.[/simba]
  656. [/spoiler]
  657. [spoiler="TIACreateEx"]
  658. [simba]{==============================================================================]
  659. Explanation: Creates TIA with ints (for every index) where size is length of the array.
  660. [==============================================================================}
  661. function TIACreateEx(ints: TIntegerArray; size: Integer): TIntegerArray;
  662. var
  663. x, y: Integer;
  664. begin
  665. if (size > 0) then
  666. begin
  667. y := Length(ints);
  668. if (y = 0) then
  669. SetLength(Result, 0);
  670. SetLength(Result, size);
  671. if (y > 0) then
  672. for x := 0 to (size - 1) do
  673. Result[x] := Integer(ints[(x mod y)]);
  674. end else
  675. SetLength(Result, 0);
  676. end;
  677.  
  678. var
  679. TIA: TIntegerArray;
  680.  
  681. begin
  682. TIA := TIACreateEx([1, 2, 3, 4], 10);
  683. WriteLn(ToStr(TIA));
  684. end.[/simba]
  685. [/spoiler]
  686. [spoiler="TIAFill"]
  687. [simba]{==============================================================================]
  688. Explanation: Fills whole TIA with x.
  689. [==============================================================================}
  690. procedure TIAFill(var TIA: TIntegerArray; x: Integer);
  691. var
  692. h, i: Integer;
  693. begin
  694. h := High(TIA);
  695. for i := 0 to h do
  696. TIA[i] := Integer(x);
  697. end;
  698.  
  699. var
  700. TIA: TIntegerArray;
  701.  
  702. begin
  703. SetLength(TIA, 5);
  704. TIAFill(TIA, 123);
  705. WriteLn(ToStr(TIA));
  706. end.[/simba]
  707. [/spoiler]
  708. [spoiler="TIAFillEx"]
  709. [simba]{==============================================================================]
  710. Explanation: Fills whole TIA with x.
  711. [==============================================================================}
  712. procedure TIAFillEx(var TIA: TIntegerArray; x: TIntegerArray);
  713. var
  714. i, h, l: Integer;
  715. begin
  716. h := High(TIA);
  717. l := Length(x);
  718. for i := 0 to h do
  719. TIA[i] := Integer(x[(i mod l)]);
  720. end;
  721.  
  722. var
  723. TIA: TIntegerArray;
  724.  
  725. begin
  726. SetLength(TIA, 25);
  727. TIAFillEx(TIA, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
  728. WriteLn(ToStr(TIA));
  729. end.[/simba]
  730. [/spoiler]
  731. [spoiler="TIAFillIDs"]
  732. [simba]{==============================================================================]
  733. Explanation: Fills TIA indexes (IDs) with x.
  734. [==============================================================================}
  735. procedure TIAFillIDs(var TIA: TIntegerArray; IDs: TIntegerArray; x: Integer);
  736. var
  737. h, l, i: Integer;
  738. begin
  739. l := Length(TIA);
  740. h := High(IDs);
  741. if ((l > 0) and (h > -1)) then
  742. for i := 0 to h do
  743. if ((IDs[i] < l) and (IDs[i] > -1)) then
  744. TIA[IDs[i]] := Integer(x);
  745. end;
  746.  
  747. var
  748. TIA: TIntegerArray;
  749.  
  750. begin
  751. SetLength(TIA, 13);
  752. TIAFillIDs(TIA, [0, 1, 2, 6, 10, 11, 12], 69);
  753. WriteLn(ToStr(TIA));
  754. end.[/simba]
  755. [/spoiler]
  756. [spoiler="TIAFillIDsEx"]
  757. [simba]{==============================================================================]
  758. Explanation: Fills TIA indexes (IDs) with ints.
  759. [==============================================================================}
  760. procedure TIAFillIDsEx(var TIA: TIntegerArray; IDs, ints: TIntegerArray);
  761. var
  762. h, l, i, m, r: Integer;
  763. begin
  764. l := Length(TIA);
  765. h := High(IDs);
  766. m := Length(ints);
  767. if ((l > 0) and (h > -1) and (m > 0)) then
  768. for i := 0 to h do
  769. if ((IDs[i] < l) and (IDs[i] > -1)) then
  770. begin
  771. TIA[IDs[i]] := Integer(ints[(r mod m)]);
  772. Inc(r);
  773. end;
  774. end;
  775.  
  776. var
  777. TIA: TIntegerArray;
  778.  
  779. begin
  780. SetLength(TIA, 13);
  781. TIAFillIDsEx(TIA, [0, 1, 2, 3, 6, 9, 10, 11, 12], [1, 2, 3]);
  782. WriteLn(ToStr(TIA));
  783. end.[/simba]
  784. [/spoiler]
  785. [spoiler="TIAReplace"]
  786. [simba]{==============================================================================]
  787. Explanation: Replaces all oldValue's in TIA with newValue.
  788. [==============================================================================}
  789. procedure TIAReplace(var TIA: TIntegerArray; oldValue, newValue: Integer);
  790. var
  791. h, i: Integer;
  792. begin
  793. if (oldValue <> newValue) then
  794. begin
  795. h := High(TIA);
  796. for i := 0 to h do
  797. if (TIA[i] = oldValue) then
  798. TIA[i] := Integer(newValue);
  799. end;
  800. end;
  801.  
  802. var
  803. TIA: TIntegerArray;
  804.  
  805. begin
  806. SetLength(TIA, 10);
  807. TIA[0] := 1;
  808. TIA[1] := 2;
  809. TIA[8] := 3;
  810. TIA[9] := 4;
  811. TIAReplace(TIA, 0, 9);
  812. WriteLn(ToStr(TIA));
  813. end.[/simba]
  814. [/spoiler]
  815. [spoiler="TIAReplaceEx"]
  816. [simba]{==============================================================================]
  817. Explanation: Replaces all oldPoints' in TIA with newPoint.
  818. [==============================================================================}
  819. procedure TIAReplaceEx(var TIA: TIntegerArray; oldValues: TIntegerArray; newValue: Integer);
  820. var
  821. a, b, x, y: Integer;
  822. begin
  823. y := High(oldValues);
  824. if (y > -1) then
  825. begin
  826. b := High(TIA);
  827. for a := 0 to b do
  828. for x := 0 to y do
  829. if (TIA[a] = oldValues[x]) then
  830. begin
  831. TIA[a] := Integer(newValue);
  832. Break;
  833. end;
  834. end;
  835. end;
  836.  
  837. var
  838. TIA: TIntegerArray;
  839.  
  840. begin
  841. SetLength(TIA, 10);
  842. TIA[0] := 1;
  843. TIA[2] := 2;
  844. TIA[4] := 3;
  845. TIA[6] := 2;
  846. TIA[8] := 1;
  847. TIAReplaceEx(TIA, [1, 3, 2], 9);
  848. WriteLn(ToStr(TIA));
  849. end.[/simba]
  850. [/spoiler]
  851. [spoiler="TIAMove"]
  852. [simba]{==============================================================================]
  853. Explanation: Moves oldIndex to newIndex in TIA. Returns true, if movement was succesfully done!
  854. [==============================================================================}
  855. function TIAMove(var TIA: TIntegerArray; oldIndex, newIndex: Integer): Boolean;
  856. var
  857. h, i: Integer;
  858. begin
  859. h := High(TIA);
  860. Result := ((h > 0) and (oldIndex <> newIndex) and InRange(oldIndex, 0, h) and InRange(newIndex, 0, h));
  861. if Result then
  862. if (oldIndex > newIndex) then
  863. begin
  864. for i := oldIndex downto (newIndex + 1) do
  865. Swap(TIA[i], TIA[(i - 1)]);
  866. end else
  867. for i := oldIndex to (newIndex - 1) do
  868. Swap(TIA[i], TIA[(i + 1)]);
  869. end;
  870.  
  871. var
  872. TIA: TIntegerArray;
  873.  
  874. begin
  875. ClearDebug;
  876. TIA := [0, 1, 6, 2, 3, 4, 5, 7, 8, 9];
  877. TIAMove(TIA, 2, 6);
  878. WriteLn(ToStr(TIA));
  879. end.[/simba]
  880. [/spoiler]
  881. [spoiler="TIAExtractEveryX"]
  882. [simba]{==============================================================================]
  883. Explanation: Extracts every X point from TIA.
  884. [==============================================================================}
  885. procedure TIAExtractEveryX(var TIA: TIntegerArray; X: Integer);
  886. var
  887. i, h, t: Integer;
  888. begin
  889. h := High(TIA);
  890. if (h > -1) then
  891. begin
  892. if (X > 0) then
  893. for i := 0 to h do
  894. if ((i mod X) = 0) then
  895. begin
  896. TIA[t] := TIA[i];
  897. Inc(t);
  898. end;
  899. SetLength(TIA, t);
  900. end;
  901. end;
  902.  
  903. var
  904. TIA, tmp: TIntegerArray;
  905. i, c: Integer;
  906.  
  907. begin
  908. ClearDebug;
  909. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  910. for i := 0 to 11 do
  911. begin
  912. SetLength(tmp, Length(TIA));
  913. for c := 0 to (Length(TIA) - 1) do
  914. tmp[c] := TIA[c];
  915. TIAExtractEveryX(tmp, i);
  916. WriteLn('TIAExtractEveryX(TIA, ' + IntToStr(i) + '): ' + ToStr(tmp));
  917. SetLength(tmp, 0);
  918. end;
  919. SetLength(TIA, 0);
  920. end.[/simba]
  921. [/spoiler]
  922. [spoiler="TIAExtractEveryXEx"]
  923. [simba]{==============================================================================]
  924. Explanation: Extracts every X point from TIA - starting from offset.
  925. [==============================================================================}
  926. procedure TIAExtractEveryXEx(var TIA: TIntegerArray; X, offset: Integer);
  927. var
  928. i, h, t: Integer;
  929. begin
  930. h := High(TIA);
  931. if (h > -1) then
  932. begin
  933. if ((X > 0) and ((offset > -1) and (offset <= h))) then
  934. for i := offset to h do
  935. if (((i - offset) mod X) = 0) then
  936. begin
  937. TIA[t] := TIA[i];
  938. Inc(t);
  939. end;
  940. SetLength(TIA, t);
  941. end;
  942. end;
  943.  
  944. var
  945. TIA, tmp: TIntegerArray;
  946. i, c: Integer;
  947.  
  948. begin
  949. ClearDebug;
  950. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  951. for i := 0 to 9 do
  952. begin
  953. SetLength(tmp, Length(TIA));
  954. for c := 0 to (Length(TIA) - 1) do
  955. tmp[c] := TIA[c];
  956. TIAExtractEveryXEx(tmp, i, 2);
  957. WriteLn('TIAExtractEveryX(TIA, ' + IntToStr(i) + ', 2): ' + ToStr(tmp));
  958. SetLength(tmp, 0);
  959. end;
  960. SetLength(TIA, 0);
  961. end.[/simba]
  962. [/spoiler]
  963. [spoiler="TIAFilterEveryX"]
  964. [simba]{==============================================================================]
  965. Explanation: Filters every X point from TIA.
  966. [==============================================================================}
  967. procedure TIAFilterEveryX(var TIA: TIntegerArray; X: Integer);
  968. var
  969. i, h, t: Integer;
  970. begin
  971. h := High(TIA);
  972. if ((h > -1) and (X > 0)) then
  973. begin
  974. for i := 0 to h do
  975. if ((i mod X) <> 0) then
  976. begin
  977. TIA[t] := TIA[i];
  978. Inc(t);
  979. end;
  980. SetLength(TIA, t);
  981. end;
  982. end;
  983.  
  984. var
  985. TIA, tmp: TIntegerArray;
  986. i, c: Integer;
  987.  
  988. begin
  989. ClearDebug;
  990. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  991. for i := 0 to 10 do
  992. begin
  993. SetLength(tmp, Length(TIA));
  994. for c := 0 to (Length(TIA) - 1) do
  995. tmp[c] := TIA[c];
  996. TIAFilterEveryX(tmp, i);
  997. WriteLn('TIAFilterEveryX(TIA, ' + IntToStr(i) + '): ' + ToStr(tmp));
  998. SetLength(tmp, 0);
  999. end;
  1000. SetLength(TIA, 0);
  1001. end.[/simba]
  1002. [/spoiler]
  1003. [spoiler="TIAFilterEveryXEx"]
  1004. [simba]{==============================================================================]
  1005. Explanation: Filters every X point from TIA - starting from offset.
  1006. [==============================================================================}
  1007. procedure TIAFilterEveryXEx(var TIA: TIntegerArray; X, offset: Integer);
  1008. var
  1009. i, h, t: Integer;
  1010. begin
  1011. h := High(TIA);
  1012. if ((h > -1) and (X > 0) and ((offset > -1) and (offset <= h))) then
  1013. begin
  1014. t := offset;
  1015. for i := offset to h do
  1016. if (((i - offset) mod X) <> 0) then
  1017. begin
  1018. TIA[t] := TIA[i];
  1019. Inc(t);
  1020. end;
  1021. SetLength(TIA, t);
  1022. end;
  1023. end;
  1024.  
  1025. var
  1026. TIA, tmp: TIntegerArray;
  1027. i, c: Integer;
  1028.  
  1029. begin
  1030. ClearDebug;
  1031. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  1032. for i := 0 to 9 do
  1033. begin
  1034. SetLength(tmp, Length(TIA));
  1035. for c := 0 to (Length(TIA) - 1) do
  1036. tmp[c] := TIA[c];
  1037. TIAFilterEveryXEx(tmp, i, 2);
  1038. WriteLn('TIAFilterEveryXEx(TIA, ' + IntToStr(i) + ', 2): ' + ToStr(tmp));
  1039. SetLength(tmp, 0);
  1040. end;
  1041. SetLength(TIA, 0);
  1042. end.[/simba]
  1043. [/spoiler]
  1044. [spoiler="TIAContains"]
  1045. [simba]{==============================================================================]
  1046. Explanation: Returns true if TIA contains x.
  1047. [==============================================================================}
  1048. function TIAContains(TIA: TIntegerArray; x: Integer): Boolean;
  1049. var
  1050. i, h: Integer;
  1051. begin
  1052. h := High(TIA);
  1053. for i := 0 to h do
  1054. begin
  1055. Result := (x = TIA[i]);
  1056. if Result then
  1057. Exit;
  1058. end;
  1059. Result := False;
  1060. end;
  1061.  
  1062. var
  1063. TIA: TIntegerArray;
  1064. i: Integer;
  1065.  
  1066. begin
  1067. ClearDebug;
  1068. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  1069. for i := -1 to 10 do
  1070. if TIAContains(TIA, i) then
  1071. WriteLn(IntToStr(i) + ' exists in TIA!')
  1072. else
  1073. WriteLn(IntToStr(i) + ' DOES NOT exist in TIA!');
  1074. end.[/simba]
  1075. [/spoiler]
  1076. [spoiler="TIAContainsEx"]
  1077. [simba]{==============================================================================]
  1078. Explanation: Returns true if TIA contains ANY Integer from ints.
  1079. [==============================================================================}
  1080. function TIAContainsEx(TIA, ints: TIntegerArray): Boolean;
  1081. var
  1082. a, b, x, y: Integer;
  1083. begin
  1084. b := High(TIA);
  1085. y := High(ints);
  1086. Result := True;
  1087. if ((b > -1) and (y > -1)) then
  1088. for a := 0 to b do
  1089. for x := 0 to y do
  1090. if (TIA[a] = ints[x]) then
  1091. Exit;
  1092. Result := False;
  1093. end;
  1094.  
  1095. begin
  1096. ClearDebug;
  1097. if TIAContainsEx([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], [8, 3, 5]) then
  1098. WriteLn('YEP!');
  1099. end.[/simba]
  1100. [/spoiler]
  1101. [spoiler="TIAContainsTIA"]
  1102. [simba]{==============================================================================]
  1103. Explanation: Returns true if TIA contains WHOLE chain of Integers (arr) in it.
  1104. [==============================================================================}
  1105. function TIAContainsTIA(TIA, arr: TIntegerArray): Boolean;
  1106. var
  1107. a, b, x, y, z: Integer;
  1108. begin
  1109. z := High(TIA);
  1110. y := High(arr);
  1111. if ((z >= y) and (z > -1)) then
  1112. begin
  1113. b := (z - y);
  1114. for a := 0 to b do
  1115. begin
  1116. for x := 0 to y do
  1117. if (TIA[(a + x)] <> arr[x]) then
  1118. Break;
  1119. if (x > y) then
  1120. Break;
  1121. end;
  1122. Result := (a <= b);
  1123. end else
  1124. Result := False;
  1125. end;
  1126.  
  1127. begin
  1128. ClearDebug;
  1129. if TIAContainsTIA([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], [8, 3, 5]) then
  1130. WriteLn('NOOOO!');
  1131. if TIAContainsTIA([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], [5, 6, 7]) then
  1132. WriteLn('YEEAH!');
  1133. end.[/simba]
  1134. [/spoiler]
  1135. [spoiler="TIAPos"]
  1136. [simba]{==============================================================================]
  1137. Explanation: Returns index position from TIA which matched with x.
  1138. Returns -1 if any of TIA items doesnt match with x!
  1139. [==============================================================================}
  1140. function TIAPos(TIA: TIntegerArray; x: Integer): Integer;
  1141. var
  1142. h: Integer;
  1143. begin
  1144. h := High(TIA);
  1145. for Result := 0 to h do
  1146. if (TIA[Result] = x) then
  1147. Exit;
  1148. Result := -1;
  1149. end;
  1150.  
  1151. var
  1152. TIA: TIntegerArray;
  1153. i, p: Integer;
  1154.  
  1155. begin
  1156. ClearDebug;
  1157. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  1158. for i := -1 to 10 do
  1159. begin
  1160. p := TIAPos(TIA, i);
  1161. if (p > -1) then
  1162. WriteLn(IntToStr(i) + ' index in TIA: ' + IntToStr(p))
  1163. else
  1164. WriteLn(IntToStr(i) + ' DOES NOT exist in TIA!');
  1165. end;
  1166. end.[/simba]
  1167. [/spoiler]
  1168. [spoiler="TIAPositions"]
  1169. [simba]{==============================================================================]
  1170. Explanation: Returns all the TIA positions where x can be found.
  1171. [==============================================================================}
  1172. function TIAPositions(TIA: TIntegerArray; x: Integer): TIntegerArray;
  1173. var
  1174. i, h, r: Integer;
  1175. begin
  1176. h := High(TIA);
  1177. if (h > -1) then
  1178. begin
  1179. SetLength(Result, (h + 1));
  1180. for i := 0 to h do
  1181. if (TIA[i] = x) then
  1182. begin
  1183. Result[r] := i;
  1184. Inc(r);
  1185. end;
  1186. end;
  1187. SetLength(Result, r);
  1188. end;
  1189.  
  1190. begin
  1191. WriteLn(ToStr(TIAPositions([1, 2, 3, 1, 2, 3, 1], 1)));
  1192. end.[/simba]
  1193. [/spoiler]
  1194. [spoiler="TIAPositionsEx"]
  1195. [simba]{==============================================================================]
  1196. Explanation: Returns all the TIA positions where index contains any integer from ints.
  1197. [==============================================================================}
  1198. function TIAPositionsEx(TIA, ints: TIntegerArray): TIntegerArray;
  1199. var
  1200. i, v, h, l, r: Integer;
  1201. begin
  1202. h := High(TIA);
  1203. l := Length(ints);
  1204. if ((l > 0) and (h > -1)) then
  1205. begin
  1206. SetLength(Result, (h + 1));
  1207. for i := 0 to h do
  1208. for v := 0 to (l - 1) do
  1209. if (ints[v] = TIA[i]) then
  1210. begin
  1211. Result[r] := i;
  1212. Inc(r);
  1213. Break;
  1214. end;
  1215. end;
  1216. SetLength(Result, r);
  1217. end;
  1218.  
  1219. var
  1220. a, b: TIntegerArray;
  1221.  
  1222. begin
  1223. a := [0, 1, 0, 1, 2, 3, 2, 3, 4];
  1224. b := [0, 1, 2];
  1225. WriteLn(ToStr(TIAPositionsEx(a, b)));
  1226. end.[/simba]
  1227. [/spoiler]
  1228. [spoiler="TIAPositionsMulti"]
  1229. [simba]{==============================================================================]
  1230. Explanation: Returns the TIA positions where index contains any integer from ints.
  1231. NOTE: Doesn't return ALL indexes, like TIAPositionsEx() does.
  1232. [==============================================================================}
  1233. function TIAPositionsMulti(TIA, ints: TIntegerArray): TIntegerArray;
  1234. var
  1235. i, v, h, l: Integer;
  1236. begin
  1237. h := High(ints);
  1238. l := Length(TIA);
  1239. if ((l > 0) and (h > -1)) then
  1240. begin
  1241. SetLength(Result, (h + 1));
  1242. for i := 0 to h do
  1243. begin
  1244. for v := 0 to (l - 1) do
  1245. if (TIA[v] = ints[i]) then
  1246. Break;
  1247. if (v < l) then
  1248. Result[i] := v
  1249. else
  1250. Result[i] := -1;
  1251. end;
  1252. end else
  1253. SetLength(Result, 0);
  1254. end;
  1255.  
  1256. var
  1257. a, b: TIntegerArray;
  1258.  
  1259. begin
  1260. a := [0, 1, 0, 1, 2, 3, 2, 3, 4];
  1261. b := [0, 1, 2];
  1262. WriteLn(ToStr(TIAPositionsMulti(a, b)));
  1263. end.[/simba]
  1264. [/spoiler]
  1265. [spoiler="TIABuiltWith"]
  1266. [simba]{==============================================================================]
  1267. Explanation: Returns true if TIA is built ONLY with allowed values.
  1268. [==============================================================================}
  1269. function TIABuiltWith(TIA, allowed: TIntegerArray): Boolean;
  1270. var
  1271. h, i, x, y: Integer;
  1272. begin
  1273. Result := False;
  1274. h := High(TIA);
  1275. y := High(allowed);
  1276. if ((h > -1) and (y > -1)) then
  1277. begin
  1278. for i := 0 to h do
  1279. begin
  1280. for x := 0 to y do
  1281. if (TIA[i] = allowed[x]) then
  1282. Break;
  1283. if (x > y) then
  1284. Exit;
  1285. end;
  1286. Result := True;
  1287. end;
  1288. end;
  1289.  
  1290. begin
  1291. if TIABuiltWith([1, 2, 3, 4], [0, 1, 2, 3, 4, 5]) then
  1292. WriteLn('YES!');
  1293. if TIABuiltWith([0, 1, 2, 3, 4, 5], [1, 2, 3, 4]) then
  1294. WriteLn('NOOOO!');
  1295. end.[/simba]
  1296. [/spoiler]
  1297. [spoiler="TIADensity"]
  1298. [simba]{==============================================================================]
  1299. Explanation: Returns the calculated density from given TIA.
  1300. [==============================================================================}
  1301. function TIADensity(TIA: TIntegerArray): Extended;
  1302. var
  1303. h, l, i, d, mn, mx, x, y: Integer;
  1304. begin
  1305. h := High(TIA);
  1306. if (h > -1) then
  1307. begin
  1308. mn := TIA[0];
  1309. mx := TIA[0];
  1310. if (h > 0) then
  1311. for i := (h - d) downto 1 do
  1312. begin
  1313. if (TIA[i] < mn) then
  1314. mn := TIA[i]
  1315. else
  1316. if (TIA[i] > mx) then
  1317. mx := TIA[i];
  1318. for x := (i - 1) downto 0 do
  1319. if (TIA[i] = TIA[x]) then
  1320. begin
  1321. l := High(TIA);
  1322. for y := i to (l - 1) do
  1323. TIA[y] := TIA[(y + 1)];
  1324. SetLength(TIA, l);
  1325. Inc(d);
  1326. Break;
  1327. end;
  1328. end;
  1329. {$IFNDEF Lape}
  1330. Result := (Extended(Length(TIA)) / (iAbs(mn - mx) + 1));
  1331. {$ELSE}
  1332. Result := (Extended(Length(TIA)) / (Abs(mn - mx) + 1));
  1333. {$ENDIF}
  1334. end else
  1335. Result := 0;
  1336. end;
  1337.  
  1338. var
  1339. test: TIntegerArray;
  1340. i, l: Integer;
  1341.  
  1342. begin
  1343. ClearDebug;
  1344. test := [0];
  1345. for i := 5 downto 1 do
  1346. begin
  1347. l := Length(test);
  1348. SetLength(test, (l + 1));
  1349. test[l] := i;
  1350. WriteLn(ToStr(TIADensity(test)) + ' ' + ToStr(test));
  1351. end;
  1352. end.[/simba]
  1353. [/spoiler]
  1354. [spoiler="TIANumberline"]
  1355. [simba]{==============================================================================]
  1356. Explanation: Returns numberline by TIA minimum and maximum values from TIA.
  1357. [==============================================================================}
  1358. function TIANumberline(TIA: TIntegerArray): TIntegerArray;
  1359. var
  1360. i, s, f, mn, mx, x, y: Integer;
  1361. begin
  1362. y := High(TIA);
  1363. if (y > -1) then
  1364. begin
  1365. mn := TIA[0];
  1366. mx := TIA[0];
  1367. if (y > 0) then
  1368. for x := 1 to y do
  1369. if (TIA[x] < mn) then
  1370. mn := TIA[x]
  1371. else
  1372. if (TIA[x] > mx) then
  1373. mx := TIA[x];
  1374. if (mn <> mx) then
  1375. begin
  1376. s := Integer(mn);
  1377. f := Integer(mx);
  1378. {$IFNDEF Lape}
  1379. SetLength(Result, (IAbs(mn - mx) + 1));
  1380. {$ELSE}
  1381. SetLength(Result, (Abs(mn - mx) + 1));
  1382. {$ENDIF}
  1383. for i := s to f do
  1384. Result[(i - s)] := i;
  1385. end else
  1386. Result := [Integer(mn)];
  1387. end else
  1388. SetLength(Result, 0);
  1389. end;
  1390.  
  1391. begin
  1392. ClearDebug;
  1393. WriteLn(ToStr(TIANumberline([10, 5, 2])));
  1394. WriteLn(ToStr(TIANumberline([999, 995, 990, 985, 980])));
  1395. end.[/simba]
  1396. [/spoiler]
  1397. [spoiler="TIANumberlineSize"]
  1398. [simba]{==============================================================================]
  1399. Explanation: Returns the size of numberline by TIA.
  1400. [==============================================================================}
  1401. function TIANumberlineSize(TIA: TIntegerArray): Integer;
  1402. var
  1403. x, y, mn, mx: Integer;
  1404. begin
  1405. y := High(TIA);
  1406. if (y > -1) then
  1407. begin
  1408. mn := TIA[0];
  1409. mx := TIA[0];
  1410. if (y > 0) then
  1411. for x := 1 to y do
  1412. if (TIA[x] < mn) then
  1413. mn := TIA[x]
  1414. else
  1415. if (TIA[x] > mx) then
  1416. mx := TIA[x];
  1417. {$IFNDEF Lape}
  1418. Result := (iAbs(mn - mx) + 1);
  1419. {$ELSE}
  1420. Result := (Abs(mn - mx) + 1);
  1421. {$ENDIF}
  1422. end else
  1423. Result := 0;
  1424. end;
  1425.  
  1426. begin
  1427. ClearDebug;
  1428. WriteLn(ToStr(TIANumberlineSize([10, 5, 2])));
  1429. WriteLn(ToStr(TIANumberlineSize([999, 995, 990, 985, 980])));
  1430. end.[/simba]
  1431. [/spoiler]
  1432. [spoiler="TIAByRange"]
  1433. [simba]{==============================================================================]
  1434. Explanation: Returns a TIA that contains all the value from start value (aStart)
  1435. to finishing value (aFinish)..
  1436. [==============================================================================}
  1437. function TIAByRange(aStart, aFinish: Integer): TIntegerArray;
  1438. var
  1439. i, s, f: Integer;
  1440. begin
  1441. if (aStart <> aFinish) then
  1442. begin
  1443. s := Integer(aStart);
  1444. f := Integer(aFinish);
  1445. {$IFNDEF Lape}
  1446. SetLength(Result, (IAbs(aStart - aFinish) + 1));
  1447. {$ELSE}
  1448. SetLength(Result, (Abs(aStart - aFinish) + 1));
  1449. {$ENDIF}
  1450. if (aStart > aFinish) then
  1451. begin
  1452. for i := s downto f do
  1453. Result[(s - i)] := i;
  1454. end else
  1455. for i := s to f do
  1456. Result[(i - s)] := i;
  1457. end else
  1458. Result := [Integer(aStart)];
  1459. end;
  1460.  
  1461. begin
  1462. WriteLn(ToStr(TIAByRange(10, -10)));
  1463. WriteLn(ToStr(TIAByRange(-10, 10)));
  1464. end.[/simba]
  1465. [/spoiler]
  1466. [spoiler="TIAByRange2bit"]
  1467. [simba]{==============================================================================]
  1468. Explanation: Returns a TIA that contains all the value from start value (aStart)
  1469. to finishing value (aFinish)..
  1470. Works with 2-bit method, that cuts loop in half.
  1471. [==============================================================================}
  1472. function TIAByRange2bit(aStart, aFinish: Integer): TIntegerArray;
  1473. var
  1474. g, l, i, s, f: Integer;
  1475. begin
  1476. if (aStart <> aFinish) then
  1477. begin
  1478. s := Integer(aStart);
  1479. f := Integer(aFinish);
  1480. {$IFNDEF Lape}
  1481. l := (IAbs(aStart - aFinish) + 1);
  1482. {$ELSE}
  1483. l := (Abs(aStart - aFinish) + 1);
  1484. {$ENDIF}
  1485. SetLength(Result, l);
  1486. g := ((l - 1) div 2);
  1487. if (aStart < aFinish) then
  1488. begin
  1489. for i := 0 to g do
  1490. begin
  1491. Result[i] := (s + i);
  1492. Result[((l - 1) - i)] := (f - i);
  1493. end;
  1494. if ((l mod 2) <> 0) then
  1495. Result[i] := (s + i);
  1496. end else
  1497. begin
  1498. for i := 0 to g do
  1499. begin
  1500. Result[i] := (s - i);
  1501. Result[((l - 1) - i)] := (f + i);
  1502. end;
  1503. if ((l mod 2) <> 0) then
  1504. Result[i] := (s - i);
  1505. end;
  1506. end else
  1507. Result := [Integer(aStart)];
  1508. end;
  1509.  
  1510. begin
  1511. WriteLn(ToStr(TIAByRange2bit(10, -10)));
  1512. WriteLn(ToStr(TIAByRange2bit(-10, 10)));
  1513. end.[/simba]
  1514. [/spoiler]
  1515. [spoiler="TIARangeFrom"]
  1516. [simba]{==============================================================================]
  1517. Explanation: Returns a TIA from start position, where step is the difference between each range value.
  1518. Count is the size of the result..
  1519. Examples: (3, -1, 3) => [3, 2, 1] and (0, 2, 4) => [0, 2, 4, 6]
  1520. [==============================================================================}
  1521. function TIARangeFrom(start, step, count: Integer): TIntegerArray;
  1522. var
  1523. i: Integer;
  1524. begin
  1525. if (count > 0) then
  1526. begin
  1527. SetLength(Result, count);
  1528. for i := 0 to (count - 1) do
  1529. Result[i] := (start + (i * step));
  1530. end else
  1531. SetLength(Result, 0);
  1532. end;
  1533.  
  1534. const
  1535. START = 2;
  1536. STEP = 2;
  1537. COUNT = 4;
  1538.  
  1539. begin
  1540. WriteLn(ToStr(TIARangeFrom(START, STEP, COUNT)));
  1541. WriteLn(ToStr(TIARangeFrom(START, -STEP, COUNT)));
  1542. end.[/simba]
  1543. [/spoiler]
  1544. [spoiler="TIARange"]
  1545. [simba]{==============================================================================]
  1546. Explanation: Determines the lowest and highest values in TIA and stores em to lo and hi variables.
  1547. [==============================================================================}
  1548. procedure TIARange(TIA: TIntegerArray; var lo, hi: Integer);
  1549. var
  1550. i, h: Integer;
  1551. begin
  1552. h := High(TIA);
  1553. if (h > -1) then
  1554. begin
  1555. lo := TIA[0];
  1556. hi := TIA[0];
  1557. if (h > 0) then
  1558. for i := 1 to h do
  1559. if (TIA[i] < lo) then
  1560. lo := TIA[i]
  1561. else
  1562. if (TIA[i] > hi) then
  1563. hi := TIA[i];
  1564. end;
  1565. end;
  1566.  
  1567. var
  1568. lowest, highest: Integer;
  1569.  
  1570. begin
  1571. ClearDebug;
  1572. TIARange([3, 1, 5, 6, -1, 9, 5, 6, 4, 9, 0], lowest, highest);
  1573. WriteLn('Lowest: ' + ToStr(lowest) + ', Highest: ' + ToStr(highest));
  1574. end.[/simba]
  1575. [/spoiler]
  1576. [spoiler="TIAReverse"]
  1577. [simba]{==============================================================================]
  1578. Explanation: Reverses TIA.
  1579. [==============================================================================}
  1580. procedure TIAReverse(var TIA: TIntegerArray);
  1581. var
  1582. g, h, i: Integer;
  1583. begin
  1584. h := High(TIA);
  1585. if (h < 1) then
  1586. Exit;
  1587. g := (h div 2);
  1588. for i := 0 to g do
  1589. Swap(TIA[i], TIA[(h - i)]);
  1590. end;
  1591.  
  1592. var
  1593. TIA: TIntegerArray;
  1594.  
  1595. begin
  1596. ClearDebug;
  1597. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  1598. TIAReverse(TIA);
  1599. WriteLn(ToStr(TIA));
  1600. end.[/simba]
  1601. [/spoiler]
  1602. [spoiler="TIAInvert"]
  1603. [simba]{==============================================================================]
  1604. Explanation: Inverts TIA by replacing all of the integers inside the numberline that weren't defined in the array.
  1605. [==============================================================================}
  1606. procedure TIAInvert(var TIA: TIntegerArray);
  1607. var
  1608. c, l, i, mn, mx, x, y, r: Integer;
  1609. b: TBoolArray;
  1610. begin
  1611. y := High(TIA);
  1612. if (y > 0) then
  1613. begin
  1614. mn := TIA[0];
  1615. mx := TIA[0];
  1616. for x := 1 to y do
  1617. if (TIA[x] < mn) then
  1618. mn := TIA[x]
  1619. else
  1620. if (TIA[x] > mx) then
  1621. mx := TIA[x];
  1622. if (mn <> mx) then
  1623. begin
  1624. {$IFNDEF Lape}
  1625. l := (IAbs(mn - mx) + 1);
  1626. {$ELSE}
  1627. l := (Abs(mn - mx) + 1);
  1628. {$ENDIF}
  1629. SetLength(b, l);
  1630. for x := 0 to y do
  1631. if not b[(TIA[x] - mn)] then
  1632. begin
  1633. b[(TIA[x] - mn)] := True;
  1634. Inc(c);
  1635. end;
  1636. SetLength(TIA, (l - c));
  1637. if (Length(TIA) > 0) then
  1638. for i := 0 to (l - 1) do
  1639. if not b[i] then
  1640. begin
  1641. TIA[r] := (i + mn);
  1642. Inc(r);
  1643. end;
  1644. SetLength(b, 0);
  1645. end else
  1646. SetLength(TIA, 0);
  1647. end else
  1648. SetLength(TIA, 0);
  1649. end;
  1650.  
  1651. var
  1652. TIA: TIntegerArray;
  1653.  
  1654. begin
  1655. ClearDebug;
  1656. TIA := [5, 10, 0];
  1657. TIAInvert(TIA);
  1658. WriteLn(ToStr(TIA));
  1659. TIA := [999, 984, 995, 990, 985, 980];
  1660. TIAInvert(TIA);
  1661. WriteLn(ToStr(TIA));
  1662. end.[/simba]
  1663. [/spoiler]
  1664. [spoiler="TIAUnique"]
  1665. [simba]{==============================================================================]
  1666. Explanation: Removes all duplicates from TIA.
  1667. [==============================================================================}
  1668. procedure TIAUnique(var TIA: TIntegerArray);
  1669. var
  1670. h, h2, i, i2, i3, d: Integer;
  1671. begin
  1672. h := High(TIA);
  1673. if (h < 1) then
  1674. Exit;
  1675. for i := (h - d) downto 1 do
  1676. for i2 := (i - 1) downto 0 do
  1677. if (TIA[i] = TIA[i2]) then
  1678. begin
  1679. h2 := High(TIA);
  1680. for i3 := i to (h2 - 1) do
  1681. TIA[i3] := TIA[(i3 + 1)];
  1682. SetLength(TIA, h2);
  1683. Inc(d);
  1684. Break;
  1685. end;
  1686. end;
  1687.  
  1688. var
  1689. TIA: TIntegerArray;
  1690.  
  1691. begin
  1692. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0];
  1693. TIAUnique(TIA);
  1694. WriteLn(ToStr(TIA));
  1695. end.[/simba]
  1696. [/spoiler]
  1697. [spoiler="TIASplitEx"]
  1698. [simba]{==============================================================================]
  1699. Explanation: Splits given TIntArray (TIA) into T2DIntArray by grouping together the integer values
  1700. that are within a given difference range (minDifference, maxDifference) from each other.
  1701. [==============================================================================}
  1702. function TIASplitEx(TIA: TIntegerArray; minDifference, maxDifference: Integer): T2DIntegerArray;
  1703. var
  1704. a, b, h, l, i, r, d: Integer;
  1705. begin
  1706. h := High(TIA);
  1707. if (h > -1) then
  1708. begin
  1709. SetLength(Result, (h + 1));
  1710. Result[0] := [Integer(TIA[0])];
  1711. if (h > 0) then
  1712. begin
  1713. r := 1;
  1714. if (minDifference > maxDifference) then
  1715. Swap(minDifference, maxDifference);
  1716. for i := 1 to h do
  1717. begin
  1718. for a := 0 to (r - 1) do
  1719. begin
  1720. l := Length(Result[a]);
  1721. for b := 0 to (l - 1) do
  1722. begin
  1723. {$IFNDEF Lape}
  1724. d := IAbs(TIA[i] - Result[a][b]);
  1725. {$ELSE}
  1726. d := Abs(TIA[i] - Result[a][b]);
  1727. {$ENDIF}
  1728. if ((d >= minDifference) and (d <= maxDifference)) then
  1729. begin
  1730. SetLength(Result[a], (l + 1));
  1731. Result[a][l] := Integer(TIA[i]);
  1732. Break;
  1733. end;
  1734. end;
  1735. if (b < l) then
  1736. Break;
  1737. end;
  1738. if (a >= r) then
  1739. begin
  1740. Result[r] := [Integer(TIA[i])];
  1741. Inc(r);
  1742. end;
  1743. end;
  1744. end;
  1745. end;
  1746. SetLength(Result, r);
  1747. end;
  1748.  
  1749. var
  1750. TIA: TIntegerArray;
  1751. ATIA: T2DIntegerArray;
  1752. i: Integer;
  1753.  
  1754. begin
  1755. ClearDebug;
  1756. TIA := [0, 18, 1, 5, 6, 9, 11, 12, 17, 18, 19, 20, 15, 0, -1, 24];
  1757. for i := 0 to 5 do
  1758. begin
  1759. ATIA := TIASplitEx(TIA, 0, i);
  1760. WriteLn('ATIA = TIASplitEx(TIA, 0, ' + IntToStr(i) + '): ' + ToStr(ATIA));
  1761. end;
  1762. end.[/simba]
  1763. [/spoiler]
  1764. [spoiler="TIAGroupEx"]
  1765. [simba]{==============================================================================]
  1766. Explanation: Splits given TIntArray (TIA) into T2DIntArray by grouping together the integer values
  1767. that are within a given difference range (minDifference, maxDifference) of the first integer value in the sub-array.
  1768. [==============================================================================}
  1769. function TIAGroupEx(TIA: TIntegerArray; minDifference, maxDifference: Integer): T2DIntegerArray;
  1770. var
  1771. a, h, l, i, r, d: Integer;
  1772. begin
  1773. h := High(TIA);
  1774. if (h > -1) then
  1775. begin
  1776. SetLength(Result, (h + 1));
  1777. Result[0] := [Integer(TIA[0])];
  1778. if (h > 0) then
  1779. begin
  1780. r := 1;
  1781. if (minDifference > maxDifference) then
  1782. Swap(minDifference, maxDifference);
  1783. for i := 1 to h do
  1784. begin
  1785. for a := 0 to (r - 1) do
  1786. begin
  1787. {$IFNDEF Lape}
  1788. d := IAbs(TIA[i] - Result[a][0]);
  1789. {$ELSE}
  1790. d := Abs(TIA[i] - Result[a][0]);
  1791. {$ENDIF}
  1792. if ((d >= minDifference) and (d <= maxDifference)) then
  1793. begin
  1794. l := Length(Result[a]);
  1795. SetLength(Result[a], (l + 1));
  1796. Result[a][l] := Integer(TIA[i]);
  1797. Break;
  1798. end;
  1799. end;
  1800. if (a >= r) then
  1801. begin
  1802. Result[r] := [Integer(TIA[i])];
  1803. Inc(r);
  1804. end;
  1805. end;
  1806. end;
  1807. end;
  1808. SetLength(Result, r);
  1809. end;
  1810.  
  1811. var
  1812. TIA: TIntegerArray;
  1813. ATIA: T2DIntegerArray;
  1814. i: Integer;
  1815.  
  1816. begin
  1817. ClearDebug;
  1818. TIA := [0, 18, 1, 5, 6, 9, 11, 12, 17, 18, 19, 20, 15, 0, -1, 24];
  1819. for i := 0 to 24 do
  1820. begin
  1821. ATIA := TIAGroupEx(TIA, 0, i);
  1822. WriteLn('ATIA = TIASplitEx(TIA, 0, ' + IntToStr(i) + '): ' + ToStr(ATIA));
  1823. end;
  1824. end.[/simba]
  1825. [/spoiler]
  1826. [spoiler="TIAMean"]
  1827. [simba]{==============================================================================]
  1828. Explanation: Returns the arithmetic mean of TIA values.
  1829. [==============================================================================}
  1830. function TIAMean(TIA: TIntegerArray): Extended;
  1831. var
  1832. i, h: Integer;
  1833. begin
  1834. Result := 0;
  1835. h:= High(TIA);
  1836. for i:= 0 to h do
  1837. Result := (Result + (Extended(TIA[i]) / (h + 1)));
  1838. end;
  1839.  
  1840. begin
  1841. WriteLn(FloatToStr(TIAMean([1, 5, 8, 3])));
  1842. end.[/simba]
  1843. [/spoiler]
  1844. [spoiler="TIASum"]
  1845. [simba]{==============================================================================]
  1846. Explanation: Returns the sum of all TIA values together.
  1847. [==============================================================================}
  1848. function TIASum(TIA: TIntegerArray): Int64;
  1849. var
  1850. i, h: Integer;
  1851. begin
  1852. Result := 0;
  1853. h:= High(TIA);
  1854. for i:= 0 to h do
  1855. Result := (Result + TIA[i]);
  1856. end;
  1857.  
  1858. begin
  1859. ClearDebug;
  1860. WriteLn(ToStr(TIASum([3, 2, 1, 4])));
  1861. end.[/simba]
  1862. [/spoiler]
  1863. [spoiler="TIARandomRange"]
  1864. [simba]{==============================================================================]
  1865. Explanation: Generates an array of random numbers from aFrom to aTo.
  1866. Amount is the size of the array.
  1867. If duplicates is set as true, the values wont be unique to each other.
  1868. [==============================================================================}
  1869. function TIARandomRange(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntegerArray;
  1870. var
  1871. a, d, e, m, n, r, i, t, x, y: Integer;
  1872. tmp: TIntegerArray;
  1873. b: Boolean;
  1874. begin
  1875. if (amount > 0) then
  1876. if not duplicates then
  1877. begin
  1878. if (aFrom > aTo) then
  1879. Swap(aFrom, aTo);
  1880. {$IFNDEF Lape}
  1881. a := IAbs(aTo - aFrom);
  1882. {$ELSE}
  1883. a := Abs(aTo - aFrom);
  1884. {$ENDIF}
  1885. if (a < amount) then
  1886. amount := a;
  1887. SetLength(Result, amount);
  1888. if (amount > 0) then
  1889. begin
  1890. if (amount < 20000) then
  1891. begin
  1892. for r := 0 to (amount - 1) do
  1893. repeat
  1894. n := RandomRange(aFrom, aTo);
  1895. y := High(Result);
  1896. for x := 0 to y do
  1897. if (Result[x] = n) then
  1898. Break;
  1899. if (x > y) then
  1900. begin
  1901. Result[i] := n;
  1902. Inc(i);
  1903. end;
  1904. until (i > r);
  1905. end else
  1906. begin
  1907. SetLength(Result, amount);
  1908. {$IFNDEF Lape}
  1909. m := IAbs(aFrom - aTo);
  1910. {$ELSE}
  1911. m := Abs(aFrom - aTo);
  1912. {$ENDIF}
  1913. if (m > 10) then
  1914. b := (m > Trunc(amount * 1.1));
  1915. if b then
  1916. begin
  1917. d := (Trunc(m / amount) + 3);
  1918. e := aFrom;
  1919. for i := 0 to (amount - 1) do
  1920. begin
  1921. r := Random(d);
  1922. IncEx(e, r);
  1923. IncEx(t, (r + 1));
  1924. Result[i] := (e + i);
  1925. Swap(Result[Random(i)], Result[Random(i)]);
  1926. d := (Trunc(((m - t) / (amount - i))) * 2);
  1927. end;
  1928. for i := 0 to (amount div 2) do
  1929. Swap(Result[Random(amount)], Result[Random(amount)]);
  1930. end else
  1931. begin
  1932. SetLength(tmp, (aTo - aFrom));
  1933. for i := aFrom to (aTo - 1) do
  1934. tmp[(i - aFrom)] := i;
  1935. for i := 0 to (amount - 1) do
  1936. begin
  1937. r := Random((aTo - aFrom) - i);
  1938. Result[i] := Integer(tmp[r]);
  1939. y := High(tmp);
  1940. if ((r <= y) and (r > -1)) then
  1941. begin
  1942. for x := r to (y - 1) do
  1943. tmp[x] := tmp[(x + 1)];
  1944. SetLength(tmp, y);
  1945. end;
  1946. end;
  1947. SetLength(tmp, 0);
  1948. end;
  1949. end;
  1950. end else
  1951. Result := [aFrom];
  1952. end else
  1953. begin
  1954. SetLength(Result, amount);
  1955. for i := 0 to (amount - 1) do
  1956. Result[i] := RandomRange(aFrom, aTo);
  1957. end;
  1958. end;
  1959.  
  1960. begin
  1961. ClearDebug;
  1962. WriteLn(ToStr(TIARandomRange(1, 10, 9, False)));
  1963. WriteLn('');
  1964. WriteLn(ToStr(TIARandomRange(1, 10, 9, True)));
  1965. end.[/simba]
  1966. [/spoiler]
  1967. [spoiler="TIAToParts"]
  1968. [simba]type
  1969. TPartitionMethod = (pm_PartSize, pm_PartAmount);
  1970.  
  1971. {==============================================================================]
  1972. Explanation: Breaks TIA to parts (TIA => ATIA). Contains 2 methods:
  1973. -pm_PartSize (Breaks TIA to ATIA by size of the parts) [x = size]
  1974. -pm_PartAmount (Breaks TIA to ATIA by amount of the parts) [x = amount]
  1975. [==============================================================================}
  1976. function TIAToParts(TIA: TIntegerArray; method: TPartitionMethod; x: Integer): T2DIntegerArray;
  1977. var
  1978. a, e, h, h2, i, i2, p, z, l: Integer;
  1979. f: Boolean;
  1980. begin
  1981. h := High(TIA);
  1982. if ((h > -1) and (x > 0)) then
  1983. begin
  1984. case method of
  1985. pm_PartSize:
  1986. if (x <= h) then
  1987. begin
  1988. Inc(h);
  1989. p := (h div x);
  1990. if ((p * x) < h) then
  1991. Inc(p);
  1992. SetLength(Result, p);
  1993. for i := 0 to (p - 1) do
  1994. for i2 := 0 to (x - 1) do
  1995. begin
  1996. SetLength(Result[i], x);
  1997. if (a < h) then
  1998. begin
  1999. Result[i][i2] := Integer(TIA[a]);
  2000. Inc(a);
  2001. end else
  2002. begin
  2003. SetLength(Result[i], i2);
  2004. Exit;
  2005. end;
  2006. end;
  2007. end else
  2008. f := True;
  2009. pm_PartAmount:
  2010. if (h > -1) then
  2011. begin
  2012. if (h < (x - 1)) then
  2013. x := (h + 1);
  2014. p := Floor((h + 1) / x);
  2015. if (p = 0) then
  2016. p := 1;
  2017. e := ((h + 1) - (p * x));
  2018. if (e >= (h + 1)) then
  2019. e := 0;
  2020. SetLength(Result, x);
  2021. for i := 0 to (x - 1) do
  2022. begin
  2023. if ((e >= (i + 1)) and (e > 0)) then
  2024. SetLength(Result[i], (p + 1))
  2025. else
  2026. if (i <= h) then
  2027. SetLength(Result[i], p);
  2028. h2 := High(Result[i]);
  2029. for i2 := 0 to h2 do
  2030. begin
  2031. Result[i][i2] := Integer(TIA[a]);
  2032. Inc(a);
  2033. end;
  2034. end;
  2035. end else
  2036. f := True;
  2037. end;
  2038. if f then
  2039. begin
  2040. SetLength(Result, 1);
  2041. l := Length(TIA);
  2042. SetLength(Result[0], l);
  2043. for z := 0 to (l - 1) do
  2044. Result[0][z] := Integer(TIA[z]);
  2045. end;
  2046. end else
  2047. SetLength(Result, 0);
  2048. end;
  2049.  
  2050. var
  2051. TIA: TIntegerArray;
  2052.  
  2053. begin
  2054. ClearDebug;
  2055. TIA := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
  2056. WriteLn('TIAToParts(TIA, pm_PartAmount, 3): ' + ToStr(TIAToParts(TIA, pm_PartAmount, 3)));
  2057. WriteLn('TIAToParts(TIA, pm_PartSize, 3): ' + ToStr(TIAToParts(TIA, pm_PartSize, 3)));
  2058. end.[/simba]
  2059. [/spoiler]
  2060. [spoiler="ATIAMerge"]
  2061. [simba]{==============================================================================]
  2062. Explanation: Merges T2DIntegerArray (ATIA) to TIntegerArray.
  2063. [==============================================================================}
  2064. function ATIAMerge(ATIA: T2DIntegerArray): TIntegerArray;
  2065. var
  2066. i, i2, h, h2, r: Integer;
  2067. begin
  2068. h := High(ATIA);
  2069. if (h > -1) then
  2070. begin
  2071. for i := 0 to h do
  2072. IncEx(r, (High(ATIA[i]) + 1));
  2073. SetLength(Result, r);
  2074. r := 0;
  2075. for i := 0 to h do
  2076. begin
  2077. h2 := High(ATIA[i]);
  2078. for i2 := 0 to h2 do
  2079. begin
  2080. Result[r] := Integer(ATIA[i][i2]);
  2081. Inc(r);
  2082. end;
  2083. end;
  2084. end else
  2085. SetLength(Result, 0);
  2086. end;
  2087.  
  2088. var
  2089. ATIA: T2DIntegerArray;
  2090.  
  2091. begin
  2092. SetLength(ATIA, 3);
  2093. ATIA[0] := [0, 1, 2, 3];
  2094. ATIA[1] := [4, 5];
  2095. ATIA[2] := [6, 7, 8, 9];
  2096. WriteLn(ToStr(ATIAMerge(ATIA)));
  2097. end.[/simba]
  2098. [/spoiler]
  2099. [spoiler="ATIAClone"]
  2100. [simba]{==============================================================================]
  2101. Explanation: Returns copy ("clone") of ATIA safely
  2102. [==============================================================================}
  2103. function ATIAClone(ATIA: T2DIntegerArray): T2DIntegerArray;
  2104. var
  2105. i, l, x, y: Integer;
  2106. begin
  2107. l := Length(ATIA);
  2108. SetLength(Result, l);
  2109. for i := 0 to (l - 1) do
  2110. begin
  2111. y := Length(ATIA[i]);
  2112. SetLength(Result[i], y);
  2113. for x := 0 to (y - 1) do
  2114. Result[i][x] := Integer(ATIA[i][x]);
  2115. end;
  2116. end;
  2117.  
  2118. var
  2119. tmp: T2DIntegerArray;
  2120.  
  2121. begin
  2122. SetLength(tmp, 5);
  2123. tmp[0] := [0, 1];
  2124. tmp[1] := [2, 3];
  2125. tmp[2] := [4, 5];
  2126. tmp[3] := [6, 7];
  2127. tmp[4] := [8, 9];
  2128. WriteLn(ToStr(ATIAClone(tmp)));
  2129. end.[/simba]
  2130. [/spoiler]
  2131. [spoiler="ATIASetLength"]
  2132. [simba]{==============================================================================]
  2133. Explanation: Sets T2DIntArray's (arr) 1D and 2D lengths by s1D and s2D.
  2134. Example: (ATIA, 2, 4) => ATIA = [[0,0,0,0],[0,0,0,0]]
  2135. [==============================================================================}
  2136. procedure ATIASetLength(var arr: T2DIntegerArray; s1D, s2D: Integer);
  2137. var
  2138. i: Integer;
  2139. begin
  2140. if (s1D < 0) then
  2141. s1D := 0;
  2142. if (s2D < 0) then
  2143. s2D := 0;
  2144. SetLength(arr, s1D);
  2145. for i := 0 to (s1D - 1) do
  2146. SetLength(arr[i], s2D);
  2147. end;
  2148.  
  2149. var
  2150. tmp: T2DIntegerArray;
  2151.  
  2152. begin
  2153. ATIASetLength(tmp, 3, 2);
  2154. WriteLn(ToStr(tmp));
  2155. end.[/simba]
  2156. [/spoiler]
  2157.  
  2158. Going to add more stuff soon probably. :stirthepot:
  2159.  
  2160. ..oh and, as always:
  2161. Feel free to use/take/improve/anything - it's all open-source!
  2162. Giving credit is always appreciated, but not really necessary for me. :)
  2163.  
  2164. Enjoy,
  2165. -Jani
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!