массивы, преоброзование, заполнение, сжатие массивов Опции

[jenka]

Есть такие задачи:
1. Сжать массив, удалив из него все элементы, модуль которых
находится в интервале [a, b]. Освободившиеся в конце массива элементы
заполнить нулями.
2. Преоброзовать массив таким образом, чтобы в первой его половине
распологались элементы, стоявшие в нечетных позициях, а во второй
половине-элементы, стоявшие в четных позициях.
3. Заполнить массив из пятнадцати элементов случайным образом
вещественными значениями х (0<х<105).

Очень нужна помощь с их решением. Помогите, плиз.

[Lapp]

1. Сжать массив, удалив из него все элементы, модуль которых
находится в интервале [a, b]. Освободившиеся в конце массива элементы
заполнить нулями.

Словами сказано - интервал, а обозначено как отрезок. Дальнейшее сделано для отрезка - примерно так, но я не проверял.

var 
  a,b,c:tElement;  
  w:array[1..n] of tElement;
.............
  j:=0;
  for i:=1 to n do begin
    c:=w[i]
    if (a>c)and(c<b) then begin
      Inc(j);
      w[j]:=c
    end
  end;
  for i:=j+1 to n do w[i]:=0;

[volvo]

Почти... Нужно обратное действие:

if NOT( (a<c)and(c<b) ) then begin

Знак тоже надо исправить на a<c...

[Lapp]

Недремлющий volvo всегда на посту . Спасибо!
Сначала я использовал конструкция с NOT, потом решил ее упростить, но забыл сменить and на or .
Исправленная версия:

var 
  a,b,c:tElement;  
  w:array[1..n] of tElement;
.............
  j:=0;
  for i:=1 to n do begin
    c:=w[i]
    if (a>c)or(c<b) then begin
      Inc(j);
      w[j]:=c
    end
  end;
  for i:=j+1 to n do w[i]:=0;

[volvo]

Так... А вот теперь у меня вопрос: кто-нибудь сможет написать программу, выполняющую второе задание, без использования доп. массива (если ответ "Да" - то просьба тоже скрывать программу, теги [ SPOILER ] [ /SPOILER ], дайте подумать остальным)... Мое решение:

Спойлер (Показать/Скрыть)

const
  n = 10;
type
  arrType = array[1 .. n] of integer;

procedure f(var arr: arrType; X: integer; is_odd: boolean; level: integer);
const
  odd_start: integer = n div 2;
  even_start: integer = n;
begin
  if level <= n then f(arr, arr[level], odd(level), succ(level));

  if is_odd then begin
    arr[odd_start] := X; dec(odd_start);
  end
  else begin
    arr[even_start] := X; dec(even_start);
  end;
end;

const
  // неважно, можно и ввод организовать...
  arr: arrType = (31, 32, 33, 34, 35, 36, 37, 38, 39, 40);

var i: integer;

begin
  f(arr, arr[1], true, 2);
  for i := 1 to n do write(arr[i]:4);
  writeln;
end.

[Lapp]

написать программу, выполняющую второе задание, без использования доп. массива

Вот мое решение.
Пара оговорок:
1. предполагаю, что длина массива четная;
2. сохраняю порядок внутри четных/нечетных групп (в задании это требование отсутствует, но я счел его логичным).

Спойлер (Показать/Скрыть)

const
  n=18;
  n2=n div 2;

type
  tElem=integer;

var
  i,j:integer;
  w:array[1..n] of tElem;
  a,b:tElem;

begin
  for j:=1 to n do w[j]:=j;

  for i:=1 to n2 div 2+1 do begin
    WriteLn('i=',i);
    for j:=1 to n do Write(w[j]:4); WriteLn;
    a:=w[i+1];
    b:=w[n-i];
    for j:=i+1 to n2-i do w[j]:=w[j+1];
    for j:=n-i-1 downto n2+i do w[j+1]:=w[j];
    w[n2+i]:=a;
    w[n2-i+1]:=b;
  end;
  ReadLn
end.

[volvo]

lapp, если ты добавишь в самом конце программы:

  for i := 1 to n do
    write(w[i]:4);
  writeln;

, то у тебя распечатается вот такой массив:

1 3 5 7 8 11 13 15 17 2 4 6 8 11 12 14 16 18

, а значит, он запорчен, ибо 8-ка и 11 не должны быть в двух местах...

[Lapp]

volvo, в твоем решении используется рекурсия.. Ничего особенно против нее не имею, но..

1. Если идет речь о неиспользовании массива, то это скорее всего экономия памяти. Рекурсия же использует память очень активно.

2. Последовательными вызовами рекурсивной процедуры возможно сохранить в памяти весь массив, не организуя его.




С твоим замечанием согласен.
Вот исправленная версия..

Спойлер (Показать/Скрыть)

const
  n=16;
  n2=n div 2;

type
  tElem=integer;

var
  i,j:integer;
  w:array[1..n] of tElem;
  a,b:tElem;

begin
  for j:=1 to n do w[j]:=j;

  for i:=1 to n2 div 2 do begin
    a:=w[i+1];
    b:=w[n-i];
    for j:=i+1 to n2-i do w[j]:=w[j+1];
    for j:=n-i-1 downto n2+i do w[j+1]:=w[j];
    w[n2+i]:=a;
    w[n2-i+1]:=b;
  end;
  for j:=1 to n do Write(w[j]:4); WriteLn;
  ReadLn
