Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.50/6: Рейтинг темы: голосов - 6, средняя оценка - 4.50
21 / 21 / 2
Регистрация: 14.10.2009
Сообщений: 202
1

Delphi Console Массивы

16.02.2010, 18:30. Показов 1181. Ответов 2
Метки нет (Все метки)

Вот есть такая задача: Даны действительные числа a1, a2, ..., a2n. Эти точки определяют n интервалов числовой оси (a1, a2), (a3, a4), ..., (a2n-1, a2n). Имеются ли точки числовой оси, принадлежащие по крайней мере трем каким-нибудь из данных интервалов. Если да, то указать какую-нибудь из этих точек.

И есть решенная аналогичная: Даны действительные числа a1, a2, ... , a2n. Эти точки определяют n интервалов числовой оси (a1, a2), (a3, a4), ..., (a2n-1, a2n). Является ли интервалом объединение этих интервалов? Если да, то указать концы этого интервала.

Решение 2й:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
program zadanie6;
{$APPTYPE CONSOLE}
 
type
  TOtr = record//тип интервал
    nc, kn: Integer;//начало, конец
  end;
  TOtrArray = array of TOtr;
 
 
function ReadOtrArray: TOtrArray;
var
  n, I: Integer;
begin
  Write('Введите количество интервалов n=');
  ReadLn(n);
  WriteLn('Введите границы ',n,'интервалов:');
  SetLength(Result,n-1);
  for I := 0 to Length(Result) do begin
    WriteLn(' Интервал ',I);
    Write('  начало='); ReadLn(Result[i].nc);
    Write('  конец='); ReadLn(Result[i].kn);
  end;
end;
 
 
procedure WriteOtrArray(OtrArray: TOtrArray);
var
  I: Integer;
begin
  for I := 0 to Length(OtrArray) do
    Write('[',OtrArray[i].nc,',',OtrArray[i].kn,']  ');
  WriteLn;
  WriteLn;
end;
 
 
procedure SortOtrArray(var OtrArray: TOtrArray);
var
  i, j: Integer;
  x: TOtr;
begin
for i := 0 to Length(OtrArray) - 1 do//сортируем по возрастанию начала интервалов
  for j := i + 1 to Length(OtrArray) do
  if OtrArray[i].nc > OtrArray[j].nc then
  begin
    x := OtrArray[i];
    OtrArray[i] := OtrArray[j];
    OtrArray[j] := x;
  end;
end;
 
 
function IsOneOtr(var OtrArray: TOtrArray): Boolean;
var
  MaxKn: Integer;
  i: integer;
begin
  MaxKn := OtrArray[1].kn;
  for i := 1 to Length(OtrArray) do begin//ищем разрывы
    // максимума из концов отрезков 1 .. i-1
  if OtrArray[i].nc > MaxKn then//нашли, сообщаем и завершаем программу
  begin
    Result := False;
    Exit;
  end;
  if OtrArray[i].kn > MaxKn then
    MaxKn := OtrArray[i].kn;
  end;
  Result := True;
end;
 
 
var
  OtrArray: TOtrArray;//массив интервалов
  Res: Boolean;
 
 
begin
  OtrArray := ReadOtrArray;
  WriteLn('Интервалы:');
  WriteOtrArray(OtrArray);
  SortOtrArray(OtrArray);
  WriteLn('Интервалы по возрастанию начала:');
  WriteOtrArray(OtrArray);
  Res := IsOneOtr(OtrArray);
  if Res = False then
    Writeln('Эти интервалы не образуют общий интервал!')
  else begin
    WriteLn('Эти интервалы образуют общий интервал.');
    Write('начало=',OtrArray[0].nc,'  конец=',OtrArray[Length(OtrArray)].kn);
  end;
end.
Я думаю, изменить в ней следует только функцию IsOneOtr. Каким образом это сделать? Помогите с алгоритмом решения.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
16.02.2010, 18:30
Ответы с готовыми решениями:

Массивы в Delphi Console
Помогите с задачей: Даны действительные числа x1, x2, ... , xn, y1, y2, ... , yn, r1, r2, ... ,...

Немного изменить программу в Delphi Console. (Массивы)
Условие задачи: Даны целые числа a1, a2, ..., an, среди которых могут быть повторяющиеся. Составить...

