IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> ЦИКЛ В ЦИКЛЕ
ipconnect
сообщение 20.04.2015 8:28
Сообщение #1





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Столкнулся с проблемой такого порядка. Как ни крутил, решить оптимально не получается. Требуется мозговой штурм коллективного разума. Задача выглядит следующим образом.

Имеется одномерный массив с N ячейками. Необходимо, казалось бы, просто сделать следующее. По заданному максимальному взятому для использования количеству ячеек M (<=N), начинающихся с первой от начала массива, необходимо менять значения в них следующим образом. Объяснить могу только на примере.
Т.е. в начале необходимо взять две первые ячейки. Изначально в первую записать 1, во вторую - на единицу больше. Затем надо менять значение во второй ячейке до некоторого числа K (к примеру, 30)...
Выглядит это так
1 2
1 3
...
1 30
Будут образовываться пары чисел, которые нужно потом будет сохранить. Но это уже к делу не относится. Тут бы сделать основное. Далее, когда значение во второй ячейке достигнет К, надо значение в первой ячейке увеличить на 1. И повторить цикл заново. Т.е.
2 3
2 4
...
2 30 и т.д. До того момента пока последняя пара будет К-1 К (в примере 29 30).
Далее необходимо включить в цикл третью ячейку. И сделать тот же самый цикл по тем же самым критериям изменений. Т.е. изначально это 1 2 3, потом 1 2 4 ... вплоть до К-2 К-1 К (28 29 30). Итак пока мы не заполним все три ячейки таким перебором. Потом четыре ячейки и т.д.
Перебор из M ячеек закончится тогда, когда последним набором чисел будет
K-M+1 K-M ... K-2 K-1 K

Думал, что просто. Справлюсь на раз-два-три. Оказалось не всё так просто, как кажется. Задача имеет практическое значение, поэтому бросить не могу. Нужно решить. Сам не в состоянии. Впервые попал в ступор при решении подобных задач. Помогите выбраться из тупика.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Федосеев Павел
сообщение 20.04.2015 12:06
Сообщение #2


Бывалый
***

Группа: Пользователи
Сообщений: 298
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  8  +


Оно?
program Counter30;

const
M = 5;
K = 10;
type
TArray = array [0..M - 1] of integer;

procedure ShowArray(const a: TArray);
var
i: integer;
begin
for i := 0 to M - 1 do
Write(a[i]: 3);
writeln;
end;

var
a: TArray;
i, j, n: integer;
begin
for i := 0 to M - 1 do
a[i] := 0;
a[0] := 1;
a[1] := 1;
i := 1;
while a[M - 1] <> K do
begin
Inc(a[i]);
if a[i] > K then
begin
a[i] := a[i - 1] + 1 + 1;
{перенос}
for j := i - 1 downto 0 do
begin
Inc(a[j]);
if (a[j] <= K - j - i) then
begin
for n := j + 1 to i do
a[n] := a[n - 1] + 1;
break;
end
else
if j = 0 then
begin
Inc(i);
a[0] := 1;
for n := j + 1 to i do
a[n] := a[n - 1] + 1;
end;
end;
end;
ShowArray(a);
end;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ipconnect
сообщение 20.04.2015 21:53
Сообщение #3





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Цитата(Федосеев Павел @ 20.04.2015 12:06) *

Оно?
program Counter30;

const
M = 5;
K = 10;
type
TArray = array [0..M - 1] of integer;





Почти ... гениально. Увы, почти. Я даже до этого не дошёл. Где-то в коде неточность есть. Я вывел результат в тестовый файл. По циклу всё идёт правильно до позиции
1 33 36
После неё должна следовать группа
1 34 35
Однако, почему-то идёт
2 3 4 и т.д.
Т.е. теряются группы
1 34 35
1 34 36
1 35 36
Тоже самое происходит и после группы
2 33 36
За ней следует не
2 34 35
2 34 36
2 35 36
а аналогичная по логике, но неправильная по сути задачи
3 4 5
Итак в конце каждого цикла по первому числу в тройках. Кроме последних троек, которые должны были оканчивать в таком порядке
33 34 35
33 34 36
33 35 36
34 35 36
а фактически получилось
32 33 36
33 34 35
33 34 36
34 35 36
Т.е. по трём чисел после пары циклы заканчиваются на ... 33 36 вместо ... 35 36.

Потом на четырёх позициях происходит тоже самое нарушение логики при смене цикла на второй позиции. Т.е. за
1 2 31 36 должно следовать 1 2 32 33 и т.к., а идёт 1 3 4 5.
Получается из логики выпадают группы
1 2 32 33
1 2 32 34
1 2 32 35
1 2 32 36
1 2 33 34
1 2 33 35
1 2 33 36
1 2 34 35
1 2 34 36
1 2 35 36
Цикл по первой позиции переключается с 1 32 33 36 на 2 3 4 5, пропуская ряд групп чисел. Т.е. цикл по третьей позиции заканчивается на ... ... 31 36 вместо ... ... 35 36.
И наконец, включается пятая позиция и ...её хватает всего на интервал
1 2 3 4 5 ... 1 2 3 4 36. Всё. Где же недочёт. Не могу найти.

Добавлено через 13 мин.
Т.е. получается такой вот файл... Вместо К=10 я взял 36 ... Но сути дело не меняет. М тоже самое оставил.

Сообщение отредактировано: ipconnect - 20.04.2015 22:08


Прикрепленные файлы
Прикрепленный файл  TZ.TXT ( 1 мегабайт ) Кол-во скачиваний: 517
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Федосеев Павел
сообщение 20.04.2015 23:13
Сообщение #4


Бывалый
***

Группа: Пользователи
Сообщений: 298
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  8  +


Или так
program Counter30;

const
M = 5;
K = 10;
type
TArray = array [0..M - 1] of integer;

procedure ShowArray(const a: TArray);
var
i: integer;
begin
for i := 0 to M - 1 do
Write(a[i]: 3);
writeln;
end;

function IsFinal(const a: TArray): boolean;
var
i: integer;
Res: boolean;
begin
Res := True;
for i := 0 to M - 1 do
Res := Res and (a[i] = K - M + 1 + i);
IsFinal := Res;
end;

var
a: TArray;
i, j, n: integer;
begin
for i := 0 to M - 1 do
a[i] := 0;
a[0] := 1;
a[1] := 1;
i := 1;
while not IsFinal(a) do
begin
Inc(a[i]);
if a[i] > K then
begin
a[i] := a[i - 1] + 1 + 1;
{перенос}
for j := i - 1 downto 0 do
begin
Inc(a[j]);
if (a[j] <= K + j - i) then
begin
for n := j + 1 to i do
a[n] := a[n - 1] + 1;
break;
end
else
if j = 0 then
begin
Inc(i);
a[0] := 1;
for n := j + 1 to i do
a[n] := a[n - 1] + 1;
end;
end;
end;
ShowArray(a);
end;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ipconnect
сообщение 20.04.2015 23:49
Сообщение #5





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Цитата(Федосеев Павел @ 20.04.2015 23:13) *

Или так
program Counter30;

const
M = 5;
K = 10;
type
TArray = array [0..M - 1] of integer;






Опять близко, но не в точку no1.gif Я же говорил, что задача несколько сложнее, чем кажется на первый взгляд. Вот тот же текстовый файл, полученный в результате выполнения программы по новому коду. Строчки в виде ************ - это место, где нарушается логическая последовательность. У меня уже крышечку срывает, когда я занимаюсь алгоритмом этой задачи. Печалька какая-то wacko.gif А решать надо. Может ещё покрутить-повертеть?


Прикрепленные файлы
Прикрепленный файл  TZ1.TXT ( 5.28 килобайт ) Кол-во скачиваний: 374
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ipconnect
сообщение 21.04.2015 6:57
Сообщение #6





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Т.е. сам принцип цикличности переменного количества циклов реализован, но ... не до конца. По всей видимости проблема в критериях, по которым прерывается очередной цикл. Т.е. где-то в коде функции IsFinal или перед её входом не учтён какой-то нюанс. Скорее всего речь идёт о таком переменном цикле условий выхода из цикла, но касающегося вопроса своевременности прерывания основных циклов смены чисел. В этом соль Земли.

т.е. в нашем примере в двухпозиционных массивах цикл из 10 чисел должен прерываться после числа 9 в первой позиции
в трёхпозиционных на второй позиции аналогично после достижения 9 и на первой позиции при достижении 8 и так далее

У нас же получается преждевременный выход из цикла в определённых местах.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Федосеев Павел
сообщение 21.04.2015 7:31
Сообщение #7


Бывалый
***

Группа: Пользователи
Сообщений: 298
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  8  +


IsFinal - условие завершения, условно говоря, программы
Ошибка где-то в переносе.

Прийду вечером - посмотрю.

Там в переменной i - текущий столбец для накопления (изменения на каждом шаге). Если i=K, то начинается перенос - инкремент левых столбцов. Этот инкремент выполняется до тех пор, пока в j столбце сохраняется после инкремента условие переноса - т.е. K-1 (для i-1), K-2 (для i-2) и т.д. Потом перенос останавливается и начинается заполнение столбцов справа новыми значениями.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ipconnect
сообщение 21.04.2015 7:36
Сообщение #8





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Цитата(Федосеев Павел @ 21.04.2015 7:31) *

IsFinal - условие завершения, условно говоря, программы
Ошибка где-то в переносе.

Прийду вечером - посмотрю.

Там в переменной i - текущий столбец для накопления (изменения на каждом шаге). Если i=K, то начинается перенос - инкремент левых столбцов. Этот инкремент выполняется до тех пор, пока в j столбце сохраняется после инкремента условие переноса - т.е. K-1 (для i-1), K-2 (для i-2) и т.д. Потом перенос останавливается и начинается заполнение столбцов справа новыми значениями.


