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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 25.04.2013, 18:09   #1
kindloo
 
Регистрация: 13.03.2013
Сообщений: 4
По умолчанию Поиск слов с двумя заданными буквами

Дан файл, содержащий русский текст. Найти в тексте N<=2000 самых коротких слов, содержащих два раза заданную букву. Записать найденные слова в текстовый файл в порядке неубывания длины. Все найденные слова должны быть разными!
Код:
program Project2;



{$APPTYPE CONSOLE}
{$R+,Q+,I+}

uses
  SysUtils;
const a='а';
const Wmin =1000;
const ABC=['а'..'я', 'А'..'Я','ё','Ё'];

Function EqualWord(n:string; w: array of string; i:integer):boolean; 
var l:integer;
begin
  result:=true;
  for l:=1 to i do
    if ansilowercase(w[l])=ansilowercase(n) then result:=false;
end;

Function ShortestWord (w:string;z:array of string; k:integer):boolean;
var i:integer;
begin
  Result:=false;
  if z[1]='' then result:=true;
  for i:=k downto 1 do
    if length(z[i])>length(w) then begin
      Result:=true;
      exit;
    end;
end;

Procedure InsertWord(w:string;var z:array of string; var k:integer); 
var prev,d:string;
    i:integer;
begin
  prev:=w;
  for i:=k downto 1 do begin
    if length(z[i])<length(prev) then begin
      d:=z[i];
      z[i]:=prev;
      z[i+1]:=d;
    end;
  end;
end;

Function Letter(w:string;a:char):boolean; 
var  i,j   : integer;
begin
  j:=0;
  Result:=false;
  for i:=1 to length(w) do
    if w[i]=a then inc(j);
  If j=2 then result:=true;
end;

var
    i,j,k : integer;
    s:string;
    z: array [1..2000] of string;
    w: array [1..100] of string; 
begin

  rewrite (output, 'output.txt');
  reset (input, 'input.txt');
  while not seekeof do begin
    readln(s);
    s:=s+' ';
    i:=1;
    j:=0;
    while i<=length(s) do begin
      if s[i] in ABC then begin
        inc(j);
        w[j]:='';
        while s[i] in ABC do begin
          w[j]:=w[j]+s[i];
          inc(i);
        end;
        inc(i);
      end
      else inc (i);
    end;
    k:=Wmin;
    for i:=1 to j do begin
      if (Letter(w[i],a)) and (EqualWord(w[i],z,k)) and (ShortestWord(w[i],z,k)) then InsertWord(w[i],z,k);
    end;
 end;
 for i:=1 to Wmin do
   If z[i]<>'' then writeln (z[i],' ');
   
end.
Не могу понять, почему выводится только одно слово. Буду очень благодарен за исправленный вариант.

Последний раз редактировалось Stilet; 25.04.2013 в 21:12.
kindloo вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Паскаль. вычисления расстояния между двумя точками, заданными на плоскости их координатами Saka Помощь студентам 10 05.11.2016 18:49
Записать в файл слова из текста, считанного из первого файла, которые начинаются и заканчиваются заданными буквами (Паскаль) makgs123 Помощь студентам 0 11.12.2012 17:07
Строки, длина слов, работа с заданными буквами microlab Паскаль, Turbo Pascal, PascalABC.NET 1 14.02.2012 20:46
алгоритм нахождения наилучшего маршрута между двумя заданными городами Uli9 Общие вопросы Delphi 28 18.11.2008 16:59
алгоритм нахождения наилучшего(кратчайшего) маршрута между двумя заданными городами Uli9 Помощь студентам 4 14.11.2008 15:03