Developing.ru

Код: Выделить всё

(*Пусть дана прямоугольная матрица А(n x m), элементами которой являются целые 
числа.Определите для каждого элемента позиции элементов матрицы с такой же 
суммой цифр.*)
uses crt;
type matr=array[1..10,1..10]of integer;
procedure summa(a:integer; var s:integer); {сумма цифр элемента}
  begin
    s:=0; {обнуляем сумму}
    if a<10 {если в числе одна цифра}
    then s:=a {то присваиваем эту цифру сумме}
    else while a>9 do {иначе пока число болше 9}
           begin
             s:=a mod 10+s; {суммируем последнюю цифру и основную сумму}
             a:=a div 10; {отбрасываем последнюю цифру}
             if a<10 then s:=s+a; {если число стало меньше 9, то фиксируем это в сумме}
           end;
  end;

procedure poz(ma:matr; n,m:integer); {позиция элемента}
  var i,j,i_prom,j_prom,sum,sum_prom,chislo,nom,kol:integer;
  begin
    nom:=1; {nom - номер элемента по порядку: 1}
    for i:=1 to m do
      for j:=1 to n do
        begin
          writeln(nom,' элемент (',ma[i,j],'): ');
          chislo:=ma[i,j]; {присваиваем переменной значение текущего элемента матрицы}
          summa(chislo,sum); {находим сумму цифр элемента}
          for i_prom:=1 to m do
            for j_prom:=1 to n do
              begin
                chislo:=ma[i_prom,j_prom];
                summa(chislo,sum_prom);
                if (sum=sum_prom)and((i<>i_prom)and(j<>j_prom)) {суммы= и элемент не один и тот же}
                then begin
                       write('(',i_prom,' : ',j_prom,') '); {выводим координаты}
                       kol:=kol+1; {подсчитываем кол-во кординат}
                     end
                else write;
              end;
          if kol=0 then write('нет'); {нет элементов с такой же суммой цифр}
          kol:=0; {обнуляем кол-во координат}
          writeln;
          nom:=nom+1; {меняем номер элемента}
        end;
  end;

var m,n,i,j:integer;
    a:matr;
begin
  clrscr; {очистка экрана}
  randomize; {включение датчика случайных чисел}
  write('Размерность (n x m): ');
  readln(n,m); {размерность матрицы}
  {заполнение матрицы случайными числами и вывод на экран}
  for i:=1 to m do {счетчик столбцов}
    begin
      for j:=1 to n do {счетчик строк}
        begin
          a[i,j]:=random(21); {заполнение}
          write(a[i,j]:3); {вывод}
        end;
      writeln;
    end;

  poz(a,n,m);
  readln;
end.

Код: Выделить всё

function summa(a:integer):integer;
var s:integer;
begin
  s:=0;
  while a>0 do
  begin
     inc(s,a mod 10);
     a:=a div 10;
  end;
  summa:=s;
end;

Код: Выделить всё

procedure find_even_sum(ma:matr;x,y:integer);
var i,j,sum:integer
begin
  sum:=summa(ma[x,y]);
  for i:=1 to 10 do
  for j:=1 to 10 do
  begin
      if (i=x) and  (j=y) then continue;
      if summa(ma[i,j])=sum then writeln(i,':',j);
  end;
end;