Добрый вечер! Не могу справиться с такой задачей: дан текстовой файл, содержащий названия городов
1) если он пуст, в файле вывода вывести слово nothing (с этим я справилась),
2) если названия городов начинаются на одну и ту же букву, то выводим города в файл в обратном порядке,
3) если города начинаются на разные буквы, то сортируем только по первой букве.
Помогите чайнику, пожалуйста!

Создаеш масив строк, проверяеш одинаковость первых букв строк, если да то выводиш в файл масив строк наоборот, если нет, сортируеш в процедуре по первой букве:

const
   n=100;
var 
   .....
   str: array[1..n] of string;
   F, F1: text;
   i, m: word;

function check(strs:array of string; nn: word): boolean; {проверка одинаковы ли все первые буквы}
   tr: boolean; k: word;
begin
   tr:=true;
   for k:=1 to nn-1 do
      if(strs[k][1]<strs[k-1][1]) then tr:=false;
   if tr then check:=true 
      else
   check:=false;          
end;

procedure sort_first(var strf: array of string; mm: word) {сортировка по первой букве}
   fl: boolean; temp: string; j: word;  
begin
   repeat
      fl:=true;    
      for j:=0 to mm-2 do 
         if(s[j][1]>s[j+1][1]) then begin
            temp:=s[j]; s[j]:=s[j+1]; s[j+1]:=temp;
         end;    
   until not fl;
end;

begin
   .....
   i:=1;
   while not(EoF(F)) do begin
      readln(F, str[i]);
      inc(i);
   end;
   m:=i;
   if check(str, i) then begin
      for i:=m downto 1 do
         writeln(F1, str[i]);
   end
      else
   sort_first(str, m);   
   .....
end.

Спасибо, буду пробовать!

Господи, не идет-стек переполняется!
Добрый человек (человеки,народ, люди) что исправить в программе??

только собралась написать про большие файлы

function check(const strs:array of string; nn: word): boolean;

попробуй...

но это тоже так... полумеры.

М

Для TS*: (цитата из правил) 7. Проверяйте программы перед тем, как разместить их на форуме!!!

Вот горе. Программа все рано висит на поцедуре сортировки.

    repeat
      fl:=true;    
      for j:=0 to mm-2 do 
         if(strf[j][1]>strf[j+1][1]) then begin
            temp:=strf[j]; strf[j]:=strf[j+1]; strf[j+1]:=temp;
         end;
   until not fl; // <----------- Тут всегда true ....

Что же делать? Я, признаюсь, плохо разбираюсь в булеановских функциях, да и в других тоже не очень. Как исправить программу? Заранее простите за настырность

    repeat
      fl:=false;   //<---------- устанавливаем фалг в 0
      for j:=0 to mm-2 do 
         if(strf[j][1]>strf[j+1][1]) then begin
            temp:=strf[j]; strf[j]:=strf[j+1]; strf[j+1]:=temp;
            fl := true; // <------------ если были перестановки, устанавливаем флаг в единицу
         end;
   until  not(fl); //<------------ а если не было, то флаг как был 0 так и остался и сорт. завршена

Исправляла-исправляла, но все-таки не получается с выводом ничего: не идет ни сортировка по первой букве с выводом в файл, не идет и вывод в файл в обратном порядке, если первая буква слова одинаковая. Пишет тоже самое в файл, и все тут

Здравтвуйте! Может быть, кто-нибудь из вас посмотрит еще раз на мое решение? Я боюсь, начинаю просто зацикливаться на этой программе

Зацикливалось потому, что строки читала оператором read, который не читает строку целиком. Чтоб узнать где зацикливается жми Ctrl+Break. Подсвеченная строка тебе покажет это место. А дальше пошагово выполняешь программу нажимая F8 и смотришь в Watch значения переменных.
Вот работающий код:

const
   n=10;
var
   str: array[1..n] of string;
   f1, f2: text;
   i, m: word;

