Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.78/9: Рейтинг темы: голосов - 9, средняя оценка - 4.78
74 / 74 / 44
Регистрация: 12.02.2011
Сообщений: 380
1

Изменить текст, удалив из него все повторные вхождения слов.

01.03.2011, 20:13. Показов 1856. Ответов 1
Метки нет (Все метки)

Изменить текст, удалив из него все повторные вхождения слов.
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
01.03.2011, 20:13
Ответы с готовыми решениями:

Отредактировать текст файла, удалив повторные вхождения слов в предложение
Дан файл, содержащий текст на русском языке. В предложениях некоторые из слов записаны подряд...

Распечатать эту же последовательность слов, удалив из нее повторные вхождения слов
Проверка кода. Распечатать эту же последовательность слов, но удалив из нее повторные вхождения...

Выведите последовательность слов, удалив из нее повторные вхождения слов
Пусть дана последовательность, содержащая от 1 до 30 слов, в каждом из которых от 1 до 5 строчных...

Напечатать последовательность слов, не удалив из нее повторные вхождения слов
дана последовательность содержащая от 1 до 30 слов, в каждом из которых от 1 до 5 прорисных...

1
13077 / 5862 / 1706
Регистрация: 19.09.2009
Сообщений: 8,807
02.03.2011, 16:29 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
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
program Project1;
 
const
  //Максимальное количество слов в тексте.
  M = 20;
 
type
  //Сведения о слове.
  TWord = record
    //Само слово.
    sWord : String;
    //Количество обнаружений слова в тексте.
    Cnt : Integer;
  end;
 
  //Хранилище уникальных слов.
  TVault = record
    //Количество слов в хранилище. - Количество значимых элементов массива.
    Len : Integer;
    //Массив сведений о словах.
    Arr : array[1..M] of TWord;
  end;
 
//Преобразование букв строки в верхний регистр
//для кодовой страницы CP866 (DOS, OEM).
function UpperCase866(const aStr : String) : String;
var
  i, Len : Integer;
  Res : String;
begin
  Len := Length(aStr);
  SetLength(Res, Len);
  for i := 1 to Len do begin
    case aStr[i] of
      //а..п -> А..П.
      #$A0..#$AF: Res[i] := Char( Ord(aStr[i]) - $20 );
      //р..я -> Р..Я.
      #$E0..#$EF: Res[i] := Char( Ord(aStr[i]) - $50 );
      //ё -> Ё.
      #$F1: Res[i] := #$F0;
      //Все остальные буквы.
      else
        Res[i] := UpCase(aStr[i]);
    end;
  end;
 
  UpperCase866 := Res;
end;
 
//Добавляет слово в массив хранилища Vault. При этом, если добавляемое
//слово уже присутствует в массиве, тогда счётчик этого слова увеличивается
//на единицу. Если добавляемое слово пока не присутствует в массиве, тогда
//это слово записывается в массив и его счётчик устанавливается равным единице.
procedure AddToVault(var aVault : TVault; const aWord : String);
var
  i : Integer;
  b : Boolean;
begin
  //Просматриваем массив - проверяем,
  //есть ли уже в нём такое слово.
  b := False;
  for i := 1 to aVault.Len do begin
    //Если такое же слово найдено, то увеличиваем
    //его счётчик на единицу и выходим из цикла.
    if aVault.Arr[i].SWord = aWord then begin
      Inc( aVault.Arr[i].Cnt );
      b := True;
      Break;
    end;
  end;
  //Если в предыдущем цикле слово не найдено, то
  //добавляем слово в массив и устанавливаем счётчик этого
  //слова равным единице.
  if not b then begin
    //Так как мы добавляем в массив новое слово, то количество значимых
    //элементов массива становится на единицу больше.
    Inc(aVault.Len);
    //Записываем в массив данные нового элемента (слова).
    aVault.Arr[aVault.Len].SWord := aWord;
    aVault.Arr[aVault.Len].Cnt := 1;
  end;
end;
 
