Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.02.07;
Скачать: [xml.tar.bz2];

Вниз

Количество значений в наборе   Найти похожие ветки 

 
vlv   (2002-01-21 21:07) [0]

Как узнать количество значений в наборе?

type
TMyAction = (caPlus, caMinus, caDiv, caMul);
TMyActions = set of TMyAction;

//...
var A:TMyActions;

Так вот, надо узнать количество значений в A


 
AlexR_R   (2002-01-21 22:02) [1]

Единственно, что пришло в голову

procedure TForm2.Button3Click(Sender: TObject);
var act_cur, act_from : TMyAction;
i, j, MaxCount : integer;
begin
A := [caPlus, caDiv];
MaxCount := 4; //Полное количество в наборе
act_cur := TMyAction(0);
act_from := act_cur;
i := 0;
for j := 0 to MaxCount - 1 do begin
if act_cur in A then inc(i);
inc(act_cur);
end;
Label1.Caption := intToStr(i);
end;


Но для этого надо знать полное количество элементов в наборе
А вот как его определить, что-то в голову сразу не приходит


 
Anatoly Podgoretsky   (2002-01-21 22:20) [2]

i := 0;
for j := Low(TMyAction) to High(TMyAction) do if J in A then i := i + 1;


 
Alx2   (2002-01-22 09:06) [3]

Еще вариант. :)
Мне кажется, он будет быстрее, но, правда, еще не проверял. Хотя речь идет не о скорости, но все же...
Идея проста. Множество в Object Pascal представляет собой битовую маску размером 32 байта. Каждый n-й бит - признак присутсвия n-го элемента во множестве. Таким образом просто считаем количество установленных бит во множестве.

function PowerOfSet(const aSet):byte;
Var
SetMap : packed array [1..32] of byte absolute aSet;
Const bitTable : array[0..255] of integer =
( 0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,
4,3,4,4,5,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,
5,3,4,4,5,4,5,5,6,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,
4,3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,
6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,1,2,2,3,2,3,3,4,2,3,3,
4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,
5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,2,3,3,
4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,
7,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,
7,6,7,7,8);

Var k : integer;
begin
Result := 0;
for k := 1 to 32 do
inc(Result, bitTable[SetMap[k]]);
end;

Небольшая ремарка: параметр в PowerOfSet должен иметь "множественный тип", хотя никто не запрещает передавать все, что угодно, но что при этом получится :)).


 
Alx2   (2002-01-22 09:20) [4]

В догонку: этот пример работает только для 32-байтных множеств :(( Так что сорри. Опять поторопился.


 
Alx2   (2002-01-22 09:24) [5]

А вот теперь - для любых множеств:)


function PowerOfSet(const aSet; MaxSize : integer):byte;
Var
SetMap : packed array [1..32] of byte absolute aSet;
Const bitTable : array[0..255] of integer =
( 0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,
4,3,4,4,5,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,
5,3,4,4,5,4,5,5,6,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,
4,3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,
6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,1,2,2,3,2,3,3,4,2,3,3,
4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,2,3,3,4,3,4,4,
5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,2,3,3,
4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,
7,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,
7,6,7,7,8);

Var k : integer;
begin
Result := 0;
for k := 1 to MaxSize do
inc(Result, bitTable[SetMap[k]]);
end;

Type
TSet = set of (caPlus, caMinus, caDiv, caMul);
Var S : TSet;
begin
S := [caPlus, caMul];
// Пример вызова.
Label1.Caption := "Кол-во элементов = "+IntToStr(PowerOfSet(S, sizeOf(S))); //2
end;



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.02.07;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.005 c
1-18825
vrRaven
2002-01-25 16:15
2002.02.07
Проблема с Copy()


6-18925
Leha2000
2001-11-13 10:43
2002.02.07
Проблемы при продолжительном подключении клиента к серверу


3-18724
Tadi
2002-01-08 15:22
2002.02.07
Здравствуйте Мастера! Помогите-- TIBQuery - update...... Update Failed?


1-18858
Shadow77
2002-01-21 09:33
2002.02.07
Где-бы взять прозрачный календарь?


1-18872
AndrewK
2002-01-23 09:54
2002.02.07
Как правильно создать и уничтожить форму





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский