Haranmeu
08.10.2020 13:24

Модуль по турбо паскалю не меняется в файл .tpu, ошибки не выдаёт и при компилировании показывает что программа выполняется правильно.
unit Graf_01;
interface
uses Graph,Crt;
type fun=function(x:real):real; {$F+}
procedure GrafInit;
procedure Tree(a,n:integer; x,y,L,xL,yL:real);
procedure Triangle(xa,ya,xb,yb,xc,yc,n:integer);
procedure Kantor(x,y:integer;size:word);
procedure FGraf(a,b,dx:real; f:fun; maxX,maxY:integer);
implementation
procedure GrafInit;
{ инициализация графического режима }
var gd,gm,ErrorCode:integer;
begin
gd:=Detect; { выбор графического драйвера }
InitGraph(gd, gm, 'c:\case\bp\bgi');
ErrorCode:=GraphResult;
if ErrorCode <> grOk
then begin
writeln('Error_Init:',GraphErrorMsg(ErrorCode)); Halt
end
end;
procedure Tree(a,n:integer; x,y,L,xL,yL:real);
{ построение фрактального дерева }
var r:real;
begin
if (n>0) and (not keypressed)
then begin
SetColor(21-n); { установка цвета линии }
xL:=0.5*(x+xL); yL:=0.5*(y+yL); r:=a*pi/180;
x:=xL+L*cos(r); y:=yL-L*sin(r);
Line(round(x),round(y),round(xL),round(yL)); { рисует отрезок прямой}
Tree(a-30,n-1,x,y,L/2,xL,yL); {рекурсивный вызов}
Tree(a+30,n-1,x,y,L/2,xL,yL);
Tree(a-45,n-1,x,y,L/2,xL,yL);
Tree(a+45,n-1,x,y,L/2,xL,yL);
Tree(a+15,n-1,x,y,L/1.5,xL,yL);
Tree(a+30,n-1,x,y,L/1.5,xL,yL);
end
end;
procedure Triangle(xa,ya,xb,yb,xc,yc,n:integer);
{ построение треугольника Серпинского}
var xp,xq,xr,yp,yq,yr:integer;
begin
if n > 0
then begin
xp:=(xb+xc) div 2; yp:=(yb+yc) div 2;
xq:=(xa+xc) div 2; yq:=(ya+yc) div 2;
xr:=(xb+xa) div 2; yr:=(yb+ya) div 2;
Line(xp,yp,xq,yq); Line(xq,yq,xr,yr); Line(xp,yp,xr,yr);
Triangle(xa,ya,xr,yr,xq,yq,n-1);
Triangle(xb,yb,xp,yp,xr,yr,n-1);
Triangle(xc,yc,xq,yq,xp,yp,n-1);
end
end;
procedure Kantor(x,y:integer;size:word);
{ построение множества Кантора }
var s:word;
procedure SolidRec(x,y,size:integer);
begin
Rectangle(x-size,y-size,x+size,y+size); { рисует прямоугольник}
Bar(x-size+1,y-size+1,x+size-1,y+size-1); {закрашеный квадрат}
end;
begin
if size>1
then begin
s:=size div 2;
Kantor(x-size,y+size,s); Kantor(x-size,y-size,s);
Kantor(x+size,y+size,s);Kantor(x+size,y-size,s);
end;
SolidRec(x,y,size)
end;
procedure FGraf(a,b,dx:real; f:fun; maxX,maxY:integer);

const Ots=10;
procedure MaxMinF(a,b,dx:real;f:fun; var fmin,fmax:real);
var w,x:real; k,n:integer;
begin
fmin:=f(a); fmax:=f(a); n:=trunc((b-a)/dx)+1;
for k:=0 to n do begin
x:=a+k*dx; w:=f(x);
if w < fmin then fmin:=w;
if w > fmax then fmax:=w
end
end;
var fmin,fmax,mx,my,x:real; n,x0,y0,k,xg,yg:integer;
begin
{ определение начала координат }
x0:=maxX div 2; y0:=maxY div 2;
Line(Ots,y0,maxX-Ots,y0); { проведение оси Ox}
Line(x0,Ots,x0,maxY-Ots); { проведение оси Oy}
MaxMinF(a,b,dx,f,fmin,fmax); { вычисление fmin, fmax на отрезке [a,b] }
mx:=(maxX-2*Ots)/(b-a); { масштаб по оси х}
my:=(maxY-2*Ots)/(fmax-fmin); { масштаб по оси y}
MoveTo(x0+trunc(mx*a),y0-trunc(my*f(a))); {установка курсора в начало графика}
n:=trunc((b-a)/dx)+1;
for k:=0 to n do begin
x:=a+k*dx;
xg:=x0+trunc(mx*x); { графические координаты по оси x}
yg:=y0-trunc(my*f(x)); { графические координаты по оси y}
LineTo(xg,yg); { проведение кривой}
end
end;
end.

Нажмите на рекламу ниже и сразу увидите ответ
Популярные вопросы:
Ответ:
AlinaVaisberg
24.12.2022 05:35
// PascalABC.Net 3.0, сборка 1064
// "Классическое" решение
const
  nn=20;

type
  SqMatrix=array[1..nn,1..nn] of integer;

function AvgRow(row,cols:integer; a:SqMatrix):double;
var
  j,s:integer;
begin
  s:=0;
  for j:=1 to cols do s:=s+a[row,j];
  AvgRow:=s/cols
end;

var
  i,j,n,k:integer;
  cavg:double;
  M:SqMatrix;
 
begin
  Write('Количество строк (столбцов) в матрице: '); Read(n);
  Write('Ограничение для среднего арифметического: '); Read(cavg);
  Randomize;
  // Инициализация и вывод исходной матрицы
  Writeln('*** Сгенерированная матрица ***');
  for i:=1 to n do begin
    for j:=1 to n do begin
      M[i,j]:=Random(51)-20;
      Write(M[i,j]:4)
    end;
    Writeln
  end;
  // Собственно, решение задачи
  k:=0;
  for i:=1 to n do
    if AvgRow(i,n,M)<cavg then Inc(k);
  Writeln('Количество отобранных строк равно ',k)
end.

Тестовое решение:
Количество строк (столбцов) в матрице: 10
Ограничение для среднего арифметического: 2
*** Сгенерированная матрица ***
  -5  10  29  25  23   0 -17   5 -19  -4
   4 -10  -4  13   3 -15  17  16  -4 -18
  -6  24  -4  19 -16 -15  11  -4  14  -3
  -7  -5 -10  -2 -17  19 -16  -2   4 -10
  26  25  29  -8  27  20  13 -10  -9   9
  -3 -11  18 -12   0   2  -7 -10  20  17
  19  18  22  14 -18 -11 -20  28   9  15
 -19  -1  -9 -15 -13  -1  25 -16  22  -5
   3   1 -16 -16 -20 -17   8 -18  28  12
   5  24   8  18   2 -12 -17  -6 -11  18
Количество отобранных строк равно 5

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

// PascalABC.Net 3.0, сборка 1064
// Решение, использующее возможности версии 3.0

var
  n: integer;
  cavg: double;
  M: array of array of integer;

begin
  Write('Количество строк (столбцов) в матрице: '); Read(n);
  Write('Ограничение для среднего арифметического: '); Read(cavg);
  // Инициализация и вывод исходной матрицы
  Writeln('*** Сгенерированная матрица ***');
  SetLength(M, n);
  for var i := 0 to n - 1 do
    begin M[i] := ArrRandom(n, -25, 25); M[i].Println end;
  // Собственно, решение задачи
  var k:=M.Select(x->x.Average < cavg).Count(x->x=True);
  Writeln('Количество отобранных строк равно ', k)
end.

Тестовое решение:
Количество строк (столбцов) в матрице: 10
Ограничение для среднего арифметического: 2
*** Сгенерированная матрица ***
-23 -13 13 20 20 -6 22 9 15 -12
8 12 20 -12 -10 16 -1 10 13 1
17 -16 -8 20 1 24 9 -8 4 15
12 7 -9 21 13 11 15 -25 -10 -24
1 3 16 15 -3 -17 23 -12 -15 4
8 -2 10 -17 23 19 20 19 -7 21
11 5 -21 25 1 -24 -4 24 0 5
-24 -1 -6 12 -25 -11 -6 2 -2 -7
-25 -5 -19 -25 -18 -11 23 -18 24 20
16 22 7 -6 -10 22 -2 16 -12 -4
Количество отобранных строк равно 4
0,0(0 оценок)
Ответ:
juliana123456
05.05.2023 17:31
Здравствуйте! В этом сочинении я расскажу, почему хочу поступить на факультет информатики.

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

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

Во-первых, программист никогда не останется без работы. Круг его деятельности невообразимо широк. Он нужен везде, на любом современном производстве.

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

Как видите, мой выбор основан не на каких то пустяках, а на реальной заинтересованности в ней. Ведь - главное, это чтобы работа была тебе по душе!
0,0(0 оценок)
Полный доступ
Позволит учиться лучше и быстрее. Неограниченный доступ к базе и ответам от экспертов и ai-bota Оформи подписку
logo
Начни делиться знаниями
Вход Регистрация
Что ты хочешь узнать?
Спроси ai-бота