Question

Нужно, , подскажите! (в паскале) дан текстовый файл f, каждая строка которого состоит из слов, разделённых одним и более пробелами. найти все слова, содержащие наименьшее, но ненулевое, количество гласных латинских букв (a, e, i, o, u). сформировать из этих слов новый файл g.

Answer 1

//Ночной отвратный код
//PascalABC.NET 3.2 сборка 1318

Var
  f,g:text;
  mins,i,currents,minsCount:integer;
  minsWords:array of string;
  buf1,buf2:char;
  wordFlag:boolean;
  s:string;
begin
mins:=integer.MaxValue;
assign(f,'input.txt');
reset(f);
read(f,buf1);
if not(EOF(f)) then
read(f,buf2);
if ((buf1=' ') or (buf1=chr(10)) or (buf1=chr(13))) and ((buf2=' ') or (buf2=chr(10)) or (buf2=chr(13))) then
 wordFlag:=false;
if (buf1<>' ') and ((buf2=' ') or (buf2=chr(10)) or (buf2=chr(13))) then
  begin
    s:=buf1;
    wordFlag:=false;
  end;
if (buf1<>' ') and (buf2<>' ') then
  begin
    s:=buf1+buf2;
    currents:=0;
    for i:=1 to length(s) do
      if (lowcase(s[i])='a') or (lowcase(s[i])='e') or (lowcase(s[i])='i') or (lowcase(s[i])='o') or (lowcase(s[i])='u') then
         inc(currents);
    wordflag:=true;
 end;
while not(EOF(f)) do
  begin
   if ((buf1=' ') or (buf1=chr(10)) or (buf1=chr(13))) and (buf2<>' ')
    then
      begin
        wordFlag:=true;
        currents:=0;
        s:=buf2;
      end
     else
      if ((buf1<>' ') and (buf2=' ')) or ((buf2=chr(10)) or (buf2=chr(13)))
        then
          begin
            wordFlag:=false;
            for i:=1 to length(s) do
              if (lowcase(s[i])='a') or (lowcase(s[i])='e') or (lowcase(s[i])='i') or (lowcase(s[i])='o') or (lowcase(s[i])='u') then
                inc(currents);
            if(currents=mins) then
              begin
                inc(minsCount);
                setlength(minsWords,minsCount);
                minsWords[minsCount-1]:=s;
              end;
            if(currents<mins) and (currents<>0) then
              begin
                minsCount:=1;
                setlength(minsWords,minsCount);
                minsWords[minsCount-1]:=s;
                mins:=currents;
              end;
          end
        else
          if wordFlag
             then
              s:=s+buf2;
   buf1:=buf2;
   read(f,buf2);
 end;
 if wordFlag
 then
 begin
 s+=buf2;
 for i:=1 to length(s) do
              if (lowcase(s[i])='a') or (lowcase(s[i])='e') or (lowcase(s[i])='i') or (lowcase(s[i])='o') or (lowcase(s[i])='u') then
                inc(currents);
              if(currents=mins) then
              begin
                inc(minsCount);
                setlength(minsWords,minsCount);
                minsWords[minsCount-1]:=s;
              end;
            if(currents<mins) and (currents<>0) then
              begin
                minsCount:=1;
                setlength(minsWords,minsCount);
                minsWords[minsCount-1]:=s;
                mins:=currents;
              end;
     end
 else
  if buf2<>' ' then
    begin
      if (lowcase(buf2)='a') or (lowcase(buf2)='e') or (lowcase(buf2)='i') or (lowcase(buf2)='o') or (lowcase(buf2)='u') then
        currents:=1;
     if(currents=mins) then
              begin
                inc(minsCount);
                setlength(minsWords,minsCount);
                minsWords[minsCount-1]:=buf2;
              end;
      if currents<mins then
              begin
                minsCount:=1;
                setlength(minsWords,minsCount);
                minsWords[minsCount-1]:=buf2;
                mins:=currents;
              end;
    end;
 close(f);
 assign(g,'output.txt');
 rewrite(g);
 for i:=0 to length(minsWords)-1 do
  write(g,minsWords[i],' ');
 close(g);
end.

Пример содержимого input.txt:
Lorem ipsum dolor sit amet consectetur adipiscing elit
etc Curabitur posuere erat et felis ultricies pulvinar u
Пример содержимого output.txt:
sit etc et u