Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
ВаЛерика
121 / 26 / 27
Регистрация: 17.04.2013
Сообщений: 105
1

На прямой даны отрезки, найти самое короткое пересечение

22.02.2016, 19:01. Просмотров 727. Ответов 8
Метки нет (Все метки)

Задача с http://informatics.mccme.ru/mod/statements/view3.php?chapterid=516#1

Недавно Петя занялся изучением древних цивилизаций. Он нашел в энциклопедии даты рождения и гибели N различных древних цивилизаций и теперь хочет узнать о влиянии культуры одних цивилизаций на культуру других.

Петя предположил, что между цивилизациями A и B происходил культурный обмен, если они сосуществовали в течение некоторого ненулевого промежутка времени. Например, если цивилизация A зародилась в 600 году до н.э. и существовала до 400 года до н.э., а цивилизация B зародилась в 450 году до н.э. и существовала до 300 года до н.э., то культура каждой из этих цивилизаций оказывала влияние на развитие другой цивилизации в течение 50 лет. В то же время, если цивилизация C зародилась в 400 году до н.э. и существовала до 50 года до н.э., то она не смогла осуществить культурного обмена с цивилизацией A, в то время как культурный обмен с цивилизацией B продолжался в течение 100 лет.

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

Входные данные
В первой строке вводится число N – количество цивилизаций, культура которых интересует Петю (1N100 000). Следующие N строк содержат описание цивилизаций – в каждой строке задаются два целых числа Si и Ei – год зарождения и год гибели соответствующей цивилизации. Все числа не превосходят 109 по абсолютной величине, Si < Ei.

Выходные данные
Выведите два числа – номера цивилизаций, периоды существования которых имеют наименьшее ненулевое пересечение. Если никакие две цивилизации не пересекаются во времени, выведите единственное число 0.

Примеры
входные данные
3
-600 -400
-450 -300
-400 -50
выходные данные
1 2
входные данные
2
10 20
15 21
выходные данные
1 2
входные данные
1
77777 77778
выходные данные
0



моя попытка:
Pascal
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
var
  n, i, k, sum, min, min1, one, duo: integer; 
  mass1, mass2, mass3: array [1..1000000] of longint;
 
{procedure sort(l,r:longint); 
var i,j,n:longint; 
x,y:longint; 
begin 
i:=l; 
j:=r; 
m:=(l+r)/l+(random(r-l); 
x:=mass[mass1,2] 
end; } 
 
procedure Quicksort(Left, Right: integer);
var
  ptrLeft, ptrRight, Pivot, Temp: integer;
begin
  ptrLeft := Left; 
  ptrRight := Right; 
  Pivot := mass1[(Left + Right) div 2]; 
  repeat
    while (ptrLeft < Right) and (mass1[ptrLeft] < Pivot) do 
      inc(ptrLeft); 
    while (ptrRight > Left) and (mass1[ptrRight] > Pivot) do 
      dec(ptrRight); 
    if ptrLeft <= ptrRight then 
    begin
      if ptrLeft < ptrRight then 
      begin
        Temp := mass1[ptrLeft]; 
        mass1[ptrLeft] := mass1[ptrRight]; 
        mass1[ptrRight] := Temp; 
        Temp := mass2[ptrLeft]; 
        mass2[ptrLeft] := mass2[ptrRight]; 
        mass2[ptrRight] := Temp; 
        Temp := mass3[ptrLeft]; 
        mass3[ptrLeft] := mass3[ptrRight]; 
        mass3[ptrRight] := Temp; 
      end; 
      inc(ptrLeft); 
      dec(ptrRight); 
    end; 
  until ptrLeft > ptrRight; 
  if ptrRight > Left then 
    Quicksort(Left, ptrRight); 
  if ptrLeft < Right then 
    Quicksort(ptrLeft, Right); 
end;
 
begin
  read(n); 
  if n = 1 then  write('0') else begin
    k := 1; 
    for i := 1 to n * 2 do 
    begin
      read(mass1[i]); 
      mass3[i] := k;
      if i mod 2 = 0 then begin mass2[i] := -1; k := k + 1; end else mass2[i] := 1; 
    end; 
    
    quicksort(1, n * 2); 
    sum := 0; 
    min1 := 1000000; 
    one := 0; 
    duo:=0;
    for i := 1 to n * 2 do 
    begin
      sum := sum + mass2[i]; 
      //if mass2[i]<0 then write(']') else write('[');
      if (sum <> 0) and (mass2[i] < 0) and ((mass1[i] - mass1[i - 1]) <> 0) then begin
        min := mass1[i] - mass1[i - 1]; 
        if min < min1 then begin
          one:=mass3[i - 1];
          duo:=mass3[i];
        min1 := min;
        end;
      end; 
    end;
  end;
  if one < duo then 
            writeln(one, ' ', duo) else 
            writeln(duo, ' ', one);
end.
0
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
22.02.2016, 19:01
Ответы с готовыми решениями:

В тексте из 20 строк найти самое короткое предложение с прямой речью
Доброй всем ночи) Ребят, помогите с этой программой, пожалуйста, завтра нужно...

В любом заданном предложении найти самое короткое и самое длинное слова
Нужна программа, чтобы в любом заданном предложении находила самое короткое и...

В заданном предложении найти самое короткое и самое длинное слова
В заданном предложении найти самое короткое и самое длинное слова.

Найти самое короткое и самое длинное слова и поменять их местами.
В заданном предложении найти самое короткое и самое длинное слова и поменять их...

Найти самое длинное и самое короткое слова и поменять их местами
Люди помогите пожалуйста нужна программа которая находит минимально длинное и...

8
ФедосеевПавел
Модератор
3672 / 2040 / 843
Регистрация: 01.02.2015
Сообщений: 6,779
23.02.2016, 01:38 2
Там же на сайте в пояснениях говорится, что
ЗАМЕЧАНИЕ 2. Что если некоторое начало и некоторый конец имеют одинаковые координаты? В этом случае, если начало будет расположено до конца, то получим в итоге min == 0, что очевидно, неверно. Таким образом, при сортировке при равенстве координат раньше должен идти конец.
Это можно реализовать двумя способами:
1. При сравнении в сортировке сравнивать не годы, а некие хэши от года и типа события, например Hash:=Год*2+Ord(ТипСобытия=НачалоЦивилизации)
2. При вводе дат сразу превращать их в Хэши по той же формуле, но при расчёте разности делать пересчёт.

Может быть что-то ещё, но в разборе всё хорошо описано.
1
Ромаха
235 / 127 / 27
Регистрация: 16.12.2012
Сообщений: 576
Записей в блоге: 1
Завершенные тесты: 1
23.02.2016, 03:59 3
Вы про что? Какие хеши?
И начало и конец сливаем в один массив с 1 и -1 соответсвенно. Сортируем по году(если равны то конец вперёд). А дальше за линию считаем.
Причём тут хеши?
1
ФедосеевПавел
Модератор
3672 / 2040 / 843
Регистрация: 01.02.2015
Сообщений: 6,779
23.02.2016, 08:34 4
А как реализовать простым способом сортировку "если равны то конец вперёд"?
Я бы реализовал так (это не идеал, просто как вариант)
Pascal
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
type
  {тип события - начало или конец цивилизации}
  TEvent = (Start, Finish);
  {тип метки на временной оси}
  TOccurrence = record
    Year:  longint;        {год}
    Civilization: longint; {номер цивилизации}
    Event: TEvent;         {тип события}
  end;
  {тип временной оси}
  TScale = array of TOccurrence;
 
  procedure Sort(var a: TScale);
 
    function Hash(A: TOccurrence): longint;
    begin
      Hash := A.Year * 2;
      if A.Event = Start then
        Inc(Hash);
    end;
 
    procedure QuickSort(var A: TScale; L, R: integer);
    var
      I, J: longint;
      P: longint;
      T: TOccurrence;
    begin
      repeat
        I := L;
        J := R;
        P := Hash(A[(L + R) shr 1]);
        repeat
          while Hash(A[I]) < P do
            Inc(I);
          while Hash(A[J]) > P do
            Dec(J);
          if I <= J then
          begin
            T := A[I];
            A[I] := A[J];
            A[J] := T;
            Inc(I);
            Dec(J);
          end;
        until I > J;
        if L < J then
          QuickSort(A, L, J);
        L := I;
      until I >= R;
    end;
 
  begin
    QuickSort(A, 0, high(a));
  end;
Код QuickSort я взял в FAQ Pascal на форуме sources и он отличается от всех, которые приводятся во всех других источниках (rosetta, Wikipedia, algolist.manual), но работает. Что он отличается заметил только сейчас, и переделывать пока не буду, просто отмечу этот момент. Ещё раз подчеркну, что это лишь идея сортировки "если равны то конец вперёд".
1
Ромаха
235 / 127 / 27
Регистрация: 16.12.2012
Сообщений: 576
Записей в блоге: 1
Завершенные тесты: 1
23.02.2016, 16:04 5
Зачем?
Напишите компаратор, что будет сравнивать два элемента. И все!
А в сортировке сравнивайте по нему. Не нужно так изощряться
0
ФедосеевПавел
Модератор
3672 / 2040 / 843
Регистрация: 01.02.2015
Сообщений: 6,779
23.02.2016, 17:43 6
Т.е. достаточно переименовать Hash в Compare?
0
Ромаха
235 / 127 / 27
Регистрация: 16.12.2012
Сообщений: 576
Записей в блоге: 1
Завершенные тесты: 1
23.02.2016, 18:58 7
Нет. Вы заменяете структуру неким числом. Я же предлагаю сравнивать сами структуры. У вас будет if f(a[i], p) then
Где f(a, b : <не помню что>) : Exit((a.year < b.year) or ((a.year = b.year) and (a.event = -1)))
0
ФедосеевПавел
Модератор
3672 / 2040 / 843
Регистрация: 01.02.2015
Сообщений: 6,779
23.02.2016, 20:37 8
Но здесь через Hash проще. Хотя, что пнем о сову, что совой о пень. Вопрос пуризма. Если отсортирует, можно продвигаться дальше - к вершинам выполнения задания.
0
ВаЛерика
121 / 26 / 27
Регистрация: 17.04.2013
Сообщений: 105
23.02.2016, 23:01  [ТС] 9
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Готовый вариант.
Pascal
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
Const
    maxn =   100000;
    minc =   -1000000000;
    maxc =   1000000000;
 
Var
    a, s:   array [1..2 * maxn] Of longint;
    l, r:   array [1..maxn] Of longint;
    n:   longint;
 
Procedure sort(l, r: longint);
 
Var
    i, j, x, t:   longint;
Begin
    i := l;
    j := r;
    x := a[l + random(r - l + 1)];
 
    While i <= j Do
        Begin
            While a[i] < x Do
                inc(i);
            While a[j] > x Do
                dec(j);
            If i <= j Then
                Begin
                    t := a[i];
                    a[i] := a[j];
                    a[j] := t;
                    t := s[i];
                    s[i] := s[j];
                    s[j] := t;
                    inc(i);
                    dec(j);
                End;
        End;
 
    If l < j Then sort(l, j);
    If i < r Then sort(i, r);
End;
 
Var
    i, j, k, m, p, q, best, t:   longint;
    u:   array [1..maxn] Of boolean;
 
Begin
   // assign(input, 'input.txt');
   // reset(input);
   // assign(output, 'output.txt');
   // rewrite(output);
   read(n);
   readln;
 
    m := 0;
    For i := 1 To n Do
        Begin
            read(l[i]);
            read(r[i]);
            readln;
 
            inc(m);
            a[m] := 2 * l[i];
            s[m] := i;
            inc(m);
            a[m] := 2 * r[i] - 1;
            s[m] := i;
        End;
 
    sort(1, m);
 
    k := 0;
    best := 0;
    p := 0;
    q := 0;
    j := 0;
    For i := 1 To m Do
        Begin
            If a[i] Mod 2 = 0 Then
                Begin
                    inc(k);
                    If (k > 1) And (a[i + 1] Mod 2 <> 0) Then
                        Begin
                            t := (a[i + 1] + 1) Div 2 - a[i] Div 2;
                            If (best = 0) Or (t < best) Then
                                Begin
                                    best := t;
                                    j := i;
                                    p := s[i];
                                    q := s[i + 1];
                                End;
                        End;
                End
            Else
                Begin
                    dec(k)
                End;
        End;
 
    If best = 0 Then
        Begin
            writeln(0)
        End
    Else
        Begin
            // writeln(best);
 
            If q = p Then
                Begin
                    For i := 1 To j Do
                        Begin
                            If a[i] Mod 2 = 0 Then
                                u[s[i]] := true
                            Else
                                u[s[i]] := false;
                        End;
 
                    For i := 1 To n Do
                        If (i <> p) And u[i] Then
                            q := i;
                End;
                if p<q then
            writeln(p, ' ',q)
            else writeln(q, ' ',p);
        End;
 
   // close(input);
   // close(output);
End.
1
23.02.2016, 23:01
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
23.02.2016, 23:01

В заданном предложении найти самое короткое и самое длинное слова
Напишите программу, которая в заданном предложении находит самое короткое и...

В заданном предложении найти самое короткое и самое длинное слово
1. Создать вектор М, содержащий количество отрицательных элементов каждого...

Найти самое длинное и самое короткое слово в строке
Пишем 5 слов, а далее выводим самое длинное и самое короткое слово в строке....


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

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

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