Check-in [f615eecc64]
Overview
Comment:Improved and parameterized perfect hash function generator
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: f615eecc64f57b3d57617a03de2f734dc9bdb8ab1982d8cb3612a786a563c7e0
User & Date: rkeene on 2019-10-10 00:40:45
Other Links: manifest | tags
Context
2019-11-04
21:09
Support using a hash table unless a really small input is used (may change in the future?) check-in: 37d00c3cfb user: rkeene tags: trunk
2019-10-10
00:40
Improved and parameterized perfect hash function generator check-in: f615eecc64 user: rkeene tags: trunk
00:40
Fix error in constraining to range check-in: c89b6aa781 user: rkeene tags: trunk
Changes

Modified lib/xvfs/xvfs.tcl from [6f620f3c29] to [1ce5b335aa].

307
308
309
310
311
312
313
314














315
316
317



318






319
320
321
322
323
324
325




326
327







328
329
330

331
332
333
334




335
336
337


338

339
340
341
342
343
344
345











346
347
348
349
350
351
352



353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370

371
372

373
374
375
376

proc ::xvfs::staticIncludeHeader {pathToHeaderFile} {
	set fd [open $pathToHeaderFile]
	::xvfs::staticIncludeHeaderData [read $fd]
	close $fd
}

proc ::xvfs::generatePerfectHashFunctionCall {cVarName cVarLength invalidValue nameList} {














	set minVal 0
	set maxVal [llength $nameList]
	set testExpr {([zlib adler32 $nameItem $alpha] + $beta) % $gamma}



	set testExprC {((Tcl_ZlibAdler32($alpha, (unsigned char *) $cVarName, $cVarLength) + $beta) % $gamma)}







	set round -1

	set beta 0
	set gamma $maxVal

	while true {




		incr round








		set alpha $round
		set gamma [expr {($round % ($maxVal + 1)) + $maxVal}]


		set idx -1
		set seenIndexes [list]
		set failed false
		foreach nameItem $nameList {




			incr idx

			set testExprVal [expr $testExpr]




			if {$testExprVal in $seenIndexes} {
				incr alpha
				set failed true
				break
			}

			lappend seenIndexes $testExprVal











		}

		if {!$failed} {
			break
		}
	}




	unset -nocomplain mapArray
	for {set idx 0} {$idx < $gamma} {incr idx} {
		set mapArray($idx) $invalidValue
	}

	set idx -1
	foreach nameItem $nameList {
		incr idx

		set mapArray([expr $testExpr]) $idx
	}

	set map "(long\[\])\{"
	for {set idx 0} {$idx < $gamma} {incr idx} {
		append map "$mapArray($idx), "
	}
	set map [string range $map 0 end-2]
	append map "\}\[[subst $testExprC]\]"

	set phfCall $map


	return $phfCall
}

package provide xvfs 1







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>


|
>
>
>
|
>
>
>
>
>
>



<
|


>
>
>
>


>
>
>
>
>
>
>
|
|

>
|
|
|
|
>
>
>
>
|

|
>
>
|
>
|
<
|
|
|

|
>
>
>
>
>
>
>
>
>
>
>







>
>
>
|
|
|
|

|
|
|

|
|

|
|
|
|
|
|
>
|
|
>




307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344

345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380

381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

proc ::xvfs::staticIncludeHeader {pathToHeaderFile} {
	set fd [open $pathToHeaderFile]
	::xvfs::staticIncludeHeaderData [read $fd]
	close $fd
}

