Урок 15 Задача 13

program u15z13;

type
  newArr = array [1..5] of integer;
  newArr2 = array [1..3] of integer;
var
  min,max,n,i,s,a,j,k,d: integer;
  promArr: newArr;
  promArr2: newArr2;

procedure shiftArr(var promArr: newArr; k:integer);
var j:integer;
begin
  for j:=k to 4 do
  begin
    promArr[j]:=promArr[j+1];
  end;
  promArr[high(promArr)]:=0;
end;

procedure out(var promArr: newArr);
begin
  for j := low(promArr) to high(promArr) do
    write(promArr[j],' ');
end;


begin
  randomize();
  min:=1;
  max:=5;
  j:=1;
  k:=0;
  d:=0;
  for i := low(promArr) to high(promArr) do
  begin
    promArr[i] := min + random(max - min +1);
    write(promArr[i],' ');
    promArr[i]:= promArr[j];
    j:=j+1;
  end;

  writeln('vvedite 3 chisla'); // vvedenie trex chisel
  for s:=1 to 3 do // кол-во вводимых чисел
  begin
    readln(a);
    promArr2[s] := a;
  end;

  s:=1;
  while (s < 4) do
  begin
    for j := low(promArr) to high(promArr) do
    begin
      k:=k + 1;
      if (promArr2[s] = promArr[j]) then
      begin
        shiftArr(promArr,k); // процедура со сдвигом
        d:=d+1;  // счётчик  кол-ва повторений одной цифры
      end;
    end;

    if (d >= 1) then
    begin
     s:=s;
     d:=d-1;   // счётчик в случае если цифра повторяется
    end
    else
      s:=s+1;
      k:=0;
  end;
  out(promArr); // вывод массива через процедуру
  readln();
end.

                                
vedro-compota's picture

1)

begin
  randomize();
  min:=1;
  max:=5;
  j:=1;
  k:=0;
  d:=0;
 
  begin

-- вложенные бегин-ы лишние

2)

s:=1;
    while (s < 4) do

-- если известно число повторений, лучше испольовать цикл for

3)

 d:=d-1;

а зачам нам тут вообще считать вхождения цифры?

_____________
матфак вгу и остальная классика =)

vedro-compota's picture

мое решение из разбора

program u15z13;

type
  newArr = array [1..7] of integer;
  newArr2 = array [1..3] of integer;
var
  i,j: integer;
  promArr: newArr;
  inputArray: newArr2;

procedure shiftArr(var promArr: newArr; k:integer);
var j:integer;
begin
  for j:=k to (high(promArr)-1) do
  begin
    promArr[j]:=promArr[j+1];
  end;
  promArr[high(promArr)]:=0;
end;

procedure out(var promArr: array of integer);
var j: integer;
begin
  for j := low(promArr) to high(promArr) do
    write(promArr[j],' ');
  writeln();
end;


begin
  // массив, в котором производим сдвиги:
  promArr[1] := 1;
  promArr[2] := 5;
  promArr[3] := 5;
  promArr[4] := 5;
  promArr[5] := 5;
  promArr[6] := 5;
  promArr[7] := 5;

  out(promArr);

  // вводит пользователь:
  inputArray[1] := 5;
  inputArray[2] := 4;
  inputArray[3] := 0;
  out(inputArray);

  for i := low(inputArray) to high(inputArray) do
    for j := low(promArr) to high(promArr) do
      if (inputArray[i]=promArr[j]) then
      begin
        shiftArr(promArr, j);
        writeln('--Сдвиг на ', j, ': ---input= ', inputArray[i],'----');
        out(promArr);

        if (inputArray[i]<>0) then
        while (inputArray[i]=promArr[j]) do
        begin
          shiftArr(promArr, j);
          writeln('--Сдвиг на ', j, ': ---input= ', inputArray[i],'----');
          out(promArr);
        end;
      end;

  writeln();
  writeln('-----Ответ:----');
  out(promArr);
end.

3 5 0
2 1 5 5 5 9
2 1 9 0 0 0


0
1 2 3 4 0 9
1 2 3 4 9 0
            

_____________
матфак вгу и остальная классика =)