Задача 11 Урок 15 вопрос

Primary tabs

Submitted by i_love_cookies on Thu, 05/27/2021 - 20:29

Forums:

Урок 15. Одномерные массивы

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

type myArr  = array[1..7] of integer;

function NotUniqueIndex(arr: myArr):integer;
var i,j,notUnique:integer;
  begin
    for i:=1 to high(arr) do
      for j:=i to high(arr) do
        if ((arr[i]=arr[j]) AND (i<>j)) then
          begin
            notUniqueIndex:=j;
            result:=notUniqueIndex;
            break;
          end
  end;

function removeNotUnique(arr: myArr; notUnique: integer):myArr;
var i,arrLenght: integer;
begin
  arrLenght:= high(arr);
  for i:=notUnique to arrLenght do
     arr[i]:=arr[i+1];
  arr[arrLenght]:=0;
  arrLenght:= arrLenght-1;
  result:=arr;
end;

function isUnique(arr: myArr):boolean;
var i,j,arrLenght:integer;
flag:boolean;
begin
  arrLenght:= high(arr);
  for i:=1 to arrLenght do
    for j:=1 to arrLenght do
      if ((arr[i]=arr[j]) AND (i<>j) ) then   // проверка на уникальность
        begin
          flag:=false;
          arrLenght:= arrLenght-1;
          break;
        end;
  result:= flag;
end;

procedure writeArr(arr: myArr; msg:string);
var i:integer;
begin
    writeln(msg);
    for i:=low(arr) to high(arr) do
      write(arr[i], ' ');
    writeln();
   end;

var
  arr: myArr;
  i,NotUnique: integer;
  unique: boolean;
begin
  randomize;
  for i:=low(arr) to high(arr) do
    arr[i]:= random(5);
  writeArr(arr,'original array: ');
  repeat
    NotUnique:= NotUniqueIndex(arr);
    writeln('not unique index ', NotUnique);
    arr:=removeNotUnique(arr,NotUnique);
    writeArr(arr,'array modify: ');
    unique:= isUnique(arr);
    writeln('is unique? ',unique);
  until (unique);
  writeln('over');
  readln();
end.
  • Log in to post comments
  • 2103 reads
vedro-compota's picture

vedro-compota

Thu, 05/27/2021 - 20:41 

  for i:=1 to arrLenght do
    for j:=1 to arrLenght do

-- вложенный цикл должен быть или в теле в основной подпрограмме.

Базовая сложность тут NxN

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

i_love_cookies

Mon, 05/31/2021 - 14:06 

type myArr  = array[1..7] of integer;

function NotUniqueIndex(arr: myArr):integer;
var i,j,notUnique:integer;
  begin
    for i:=1 to high(arr) do
      for j:=1 to high(arr) do
        if ((arr[i]=arr[j]) AND (i<>j) AND (arr[j] <> 0) ) then
          begin
            notUniqueIndex:=j;     // вычислить не уникальный индекс
            result:=notUniqueIndex;
            break;
          end
  end;

function removeNotUnique(var arr: myArr; notUnique: integer):myArr;
var i,arrLenght: integer;
begin
  arrLenght:= length(arr);
  for i:=notUnique to arrLenght do
    begin
      arr[i]:=arr[i+1];   // удалить дубли
    end;
    arr[arrLenght]:=0;
    arrLenght:= arrLenght-1;  // сократить длинну итерируемого массива в будующем
  result:=arr;
end;

procedure writeArr(arr: myArr; msg:string);
var i:integer;
begin
    writeln(msg);
    for i:=low(arr) to high(arr) do
      write(arr[i], ' ');
    writeln();
   end;

var
  arr: myArr;
  i,NotUnique: integer;
begin
  randomize;
  for i:=low(arr) to high(arr) do
    arr[i]:= random(8);
  writeArr(arr,'original array: ');
  repeat
    NotUnique:= NotUniqueIndex(arr);
    if (NotUnique = 0) then break;
    writeln('not unique index ', NotUnique);
    arr:=removeNotUnique(arr,NotUnique);
    writeArr(arr,'array modify: ');
  until (NotUnique = 0);
  writeln('over');
  readln();
end.
//original array:
//3 3 5 5 3 1 6
//not unique index 1
//array modify:
//3 5 5 3 1 6 0
//not unique index 1
//array modify:
//5 5 3 1 6 0 0
//not unique index 1
//array modify:
//5 3 1 6 0 0 0
//over