end.

[Bokul]

Вот мой вариант.

Спойлер (Показать/Скрыть)

uses crt;
const
   n=10;
var
   mas:array[1..n] of byte;
   i,buf:byte;
begin
clrscr;
for i:=1 to n do
    if (i mod 2)=0 then
       mas[i]:=0
    else
       mas[i]:=1;

for i:=1 to n do
   write(mas[i],' ');
writeln;

{------------Главный цикл--------------------------}
for i:=1 to (n div 2) do
    if (i mod 2)=0 then
       begin
            buf:=mas[i+n div 2];
            mas[i+n div 2]:=mas[i];
            mas[i]:=buf;
       end;
{---------------------------------------}
for i:=1 to n do
   write(mas[i],' ');
readln;
end.

Сообщение отредактировано: volvo - 2.11.2006 15:03

[Lapp]

Вот мой вариант.

Bokul, для n=12 у тебя непорядок..
При n=10 тоже не очень здорово - не сохраняется порядок. Это, правда, не требуется в задаче..

[Bokul]

Да, такой способ не идет при количестве кратном 4-ом.

[Malice]

Так... А вот теперь у меня вопрос: кто-нибудь сможет написать программу, выполняющую второе задание, без использования доп. массива (если ответ "Да" - то просьба тоже скрывать программу, теги

Может я чего не понял, но вроде все просто:

Спойлер (Показать/Скрыть)

uses crt;
const n=10;
type arr=array [1..n] of byte;
var x:array [1..n] of byte;
i,q:integer;
begin
clrscr;
for i:=1 to n do x[i]:=i;
for i:=1 to n do write (x[i]:3); writeln; 
for i:=1 to n div 2 do begin
q:=x[i]; x[i]:=x[(I-1)*2+1]; x[(i-1)*2+1]:=q;
end;
for i:=1 to n do write (x[i]:3); writeln;
end.

Хотя можно еще стек заиспользовать для хранения вместо массива..

[мисс_граффити]

раз сохранение порядка необязательно:

Спойлер (Показать/Скрыть)

program mas;
const n=15;
var arr: array [1..n] of integer;
i,dop,b,a:integer;
begin
randomize;
for i:=1 to n do
  begin
  arr[i]:=i;
  write(' ',arr[i]);
  end;
writeln;
if odd(n) then
 begin
 b:=n+1;
 a:=n div 2+1;
 end
else
 begin
 b:=n;
 a:=n div 2;
 end;
for i:=1 to a do
  if not(odd(i)) then
    begin
    dop:=arr[i];
    arr[i]:=arr[b-i+1];
    arr[b-i+1]:=dop;
    end;
for i:=1 to n do
  write(' ',arr[i]);
writeln;
writeln;
readln;
end.

...или вместо 2 вариантов а сделать просто деление с округлением в большую сторону.

Сообщение отредактировано: volvo - 2.11.2006 15:04

[volvo]

раз сохранение порядка необязательно:

, что значит, необязательно? Смысл-то какой в этом тогда? Единственно логичной была бы такая перестановка, после которой массив
<1 2 3 4 5 6 7 8 9 10>
становится таким:
<1 3 5 7 9 2 4 6 8 10>...

Автору: Давайте будем полностью и корректно приводить задания... Видите, сколько в них недомолвок и неясностей?

[Lapp]

раз сохранение порядка необязательно:

Что-та не таво-та...

Running "c:\home\home\ak\pas\th\th014\th014-miss-gr.exe "
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 15 3 13 5 11 7 8 9 10 6 12 4 14 2

[мисс_граффити]

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

Malice, проверь при нечетной длине массива...

Что-та не таво-та...

Running "c:\home\home\ak\pas\th\th014\th014-miss-gr.exe "
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 15 3 13 5 11 7 8 9 10 6 12 4 14 2

сорри.
разбираюсь...

Сообщение отредактировано: мисс_граффити - 28.10.2006 12:26

[Lapp]

в задании про это ни слова.
...
Malice, проверь при нечетной длине массива...

А что такое первая и вторая половины массива при нечетной его длине?
В задании про это ни слова.. Будем фантазировать или подождем автора?

Хотя, сумлеваюсь я, что автор что-то прояснит..

[Malice]

Malice, проверь при нечетной длине массива...

а где в таком случае половина ?
2Volvo, задание такое, какое оно есть. Зачем склонять автора к своему варианту ?
Хотя я думаю, что нашим способом тоже можно порядок не нарушить, нужно только добавить еще 1 цикл перестановок по второй части массива. Тогда совсем честно будет, даже честней чем у Volvo, так что мы с мисс_граффити тоже победим Попробую сейчас, некогда только - сервер проапгрейдил, перестанавливаю все

[Lapp]

даже честней чем у Volvo,

?????????? ? ? ??

так что мы с мисс_граффити тоже победим

Победит, как обычно дружба!

[volvo]

задание такое, какое оно есть

А его никакого нет... Пока Автор не соизволит написать, что ИМЕННО ему нужно...