Program lists;
function readFile(src: string; var matrix: List<List<integer>>): List<integer>;
var SourceFile: TextFile;
i: integer; // i - для хранения итерации цикла
line: string; // строка из файла
begin
if fileExists(src) then begin
assignfile(SourceFile, src);
reset(SourceFile);
matrix := new List<List<integer>>;
result := new List<integer>; // результирующий список, где 0 - v, 1 - k
while not eof(SourceFile) do begin
readln(SourceFile, line);
if(i = 0) then begin
foreach var val in line.Split(' ').ToList() do begin
result.Add(val.ToInteger());
end;
end else begin
matrix.Add(new List<integer>);
foreach var val in line.Split(' ').ToList() do begin
matrix[i - 1].Add(val.ToInteger());
end;
end;
inc(i);
end;
closefile(SourceFile);
end else begin
writeln('Не удалось открыть файл ', src, '. Возможно он не существует.');
exit;
end;
end;
procedure writeFile(src, val: string);
var
SourceFile: TextFile;
begin
assign(SourceFile, src);
rewrite(SourceFile);
writeln(SourceFile, val);
close(SourceFile);
end;
function findL1(Ie: List<integer>; Q: List<List<integer>>): integer;
var res, sum, max, key: integer;
tempList: List<integer>;
begin
for var j := 0 to Q.Count - 1 do begin
if(Ie.Contains(j)) then begin
sum := 0;
for var i := 0 to Q[0].Count - 1 do begin
tempList := new List<integer>;
for var k := 0 to Q[0].Count - 1 do begin
tempList.Add(Q[j][k]);
end;
tempList.Remove(j);
if(Q[j][i] = 1) and (tempList.Count > 0) then begin
inc(sum);
end;
tempList.Clear();
end;
if(sum >= max) then begin
max := sum;
key := j;
end;
//writeln(j, '=>', sum);
end;
end;
result := key;
end;
function calculateL2(L2List: List<integer>; index: integer; block: List<integer>; Q: List<List<integer>>): integer;
var res: integer;
begin
res := 0;
for var j := 0 to Q[0].Count - 1 do begin
var tempList := new List<integer>;
if(L2List.Contains(j)) then begin
for var i := 0 to Q.Count - 1 do begin
tempList.Add(Q[i][j]);
end;
foreach var e in block do begin
tempList[e] := 0;
end;
tempList[index] := 0;
if(tempList.Contains(1)) then begin
res := res + 1;
end;
end;
end;
result := res;
end;
function findL2(Ie, block: List<integer>; Q: List<List<integer>>): List<integer>;
var l2: integer;
begin
result := new List<integer>;
for var i := 0 to Q.Count - 1 do begin
result.Add(MaxInt);
end;
for var j := 0 to Q.Count - 1 do begin
if(Ie.Contains(j)) then begin
var vList := new List<integer>;
for var i := 0 to Q[0].Count - 1 do begin
if(Q[block[0]][i] = 1) then begin
vList.Add(i);
end;
if(Q[j][i] = 1) and (not vList.Contains(i)) then begin
vList.Add(i);
end;
end;
l2 := calculateL2(vList, j, block, Q);
writeln('L2 => v(', block, ',[', j, ']) = ', vList, ' => ', l2);
if(l2 <= 6) then begin
result[j] := l2;
end;
end;
end;
end;
function calculateL3(vList: List<integer>; block: integer; Q: List<List<integer>>): integer;
begin
result := 0;
foreach var val in vList do begin
if(Q[block][val] = 1) then begin
inc(result);
end;
end;
end;
function findL3(Ie, block: List<integer>; Q: List<List<integer>>): List<integer>;
var res, l3: integer;
begin
result := new List<integer>;
for var i := 0 to Q.Count - 1 do begin
result.Add(0);
end;
for var j := 0 to Q.Count - 1 do begin
if(Ie.Contains(j)) then begin
var vList := new List<integer>;
for var i := 0 to Q[0].Count - 1 do begin
if(Q[j][i] = 1) then begin
vList.Add(i);
end;
end;
l3 := calculateL3(vList, block[0], Q);
writeln('L3 => v(', j, ') = ', vList, ' => ', l3);
result[j] := l3;
end;
end;
end;
var Q, blocks: List<List<integer>>;
k, v, count, current, key: integer;
choose, save: char;
src, res: string; // src - название файла, res - результат выполнения программы (для вывода в консоль и запись в файл) это все строчный тип данных
Limits, Ie, L2, L3: List<integer>;
begin
writeln('1 - ввод из файла, 2 - ручной ввод');
readln(choose);
if(choose = '1') then begin
writeln('Введите путь до файла с матрицей:');
readln(src);
Limits := readFile(src, Q);
k := Limits[0];
v := Limits[1];
end else begin
end;
Ie := new List<integer>; // список нераспределенных элементов
for var i := 1 to Q.Count - 1 do begin
Ie.Add(i); // добавляем в него все элементы, кроме 0, т.к. он по умолчанию распределен
end;
count := round((Q.Count - 1) / k);
{
Количество блоков, исходя из того, что задано условие k на количество элементов в блоке, а также есть размерность матрицы (n (кол-во строк))
n - 1 из-за того, что первая строка матрицы описывает разъем
round() - функция для округления в большую сторону, например, если число элементов в блоке = 3, а число элементов 8 (где 1 из них - контактная площадка):
(8 - 1) / 3 = 2,333. 0,333 - означает, что элемент не влез в два блока, для него нужен третий блок.
round((8 - 1) / 3) = 3.
Получаем размерность списка, хранящего блоки:
}
writeln('Количество элементов в блоке: ', k);
writeln('Количество связей в блоке: ', v);
blocks := new List<List<integer>>;
for var i := 0 to count - 1 do begin
blocks.Add(new List<integer>);
end;
{
writeln('Q matrix:');
for var i := 0 to n - 1 do begin
writeln(Q[i]);
end;
}
repeat begin
{L1}
key := findL1(Ie, Q);
writeln('В результате расчета оценки L1 элемент e', key, ' будет помещен в блок - ', current);
blocks[current].Add(key);
Ie.Remove(key);
{/L1}
{L2 + L3}
repeat begin
L2 := findL2(Ie, blocks[current], Q);
L3 := findL3(Ie, blocks[current], Q);
if(L3.Where(val -> val = L3.Max()).Count < 2) then begin
key := L3.LastIndexMax;
end else begin
key := L2.LastIndexMin;
end;
writeln('В результате расчета оценки L2/L3 элемент e', key, ' будет помещен в блок - ', current);
blocks[current].Add(key);
Ie.Remove(key);
end until blocks[current].Count = k;
inc(current);
end until Ie.Count = 0;
res := 'Итоговое распределение: ' + #10;
for var i := 0 to count - 1 do begin
res += 'b' + (i + 1) + '{';
for var j := 0 to blocks[i].Count - 1 do begin
res += 'e' + blocks[i][j];
if(j <> blocks[i].Count - 1) then begin
res += ',';
end;
end;
res += '}' + #10;
end;
writeln(res);
writeln('Вы хотите сохранить результат работы программы в файл? y/n');
readln(choose);
if(choose = 'y') then begin
writeFile('output.txt', res);
end;
end.