Вывести перестановки по заданному условию

@Rat999 · Регистрация: 30.06.2023

Студворк — интернет-сервис помощи студентам

Сформировать одномерный массив и вывести перестановки при условии, что если элемент больше соседних в два и более раз, то такая перестановка не подходит.
Массив есть, перестановки есть, а вот как реализовать условие не понимаю.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
program Permutations;
const
  N = 5;// размер массива
type
  TArray = array[1..N] of Integer;
  TPerm = array[1..N] of Integer;
var
  arr: TArray;
  perm: TPerm;
 
procedure GenPerm(index: Integer);
var
  i, temp: Integer;
begin
  if index = N + 1 then
  begin
    for i := 1 to N do
      Write(perm[i], ' ');
    Writeln;
  end
  else
  begin
    for i := 1 to N do
    begin
      // проверяем, было ли уже использовано текущее число
      temp := perm[i];
      if temp = 0 then
      begin
        perm[i] := arr[index];
        GenPerm(index + 1);
        perm[i] := 0;
      end;
    end;
  end;
end;
 
var
  i: Integer;
 
begin
  // заполняем массив случайными числами
  Randomize;
  for i := 1 to N do
    arr[i] := Random(10) + 1;
  
  // выводим исходный массив
  write('Исходный');
  writeln;
  for i := 1 to N do
    Write(arr[i], ' ');
  Writeln;
  write('Перестановки');
  writeln;
  // генерируем перестановки
  GenPerm(1);
end.

@bormant · 11.12.2023, 16:51

Перестановки выводятся где? Правильно, в строках 18-19.
Соответственно, перед строкой 18 проверяем, соблюдается ли условие

если элемент больше соседних в два и более раз, то такая перестановка не подходит

и выводим, если не соблюдается, ибо не подходит.

Добавлено через 9 минут

Кликните здесь для просмотра всего текста

Pascal
17
18
19
20
21
22
23
    i:=N-1;
    while (i>1) and (perm[i]<=2*perm[i-1]) and (perm[i]<=2*perm[i-1]) do Dec(i);
    if (i=1) and (perm[N]>2*perm[N-1]) then Inc(i);
    if (i=1) and (perm[1]>2*perm[2]  ) then Inc(i);
    if i=1 then begin
      for i:=1 to N do Write(' ',perm[i]); WriteLn;
    end

@Rat999 · 14.12.2023, 10:40 **[ТС]**

Сформировать одномерный массив и вывести перестановки при условии, что если элемент больше соседних в два и более раз, то такая перестановка не подходит. Сделал массив, перестановки, проверку на условие, но проблема с крайними элементами при проверке разницы.
Грубо говоря, если исходный массив [ 3 5 6 4 10], то [6 3 5 4 10] он всё равно выведет, но при [ 3 5 10 4 6] выполняется.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
program Perms;
 
const
  N = 5;// размер массива
 
type
  TArray = array[1..N] of Integer;
  TPerm = array[1..N] of Integer;
 
var
  arr: TArray;
  perm: TPerm;
 
procedure GenPerm(index: Integer);
var
  i, temp: Integer;
  valid: Boolean;
begin
  if index = N + 1 then
  begin
    valid := true;
    for i := 2 to N - 1 do
    begin
      if (perm[i] >= perm[i - 1] * 2) or (perm[i] >= perm[i + 1] * 2) then
      begin
        valid := false;
        Break;
      end;
    end;
    
    if valid then
    begin
      for i := 1 to N do
        Write(perm[i], ' ');
      Writeln;
    end;
  end
  else
  begin
    for i := 1 to N do
    begin
      // проверяем, было ли уже использовано текущее число
      temp := perm[i];
      if temp = 0 then
      begin
        perm[i] := arr[index];
        GenPerm(index + 1);
        perm[i] := 0;
      end;
    end;
  end;
end;
 
var
  i: Integer;
 
begin
  // заполняем массив случайными числами
  Randomize;
  for i := 1 to N do
    arr[i] := Random(10) + 1;
  
  // выводим исходный массив
  write('Исходный');
  writeln;
  for i := 1 to N do
    Write(arr[i], ' ');
  Writeln;
  write('Перестановки');
  writeln;
  // генерируем перестановки
  GenPerm(1);
end.

@bormant · 14.12.2023, 20:51

Сообщение от Rat999

Грубо говоря, если исходный массив [ 3 5 6 4 10], то [6 3 5 4 10] он всё равно выведет, но при [ 3 5 10 4 6] выполняется.

Можно как-то связанно пояснить, что хотели сказать?
Что 10 в 2 раза больше 4, но эта перестановка все равно выводится, но не должна? Так для элементов 2..N-1 условие соблюдается, а проверки крайних элементов вы писать не стали, код проверок выкинули, потому перестановка и выводится. Мне совсем непонятно, чему вы удивляетесь и что непонятно. А объяснять, что не так, вам, похоже, недосуг

Добавлено через 2 минуты
В сообщении #2 под спойлером есть готовый код проверки, почему б не попробовать его в деле?

@Rat999 · 16.12.2023, 16:19 **[ТС]**

Так в этом и проблема, что я не понимаю, как именно прописать условие. Выдаёт ошибку размерности. Если же брать ранее написанную прогу, то каждая строчка выводится по нескольку раз.

@bormant · 16.12.2023, 16:43

Сообщение от Rat999

проблема, что я не понимаю, как именно прописать условие

Идете к сообщению #2 в этой теме, щелкаете "Кликните здесь для просмотра всего текста".
Вы же код внутри открывшегося блока видели? Вот ровно так и прописать, буквально.
Строки 19, 20 как раз про проверку последнего и первого элементов массива соответственно.

@Rat999 · 17.12.2023, 15:04 **[ТС]**

Это- то понятно. Но всё, понял, где был недочёт, прога теперь работает!

Новые блоги и статьи Все статьи Все блоги /
Использование SDL3-callbacks вместо функции main() на Android, Desktop и WebAssembly 8Observer8 24.01.2026 Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а привычная функция main(). . .	моя боль iceja 24.01.2026 Выложила интерполяцию кубическими сплайнами www. iceja. net REST сервисы временно не работают, только через Web. Написала за 56 рабочих часов этот сайт с нуля. При помощи perplexity. ai PRO , при. . .	Модель сукцессии микоризы anaschu 24.01.2026 Решили писать научную статью с неким РОманом	http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .
http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь(не выше 3-го порядка) постоянного тока с элементами R, L, C, k(ключ), U, E, J. Программа находит переходные токи и напряжения на элементах схемы классическим методом(1 и 2 з-ны. . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/

@Rat999 0 / 0 / 0 Регистрация: 30.06.2023 Сообщений: 6
	16.12.2023, 16:19 [ТС]
	Так в этом и проблема, что я не понимаю, как именно прописать условие. Выдаёт ошибку размерности. Если же брать ранее написанную прогу, то каждая строчка выводится по нескольку раз. 0

@Rat999 0 / 0 / 0 Регистрация: 30.06.2023 Сообщений: 6
	17.12.2023, 15:04 [ТС]
	Это- то понятно. Но всё, понял, где был недочёт, прога теперь работает! 0