Прочитать последовательность слов в список. Если количество слов четно, то тогда создать список из 2-го, 4-го и т.д. слов

@Roman0912 · Регистрация: 27.01.2014

Author24 — интернет-сервис помощи студентам

Вот условие задачи(В файл занести последовательность слов. Прочитать последовательность слов в список. Если количество слов четно, то тогда создать список из 2-го, 4-го и т.д. слов. Если же последовательность содержит нечетное количество слов, тогда создается список из 1-го, 3-го и т.д. слов. Обеспечить вывод на экран исходной последовательности слов и результатов обработки этой последовательности.) помогите написать прогу плиз, я по спискам почти ноль, набросайте хотя бы основы и как прочитать четные слова из файла в список? мне для зачета надо сделать эту прогу, заранее спс!

@pHOMM · 28.01.2014, 10:20

Список то какой ? односвязный двусвязный, или может вообще потомок TList ?
Вот для последнего:

Delphi

procedure TForm1.Button1Click(Sender: TObject);
var
  sls, slt: TStringList;
  I: Integer;
begin
  sls := TStringList.Create;
  slt := TStringList.Create;
  sls.Text := 'ololo'#13#10'pysh'#13#10'popya4so'#13#10'ftopku'#13#10'up4ka'#13#10'!!!11odin';
  for I := 0 to sls.Count - 1 do
    if (Odd(sls.Count) and not Odd(i)) or (not Odd(sls.Count) and Odd(i)) then
      slt.Add(sls[i]);
  ShowMessage(sls.Text);
  ShowMessage(slt.Text);
  sls.Free;
  slt.Free;
end;

