Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ подсчитать наименьший расход гирлянд

Автор: maksimla 14.02.2009 17:51

задача
На новый год ученики решили украсить длинный коридор своими гирляндами. На потолке весят светильники. Какие нибуть два светильника можно соединить гирляндой. Надо сцепить светильники парами так чтобы возле каждого светильника была бы соединена хоть одна гирлянда, о всех гирлянд обшая длина была бы наименьшей.

Напишите программу, находящую наименьшую всех гирлянд длину.

Первичные данные записаны в файле duom.txt . На первой строчке в файле написано натуральное число s всех светильников (2<=s<=1000) светильников число . На другой строчке написано отделено пробелами растояние от светильников неотрицательное число, не больше 10000,- каждого светильника координаты.

Результаты - наименьшее всех гирлянд общее длина - записывается в файл rez.txt.

пример
начальные данные
5
4 10 0 12 2

результат
6

обьяснение
соединяем 0 и 2 (длина гирлянды 2) потом 2 и 4 (длина гирлянды 2) и 10 с 12 (длина гирлянды 2) общяя длина 6

и потом написать программы еще чтобы в файл duom.txt записывало эти разные числа.

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

еще у меня написаны там чтобы выводили числа на экран это для меня проверка.
вот вся программа.

program sviestuvai;
const count=1000;
Var
s,i,a,j,w,v:integer;
z:array [1..500] of integer;
m:array [1..999] of integer;
n:array [1..count] of integer;
pradDuom,rezult: text;


BEGIN
assign (pradDuom, 'duom.TXT');
assign (rezult, 'rez.TXT');
reset (pradDuom);
rewrite (rezult);
readln(pradduom,s);
for i:=1 to s do
 read(pradduom,n[i]);

 {********************sortirovka massiva po vozrastaniju****************}

 for i:= 1 to s do
 for j:=1 to s do
 if n[i]<n[j] then begin w:=n[i]; n[i]:=n[j]; n[j]:=w; end;

 {******************konec sortirovki************************************}

 j:=0;
   for i:= 1 to s-1 do
    begin
    inc(j);
    m[j]:=n[i+1]-n[i];
    end;
    

  {************proverka kak otsortirovalo****************}
  for i:=1 to s do
 write(n[i]:3,' ');
 writeln;
 {***********konec proverki sortirovki************************}

 {*************nacalo proverki vsex promizutkov*************}
 for i:=1 to s-1 do
 write(' ',m[i]:3);  writeln;

 {***************************konec************************}
 
 
 {****************************OSIBKA*****************************************}
 
 
 {****************nacalo otbora cisel**********************}
 z[1]:=m[1];
 z[j-1]:=m[s-1];
 v:=1;
 for i:=2 to j-2 do
 begin
 if m[i]>m[i+1]
 then begin inc(v); z[v]:=m[i+1]; i:=i+2 end
  else begin inc(v); z[v]:=m[i]; i:=i+2 end;
{ writeln('privet',j);}

{*********************konec*******************************}
 v:=v+1;
for i:= 1 to v+1 do
writeln(i,'--> ',z[i]);
writeln;
a:=0;
for i:=1 to v do
a:=a+z[i];
 writeln(a,'  ',v,' ',z[j-1]);
  end;
write(rezult,a);
readln;

 close(pradduom);
 close(rezult);
END.


вот и все написал где ошибка начинается помогите

Автор: maksimla 15.02.2009 15:55

вот дополнительная программа записывает числа в duom.txt файл любые числа 

var
  v: array[1 .. 1000] of integer;
   i, n: integer;
   t:text;
begin
 assign (t, 'duom.TXT');
 rewrite (t);
  randomize;
  n:= random(1000)+1;
   for i := 1 to n do
    v[i]:=random(10001);
     writeln(t,n);
     for i:=1 to n do
     write(t,v[i],' ');
  close(t);
end.


помогите доделать ту верхнию программу исправить если что непонятно то спрашиваете

Автор: maksimla 15.02.2009 18:27

вот сделал подругому программу но при других первичных данных пишет совсем другое тоже гдето ошибка
при таких данных
7
0 2 5 10 16 20

вот программа

program sviestuvai;
const count=1000;
Var
s,i,a,j,w,v:integer;
z:array [1..500] of integer;
m:array [1..999] of integer;
n:array [1..count] of integer;
pradDuom,rezult: text;


