Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.12.2018, 12:33   #1
Ya ne Ya
 
Регистрация: 02.12.2018
Сообщений: 8
Вопрос Работа со списками , вставить второй список за первым вхождением числа первого списка

Есть такой вот код тут практически ничего моего нет , но я его понял но вторую часть не очень хорошо.
Код я взял с форума и видоизменил только переменные.
Тут выполняется вот такое:я создаю список , потом ищу элемент в первом списке за которым я буду вставлять число ищу элемент из второго списка который вставлю в первый за вхождением числа из первого и осуществляю вставку. Но мне нужно сделать так , чтобы весь второй список вставлялся за первым вхождением числа из первого списка, буду очень благодарен если поможете встать на пусть понимания как это сделать.
Код:
type
{Тип основных данных.}
TElem=real;
{Тип указателя на элемент списка.}
n=^L1;
{Тип элемента списка.}
L1 = record
        Elem:TElem;{Основные данные.}
        next:n;{Указатель на следующий элемент списка.}        
end; 
{Тип, описывающий однонаправленный список.}
Spisock = record 
        NFirst,NLast:n; {Указатели на первый и на последний элементы списка.}
end;        
 
 
{Начальная инициализация списка,только в отношении пустого списка}
procedure Init(var aList : Spisock );
begin
  aList.NFirst := nil;
  aList.NLast := nil;
end;
 
{Особождение памяти, занятой под список.}
procedure Free(var aList : Spisock);
var
  next, NDel : n;
begin
  next := aList.NFirst;
  while next <> nil do 
  begin
    NDel := next;
    next := next^.next;
    Dispose(NDel);
  end;
  Init(aList);
end;
 
       
{Распечатка однонаправленного списка.}
procedure WriteList(const aList : Spisock );
var
  tec : n;
begin
  if aList.NFirst = nil then begin
    Write('Список пуст.');
    Exit;
  end;
 
  tec := aList.NFirst;
  while tec <> nil do begin
    if tec <> aList.NFirst then Write(', ');
    Write(tec^.Elem);
    tec := tec^.next;
  end;
end;
 
 
{Добавление элемента в конец однонаправленного списка.}
procedure Add(var aList :Spisock ; const aElem : TElem);
var
  tec : n;
begin
  New(tec);
  tec^.Elem := aElem;
  tec^.next := nil;
  if aList.NFirst = nil then
    aList.NFirst := tec
  else
    aList.NLast^.next := tec;
    aList.NLast := tec;
end;
 
var
L,L2:Spisock;
pred,tec,Tnew:n;
i,code:integer;
u,v:string;
Elem,E,F:TElem;
Begin
 
{Начальная инициализация списка.}
Init(L);
Init(L2);
 
{создание первого списка}
repeat
    Writeln('Создание списка.');
    Writeln('Прекратить ввод - пустая строка + Enter.');
    i := 0;
    repeat
      Write('Элемент ', i + 1, ': ');
      Readln(u);
      if u <> '' then 
      begin
        Val(u, Elem, Code);
        if Code = 0 then 
        begin
          Inc(i);
          Add(L, Elem);
        end 
        else
          Writeln('Неверный ввод. Повторите.');
      end;
    until u = '';
    Writeln('Составлен список:');
    WriteList(L);
    Writeln;
until u = '';
 {создание второго списка}
repeat
    Writeln('Создание списка.');
    Writeln('Прекратить ввод - пустая строка + Enter.');
    i := 0;
    repeat
      Write('Элемент ', i + 1, ': ');
      Readln(v);
      if v <> '' then 
      begin
        Val(v, Elem, Code);
        if Code = 0 then begin
          Inc(i);
          Add(L2, Elem);
        end 
        else
          Writeln('Неверный ввод. Повторите.');
      end;
    until v = '';
    Writeln('Составлен список:');
    WriteList(L2);
    Writeln; 
until v = '';
 
 
 
{Задаем значение элементов.}
repeat
      Write('Задайте значение искомого элемента (E): ');
      Readln(u);
      Val(u, E, Code);
      if Code <> 0 then
        Writeln('Неверный ввод. Повторите.');
until Code = 0;
repeat
      Write('Задайте значение вставляемого элемента (F): ');
      Readln(v);
      Val(v, F, Code);
      if Code <> 0 then
        Writeln('Неверный ввод. Повторите.');
