Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed Статус: Профессионал Рейтинг: 2673 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 2366 ∙ повысить рейтинг »

star9491 Статус: Профессионал Рейтинг: 2043 ∙ повысить рейтинг »

Вопрос № 178381: Доброго времени суток, дорогие эксперты! Требуется решить задачу на ТП7. Даны две прямоугольные матрицы разных размеров. Упорядочить строки каждой из них по убыванию первых элементов строк, если это возможно. Тема данной зада...

Доброго времени суток, дорогие эксперты!

Требуется решить задачу на ТП7.

Даны две прямоугольные матрицы разных размеров.
Упорядочить строки каждой из них по убыванию первых элементов строк, если это возможно.

Тема данной задачи это:
"Создание гибких подпрограмм для обработки матриц произвольного порядка с фиксированным базовым типом"

Поэтому массивы должны быть открытыми или задача как то решалась через дерективу absolute(Желательно чтобы открытые массивы были).

Спасибо за внимание.

Отправлен: 14.05.2010, 18:01
Вопрос задал: Юдин Евгений Сергеевич, 1-й класс
Всего ответов: 1
Страница вопроса »

Приложение:
const sizeofInteger = sizeof(Integer); procedure Sort(var m; const rows, cols: Integer); var k, n, p1, p2: Integer; s, o: Word; temp: Pointer; {Делаю через динамическую память - если не так надо, напишите. Будет чуть дольше} begin s := Seg(m); o := Ofs(m); GetMem(temp, cols*sizeofInteger); for k:=1 to rows-1 do for n := k+1 to rows do begin p1 := memw[s:o+(k-1)*cols*sizeofInteger]; p2 := memw[s:o+(n-1)*cols*sizeofInteger]; if p2 > p1 then begin {Обмен строк местами} move(ptr(s, o+(k-1)*cols*sizeofInteger)^, temp^, cols*sizeofInteger); move(ptr(s, o+(n-1)*cols*sizeofInteger)^, ptr(s, o+(k-1)*cols*sizeofInteger)^, cols*sizeofInteger); move(temp^, ptr(s, o+(n-1)*cols*sizeofInteger)^, cols*sizeofInteger); end end; FreeMem(temp, cols*sizeofInteger); end; procedure Print(var m; rows, cols: Integer); var k, n, p: Integer; s, o: Word; begin s := Seg(m); o := Ofs(m); for k:=1 to rows do begin for n := 1 to cols do begin p := memw[s:o + ((k-1)*cols + (n-1))*sizeofInteger]; Write(p:5); end; WriteLn; end; end; procedure FillMatrics(var m; const rows, cols: Integer); var k,n, p: Integer; s, o: Word; begin s := Seg(m); o := Ofs(m); {Через нетипированный параметр передается только адрес переменной. Так что нужно вычислять положение элементов по типу, номеру ряда и числу столбцов} for k:=1 to rows do for n := 1 to cols do begin p := k*100 + n; (* Вариант - случайными числами *) {p := Random(1000);} memw[s:o + ((k-1)*cols + (n-1))*sizeofInteger] := p end; end; var m1: array[1..3, 1..10] of Integer; m2: Array[1..5, 1..3] of Integer; BEGIN FillMatrics(m1, 3, 10); WriteLn(\'Исходная матрица m1 3х10\'); Print(m1, 3, 10); Sort(m1, 3, 10); WriteLn(\'Отсортированная матрица m1\'); Print(m1, 3, 10); FillMatrics(m2, 5, 3); WriteLn(\'Исходная матрица m2 5х3\'); Print(m2, 5, 3); Sort(m2, 5, 3); WriteLn(\'Отсортированная матрица m2\'); Print(m2, 5, 3); END.
-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 16.05.2010, 19:03
Номер ответа: 261432

Оценка ответа: 5
Комментарий к оценке:
отлично продумано спасибо!

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 261432 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

уважаемые эксперты!!! помогите решить задачу по объектно-ориентированному программированию( pascal abc.net), используя модуль graph, с выделением отдельных объектов и реализацией методов над ними. Иерархия объектов должна включать в себя как минимум одного объекта-наследника. Программа должна графически иллюстрировать как ответ задачи, так и само ее решение (в динамике). условие задачи:
Задано множество М точек на плоскости. Найти пару точек с максимальным расстоянием между ними.
(в иерархии объекты точка(x, y, цвет) и массив точек)

Отправлен: 15.05.2010, 00:41
Вопрос задал: Невалёный Виталий Владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses graphABC; TYPE TCoordinate = record x, y: integer; end; TBasePoint = class private fX, fY: Real; fColor: Color; fVisible: Boolean; procedure SetX(newX: Real); procedure SetY(newY: Real); procedure SetColor(newColor: Color); public constructor Create(newX, newY: real; newColor: Color); constructor Create(newX, newY: real); // Color = clBlack constructor Create; property X: Real read fX write SetX; property Y: Real read fY write SetY; property TheColor: Color read fColor write SetColor; property Visible: Boolean read fVisible write fVisible; end; TPoint = class(TBasePoint) constructor Create(newX, newY: real; newColor: Color); constructor Create; // создание случайной точки черного цвета 0..100 // Generate - метод для изменения значения на случайное procedure Generate(maxX, maxY: real; newColor: Color); end; CONST cap_delta = 10; // приращение длины массива (коллекции), когда достигается предел R_capt = 4; // радиус захвата точки - т.е. насколько могут отличаться точка // где нажали мышки от положения точки, чтобы считать, что "попали" // Он же = радиус точки TYPE TPointCollection = class // коллекция точек методы ТОЛЬКО для работы с коллекцией private fPointCollection: Array of TPoint; fcount: Integer; {Номер СЛЕДУЮЩЕЙ, что будет добавлена} fScaleX, fScaleY : Real; procedure SetScaleX(value: Real); procedure SetScaleY(value: Real); procedure Compess; // сжатие = удаление нулевых элементов public constructor Create; function Add(newX, newY: Integer): Integer; // +1 = точка добавлена, -1 = удалена // procedure Draw; virtual; property Count: Integer read fcount; property ScaleX: Real read fScaleX write SetScaleX; property ScaleY: Real read fScaleY write SetScaleY; destructor Destroy; virtual; end; TScrPoints = class(TPointCollection) // добавлена работа с экраном - пока точек private public constructor Create; procedure Draw; virtual; end; TMaxLength = class(TScrPoints) // нахождение и отображение длины максимального private maxpoints: array[0..1] of Integer; // Номера точек procedure GetMaxLength; public constructor Create; procedure Draw; override; end; // Решение задачи - управление коллекцией, отображение, // нахождение наибольшего // -------- Реализация методов ------------------- // constructor TPointCollection.Create; begin SetLength(fPointCollection, cap_delta); // динамический fcount := 0; fScaleX := 1; fScaleY := 1; end; function TPointCollection.Add(newX, newY: Integer): Integer; // если нет такой точки, то добавлется // если есть, то удаляется var i: Integer; begin // Проверяем, есть ли такая? for i :=0 to Count-1 do if (abs(newX - fPointCollection[i].X/ScaleX) <= R_capt) and (abs(newY - fPointCollection[i].Y/ScaleY) <= R_capt) then begin fPointCollection[i].Visible := False; result :=-1; Exit end; // Если не вышли по Exit, то добавляем if Count >= fPointCollection.Length then SetLength(fPointCollection, fPointCollection.Length + cap_delta); fPointCollection[count] := new TPoint(newX/ScaleX, newY/ScaleY, clBlack); inc(fcount); result := +1 end; procedure TPointCollection.SetScaleX(value: Real); // главная цель - не допустить установки масштаба = 0 begin if value <> 0 then fScaleX := value end; procedure TPointCollection.SetScaleY(value: Real); // главная цель - не допустить установки масштаба = 0 begin if value <> 0 then fScaleY := value end; procedure TPointCollection.Compess; // Удаление невидимых точек var i: Integer; begin i:=0; while i < fCount do begin if NOT fPointCollection[i].Visible then begin fPointCollection[i] := nil; fPointCollection[i] := fPointCollection[i+1]; dec(fCount); end else inc(i); end; // Пересчитаем заново fCount := 0; for i := 0 to fPointCollection.Length-1 do if NOT fPointCollection[i].Visible then Break else inc(fCount); end; destructor TPointCollection.Destroy; begin fPointCollection := nil; end; // ////////////////////////// constructor TScrPoints.Create; begin Inherited; end; procedure TScrPoints.Draw; var i: Integer; begin // Window.Clear; // Вызывает моргание, но очистка рисованием б for i:=0 to Count-1 do begin with fPointCollection[i] do begin if Visible then begin Pen.Color := TheColor; Brush.Color := clGreen end else begin Pen.Color := clWhite; Brush.Color := clWhite end; Circle(round(X*ScaleX), round(Y*ScaleY), R_capt); end; end end; // ////////////////////////// constructor TMaxLength.Create; var i: Integer; begin Inherited; Randomize; // добавим 10 случайных точек for i:= 1 to 10 do Add(random(WindowWidth), random(WindowHeight)); maxpoints[0] := -1; maxpoints[1] := -1; Draw; end; procedure TMaxLength.Draw; begin inherited; GetMaxLength; end; procedure TMaxLength.GetMaxLength; var i, j: Integer; len, maxLen: Real; begin if Count < 1 then begin maxpoints[0] := -1; maxpoints[1] :=-1; Exit end; maxpoints[0] := 0; maxpoints[1] := 0; maxLen := 0; for i:= 0 to Count - 2 do begin if NOT fPointCollection[i].Visible then Continue; for j := i+1 to Count -1 do begin if fPointCollection[j].Visible then len := sqr(fPointCollection[i].X - fPointCollection[j].X) + sqr(fPointCollection[i].Y - fPointCollection[j].Y); if len > maxLen then begin maxLen := len; maxpoints[0] := i; maxpoints[1] := j end end end; Window.Clear; Inherited Draw; if maxpoints[0] >= 0 then begin SetPenColor(clRed); Line(round(fPointCollection[maxpoints[0]].X/ScaleX), round(fPointCollection[maxpoints[0]].Y/ScaleY), round(fPointCollection[maxpoints[1]].X/ScaleX), round(fPointCollection[maxpoints[1]].Y/ScaleY)) end; end; // TBasePoint - базовый класс для точки constructor TBasePoint.Create(newX, newY: real; newColor: Color); begin X := newX; Y := newY; fColor := newColor; Visible := True end; constructor TBasePoint.Create(newX, newY: real); begin X := newX; Y := newY; fColor := clBlack; end; constructor TBasePoint.Create; begin Inherited; end; procedure TBasePoint.SetX(newX: Real); begin fX := newX end; procedure TBasePoint.SetY(newY: Real); begin fY := newY end; procedure TBasePoint.SetColor(newColor: Color); begin fColor := newColor end; // TPoint - добавлена возможность генерации случаных координат constructor TPoint.Create(newX, newY: real; newColor: Color); begin inherited Create(newX, newY, newColor); end; constructor TPoint.Create; begin Inherited; // Generate(200, 200, clBlack) end; procedure TPoint.Generate(maxX, maxY: real; newColor: Color); begin SetY(random*maxY); SetX(random*maxX); TheColor := newColor; end; // var m: TMaxLength; procedure MouseDown(x, y, mb: integer); begin m.Add(x,y); m.Draw end; procedure Close; begin if m <> nil then m.Destroy end; BEGIN OnMouseDown := MouseDown; OnClose := Close; m := new TMaxLength; END. Прикрепленный файл: загрузить »

-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 20.05.2010, 23:57
Номер ответа: 261533

Оценка ответа: 5
Комментарий к оценке:
благодарю!!!!!!

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 261533 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »