Решаем задачи Абрамян на Паскале. Array106

Array106. Дан массив размера $$N$$. Продублировать в нем элементы с четными номерами ($$2, 4, …$$). Условный оператор не использовать.

Решение:

program Array106;

type
 m =  array[1..20] of Integer;

var
  a,b: m;
  N,Nk,i,k:Integer;

begin
  Write('N: ');
  Readln(N);

  Writeln('A: ');
  for i:=1 to N do
   begin
    write(i,' :');
    readln(a[i]);
   end;

  i:=2;
  k:=1;
  while (i<=(n div 2)*2) do
   begin
    b[k]:=a[i-1];
    inc(k);
    b[k]:=a[i];
    inc(k);
    b[k]:=a[i];
    inc(k);
    inc(i,2);
   end;
  dec(i);
  while (i=n) do
   begin
    b[k]:=a[i];
    inc(i);
    inc(k)
   end;
  dec(k);
  a:=b;
  for i:=1 to k do Writeln(a[i]);

end.

program Array106;

type

m = array[1..20] of Integer;

var

a,b: m;

N,Nk,i,k:Integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,' :');

readln(a[i]);

end;

i:=2;

k:=1;

while (i<=(n div 2)*2) do

begin

b[k]:=a[i-1];

inc(k);

b[k]:=a[i];

inc(k);

b[k]:=a[i];

inc(k);

inc(i,2);

end;

dec(i);

while (i=n) do

begin

b[k]:=a[i];

inc(i);

inc(k)

end;

dec(k);

a:=b;

for i:=1 to k do Writeln(a[i]);

end.

Решение от olegst1975:

Ниже одним массивом(объявляем с запасом 10 плюс максимум 5 четных). Первый цикл соответствует количеству четных эл-тов в массиве, причем в обратном порядке — начинаем дублирование от больших индексов, чтобы младшие не сбивались. Второй по мотивам предыдущих задач — сдвигаем элементы (с текущего последнего и до текущего четного) на один.

var
  n,i,i1:integer;      
  a:array [1..15]of real;
    
begin 
  readln(n);        
  for i:=1 to n do read(a[i]);  
  for i:=(n div 2) downto 1 do
    for i1:=(n+(n div 2)-i) downto 2*i do a[i1+1]:=a[i1];              
  for i:=1 to (n+(n div 2)) do writeln(a[i]);
end.

var

n,i,i1:integer;

a:array [1..15]of real;

begin

readln(n);

for i:=1 to n do read(a[i]);

for i:=(n div 2) downto 1 do

for i1:=(n+(n div 2)-i) downto 2*i do a[i1+1]:=a[i1];

for i:=1 to (n+(n div 2)) do writeln(a[i]);

end.

Решение от Kirk:

Program a106;

Var
 a: array [1..20] of real;
 n,i,j: integer;
 
Begin
Randomize;
 n:=random(6)+4;
 Writeln('N=',n);
 Write('A: ');
 For i:=1 to n do
  Begin
   a[i]:=random*20-10;
   Write(a[i]:6:2);
  End;
 Writeln();
 i:=2;
 n:=((n div 2)+n);
 While (i<n) do
  Begin
   For j:=n downto i+1 do a[j]:=a[j-1];
   a[i]:=a[i+1];
   i:=i+3;
  End;
 Write('A: ');
 For i:=1 to n do Write(a[i]:6:2);
End.

Program a106;

Var

a: array [1..20] of real;

n,i,j: integer;

Begin

Randomize;

n:=random(6)+4;

Writeln('N=',n);

Write('A: ');

For i:=1 to n do

Begin

a[i]:=random*20-10;

Write(a[i]:6:2);

End;

Writeln();

i:=2;

n:=((n div 2)+n);

While (i<n) do

Begin

For j:=n downto i+1 do a[j]:=a[j-1];

a[i]:=a[i+1];

i:=i+3;

End;

Write('A: ');

For i:=1 to n do Write(a[i]:6:2);

End.

Задачи из раздела Array можно посмотреть здесь.

Комментарии 8

Никита Калякин

19.03.2016 в 13:35

условный оператор, т.е. if не использовать

Ответить
Никита Калякин

19.03.2016 в 13:36

i:=0;
repeat
i:=i+2;
Write(A[i-1],A[i],A[i]);
until (i>n)

Ответить

Да, согласен проблема есть.
но так просто от неё не избавишься, «Продублировать в нем » тоесть на выходе должен быть массив с удвоенными элементами с чётными номерами…
к тому же в вашем примере мы выходим за границы массива.
исправил своё решение:
Было:

program Array106;

type
 m =  array[1..20] of Integer;

var
  a, b: m;
  N,Nk,i,k:Integer;

begin
  Write('N: ');
  Readln(N);

  Writeln('A: ');
  for i:=1 to N do
   begin
    write(i,' :');
    readln(a[i]);
   end;
  Nk:=N;
  k:=1;
  for i:=1 to N do
   begin
    b[k]:=a[i];
    if i mod 2 = 0 then
     begin
      Nk:=Nk+1;
      k:=k+1;
      b[k]:=a[i];
     end;
    K:=k+1;
   end;

  N:=Nk;
  a:=b;
  Writeln(N);
  for i:=1 to N do writeln(i,' :',a[i]);
end.

program Array106;

type

m = array[1..20] of Integer;

