Написать программу со списками и текстовыми файлами

@denfox_pro · Регистрация: 30.10.2012

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

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

Добавлено через 3 часа 26 минут

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

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

Проблемы:
1)количество слов заранее неизвестно (статический массив);
2)количество слов определяется только в конце работы (динамический массив).
Решение – список.
Алгоритм:
1)создать список;
2)если слова в файле закончились, то стоп.
3)прочитать слово и искать его в списке;
4)если слово найдено – увеличить счетчик повторений,
иначе добавить слово в список;
5)перейти к шагу 2.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
program Node_Text_lr3;
 
uses crt;
Type IVuzol=^Vuzol; {указатель на узел}
     Vuzol=record  {структура узла}
       slovo:string[40];  {слово}
       lich:integer; {счетчик повторений}
       nast:IVuzol;  {посилання на наступний}
     end;
Const chars=[' ', '.',',','!','?',':',';',#10,#13];
var gol,p,Vuz:IVuzol; txt,newtxt:text; sl,sl1:string; i:integer;
 
function StvorVuzol(NoveSl:string):IVuzol;   {создание списка}
var NovVuz,result:IVuzol;
begin
   New(NovVuz);
   NovVuz^.slovo:=NoveSl;
   NovVuz^.lich:=1;
   NovVuz^.nast:=nil;
   result:=NovVuz;
end;
procedure DobVPoch(var gol:IVuzol; NovVuz:IVuzol);{ Добавление узла в начало списка}
begin
   NovVuz^.nast:=gol;
   gol:=NovVuz;
end;
 
procedure DobPisl(p,NovVuz:IVuzol); {Добавление узла в конец списка}
begin
   NovVuz^.nast:=p^.nast;
   p^.nast:=NovVuz;
end;
 
procedure DobZ(var gol:IVuzol; p,NovVuz:IVuzol); {Добавление узла перед заданным}
var q:IVuzol;
begin
   q:=gol;
   if p=gol then DobVPoch(gol,NovVuz)
   else begin
    while(q<>nil) and (q^.nast<>p) do q:=q^.nast;
    if q>nil then DobPisl(q,NovVuz);
   end;
end;
 
function Kil:string;{подсчет количества повторений}
var NovVuz:IVuzol;ch:char;
begin
   read(txt,NovVuz^.slovo);
   if (ch in chars) or eof(txt) then
    Kil:=''
   else Kil:=ch+Kil;
end;
 
BEGIN
   clrscr;
   gol:=nil; {адресс начала списка}
 
   assign(txt,'D:\text1.txt');
   assign(newtxt,'D:\newtext.txt');
   reset(txt);
   rewrite(newtxt);
 
 
   repeat
      if Kil<>'' then inc(Vuz^.lich);
   until eof(txt);
 
   while not eof(txt) do begin
    read(txt,Vuz^.slovo);
    while pos(' ',Vuz^.slovo)>0 do begin
      sl:=copy(Vuz^.slovo,1,pos(' ',Vuz^.slovo));
      for i:=length(Vuz^.slovo) downto 1 do sl1:=sl1+sl1[i];
      inc(Vuz^.lich);
      if Vuz^.slovo<>#32 then write(newtxt,Vuz^.slovo)
      else writeln(txt,Vuz^.slovo);
    end;
   end;
   close(txt);
   close(newtxt);
   writeln(Vuz^.lich);
   readln;
END.

Исправьте и до делайте плиз, дальше не знаю как...

@Jener · 27.09.2013, 13:43

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
program alf1;
uses
  crt;
type
  TSlovo = string[40];
  PNode = ^Node;
  Node  = record           //элемент списка
  Slovo  : TSlovo;       //слово
  Povtor : word;       //количество повторений
  Next   : PNode;      //ссылкa следующий элемент списка
  end;
//процедура добавляет слово в список  
procedure AddQue(var First, Last : PNode; Slovo : TSlovo);
var PElem : PNode;
begin
  if Slovo = '' then exit;
  New(PElem);
  PElem^.Slovo  := Slovo;
  PElem^.Povtor := 1;
  PElem^.Next   := nil;
  if First = nil then
   begin
    First := PElem;
    Last  := First;
   end
  else
   begin
    Last^.Next := PElem;
    Last       := PElem;
   end;
end;  
//Сортировка из фака
procedure SortBublLink(nach:PNode);
var
  tmp,pered,pered1,pocle,rab:PNode; {все рабочие ссылки}
begin
  rab:=nach; {становимся на вершину стека}
  while rab<>nil do{пока не конец стека делать}
  begin
    tmp:=rab^.next; {переходим к следующему за сортируемым элементу}
    while tmp<>nil do {пока не конец стека делать}
    begin
      if tmp^.Slovo<rab^.Slovo then {если следует произвести замену, то}
      begin
        pered:=nach; {становимся в вершину стека}
        pered1:=nach; {становимся в вершину стека}
        if rab<>nach then {если мы не стоим на изменяемом элементе, то}
          while pered^.next<>rab do pered:=pered^.next; {станем на элементе перед изменяемым}
        while pered1^.next<>tmp do pered1:=pered1^.next; {станем на элементе перед изменяемым, который находится за
        первым изменяемым}
        pocle:=tmp^.next; {запоминаем адрес элемента после второго изменяемого}
        if rab^.next=tmp then {если элементы "соседи", то}
        begin
          tmp^.next:=rab; {меняем ссылки, тут если не понятно рисуйте на листочке}
          rab^.next:=pocle
        end
        else {в случае если элементы не соседи, то}
        begin
          tmp^.next:=rab^.next;{меняем ссылки, тут если не понятно рисуйте на листочке}
          rab^.next:=pocle;
        end;
        if pered1<>rab then{советую просмотреть на листочке}
          pered1^.next:=rab;
        if rab<>nach then{советую просмотреть на листочке}
          pered^.next:=tmp
        else{всё советую просмотреть на листочке}
          nach:=tmp;
        pered1:=tmp;{советую просмотреть на листочке}
        tmp:=rab;{советую просмотреть на листочке}
        rab:=pered1;{советую просмотреть на листочке}
      end;
      tmp:=tmp^.next; {переходим на следующий элемент}
    end;
    rab:=rab^.next;{переходим на следующий элемент}
  end;
end;
//Процедура удаления элемента списка - тоже с фака
Procedure DelElem(var stek1:PNode;tmp:PNode);
var
  tmpi:PNode;
begin
  if (stek1=nil) or (tmp=nil) then {если стек пуст или указатель никуда не указывает, то выходим}
    exit;
  if tmp=stek1 then {если мы удаляем элемент который является вершиной стека, то}
  begin
    stek1:=tmp^.next;{следует перенести вершину и}
    FreeMem(tmp,SizeOf(PNode)); {высвободить память из под элемента}
  end
  else {в случае, если удаляемый элемент не вершина стека, то}
  begin
    tmpi:=stek1; {ставим указатель на вершину стека}
    while tmpi^.next<>tmp do {доходим до элемента стоящего "перед" тем, который нам следует удалить}
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next; {указатель элемента переносим на следующий элемент за удаляемым}
    FreeMem(tmp,sizeof(PNode)); {удаляем элемент}
  end;
end; 
var
  znaki_prep : set of char = ['.',',','!','?','(',')',':',';','-']; //знаки препинания
  t, new_t : text;
  s        : string;
  slovo    : TSlovo;
  First, Last, PElem : PNode;
begin 
  clrscr;
  write('Имя файла : '); readln(s);
  assign(t,s);
  {$i-} 
  reset(t);
  {$I+}  
  If IOResult <> 0 then begin
    writeln('Файл не найден.');
    exit;
  end;
  First := nil; Last := nil;  //инициация списка
  while not eof(t) do begin
   readln(t,s);   
   while pos(' ',s)<>0 do begin  //пока в строке есть пробелы
    slovo := copy(s,1,pos(' ',s)-1);  //первое слово в строке
    while (slovo[length(slovo)] in znaki_prep) and (slovo <> '') do //удаляем знаки препинания 
     slovo := copy(slovo,1,length(slovo)-1);                        //вконце слова
    while (slovo[1] in znaki_prep) and (slovo <> '') do             //тоже в начале слова
     slovo := copy(slovo,2,length(slovo));
    AddQue(First, Last, slovo);                                //записываем слово в список
    s := copy(s,pos(' ',s)+1,length(s)-length(slovo)-1);       //удаляем слово из строки
   end;
   while (s[length(s)] in znaki_prep) and (s<>'') do  //удаляем знаки 
     s := copy(s,1,length(s)-1);                      //препинания
   while (s[1] in znaki_prep) and (s<>'') do          //в начале и
     s := copy(s,2,length(s));                        //конце строки
   AddQue(First, Last, s);                      //записываем строку в список
  end;
  assign(new_t,'TextFile.txt');
  rewrite(new_t);
  SortBublLink(First);          //сортируем список
  PElem := First;
  while PElem^.Next<>nil do begin
    if PElem^.Slovo=PElem^.Next^.Slovo then begin                //поля Slovo 2-х рядом стоящих элем равны 
    PElem^.Next^.Povtor := PElem^.Next^.Povtor + PElem^.Povtor;  //увеличиваем знач поля Povtor 2-го элемента 
    DelElem(First,PElem);                                        //удаляем 1-ый элемент
    end;
    PElem := PElem^.Next;
  end;
  PElem := First;
  while PElem<>nil do begin   //выводим получившийся список в файл
    writeln(new_t,PElem^.Slovo:40,PElem^.Povtor:7);
    PElem := PElem^.Next;
  end;
  close(t);
  close(new_t);
  writeln('Файл TextFile.txt создан.');
  readln;  
end.

Новые блоги и статьи Все статьи Все блоги /
Шаблоны и приёмы реализации DDD на C# stackOverflow 12.05.2025 Когда я впервые погрузился в мир Domain-Driven Design, мне показалось, что это очередная модная методология, которая скоро канет в лету. Однако годы практики убедили меня в обратном. DDD — не просто. . .	Исследование рантаймов контейнеров Docker, containerd и rkt Mr. Docker 11.05.2025 Когда мы говорим о контейнерных рантаймах, мы обсуждаем программные компоненты, отвечающие за исполнение контейнеризованных приложений. Это тот слой, который берет образ контейнера и превращает его в. . .	Micronaut и GraalVM - будущее микросервисов на Java? Javaican 11.05.2025 Облачные вычисления безжалостно обнажили ахиллесову пяту Java — прожорливость к ресурсам и медлительный старт приложений. Традиционные фреймворки, годами радовавшие корпоративных разработчиков своей. . .	Инфраструктура как код на C# stackOverflow 11.05.2025 IaC — это управление и развертывание инфраструктуры через машиночитаемые файлы определений, а не через физическую настройку оборудования или интерактивные инструменты. Представьте: все ваши серверы,. . .	Инъекция зависимостей в ASP.NET Core - Практический подход UnmanagedCoder 11.05.2025 Инъекция зависимостей (Dependency Injection, DI) — это техника программирования, которая кардинально меняет подход к управлению зависимостями в приложениях. Представьте модульный дом, где каждая. . .
Битва за скорость: может ли Java догнать Rust и C++? Javaican 11.05.2025 Java, с её мантрой "напиши один раз, запускай где угодно", десятилетиями остаётся в тени своих "быстрых" собратьев, когда речь заходит о сырой вычислительной мощи. Rust и C++ традиционно занимают. . .	Упрощение разработки облачной инфраструктуры с Golang golander 11.05.2025 Причины популярности Go в облачной инфраструктуре просты и одновременно глубоки. Прежде всего — поразительная конкурентность, реализованная через горутины, которые дешевле традиционных потоков в. . .	Создание конвейеров данных ETL с помощью Pandas AI_Generated 10.05.2025 Помню свой первый опыт работы с большим датасетом — это была катастрофа из неотформатированных CSV-файлов, странных значений NULL и дубликатов, от которых ехала крыша. Тогда я потратил три дня на. . .	C++ и OpenCV - Гайд по продвинутому компьютерному зрению bytestream 10.05.2025 Компьютерное зрение — одна из тех технологий, которые буквально меняют мир на наших глазах. Если оглянуться на несколько лет назад, то сложно представить, что алгоритмы смогут не просто распознавать. . .	Создаем Web API с Flask и SQLAlchemy py-thonny 10.05.2025 В веб-разработке Flask и SQLAlchemy — настоящие рок-звезды бэкенда, особенно когда речь заходит о создании масштабируемых API. Эта комбинация инструментов прочно закрепилась в арсенале разработчиков. . .

Опции темы