В теории ДА, но не по всему массиву срабатывает на практике. Значит уже где-то в самом алгоритме что-то не то. Спасибо, что не остаётесь безучастным к проблеме. До вечера.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ipconnect
сообщение 21.04.2015 17:56
Сообщение #9





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


Павел, совместно с ещё одним помощником пришли к самому близкому по сути простому алгоритму. Он выглядит следующим образом:

Цитата
Program MH;
Const n=5; k=6;
Var a: array [0..n] of integer;
i,j,l,m: integer;
Id, Od: text;
begin
assign(Od,'C:\TP\tz.txt'); Rewrite(Od);
a[1]:=1; i:=1;
repeat
i:=i+1;
repeat
for j:=1 to k-a[i-1] do
begin
a[i]:=a[i-1]+j;
for l:=1 to n do write(Od,a[l]:3);
writeln(Od);
end;
a[i-1]:=a[i-1]+1;
m:=-1;
for l:=i-1 downto 1 do
begin
m:=m+1;
if a[l]>k-m then
begin
a[l-1]:=a[l-1]+1;
a[l]:=l;
end;
end;
until a[1]=k-i+2;
a[0]:=0;
for l:=1 to i do a[l]:=l;
until i=n;
close(Od);
end.


В итоге получилось следующее. Если используются первые две из пяти позиций массива (т.е. 1 2 0 0 0 и т.д.), алгоритм идеально отрабатывается. На трёх позициях первый сбой происходит на изменении в цикле первой позиции. Т.е. с 1 2 3 0 0 по 1 5 6 0 0 всё гладко ложится, но потом идёт не 2 3 4 0 0, а 2 2 3 0 0... Итак, по всем сменам циклов по позициям. Т.е., как я понимаю, для устранения этой ошибки надо сделать так, чтобы после смены цикла на следующей позиции число было бы на единицу больше, чем в старте текущего цикла.
Устранив эту ошибку, мы решим задачу.
Отсюда предполагается, что рыть надо в коде начиная с выражения a[i-1]:=a[i-1]+1 и ниже до until a[0]=k-n. Всё что вне этих рамок, вроде как создаёт правильную логику. HELP!!! Мы уже близко.

Добавлено через 2 мин.
В прилагаемом текстовом файле в результате отработки программного кода всё это видно наглядно.

Сообщение отредактировано: ipconnect - 21.04.2015 19:27


Прикрепленные файлы
Прикрепленный файл  TZ.TXT ( 4.02 килобайт ) Кол-во скачиваний: 372
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ipconnect
сообщение 21.04.2015 20:24
Сообщение #10





Группа: Пользователи
Сообщений: 8
Пол: Мужской

Репутация: -  0  +


УРА!!! Сам докрутил
Вот, что получилось:

Program MH;
Const n=5; k=6;
Var a: array [0..n] of integer;
i,j,d,l,m: integer;
Id, Od: text;
begin
assign(Od,'C:\TP\tz.txt'); Rewrite(Od);
a[1]:=1; i:=1;
repeat
i:=i+1;
repeat
for j:=1 to k-a[i-1] do
begin
a[i]:=a[i-1]+j; d:=0;
for l:=1 to n do
if a[l]>a[l-1] then d:=d+1;
for l:=1 to n do
if d=i then write(Od,a[l]:3) else break;
if l=n then writeln(Od);
end;
a[i-1]:=a[i-1]+1;
m:=-1;
for l:=i-1 downto 1 do
begin
m:=m+1;
if a[l]>k-m then
begin
a[l-1]:=a[l-1]+1;
a[l]:=l;
end;
end;
until a[1]=k-i+2;
a[0]:=0;
for l:=1 to i do a[l]:=l;
until i=n;
close(Od);
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Федосеев Павел
сообщение 21.04.2015 21:25
Сообщение #11


Бывалый
***

Группа: Пользователи
Сообщений: 298
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  8  +


Откомпилировал во FreePascal файл из поста #4.
Результат
Код
  1  7  9  0  0
  1  7 10  0  0
  1  8  9  0  0
  1  8 10  0  0
  1  9 10  0  0
  2  3  4  0  0
  2  3  5  0  0

Для сравнения тот же кусок из TZ1.txt из поста #5:
Код
  1  7  9  0  0
  1  7 10  0  0
  *************
  2  3  4  0  0
  2  3  5  0  0

Ну и дальше
Код
  5  6  7  8  9
  5  6  7  8 10
  5  6  7  9 10
  5  6  8  9 10
  5  7  8  9 10
  6  7  8  9 10

Из TZ1:
Код
  5  6  7  8 10
  *************
  6  7  8  9 10

Я не пойму. Помеченное звёздочками должно отсутствовать, или наоборот - почему то отсутствует?
----------------------------
Sorry. Пока набирал, всё уже закончилось.

Сообщение отредактировано: Федосеев Павел - 21.04.2015 21:34
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 28.03.2024 22:14
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"