Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Умоляю помогите решить задачи по Паскалю!  (Прочитано 17806 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Alenka_kiss
Гость
« : 27-01-2006 09:06 » 

Форумчане! Умоляю, помогите журналисту разобраться с Паскалем!
Задачи посвящены динамическим структурам данных и графическому программированию.

Задача 1
Используя представление последовательности чисел в виде линейного списка, напишите программу сортировки этой последовательности при помощи алгоритма простого обмена.

Задача 2
Соединить конечное множество точек на плоскости замкнутой ломаной линией без самопересечений с вершинами в этих точках. (Полный перебор не делать; ответом будет порядок обхода точек плоскости.) Указание: перейти к полярным координатам и упорядочить точки по значениям угла, а для точек с одинаковым значением угла – по расстоянию до полюса.

На первую задачу есть наметки:
Код:
program Project1; 

uses
SysUtils;

Type
List= ^Node;
Node = record
info: Integer;
next: List
end;

Var
p, s: List;
i, x, n: Integer;

Procedure Out_spisok(l: List);
Var
s: List;
begin
While l <> nil do
begin
s:= l^.next;
Write(l^.info,' ');
l:= s;
end;
WriteLn;
end;

Procedure Sorting(l: List);
Var
p, LL: List;
k: Integer;
isExchanged: Boolean;
begin
LL:= l;
Repeat
l:= LL;
p:= l^.next;
isExchanged:= False;
while p <> nil do
begin
if p^.info > l^.info then
begin
isExchanged:= True;
k:= p^.info;
p^.info:= l^.info;
l^.info:= k;
l:= l^.next;
p:= p^.next;
end;
end;
Until not isExchanged;
end;

begin
Write('Vvedite kol-vo elementov spiska: ');
ReadLn(n);
s:= nil;
For i:= 1 to n do
begin
New(p);
p^.next:= s;
Write('Vvedite chislo: ');
ReadLn(x);
p^.info:= x;
s:= p;
end;
Write('Vvedennaya posledovatelnost: ');
Out_spisok(p);
Sorting(p);
Write('Otsortirovannaya posledovatelnost: ');
Out_spisok(p);
ReadLn;
end.


Но здесь не все правильно.
Не знаю куда еще обратиться за помощью.
« Последнее редактирование: 04-12-2007 20:37 от Алексей1153++ » Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #1 : 27-01-2006 09:42 » 

не вдаваясь в подробности сортировки
смотри здесь
Код:
Procedure Sorting(l: List); 
надо
Код:
Procedure Sorting(var l: List); 
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #2 : 27-01-2006 09:44 » 

И сразу же вопрос.
А кучу кто чистить после тебя будет?
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Alenka_kiss
Гость
« Ответ #3 : 27-01-2006 11:58 » 

Вот из-за этой маленькой поправочки не работала что ли и все?
Записан
Alenka_kiss
Гость
« Ответ #4 : 27-01-2006 12:00 » 

А что такое куча и как ее надо правильно чистить?
Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #5 : 27-01-2006 13:28 » 

Цитата
Вот из-за этой маленькой поправочки не работала что ли и все?
По способу передачи параметры в Паскале делятся на типы: параметры-значения, параметры-переменные.
Если разберешься с параметрами - поймешь.

New - выделяет память под указатель
Dispose - освобождает память
Т.е. создавая список под каждую запись ты в "куче" (динамической области памяти) выделяешь область памяти.
Заканчивая программу, занятую тобой память нужно освободить (в данном случае удалить список)
С другой стороны, если программа предназначна только для твоей задачи, то при завершении встроеный менеджер памяти сам все почистит.
Эту неприятность можно обойти используя функции Mark и Release.
« Последнее редактирование: 27-01-2006 13:35 от Sla » Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
PooH
Глобальный модератор

ru
Offline Offline
Пол: Мужской
... и можно без хлеба!


« Ответ #6 : 27-01-2006 13:40 » 

после Until not isExchanged; надо добавить l:= LL;
Код:
Until not isExchanged;
l:= LL;
а "кучу" можешь освободить так (примерно так, давно на паскале не писал, могу ошибаться):
Код:
while p <> nil do 
begin
   s := p^.next;
   Dispose (p);
   p := s;
end;
это надо добавить после второго Out_spisok(p);
« Последнее редактирование: 27-01-2006 14:02 от PooH » Записан

Удачного всем кодинга! -=x[PooH]x=-
Alenka_kiss
Гость
« Ответ #7 : 13-02-2006 02:39 » new

На счет второй задачи про соединить точки. Мне помогли ее решить. Только я не могу комментарии написать.
Код:
uses 
  graph,
  crt;

const K = 10;  {kol-vo tochek}

type tPoint = record
    x, y: real;
    n: integer;
end; { record}

type tPoints = array [1..K] of tPoint;

procedure dec2pol (var p: tPoint);
    var t: tPoint;
begin { dec2pol }
    t. n := p. n;
    if p. x = 0 then begin
if p. y = 0 then
    t. x := 0
else
    t. x := 90;
    end else
t. x := 180 * arctan (p. y / p. x) / Pi;
    t. y := sqrt (sqr (p. x) + sqr (p. y));
    p := t;
end; { dec2pol }

procedure swap (var x, y: tPoint);
    var t: tPoint;
begin { swap}
    t := x;
    x := y;
    y := t;
end; { swap}

procedure transit (p1: tPoint; var p2: tPoint);
begin { transit}
    p2. x := p2. x - p1. x;
    p2. y := p2. y - p1. y;
end; { transit }

var points: tPoints;
    t, p1, p2: tPoint;
    i, j, N: integer;
    grDriver, grMode: integer;
    minXY: tPoint;

begin { main program }

    minXY. x := 0;
    minXY. y := 0;
    Write('Vvedite kolichestvo tochek (do 10-ti): ');
    ReadLn(N);
    WriteLn('Vvedite koordinaty tochek. -320<x<320 -240<y<240');
    for i := 1 to N do begin
points [i]. n := i;
Write('Tochka ', i, ':');
        readLn (points [i]. x, points [i]. y);
    end; {for}
    minXY := points [1];
    for i := 2 to N do begin
        if (points [i]. x < minXY. x) then
            minXY. x := points [i]. x;
        if (points [i]. y < minXY. y) then
            minXY. y := points [i]. y;
    end;
    for i := 1 to N - 1 do begin
        p1 := points [i];
        transit (minXY, p1);
        dec2pol (p1);
        for j := i + 1 to N do begin
            p2 := points [j];
            transit (minXY, p2);
            dec2pol (p2);
            if p2. x < p1. x then begin
                swap (points [i], points [j]);
                swap (p1, p2);
            end; { if }
        end; { for }
    end; { for }
    for i := 1 to N - 1 do begin
        p1 := points [i];
        transit (minXY, p1);
        dec2pol (p1);
        for j := i + 1 to N do begin
            p2 := points [j];
            transit (minXY, p2);
            dec2pol (p2);
            if (p2. x = p1. x) and (p2. y < p2. y) then begin
                swap (points [i], points [j]);
                swap (p1, p2);
            end; { if }
        end; { for }
    end; { for }
{vyvod poryadka obchoda tochek}
    write('Poryadok obhoda tochek: ');
    for i := 1 to N do
        Write(points [i]. n : 3);
    WriteLn;
    Write ('Zamknutaja lomannaja - nagmi <Enter>');
    ReadLn;
{risuem lomannuu}
    grDriver := 9;
    grMode := 2;
    InitGraph (grDriver, grMode, 'С:\BP\BGI');

    if GraphResult = grOk then begin
        ClearDevice;
        MoveTo (320, 0);
        LineTo (320, 480);
        MoveTo (0, 240);
        LineTo (640, 240);
        MoveTo (320 + trunc (points [1]. x), 240 - trunc (points [1]. y));
        setcolor(13); {choby lomannaja ne slivalas s osyami koordinat, i potomu chto
tak krasivee};
for i := 2 to N do
            LineTo (320 + trunc (points [i]. x), 240 - trunc (points [i]. y));
        LineTo (320 + trunc (points [1]. x), 240 - trunc (points [1]. y));
    while not KeyPressed do ;
    end else
        Writeln ('graph initialization fault');
CloseGraph;
end. {main program}

« Последнее редактирование: 04-12-2007 20:41 от Алексей1153++ » Записан
Sands
Помогающий

ua
Offline Offline

« Ответ #8 : 22-02-2006 21:35 » 

Я бы делал немного по другому. Просто задача №2 очень похожа на задачу о постороении опуклой оболочки, посему и решать ее можно похоже.
Алгоритм:
1. Найти самую нижнюю точку множества.
2 Для каждой точки множества найти угол между осью Х, которая проходит через самую нижнюю точку и отрезком который соединяет данную точку с самой нижней.
3. Отсортировать точки по возростанию угла(если угол одинаковый то по возрастанию расстояния до самой нижней точки)
4. Вывести порядок обхода.

По-моему немного проще чем переход в полярную систему. Хотя принцип тот же
« Последнее редактирование: 04-12-2007 20:42 от Алексей1153++ » Записан
DanZer
Гость
« Ответ #9 : 02-03-2006 09:54 » 

Не в ТУСУРе учишься, случаем? Мне засчитали вот такую:
Код:
uses crt, graph;

const n=5; {Кол-во точек. n>1 иначе задача не имеет смысла}
Rad2Grad=180/pi; {Если не нужно преобразовывать радианы в
градусы заменяем 180/pi на 1}
BGI_path='c:\bp\bgi'; {путь к каталогу графических драйверов, при несовпадении указанного и реального его расположения, работа в графическом режиме невозможна}

var
 zoom,drive,mode,i,j:integer;
 x,y:real;
 points:array [1..n,1..4] of real; {здесь хранятся координаты}
 P_order:array [1..n] of integer; {Вспомогательный массив. Хранит индексы
точек в основном массиве. Определяет порядок обхода точек}

Function CalcZoom:integer; {определение коэф-та увеличения при построении линии}
var
 max_X, max_Y:real;
begin
 max_X:=abs(points[1,1]); {находим макс. по модулю значение Х и Y}
 max_Y:=abs(points[1,2]); {простым сравнением}
 for i:=2 to n do
  begin
   if abs(points[i,1])>max_X then max_X:=abs(points[i,1]);
   if abs(points[i,2])>max_Y then max_Y:=abs(points[i,2]);
  end; 
   if (GetMaxX-10) div round(2*max_X) < (GetMaxY-10) div round(2*max_Y) then
    CalcZoom:=(GetMaxX-10) div round(2*max_X) else
    CalcZoom:=(GetMaxY-10) div round(2*max_Y);

{оставляем поля по 5 пикселов по краям экрана, 5+5=10, поэтому вместо
GetMaxX и GetMaxY используем GetMaxX-10 и GetMaxY-10 соответственно
Т.к. каждая четверть построенной координатной плоскости равна половине ширины и половине
высоты экрана, делим макс. широту и высоту (за вычетом полей) на 2, и затем на max_Y или max_Х
соответственно. А потом выбираем меньшее из значений. Таким образом избавляемся от
возможности выскочить за пределы экрана и одновременно получаем автоматическое
масштабирование построенной линии}

end;

procedure XY2Polar(t:integer); {Перевод декартовых координат в полярные}

{Обозначим буквами r и ф полярные координаты
(расстояние до объекта от начала координат и
угол направления на объект соответственно)}
var
 r,phi:real;
begin
 x:=points[t,1]; {в принципе, переменные х и у вводить необязательно}
 y:=points[t,2]; {однако это повышает наглядность}

 r:=sqrt(sqr(x)+sqr(y));{вычисляем r по т.Пифагора, как гипотенузу
треугольника с катетами x и y}

 {т.к. x = r*cosф, y = r*sinф, -> y/x = sinф/cosф = tgф}
 phi:=arctan(y/x); {а из tgф, через arctg(tgф) получим угол ф}

 points[t,3]:=r; {и занесем преобразованные координаты}
 points[t,4]:=phi; {в ту же строку массива точек}
end;

function ComparePoints(a,b:integer):boolean;

{Функция сравнивает две точки по их координатам.
"Больше" та точка, угол которой больше,
а при одинаковом значении угла -
сравнивает по расстоянию. Возвращает True,
 если первая точка "больше" второй}
var t1,t2:integer;
begin
 t1:=P_order[a];
 t2:=P_order[b];
 ComparePoints:=(points[t1,4]>points[t2,4])
  or
 ((points[t1,4]=points[t2,4]) and (points[t1,3]>points[t2,3]));
end;

procedure Swap(a,b:integer);
{Процедура меняет местами индексы двух точек в массиве,
изменяя тем самым порядок их обхода}
var
 t:integer;
begin
 t:=P_order[a];
 P_order[a]:=P_order[b];
 P_order[b]:=t;
end;


begin
 For i:=1 to n do {вводим координаты n точек}
  begin
   Write('Точка ');
   Write(i);
   Writeln(' -  X:');
   readln(points[i,1]);
   Write('Точка ');
   Write(i);
   Writeln(' -  Y:');
   readln(points[i,2]);
   P_order[i]:=i; {заносим индекс очередной точки в массив}
   XY2Polar(i); {и преобразуем введенные координаты в полярные}
  end;

 For i:=1 to n-1 do {сортируем массив введенных координат
(а точнее - его индекс) методом простого выбора}
  begin
   For j:=i+1 to n do
    begin
     if ComparePoints(i,j) then
      Swap(i,j);
    end;
  end;

 WriteLn('Порядок обхода точек:'); {начинаем вывод результатов}
 For i:=1 to n do
  begin
   Write('Точка N:');
   Write((P_order[i]):3);
   Write(', Угол Ф:');
   Write((points[P_order[i],4]*Rad2Grad):6:2);
   Write(', Расстояние R:');
   Write(points[P_order[i],3]:6:2);
   Write(', X:');
   Write(points[P_order[i],1]:6:2);
   Write(', Y:');
   WriteLn(points[P_order[i],2]:6:2);
  end;

 WriteLn('Нажмите Enter...'); {Делаем паузу, чтобы можно было увидеть}
 ReadLn; {результаты работы программы}
 {а теперь строим замкнутую ломаную в графическом режиме}
 drive:=detect;
 initgraph(drive,mode,BGI_path);
 zoom:=CalcZoom; {вычисляем масштаб}
 line(10,240,630,240); {Проводим ось Х}
 line(320,10,320,470); {и ось Y}
 line(630,240,610,235); {Стрелка на оси Х}
 line(630,240,610,245);
 line(320,10,315,30); {Стрелка на оси Y}
 line(320,10,325,30);
 For i:=1 to n do
  begin
   x:=points[P_order[i],1]*zoom + (GetMaxX div 2);
   y:=(GetMaxY div 2) - points[P_order[i],2]*zoom;
{ставим точки, взяв за начало координат середину экрана, в масштабе 1:zoom
Т.к. на экране ось Y идет сверху вниз, координата по оси у берется с
противоположным знаком, или, проще говоря, отнимается от начала координат}
   if i>1 then LineTo(round(x),round(y));
{если точка не первая - проводим к ней линию от предыдущей}
   Circle(round(x),round(y),1);
{обводим точку маленьким кружком для заметности}
  end;
   x:=points[P_order[1],1]*zoom + (GetMaxX div 2);
   y:=(GetMaxY div 2) - points[P_order[1],2]*zoom;
   LineTo(round(x),round(y)); {замыкаем линию}
 repeat until keypressed; {и ждем нажатия клавиши для завершения работы}
 closegraph;
end.
« Последнее редактирование: 04-12-2007 20:43 от Алексей1153++ » Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines