Compiler Explorer

Source code

{$mode objfpc} {$longstrings on} {$modeswitch advancedrecords}
{$rangechecks off} {$overflowchecks off}
program app;

type
	pVec3u8 = ^Vec3u8;
	Vec3u8 = record
		v: array[0 .. 2] of uint8;
		class function Make(x, y, z: uint8): Vec3u8; static;
		class operator =(const a, b: Vec3u8): boolean;
	end;

class function Vec3u8.Make(x, y, z: uint8): Vec3u8;
	begin
		result.v[0] := x; result.v[1] := y; result.v[2] := z;
	end;

class operator Vec3u8.=(const a, b: Vec3u8): boolean;
	begin
		// Это предполагает, что цвета можно перечитать на 1 дополнительный байт. К аллокациям добавляется OverReadColors.
		result := (unaligned(pUint32(@a)^) xor unaligned(pUint32(@b)^)) {$ifdef endian_big} shr 8 {$else} and $FFFFFF {$endif} = 0;
	end;

const
	OverReadColors = 1;

type
	// Методы для работы с массивами, разделёнными на блоки логарифмического размера.
	ChunkedArray = record
	const
		StartingChunkSizeLog2 = 5;
		StartingChunkSize = 1 shl StartingChunkSizeLog2; // Блоки начинаются с размера 32, каждый последующий удваивается.
		MaxChunks = bitsizeof(SizeUint) - StartingChunkSizeLog2; // Максимальное количество блоков в массиве.

// Количество элементов в iChunk-м блоке.
		class function ChunkSize(iChunk: SizeUint): SizeUint; static; inline;

// Количество элементов в массиве с nChunks блоками.
		class function FullSize(nChunks: SizeUint): SizeUint; static; inline;

type
		IndicesPair = record
			chunkIndex, indexInChunk: SizeUint;
		end;

// Превращает глобальный индекс в пару (индекс блока, индекс в блоке).
		// DecomposeGlobalIndex(30) = (0, 30)
		// DecomposeGlobalIndex(31) = (0, 31)
		// DecomposeGlobalIndex(32) = (1, 0)
		// DecomposeGlobalIndex(33) = (1, 1)
		// ...
		// DecomposeGlobalIndex(95) = (1, 62)
		// DecomposeGlobalIndex(95) = (1, 63)
		// DecomposeGlobalIndex(96) = (2, 0), и т. д.
		class function DecomposeGlobalIndex(iGlobal: SizeUint): IndicesPair; static;
	end;

class function ChunkedArray.ChunkSize(iChunk: SizeUint): SizeUint;
	begin
		result := 1 shl (StartingChunkSizeLog2 + iChunk);
	end;

class function ChunkedArray.FullSize(nChunks: SizeUint): SizeUint;
	begin
		// Число элементов, умещающееся в:
		// 1 блок:     %100000 (32)
		// 2 блока:   %1100000 (32 + 64 = 96)
		// 3 блока:  %11100000 (32 + 64 + 128 = 224)
		// 4 блока: %111100000 (32 + 64 + 128 + 256 = 480), и так далее.
		result := 1 shl (StartingChunkSizeLog2 + nChunks) - StartingChunkSize;
	end;

class function ChunkedArray.DecomposeGlobalIndex(iGlobal: SizeUint): IndicesPair;
	var
		iChunk, nBefore: SizeUint;
	begin
		// Номер блока iGlobal-го элемента — либо ⌊log₂(max(32, iGlobal))⌋ − 5, либо на 1 больше.
		iChunk := {$if sizeof(SizeUint) = sizeof(uint64)} BsrQWord {$elseif sizeof(SizeUint) = sizeof(uint32)} BsrDWord {$else} {$error} {$endif}
			(iGlobal or StartingChunkSize); // Значение iChunk сдвинуто на 5 (StartingChunkSizeLog2) относительно возвращаемого, так удобнее для расчётов.

// В моменте это количество элементов, умещающееся в (1 + iChunk)(-5) блоков.
		nBefore := 1 shl (iChunk + 1) - StartingChunkSize;

if iGlobal >= nBefore then
			// Значение nBefore корректно для своего названия, а iChunk должен быть на 1 больше.
			// Например, для iGlobal = 50 изначально вычисляется iChunk = 0(+5) и nBefore = 32, а нужно вернуть (chunkIndex = 1, indexInChunk = 50 - 32).
			iChunk += 1
		else
			// iChunk корректен, а вот значение nBefore завышено на 1 шаг для своего названия.
			// Например, для iGlobal = 70 изначально вычисляется iChunk = 1(+5) и nBefore = 96, а нужно вернуть (chunkIndex = 1, indexInChunk = 70 - 32).
			nBefore := nBefore shr 1 and SizeUint(-StartingChunkSize);
		result.chunkIndex := iChunk - StartingChunkSizeLog2;
		result.indexInChunk := iGlobal - nBefore;
	end;

type
	ColorMap = record
		procedure Add(const color: Vec3u8);
	private
		indices: array[0 .. ChunkedArray.MaxChunks] of pInt32;
		colors: array[0 .. ChunkedArray.MaxChunks] of pVec3u8;
		_nColors, maxColors, nIndices: uint32;
		procedure GrowAndReAdd(const color: Vec3u8);
		procedure ReAddItems;
		class operator Initialize(var self: ColorMap);
		class operator Finalize(var self: ColorMap);
	public
		property nColors: uint32 read _nColors;
	end;

function HashUint32(x: uint32): uint32;
	begin
		x := (x xor x shr 16) * $21f0aaad;
		x := (x xor x shr 15) * $d35a2d97;
		result := x xor x shr 15;
	end;