var

a, b: m;

N,Nk,i,k:Integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,' :');

readln(a[i]);

end;

Nk:=N;

k:=1;

for i:=1 to N do

begin

b[k]:=a[i];

if i mod 2 = 0 then

begin

Nk:=Nk+1;

k:=k+1;

b[k]:=a[i];

end;

K:=k+1;

end;

N:=Nk;

a:=b;

Writeln(N);

for i:=1 to N do writeln(i,' :',a[i]);

end.

Стало:

program Array106;

type
 m =  array[1..20] of Integer;

var
  a,b: m;
  N,Nk,i,k:Integer;

begin
  Write('N: ');
  Readln(N);

  Writeln('A: ');
  for i:=1 to N do
   begin
    write(i,' :');
    readln(a[i]);
   end;

  i:=2;
  k:=1;
  while (i< =(n div 2)*2) do
   begin
    b[k]:=a[i-1];
    inc(k);
    b[k]:=a[i];
    inc(k);
    b[k]:=a[i];
    inc(k);
    inc(i,2);
   end;
  dec(i);
  while (i=n) do
   begin
    b[k]:=a[i];
    inc(i);
    inc(k)
   end;
  dec(k);
  a:=b;
  for i:=1 to k do Writeln(a[i]);
end.

program Array106;

type

m = array[1..20] of Integer;

var

a,b: m;

N,Nk,i,k:Integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,' :');

readln(a[i]);

end;

i:=2;

k:=1;

while (i< =(n div 2)*2) do

begin

b[k]:=a[i-1];

inc(k);

b[k]:=a[i];

inc(k);

b[k]:=a[i];

inc(k);

inc(i,2);

end;

dec(i);

while (i=n) do

begin

b[k]:=a[i];

inc(i);

inc(k)

end;

dec(k);

a:=b;

for i:=1 to k do Writeln(a[i]);

end.

Ответить

[crayon-6741365145033267582152 inline="true" ]
var
  n,i,i1:integer;      
  a:array [1..15]of real;
    
begin 
  readln(n);        
  for i:=1 to n do read(a[i]);  
  for i:=(n div 2) downto 1 do
    for i1:=(n+(n div 2)-i) downto 2*i do a[i1+1]:=a[i1];              
  for i:=1 to (n+(n div 2)) do writeln(a[i]);
end.

[crayon-6741365145033267582152 inline="true" ]

var

n,i,i1:integer;

a:array [1..15]of real;

begin

readln(n);

for i:=1 to n do read(a[i]);

for i:=(n div 2) downto 1 do

for i1:=(n+(n div 2)-i) downto 2*i do a[i1+1]:=a[i1];

for i:=1 to (n+(n div 2)) do writeln(a[i]);

end.

[/crayon]

Ответить

Anton

20.03.2016 в 16:34

добавил решение… оно прям показывает, что if нужен в программировании 🙂

Ответить

Program a106;

Var
 a: array [1..20] of real;
 n,i,j: integer;
 
Begin
Randomize;
 n:=random(6)+4;
 Writeln('N=',n);
 Write('A: ');
 For i:=1 to n do
  Begin
   a[i]:=random*20-10;
   Write(a[i]:6:2);
  End;
 Writeln();
 i:=2;
 n:=((n div 2)+n);
 While (i<n) do
  Begin
   For j:=n downto i+1 do a[j]:=a[j-1];
   a[i]:=a[i+1];
   i:=i+3;
  End;
 Write('A: ');
 For i:=1 to n do Write(a[i]:6:2);
End.

Program a106;

Var

a: array [1..20] of real;

n,i,j: integer;

Begin

Randomize;

n:=random(6)+4;

Writeln('N=',n);

Write('A: ');

For i:=1 to n do

Begin

a[i]:=random*20-10;

Write(a[i]:6:2);

End;

Writeln();

i:=2;

n:=((n div 2)+n);

While (i<n) do

Begin

For j:=n downto i+1 do a[j]:=a[j-1];

a[i]:=a[i+1];

i:=i+3;

End;

Write('A: ');

For i:=1 to n do Write(a[i]:6:2);

End.

Ответить

Anton

02.05.2017 в 09:55

добавил в шапку..

Ответить

program array_106;//fpc

var
  a: array[1..15] of integer;
  i, j, k, n: integer;

begin
  n := 10;
  for i := 1 to n do a[i] := i;
  for i := 1 to n do Write(a[i], ' '); Writeln;
  
  k := 2;
  
  for i := 1 to n div 2 do
  begin
    for j := n + 1 downto k + 1 do
      a[j] := a[j - 1];
    n += 1;
    k += 3
  end;
  
  for i := 1 to n do Write(a[i], ' ');
  Readln
end.

program array_106;//fpc

var

a: array[1..15] of integer;

i, j, k, n: integer;

begin

n := 10;

for i := 1 to n do a[i] := i;

for i := 1 to n do Write(a[i], ' '); Writeln;

k := 2;

for i := 1 to n div 2 do

begin

for j := n + 1 downto k + 1 do

a[j] := a[j - 1];

n += 1;

k += 3

end;

for i := 1 to n do Write(a[i], ' ');

Readln

end.

Ответить

Решаем задачи Абрамян на Паскале. Array106

Комментарии:

Комментарии 8

Добавить комментарий Отменить ответ