1. my class Rakudo::QuantHash {
  2. # a Pair with the value 0
  3. my $p0 := nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0);
  4. our role Pairs does Iterator {
  5. has $!elems;
  6. has $!picked;
  7. method !SET-SELF(\elems,\count) {
  8. nqp::stmts(
  9. ($!elems := elems),
  10. ($!picked := Rakudo::QuantHash.PICK-N(elems, count)),
  11. self
  12. )
  13. }
  14. method new(Mu \elems, \count) {
  15. nqp::if(
  16. (my $todo := Rakudo::QuantHash.TODO(count))
  17. && elems
  18. && nqp::elems(elems),
  19. nqp::create(self)!SET-SELF(elems, $todo),
  20. Rakudo::Iterator.Empty
  21. )
  22. }
  23. }
  24. # Return the iterator state of a randomly selected entry in a
  25. # given IterationSet
  26. method ROLL(Mu \elems) {
  27. nqp::stmts(
  28. (my int $i = nqp::add_i(nqp::rand_n(nqp::elems(elems)),1)),
  29. (my $iter := nqp::iterator(elems)),
  30. nqp::while(
  31. nqp::shift($iter) && ($i = nqp::sub_i($i,1)),
  32. nqp::null
  33. ),
  34. $iter
  35. )
  36. }
  37. # Return a list_s of N keys of the given IterationSet in random order.
  38. method PICK-N(Mu \elems, \count) {
  39. nqp::stmts(
  40. (my int $elems = nqp::elems(elems)),
  41. (my int $count = nqp::if(count > $elems,$elems,count)),
  42. (my $keys := nqp::setelems(nqp::list_s,$elems)),
  43. (my $iter := nqp::iterator(elems)),
  44. (my int $i = -1),
  45. nqp::while(
  46. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  47. nqp::bindpos_s($keys,$i,nqp::iterkey_s(nqp::shift($iter)))
  48. ),
  49. (my $picked := nqp::setelems(nqp::list_s,$count)),
  50. ($i = -1),
  51. nqp::while(
  52. nqp::islt_i(($i = nqp::add_i($i,1)),$count),
  53. nqp::stmts(
  54. nqp::bindpos_s($picked,$i,
  55. nqp::atpos_s($keys,(my int $pick = $elems.rand.floor))
  56. ),
  57. nqp::bindpos_s($keys,$pick,
  58. nqp::atpos_s($keys,($elems = nqp::sub_i($elems,1)))
  59. )
  60. )
  61. ),
  62. $picked
  63. )
  64. }
  65. # Return number of items to be done if > 0, or 0 if < 1, or throw if NaN
  66. method TODO(\count) is raw {
  67. nqp::if(
  68. count < 1,
  69. 0,
  70. nqp::if(
  71. count == Inf,
  72. count,
  73. nqp::if(
  74. nqp::istype((my $todo := count.Int),Failure),
  75. $todo.throw,
  76. $todo
  77. )
  78. )
  79. )
  80. }
  81. #--- Set/SetHash related methods
  82. method SET-IS-SUBSET($a,$b) {
  83. nqp::stmts(
  84. nqp::unless(
  85. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  86. nqp::if(
  87. (my $araw := $a.raw_hash)
  88. && nqp::elems($araw),
  89. nqp::if( # number of elems in B *always* >= A
  90. (my $braw := $b.raw_hash)
  91. && nqp::isle_i(nqp::elems($araw),nqp::elems($braw))
  92. && (my $iter := nqp::iterator($araw)),
  93. nqp::while( # number of elems in B >= A
  94. $iter,
  95. nqp::unless(
  96. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  97. return False # elem in A doesn't exist in B
  98. )
  99. ),
  100. return False # number of elems in B smaller than A
  101. )
  102. )
  103. ),
  104. True
  105. )
  106. }
  107. #--- Bag/BagHash related methods
  108. # Calculate total of value of a Bag(Hash). Takes a (possibly
  109. # uninitialized) IterationSet in Bag format.
  110. method BAG-TOTAL(Mu \elems) {
  111. nqp::if(
  112. elems && nqp::elems(elems),
  113. nqp::stmts(
  114. (my Int $total := 0),
  115. (my $iter := nqp::iterator(elems)),
  116. nqp::while(
  117. $iter,
  118. $total := nqp::add_I(
  119. $total,
  120. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  121. Int
  122. )
  123. ),
  124. $total
  125. ),
  126. 0
  127. )
  128. }
  129. # Return random iterator item from a given Bag(Hash). Takes an
  130. # initialized IterationSet with at least 1 element in Bag format,
  131. # and the total value of values in the Bag.
  132. method BAG-ROLL(\elems, \total) {
  133. nqp::stmts(
  134. (my Int $rand := total.rand.Int),
  135. (my Int $seen := 0),
  136. (my $iter := nqp::iterator(elems)),
  137. nqp::while(
  138. $iter &&
  139. nqp::isle_I(
  140. ($seen := nqp::add_I(
  141. $seen,
  142. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  143. Int
  144. )),
  145. $rand
  146. ),
  147. nqp::null
  148. ),
  149. $iter
  150. )
  151. }
  152. # Return random object from a given BagHash. Takes an initialized
  153. # IterationSet with at least 1 element in Bag format, and the total
  154. # value of values in the Bag. Decrements the count of the iterator
  155. # found, completely removes it when going to 0.
  156. method BAG-GRAB(\elems, \total) {
  157. nqp::stmts(
  158. (my $iter := Rakudo::QuantHash.BAG-ROLL(elems,total)),
  159. nqp::if(
  160. nqp::iseq_i(
  161. (my $value := nqp::getattr(nqp::iterval($iter),Pair,'$!value')),
  162. 1
  163. ),
  164. nqp::stmts( # going to 0, so remove
  165. (my $object := nqp::getattr(nqp::iterval($iter),Pair,'$!key')),
  166. nqp::deletekey(elems,nqp::iterkey_s($iter)),
  167. $object
  168. ),
  169. nqp::stmts(
  170. nqp::bindattr(
  171. nqp::iterval($iter),
  172. Pair,
  173. '$!value',
  174. nqp::sub_i($value,1)
  175. ),
  176. nqp::getattr(nqp::iterval($iter),Pair,'$!key')
  177. )
  178. )
  179. )
  180. }
  181. method BAGGY-CLONE-RAW(Mu \baggy) {
  182. nqp::if(
  183. baggy && nqp::elems(baggy),
  184. nqp::stmts( # something to coerce
  185. (my $elems := nqp::clone(baggy)),
  186. (my $iter := nqp::iterator($elems)),
  187. nqp::while(
  188. $iter,
  189. nqp::bindkey(
  190. $elems,
  191. nqp::iterkey_s(nqp::shift($iter)),
  192. nqp::p6bindattrinvres(
  193. nqp::clone(nqp::iterval($iter)),
  194. Pair,
  195. '$!value',
  196. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  197. )
  198. )
  199. ),
  200. $elems
  201. ),
  202. baggy
  203. )
  204. }
  205. method ADD-BAG-TO-BAG(\elems,Mu \bag --> Nil) {
  206. nqp::if(
  207. bag && nqp::elems(bag),
  208. nqp::stmts(
  209. (my $iter := nqp::iterator(bag)),
  210. nqp::while(
  211. $iter,
  212. nqp::if(
  213. nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
  214. nqp::stmts(
  215. (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  216. nqp::bindattr($pair,Pair,'$!value',
  217. nqp::add_i(
  218. nqp::getattr($pair,Pair,'$!value'),
  219. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  220. )
  221. )
  222. ),
  223. nqp::bindkey(elems,nqp::iterkey_s($iter),
  224. nqp::clone(nqp::iterval($iter))
  225. )
  226. )
  227. )
  228. )
  229. )
  230. }
  231. method ADD-ITERATOR-TO-BAG(\elems,Mu \iterator --> Nil) {
  232. nqp::until(
  233. nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd),
  234. nqp::if(
  235. nqp::existskey(elems,(my $WHICH := $pulled.WHICH)),
  236. nqp::stmts(
  237. (my $pair := nqp::atkey(elems,$WHICH)),
  238. nqp::bindattr($pair,Pair,'$!value',
  239. nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1)
  240. )
  241. ),
  242. nqp::bindkey(elems,$WHICH,Pair.new($pulled,1))
  243. )
  244. )
  245. }
  246. method ADD-SET-TO-BAG(\elems,Mu \set --> Nil) {
  247. nqp::if(
  248. set && nqp::elems(set),
  249. nqp::stmts(
  250. (my $iter := nqp::iterator(set)),
  251. nqp::while(
  252. $iter,
  253. nqp::if(
  254. nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
  255. nqp::stmts(
  256. (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  257. nqp::bindattr($pair,Pair,'$!value',
  258. nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1)
  259. )
  260. ),
  261. nqp::bindkey(elems,nqp::iterkey_s($iter),
  262. Pair.new(nqp::iterval($iter),1)
  263. )
  264. )
  265. )
  266. )
  267. )
  268. }
  269. method MULTIPLY-BAG-TO-BAG(\elems,Mu \bag --> Nil) {
  270. nqp::stmts(
  271. (my $iter := nqp::iterator(elems)),
  272. nqp::if(
  273. bag && nqp::elems(bag),
  274. nqp::while(
  275. $iter,
  276. nqp::if(
  277. nqp::existskey(bag,nqp::iterkey_s(nqp::shift($iter))),
  278. nqp::stmts(
  279. (my $pair := nqp::iterval($iter)),
  280. nqp::bindattr($pair,Pair,'$!value',
  281. nqp::mul_i(
  282. nqp::getattr($pair,Pair,'$!value'),
  283. nqp::getattr(
  284. nqp::atkey(bag,nqp::iterkey_s($iter)),
  285. Pair,
  286. '$!value'
  287. )
  288. )
  289. )
  290. ),
  291. nqp::deletekey(elems,nqp::iterkey_s($iter))
  292. )
  293. ),
  294. nqp::while( # nothing to match against, so reset
  295. $iter,
  296. nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter)))
  297. )
  298. )
  299. )
  300. }
  301. method MULTIPLY-SET-TO-BAG(\elems,Mu \set --> Nil) {
  302. nqp::stmts(
  303. (my $iter := nqp::iterator(elems)),
  304. nqp::if(
  305. set && nqp::elems(set),
  306. nqp::while(
  307. $iter,
  308. nqp::unless(
  309. nqp::existskey(set,nqp::iterkey_s(nqp::shift($iter))),
  310. nqp::deletekey(elems,nqp::iterkey_s($iter))
  311. )
  312. ),
  313. nqp::while( # nothing to match against, so reset
  314. $iter,
  315. nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter)))
  316. )
  317. )
  318. )
  319. }
  320. #--- Mix/MixHash related methods
  321. # Calculate total of values of a Mix(Hash). Takes a (possibly
  322. # uninitialized) IterationSet in Mix format.
  323. method MIX-TOTAL(Mu \elems) {
  324. nqp::if(
  325. elems && nqp::elems(elems),
  326. nqp::stmts(
  327. (my $total := 0),
  328. (my $iter := nqp::iterator(elems)),
  329. nqp::while(
  330. $iter,
  331. $total := $total
  332. + nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  333. ),
  334. $total
  335. ),
  336. 0
  337. )
  338. }
  339. # Calculate total of positive value of a Mix(Hash). Takes a
  340. # (possibly uninitialized) IterationSet in Mix format.
  341. method MIX-TOTAL-POSITIVE(Mu \elems) {
  342. nqp::if(
  343. elems && nqp::elems(elems),
  344. nqp::stmts(
  345. (my $total := 0),
  346. (my $iter := nqp::iterator(elems)),
  347. nqp::while(
  348. $iter,
  349. nqp::if(
  350. 0 < (my $value :=
  351. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')),
  352. ($total := $total + $value)
  353. )
  354. ),
  355. $total
  356. ),
  357. 0
  358. )
  359. }
  360. # Return random iterator item from a given Mix(Hash). Takes an
  361. # initialized IterationSet with at least 1 element in Mix format,
  362. # and the total value of values in the Mix.
  363. method MIX-ROLL(\elems, \total) {
  364. nqp::stmts(
  365. (my $rand := total.rand),
  366. (my Int $seen := 0),
  367. (my $iter := nqp::iterator(elems)),
  368. nqp::while(
  369. $iter && (
  370. 0 > (my $value := # negative values ignored
  371. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'))
  372. || $rand > ($seen := $seen + $value) # positive values add up
  373. ),
  374. nqp::null
  375. ),
  376. $iter
  377. )
  378. }
  379. method ADD-MIX-TO-MIX(\elems,Mu \mix --> Nil) {
  380. nqp::if(
  381. mix && nqp::elems(mix),
  382. nqp::stmts(
  383. (my $iter := nqp::iterator(mix)),
  384. nqp::while(
  385. $iter,
  386. nqp::if(
  387. nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
  388. nqp::stmts(
  389. (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  390. nqp::bindattr($pair,Pair,'$!value',
  391. nqp::getattr($pair,Pair,'$!value')
  392. + nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  393. )
  394. ),
  395. nqp::bindkey(elems,nqp::iterkey_s($iter),
  396. nqp::clone(nqp::iterval($iter))
  397. )
  398. )
  399. )
  400. )
  401. )
  402. }
  403. method MULTIPLY-MIX-TO-MIX(\elems,Mu \mix --> Nil) {
  404. nqp::stmts(
  405. (my $iter := nqp::iterator(elems)),
  406. nqp::if(
  407. mix && nqp::elems(mix),
  408. nqp::while(
  409. $iter,
  410. nqp::if(
  411. nqp::existskey(mix,nqp::iterkey_s(nqp::shift($iter))),
  412. nqp::stmts(
  413. (my $pair := nqp::iterval($iter)),
  414. nqp::bindattr($pair,Pair,'$!value',
  415. nqp::getattr($pair,Pair,'$!value')
  416. * nqp::getattr(
  417. nqp::atkey(mix,nqp::iterkey_s($iter)),
  418. Pair,
  419. '$!value'
  420. )
  421. )
  422. ),
  423. nqp::deletekey(elems,nqp::iterkey_s($iter))
  424. )
  425. ),
  426. nqp::while( # nothing to match against, so reset
  427. $iter,
  428. nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter)))
  429. )
  430. )
  431. )
  432. }
  433. method MIX-ALL-POSITIVE(\elems) {
  434. nqp::stmts(
  435. (my $iter := nqp::iterator(elems)),
  436. nqp::while(
  437. $iter,
  438. nqp::unless(
  439. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value') > 0,
  440. return False
  441. )
  442. ),
  443. True
  444. )
  445. }
  446. method MIX-ALL-NEGATIVE(\elems) {
  447. nqp::stmts(
  448. (my $iter := nqp::iterator(elems)),
  449. nqp::while(
  450. $iter,
  451. nqp::unless(
  452. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value') < 0,
  453. return False
  454. )
  455. ),
  456. True
  457. )
  458. }
  459. method MIX-IS-SUBSET($a,$b) {
  460. nqp::if(
  461. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  462. True, # X is always a subset of itself
  463. nqp::if(
  464. (my $araw := $a.raw_hash) && nqp::elems($araw),
  465. nqp::if( # elems in A
  466. (my $braw := $b.raw_hash) && nqp::elems($braw),
  467. nqp::stmts( # elems in A and B
  468. (my $iter := nqp::iterator($araw)),
  469. nqp::while( # check all values in A with B
  470. $iter,
  471. nqp::unless(
  472. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  473. <= # value in A should be less or equal than B
  474. nqp::getattr(
  475. nqp::ifnull(nqp::atkey($araw,nqp::iterkey_s($iter)),$p0),
  476. Pair,
  477. '$!value'
  478. ),
  479. return False
  480. )
  481. ),
  482. ($iter := nqp::iterator($braw)),
  483. nqp::while( # check all values in B with A
  484. $iter,
  485. nqp::unless(
  486. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  487. >= # value in B should be more or equal than A
  488. nqp::getattr(
  489. nqp::ifnull(nqp::atkey($araw,nqp::iterkey_s($iter)),$p0),
  490. Pair,
  491. '$!value'
  492. ),
  493. return False
  494. )
  495. ),
  496. True # all checks worked out, so ok
  497. ),
  498. # nothing in B, all elems in A should be < 0
  499. Rakudo::QuantHash.MIX-ALL-NEGATIVE($araw)
  500. ),
  501. nqp::if(
  502. ($braw := $b.raw_hash) && nqp::elems($braw),
  503. # nothing in A, all elems in B should be >= 0
  504. Rakudo::QuantHash.MIX-ALL-POSITIVE($braw),
  505. False # nothing in A nor B
  506. )
  507. )
  508. )
  509. }
  510. }