Слить две строки, вставив символы одной строки между символами другой строки

@Greenmars · Регистрация: 01.02.2016

Текст задачи

Строка a из n символов лексикографически меньше строки b из n символов, если существует такой индекс j, что aj < bj, а для всех i < j ai = bi.

Вам даны две строки: a и b.

Вам необходимо слить две строки, вставив символы одной строки между (возможно также перед или после) символами другой строки, сохранив при этом порядок следования символов в исходных строках. Новая строка должна быть лексикографически максимальной из всех возможных.

Ограничения

Строки состоят из строчных букв латинского алфавита. Длина строк не превышает 1000.

Входные данные
В первой строка дана строка a. Во второй строке дана строка b.

Выходные данные
Выведите одну строку — лексикографически максимальную строку, которую можно получить слиянием строк a и b.

Примеры

input.txt	output.txt
ca dbxb	dcbxba

input.txt	output.txt
abc xyz	xyzabc

input.txt	output.txt
aa aa	aaaa

@bormant · 03.02.2016, 14:33

Условие длиннее решения:

Pascal

const m=1000;
var
  a, b: array [0..m] of Char;
  c: array [0..2*m] of Char;
  i, j, k: Integer;
begin
  ReadLn(a); ReadLn(b);
  i:=0; j:=0; k:=0;
  while (a[i]<>#0) and (b[j]<>#0) do begin
    if a[i]>b[j] then begin
      c[k]:=a[i]; Inc(i)
    end else begin
      c[k]:=b[j]; Inc(j);
    end;
    Inc(k);
  end;
  while a[i]<>#0 do begin
    c[k]:=a[i]; Inc(i); Inc(k);
  end;
  while b[j]<>#0 do begin
    c[k]:=b[j]; Inc(j); Inc(k);
  end;
  c[k]:=#0;
  WriteLn(c);
end.

@Greenmars · 03.02.2016, 14:54 **[ТС]**

bormant, не очень понятно ваше решение. Зачем нужны массивы?

@bormant · 03.02.2016, 15:00

Сообщение от Greenmars

Зачем нужны массивы?

Сообщение от Greenmars

Вам даны две строки: a и b.
... Длина строк не превышает 1000.

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

Добавлено через 3 минуты
Кстати, можно (и нужно) еще короче, пользуясь тем что всякий допустимый символ больше #0:

Pascal

const m=1000;
var
  a, b: array [0..m] of Char;
  c: array [0..2*m] of Char;
  i, j, k: Integer;
begin
  ReadLn(a); ReadLn(b);
  i:=0; j:=0; k:=0;
  while (a[i]<>#0) or (b[j]<>#0) do begin
    if a[i]>b[j] then begin
      c[k]:=a[i]; Inc(i)
    end else begin
      c[k]:=b[j]; Inc(j);
    end;
    Inc(k);
  end;
  c[k]:=#0;
  WriteLn(c);
end.

@Greenmars · 03.02.2016, 15:03 **[ТС]**

Сообщение от bormant

ReadLn(a); ReadLn(b);

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

@bormant · 03.02.2016, 15:06

Можно переписать так:

Pascal

const m=1000;
var
  a, b: array [0..m] of Char;
  c: array [0..2*m] of Char;
  pa, pb, pc: PChar;
begin
  ReadLn(a); ReadLn(b);
  pa:=a; pb:=b; pc:=c;
  while (pa^<>#0) or (pb^<>#0) do begin
    if pa^>pb^ then begin
      pc^:=pa^; Inc(pa);
    end else begin
      pc^:=pb^; Inc(pb);
    end;
    Inc(pc);
  end; pc^:=#0;
  WriteLn(c);
end.

@Greenmars · 03.02.2016, 15:07 **[ТС]**

bormant,

@bormant · 03.02.2016, 15:15

Сообщение от Greenmars

я пользуюсь ABC

Для него есть отдельная ветка.

Сообщение от Greenmars

как так можно считать массив?

В TP/FPC с этим нет проблем, читается как ASCIIZ строка.

Для FPC с длинными строками можно так:

Pascal

{$H+}
var
  a, b, c: String;
  i, j: Integer;
begin
  ReadLn(a); ReadLn(b);
  a:=a+#0; b:=b+#0; c:=''; i:=1; j:=1;
  while (a[i]<>#0) or (b[i]<>#0) do begin
    if a[i]>b[i] then begin
      c:=c+a[i]; Inc(i);
    end else begin
      c:=c+b[j]; Inc(j);
    end;
  end;
  WriteLn(c);
end.

@Greenmars · 03.02.2016, 15:16 **[ТС]**

Сообщение от bormant

c[k]:=#0;

А еще вопрос. Что означает вот эта функция?

@bormant · 03.02.2016, 15:26

ASCIIZ-строка

Добавлено через 5 минут
Для FPC можно также так:

Pascal

var
  a, b, c: AnsiString;
  pa, pb, pc: PChar;
begin
  ReadLn(a); ReadLn(b); SetLength(c,Length(a)+Length(b));
  pa:=@a[1]; pb:=@b[1]; pc:=@c[1];
  while (pa^<>#0) or (pb^<>#0) do begin
    if pa^>pb^ then begin
      pc^:=pa^; Inc(pa);
    end else begin
      pc^:=pb^; Inc(pb);
    end;
    Inc(pc);
  end;
  WriteLn(c);
end.

Здесь использовано то свойство, что AnsiString в конце обязательно хранит #0.

@APALoff · 03.02.2016, 15:41

Pascal

Var a,b : String;
 
Function Merge(s1,s2 : String) : String;
Begin
  If Length(s2)>0 then
    If Length(s1)>0 then 
      If s2[1]>=s1[1] then Merge:=s2[1]+Merge(s1,Copy(s2,2,Length(s2)-1))
      else Merge:=s1[1]+Merge(Copy(s1,2,Length(s1)-1),s2)
    else Merge:=s2
  else Merge:=s1;
end;
 
Begin
  a:='ca';   //Readln(a);
  b:='dbxb'; //Readln(b);
  Writeln(Merge(a,b));
  a:='abc';
  b:='xyz';
  Writeln(Merge(a,b));
  a:='aa';
  b:='aa';
  Writeln(Merge(a,b));
end.

@Greenmars · 03.02.2016, 17:14 **[ТС]**

bormant,посмотрите мой код на ABC. Что в нем не так? Он компилирует. Но при отправке проходит больше половины тестов, но не все.

Pascal

var a,b:string;
c:array [1..2000] of char;
i,j,k,n:integer;
begin
readln(a);
read(b);
j:=1;
i:=1;
k:=1;
n:=length(a)+length(b);
a:=a+'*';
b:=b+'*';
while (a[i]<>'*') and (b[j]<>'*') do 
    begin
    if a[i]>b[j] then 
         begin
         c[k]:=a[i];
         Inc(i);
         end 
   else 
         begin
         c[k]:=b[j];
         Inc(j);
         end;
   write(c[k]);
   Inc(k);
   end;
while a[i]<>'*' do begin
    c[k]:=a[i]; 
    Inc(i); 
    write(c[k]);
    Inc(k);
    end;
  while b[j]<>'*' do 
   begin
   c[k]:=b[j]; 
   Inc(j); 
   write(c[k]);
   Inc(k);
   end;
end.

Добавлено через 10 минут
APALoff, а можете пояснить решение?

Добавлено через 4 минуты
bormant, APALoff, кстати, смотрите... например:
kaaz
kaam
программа должна вывести kkaazaam;
но в предложенной программе выведет: kkaaamaaaz

@bormant · 03.02.2016, 17:36

Должно быть достаточно:

Pascal

var
  a, b, c: String;
  i, j: Integer;
begin
  ReadLn(a); ReadLn(b);
  i:=1; j:=1; c:=''; a:=a+#0; b:=b+#0;
  while (a[i]<>#0) or (b[j]<>#0) do
    if a[i]>b[j] then begin
      c:=c+a[i]; Inc(i);
    end else begin
      c:=c+b[j]; Inc(j);
    end;
  WriteLn(c);
end.

Проверял в http://pascalabc.net/WDE/

Добавлено через 2 минуты

Сообщение от Greenmars

кстати, смотрите... например:
kaaz
kaam
программа должна вывести kkaazaam;
но в предложенной программе выведет: kkaaamaaaz

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

Добавлено через 19 минут
Подумал:

Pascal

var
  a, b, c, t: String;
  i, j: Integer;
begin
  ReadLn(a); ReadLn(b);
  a:=a+#0; b:=b+#0; c:=''; t:=''; i:=1; j:=1;
  while (a[i]<>#0) or (b[j]<>#0) do
    if          a[i]>b[j] then begin
      c:=c+t+a[i]; Inc(i); Dec(j,Length(t)); t:='';
    end else if a[i]<b[j] then begin
      c:=c+t+b[j]; Inc(j); Dec(i,Length(t)); t:='';
    end else begin
      t:=t+a[i]; Inc(i); Inc(j);
    end;
  WriteLn(c,t,t);
end.

@Greenmars · 03.02.2016, 17:43 **[ТС]**

bormant, и все-таки нет.. Представляете, и так даже проходит 114/127. всю голову себе сломал с этой задачей. Уже, наверное, месяца 3 "ломаю".
У меня был код, очень жадный, правда. Там проходит 124/127.
А какие тут еще нюансы, ну, правда, найти не могу.

@bormant · 03.02.2016, 19:33

Сообщение от Greenmars

и все-таки нет.

Угу, надо еще немного подумать.
То, что выше написал, оно дублирует одинаковую подстроку, а ее надо тоже предварительно преобразовать, нужно только сообразить, по какому правилу.

Добавлено через 27 минут
Подумал.

Pascal

var
  a, b, c: String;
  i, j: Integer;
procedure TakeA; begin c:=c+a[i]; Inc(i); end;
procedure TakeB; begin c:=c+b[j]; Inc(j); end;
function LookForA: Boolean;
var ii, jj: Integer;
begin
  ii:=i; jj:=j;
  while (a[ii]<>#0) and (a[jj]<>#0) and (a[ii]=b[jj]) do begin
    Inc(ii); Inc(jj);
  end;
  LookForA:=a[ii]>b[jj];
end;
begin
  ReadLn(a); ReadLn(b);
  a:=a+#0; b:=b+#0; c:=''; i:=1; j:=1;
  while (a[i]<>#0) or (b[j]<>#0) do
    if      a[i]>b[j] then TakeA
    else if a[i]<b[j] then TakeB
    else if LookForA  then TakeA else TakeB;
  WriteLn(c);
end.

Добавлено через 5 минут
Или даже так:

Pascal

{$H+}
var
  a, b, c: String;
  i, j: Integer;
procedure TakeA; begin c:=c+a[i]; Inc(i); end;
procedure TakeB; begin c:=c+b[j]; Inc(j); end;
function  FwdA(i, j: Integer): Boolean;
begin
  while (a[i]<>#0) and (a[j]<>#0) and (a[i]=b[j]) do begin
    Inc(i); Inc(j);
  end;
  FwdA:=a[i]>b[j];
end;
begin
  ReadLn(a); ReadLn(b);
  a:=a+#0; b:=b+#0; c:=''; i:=1; j:=1;
  while (a[i]<>#0) or (b[j]<>#0) do
    if      a[i]>b[j] then TakeA
    else if a[i]<b[j] then TakeB
    else if FwdA(i,j) then TakeA else TakeB;
  WriteLn(c);
end.

Кстати, проверяющий сайт на каком компиляторе? Если FPC, то этот вариант его должен удовлетворить.

Добавлено через 4 минуты
Ну и вариант для TP, в котором нет длинных String-ов:

Pascal

const m=1000;
var
  a, b: array [0..m] of Char;
  c: array [0..2*m] of Char;
  i, j, k: Integer;
procedure TakeA; begin c[k]:=a[i]; Inc(k); Inc(i); end;
procedure TakeB; begin c[k]:=b[j]; Inc(k); Inc(j); end;
function  FwdA(i, j: Integer): Boolean;
begin
  while (a[i]<>#0) and (a[j]<>#0) and (a[i]=b[j]) do begin
    Inc(i); Inc(j);
  end;
  FwdA:=a[i]>b[j];
end;
begin
  ReadLn(a); ReadLn(b); { i:=0; j:=0; k:=0; }
  while (a[i]<>#0) or (b[j]<>#0) do
    if      a[i]>b[j] then TakeA
    else if a[i]<b[j] then TakeB
    else if FwdA(i,j) then TakeA else TakeB;
  {c[k]:=#0;} WriteLn(c);
end.

@Greenmars · 03.02.2016, 19:36 **[ТС]**

Сообщение от bormant

function *FwdA(i, j: Integer): Boolean;

я отправил. представляете, 126/127. Замечу, прошлое решение проходило данный тест, который остался для полного решения.

Добавлено через 56 секунд

Сообщение от Greenmars

function *FwdA(i, j: Integer): Boolean

выделил и забыл об этом)
Что делает данная функция. И опять же, если не сложно, прокомментируйте решение.

@bormant · 03.02.2016, 19:36

А у вас есть тест, который не проходит?

@Greenmars · 03.02.2016, 19:40 **[ТС]**

bormant, кажется, нашел этот несчастный тест.
aa
aaaaaaa
- ошибка времени исполнения.

@bormant · 03.02.2016, 20:13

TakeA -- взять в C очередной символ из A,
TakeB -- взять в C очередной символ из B,
FwdA -- когда текущие подстроки равны, заглянуть вперед, будет ли у A после равного участка больший символ. Если будет, TakeA, иначе TakeB.
Формально, если не экономить на накладных расходах на вызов функции, можно сократить до

Pascal

17
18

  while (a[i]<>#0) or (b[j]<>#0) do
    if FwdA(i,j) then TakeA else TakeB;

Добавлено через 8 минут
Там опечатка в строке, должно быть

Pascal

1	while (a[i]<>#0) and (b[j]<>#0) and (a[i]=b[j]) do begin

Везде в FwdA индекс j или jj должен применяться к b. Там где выше эта опечатка есть, ее нужно поправить.

Добавлено через 2 минуты
В сухом остатке:

Pascal

var
  a, b, c: String;
  i, j: Integer;
function  FwdA(i, j: Integer): Boolean;
begin
  while (a[i]<>#0) and (b[j]<>#0) and (a[i]=b[j]) do begin
    Inc(i); Inc(j);
  end;
  FwdA:=a[i]>b[j];
end;
begin
  ReadLn(a); ReadLn(b);
  a:=a+#0; b:=b+#0; c:=''; i:=1; j:=1;
  while (a[i]<>#0) or (b[j]<>#0) do
    if FwdA(i,j)
    then begin c:=c+a[i]; Inc(i); end
    else begin c:=c+b[j]; Inc(j); end;
  WriteLn(c);
end.

Добавлено через 15 минут
Возможный вариант для Turbo Pascal и FreePascal:

Pascal

uses Strings;
const m=1000;
var
  aa, ab: array [0..m] of Char;
  ac: array [0..2*m] of Char;
  a, b, c: PChar;
begin
  ReadLn(aa); ReadLn(ab); a:=aa; b:=ab; c:=ac;
  while (a^<>#0) or (b^<>#0) do
    if StrComp(a,b)>0
    then begin c^:=a^; Inc(c); Inc(a); end
    else begin c^:=b^; Inc(c); Inc(b); end;
  WriteLn(ac);
end.

@Greenmars · 03.02.2016, 20:40 **[ТС]**

bormant, огромное спасибо. Задача решена.

Слить две строки, вставив символы одной строки между символами другой строки

Решение

Решение

Решение

Решение

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 14:54 [ТС]	3
	bormant, не очень понятно ваше решение. Зачем нужны массивы? 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 15:03 [ТС]	5
	Сообщение от bormant ReadLn(a); ReadLn(b); а как так можно считать массив? я пользуюсь ABC. Не компилирует даже. 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 15:07 [ТС]	7
	bormant, Миниатюры 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 15:16 [ТС]	9
	Сообщение от bormant c[k]:=#0; А еще вопрос. Что означает вот эта функция? 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 17:43 [ТС]	14
	bormant, и все-таки нет.. Представляете, и так даже проходит 114/127. всю голову себе сломал с этой задачей. Уже, наверное, месяца 3 "ломаю". У меня был код, очень жадный, правда. Там проходит 124/127. А какие тут еще нюансы, ну, правда, найти не могу. 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 19:36 [ТС]	16
	Сообщение от bormant function FwdA(i, j: Integer): Boolean; я отправил. представляете, 126/127. Замечу, прошлое решение проходило данный тест, который остался для полного решения. Добавлено через 56 секунд* Сообщение от Greenmars function *FwdA(i, j: Integer): Boolean выделил и забыл об этом) Что делает данная функция. И опять же, если не сложно, прокомментируйте решение. 0

@bormant Модератор 7064 / 4192 / 2728 Регистрация: 22.11.2013 Сообщений: 12,011 Записей в блоге: 1
	03.02.2016, 19:36	17
	А у вас есть тест, который не проходит? 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 19:40 [ТС]	18
	bormant, кажется, нашел этот несчастный тест. aa aaaaaaa - ошибка времени исполнения. 0

@Greenmars 0 / 0 / 0 Регистрация: 01.02.2016 Сообщений: 75
	03.02.2016, 20:40 [ТС]	20
	bormant, огромное спасибо. Задача решена. 0