program L1D;

{$APPTYPE CONSOLE}

uses
   System.SysUtils, Math;

type
   Line = record
   Public
      BCoord, Ecoord: Real;
      Count: Integer;
   end;
   TDArray = array of Line;

function CheckFileName(FileName: String): Boolean;
var
   Ans: Boolean;
   i: Integer;
begin
   Ans := True;
   i := 1;
   while (i <= Length(FileName)) And Ans do
   begin
      if FileName[i] In ['\', '/', ':', '*', '?', '"', '<', '>', '|'] then
      begin
         Ans := False;
         Writeln('\/:*?"<>| are forbidden characters...');
      end;
      Inc(i);
   end;
   if Length(FileName) = 0 then
   begin
      Ans := False;
      Writeln('File name is empty');
   end;
   CheckFileName := Ans;
end;

procedure Swap(var A, B: Real);
var
   Buf: Real;
begin
   Buf := A;
   A := B;
   B := A;
end;

function ReadInput(var LineArray: TDArray; var N: Integer): Boolean;
var
   Option: Char;
   ErrorPos, i: Integer;
   FileName, RawInput: String;
   InFile: TextFile;
   KeepReadFileName, KeepReadCosole, StopReadN: Boolean;
begin
   Writeln('[1] Read data from file');
   Writeln('[2] Read data from console');
   Writeln('[~] Close');
   Readln(Option);
   case Option of
      '1':
      begin
         KeepReadFileName := True;
         while KeepReadFileName do
         begin
            Writeln('Enter file name: ');
            Readln(FileName);
            if CheckFileName(FileName) then
            begin
               AssignFile(InFile, FileName);
               if FileExists(FileName) then
               begin
                  KeepReadFileName := False;
                  Reset(InFile);
                  //----------------------------------
                  StopReadN := False;
                  repeat
                     Readln(InFile, RawInput);
                     Val(RawInput, N, ErrorPos);
                     if N > 0 then
                        StopReadN := True
                     else
                        Writeln('N must be greater than zero...');
                  until (ErrorPos = 0) And (StopReadN);
                  SetLength(LineArray, N);
                  for i := 0 to N - 1 do
                  begin
                     Read(InFile, LineArray[i].BCoord, LineArray[i].Ecoord);
                     if LineArray[i].Ecoord < LineArray[i].BCoord then
                        Swap(LineArray[i].Ecoord, LineArray[i].BCoord);
                     LineArray[i].Count := 0;
                  end;
                  CloseFile(InFile);
                  ReadInput := True;
                  //-----------------------------------
               end
               else
                  Writeln('No such file...');
            end;
         end;
      end;
      '2':
      begin
         KeepReadCosole := True;
         while KeepReadCosole do
         begin
            StopReadN := False;
            repeat
               Writeln('Enter number of lines: ');
               Readln(RawInput);
               Val(RawInput, N, ErrorPos);
               if N > 0 then
                  StopReadN := True
               else
                  Writeln('N must be greater than zero...');
            until (ErrorPos = 0) And (StopReadN);
            SetLength(LineArray, N);
            Writeln('Enter coordinates: ');
            for i := 0 to N - 1 do
            begin
               Read(LineArray[i].BCoord, LineArray[i].Ecoord);
               if LineArray[i].Ecoord < LineArray[i].BCoord then
                  Swap(LineArray[i].Ecoord, LineArray[i].BCoord);
               LineArray[i].Count := 0;
            end;
            KeepReadCosole := False;
         end;
         ReadInput := True;
      end;
   else
      ReadInput := False;
   end;
end;

procedure WriteOutput(var Ans: Line);
var Option: Char;
   ErrorPos, i: Integer;
   FileName, RawInput: String;
   OutFile: TextFile;
   KeepReadFileName, KeepReadOption: Boolean;
begin
   Writeln('[1] Write data to file');
   Writeln('[2] Write data to console');
   KeepReadOption := True;
   while KeepReadOption do
   begin
      Readln(Option);
      case Option of
         '1':
         begin
            KeepReadOption := False;
            KeepReadFileName := True;
            while KeepReadFileName do
            begin
               Writeln('Enter file name: ');
               Readln(FileName);
               if CheckFileName(FileName) then
                  KeepReadFileName := False;
            end;
            AssignFile(OutFile, FileName);
            if FileExists(FileName) then
            begin
               KeepReadOption := True;
               Writeln('Do you want to clear file? [Y/N]: ');
               while KeepReadOption do
               begin
                  Readln(Option);
                  if (UpperCase(Option) = 'Y') then
                  begin
                     Rewrite(OutFile);
                     KeepReadOption := False;
                  end
                  else
                  if UpperCase(Option) = 'N' then
                  begin
                     KeepReadOption := False;
                     Append(OutFile);
                  end;
               end;
            end
            else
               Rewrite(OutFile);
         //---------------------------------
            Writeln(OutFile, Ans.BCoord: 2: 3, ' ', Ans.ECoord: 2: 3, ' ', Ans.Count);
            Writeln('Done.');
            CloseFile(OutFile);
         //-----------------------------------
         end;
         '2':
         begin
            KeepReadOption := False;
            Writeln(Ans.BCoord: 2: 3, ' ', Ans.ECoord: 2: 3, ' ', Ans.Count);
         end;
      end;
   end;
end;

procedure QuickSort(var A: TDArray; Min, Max: Integer);
var
   i, j: Integer;
   Mid, Buf: Line;
begin
   Mid := A[Max - ((Max - Min) Div 2)];
   i := Min;
   j := Max;
   while i < j do
   begin
      while A[i].BCoord < Mid.BCoord do
         i := i + 1;
      while A[j].BCoord > Mid.BCoord do
         j := j - 1;
      if i <= j then
      begin
         Buf := A[i];
         A[i] := A[j];
         A[j] := Buf;
         i := i + 1; j := j - 1;
      end;
   end;
   if Min < j then
      QuickSort(A, Min, j);
   if i < Max then
      QuickSort(A, i, Max);
end;

function CountMaxIntersections(var LineList: TDArray): Line;
var
   i, j: Integer;
   Ans: Line;
begin
   Ans.Count := -1;
   i := 0;
   while i < Length(LineList) - 1 do
   begin
      j := i + 1;
      while (LineList[j].BCoord <= LineList[i].ECoord) And (j < Length(LineList)) do
      begin
         Inc(LineList[j].Count);
         Inc(LineList[i].Count);
         Inc(j);
      end;
      if LineList[i].Count > Ans.Count then
         Ans := LineList[i];
      Inc(i);
   end;
   CountMaxIntersections := Ans;
end;

procedure Main();
var
   i, N: Integer;
   LineArr: TDArray;
   Close: Boolean;
   Buf, Ans: Line;
begin
   while ReadInput(LineArr, N) do
   begin
      try
         QuickSort(LineArr, 0, N - 1);
         Ans := CountMaxIntersections(LineArr);
         WriteOutput(Ans);
      except
         on EInOutError do
            Writeln('Input Error');
      end;
   end;
end;

begin
   Main;
end.