IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Задача про точки и отрезки
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


Точки и отрезки
(Время: 2 сек. Память: 16 Мб Сложность: 62%)
Дано N отрезков на числовой прямой и M точек на этой же прямой. Для каждой из данных точек определите, скольким отрезкам она принадлежит. Точка x считается принадлежащей отрезку с концами a и b, если выполняется двойное неравенство min(a, b) <= x <= max(a, b).

Входные данные

Первая строка входного файла INPUT.TXT содержит два целых числа N – число отрезков и M – число точек (1 <= N, M <= 10^5). В следующих N строках по два целых числа ai и bi – координаты концов соответствующего отрезка. В последней строке M целых чисел – координаты точек. Все числа во входном файле не превосходят по модулю 10^9.

Выходные данные

В выходной файл OUTPUT.TXT выведите M чисел – для каждой точки количество отрезков, в которых она содержится.

ПРИМЕРЫ
3 2
0 5
-3 2
7 10
1 6
ответ 2 0

1 3
-10 10
-100 100 0
ответ 0 0 1

Моя идея проста: сначала сортируем точки по координате, затем точки с одинаковой координатой сортируем по типу
К сожалению, этот вариант не проходит автоматическую систему проверки по времени (~+0,5сек) sad.gif
Самого теста у меня нет
Вероятно, надо прикрутить упорядочивание по типу точки в процедуру сортировки по координате, но я не представляю, как это сделать...
А может ещё какой-то вариант есть?
Времени у меня как всегда впритык unsure.gif

program Project1;

type
tip=(_left,_none,_right);
point=record x,n,c:longint; t:tip end;
mas=array [1..300000]of point;
var
a,b:mas;
f:text;
i,n,m,k,j:longint;
t:point;

procedure quicksort(var a: mas; Lo,Hi: integer);
procedure sort(l,r: integer);
var
i,j: integer;
x,y:point;
begin
i:=l; j:=r; x := a[(r+l) div 2];
repeat
while a[i].x<x.x do i:=i+1;
while x.x<a[j].x do j:=j-1;
if i<=j then
begin
if a[i].x > a[j].x then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y
end;
i:=i+1; j:=j-1
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r)
end;
begin
sort(Lo,Hi)
end;

procedure Tquicksort(var a: mas; Lo,Hi: integer);
procedure sort(l,r: integer);
var
i,j: integer;
x,y:point;
begin
i:=l; j:=r; x := a[(r+l) div 2];
repeat
while a[i].t<x.t do i:=i+1;
while x.t<a[j].t do j:=j-1;
if i<=j then
begin
if a[i].t > a[j].t then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y
end;
i:=i+1; j:=j-1
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r)
end;
begin
sort(Lo,Hi)
end;

begin
assign(f,'input.txt');
reset(f);
readln(f,n,m);
k:=1;
for I := 1 to n do {читаем отрезки}
begin
readln(f,a[k].x,a[k+1].x);
a[k].t:=_left; a[k+1].t:=_right;
inc(k,2)
end;
for I := 1 to m do {читаем точки}
begin
read(f,a[k].x);
a[k].t:=_none;
a[k].n:=i;
inc(k)
end;
close(f);
quicksort(a,1,k-1); {сортируем все точки по координате}
for i := 1 to k - 2 do
if a[i].x=a[i+1].x then {находим последовательность точек с одинаковой координатой...}
begin
j:=i+1;
while a[i].x=a[j].x do
inc(j);
tquicksort(a,i,j-1) {...и сортируем её по типу: сначала должны идти _left, затем _none, затем _right}
end;
j:=0;
for I := 1 to k-1 do {считаем количество вхождений точки в отрезки}
case a[i].t of
_none:begin a[i].c:=j; b[a[i].n]:=a[i] end;
_left:inc(j);
_right:dec(j)
end;
assign(f,'output.txt');
rewrite(f);
for i := 1 to m do
if b[i].n>0 then write(f,b[i].c,' ');
close(f)
end.

Заранее спасибо

Сообщение отредактировано: c-ch -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


ещё один вариант сделал: разводим начала и концы отрезков в разные массивы, оба упорядичиваем и для каждой точки бинарным поиском ищем сколько начал отрезков левее её (не строго) и сколько правее (строго). Их разность является ответом.
Вроде и сортировка и поиск достаточно быстрые, но всё равно по времени не укладывается sad.gif
program Project1;
uses math;
type arrtype=array[1..100000]of longint;
var
l,r,p:arrtype;
i,j,n,m,t1,t2:longint;
f:text;

