Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.05.2016, 14:34   #1
Andreu12333
Новичок
Джуниор
 
Регистрация: 22.05.2016
Сообщений: 4
По умолчанию Задача для поступления в лагерь. В общем даются задания, прием автоматический, через форму. Форма выдают ошибку и не принимает

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

Задание было такое
Дано натуральное число n. Сгенерируйте все разбиения числа n в сумму натуральных слагаемых n = a1+a2+…+ak, в порядке, обратном лексикографическому. Разбиения, отличающиеся только порядком слагаемых, считаются одинаковыми.
Например, при n = 4 требуется вывести 4, 3+1, 2+2, 2+1+1, 1+1+1+1.
Формат файла входных данных:
На вход подается одно натуральное число n (n ≤ 30).
Формат файла выходных данных:
На выходе нужно получить все возможные разбиения числа n в сумму слагаемых. В частности, в сумме может быть только одно слагаемое. Каждое разбиение следует выводить в отдельной строке. Если слагаемых больше двух, разделяйте их знаками ‘+’.

решение было такое:

program Project1;
var A,B,C,D,Q,W,E: integer;
T: Text;
begin
B:=0;
D:=0;
E:=1;
assign(T, 'partition.in');
reset(T);
read(T,C);
close(T);
assign(T, 'partition.out');
rewrite(T);
writeln(T,C);
for A := 1 to 30 do
begin
repeat
B:=B+1;
if B>30 then
D:=1;
until (A+B=C) or (D=1);
if (A30 then
D:=1;
until (Q+W+E=C) or (D=1);
if (Q<C) and (W<C) and (E<C) then
writeln(T,Q,'+',W,'+',E);
write('');
D:=0;
E:=0;
End;
end;
close(t);
end.

вроде работает на компе, но что конкретно в коде не правильно?

Последний раз редактировалось Andreu12333; 22.05.2016 в 14:45.
Andreu12333 вне форума Ответить с цитированием
Старый 22.05.2016, 15:13   #2
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Именно этот код даже не компилируется.

Это помимо невозможности сопоставить в нём исходные данные переменным (в условии - даётся n, а в программе - переменная C). Сижу, гадаю.
FPaul вне форума Ответить с цитированием
Старый 22.05.2016, 15:41   #3
Andreu12333
Новичок
Джуниор
 
Регистрация: 22.05.2016
Сообщений: 4
По умолчанию

Спасибо за оперативный ответ. А вы не могли бы помочь с написанием правильного кода?
Andreu12333 вне форума Ответить с цитированием
Старый 22.05.2016, 16:28   #4
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Стоять-бояться. Я читал "вроде работает на компе, но что конкретно в коде не правильно?"

Это ведь подобие экзамена?

Давайте лишь подскажу ход решения.
Решить можно 2 способами - имитацией циклов на массиве или имитацией циклов рекурсией. Именно имитацией, т.к. если одно слагаемое, то один цикл for, если два слагаемых, то два for (для каждого слагаемого), ... для 20 слагаемых - 20 вложенных циклов for. А количество слагаемых будет менятся от 1 до n.

Вот у вас число n. Массив со слагаемыми Addends[0..n-1]. Текущее количество слагаемых Amount. Сумма, которую нужно получить оставшимися слагаемыми Sum (для первого слагаемого равно n).
Кроме того, для исключения повторов, каждое последующее слагаемое не должно превышать предыдущее.

Если имитацией цикла рекурсией - то всё очень просто.
FPaul вне форума Ответить с цитированием
Старый 22.05.2016, 16:32   #5
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Рекурсией
Код:
procedure ShowSum(n:integer);
var
    Addends: array of integer; {слагаемые}
    Amount:  integer;          {количество слагаемых}

    procedure Backtracking(Sum, MaxAddend: integer);
    var
      i: integer;
    begin
      if Sum = 0 then
      begin
        напечатать слагаемые
        exit;
      end;
      for i := MaxAddend downto 1 do
      begin
        Addends[Amount] := i;
        Inc(Amount);
        Backtracking(Sum - i, i);
        Dec(Amount);
      end;
    end;

  begin
    SetLength(Addends, n);
    Amount := 0;
    Backtracking(n, n);
  end;
Это не готовый для сдачи код. Над ним ещё работать и его отлаживать. Это просто пример имитации вложенных циклов.

Последний раз редактировалось FPaul; 22.05.2016 в 16:35.
FPaul вне форума Ответить с цитированием
Старый 22.05.2016, 16:41   #6
Andreu12333
Новичок
Джуниор
 
Регистрация: 22.05.2016
Сообщений: 4
По умолчанию

Спасибо,вот бы полный код( Проблема в том, что это требуют от ребенка 12 лет (для того, чтобы попасть в лагерь детский тематический). Он знает тему слабо. А сами мы, конечно, ничего не решим и не сделаем никогда.

Что-то мне подсказывает, что это, как минимум старшие классы, если не институтская проблематика...
Andreu12333 вне форума Ответить с цитированием
Старый 22.05.2016, 17:01   #7
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

А тогда что ему делать в лагере?

Попробуйте отключить ребёнку интернет на компе и на телефоне.

Перед выкладыванием я проверил этот код на FreePascal. Удалил из него часть строк. Пробуйте решить.

Смотрите. Если рассматривать бумажное решение для n=4. Оно разбивается на 4 участка по количеству слагаемых.
1. Для 1 слагаемого
Код:
  writeln(n)
2. Для 2-х слагаемых
Код:
  for i:=n downto 1 do
    for j:=i downto 1 do
      if i+j=n then
        writeln(i,'+',j);
3. Для 3-х слагаемых
Код:
  for i:=n downto 1 do
    for j:=i downto 1 do
      for k:=j downto 1 do
        if i+j+k=n then
          writeln(i,'+',j);
4. Для 4-х слагаемых
Код:
  for i:=n downto 1 do
    for j:=i downto 1 do
      for k:=j downto 1 do
        for m:=k downto 1 do
          if i+j+k+m=n then
            writeln(i,'+',j);
Для n=20 придётся рассмотреть 20 случаев от 1 до 20 слагаемых. Чтобы не плодить заранее неизвестное количество циклов вводят рекурсию с 1 но своим циклом. Нет следующего вызова - нет и цикла.

В общем - пробуйте. Лагерь - не обязательная школьная программа для усреднённого ученика, а для целеустремлённых родителей.
FPaul вне форума Ответить с цитированием
Старый 22.05.2016, 17:03   #8
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Код:
program pas_116;

  procedure ShowSums(n: integer);
  var
    Addends: array of integer; {слагаемые}
    Amount:  integer;          {количество слагаемых}

    procedure Backtracking(Sum, MaxAddend: integer);
    var
      i: integer;
    begin
      if Sum = 0 then
      begin
        напечатать слагаемые
        exit;
      end;
      for i := MaxAddend downto 1 do
      begin
        Addends[Amount] := i;
        Inc(Amount);
        Backtracking(Sum - i, i);
        Dec(Amount);
      end;
    end;

  begin
    SetLength(Addends, n);
    Amount := 0;
    Backtracking(n, n);
  end;

var
  n: integer;
begin
  readln(n);
  ShowSums(n);
end.
FPaul вне форума Ответить с цитированием
Старый 22.05.2016, 17:07   #9
Andreu12333
Новичок
Джуниор
 
Регистрация: 22.05.2016
Сообщений: 4
По умолчанию

Большое спасибо!
Andreu12333 вне форума Ответить с цитированием
Старый 22.05.2016, 17:11   #10
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Пока не за что. Этот код ещё нерабочий. Из него удалено рассмотрение некоторых случаев, ну и вывод результатов.
------------------------------------------------------------------------------------
Код:
program pas_116;

  procedure ShowSums(n: integer);
  var
    Addends: array of integer; {слагаемые}
    Amount:  integer;          {количество слагаемых}

    procedure Backtracking(Sum, MaxAddend: integer);
    var
      i: integer;
    begin
      if Sum = 0 then
      begin
        Write(Addends[0]);
        for i := 1 to Amount - 1 do
          Write('+', Addends[i]);
        writeln;
        exit;
      end;
      if Sum < MaxAddend then
        MaxAddend := Sum;
      for i := MaxAddend downto 1 do
      begin
        Addends[Amount] := i;
        Inc(Amount);
        Backtracking(Sum - i, i);
        Dec(Amount);
      end;
    end;

  begin
    SetLength(Addends, n);
    Amount := 0;
    Backtracking(n, n);
  end;

var
  n: integer;
begin
  Assign(input, 'partition.in');
  reset(input);
  Assign(output, 'partition.out');
  rewrite(output);

  readln(n);
  ShowSums(n);

  Close(output);
  Close(input);
end.

Последний раз редактировалось FPaul; 22.05.2016 в 21:35.
FPaul вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Автоматический прием патежей у себя на сайте nibufep PHP 1 05.11.2014 07:42
Помогите!!! после esle выдают ошибку ЕленаPRO Помощь студентам 3 29.09.2014 22:09
Перевод в постфиксную форму в общем случае. Lasur Помощь студентам 1 17.03.2012 09:16
При переносе БД с ACCESS в MS SQL SERVER статистические диаграммы выдают ошибку eriksson БД в Delphi 1 28.02.2012 22:52
Задача про вклад (через форму) Ya_tolko_uchus Помощь студентам 1 16.12.2010 22:04