//Проверяет - есть ли в хранилище заданное слово.
//Возвращаемое значение:
//0 - слова нет.
//1.. - индекс найденного слова.
function InVault(const aVault : TVault; aWord : String) : Integer;
var
  i, Res : Integer;
begin
  Res := 0;
  for i := 1 to aVault.Len do begin
    if aWord = aVault.Arr[i].SWord then begin
      Res := i;
      Break;
    end;
  end;
  InVault := Res;
end;
 
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  S, sWord : String;
  i, j, Pos1, Len, LenW : Integer;
  Vault : TVault;
begin
  repeat
    Writeln('Введите текст:');
    Readln(S);
 
    Vault.Len := 0;
 
    //Извлекаем слова и добавляем их в хранилище Vault.
    Len := Length(S);
    Pos1 := 0;
    for i := 1 to Len do begin
      //Пропускаем разделители.
      if S[i] in D then Continue;
      //Отслеживаем начало слова.
      if (i = 1) or (S[i - 1] in D) then Pos1 := i;
      //Отслеживаем конец слова.
      if (i = Len) or (S[i + 1] in D) then begin
        //Добавляем слово в массив.
        LenW := i - Pos1 + 1;
        //Если требуется независимость от регистра букв.
        //sWord := UpperCase866( Copy(S, Pos1, LenW) );
        sWord := Copy(S, Pos1, LenW);
        AddToVault(Vault, sWord);
      end;
    end;
 
    //Переформировываем массив Vault так, чтобы в нём остались
    //только те слова, которые в тексте присутствуют два и более раз.
    j := 0;
    for i := 1 to Vault.Len do begin
      if Vault.Arr[i].Cnt > 1 then begin
        Inc(j);
        Vault.Arr[j] := Vault.Arr[i];
      end;
    end;
    Vault.Len := j;
 
    if Vault.Len = 0 then begin
      Writeln('В тексте нет слов, которые присутствуют более одного раза.');
    end else begin
      Writeln('Перечень слов, которые присутствуют более одного раза:');
      for i := 1 to Vault.Len do begin
        if i > 1 then Write(', ');
        Write(Vault.Arr[i].sWord);
      end;
      Writeln;
    end;
 
    //Удаляем из текста повторные вхождения слов.
    Len := Length(S);
    Pos1 := 0;
    for i := Len downto 1 do begin
      //Пропускаем разделители.
      if S[i] in D then Continue;
      //Отслеживаем конец слова.
      if (i = Len) or (S[i + 1] in D) then Pos1 := i;
      //Отслеживаем начало слова.
      if (i = 1) or (S[i - 1] in D) then begin
        //Удаляем искомые слова.
        LenW := Pos1 - i + 1;
        //Если требуется независимость от регистра букв.
        //sWord := UpperCase866( Copy(S, i, LenW) );
        sWord := Copy(S, i, LenW);
        j := InVault(Vault, sWord);
        if (j > 0) and (Vault.Arr[j].Cnt > 1) then begin
          Delete(S, i, LenW);
          Dec(Vault.Arr[j].Cnt);
        end;
      end;
    end;
 
    Writeln('Строка после обработки:');
    Writeln(S);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
02.03.2011, 16:29

Напечатайте заданный текст из 60 литер, удалив из него повторные вхождения каждой литеры
Напечатайте заданный текст из 60 литер, удалив из него повторные вхождения каждой литеры. На...

Напечатать заданный текст из 100 литер удалив из него повторные вхождения каждой литеры
требования к выполнению: – Проект должен быть многофайловым (т.е. использовать подключение...

Напечатайте заданный текст из 100 литер, удалив из него повторные вхождения каждой литеры
Мы ведь &quot;ОДНА БОЛЬШАЯ СЕМЬЯ&quot;, помогите сделать:)!!! Напечатайте заданный текст из 100 литер,...

Как напечатать заданный текст из 100 литер, удалив из него повторные вхождения каждой литеры
Программа. Напечатать заданный текст из 100 литер, удалив из него повторные вхождения каждой литеры.


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru