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

Вниз

Задачка для начинающих   Найти похожие ветки 

 
Digitman   (2002-04-17 13:38) [0]

Имеется :
- матрица N x N (квадратная), в узлах которой расположены в случайном порядке boolean-значения; для простоты положим, что 2 <= N <= 65535;

- считается, что некий столбец (1) матрицы "покрывается" неким столбцом (2) той же матрицы, если упорядоченное по строкам множество значений столбца (1), равных TRUE, является подмножеством упорядоченного по строкам множества значений столбца (2), равных TRUE.

Задача :

Преобразовать исходную матрицу, исключив из нее столбцы, удовлетворяющие условиям "покрываемости". Иными словами, результирующая матрица должна состоять только из столбцов с неповторяющимися множествами построчно упорядоченных значений узлов в этих столбцах.

Пример :

исх.матрица 3 x 3 (N = 3):

| T F F |
| F F T |
| T T F |

результирующая матрица 3 x 2 (средний столбец "покрывается"):

| T F |
| F T |
| T F |


 
evgeg   (2002-04-17 13:53) [1]

В данной постановке задачи третий столбец тоже покрывается первым.
Упорядоченное по строкам множество значений T первого столбца: {T, T}
Упорядоченное по строкам множество значений T третьего столбца: {T}.
{T} является подмножеством T.

Решение задачи: массив a(N) заполняем колиствами эл-в в столцах. Находим i= arg max(a(i)). Столбец i оставляем. Остоальные выкидываем.

Если вы имели в виду что-то другое, скорректируйте условие.


 
Mystic   (2002-04-17 14:05) [2]

> evgeg ©

Насколько я понял, речь идет о множестве индексов. Имеем, для первого столбца {1,3}, для второго {3}, для третьего {2}. Поскольку {3} \in {1,3}, то второй столбец отбрасывается.


> Модератор

Может начать создавать базу задачек для начинающих?


 
Виктор Щербаков   (2002-04-17 14:14) [3]

Вот еще.
Найти цепочку двузначных чисел.
Каждое число получается из предыдущего путём замены первой или второй цифры на сумму цифр числа. Если эта сумма больше 10, то берется остаток от деления на 10. Первое и последнее число цепочки дано. Найти самую короткую из возможных цепочек или сказать, что такая цепочка не существует.

Например дано:
22, 46
Ответ
22 -> 42 -> 46



 
evgeg   (2002-04-17 14:45) [4]

> Виктор Щербаков

Если эта сумма больше 10

Видимо, следует читать больше или равно 10.

Ответ: Первое и посл. число цепочки -- любое двухначное число, оканчивающиеся на 0 (заменяем первую цифру на нее же), пример
50->50.



 
Digitman   (2002-04-17 14:48) [5]

>evgeg

Ну, где же покрывается -то ?

<Mystic> прав : ты под "значениями" почему-то рассматриваешь только TRUE, а куда, спрашивается, FALSE в том же столбце делись ?

Вообще-то желательно привести наиболее компактный и эффективный код, реализующий задачку)


 
Виктор Щербаков   (2002-04-17 14:51) [6]

evgeg © (17.04.02 14:45)

> Видимо, следует читать больше или равно 10.

Да, совершенно верно.

> Ответ: Первое и посл. число цепочки -- любое двухначное
> число, оканчивающиеся на 0 (заменяем первую цифру на нее
> же), пример
> 50->50.


Нет. Имелось ввиду не это. Задачка-то по программированию. То есть входные данные - первое и последнее число. Выходные - цепочка. И вот если из первого числа можно получить последнее не одним способом, то следует выдать самый короткий вариант.


 
evgeg   (2002-04-17 15:05) [7]

> Digitman

упорядоченное по строкам множество значений столбца (1), равных TRUE

т. е. множество состоит только из значений, равных True.

Впрочем, Mistic уже пояснил. Только желательно все таки сразу формулировать задачу предельно четко.


 
evgeg   (2002-04-17 15:06) [8]

> Виктор Щербаков

Да, я проглядел.


 
evgeg   (2002-04-17 15:16) [9]

цепочек получается 90*90=8100 штук. Для хранения эл-та цеп-ки дост-но байта. Пусть все они будут содержать даже по 100 эл. Пол-ся 810000 b = 791 Kb (на самом деле будет гораздо меньше). Т.е. можно рассчитать их все зараннее один раз и потом просто брать из готовой таблицы. Для рассчета можно использовать неэффективный рекурсивный метод.


 
Digitman   (2002-04-17 15:22) [10]

>evgeg

Согласен - не очень четко сформулировал.
Индексная формулировка здесь более подходящая.


 
troits   (2002-04-17 15:24) [11]

Вариант (код писать неохота):
Сравниваем каждый столбец со всеми, причем критерий "покрываемости" столбца(A покрывает B) : A and B = B


 
Alx2   (2002-04-18 09:51) [12]

>Виктор Щербаков © (17.04.02 14:14)
>Вот еще.
>Найти цепочку двузначных чисел.

Числа из одной цифры считаем двузначным (например 5 в такой записи = 05)
"В лоб" вот что вышло:

Procedure TForm1.Button1Click(Sender: TObject);
Type TByteArray = Array[0..99] Of Byte;
Const f1: TByteArray = ( // Таблица значений при замене первой
//цифры модулем по 10 суммы составляющих цифр
0, 11, 22, 33, 44, 55, 66, 77, 88, 99,
10, 21, 32, 43, 54, 65, 76, 87, 98, 9,
20, 31, 42, 53, 64, 75, 86, 97, 8, 19,
30, 41, 52, 63, 74, 85, 96, 7, 18, 29,
40, 51, 62, 73, 84, 95, 6, 17, 28, 39,
50, 61, 72, 83, 94, 5, 16, 27, 38, 49,
60, 71, 82, 93, 4, 15, 26, 37, 48, 59,
70, 81, 92, 3, 14, 25, 36, 47, 58, 69,
80, 91, 2, 13, 24, 35, 46, 57, 68, 79,
90, 1, 12, 23, 34, 45, 56, 67, 78, 89);
f2: TByteArray = (// Таблица значений при замене второй цифры
//модулем по 10 суммы составляющих цифр

0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
11, 12, 13, 14, 15, 16, 17, 18, 19, 10,
22, 23, 24, 25, 26, 27, 28, 29, 20, 21,
33, 34, 35, 36, 37, 38, 39, 30, 31, 32,
44, 45, 46, 47, 48, 49, 40, 41, 42, 43,
55, 56, 57, 58, 59, 50, 51, 52, 53, 54,
66, 67, 68, 69, 60, 61, 62, 63, 64, 65,
77, 78, 79, 70, 71, 72, 73, 74, 75, 76,
88, 89, 80, 81, 82, 83, 84, 85, 86, 87,
99, 90, 91, 92, 93, 94, 95, 96, 97, 98);
Var
CheckArray, ResultArray, WorkArray: TByteArray;
Start, Stop : Byte;
CountSteps : Integer;
MinCountSteps : Integer;
Function Search(cVal: Byte): Boolean;
Begin
inc(CountSteps); // Количество шагов ++
WorkArray[CountSteps] := cVal; // Добавляем очередное
Result := (cVal = Stop); // Нашли ли искомое?
If Result Then // Ага, нашли!
Begin
If MinCountSteps > CountSteps Then // Если затрачено меньше шагов, чем раньше,
Begin
MinCountSteps := CountSteps;
ResultArray := WorkArray; // то запоминаем достижение
End;
End;
If CheckArray[cVal] = 0 Then // Если очередное число в цепочке не рассматривали,
Begin
CheckArray[cVal] := 1; // то запомним его, чтобы не зациклиться
Result := Search(f1[cVal]) Or Search(f2[cVal]); // Истина где-то рядом :)
CheckArray[cVal] := 0; // снимаем запомненное число для будущего использования
End;
dec(CountSteps); // Возвращаемся...
End;
Var K: Integer;
Begin
fillchar(CheckArray, sizeof(CheckArray), 0);
CountSteps := 0;
MinCountSteps := Maxint;
Start := 22; // Первое число в цепочке
Stop := 46; // Последнее число в цепочке
Search(Start);
Memo1.Lines.Clear;
For K := 2 To MinCountSteps Do
Memo2.Lines.Add(IntToStr(ResultArray[K - 1]) + "->" + IntToStr(ResultArray[K]));
End;

MinCountSteps-1 = минимальное количество шагов.


 
Alx2   (2002-04-18 09:56) [13]

Как всегда забыл слона.. :(
Для корректной работы в случае несуществования искомой цепочки нужно вместо

For K := 2 To MinCountSteps Do
Memo2.Lines.Add(IntToStr(ResultArray[K - 1]) + "->" + IntToStr(ResultArray[K]));

написать

if MinCountSteps<maxint then
For K := 2 To MinCountSteps Do
Memo1.Lines.Add(IntToStr(ResultArray[K - 1]) + "->" + IntToStr(ResultArray[K]))
else
Memo1.Lines.Add("Нет таких цепочек!");



 
Alx2   (2002-04-18 10:01) [14]

Ребята, простите. В коде ошибка. :(
Сейчас поправлю


 
igorr   (2002-04-18 10:07) [15]

>Digitman © (17.04.02 14:48)
>Вообще-то желательно привести наиболее компактный и эффективный код, реализующий задачку

Может так пойдет?


type
TForm1 = class(TForm)
Memo1: TMemo;
bbDeleteCover: TButton;
bbGetMatrix: TButton;
procedure bbGetMatrixClick(Sender: TObject);
procedure bbDeleteCoverClick(Sender: TObject);
procedure MatrixOut;
private

public

end;
TMatrix=array of array of Boolean;

var
Form1: TForm1;
Matrix:TMatrix;
Mi,Mj:Integer;

implementation

{$R *.DFM}

procedure TForm1.MatrixOut;
var
MatrixSell,MatrixLine:String;
i,j:Integer;
begin
for i:=0 to Mi-1 do begin
MatrixLine:=IntToStr(i+1)+" ";
for j:=0 to Mj-1 do begin
if Matrix[i,j] then MatrixSell:=" True"
else MatrixSell:=" False";
MatrixLine:=MatrixLine+MatrixSell;
end;
Memo1.Lines.Add(MatrixLine);
end;
Memo1.Lines.Add("");
end;

procedure TForm1.bbGetMatrixClick(Sender: TObject);
var
i,j:Integer;
begin
Mi:=StrToInt(InputBox("Matrix","Input i",""));
Mj:=StrToInt(InputBox("Matrix","Input j",""));
SetLength(Matrix,Mi,Mj);
Randomize;
for i:=0 to Mi-1 do
for j:=0 to Mj-1 do Matrix[i,j]:=1=Random(2);
Memo1.Clear;
MatrixOut;
Form1.Tag:=1; {Matrix not empty}
end;

procedure TForm1.bbDeleteCoverClick(Sender: TObject);
var
Checkj,i,ii,j:Integer;
begin
if Form1.Tag=1 then begin
j:=0;
Checkj:=0;
while Checkj<Mj-1 do begin
Inc(Checkj);
for i:=0 to Mi-1 do
if Matrix[i,j]<Matrix[i,Checkj] then begin
for ii:=0 to Mi-1 do Matrix[ii,j+1]:=Matrix[ii,Checkj];
Inc(j);
Continue;
end;
end;
Mj:=j+1;
SetLength(Matrix,Mi,Mj);
MatrixOut;
end;
end;

end.


 
Alx2   (2002-04-18 10:14) [16]

Готово, исправил - работает полностью :)


Procedure TForm1.Button1Click(Sender: TObject);
Type TByteArray = Array[0..99] Of Byte;
Const f1: TByteArray = (
0, 11, 22, 33, 44, 55, 66, 77, 88, 99,
10, 21, 32, 43, 54, 65, 76, 87, 98, 9,
20, 31, 42, 53, 64, 75, 86, 97, 8, 19,
30, 41, 52, 63, 74, 85, 96, 7, 18, 29,
40, 51, 62, 73, 84, 95, 6, 17, 28, 39,
50, 61, 72, 83, 94, 5, 16, 27, 38, 49,
60, 71, 82, 93, 4, 15, 26, 37, 48, 59,
70, 81, 92, 3, 14, 25, 36, 47, 58, 69,
80, 91, 2, 13, 24, 35, 46, 57, 68, 79,
90, 1, 12, 23, 34, 45, 56, 67, 78, 89);
f2: TByteArray = (
0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
11, 12, 13, 14, 15, 16, 17, 18, 19, 10,
22, 23, 24, 25, 26, 27, 28, 29, 20, 21,
33, 34, 35, 36, 37, 38, 39, 30, 31, 32,
44, 45, 46, 47, 48, 49, 40, 41, 42, 43,
55, 56, 57, 58, 59, 50, 51, 52, 53, 54,
66, 67, 68, 69, 60, 61, 62, 63, 64, 65,
77, 78, 79, 70, 71, 72, 73, 74, 75, 76,
88, 89, 80, 81, 82, 83, 84, 85, 86, 87,
99, 90, 91, 92, 93, 94, 95, 96, 97, 98);
Var
CheckArray, ResultArray, WorkArray: TByteArray;
Start, Stop : Byte;
CountSteps : Integer;
MinCountSteps : Integer;
Function Search(cVal: Byte): Boolean;
Begin
If CountSteps >= MinCountSteps Then // Если у нас есть решение получше, то зачем тратить время на это?
Begin
Result := False;
exit;
End;
inc(CountSteps);
WorkArray[CountSteps] := cVal;
Result := (cVal = Stop);
If Result Then
Begin
MinCountSteps := CountSteps;
ResultArray := WorkArray;
End Else
If CheckArray[cVal] = 0 Then
Begin
CheckArray[cVal] := 1;
// Вот это исправление (по сравнению с предыдущим постом) ключевое :)
// Я как-то сначала его и проморгал
{$B+}
Result := Search(f1[cVal]) Or Search(f2[cVal]);
{$B-}
CheckArray[cVal] := 0;
End;
dec(CountSteps);
End;
Var K: Integer;
Begin
fillchar(CheckArray, sizeof(CheckArray), 0);
CountSteps := 0;
MinCountSteps := Maxint;
Start := 1; // Первое в цепочке
Stop := 25; // Последнее в цепочке
Search(Start);
Memo1.Lines.Clear;
If MinCountSteps < Maxint Then
Begin
Memo1.Lines.Add("Кол-во шагов: " + IntToStr(MinCountSteps - 1));
For K := 2 To MinCountSteps Do
Memo1.Lines.Add(IntToStr(ResultArray[K - 1]) + "->" + IntToStr(ResultArray[K]))
End
Else
Memo1.Lines.Add("Нет таких цепочек.");
End;

Остальные комментарии - в предыдущих постах.


 
Виктор Щербаков   (2002-04-18 10:18) [17]

Alx2 ©
Вообще эту задачу мне год назад брат принес (в школе учится). Её предлагали на районной олимпиаде по информатике. Она была самая сложная и, естественно, её никто не решил. Пришлось объяснять ему решение на Turbo Pascal, самым тупым рекурсивным перебором и без таблиц.

Могу еще посмотреть, может осталиьсь задачи с областных олимпиад. Там намного веселее.


 
Digitman   (2002-04-18 11:17) [18]

1 True True True True False
>igorr

Не пойдет.
Вот результаты теста (5 х 5):

Исх.матрица

A B C D E
1 True True True True False
2 True True False False False
3 False True False True False
4 True False True True False
5 False True False True True


Рез.матрица

A B C D
1 True True True True
2 True True False False
3 False True False True
4 True False True True
5 False True False True

Из рез-тов видно, что в рез.матрице, как минимум, столбец A покрывает столбец C, однако столбец C не удален, что не соответствует цели задачи.

Пересмотри алгоритм.


 
igorr   (2002-04-18 16:16) [19]

Не так понял задание.
Ну ладно, тогда так.


type
TForm1 = class(TForm)
Memo1: TMemo;
bbDeleteCover: TButton;
bbGetMatrix: TButton;
procedure bbGetMatrixClick(Sender: TObject);
procedure bbDeleteCoverClick(Sender: TObject);
procedure MatrixOut;
private

public

end;
TMatrix=array of array of Boolean;

var
Form1: TForm1;
Matrix:TMatrix;
Mi,Mj:Integer;

implementation

{$R *.DFM}

procedure TForm1.MatrixOut;
var
MatrixSell,MatrixLine:String;
i,j:Integer;
begin
for i:=0 to Mi-1 do begin
MatrixLine:=IntToStr(i+1)+" ";
for j:=0 to Mj-1 do begin
if Matrix[i,j] then MatrixSell:=" True"
else MatrixSell:=" False";
MatrixLine:=MatrixLine+MatrixSell;
end;
Memo1.Lines.Add(MatrixLine);
end;
Memo1.Lines.Add("");
end;

procedure TForm1.bbGetMatrixClick(Sender: TObject);
var
i,j:Integer;
begin
Mi:=StrToInt(InputBox("Matrix","Input i",""));
Mj:=StrToInt(InputBox("Matrix","Input j",""));
SetLength(Matrix,Mi,Mj);
Randomize;
for i:=0 to Mi-1 do
for j:=0 to Mj-1 do Matrix[i,j]:=1=Random(2);
Memo1.Clear;
MatrixOut;
Form1.Tag:=1; {Matrix not empty}
end;

procedure TForm1.bbDeleteCoverClick(Sender: TObject);
var
Startj,Writej,i,ii,j:Integer;
begin
if Form1.Tag=1 then begin
Startj:=0;
Writej:=Startj+1;

While Startj<Mj-1 do begin
for j:=Startj+1 to Mj-1 do begin
i:=0;
While i<Mi do begin
if Matrix[i,Startj]<Matrix[i,j] then begin
for ii:=0 to Mi-1 do Matrix[ii,Writej]:=Matrix[ii,j];
Inc(Writej);
i:=Mi; {in order to stop cycle}
end;
Inc(i);
end;
end;
Mj:=Writej;
Inc(Startj);
Writej:=Startj+1;
end;

SetLength(Matrix,Mi,Mj);
MatrixOut;
end;
end;

end.



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

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

Наверх





Память: 0.52 MB
Время: 0.006 c
1-88531
kserg@ukr.net
2002-05-16 10:25
2002.05.27
Как подогнать размеры оконной формы ?


14-88603
Дремучий
2002-04-16 22:45
2002.05.27
zip & password....


1-88532
???
2002-05-16 11:53
2002.05.27
Можно ли выделить в exe файле кусок памяти


3-88367
Георгинчик
2002-05-02 14:02
2002.05.27
Подскажите, как ускорить следующую операцию. Копирую изтаблицы


1-88451
Димок
2002-05-17 16:33
2002.05.27
Как изменить раскладку клавиатуры в чужом окне?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский