program addition;
// обычное сложение в столбик
function add(a, b: string): string;
const
OFFSET = 48;
var
tmp: integer;
carry: integer;
index_a,
index_b: integer;
addend_a,
addend_b: integer;
begin
result := '';
// индексы последних цифр в каждой строке, т.к. сложение начинается справа налево
index_a := length(a);
index_b := length(b);
// значение переноса, то что держим в уме, когда в сумме получаем двузначное число
// например, 9 + 4 = 13: 3 пишем, а 1 в уме
carry := 0;
// продолжаем складывать, пока не пройдем по всем числам каждой строки
while (index_a <> 0) or (index_b <> 0) do
begin
// первое и второе слагаемые
addend_a := 0;
addend_b := 0;
// вместо выравнивания строк (дополнения нулями слева), я проверяю чтобы индекс не уходил в минус
if index_a > 0 then
begin
addend_a := ord(a[index_a]) - OFFSET;
dec(index_a);
end;
if index_b > 0 then
begin
addend_b := ord(b[index_b]) - OFFSET;
dec(index_b);
end;
// собственно само сложение
tmp := addend_a + addend_b + carry;
carry := tmp div 10;
result := chr((tmp mod 10) + OFFSET) + result;
end;
if carry > 0 then
result := chr(carry + OFFSET) + result;
end;
begin
writeln(add('999999999999999', '8009730000456465480001'));
// 8009731000456465480000;
end.program ChangeMatrix;
const
FileIn = 'C:\Users\admin\Documents\in.txt';
FileOut = 'C:\Users\admin\Documents\out.txt';
var
fin, fout: Text;
n: integer;
matrix: array of array of string;
row, col: integer;
src: string;
target: array of string;
counter: integer;
function Split(sep: string; source: string): array of string;
var
i: integer;
position: integer;
begin
result := Nil;
SetLength(result, n);
for i := 0 to n - 1 do
begin
position := Pos(sep, source);
if position > 0 then
begin
result[i] := Copy(source, 1, position - 1);
Delete(source, 1, position + Length(sep) - 1);
end
else
result[i] := source;
end;
end;
function Join(sep: string; source: array of string): string;
var
i: integer;
begin
result := source[0];
for i := 1 to n - 1 do
result := Concat(result, sep, source[i]);
end;
begin
Assign(fin, FileIn);
Reset(fin);
Assign(fout, FileOut);
Rewrite(fout);
While not EoF(fin) do
begin
// Читаем размер матрицы
Readln(fin, n);
// Обнуляем матрицу
matrix := Nil;
// Задаем размеры матрицы
SetLength(matrix, n);
for row := 0 to n - 1 do
SetLength(matrix[row], n);
// Читаем значения и заполняем матрицу
for row := 0 to n - 1 do
begin
Readln(fin, src);
target := Split(' ', src);
for col := 0 to n - 1 do
matrix[row][col] := target[col];
begin
end;
end;
// Удаляем элементы побочной диагонали
counter := 0;
row := n - 1;
col := 0;
while counter < n do
begin
matrix[row][col] := '*';
Dec(row);
Inc(col);
Inc(counter);
end;
// Записываем результат в файл
Writeln(fout, n);
for row := 0 to n - 1 do
begin
Writeln(fout, Join(' ', matrix[row]));
end;
end;
Close(fout);
Close(fin);
end.program ChangeMatrix;
const
DataFile = 'C:\Users\Jonathan\Documents\in.txt';
var
fdata: Text;
n: integer;
matrix: array of array of string;
change: array of string;
cursor: integer;
row, col: integer;
src: string;
target: array of string;
counter: integer;
function Split(sep: string; source: string): array of string;
var
i: integer;
position: integer;
begin
result := Nil;
SetLength(result, n);
for i := 0 to n - 1 do
begin
position := Pos(sep, source);
if position > 0 then
begin
result[i] := Copy(source, 1, position - 1);
Delete(source, 1, position + Length(sep) - 1);
end
else
result[i] := source;
end;
end;
function Join(sep: string; source: array of string): string;
var
i: integer;
begin
result := source[0];
for i := 1 to n - 1 do
result := Concat(result, sep, source[i]);
end;
begin
cursor := 0;
Assign(fdata, DataFile);
Reset(fdata);
While not EoF(fdata) do
begin
// Читаем размер матрицы
Readln(fdata, n);
// Обнуляем матрицу
matrix := Nil;
// Задаем размеры матрицы
SetLength(matrix, n);
SetLength(change, Length(change) + n + 1);
change[cursor] := IntToStr(n);
Inc(cursor);
for row := 0 to n - 1 do
SetLength(matrix[row], n);
// Читаем значения и заполняем матрицу
for row := 0 to n - 1 do
begin
Readln(fdata, src);
target := Split(' ', src);
for col := 0 to n - 1 do
matrix[row][col] := target[col];
begin
end;
end;
// Удаляем элементы побочной диагонали
counter := 0;
row := n - 1;
col := 0;
while counter < n do
begin
matrix[row][col] := '*';
change[cursor + row] := Join(' ', matrix[row]);
Dec(row);
Inc(col);
Inc(counter);
end;
Inc(cursor, n);
end;
Close(fdata);
Assign(fdata, DataFile);
Rewrite(fdata);
// Записываем результат в файл
for row := 0 to cursor - 1 do
begin
Writeln(fdata, change[row]);
end;
Close(fdata);
end.program transformation;
var
matrix: array of array of integer;
n, m: integer;
i, j: integer;
begin
Write ('M = ');
ReadLn (m);
Write ('N = ');
ReadLn (n);
// Создание размера динамического массива
SetLength(matrix, m);
for i := 0 to m - 1 do
SetLength(matrix[i], n);
// Заполнение матрицы
Randomize;
for i := 0 to m - 1 do
for j := 0 to n - 1 do
matrix[i, j] := Random(-100, 100);
// Вывод получившейся матрицы
WriteLn();
WriteLn('Исходная матрица:');
WriteLn();
for i := 0 to m - 1 do
begin
for j := 0 to n - 1 do
Write(matrix[i, j]:5);
WriteLn();
end;
// Преобразование матрицы
WriteLn();
WriteLn('Преобразованная матрица:');
WriteLn();
for i := 0 to m - 1 do
begin
for j := 0 to n - 1 do
begin
if matrix[i, j] < 0 then
matrix[i, j] := -1;
if matrix[i, j] > 0 then
matrix[i, j] := 1;
Write(matrix[i, j]:3);
end;
WriteLn();
end;
end.program MatrixArea;
const N = 5;
var
matrix: array[1..N, 1..N] of integer;
i, j: integer;
edge: integer;
sum: integer;
min: integer;
begin
randomize;
{заполняем массив}
for i := 1 to N do
for j := 1 to N do
matrix[i][j] := Random(50);
{печатаем массив}
for i := 1 to N do
begin
for j := 1 to N do
Write(matrix[i][j]:3);
WriteLn();
end;
WriteLn();
{печатаем заштрихованную область массива}
{находим минимальный элемент и сумму всех элементов в заштрихованной области}
edge := N;
min := matrix[1][edge];
sum := 0;
for i := 1 to N do
begin
for j := 1 to N do
begin
if (j >= edge) then
begin
sum := sum + matrix[i][j];
if (min > matrix[i][j]) then
min := matrix[i][j];
Write(matrix[i][j]:3);
end
else
Write('..':3);
end;
if (i < N div 2 + 1) then
edge := edge - 1
else
edge := edge + 1;
WriteLn();
end;
WriteLn();
WriteLn('Сумма: ', sum);
WriteLn('Минимальный элемент: ', min);
end.
Передача статического массива в подпрограмму
При передаче статического массива в подпрограмму по значению также производится копирование содержимого массива - фактического параметра в массив - формальный параметр:procedure p(a: Arr); // передавать статический массив по значению - плохо! ... p(a1);
Это крайне расточительно, поэтому статические массивы рекомендуется передавать по ссылке. Если массив не меняется внутри подпрограммы, то его следует передавать как ссылку на константу (const), если меняется - как ссылку на переменную:type Arr = array [2..10] of integer; procedure Squares(var a: Arr); begin for var i:= Low(a) to High(a) do a[i] := Sqr(a[i]); end; procedure PrintArray(const a: Arr); begin for var i:= Low(a) to High(a) do Print(a[i]) end; var a: Arr := (1,3,5,7,9,2,4,6,8); begin Squares(a); PrintArray(a); end.
Для доступа к нижней и верхней границам размерности одномерного массива используются функцииLowиHigh.
Program arrays;
type
tArray = array [0..3] of integer;
var
a, b: tArray;
i: integer;
procedure FirstProcedure(a, b: tArray);
begin
writeLn(a);
end;
begin
for i := Low(a) to High(a) do
begin
writeLn('WHAT IS A' + i + '?');
readLn(a[i]);
end;
for i := Low(b) to High(b) do
begin
writeLn('WHAT IS B' + i + '?');
readLn(b[i]);
end;
FirstProcedure(a,b);
end.program endless_sum;
var
x, i, j: integer;
y, sum: extended;
function power(x, n: integer): longint;
var
a, b: integer;
begin
if (n = 0) then power := 1;
if (n = 1) then power := x
else
begin
a := x;
for b := 2 to n do
a := a * x;
power := a;
end;
end;
begin
i := 1;
write('input x: ');
readln(x);
sum := x;
y := power(-1, i) * power(x, 2 * i);
for j := 1 to 2 * i do
y := y / j;
while (abs(y) > 0.0001) do
begin
sum := sum + y;
i := i + 1;
y := power(-1, i) * x;
for j := 2 to 2 * i do
y := y * x / j;
end;
writeln(sum:5:4);
readln();
end.program endless_sum;
var
x, i, j: integer;
y, sum: extended;
function power(x, n: integer): longint;
var
a, b: integer;
begin
if (n = 0) then power := 1;
if (n = 1) then power := x
else
begin
a := x;
for b := 2 to n do
a := a * x;
power := a;
end;
end;
begin
i := 1;
write('input x: ');
readln(x);
sum := x;
y := power(-1, i) * power(x, 2 * i);
for j := 1 to 2 * i do
y := y / j;
while (abs(y) > 0.0001) do
begin
sum := sum + y;
i := i + 1;
y := power(-1, i) * x;
for j := 2 to 2 * i do
y := y * x / j;
end;
writeln(sum:5:4);
readln();
end.x = 3
n = 4
xn = x
# (1 + 1)
sum = 2
for i in range(2, (2 * n + 1)):
xn *= x
sum *= (1 + xn)program hello;
var
x, n, xn, i: integer;
sum: int64;
begin
x := 3;
n := 4;
sum := 2;
xn := x;
for i := 2 to (2 * n) do
begin
xn := xn * x;
sum := sum * (1 + xn);
writeln(sum);
end;
writeln(sum);
readln();
end.var
a: longint;
begin
writeln('Введите целое число(не более 2100000000)');
readln(a);
while (a <> 0) do
begin
if a mod 2 = 0 then
writeln('Это число четное')
else
writeln('Это число нечетное');
writeln('Введите целое число(не более 2100000000)');
readln(a);
end;
end.Удачным периодом Вася считает такой период, когда рейтинг не понижался, а провальным, соответственно, когда рейтинг не рос. Наиболее удачным периодом Вася считает такой удачный период, на котором произошел наибольший рост рейтинга, а наиболее неудачным считает такой период, на котором произошло наибольшее падение. Помогите Васе по исходным данным найти изменения рейтинга за эти периоды.
procedure TForm1.Button1Click(Sender: TObject);
var
rect: array[0..2] of real;
tmp, p, s: real;
i: integer;
begin
rect[0] := StrToFloat(Edit1.Text);
rect[1] := StrToFloat(Edit2.Text);
rect[2] := StrToFloat(Edit3.Text);
if (rect[0] = rect[1]) and (rect[1] = rect[2]) then
begin
label1.Caption := 'Равносторонний';
Exit;
end;
if (rect[0] = rect[1]) or (rect[1] = rect[2]) or (rect[0] = rect[2]) then
begin
label1.Caption := 'Равнобедренный';
Exit;
end;
//сортируем массив
for i := 0 to 1 do
begin
tmp := rect[i + 1];
if (rect[i] > rect[i + 1]) then
begin
rect[i + 1] := rect[i];
rect[i] := tmp;
end;
end;
if (rect[0] > rect[1]) then
begin
tmp := rect[1];
rect[1] := rect[0];
rect[0] := tmp;
end;
if (sqrt(rect[0] * rect[0] + rect[1] * rect[1]) = rect[2]) then
begin
label1.Caption := 'Прямоугольный';
Exit;
end;
if (rect[0] * rect[0] + rect[1] * rect[1] > rect[2] * rect[2]) then
begin
label1.Caption := 'Тупоугольный';
p := (rect[0] + rect[1] + rect[2]) / 2;
s := sqrt(p * (p - rect[0]) * (p - rect[1]) * (p - rect[2]));
label1.Caption := 'Площадь: ' + FloatToStr(s) + #13;
for i := 0 to 2 do
label1.Caption := label1.Caption + FloatToStr(rect[i]) + #13;
Exit;
end;
end;