Урок 15 задача 11

Primary tabs

Submitted by alexander263 on Sat, 02/05/2022 - 20:07

Forums:

Урок 15 задача 11

Напишите функцию, которая определяет являются ли значения переданного массива целых чисел уникальными относительно друг друга, если среди есть неуникальные элементы, то удалите их, сдвинув значения влево, заполняя оставшиеся справа ячейки нулями.
Протестируйте работу функции на массиве из 7 случайных элементов из диапазона от 1 до 15-ти.
Например для:

|1|-3|5|-3|9|5|8|

получим:

|1|9|8|0|0|0|0|

program project1;

type newArr = array [1..7] of integer;
var numArr: newArr;
    i: integer;

function unicalArr(var promArr:newArr):newArr;
var x,y:integer;

begin
  for x := 1 to 7 do
    for y := 1 to 7 do
    begin
      if((promArr[x]=promArr[y])and (x <> y))then
      begin
        promArr[x]:=0;
        promArr[y]:=0;
      end;
      result:=promArr;

    end;
end;

procedure shiftArr(var promArr: newArr);
var j,count:integer;
begin
  unicalArr(numArr);
  for count:=1 to 7 do
    for j:=1 to 7 do
    if(promArr[j]=0)then
    begin
      promArr[j]:=promArr[j+1];
    promArr[j+1]:=0;
    end;
end;

begin
  for i:=1 to 7 do
  begin
    write('Введите ',i,' элемент массива: '); readln(numArr[i]);
  end;
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  writeln();
  shiftArr(numArr);
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  readln();
end.
  • Log in to post comments
  • 3461 reads
vedro-compota's picture

vedro-compota

Sat, 02/05/2022 - 20:35

1)

 promArr[j+1]:=0;

-- выход за пределы массива

-- поправить этот вариант решения

2) Есть реализация сдвига по указанному индексу:

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

-- добавить еще один альтернативный вариант решения

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

vedro-compota's picture

vedro-compota

Sat, 03/05/2022 - 21:08

Сейчас мы на стадии сдвига на нулевые элементы в подобном массиве: 

1 0 2 3 0 4 0 5 6 0

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

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

alexander263

Thu, 03/17/2022 - 16:12 

program project1;

type newArr = array [1..7] of integer;
var numArr: newArr;
    i: integer;

function unicalArr(var promArr:newArr):newArr;
var x,y:integer;

begin
  for x := 1 to 7 do
    for y := 1 to 7 do
    begin
      if((promArr[x]=promArr[y])and (x <> y))then
      begin
        promArr[x]:=0;
        promArr[y]:=0;
      end;
      result:=promArr;
    end;
end;

procedure shiftArr(var promArr: newArr);
var x,y:integer;
begin
  unicalArr(numArr);
  for x:=1 to 6 do
    for y:=1 to 6 do
    if(promArr[y]=0)then
    begin
      promArr[y]:=promArr[y+1];
      promArr[y+1]:=0;
      //write(j+1,'|');
    end;
    writeln();
end;

begin
  for i:=1 to 7 do
  begin
    write('Введите ',i,' элемент массива: '); readln(numArr[i]);
  end;
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  writeln();
  shiftArr(numArr);
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  readln();
end.

---используется принцип (алгоритм) работы машины Поста.

alexander263

Sat, 04/02/2022 - 19:19 

program project1;

type newArr = array [1..7] of integer;
var numArr: newArr;
    i: integer;

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

function unicalArr(var promArr:newArr):newArr;
var x,y:integer;

begin
  for x := 1 to 7 do
    for y := 1 to 7 do
    begin
      if((promArr[x]=promArr[y])and (x <> y))then
      begin
        promArr[x]:=0;
        promArr[y]:=0;
        shiftArr(numArr,y);
      end;
    end;
  result:=promArr;
end;

begin
  for i:=1 to 7 do
  begin
    write('Введите ',i,' элемент массива: '); readln(numArr[i]);
  end;
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  writeln();
  unicalArr(numArr);
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  readln();
end.
vedro-compota's picture

vedro-compota

Sat, 04/02/2022 - 20:33

Реализовать замену на ноль неуникальных чисел в массиве:

1 2 3 5 6 5 5

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

alexander263

Sat, 04/16/2022 - 20:09 

program project1;

type newArr = array [1..7] of integer;
var numArr: newArr;
    i: integer;

procedure replaceByZero(var promArr: newArr; k:integer);
var j:integer;
begin
  for j:=1 to 7 do
    if(promArr[j]=k)then
      promArr[j]:=0;
end;

function unicalArr(var promArr:newArr):newArr;
var x,y,n:integer;

begin
  for x := 1 to 7 do
    for y := 1 to 7 do
    begin
      if((promArr[x]=promArr[y])and (x <> y))then
      begin
        n:=promArr[y];
        replaceByZero(numArr,n);
      end;
    end;
  result:=promArr;
end;

begin
  for i:=1 to 7 do
  begin
    write('Введите ',i,' элемент массива: '); readln(numArr[i]);
  end;
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  writeln();
  unicalArr(numArr);
  for i:=1 to 7 do
  begin
    write(numArr[i],'|');
  end;
  readln();
end.
vedro-compota's picture

vedro-compota

Sat, 04/16/2022 - 20:14

засчитано

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