Опытный
Профиль
Группа: Участник
Сообщений: 379
Регистрация: 9.11.2005
Репутация: 26
Всего: 31
|
| Цитата |
Составить алгоритмы, Paskal
|
Pascal. Цитата(LASSKA @ 8.11.2008, 11:56  ) | | 1. Треугольник со сторонами А,В,С является равнобедренным |
| Код |
program IsoscalesTriangle;
function ReadSideLength( strSideName : string ) : integer;
{функция чтения значения переменной}
var
iValue : integer;{вводимое значение}
begin
repeat
writeln( 'Please enter ', strSideName, ' :' );
readln( iValue );{чтение значения}
if( iValue <= 0 ) then{если значение неположительно}
writeln( 'Invalid value of ', strSideName, '.' );
until iValue > 0;{прекращение цикла при положительном значении iValue}
ReadSideLength := iValue;{возвращаем результат}
end;
function IsTriangle( iSideA, iSideB, iSideC : integer ) : boolean;
{функция проверяет могут ли длины, являться длинами сторон треугольника}
begin
IsTriangle := ( iSideA < iSideB + iSideC ) and ( iSideB < iSideA + iSideC ) and ( iSideC < iSideA + iSideB );
end;
function IsIsoscalesTriangle( iSideA, iSideB, iSideC : integer ) : boolean;
{функция проверяет можно ли составить равнобедренный треугольник из длин сторон}
begin
IsIsoscalesTriangle := ( iSideA = iSideB ) or ( iSideA = iSideC ) or ( iSideB = iSideC );
end;
var
A, B, C : integer;{длины сторон треугольника}
begin
{чтение длин сторон}
A := ReadSideLength( 'A' );
B := ReadSideLength( 'B' );
C := ReadSideLength( 'C' );
if( IsTriangle( A, B, C ) ) then{если из сторон можно составить треугольник}
begin
writeln( 'Result:' );
{треугольник равнобедренный, если у него совпадают длины 2-х сторон}
if( IsIsoscalesTriangle( A, B, C ) ) then
writeln( 'TRUE.' )
else
writeln( 'FALSE.' );
end
else
writeln( 'Result : NOT TRIANGLE.' );
readln;{ждем ввода}
end.
|
| Цитата(LASSKA @ 8.11.2008, 11:56 ) | | 2. Сумма двух последних цифр заданного трехзначного числа N меньше заданного числа K, первая цифра больше 5 |
| Код |
program NumberParts;
function ReadValue( strValueName : string; iMinValue, iMaxValue : integer ) : integer;
{процедура чтения значения из диапазона [ iMinValue, iMaxValue ] }
var
iValue : integer;{вводимое значение}
begin
repeat
writeln( 'Please enter ', strValueName, ' [ ', iMinValue, ', ', iMaxValue,' ]:' );
readln( iValue );
if( ( iValue < iMinValue ) or ( iValue > iMaxValue ) ) then
writeln( 'Invalid data. ', strValueName, ' must be in [ ', iMinValue, ', ', iMaxValue, ' ]' );
until ( iValue >= iMinValue ) and ( iValue <= iMaxValue );{выход из цикла, если значение из диапазона}
end;
function GetSumLastCiphers( iNumber, iCiphers : integer ) : integer;
{функция возвращает сумму последних iCiphers цифр числа iNumbers}
var
i, iRes : integer;{i - счетчик, iRes - результат}
begin
iRes := 0;{инициализация результата}
for i := 1 to iCiphers do
begin
iRes := iRes + iNumber mod 10;{прибавляем к результату последнюю цифру iNumber}
iNumber := iNumber div 10;{отрезаем единицы от числа iNumber}
end;
GetSumLastCiphers := iRes;{возвращаем результат}
end;
function GetFirstCipher( iNumber : integer ) : integer;
{функция возвращает первую цифру числа iNumber}
var
iRes : integer;{результат}
begin
iRes := 0;{инициализация результата}
while( iNumber <> 0 ) do{пока не дошли до последней цифры}
begin
iRes := iNumber mod 10;{заплминаем последнюю цифру числа iNumber}
iNumber := iNumber div 10;{отрезаем единицы от iNumber}
end;
GetFirstCipher := iRes;{возвращаем результат}
end;
var
N, K : integer;{N - вводимое значение, K - "некоторое заданное число K"}
begin
N := ReadValue( 'N', 100, 999 );{читаем число N из диапазона [100, 999]}
writeln( 'Please enter K:' );
readln( K );{читаем "некоторое заданное число K"}
{печать результата}
writeln( 'Result:' );
if( ( GetSumLastCiphers( N, 2 ) < K ) and ( GetFirstCipher( N ) > 5 ) ) then
writeln( 'TRUE' )
else
writeln( 'FALSE' );
readln;{ждем ввода}
end.
|
| Цитата(LASSKA @ 8.11.2008, 11:56 ) | | 4. Даны две точки А(x1,y1) и В(x2,y2). Составить алгоритм программы, определяющий, которая из точек находится ближе к началу координат. |
| Код |
program Points;
function GetVectorLength( x, y : real ) : real;
{функция возвращает длину вектора с координатами (x,y)}
begin
GetVectorLength:= sqrt( sqr( x ) + sqr( y ) );{ корень из суммы квадратов координат }
end;
var
x1, y1, x2, y2, fLength1, fLength2 : real;{x1,y1,x2,y2 - координаты; fLength1,fLength2 - расстояние до O}
begin
{ввод координат}
writeln( 'Please enter x1:' );
readln( x1 );
writeln( 'Please enter y1:' );
readln( y1 );
writeln( 'Please enter x2:' );
readln( x2 );
writeln( 'Please enter y2:' );
readln( y2 );
{вычисление длин}
fLength1 := GetVectorLength( x1, y1 );
fLength2 := GetVectorLength( x2, y2 );
{печать результата}
writeln( 'Result:' );
if( fLength1 < fLength2 ) then
writeln( 'A' )
else if( fLength2 < fLength1 ) then
writeln( 'B' )
else
writeln( 'AB' );
readln;{ждем ввода}
end.
|
| Цитата(LASSKA @ 8.11.2008, 11:56 ) | | 5.Даны три числа А,В,С. Определить какое из них равно d, если не одно не ровно, то найти max(d-a, d-b, d-c) |
| Код |
program ThreeNumbers;
function GetMax( iValue1, iValue2, iValue3 : integer ) : integer;
{функция возвращает максимум из 3 цифр}
var
iRes : integer;
begin
iRes := iValue3;{инициализация результата третим значением}
if( iValue1 > iValue2 ) then{если первое значение больше второго}
begin
if( iValue1 > iValue3 ) then{если первое значение больше и третьего}
iRes := iValue1;{максимум - первое значение}
end
else if( iValue2 > iValue3 ) then{второе больше первого и второе больше третьего}
iRes := iValue2;{максимум второе значение}
GetMax := iRes;{возвращаем результат}
end;
var
A, B, C, D : integer;
bEqual : boolean;{встретилось ли число равное D}
begin
bEqual := false;{инциализация}
{ввод чисел}
writeln( 'Please enter A:' );
readln( A );
writeln( 'Please enter B:' );
readln( B );
writeln( 'Please enter C:' );
readln( C );
writeln( 'Please enter D:' );
readln( D );
{печать результата}
writeln( 'Result:' );
if( A = D ) then
begin
writeln( 'A = D' );
bEqual := true;
end;
if( B = D ) then
begin
writeln( 'B = D' );
bEqual := true;
end;
if( C = D ) then
begin
writeln( 'C = D' );
bEqual := true;
end;
if( not bEqual ) then{нет ни одного числа равного D}
writeln( 'MAX = ', D - GetMax( A, B, C ) );{печатаем максимум из 3 цифр}
readln;{ждем ввода}
end.
|
| Цитата(LASSKA @ 8.11.2008, 11:56 ) | 6.Даны действительные числа А,В,С (а>0). Полностью исследовать биквадратное уравнение
4 2
АХ + ВХ +С=0
(если действительных корней нет, то должно быть выдано сообщение об этом, иначе найти действительные корни, сообщить сколько среди них различных. |
| Код |
program BiquadraticEquation;
procedure GetRootsYEqualX2( y : real; var x1, x2 : real; var roots : integer );
{процедура возвращает количество корней и корни уравнения y = x^2}
begin
if( y < 0 ) then{нет действительных корней}
roots := 0{корней нет}
else if ( y = 0 ) then{1 действительный корень - 0}
begin
roots := 1;{1 корень}
x1 := 0;
end
else{ 2 действительных корня}
begin
roots := 2;{два корня}
y := sqrt( y );
x1 := y;
x2 := -y;
end;
end;
procedure PrintEquationRoots( y : real; var iRootsCount : integer );
{процедура печатает корни уравнения и увеличивает счетчик корней iRootsCount}
var
x1, x2 : real;{для хранения корней}
iRoots : integer;{количество корней}
begin
GetRootsYEqualX2( y, x1, x2, iRoots );{узнаем корни}
iRootsCount := iRootsCount + iRoots;{увеличиваем счетчик корней}
{печатаем корни}
if( iRoots > 0 ) then
writeln( 'x = ', x1 );
if( iRoots > 1 ) then
writeln( 'x = ', x2 );
end;
var
A, B, C, D, Y, x1, x2 : real;{A, B, C - коэффециенты, D - ди}
iRootsCount : integer;
begin
{ввод A, должно быть > 0}
repeat
writeln( 'Please enter A' );
readln( A );
if( A <= 0 ) then
writeln( 'Invalid data. A must be > 0.' );
until( A > 0 );
{ввод B}
writeln( 'Please enter B:' );
readln( B );
{ввод C}
writeln( 'Please enter C:' );
readln( C );
iRootsCount := 0;{инициализация количесива корней}
{вычисление дискриминанта уравнения}
D := sqr( B ) - 4 * A * C;
{печать результата}
writeln( 'Result:' );
if( D < 0 ) then{дискриминант меньше 0, нет действительного решения, даже для квадратного уравнения}
writeln( 'ROOTS = 0' )
else
begin
if( D = 0 ) then{один корень квадратного уравнения}
PrintEquationRoots( -B / ( 2 * A ), iRootsCount )
else{ D > 0 - 2 корня квадратного уравнения}
begin
PrintEquationRoots( ( -B + sqrt( D ) ) / ( 2 * A ), iRootsCount );
PrintEquationRoots( ( -B - sqrt( D ) ) / ( 2 * A ), iRootsCount );
end;
writeln( 'ROOTS = ', iRootsCount );
end;
readln;{ждем ввода}
end.
|
| Цитата(LASSKA @ 8.11.2008, 11:56 ) | | 3. Для данных областей составить линейную программу, которая печатает true, если точка с координатами (x,y) принадлежит закрашенной области, и false – в противном. |
Условие не полное - умываю руки  . Это сообщение отредактировал(а) darkart - 8.11.2008, 17:20 |
Составить алгоритмы, Paskal 
Загрузка ...
