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
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} {
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 {([zlib adler32 $nameItem $alpha] + $beta) % $gamma}
	set testExprC {((Tcl_ZlibAdler32($alpha, (unsigned char *) $cVarName, $cVarLength) + $beta) % $gamma)}
	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 beta 0
	set gamma $maxVal
	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 $round
		set gamma [expr {($round % ($maxVal + 1)) + $maxVal}]
			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 {
			incr idx
				set idx -1
				set seenIndexes [list]
				set failed false
				foreach nameItem $nameList {

					set testExprVal [expr $testExprContents]

					if {$minimal} {
						incr idx

			set testExprVal [expr $testExpr]

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

			lappend seenIndexes $testExprVal
						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
	}
		unset -nocomplain mapArray
		for {set idx 0} {$idx < $gamma} {incr idx} {
			set mapArray($idx) $invalidValue
		}

	set idx -1
	foreach nameItem $nameList {
		incr idx
		set idx -1
		foreach nameItem $nameList {
			incr idx

		set mapArray([expr $testExpr]) $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]\]"
	set phfCall $map
		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 ""
}