BEGIN
assign (pradDuom, 'duom.TXT');
assign (rezult, 'rez.TXT');
reset (pradDuom);
rewrite (rezult);
readln(pradduom,s);
for i:=1 to s do
 read(pradduom,n[i]);

 {********************sortirovka massiva po vozrastaniju****************}

 for i:= 1 to s do
 for j:=1 to s do
 if n[i]<n[j] then begin w:=n[i]; n[i]:=n[j]; n[j]:=w; end;

 {******************konec sortirovki************************************}

 j:=0;
   for i:= 1 to s-1 do
    begin
    inc(j);
    m[j]:=n[i+1]-n[i];
    end;


  {************proverka kak otsortirovalo****************}
  for i:=1 to s do
 write(n[i]:3,' ');
 writeln;
 {***********konec proverki sortirovki************************}

 {*************nacalo proverki vsex promizutkov*************}
 for i:=1 to s-1 do
 write(' ',m[i]:3);  writeln;

 {***************************konec************************}


 {****************************OSIBKA*****************************************}


 {****************nacalo otbora cisel**********************}
 z[1]:=m[1];
 z[j-1]:=m[s-1];
 v:=1;
 for i:=2 to j-1 do
 begin
 if m[i]>m[i+1]
 then begin inc(v); z[v]:=m[i+1]; i:=i+1 end
  else begin inc(v); z[v]:=m[i]; i:=i+1 end;
{ writeln('privet',j);}        end;

{*********************konec*******************************}
 v:=v+1;
for i:= 1 to s-1 do
writeln(i,'--> ',z[i]);
writeln;
a:=0;
for i:=1 to s-1 do
a:=a+z[i];
 writeln(a,'  ',v,' ',z[j-1]);

write(rezult,a);
readln;

 close(pradduom);
 close(rezult);
END.


Автор: Lapp 15.02.2009 22:37

По поводу программы, делающей исходный файл (duom.txt).
Насколько я понял, два светильника не могут находиться в одном месте, поэтому я добавил проверку на то, что позиция уже встречалась. Вот:

const
  l=30;

var
  i,j,n,r: integer;
  t:text;
  Fresh: boolean;
  v: array[1..l]of integer;

begin
  assign (t, 'duom.TXT');
  rewrite (t);
  randomize;
  n:= random(l)+1;
  writeln(t,n);
  for i := 1 to n do begin
    repeat
      r:=random(l+1);
      Fresh:=true;
      j:=1;
      while Fresh and (j<i) do begin
        Fresh:=v[j]<>r;
        Inc(j)
      end
    until Fresh;
    v[i]:=r;
    write(t,r,' ');
  end;
  close(t);
end.
Еще одно замечание: старайся поменьше чисел в тексте, задавай их константами в начале программы.

Теперь про основную программу.
Ты чересчур переусложнил все, хотя подход верный. Но чем больше ненужных дополнительных вещей, тем больше вероятность ошибки. Зачем тебе массивы z и так далее? Считай сразу то, что тебе нужно. Массив m (разности) - согласен, полезен. Короче, вот так примерно вышло на основе твоей программы:
program sviestuvai;
const
  count=1000;
Var
  s,i,a,j,w,v:integer;
  z:array [1..500] of integer;
  m:array [1..999] of integer;
  n:array [1..count] of integer;
  pradDuom,rezult: text;
  Left: boolean;


BEGIN
  assign (pradDuom, 'duom.TXT');
  assign (rezult, 'rez.TXT');
  reset (pradDuom);
  rewrite (rezult);
  readln(pradduom,s);
  for i:=1 to s do read(pradduom,n[i]);

  {********************sortirovka massiva po vozrastaniju****************}

  for i:= 1 to s do for j:=1 to s do if n[i]<n[j] then begin
    w:=n[i]; n[i]:=n[j]; n[j]:=w
  end;

  {******************konec sortirovki************************************}

  for i:= 1 to s-1 do m[i]:=n[i+1]-n[i];


  {************proverka kak otsortirovalo****************}
  for i:=1 to s do  write(n[i]:3,' ');
  writeln;
  {***********konec proverki sortirovki************************}

  a:=n[2]-n[1]+n[s]-n[s-1];   { сначала считаем концы }
  Left:=true;
  for i:=3 to s-2 do if Left then begin
    Left:=(m[i-1]<m[i]);
    if Left then a:=a+m[i-1] else a:=a+m[i]
  end
  else Left:=true;
  WriteLn('Minimal lenght = ',a)
END.

Автор: maksimla 15.02.2009 23:29