Тут в список заносится 6 строк (разделяются по #13#10) и выведутся оригинальный список и список чётных. Если измените кол-во строк до нечётного - то выведутся нечётные. Условие в if учитывает нумерацию в списке - она от 0, поэтому not чередуются. Поменять указание текста на загрузку из файла можно командой sls.LoadFromFile('полный_путь_до_файла');

@Roman0912 · 28.01.2014, 11:32 **[ТС]**

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

Список то какой ? односвязный двусвязный, или может вообще потомок TList ?

я не знаю какой именно нужен список, наверное, односвязный

Добавлено через 2 минуты
А без Form можете сделать тот фрагмент?

Добавлено через 14 минут
можешь пояснить условие пж, а то я что-то не очень понимаю, что именно там делается, на каком-нибудь примере пж!

Добавлено через 2 минуты
я просто не знаю, что делает odd первый раз это вижу((((

@pHOMM · 28.01.2014, 11:50

Если нужен односвязный, то этот код не подойдёт никак, лучше сперва напишите или наберите по форуму процедуры для работы с односвязным списком - куча тем есть. Потом уже можно что-то обсуждать. Да и сами Вы должны поработать. А то у Вас даже нет загрузки списка.
Для консольного приложения можно так поменять. Как видите, практически ничего не поменялось:

Delphi

procedure BlahBlah;
var
  sls, slt: TStringList;
  I: Integer;
begin
  sls := TStringList.Create;
  slt := TStringList.Create;
  sls.Text := 'ololo'#13#10'pysh'#13#10'popya4so'#13#10'ftopku'#13#10'up4ka'#13#10'!!!11odin';
  for I := 0 to sls.Count - 1 do
  begin  
    if (Odd(sls.Count) and not Odd(i)) or (not Odd(sls.Count) and Odd(i)) then
      slt.Add(sls[i]);
    WriteLn(sls[i]);
  end;
  for I := 0 to slt.Count - 1 do
    WriteLn(slt[i]);
  sls.Free;
  slt.Free;
end;

Odd - стандартная функция паскаля, емнип, выдаёт true если число нечётное, можно заменить на "число mod 2 <> 0"
Условие читается как "если (строк в файле чётно и i-я итерация цикла - нечётная) или (наоборот для случая нечётного числа строк в файле)"

@Roman0912 · 28.01.2014, 11:54 **[ТС]**

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

Если нужен односвязный, то этот код не подойдёт никак...

А для какого списка подойдет этот код? Можете в краткости сказать, в чем именно различия односвязного от двусвязного списков?

@pHOMM · 28.01.2014, 12:35

Этот код для списка строк, просто списка на основе готового класса, включённого в библиотеку классов Дельфи. Односвязный и двусвязный списки это в некотором роде абстракция, реализуется через указатели, при этом каждый элемент списка содержит ссылку (указатель) на другой (обычно "следующий") элемент списка (или "пустой" указатель, nil). Если Вы проходите в ВУЗе тему про указатели, то списки скорее всего подразумеваются односвязные. Различия односвязного и двусвязного - у двусвязного есть не одна ссылка на другой элемент , а две (на следующий и на предыдущий).

@Roman0912 · 28.01.2014, 18:22 **[ТС]**

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

Этот код для списка строк, просто списка на основе готового класса, включённого в библиотеку классов Дельфи. ....

то есть этот код и на двусвязный список нельзя использовать? а как тогда можно узнать четное или не четное количество слов в файле и занести эти слова в список?(я вот это не могу понять, я даже просто занес в файл 5 слов и решил просто посчитать количество слов, но у меня выдало больше 2-ух миллионов, после этого я и застрял на этой задаче)

Добавлено через 3 часа 58 минут
а ты не знаешь как слова из файла занести слова в двусвязный список? и как четные или нечетные из этих слов занести также в список? извини за такое большое количество вопросов, я вот не могу вот придумать как в программе записать результат этих двух ответов((((

Добавлено через 1 час 13 минут
Я пытаюсь посчитать количество слов в файле и мне выдает такую ошибку Project lab__6.exe raised exception class EInOutError with message 'I/o error 105'. Process stopped. Use Step or Run to continue. вот прога для того, чтобы посчитать количество слов в файле:

Delphi

program lab__6;
uses
  SysUtils;
 
var f: file of char;
    k: integer;
    c: char;
begin
assign(f,'C:\Users\Admin\Desktop\Inf\my_file.txt');
reset(f);
while not (eof(f)) do
      begin
      read(f,c);
      if (c=' ') or (c=#13) then inc(k);
      end;
close(f);
write(k);
end.

что у меня не так подскажите пж!

Добавлено через 4 минуты
или мне надо обозначать не char, а строками?

Добавлено через 4 минуты
и ещё, эту ошибку выдает на предпоследней строке

@volvo · 28.01.2014, 18:47

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

ошибку выдает на предпоследней строке

Для того, чтобы использовать консольные read/write, в программе не хватает директивы {$APPTYPE CONSOLE}

Кстати, перед End-ом надо бы добавить еще ReadLn, чтобы успеть увидеть ответ...

P.S. Как это связано с чтением слов в список - не понимаю...

@Roman0912 · 28.01.2014, 19:02 **[ТС]**

у меня не получалось посчитать количество слов, то что я скинул это часть проги

Добавлено через 2 минуты
спс за помощь но у меня снова количество слов неправильно считает((( у меня результат снова чуть больше 2млн вместо 12 слов

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

Delphi

program lab__6;
{$APPTYPE CONSOLE}
uses
  SysUtils;
 
var f: file of char;
    k: integer;
    c: char;
begin
assign(f,'C:\Users\Admin\Desktop\Inf\my_file.txt');
reset(f);
while not (eof(f)) do
      begin
      read(f,c);
      if (c=' ') or (c=#13) then inc(k);
      end;
close(f);
write(k);
readln;
end.

@volvo · 28.01.2014, 19:25

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

@Roman0912 · 29.01.2014, 12:01 **[ТС]**

а можете подсказать как из файла прочитать слова(построчно) в список?

Добавлено через 3 часа 4 минуты
У меня на 42 строке выдает вот эту ошибку и ещё куча подобных ошибок. вот код:

Delphi

program lab6;
{$APPTYPE CONSOLE}
uses SysUtils,windows;
 
function torus(winstr:string):string;
begin
setlength(result,length(winstr));
chartooem(pchar(winstr),pchar(result));
end;
 
type Plist=^Pl; Pl=record c:string; pred:Plist; next:Plist; end;
   tf=TextFile;
 
  procedure soxran_f(var f:tf; flist,list,slist:Plist; t,g,i,k:integer; c:string);
begin
  g:=0;
   k:=1;
  write(torus('Ââîäèòå ñëîâà, ðàçäåëÿÿ èõ îäíèì ïðîáåëîì: '));
  readln(c);
   Assign(f, 'C:\Users\Admin\Desktop\Inf\my_file.txt');
  Rewrite(f);
  for i:=1 to Length(c) do begin
   write(f,c[i]);
   end;
   t:=0;
   while not Eof(f) do begin
      if t=0 then begin
        t:=1;
        new(list);
        list^.c:=c;
        list^.next:=nil;
        list^.pred:=nil;
        flist:=list;
      end
      else begin
        New(slist);
        slist^.c:=c;
        slist^.next:=nil;
        slist^.pred:=list;
        slist^.next:=slist;
        list:=slist;
      end;
   end;
   end;
 
   procedure chtenie(var f:tf; flist,list,slist:Plist; p,g,m,i,k:integer; c:string);
   begin
  Reset(f);
  list:=nil;
  while not Eof(f) do begin
   for i:=1 to Length(c) do begin
     read(f,c[i]);
   if c[i]=' ' then
   inc(k);
   end;
  end;
  if k mod 2 <> 0 then begin
   while not Eof(f) do begin
          m:=1;
     for i:=m to Length(c) do begin
       write(c[i]);
      if c[i]=' ' then begin
       p:=i+1;
       while g<1 do begin
       for i:=p to Length(c) do
        if c[i]=' ' then
        m:=i+1;
        write(c[i]);
        g=1;
       end;
      end;
      end;
      end;
  end else
  while not Eof(f) do begin
          m:=1;
     for i:=m to Length(c) do begin
      if c[i]=' ' then begin
        m:=i+1;
        for i:=m to Length(c) do begin
         write(c[i]);
         if c[i]=' ' then begin
           p:=i+1;
         while g<1 do begin
       for i:=p to Length(c) do
        if c[i]=' ' then
        m:=i;
        write(c[i]);
        g=1;
       end;
         end;
         end;
 
      end;
      end;
      end;
 
 
  write(torus('Ïðåîáðàçîâàííàÿ ïîñëåäîâàòåëüíîñòü: '));
  write(k);
  Close(f);
  soxran_f;
  chtenie(list,flist,slist);
  vivod;
  Readln;
  Readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Добавлено через 12 минут
помогите добавить процедуру вывода списка четных или нечетных слов, ну и конечно помогите записать эти слова в сам список, пж, код написан выше, там около 25 ошибок, помогите устранить их плиз!!!

Добавлено через 2 минуты
pHOMM, влад помоги решить проблему с ошибками в моём коде пж!!!

Добавлено через 2 часа 34 минуты
вот еще один из моих вариантов решения этой задачи, но также без успешный, снова ошибки

Delphi

program Spisok_strok;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  windows;
 
function torus(winstr:string):string;
begin
setlength(result,length(winstr));
chartooem(pchar(winstr),pchar(result));
end;
 type str=string;  TStringList=^p; p=record c:str; next:TStringList; prev:TStringList; end;
   var StrList:TStringList; c:string;
   f:TextFile; flist,list,slist:TStringList; index,t,g,i,k:integer;
begin
  StrList:=TStringList.Create;
  StrList.Sorted:=False;
   g:=0;
   k:=1;
  write(torus('Ââîäèòå ñëîâà, ðàçäåëÿÿ èõ îäíèì ïðîáåëîì: '));
  readln(c);
   Assign(f, 'C:\Users\Admin\Desktop\Inf\my_file.txt');
  Rewrite(f);
  for i:=1 to Length(c) do begin
   write(f,c[i]);
   end;
     index:=0;
   while not Eof(f) do begin
     for i:=1 to langth(c) do begin
      if c[i]<>' ' tnen begin
      StrList.Insert(index,c[i]);
      end;
      if c[i]=' ' then begin
      inc(index);
      end;
      end;
   end;
   end;
 
   procedure chtenie_i_vivod(var f:tf; flist,list,slist:Plist; p,g,m,i,k:integer; c:string);
   begin
 
   Assign(f, 'C:\Users\Admin\Desktop\Inf\my_file.txt');
   Reset(f);
  while not Eof(f) do begin
   for i:=1 to Length(c) do begin
     read(f,c[i]);
   if c[i]=' ' then
   inc(k);
   end;
  end;
  if k mod 2 <> 0 then begin
    p:=1;
    while p<=k do begin
   StrList.Delete(p);
    p:=p+2;
  end;
  end else begin
   p:=0;
   while p<=k do begin
    StrList.Delete(p);
    p:=p+2;
    end;
   end;
 
  write(torus('Ïðåîáðàçîâàííàÿ ïîñëåäîâàòåëüíîñòü: '));
  write(k);
  Close(f);
  soxran_f;
  chtenie_i_vivod(list,flist,slist);
  Readln;
  Readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Добавлено через 1 минуту
UI, помогите пж!!! мне срочно надо сделать эту программу, у меня осталось где то полтора часа, чтобы сделать программу рабочей, помогите плиз!!!

@Mawrat · 29.01.2014, 13:10

Roman0912, решение с односвязанным (однонаправленным) списком. Консольное приложение. Перед запуском программы надо в папку с программой записать файл file.txt в котором должны быть записаны слова. Каждое слово в файле должно быть записано на отдельной строке.

Delphi

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
type
  {Тип основных данных списка.}
  TData = String;
  {Тип указателя на элемент списка.}
  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 LFree(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 LWriteln(const aList : TDList);
var
  PElem : TPElem;
begin
  if aList.PFirst = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aList.PFirst;
  while PElem <> nil do begin
    if PElem <> aList.PFirst then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
const
  Fn = 'file.txt'; {Имя файла.}
var
  F : TextFile;
  L1, L2 : TDList;
  PElem : TPElem;
  Data : TData;
  i, Cnt : Integer;
  S : String;
begin
  {Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  Если после переключения русские буквы показываются неверно,
  следует открыть системное меню консольного окна - щелчком мыши в левом
  верхнем углу окна консоли и выбрать:
  Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  {Начальная инициализация списков}
  Init(L1);
  Init(L2);
 
  repeat
    {Чтение списка слов из файла. В файле каждое слово должно быть записано
    на отдельной строке. Пустые строки пропускаются.}
    {ExtractFilePath(ParamStr(0)) + Fn - Это полный путь к файлу, который
    лежит в той же папке, где располжен исполняемый файл программы.}
    AssignFile(F, ExtractFilePath(ParamStr(0)) + Fn);
    Reset(F);
    Cnt := 0; {Количество прочитанных слов.}
    while not Eof(F) do
    begin
      Readln(F, Data); {Читаем очередную строку (слово) из файла.}
      if Data <> '' then {Если строка (слово) не пустая, то добавляем её в список.}
      begin
        Add(L1, Data); {Добавляем прочитанное слово в список.}
        Inc(Cnt); {Подсчёт слов.}
      end;
    end;
    Writeln('Из файла прочитан список слов:');
    LWriteln(L1);
    Writeln('Количество элементов: ', Cnt);
 
    PElem := L1.PFirst;
    i := 0;
    while PElem <> nil do
    begin
      Inc(i); //Порядковый номер элемента.
      if Cnt mod 2 = 0 then
      begin
        if i mod 2 = 0 then
          Add(L2, PElem^.Data)
      end
      else if i mod 2 <> 0 then
        Add(L2, PElem^.Data);
      {Переходим к следующему элементу списка.}
      PElem := PElem^.PNext;
    end;
 
    Writeln('Составлен новый список слов:');
    LWriteln(L2);
 
    {Освобождение памяти, занятой под списки.}
    LFree(L1);
    LFree(L2);
    Writeln('Память, выделенная для списков, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

@Roman0912 · 29.01.2014, 14:32 **[ТС]**

спасибо огромное!!! можешь переделать так, чтобы последовательность слов вводилась с клавиатуры, а затем записывалась в файл?

@Mawrat · 29.01.2014, 19:54

В код из моего предыдущего сообщения надо ещё добавить команду закрытия файла - вставить на строке 118:

Delphi

118	CloseFile(F);

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

... можешь переделать так, чтобы последовательность слов вводилась с клавиатуры, а затем записывалась в файл?

С вводом данных в файл:

Delphi

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
type
  {Тип основных данных списка.}
  TData = String;
  {Тип указателя на элемент списка.}
  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 LFree(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 LWriteln(const aList : TDList);
var
  PElem : TPElem;
begin
  if aList.PFirst = nil then
  begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aList.PFirst;
  while PElem <> nil do
  begin
    if PElem <> aList.PFirst then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
const
  Fn = 'file.txt'; {Имя файла.}
var
  F : TextFile;
  L1, L2 : TDList;
  PElem : TPElem;
  Data : TData;
  i, Cnt : Integer;
  S : String;
begin
  {Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  Если после переключения русские буквы показываются неверно,
  следует открыть системное меню консольного окна - щелчком мыши в левом
  верхнем углу окна консоли и выбрать:
  Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  {Начальная инициализация списков}
  Init(L1);
  Init(L2);
  {Связывание файловой переменной с именем файла.
  ExtractFilePath(ParamStr(0)) + Fn - Это полный путь к файлу, который
  лежит в той же папке, где располжен исполняемый файл программы.}
  AssignFile(F, ExtractFilePath(ParamStr(0)) + Fn);
 
  repeat
    Writeln('Ввод слов и запись их в файл.');
    Writeln('Ввод каждого слова завершайте нажатием Enter.');
    Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
    Rewrite(F); {Создаём/пересоздаём файл.}
    Cnt := 0; {Количество введённых слов.}
    repeat
      Write('Слово №', Cnt + 1, ': ');
      Readln(Data);
      if Data <> '' then
      begin
        Writeln(F, Data); {Записываем слово в файл.}
        Inc(Cnt);
      end;
    until Data = '';
    Writeln('Слова записаны в файл: ', Fn);
 
    {Чтение списка слов из файла. В файле каждое слово должно быть записано
    на отдельной строке. Пустые строки пропускаются.}
    Reset(F); {Открываем текстовый файл в режиме чтения.}
    Cnt := 0; {Количество прочитанных слов.}
    while not Eof(F) do
    begin
      Readln(F, Data); {Читаем очередную строку (слово) из файла.}
      if Data <> '' then {Если строка (слово) не пустая, то добавляем её в список.}
      begin
        Add(L1, Data); {Добавляем прочитанное слово в список.}
        Inc(Cnt); {Подсчёт слов.}
      end;
    end;
    CloseFile(F); {Закрываем файл.}
 
    Writeln('Из файла прочитан список слов:');
    LWriteln(L1);
    Writeln('Количество элементов: ', Cnt);
 
    {Составляем второй список. Если количество слов нечётное, то во второй
    список записываем слова с чётными порядковыми номерами, иначе - с нечётными.}
    PElem := L1.PFirst;
    i := 0;
    while PElem <> nil do
    begin
      Inc(i); {Порядковый номер элемента (слова) в первом списке.}
      {Если количество слов чётное.}
      if Cnt mod 2 = 0 then
      begin
        if i mod 2 = 0 then {Если порядковый номер слова чётный.}
          Add(L2, PElem^.Data) {Добавление слова во второй список.}
      end
      {Если количество слов нечётное и порядковый номер слова нечётный.}
      else if i mod 2 <> 0 then
        Add(L2, PElem^.Data); {Добавление слова во второй список.}
      {Переходим к следующему элементу списка.}
      PElem := PElem^.PNext;
    end;
 
    Writeln('Составлен новый список слов:');
    LWriteln(L2);
 
    {Освобождение памяти, занятой под списки.}
    LFree(L1);
    LFree(L2);
    Writeln('Память, выделенная для списков, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

@Roman0912 · 30.01.2014, 00:07 **[ТС]**

спс тебе большое, ты меня выручил!!!

@Roman0912 · 15.02.2014, 20:57 **[ТС]**

вот твоя прога с русификатором:

Delphi

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
  function torus(winstr:string):string;
begin
setlength(result,length(winstr));
chartooem(pchar(winstr),pchar(result));
end;
 
type
  {Тип основных данных списка.}
  TData = String;
  {Тип указателя на элемент списка.}
  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 LFree(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 LWriteln(const aList : TDList);
var
  PElem : TPElem;
begin
  if aList.PFirst = nil then
  begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aList.PFirst;
  while PElem <> nil do
  begin
    if PElem <> aList.PFirst then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
const
  Fn = 'my_file.txt'; {Имя файла.}
var
  F : TextFile;
  L1, L2 : TDList;
  PElem : TPElem;
  Data : TData;
  i, Cnt : Integer;
  S : String;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  {Начальная инициализация списков}
  Init(L1);
  Init(L2);
  {Чтение списка слов из файла. В файле каждое слово должно быть записано
    на отдельной строке. Пустые строки пропускаются.}
    {ExtractFilePath(ParamStr(0)) + Fn - Это полный путь к файлу, который
    лежит в той же папке, где располжен исполняемый файл программы.}
  AssignFile(F, ExtractFilePath(ParamStr(0)) + Fn);
 
  repeat
    Writeln(torus('Ввод слов и запись их в файл.'));
    Writeln(torus('Ввод каждого слова завершайте нажатием Enter.'));
    Writeln(torus('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.'));
    Rewrite(F); {Создаём/пересоздаём файл.}
    Cnt := 0; {Количество введённых слов.}
    repeat
      Write(torus('Слово '));
      writeln(Cnt + 1, ': ');
      Readln(Data);
      if Data <> '' then
      begin
        Writeln(F, Data); {Записываем слово в файл.}
        Inc(Cnt);
      end;
    until Data = '';
    Writeln(torus('Слова записаны в файл: '));
    writeln(Fn);
 
    {Чтение списка слов из файла. В файле каждое слово должно быть записано
    на отдельной строке. Пустые строки пропускаются.}
    Reset(F); {Открываем текстовый файл в режиме чтения.}
    Cnt := 0; {Количество прочитанных слов.}
    while not Eof(F) do
    begin
      Readln(F, Data); {Читаем очередную строку (слово) из файла.}
      if Data <> '' then {Если строка (слово) не пустая, то добавляем её в список.}
      begin
        Add(L1, Data); {Добавляем прочитанное слово в список.}
        Inc(Cnt); {Подсчёт слов.}
      end;
    end;
    CloseFile(F); {Закрываем файл.}
 
    Writeln(torus('Из файла прочитан список слов:'));
    LWriteln(L1);
    Writeln(torus('Количество слов: '));
    writeln(Cnt);
 
    {Составляем второй список. Если количество слов нечётное, то во второй
    список записываем слова с чётными порядковыми номерами, иначе - с нечётными.}
    PElem := L1.PFirst;
    i := 0;
    while PElem <> nil do
    begin
      Inc(i); {Порядковый номер элемента (слова) в первом списке.}
      {Если количество слов чётное.}
      if Cnt mod 2 = 0 then
      begin
        if i mod 2 = 0 then {Если порядковый номер слова чётный.}
          Add(L2, PElem^.Data) {Добавление слова во второй список.}
      end
      {Если количество слов нечётное и порядковый номер слова нечётный.}
      else if i mod 2 <> 0 then
        Add(L2, PElem^.Data); {Добавление слова во второй список.}
      {Переходим к следующему элементу списка.}
      PElem := PElem^.PNext;
    end;
 
    Writeln(torus('Составлен новый список слов:'));
    LWriteln(L2);
 
    {Освобождение памяти, занятой под списки.}
    LFree(L1);
    LFree(L2);
    Writeln(torus('Память, выделенная для списков, освобождена.'));
 
    Writeln(torus('Повторить - Enter, выход - любой символ + Enter.'));
    Readln(S);
  until S <> '';
end.

спс тебе большое!!!

Добавлено через 8 минут
Mawrat, и еще раз спс!

@Mawrat · 15.02.2014, 21:01

Это лишнее.

В программе для русификации используется вызовы:

Delphi

1 2	SetConsoleCP(1251); SetConsoleOutputCP(1251);

Если после этого показываются "каракули", то надо переключить шрифт в консольном окне, как сказано в комментариях:

Delphi

  {Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  Если после переключения русские буквы показываются неверно,
  следует открыть системное меню консольного окна - щелчком мыши в левом
  верхнем углу окна консоли и выбрать:
  Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);

@Roman0912 · 16.02.2014, 21:15 **[ТС]**

Mawrat, ок, спс за совет! но мне просто сказали русификатор через функцию оформить, так что я отправил тебе уже с функцией русификации

Добавлено через 20 часов 49 минут
Mawrat,можешь прокомментировать действия у 4 прог, я щас скину их сюда, а ты добавь в код комментарии к каждой процедуре и важным действиям пж. 1 прога

Delphi

program perestanovki;
 
{$APPTYPE CONSOLE}
uses SysUtils,Windows;
 
  function torus(winstr:string):string;
begin
 setlength(result,length(winstr));
 chartooem(pchar(winstr),pchar(result));
end;
 
  type mat=array of integer;
  procedure perestanovka (a:mat; M,n:integer); var  i:integer; ar:integer;
begin
  if(m <= 0) then begin
    for i:=0 to N do begin
      write(a[i],' ');
    end;
      writeln;
  end
      else begin
      perestanovka(a,m-1,n);
    for i:=m downto 0 do begin
      if(i <> m) then begin
      ar:=a[i];
      a[i]:=a[m];
      a[m]:=ar;
      perestanovka(a,m-1,n);
      ar:=a[i];
      a[i]:=a[m];
      a[m]:=ar;
      end;
    end;
  end;
end;
 
  var a:mat; n,i:integer;
begin
    write(torus('Количество переставляемых чисел : '));
    readln(N);
    SetLength(a,N);
    n:=n-1;
  for i:=0 to n do begin
    write(torus('Введите целое число № '));
    write(i+1,' : ');
    readln(a[i]);
  end;
    perestanovka(a,n,n);
    readln;
end.

2 прога

Delphi

program porazrydnay_sortirovka;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  windows;
 
function torus(winstr:string):string;
begin
 setlength(result,length(winstr));
 chartooem(pchar(winstr),pchar(result));
end;
 
 type str=string[50]; PList=^PStruct; PStruct=record num:integer; next:PList;
  end;
 
 procedure vivod_ch(slist:plist); var listtemp:plist;
begin
    listtemp:=slist;
  while (listtemp <> nil) do begin
    writeln(listtemp^.num);
    listtemp:=listtemp^.next;
  end;
end;
 
 procedure sortirovka(var flist, slist:plist);
 var i,j,num,kmax,k:integer; listlast,listnew,listtemp,listsave:plist;
begin
    kmax:=0;
    listlast:=nil;
    slist:=nil;
    listtemp:=flist;
  while (listtemp <> nil) do begin
    num:=listtemp^.num;
    i:=0;
    while (num <> 0) do begin
      num:=num div 10;
      inc(i);
      if (kmax < i) then
      kmax:=i;
    end;
      listtemp:=listtemp^.next;
  end;
  for k:=1 to kmax do begin
      slist:=nil;
    for i := 0 to 9  do begin
      if(k = 1) then begin
      listtemp:=flist;
      end
      else begin
      listtemp:=listsave;
      end;
      while (listtemp <> nil) do begin
        num:=listtemp^.num;
        for j:=1 to (k-1)  do
          num:=num div 10;
          num:=num mod 10;
        if (num=i) then begin
        new(listnew);
        listnew^.num:=listtemp^.num;
        listnew^.next:=nil;
          if (slist=nil) then begin
          slist:=listnew;
          end
          else begin
          listlast^.next:=listnew;
          end;  
          listlast:=listnew;
        end;
        listtemp:=listtemp^.next;
      end;
    end;
    listsave:=slist;
  end;
end;
 
 procedure vvod_ch(var flist:PList);
 var temps:str; tempnum,t:integer;
  listnew,listlast:PList;
begin
  t:=0;
  listlast:=nil;
  repeat
    write(torus('Введите целое число или пустую строку для окончания : '));
    readln(temps);
    if(temps <> '') then begin
      tempnum:=StrToIntDef(temps,-1);
      if (t=0) then begin
        t:=1;
        new(listnew);
        listnew^.num:=tempnum;
        listnew^.next:=nil;
        flist:=listnew;
        listlast:=flist;
      end
      else begin
        new(listnew);
        listnew^.num:=tempnum;
        listnew^.next:=nil;
        listlast^.next:=listnew;
        listlast:=listnew;
      end;
    end;
  until(temps='');
end;
 
 var flist,slist:PList;
begin
  flist:=nil;
  slist:=nil;
  vvod_ch(flist);
  sortirovka(flist,slist);
  vivod_ch(slist);
  readln;
end.

Добавлено через 1 минуту
Mawrat, 3 прога

Delphi

program razrydi;
{$APPTYPE CONSOLE}
uses  SysUtils,windows;
 
function torus(winstr:string):string;
begin
 setlength(result,length(winstr));
 chartooem(pchar(winstr),pchar(result));
end;
 
type str=string[50]; PList=^PStructNum; PStructKey=record exist:integer;
    fpoint:PList; spoint : PList;
  end;
  PStructNum=record num:integer; next:PList; prev:PList;
  end;
  matrix=array [0..9] of PStructKey; Table=record mat : matrix;
  end;
  TFILE=file of integer;
 
  procedure soxran_file; var file1:TFILE; temps:str; tempnum:integer; namefile:str;
begin
    write(torus('Введите имя файла : '));
    readln(namefile);
    Assignfile(file1, namefile);
    rewrite(file1);
  repeat
    write(torus('Введите целое число или пустую строку для окончания : '));
    readln(temps);
    if(temps <> '') then begin
    tempnum:=StrToIntDef(temps,-1);
    write(file1,tempnum);
    end;
  until(temps='');
    close(file1);
end;
 
  procedure zagryz_file(var table1:table;var k:integer);
  var file1:TFILE; tempnum:integer; namefile:str; i,p:integer; list:PList;
begin
    write(torus('Введите имя сохраненного файла : '));
    readln(namefile);
    write(torus('Введите цифру разряда : '));
    readln(k);
    Assignfile(file1,namefile);
    reset(file1);
  for i:=0 to 9 do
    table1.mat[i].exist:=0;
  while  not(EoF(file1))  do begin
    read(file1,tempnum);
    p:=tempnum;
    for i:=2 to k do begin
    p:=p div 10;
    end;
    p:=p mod 10;
    if (table1.mat[p].exist=0) then begin
    table1.mat[p].exist:=1;
    new(list);
    list^.num:=tempnum;
    list^.next:=nil;
    list^.prev:=nil;
    table1.mat[p].fpoint:=list;
    table1.mat[p].spoint:=list;
    end
    else begin
    new(list);
    list^.num:=tempnum;
    list^.next:=nil;
    list^.prev:=table1.mat[p].spoint;
    table1.mat[p].spoint^.next:=list;
    table1.mat[p].spoint:=list;
    end;
  end;
    close(file1);
end;
 
  procedure vivod(table1:table; k:integer);
  var list:PList; i:integer;
begin
        writeln('*********************************************');
        writeln('------------------Razryd  ',k,'------------------');
        writeln('*********************************************');
  for i:=0 to 9 do
  begin
        if (table1.mat[i].exist <> 0) then begin
        writeln('---------------------------------------------');
        writeln('******************Chislo  ',i,'******************');
        writeln('---------------------------------------------');
        list:=table1.mat[i].fpoint;
      while (list <> nil) do begin
        writeln(list^.num);
        list:=list^.next;
      end;
    end;
  end;
end;
 
var table1:table; k:integer;
begin
  soxran_file;
  zagryz_file(table1,k);
  vivod(table1,k);
  readln;
end.

4 прога

Delphi

program ubiranie_lishnego slova;
{$APPTYPE CONSOLE}
uses SysUtils,windows;
 
function torus(winstr:string):string;
begin
 setlength(result,length(winstr));
 chartooem(pchar(winstr),pchar(result));
end;
 
type str = string[50]; PList=^p; p=record s:str; next:PList; prev:PList;
  end;
  TFILE = textfile;
 
procedure soxran_f; var file1 : TFILE; temps : str; namefile : str;
begin
    write(torus('Введите имя файла : '));
    readln(namefile);
    Assignfile(file1, namefile);
    rewrite(file1);
  repeat
    write(torus('Введите слово или пустую строку для окончания : '));
    readln(temps);
    if(temps <> '') then
    writeln(file1, temps);
  until(temps='');
    close(file1);
end;
 
procedure zagryz_f(var flist, list, slist : PList);
var file1 : TFILE; temps : str; namefile : str; t : integer;
begin
    write(torus('Введите имя созданного файла : '));
    readln(namefile);
    Assignfile(file1, namefile);
    reset(file1);
    flist:=nil;
    list:=nil;
    slist:=nil;
    t:=0;
  while not(EoF(file1)) do begin
    readln(file1, temps);
    if t=0 then begin
    t:=1;
    new(list);
    list^.s :=temps;
    list^.next := nil;
    list^.prev := nil;
    flist:=list;
    end
     else begin
     new(slist);
     slist^.s := temps;
     slist^.next:=nil;
     slist^.prev:=list;
     list^.next:=slist;
     list:=slist;
    end;
  end;
    close(file1);
end;
 
procedure ydalenie(var list1,list2:PList); var lista:PList;
begin
  while list1<>nil do begin
    list2:=list1^.next;
   while list2<>nil do begin
    if(list1^.s=list2^.s) then begin
    lista:=list2^.next;
    if list2^.prev <> nil then
    list2^.prev^.next:=list2^.next
    else
    list2^.prev:=nil;
    if list2^.next <> nil then
    list2^.next^.prev:=list2^.prev
    else
    list2^.next:=nil;
    list2^.prev:=nil;
    list2:=lista;
    end
     else
     list2:=list2^.next;
   end;
     list1:=list1^.next;
  end;
end;
 
    procedure vivod(flist : plist); var lista : plist;
begin
    lista:=flist;
  while lista<>nil do begin
    writeln(lista^.s);
    lista:=lista^.next;
  end;
end;
 
var list, flist, slist:PList; list1, list2 : PList;
begin
  soxran_f;
  zagryz_f(flist, list, slist);
  list1:=flist;
  list2:=nil;
  ydalenie(list1, list2);
  vivod(flist);
  readln;
end.

Добавлено через 2 минуты
Mawrat, 1 прога(все возможные перестановки), 2 прога(поразрядная сортировка чисел), 3 прога(сортировка по конкретному разряду), 4 прога(удаление одинаковых слов из списка слов)

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

Добавлено через 46 минут
если не сложно!!!

Прочитать последовательность слов в список. Если количество слов четно, то тогда создать список из 2-го, 4-го и т.д. слов

Решение

Решение

@Roman0912 0 / 1 / 0 Регистрация: 27.01.2014 Сообщений: 15
		1
	Прочитать последовательность слов в список. Если количество слов четно, то тогда создать список из 2-го, 4-го и т.д. слов 27.01.2014, 21:56. Показов 2176. Ответов 17 Метки нет (Все метки) Вот условие задачи(В файл занести последовательность слов. Прочитать последовательность слов в список. Если количество слов четно, то тогда создать список из 2-го, 4-го и т.д. слов. Если же последовательность содержит нечетное количество слов, тогда создается список из 1-го, 3-го и т.д. слов. Обеспечить вывод на экран исходной последовательности слов и результатов обработки этой последовательности.) помогите написать прогу плиз, я по спискам почти ноль, набросайте хотя бы основы и как прочитать четные слова из файла в список? мне для зачета надо сделать эту прогу, заранее спс! 0

@Roman0912 0 / 1 / 0 Регистрация: 27.01.2014 Сообщений: 15
	28.01.2014, 11:32 [ТС]	3
	Сообщение от pHOMM Список то какой ? односвязный двусвязный, или может вообще потомок TList ? я не знаю какой именно нужен список, наверное, односвязный Добавлено через 2 минуты А без Form можете сделать тот фрагмент? Добавлено через 14 минут можешь пояснить условие пж, а то я что-то не очень понимаю, что именно там делается, на каком-нибудь примере пж! Добавлено через 2 минуты я просто не знаю, что делает odd первый раз это вижу(((( 0

@Roman0912 0 / 1 / 0 Регистрация: 27.01.2014 Сообщений: 15
	28.01.2014, 11:54 [ТС]	5
	Сообщение от pHOMM Если нужен односвязный, то этот код не подойдёт никак... А для какого списка подойдет этот код? Можете в краткости сказать, в чем именно различия односвязного от двусвязного списков? 0

@pHOMM 480 / 253 / 51 Регистрация: 30.06.2010 Сообщений: 651
	28.01.2014, 12:35	6
	Этот код для списка строк, просто списка на основе готового класса, включённого в библиотеку классов Дельфи. Односвязный и двусвязный списки это в некотором роде абстракция, реализуется через указатели, при этом каждый элемент списка содержит ссылку (указатель) на другой (обычно "следующий") элемент списка (или "пустой" указатель, nil). Если Вы проходите в ВУЗе тему про указатели, то списки скорее всего подразумеваются односвязные. Различия односвязного и двусвязного - у двусвязного есть не одна ссылка на другой элемент , а две (на следующий и на предыдущий). 1

@volvo Супер-модератор 32835 / 21172 / 8148 Регистрация: 22.10.2011 Сообщений: 36,431 Записей в блоге: 8
	28.01.2014, 18:47	8
	Сообщение от Roman0912 ошибку выдает на предпоследней строке Для того, чтобы использовать консольные read/write, в программе не хватает директивы {$APPTYPE CONSOLE} Кстати, перед End-ом надо бы добавить еще ReadLn, чтобы успеть увидеть ответ... P.S. Как это связано с чтением слов в список - не понимаю... 1

@volvo Супер-модератор 32835 / 21172 / 8148 Регистрация: 22.10.2011 Сообщений: 36,431 Записей в блоге: 8
	28.01.2014, 19:25	10
	Обнулил k перед циклом, запустил на своем файле. Правильно считает пробелы и переводы строк (хотя это не всегда показатель количества слов, что будет если между словами есть несколько пробелов подряд?)... 1

@Roman0912 0 / 1 / 0 Регистрация: 27.01.2014 Сообщений: 15
	29.01.2014, 14:32 [ТС]	13
	спасибо огромное!!! можешь переделать так, чтобы последовательность слов вводилась с клавиатуры, а затем записывалась в файл? 0

@Roman0912 0 / 1 / 0 Регистрация: 27.01.2014 Сообщений: 15
	30.01.2014, 00:07 [ТС]	15
	спс тебе большое, ты меня выручил!!! 0