until Code = 0;
 
 
{Ищем первый элемент со значением E и в случае его обнаружения вставляем перед ним элементы второго списка}
{Чтобы вставить перед элементом новый элемент мы должны знать указатель на предыдущий элемент. Для этого заведена переменная pred.}
pred := nil;{Указатель на предыдущий элемент списка.}
tec := L.NFirst;{Указатель на текущий элемент списка.}
Tnew := nil;{Указатель на новый элемент.}
while (tec <> nil) and (Tnew = nil) do
  if tec^.Elem = E then begin
  {Выделяем память для нового элемента и получаем указатель на него.}
  new(Tnew);
  {Записываем данные.}
  Tnew^.Elem := F;
  {К новому элементу прикрепляем ту часть списка, которая идёт после элемента tec.}
  Tnew^.next := tec;
  {К элелменту tec прикрепляем элемент Tnew. (А к Tnew уже прикреплена остальная часть списка.)}
  if pred = nil then 
    L.NFirst := Tnew
  else
    pred^.next := Tnew;
  end else begin
  {Переходим к следующей паре элементов.}
  pred := tec;
  tec := tec^.next{Получаем указатель на следующий элемент списка.}
  end;
  
  if Tnew <> nil then 
  begin
      Writeln('Новый элемент F вставлен в список.');
      Writeln('Список после вставки:');
      WriteList(L);
      Writeln;
  end else
      Writeln('Элемента Е нет в списке. Новый элемент F в список не вставлен.');
      
{Освобождение памяти, занятой под список.}
    Free(L);
    Writeln('Память, занятая под список, освобождена. Работа завершена.'); 
    
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(u);
 
End.
Ya ne Ya вне форума Ответить с цитированием
Старый 17.12.2018, 15:09   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
program Project1;
uses crt;

type
  TData = Integer;
  TPElem = ^TElem;
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
  TDList = record
    PFirst, PLast : TPElem;
  end;