да а я и даже не подумал что два светильника не могут в одном месте находится можете обьяснить как вы эту проверку сделали я там понял когда random потом постоянно j=1 потом проверка идет если j<i и true будит ,а если fresh =false случится то тогда что произойдет ?

Автор: maksimla 15.02.2009 23:56

а программа кажется неправильно результат выводит если
начальные данные
6
0 2 5 10 16 20
2 3 5 6 4 все растояние

результат наимений кажется
11
сперва посчитали как первый и последний это 6 и плюс средний 5 равно 11 и все попарно соединены потомучто зачем еще два соединения если 3 и 6 больше чем 5 так лутше 5 соединение чем два

а в программе считается что
14

программа кажется так считает первы и последний это 6 потом смотрит 3 меньше 5 записывает +3 это все уже 9 потом смотрит 5 меньше 6 и записывает 5 и получается результат 14

Автор: TarasBer 16.02.2009 0:54

Извините, что беру на себя чужие функции, но я мозг поломал тут. Просьба к автору использовать знаки препинания! В частности, точки и запятые. Клавиша с точкой в русской раскладке находится сразу рядом с правым Shiftом. А для ввода запятой в русской раскладке надо нажать Shift (любой) и одновременно клавишу с точкой.

Автор: Lapp 16.02.2009 4:50

Цитата(maksimla @ 15.02.2009 19:56) *
а программа кажется неправильно результат выводит если
Да, верно, решение мое неправильное.. sad.gif
Сейчас времени нет - убегаю, но к утру постараюсь исправить (если никто раньше меня не сделает, конечно smile.gif)

Автор: Lapp 16.02.2009 18:51

Вот вроде правильное решение на сей раз)).
Пришлось делать полный перебор, это тоже удобно через все ту же рекурсию smile.gif.
program sviestuvai;

const
  count=1000;
Var
  s,i,a,j,k,x,w: integer;
  m: array [1..count-1] of integer;
  n: array [1..count] of integer;
  pradDuom,rezult: text;

procedure Step(Connect,Connected: boolean);
begin
  Inc(x);
  if x<=s then begin
    if Connect then begin
      Inc(k,m[x-1]);
      Step(false,true);
      if not Connected then Step(true,true);
      Dec(k,m[x-1])
    end
    else Step(true,false)
  end
  else
    if Connected and(k<a) then a:=k;
  Dec(x)
end;


BEGIN
  assign (pradDuom, 'duom.TXT');
  assign (rezult, 'rez.TXT');
  reset (pradDuom);
  rewrite (rezult);
  readln(pradduom,s);
  for i:=1 to s do read(pradduom,n[i]);

  {********************sortirovka massiva po vozrastaniju****************}

  for i:= 1 to s do for j:=1 to s do if n[i]<n[j] then begin
    w:=n[i]; n[i]:=n[j]; n[j]:=w
  end;

  {******************konec sortirovki************************************}

  for i:= 1 to s-1 do m[i]:=n[i+1]-n[i];


  {************proverka kak otsortirovalo****************}
  for i:=1 to s do  write(n[i]:3,' ');
  writeln;
  {***********konec proverki sortirovki************************}


  {****************nacalo otbora cisel**********************}
  a:=n[s];
  k:=0;
  x:=1;
  Step(true,false);
  WriteLn('Minimal length = ',a)
END.

Нужны объяснения?

Мне устойчиво кажется, что я где-то перемудрил.. Думаю, можно и попроще. Но - работает, вроде)).
Проверяй.

Автор: maksimla 16.02.2009 19:17

запутался я тут как считается можете обеснить это?

procedure Step(Connect,Connected: boolean);
begin
  Inc(x);
  if x<=s then begin
    if Connect then begin
      Inc(k,m[x-1]);
      Step(false,true);
      if not Connected then Step(true,true);
      Dec(k,m[x-1])
    end
    else Step(true,false)
  end
  else
    if Connected and(k<a) then a:=k;
  Dec(x)
end;

Автор: Lapp 16.02.2009 19:50

Цитата(maksimla @ 16.02.2009 15:17) *
запутался я тут как считается можете обеснить это?
Процедура Step - это шаг к следующему светильнику. Если Connect=true, то протягиваем к нему гирлянду, если false, то нет. Connected - это протянута ли уже гирлянда к текущему светильнику. В зависимости от этих параметров я либо тяну гирлянду от следующего еще дальше, либо нет - так, чтобы удовлетворить условиям задачи и, заодно, чтобы не делать лишней работы. Из этого следует:
1. что не должно быть дыух подряд пустых (без гирлянд) промежутков;
2. что не может быть трех подряд заполненных (с гирляндами) промежутков.

Если нужны более подробные объяснения - не раньше вечера, извини.

Автор: maksimla 16.02.2009 20:00

хорошо я подожду когда более подробное описание дадите то запутался я с k,x,а с этими значениями как рекурсия выполняется вы только неспешите обьяснять мне если времени нет то необесняйте мне только 19 февраля вечером надо сдать эту программу

Автор: Lapp 17.02.2009 10:53

Как я и думал, все можно было упростить. Правда, за счет производительности.. Точнее, я отказался от проверки на заполненность трех промежутков подряд. Логика упростилась, и ощущение "перемудренности" пропало smile.gif. Хотя, если кто-то все же сможет упростит - респект)).
Попутно, я все-таки убрал лишний с моей точки зрения массив m. Зачем удваивать память, где легко посчитать на ходу?
Вот новый вариант с небольшими комментариями:

program sviestuvai;
const
  count=1000;
Var
  s,i,a,j,k,x,w: integer;
  n: array [1..count] of integer;
  pradDuom,rezult: text;

procedure Step(Connect: boolean);
begin
  Inc(x);                     { uvelichivaem schetchik shagov }
  if x<s then begin           { esli eshe ne doshli do konca }
    if Connect then begin               { esli na etom promezhutke tyanem girlyandu.. }
      Inc(k,n[x]-n[x-1]);               {   ..to uvelichivaem dlinu girlyandy..}
      Step(false)                       {   ..i imeem pravo sleduyushiy promezhutok ostavitj pustym }
    end;
    Step(true);                         { tynem girlyandu daljshe }
    if Connect then Dec(k,n[x]-n[x-1]); { idem obratno, ubiraem girlyandu }
  end
  else if k<a then a:=k;      { esli doshli do konca, to proveryam poluchennuyu dlinu na minimaljnostj }
  Dec(x)                      { shgaem nazad }
end;


BEGIN
  assign (pradDuom, 'duom.TXT');
  assign (rezult, 'rez.TXT');
  reset (pradDuom);
  rewrite (rezult);
  readln(pradduom,s);
  for i:=1 to s do read(pradduom,n[i]);

  {*** sortirovka massiva po vozrastaniju ***}
  for i:= 1 to s do for j:=1 to s do if n[i]<n[j] then begin
    w:=n[i]; n[i]:=n[j]; n[j]:=w
  end;

  {*** vyvod otsortirovannogo massiva ***}
  for i:=1 to s do  write(n[i]:3,' ');
  writeln;

  k:=n[s]-n[s-1];      { realnaya dlina, kladem v nee posledniy promezhutok }
  x:=1;                { schetchik shagov }
  a:=n[s];             { maximalno vozmozhnaya dlina girlyandy }
  Step(true);          { zapusk recursii }
  WriteLn('Minimal length = ',a)
END.

Теперь обещанное объяснение.
Рекурсию часто имеет смысл попытаться интерпретировать как реальный процесс, выполняемый людьми. Я уже делал это в примере к задаче про розы. В данном случае не нужно придумывать отвлеченный пример, можно прямо все рассмотреть на процессе, о котором идет речь.

Сначала соединим последний промежуток - на нем обязательно надо тянуть (это присваивание k длины последнего промежутка). Теперь переходим в начало (счетчик шагов ставим в 1). Переменная a - это минимальное значение полученных длин, пока присваиваем ему макимально возможное значение. Делаем первый шаг (Step) - обязательно соединяем (параметр true), потому что первый светильник должен быть охвачен.

Зайдя в процедуру, проверяем, не дошли ли до конца. Если нет, то увеличиваем длину и делаем следующий шаг. Следующий шаг зависит от предыдущего следующим образом: если на предыдущем не было гирлянды (Connect=false), то на следующем обязательно должна быть. Поэтому я вызываю Step(false) только если Connect=true.
Если дошли до конца, то нужно проверить полученную длину k на минимальность (если меньше, чем a, то кладем k в a).
Потом идем обратно, снимая гирлянду (нсли вешали) на каждом шагу. И проверяем другой вориант.. Так мы проверим все варианты, подчиняющиеся условию, что каждый светильник соединен с каким-то из соседей. В процессе найдем минимальную длину.
Вроде, все.

Автор: maksimla 17.02.2009 20:41

спасибо все понел