Массивы в Delphi (Console): Определить, является ли интервалом объединение этих интервалов
Даны действительные числа a1, a2, ... , a2n. Эти точки определяют n интервалов числовой оси (a1,...

Delphi Console
Добрый день. Программирую в консоли, нужно что бы всё содержимое консоли, что получилось в...

2
13067 / 5853 / 1705
Регистрация: 19.09.2009
Сообщений: 8,807
17.02.2010, 11:41 2
Первая задача:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils
 
  ,Math, Windows;
 
type
  TOtr = record//тип интервал
    nc, kn: Integer;//начало, конец
  end;
  TOtrArray = array of TOtr;
 
 
function ReadOtrArray: TOtrArray;
var
  n, I: Integer;
begin
  Write('Введите количество интервалов n=');
  ReadLn(n);
  WriteLn('Введите границы ',n,'интервалов:');
  SetLength(Result, n);
  for I := 0 to High(Result) do begin
    WriteLn(' Интервал ',I);
    Write('  начало='); ReadLn(Result[i].nc);
    Write('  конец='); ReadLn(Result[i].kn);
  end;
end;
 
 
procedure WriteOtrArray(const OtrArray: TOtrArray);
var
  I: Integer;
begin
  for I := 0 to High(OtrArray) do
    Write('[',OtrArray[i].nc,',',OtrArray[i].kn,']  ');
  WriteLn;
  WriteLn;
end;
 
//Проверяет, накладываются ли отрезки. Формирует отрезок равный наложению.
function IsIntersect(const aOtr1, aOtr2 : TOtr; var aOtrRes : TOtr) : Boolean;
begin
  Result := False;
  aOtrRes.nc := Max(aOtr1.nc, aOtr2.nc);
  aOtrRes.kn := Min(aOtr1.kn, aOtr2.kn);
  if aOtrRes.nc <= aOtrRes.kn then Result := True;
end;
 
//Поиск трёх отрезков, которые имеют общий интервал.
function Find3Intersect(const aOtrArray: TOtrArray; var aOtrArrRes : TOtrArray) : Boolean;
const
  //Количество отрезков, имеющих общий интервал.
  N = 3;
var
  //Индексы массивов.
  i, j, k : Integer;
  //Область пересечения N отрезков.
  OtrIntersect : TOtr;
  //Область пересечения двух отрезков.
  OtrTmp : TOtr;
begin
  //Искомые отрезки пока не найдены.
  Result := False;
  //Выделяем память для массива, который будет хранить сведения об N отрезках,
  //имеющих общий диапазон + сведения об отрезке, который представляет общий
  //диапазон.
  SetLength(aOtrArrRes, N + 1);
  //Перебор отрезков.
  for i := 0 to High(aOtrArray) - (N - 1) do begin
    //Индекс текущего элемента результирующего массива.
    k := 0;
    //Добавляем в результирующий массив первый элемент.
    aOtrArrRes[k] := aOtrArray[i];
    //Начальное значение области пересечения.
    OtrIntersect := aOtrArray[i];
    //Поиск пересекающихся отрезков.
    for j := i + 1 to High(aOtrArray) do begin
      //Проверяем, есть ли пересечение.
      if IsIntersect(OtrIntersect, aOtrArray[j], OtrTmp) then begin
        //Индекс следующего элемента результирующего массива.
        Inc(k);
        //Добавляем найденный отрезок в результирующий массив.
        aOtrArrRes[k] := aOtrArray[j];
        //Уточняем область пересечения.
        OtrIntersect := OtrTmp;
        //Если полученная область пересечения составлена из N отрезков - значит
        //поиск завершён.
        if k + 1 = N then begin
          //Добавляем в конец результирующего массива сведения о полученной
          //области пересечения.
          aOtrArrRes[k + 1] := OtrIntersect;
          //Искомые отрезки найдены.
          Result := True;
          //Выходим из процедуры.
          Exit;
        end; //if k
      end; //if IsIntersect
    end; //for j
  end; //for i
end;
 
var
  //Массив интервалов
  OtrArray: TOtrArray;
  //Результирующий массив - содержит 3 накладывающихся отрезка
  //+ один отрезок, представляющий диапазон наложения.
  OtrArrIntersect : TOtrArray;
  //Строка для промежуточных вычислений.
  StrTmp : String;
begin
  //Переключаем консоль на использование кодовой страницы CP1251.
  //Если в консоли всё равно окажется абракадабра - значит выбран "Точечный шрифт".
  //Следует зайти в свойства окна консоли и установить шрифт "Lucida Console".
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  repeat
    OtrArray := ReadOtrArray;
    WriteLn('Интервалы:');
    WriteOtrArray(OtrArray);
    if Find3Intersect(OtrArray, OtrArrIntersect) then begin
      WriteLn('Пересекующиеся отрезки + отрезок, представляющий общий интервал:');
      WriteOtrArray(OtrArrIntersect);
    end else begin
      WriteLn('Никакие три отрезка массива не образуют общего интервала.');
    end;
 
    Writeln('Чтобы повторить нажмите ENTER. Выход - любой символ + ENTER.');
    Readln(StrTmp);
  until StrTmp <> '';
 
end.
---
Кстати, алгоритм решения второй задачи неверен, к сожалению.
Два теста:
1.
Количество отрезков: 3
Первый отрезок: 1; 4
Второй отрезок: 3; 6
Третий отрезок: 2; 8
Программа выдаст результат, что из этих отрезков можно составить общий отрезок: 1; 6.
Это неверно. Общий отрезок должен быть таким: 1; 8.
---
2.
Количество отрезков: 3
Первый отрезок: 1; 10
Второй отрезок: 1; 2
Третий отрезок: 3; 4
Программа выдаст результат, что из этих отрезков нельзя составить общий интервал.
Это неверно. Обший интервал составить можно и он бдует равен: 1; 10.
---
Кроме этого, в коде для второй задачи имеются обращения за пределы выделенной памяти. Если программа не выдаёт ошибок - то только по тому, что везёт.
1
21 / 21 / 2
Регистрация: 14.10.2009
Сообщений: 202
17.02.2010, 14:44  [ТС] 3
Спасибо большое. Вторая задача не нужна, это просто был пример, но все равно спасибо за разъяснения.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
17.02.2010, 14:44

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Console в Delphi
Доброго времени суток Есть консольная программа($APPTYPE CONSOLE) на Делфи которая в бесконечном...

Console Delphi App
Добрый день. Делаю консольное приложение, хочу спросить можно ли взаимодействовать с интернетом?...

Delphi (Console Application)
Всем Добрый день! Помогите пожалуйста, есть задание &quot;Организовать инициализацию двумерного массива...

Delphi console application httpsend
Всем привет, не подскажите как работать с httpsend в console application? Допустим нужно перейти по...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.