procedure Init(var aList : TDList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;

procedure Add(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
end;

procedure Free(var aList : TDList);
var
  PNext, PDel : TPElem;
begin
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;

procedure WriteList(const aList : TDList);
var
  PElem : TPElem;
begin
  if aList.PFirst = nil then begin
    Write('Empty List.');
    Exit;
  end;

  PElem := aList.PFirst;
  while PElem <> nil do begin
    if keypressed then exit;
    if PElem <> aList.PFirst then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  writeln;
end;

procedure CreateList(var aList : TDList);
var s,u: string;
	i,Code	: integer;
	Data : TData;
begin
    Writeln('List Creating.');
    Writeln('STOP - empty line + Enter.');
    i := 0;
    repeat
      Write('Element ', i + 1, ': ');
      Readln(S);
      if S <> '' then begin
        Val(S, Data, Code);
        if Code = 0 then begin
          Inc(i);
          Add(aList, Data);
        end else
          Writeln('Error. Repeat.');
      end;
    until S = '';
end;

var
  L, L2 : TDList;
  PElem  : TPElem;
  Data, E  : TData;
  i, Code : Integer;
  S : String;
begin
  ClrScr;
  Init(L);

    CreateList(L);
    Writeln('List:');
    WriteList(L);
    Writeln;
	CreateList(L2);
    Writeln('List:');
    WriteList(L2);
    Writeln;

    repeat
      Write('Element   (E): ');
      Readln(S);
      Val(S, E, Code);
      if Code <> 0 then
        Writeln('Error. Repeat.');
    until Code = 0;

    PElem := L.PFirst;

   while (PElem <> nil)  do
      if PElem^.Data = E then begin
        L2.PLast^.PNext := PElem^.Pnext;
        L2.PLast := PElem;
        PElem^.pNext := L2.PFirst;
        break;
      end
      else
      begin
        PELem := PElem^.PNext;
      end;
      WriteList(L);
    Free(L);
    Writeln;
    Writeln('Press <<ENTER>>');
    Readln;
end.
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 17.12.2018, 15:12   #3
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

Код:
 {Выделяем память для нового элемента и получаем указатель на него.}
  new(Tnew);   {Выделяем память для нового элемента и получаем указатель на него.}
  new(Tnew); 
  {Записываем данные.}
  Tnew^.Elem := F;  
 У нас НЕТ никакого отдельно взятого нового элемента F (а есть список который надо встроить на заданное место)
Цитата:
Но мне нужно сделать так , чтобы весь второй список вставлялся за первым вхождением числа из первого списка,
tec... --> next... --> ...
tec... --> корень2. --> ... --> посл.из2... --> next.... --> ...
нам надо добавить

1. нашли куда (tec:= next:=
Цитата:
while (tec<>nil) do
if tec^Elem =E then break;

next:=tec^.next;
2. поменяли ссылку tec.next на корень(первый элемент) добавляемого списка
3. поменяли ссылку у последнего из добавляемого списка на след. за искомым
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 17.12.2018, 18:08   #4
Ya ne Ya
 
Регистрация: 02.12.2018
Сообщений: 8
По умолчанию

Цитата:
Сообщение от evg_m Посмотреть сообщение
Код:
 {Выделяем память для нового элемента и получаем указатель на него.}
  new(Tnew);   {Выделяем память для нового элемента и получаем указатель на него.}
  new(Tnew); 
  {Записываем данные.}
  Tnew^.Elem := F;  
 У нас НЕТ никакого отдельно взятого нового элемента F (а есть список который надо встроить на заданное место)
tec... --> next... --> ...
tec... --> корень2. --> ... --> посл.из2... --> next.... --> ...
нам надо добавить

1. нашли куда (tec:= next:=

2. поменяли ссылку tec.next на корень(первый элемент) добавляемого списка
3. поменяли ссылку у последнего из добавляемого списка на след. за искомым
Спасибо за помощь ) все учту )
Ya ne Ya вне форума Ответить с цитированием
Старый 17.12.2018, 18:09   #5
Ya ne Ya
 
Регистрация: 02.12.2018
Сообщений: 8
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Код:
program Project1;
uses crt;

type
  TData = Integer;
  TPElem = ^TElem;
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
  TDList = record
    PFirst, PLast : TPElem;
  end;

procedure Init(var aList : TDList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;

procedure Add(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
end;

procedure Free(var aList : TDList);
var
  PNext, PDel : TPElem;
begin
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;

procedure WriteList(const aList : TDList);
var
  PElem : TPElem;
begin
  if aList.PFirst = nil then begin
    Write('Empty List.');
    Exit;
  end;

  PElem := aList.PFirst;
  while PElem <> nil do begin
    if keypressed then exit;
    if PElem <> aList.PFirst then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  writeln;
end;

procedure CreateList(var aList : TDList);
var s,u: string;
	i,Code	: integer;
	Data : TData;
begin
    Writeln('List Creating.');
    Writeln('STOP - empty line + Enter.');
    i := 0;
    repeat
      Write('Element ', i + 1, ': ');
      Readln(S);
      if S <> '' then begin
        Val(S, Data, Code);
        if Code = 0 then begin
          Inc(i);
          Add(aList, Data);
        end else
          Writeln('Error. Repeat.');
      end;
    until S = '';
end;

var
  L, L2 : TDList;
  PElem  : TPElem;
  Data, E  : TData;
  i, Code : Integer;
  S : String;
begin
  ClrScr;
  Init(L);

    CreateList(L);
    Writeln('List:');
    WriteList(L);
    Writeln;
	CreateList(L2);
    Writeln('List:');
    WriteList(L2);
    Writeln;

    repeat
      Write('Element   (E): ');
      Readln(S);
      Val(S, E, Code);
      if Code <> 0 then
        Writeln('Error. Repeat.');
    until Code = 0;

    PElem := L.PFirst;

   while (PElem <> nil)  do
      if PElem^.Data = E then begin
        L2.PLast^.PNext := PElem^.Pnext;
        L2.PLast := PElem;
        PElem^.pNext := L2.PFirst;
        break;
      end
      else
      begin
        PELem := PElem^.PNext;
      end;
      WriteList(L);
    Free(L);
    Writeln;
    Writeln('Press <<ENTER>>');
    Readln;
end.
Огромное спасибо случаем не знаешь как вставить новый элемент в начало списка по такому же принципу как у тебя?
Ya ne Ya вне форума Ответить с цитированием
Старый 17.12.2018, 21:21   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Знаю. Выделить память под новый елемент, назначить ему .PNext = L.PFirst а L.PFirst назначить этот новый элемент. В инете полно туториалов как добавить элемент в начало списка.
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Необходимо на четные места во второй список поставить элементы из первого списка anasttb Общие вопросы C/C++ 3 19.06.2017 13:19
Помогите решить задачу на C# В непустой динамически двусвязный список вставить новый элемент Е1 перед первым вхождением элемента Е ekzo Помощь студентам 0 19.01.2017 16:22
Сформировать список из N целочисленных случайных элементов. Удалить из списка все элементы, содержащие делители числа N RomaBayn Паскаль, Turbo Pascal, PascalABC.NET 11 07.11.2014 11:37
В слово, заканчивающимся точкой, вставить новый элемент е1 за каждым вхождением элемента е2(исправить)/delphi(cписки) freestudent Помощь студентам 0 08.02.2014 20:14
LISP.разделить список на 2, в первый поместить четные элементы исходного списка, во второй - нечетные mashik2503 Помощь студентам 1 17.05.2011 19:14