Function sort(var strf: array of string; mm: word):string;
Var   fl: boolean; temp: string; j: word;
begin
   repeat
      fl:=false;
      for j:=0 to mm-2 do
         if(strf[j][1]>strf[j+1][1]) then begin  {сортируем по первой букве}
            temp:=strf[j]; strf[j]:=strf[j+1]; strf[j+1]:=temp;
            fl:=true;
         end
         else  {если совпадают первые символы, то сортируем наоборот}
              if (strf[j][1]=strf[j+1][1])and(strf[j]<strf[j+1]) then begin
                temp:=strf[j]; strf[j]:=strf[j+1]; strf[j+1]:=temp;
                fl:=true;
              end;
   until not (fl);
end;

begin
   Assign (f1, 'pasts.in');
   Assign (f2,'pasts.out');
   Reset (f1);
   Rewrite (f2);
   i:=1;
   while not(EoF(F1)) do begin
      readln(F1, str[i]);              {ведь строки читаем!}
      if length(str[i])>0 then inc(i); {пустые строки пропускаем}
   end;
   m:=i;

   sort(str, m);

   for i:=1 to m-1 do writeln (f2,str[i]); {если выводить то все}

   Close (f1);
   Close (f2);
end.

Огромное спасибо! Только мне требуется считывать города, записанные в строчку, а не в столбик. Поэтому было "read".

И сколько таких строчек? И каким символом города друг от друга отделяются?

Любое слово может начинаться с большой или малой буквы, длиной от 1 до 255 символов, между словами один или несколько пропусков

Прошу прощения, либо только с большой, либо только с малой буквы. Если слов в файле нет, то в выходном файле выходит слово "nothing". Входной файл до мегабайта объемом

Вот с этого и надо было начинать. Тут телепаты не водятся.
Тогда читать надо посимвольно с помощью read(с), где с :char; - один символ.
Столько в массив строк просто не влезет (ибо в DOS не более 640Килобайт оперативной памяти используется). Таким способом решать задачу нельзя!

Бог с ним, с этим мегабайтом! Мне бы сортировку по строкам добить, а то скоро экзамен и решать еще четыре таких же замудреных задачи

Тогда так:

const
   n=10;
var
   str: array[1..n] of string;
   f1, f2: text;
   i, m: word;
   c :char;

Function sort(var strf: array of string; mm: word):string;
Var   fl: boolean; temp: string; j: word;
begin
   repeat
      fl:=false;
      for j:=0 to mm-2 do
         if(strf[j][1]>strf[j+1][1]) then begin  {сортируем по первой букве}
            temp:=strf[j]; strf[j]:=strf[j+1]; strf[j+1]:=temp;
            fl:=true;
         end
         else  {если совпадают первые символы, то сортируем наоборот}
              if (strf[j][1]=strf[j+1][1])and(strf[j]<strf[j+1]) then begin
                temp:=strf[j]; strf[j]:=strf[j+1]; strf[j+1]:=temp;
                fl:=true;
              end;
   until not (fl);
end;

begin
   Assign (f1, 'pasts.in');
   Assign (f2,'pasts.out');
   Reset (f1);
   Rewrite (f2);
   i:=1;
   str[i]:=''; {в начале инициализируем пустой строкой}
   while not(EoF(F1)) do begin
      read(F1, c);              {читаем посимвольно!}
      if (c<>' ')and(c<>#10)and(c<>#13) then  str[i]:=str[i]+c
      else if length(str[i])>0 then begin {непустые строки нам нужны}
             inc(i);
             str[i]:=''; {инициализируем пустой строкой}
           end;
   end;
   m:=i;

   sort(str, m);

   for i:=1 to m-1 do write(f2,str[i],' '); {если выводить то все и через пробел}

   Close (f1);
   Close (f2);
end.

Спасибо громаднейшее!!! Буду дальше над оставшимеся голову ломать!