procedure ColorMap.Add(const color: Vec3u8);
	var
		h, hRest, iIndex: SizeUint;
		indexPtr: pInt32;
		dec: ChunkedArray.IndicesPair;
	begin
		h := HashUint32(unaligned(pUint32(@color)^) {$ifdef endian_big} shr 8 {$else} and $FFFFFF {$endif});
		hRest := h;
		iIndex := h mod nIndices;
		repeat
			dec := ChunkedArray.DecomposeGlobalIndex(iIndex);
			indexPtr := @indices[dec.chunkIndex][dec.indexInChunk];
			if indexPtr^ < 0 then
				break;
			dec := ChunkedArray.DecomposeGlobalIndex(indexPtr^);
			if color = colors[dec.chunkIndex][dec.indexInChunk] then
				exit;
			hRest := hRest shr 5;
			iIndex := (iIndex + 1 + hRest) mod nIndices;
		until false;

if nColors < maxColors then
		begin
			dec := ChunkedArray.DecomposeGlobalIndex(nColors);
			colors[dec.chunkIndex][dec.indexInChunk] := color;
			indexPtr^ := nColors;
			_nColors += 1;
			exit;
		end;
		GrowAndReAdd(color);
	end;

procedure ColorMap.GrowAndReAdd(const color: Vec3u8);
	const
		Limit = 256 * 256 * 256;
	var
		iNewChunk, allocColors, reqIndexChunks: SizeUint;
	begin
		// Добавить новый блок colors. Суммарно не более Limit.
		iNewChunk := ChunkedArray.DecomposeGlobalIndex(maxColors).chunkIndex;
		allocColors := ChunkedArray.ChunkSize(iNewChunk);
		if allocColors > Limit - maxColors then
			allocColors := Limit - maxColors;
		colors[iNewChunk] := nil; // Метки на случай провала GetMem, см. Finalize.
		colors[iNewChunk + 1] := nil;
		colors[iNewChunk] := GetMem(sizeof(colors[0]^) * allocColors + OverReadColors);
		maxColors += allocColors;

// Добавить новый блок indices (а то и не один) (осторожно с пустой таблицей с фейковым indices[0]).
		if nIndices <= 1 then nIndices := 0;
		iNewChunk := ChunkedArray.DecomposeGlobalIndex(self.nIndices).chunkIndex;
		reqIndexChunks := ChunkedArray.DecomposeGlobalIndex(maxColors - 1).chunkIndex;
		while ChunkedArray.FullSize(reqIndexChunks) < maxColors + maxColors div 2 do
			reqIndexChunks += 1;
		while iNewChunk < reqIndexChunks do
		begin
			indices[iNewChunk] := nil;
			indices[iNewChunk + 1] := nil;
			indices[iNewChunk] := GetMem(sizeof(indices[0]^) * ChunkedArray.ChunkSize(iNewChunk));
			nIndices += ChunkedArray.ChunkSize(iNewChunk);
			iNewChunk += 1;
		end;
		ReAddItems;
		Add(color);
	end;

procedure ColorMap.ReAddItems;
	var
		iChunk, iIndex, hRest: SizeUint;
		iItem: SizeInt;
		indexPtr: pInt32;
		dec: ChunkedArray.IndicesPair;
	begin
		// Очистить все индексы.
		for iChunk := 0 to ChunkedArray.DecomposeGlobalIndex(nIndices - 1).chunkIndex do
			FillChar(indices[iChunk]^, ChunkedArray.ChunkSize(iChunk) * sizeof(indices[iChunk]^), uint8(-1));

// Передобавить существующие элементы.
		for iItem := 0 to SizeInt(nColors) - 1 do
		begin
			dec := ChunkedArray.DecomposeGlobalIndex(iItem);
			hRest := HashUint32(unaligned(pUint32(@colors[dec.chunkIndex][dec.indexInChunk])^) {$ifdef endian_big} shr 8 {$else} and $FFFFFF {$endif});
			iIndex := hRest mod nIndices;
			repeat
				dec := ChunkedArray.DecomposeGlobalIndex(iIndex);
				indexPtr := @indices[dec.chunkIndex][dec.indexInChunk];
				if indexPtr^ < 0 then
					break;
				hRest := hRest shr 5;
				iIndex := (iIndex + 1 + hRest) mod nIndices;
			until false;
			indexPtr^ := iItem;
		end;
	end;

class operator ColorMap.Initialize(var self: ColorMap);
	const
		DummyIndices: int32 = (-1);
	begin
		self.indices[0] := @DummyIndices;
		self.colors[0] := nil;
		self._nColors := 0;
		self.maxColors := 0;
		self.nIndices := 1;
	end;

class operator ColorMap.Finalize(var self: ColorMap);
	var
		i: SizeInt;
	begin
		for i := 0 to ChunkedArray.MaxChunks - 1 do
			if Assigned(self.colors[i]) then FreeMem(self.colors[i]) else break;
		if self.nIndices > 1 then
			for i := 0 to ChunkedArray.MaxChunks - 1 do
				if Assigned(self.indices[i]) then FreeMem(self.indices[i]) else break;
	end;

var
	i: SizeInt;
	cm: ColorMap;

begin
	RandSeed := 0;
	for i := 0 to 16777215 do
		cm.Add(Vec3u8.Make(random(256), random(256), random(256)));
	writeln('Добавлено 16777216 случайных цветов.');
	writeln('Уникальных цветов: ', cm.nColors, '.');
	writeln('Для сравнения, 16777216 * (1 - 1/e) = ', 16777216 * (1 - 1 / exp(1)):0:0, '.');
end.