Еще одна девушка в беде!Помогите!

За вознаграждение или нахаляву (если повезёт)

Модераторы: Хыиуду, MOTOCoder, Medved, dr.Jekill

Ответить
Vickie
Сообщения: 1
Зарегистрирован: 06 апр 2007, 11:55

Приветик!Помогите пожалуйста,я переводчик,а меня в универе заставляют решеть задачу по програмированию.В общем это какая-то катастрофа,задачи не большие,но я даже не имею представления,как это сделать...
(с помощью Pascal, с функцией и процедурой)
1.Выбрать три разные точки заданного на плоскости множества точек, являющиеся верши-нами треугольника наибольшего периметра.
2.Найти все натуральные числа, не превосходящие заданного числа n, десятичная запись ко-торых есть строго возрастающая или строго убывающая последовательность цифр.
Хыиуду
Сообщения: 2442
Зарегистрирован: 06 мар 2005, 21:03
Откуда: Москва
Контактная информация:

1. Допустим A - массив от 1 до N, содержащий координаты точек этого множества (x,y).

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

type TPoint=record
    x,y:integer;
    end;
function range(i,j:TPoint):real;
begin range:=sqrt(sqr(i.x-j.x)+sqr(i.y-j.y)); end;
var i,j,k,maxi,maxj,maxk:integer;
A:array[1..N] of TPoint;
begin
  maxi:=1;
  maxj:=2;
  maxk:=3;
for i:=1 to N-2 do
for j:=i to N-1 do
for k:=j to N do
if range(A[i],A[j])+range(A[j],A[k])+range(A[i],A[k]) > 
  range(A[imax],A[jmax])+range(A[jmax],A[kmax])+range(A[imax],A[kmax]) then
  begin     imax:=i; jmax:=j; kmax:=k;    end;
writeln('Точки: ',imax.x,':',imax.y,', ',jmax.x,':',jmax.y,', ',kmax.x,':',kmax.y);
end;
Вторая задача - в цикле проходить все числа и проверять на возрастание/убывание

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

function is_incdec(x:integer):boolean;
var s:string; i:byte; vozr:boolean;
begin 
  s:=inttostr(x);
  if s[1]<s[2] then vozr:=true else vozr:=false;
result:=true;
for i:=1 to length(s)-1 do
if (vozr and (s[i]>s[i+1])) or (not vozr and (s[i]<s[i+1])) then
begin result:=false; break; end;
is_incdec=result;
end;
Искусство программирования - заставить компьютер делать все то, что вам делать лень.
Для "спасибо" есть кнопка "Спасибо" в виде звездочки внизу под ником автора поста.
Аватара пользователя
somewhere
Сообщения: 1858
Зарегистрирован: 31 авг 2006, 17:14
Откуда: 71 RUS
Контактная информация:

1-ая задача:
Вкратце обьясню смысл
- Вначале инициализируются произвольно точки на плоскости в количестве 100 штук
- Известна функция определения расстояния между двумя точками из курса геометрии 7-го класса
- Периметр есть сумма растояний между отдельно взятыми точками.
- Выполняется тупой перебор всех точек на плоскости, 100х99х98 комбинаций
- Запоминается значение периметра и собственно сами образующие точки и выводятся на экран по завершении перебора.

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

Uses crt;

Type
TPoint = Record X:Integer;
                Y:Integer;
         end;

var Points : Array[1..100] of TPoint;
     x,y,z : Integer;
   p, maxp : Real;
  xm,ym,zm : Integer;

procedure InitPoints;
var x: Integer;
begin
Randomize;
For x:=1 to 100 do
	begin
        Points[x].X := 500 - Random(1000);
        Points[x].Y := 500 - Random(1000);
        end;
end;

Function Distance(A,B:TPoint):Real;
var x,y: Real;
begin
x := A.x - B.x;
y := A.y - B.y;
Distance := sqrt(x*x+y*y);
end;

Function Perimeter(A,B,C:TPoint):Real;
begin
Perimeter := Distance(A, B) + Distance(A, C) + Distance(B, C);
end;

begin
ClrScr;
InitPoints;
xm := 0; ym := 0; zm := 0;
maxp := -1;
For x := 1 to 98 do
    For y := x+1 to 99 do
    	For z := y+1 to 100 do
            begin
            P := Perimeter(Points[x], Points[y], Points[z]);
            If P > MaxP then
            	begin
                MaxP := P;
                xm := x;
                ym := y;
                zm := z;
                end;
            end;
if maxp > 0 then
	begin
        Writeln('Maximum perimeter = ', maxp:10:2);
        Writeln('This triangle has following point coordinates:');
        Writeln('A(',Points[xm].X,',',Points[xm].Y,'),',
                'B(',Points[ym].X,',',Points[ym].Y,'),',
                'C(',Points[zm].X,',',Points[zm].Y,')');
        end;
end.
It's a long way to the top if you wanna rock'n'roll
Ответить