proc ::xvfs::generatePerfectHashFunctionCall {cVarName cVarLength invalidValue nameList args} {
	array set config {
		preferMinimalHashSize   8
		switchToNonMinimalHash  1048576
		triesAtHashSize         1024
		maxIntermediateMultiple 8
	}

	foreach {configKey configVal} $args {
		if {![info exists config($configKey)]} {
			error "Invalid option: $configKey"
		}
	}
	array set config $args

	set minVal 0
	set maxVal [llength $nameList]
	set testExpr(0) {([zlib adler32 $nameItem $alpha] + $beta) % $gamma}
	set testExpr(1) {([zlib crc32 $nameItem $alpha] + $beta) % $gamma}
	set testExpr(2) {([zlib adler32 $nameItem [zlib crc32 $nameItem $alpha]] + $beta) % $gamma}
	set testExprC(0) {((Tcl_ZlibAdler32(${alpha}LU, (unsigned char *) $cVarName, $cVarLength) + ${beta}LU) % ${gamma}LU)}
	set testExprC(1) {((Tcl_ZlibCRC32(${alpha}LU, (unsigned char *) $cVarName, $cVarLength) + ${beta}LU) % ${gamma}LU)}
	set testExprC(2) {((Tcl_ZlibAdler32(Tcl_ZlibCRC32(${alpha}LU, (unsigned char *) $cVarName, $cVarLength), (unsigned char *) $cVarName, $cVarLength) + ${beta}LU) % ${gamma}LU)}

	set minimal false
	if {$maxVal < $config(preferMinimalHashSize)} {
		set minimal true
	}

	set round -1


	set gammaRoundMod [expr {$maxVal * ($config(maxIntermediateMultiple) - 1)}]

	while true {
		if {$minimal && $round > $config(switchToNonMinimalHash)} {
			set minimal false
			set round -1
		}
		incr round

		if {$minimal} {
			set gamma [expr {$maxVal + ($round % ($maxVal * 4))}]
		} else {
			set gamma [expr {$maxVal + ($round % $gammaRoundMod)}]
		}

		for {set try 0} {$try < $config(triesAtHashSize)} {incr try} {
			set alpha [expr {entier(rand() * (2**31))}]
			set beta  [expr {entier(rand() * (2**31))}]

			foreach {testExprID testExprContents} [array get testExpr] {
				set idx -1
				set seenIndexes [list]
				set failed false
				foreach nameItem $nameList {

					set testExprVal [expr $testExprContents]

					if {$minimal} {
						incr idx

						if {$testExprVal != $idx} {
							set failed true
							break
						}
					} else {
						if {$testExprVal in $seenIndexes} {

							set failed true
							break
						}

						lappend seenIndexes $testExprVal
					}
				}

				if {!$failed} {
					break
				}
			}

			if {!$failed} {
				break
			}
		}

		if {!$failed} {
			break
		}
	}

	if {$minimal} {
		set phfCall [subst $testExprC($testExprID)]
	} else {
		unset -nocomplain mapArray
		for {set idx 0} {$idx < $gamma} {incr idx} {
			set mapArray($idx) $invalidValue
		}

		set idx -1
		foreach nameItem $nameList {
			incr idx

			set mapArray([expr $testExpr($testExprID)]) $idx
		}

		set map "(long\[\])\{"
		for {set idx 0} {$idx < $gamma} {incr idx} {
			append map "$mapArray($idx), "
		}
		set map [string range $map 0 end-2]
		append map "\}\[[subst $testExprC($testExprID)]\]"

		set phfCall $map
	}

	return $phfCall
}

package provide xvfs 1

Added xvfs-test-phf version [97db11b922].



















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
#! /usr/bin/env tclsh

set sourceDirectory [file dirname [file normalize [info script]]]

lappend auto_path [file join $sourceDirectory lib]

package require xvfs

set list {
	main.tcl foo fop gop top fooo lib/hello/hello.tcl lib/hello/pkgIndex.tcl lib/hello lib {}
}

for {set i 0} {$i < 2000} {incr i} {
	lappend list $i
}

for {set idx 0} {$idx < [llength $list]} {incr idx} {
	set subList [lrange $list 0 $idx]
	puts "$idx ($subList):"
	puts [time {
		puts [::xvfs::generatePerfectHashFunctionCall pathName strlen(pathName) -1 $subList triesAtHashSize 1]
	} 1]
	puts ""
}