Procedure quicksort(Var ar: arrType; n: integer);
Procedure sort(m, l: Integer);
Var i, j, x, w: Integer;
Begin
i := m; j := l;
x := ar[(m+l) div 2];
Repeat
While ar[i] < x Do Inc(i);
While ar[j] > x Do Dec(j);
If i <= j Then Begin
w := ar[i]; ar[i] := ar[j]; ar[j] := w;
Inc(i); Dec(j)
End
Until i > j;
If m < j Then Sort(m, j);
If i < l Then Sort(i, l)
End;
Begin
sort(1, n)
End;

function FindIt(x:longint):longint;

function FindInLeft:longint;
var left,right,middle:longint;
begin
if x<l[1] then result:=0
else
if x>l[n] then result:=n
else
begin
left:=1; right:=n;
repeat
middle:=(right+left) div 2;
if l[middle]>x then right:=middle
else
if l[middle]<x then left:=middle
until (l[middle]<=x)or(right-left=1);
while (l[middle]<=x)and(middle<=n) do inc(middle);
result:=middle-1;
end;
end;

function FindInRight:longint;
var left,right,middle:longint;
begin
if x<r[1] then result:=0
else
if x>r[n] then result:=n
else
begin
left:=1; right:=n;
repeat
middle:=(right+left) div 2;
if r[middle]>x then right:=middle
else
if r[middle]<x then left:=middle
until (r[middle]<=x)or(right-left=1);
while (r[middle]>=x)and(middle<=n) do dec(middle);
result:=middle;
end;
end;

begin
result:=abs(findinleft-findinright)
end;

begin
assign(f,'input.txt');
reset(f);
readln(f,n,m);
for i := 1 to n do
begin
readln(f,t1,t2);
l[i]:=min(t1,t2);
r[i]:=max(t1,t2);
end;
for I := 1 to m do read(f,p[i]);
close(f);
quicksort(l,n);
quicksort(r,n);
assign(f,'output.txt');
rewrite(f);
for I := 1 to m do write(f,findit(p[i]),' ');
close(f);
end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(c-ch @ 5.04.2009 20:59) *
Вроде и сортировка и поиск достаточно быстрые, но всё равно по времени не укладывается
Я бы на твоем месте больше заботился о качестве самого кода. Например, вот тут:
  l[i]:=min(t1,t2);
r[i]:=max(t1,t2);
- ты транжиришь время как будто у тебя есть вечность smile.gif


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


конкретно этот кусок я исправил ветвлением, спасибо smile.gif
но толку-то никакого
либо есть что-то ещё, что я не вижу, либо одно из двух, как в анекдоте... smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






c-ch
Насколько я вижу, у тебя вся проблема - в реализации бинарного поиска. Ты выбрал, наверное, самый неэффективный способ. Попробуй вот так:
function FindIt(x:longint):longint;
function FindInLeft:longint;
var left,right,middle:longint;
begin
if x<l[1] then result:=0
else
if x>l[n] then result:=n
else begin
left:=1; right:=n;
(*
repeat
middle:=(right+left) div 2;
if l[middle]>x then right:=middle
else
if l[middle]<x then left:=middle
until (l[middle]<=x)or(right-left=1);
*)
while right-left > 1 do begin
middle := (right+left) div 2;
if l[middle] < x then left := middle
else right := middle;
end;
while (l[middle]<=x)and(middle<=n) do inc(middle);
result:=middle-1;
end;
end;

function FindInRight:longint;
var left,right,middle:longint;
begin
if x<r[1] then result:=0
else
if x>r[n] then result:=n
else begin
left:=1; right:=n;
(*
repeat
middle:=(right+left) div 2;
if r[middle]>x then right:=middle
else
if r[middle]<x then left:=middle
until (r[middle]<=x)or(right-left=1);
*)
while right-left > 1 do begin
middle := (right+left) div 2;
if r[middle] < x then left := middle
else right := middle;
end;
while (r[middle]>=x)and(middle<=n) do dec(middle);
result:=middle;
end;
end;

begin
result:=abs(findinleft-findinright)
end;
Казалось бы, ничего не изменилось, ан нет... smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


время улучшилось на пару сотых секунды smile.gif
но этого мало sad.gif
я уже начинаю подозревать систему проверки blink.gif
хотя, люди как-то сдают...то ли лыжи не едут...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Цитата
время улучшилось на пару сотых секунды
Да? У меня время уменьшилось с 8 секунд изначальных (n = m = 105, случайные данные) до 0.06 сек после внесения изменений... Что-то у тебя не то происходит...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


я лишь привёл цифры, которые дала система проверки...
буду дальше думать
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской

Репутация: -  0  +


Координаты отрезков записываем в массив. Держим вспомогательный признак: начало отрезка +1, конец -1. Сортируем массив. Сортируем массив точек. Дольше идем от наименьшего в двух массивах. Сумма +1 будет давать количетво отрезков, которым принадлежит точка.

Такой алгоритм подойдет?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской

Репутация: -  0  +


Точнее, даже так. Все сливаем в один массив. ВВодим признаки: +1 - начало отрезка, 0 - точка, -1 - конец отрезка. Сортируем массив. Далее идем от начала к концу и подсчитываем суммы +1, -1, и 0. На каждом нуле запоминаем сумму.

Работать должно за время сортировки плюс полного прохода по массиву, т.е. O((2*N+M)*(1+log(2*N+M)))

Несколько ускорить может внутренняя проверка на исчерпанность точек и отрезков.

Сработает?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


конечно smile.gif
в первом посте именно такой вариант smile.gif
кстати, оба варианта показывают одинаковое время
может таки это не мой косяк?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Цитата
может таки это не мой косяк?
Может, ты все-таки дашь ссылку на сервер, на котором проверяешь код? А то борьба, похоже, идет с ветряными мельницами...

Ну, сгенерируй файл данных для макс. значений M, N и запусти у себя на машине твой второй и мой исправленный варианты решения. Сколько времени выполняется исправленный? Как может сервер выдавать тебе овертайм при разрешенном времени = 2 секунды (если он, конечно, вменяемый сервер)?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


пожалуйста: http://acmp.ru/index.asp?main=task&id_task=396

Сообщение отредактировано: c-ch -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Я ничего с этим сервером не понимаю wacko.gif Была вот такая идея:

{$r-}
{$q-}
program Project1;
// uses windows;
const
count = 100000;
type
tevent = (ev_add, ev_check, ev_remove);
trec = record
ev: tevent;
index: longint;
X: longint;
end;

ev_array = array[1 .. 3 * count] of trec;
arrtype = array[1 .. count] of longint;

var
events: ev_array;


procedure quicksort(var a: ev_array; Lo,Hi: integer);
function less(f, s: trec): boolean;
begin
less := (f.X < s.X) or ((f.X = s.X) and (f.ev < s.ev));
end;
function more(f, s: trec): boolean;
begin
more := (f.X > s.X) or ((f.X = s.X) and (f.ev > s.ev));
end;
procedure sort(l,r: integer);
var
i,j: integer;
x,y: trec;
begin
i:=l; j:=r; x := a[(r+l) div 2];
repeat
while less(a[i], x) do i:=i+1;
while less(x, a[j]) do j:=j-1;
if i<=j then
begin
if more(a[i], a[j]) then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y
end;
i:=i+1; j:=j-1
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r)
end;
begin
sort(Lo,Hi)
end;

// var tt: dword;
var
f, fout: text;

m, n, i, j: longint;
cnt: arrtype;
curr: longint;
p, L, R: longint;

begin
// tt := gettickcount;
assign(f, 'input.txt'); reset(f);
readln(f, n, m);
j := 0;
for i := 1 to n do begin
readln(f, L, R);
inc(j);
events[j].ev := ev_add; events[j].index := -1; events[j].X := L;
inc(j);
events[j].ev := ev_remove; events[j].index := -1; events[j].X := R;
end;

for i := 1 to m do begin
read(f, p);
inc(j);
events[j].ev := ev_check; events[j].index := i; events[j].X := p;
end;
quicksort(events, 1, j);
close(f);

curr := 0;
for i := 1 to j do begin
if events[i].ev = ev_add then inc(curr)
else
if events[i].ev = ev_check then cnt[events[i].index] := curr
else dec(curr);
end;

assign(fout, 'output.txt'); rewrite(fout);
for i := 1 to m do write(fout, cnt[i], ' ');
close(fout);
// writeln('time = ', gettickcount - tt);
end.
, 5 тестов отработало "влёт", на шестом с какого-то перепуга "неверный ответ", хотя что там может быть неверного? Может, ты найдешь ошибку в алгоритме?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






Бррр... Да, сам виноват, посчитал, что в паре координат, образующих отрезок, всегда первой идет левая граница, а второй - правая. В условии этого не было указано, так что надо проверять, что меньше, а что - больше. С проверкой программа проходит все тесты, еще и с запасом...

c-ch, в алгоритме разобрался?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  1  +


да, спасибо :смайлик_с_пивом:
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






Statutaria Kamagra Vendite
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






Comprar Cialis Generico Por Internet
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 19.04.2024 6:37
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name