Здравствуйте, Посетитель - 360475!

Файл с ответами

Вот исправленный вариант.
В первом задании еще неправильно определялись радиусы вписанной и описанной окружностей:

Радиус вписанной окружности правильного треугольника со стороной D (rmin) равен .
Радиус описанной окружности (rmax) в 2 раза больше rmin и равен .

В третьем задании для определения соответствия условию использовано прямое вычисление квадратного корня с последующим возведением его в квадрат.

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

Ошибки по возможности были оставлены в комментариях.
Изменения выделены зеленым цветом.

Если есть вопросы или пожелания - пишите в мини-форум.

Здравствуйте, Посетитель - 360475!
1) Во-первых ошибка в определении радиуса описанной и вписанной окружностей
Во-вторых, if, действительно, не нужно.
[code h=200]program a1;
uses crt;
var
r2, d2:real;
function IsIn(R,D:real):boolean;
var rvpis,ropis:real;
begin
rvpis:=D/(2*sqrt(3));
ropis:=D/sqrt(3);
IsIn:= (R<=rvpis) or (R>=ropis);
end;

begin
clrscr;
write('Vvedite R i D:');
readln(r2,d2);
writeln(isIn(r2,d2));
readkey;
end.[/code]
3) Надо было округлить до целого корень из чисел и сравнить квадрат корня с числом
[code h=200]program a1;
uses crt;
var i,k:integer;
m:array[1..20] of integer;

begin
clrscr;
randomize;
for i:=1 to 20 do
begin;
m[i]:=random(100);
write(m[i]:3);
end;
writeln;
writeln;
for i:=1 to 20 do
begin;
k:=trunc(sqrt(m[i]));
if m[i] = k*k then writeln(m[i]:3);
end;
readkey;
end.[/code]
4)Вы забыли, что внутри функции нумерация индексов, в случае "открытых массивов", будет с 0
Должен заметить, что данный вариант не всеми компиляторами поддерживается.
Поэтому, более правильным вариантом следует считать вариант, предложенный Юрием Леонидовичем.
[code h=200]program a1;
uses crt;
const MaxA=100;
var A:array[1..MaxA] of byte;
i:byte;

function countNotZero(a:array of byte;n:byte):longint;
var
i:byte;
count:longint;
begin
count:=0;
for i:=0 to n-1 do
if a[i] <>0 then inc (count);
if count = 0 then count:=7777777;
countNotZero:=count;
end;

begin
clrscr;
randomize;
for i:=1 to MaxA do
begin
A[i]:=random(10);
write(A[i]:4);
end;
writeln('Found ',countNotZero(A,10));;
writeln('Done. Press any key...');
readkey;
end.[/code]
5) Несколько намудрили с циклами...
Посмотрите, как я сделал
[code h=200]program a1;
uses crt;
const n=8;
type sq_matr=array[1..n,1..n] of integer;
procedure output_matr(a:sq_matr); {процедура вывода матрицы}
var i,j:byte;
begin
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(a[i,j]:5);
end;
end;
procedure input_matr(var a:sq_matr); {процедура ввода матрицы}
var i,j:byte;
begin
randomize;
for i:=1 to n do
for j:=1 to n do
a[i,j]:=random(5);
end;
procedure nums(a:sq_matr; var num:byte); {процедура подсчета строк с максимальным элементом}
var i,j:byte;
max:integer;
begin
num:=0;
max:=a[1,1];
for i:=1 to n do
for j:=1 to n do
if max<a[i,j] then
max:=a[i,j]; {находим максимальный элемент}
for i:=1 to n do
for j:=1 to n do
if a[i,j]=max then
begin
inc(num);
break;
end;
end;


var a:sq_matr;
num:byte;
begin
input_matr(a);
output_matr(a);
writeln;
nums(a,num);
writeln;
writeln(num);
readkey;
end.
[/code]