Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
deadsoulinrus
0 / 0 / 0
Регистрация: 15.05.2016
Сообщений: 12
#1

Во всех словах заменить первую букву на последнюю, а последнюю на первую. Как считывать каждое слово?

29.05.2016, 16:36. Просмотров 818. Ответов 6
Метки нет (Все метки)

Ребята, написал программу, выполняла свое предназначение, но меня преподаватель попросил записать в строку 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
Program Files;
Uses crt;
 
Procedure Input(Var S: string; Var f1: text);
Var i:shortint;
    n:integer;
    M:string;
begin
 Write('Enter the file name: ');
 Readln(M);
 Assign(f1, M);
 {$I-}
  Rewrite(f1);
 {$I+}
 if ioresult <> 0 then
  WriteLn('File not found')
 else
  begin
   WriteLn('Found file');
   Rewrite(f1);
 Write('Enter number the strings (0<Strings<=10): ');
 Readln(n);
 Repeat
  if (n>10) or (n<1) then
   begin
    write('Incorrect, retype please: ');
    readln(n);
   end;
 Until (n>=1) and (n<=10);
 for i:=1 to n do
  begin
   Write('Enter string #[',i,']: ');
   readln(s);
   writeln(f1,s);
  end;
 close(f1);
 writeln;
end;
end;
 
Procedure ReplaceLetters(Var s:string; Var f1,f2: text);
Var i:shortint;
    c:char;
begin
 Reset(f1);
 Assign(f2, 'file2.txt');
 Rewrite(f2);
 writeln('File1: ');
 while not eof(f1) do
  begin
   readln(f1,s);
   writeln(s);
   c:=s[1];
   s[1]:=s[Length(s)];
   s[Length(s)]:=c;
   writeln(f2,s);
  end;
 Close(f1);
 Close(f2);
end;
 
Procedure Output(Var S: string; Var f2: text);
begin
 Writeln;
 Writeln('File2: ');
 Reset(f2);
 While not eof(f2) do
 begin
  begin
   readln(f2,s);
   Writeln(s);
  end;
 end;
end;
 
Var File1,File2: text;
    Lines: string;
 
Begin
 clrscr;
 writeln('Program to replace the first and last letters in words to each other');
 Input(Lines,File1);
 ReplaceLetters(Lines,File1,File2);
 Output(Lines,File2);
 write('The program is completed, press any key to exit . . .');
 readkey;
End.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
29.05.2016, 16:36
Ответы с готовыми решениями:

В каждом слове строки заменить первую букву на последнюю
Всем доброго времени суток, подскажите пожалуйста, как в троке, в каждом слове...

Первую букву каждого слова заменить на последнюю букву последнего слова
Слова в строке отделены одним пробелом, в конце ставится точка. Первую букву...

В словах (например, "шабаш", "казак") первую и последнюю букву сделать большими
ХЕЕЕЛП

Поменять местами первую и последнюю букву каждого слова
Разработать программу, которая в заданной строке, представляющей собой...

В каждом слове заменить местами первую и последнюю буквы
Дана строка символов, слова разделены пробелами. В каждом слове заменить...

6
ФедосеевПавел
Модератор
3594 / 1980 / 823
Регистрация: 01.02.2015
Сообщений: 6,591
29.05.2016, 16:43 #2
В цикле while i<=length(M) пропускаешь разделители слов, как только M[i] буква - break
Теперь в i индекс начала слова. Запоминаем его в WordStart: integer
Цикл while i<=length(M) пропускаешь буквы, как только M[i] разделитель - break
Теперь в i индекс первого разделителя. Запоминаем в WordFinish:=i-1.

Меняешь символы по индексам WordStart и WordFinish.

И опять выполнять пропуск разделителей.
0
deadsoulinrus
0 / 0 / 0
Регистрация: 15.05.2016
Сообщений: 12
29.05.2016, 17:12  [ТС] #3
ФедосеевПавел, Был бы очень признателен, если бы вы кусок этого кода оформили, не могу воспринять так
Если не трудно конечно, тут вроде пару строк
0
bormant
Модератор
Эксперт Pascal/DelphiЭксперт NIX
3794 / 2480 / 2050
Регистрация: 22.11.2013
Сообщений: 6,900
29.05.2016, 17:44 #4
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

deadsoulinrus,
Обработка одной строки:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
const Letter=['0'..'9','A'..'Z','a'..'z','А'..'п','р'..'я','Ё','ё'];
var
  s: String;
  t: Char;
  i, j: Integer;
begin
  ReadLn(s); i:=1;
  while i<=Length(s) do begin
    while (i<=Length(s)) and not (s[i] in Letter) do Inc(i); j:=i;
    while (i<=Length(s)) and     (s[i] in Letter) do Inc(i);
    if i>j then begin
      t:=s[j]; s[j]:=s[i-1]; s[i-1]:=t;
    end;
  end;
  WriteLn(s);
end.
1
deadsoulinrus
0 / 0 / 0
Регистрация: 15.05.2016
Сообщений: 12
29.05.2016, 17:45  [ТС] #5
Огромное вам спасибо!)
0
bormant
Модератор
Эксперт Pascal/DelphiЭксперт NIX
3794 / 2480 / 2050
Регистрация: 22.11.2013
Сообщений: 6,900
29.05.2016, 18:06 #6
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

deadsoulinrus,
Другой вариант:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
const Letter=['0'..'9','A'..'Z','a'..'z','А'..'п','р'..'я','Ё','ё'];
var
  s: String;
  t: Char;
  i, j: Integer;
begin
  ReadLn(s); s:=s+' '; j:=Length(s);
  for i:=1 to Length(s) do
    if (s[i] in Letter) then 
      if ((i=1) or not (s[i-1] in Letter)) then j:=i else
    else
      if (i>j) and (s[i-1] in Letter) then begin
        t:=s[j]; s[j]:=s[i-1]; s[i-1]:=t;
      end;
  Delete(s,Length(s),1);
  WriteLn(s);
end.
или
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
const Letter=['0'..'9','A'..'Z','a'..'z','А'..'п','р'..'я','Ё','ё'];
var
  s: String;
  t: Char;
  i, j: Integer;
begin
  ReadLn(s); j:=Length(s);
  for i:=1 to Length(s) do
    if (s[i] in Letter) then 
      if ((i=1) or not (s[i-1] in Letter)) then j:=i else
    else
      if (i>j) and (s[i-1] in Letter) then begin
        t:=s[j]; s[j]:=s[i-1]; s[i-1]:=t;
      end;
  i:=Length(s);
  if s[i] in Letter then begin
    t:=s[j]; s[j]:=s[i]; s[i]:=t;
  end;
  WriteLn(s);
end.
Добавлено через 5 минут
Или
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
const Letter=['0'..'9','A'..'Z','a'..'z','А'..'п','р'..'я','Ё','ё'];
var
  s: String;
  t: Char;
  i, j: Integer;
begin
  ReadLn(s); j:=Length(s);
  for i:=1 to Length(s)+1 do
    if (i>Length(s)) or not (s[i] in Letter) then 
      if (i>j) and (s[i-1] in Letter) then begin
        t:=s[j]; s[j]:=s[i-1]; s[i-1]:=t;
      end else
    else
      if ((i=1) or not (s[i-1] in Letter)) then j:=i;
  WriteLn(s);
end.
1
ФедосеевПавел
Модератор
3594 / 1980 / 823
Регистрация: 01.02.2015
Сообщений: 6,591
29.05.2016, 18:10 #7
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

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
program ReverseFirstAndLastCharsInWord;
 
type
  TSetOfChar = set of char;
const
  Delimiters: TSetOfChar = [' ', ',', '.'];
 
  function GetNextWordIndexes(const s: string;
  var StartIndex, FinishIndex: integer): boolean;
  begin
    if (StartIndex < 1) then
    begin
      StartIndex  := Length(s) + 1;
      FinishIndex := Length(s) + 1;
      GetNextWordIndexes := False;
      exit;
    end;
    while StartIndex <= Length(s) do
      if not (s[StartIndex] in Delimiters) then
        break
      else
        Inc(StartIndex);
    if StartIndex > Length(s) then
    begin
      StartIndex  := Length(s) + 1;
      FinishIndex := Length(s) + 1;
      GetNextWordIndexes := False;
      exit;
    end;
    FinishIndex := StartIndex;
    while FinishIndex <= Length(s) do
      if (s[FinishIndex] in Delimiters) then
        break
      else
        Inc(FinishIndex);
    Dec(FinishIndex);
    GetNextWordIndexes := True;
  end;
 
var
  s: string;
  IndxStart, IndxFinish: integer;
  TempChar: char;
begin
  s := 'qwe ,rrr jfjf 123 -54 ';
  writeln(s);
  IndxStart := 1;
  while GetNextWordIndexes(s, IndxStart, IndxFinish) do
  begin
    TempChar  := s[IndxStart];
    s[IndxStart] := s[IndxFinish];
    s[IndxFinish] := TempChar;
    IndxStart := IndxFinish + 1;
  end;
  writeln(s);
end.
0
29.05.2016, 18:10
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
29.05.2016, 18:10

Перенести первую букву в конец слова, последнюю букву в начало слова
Дан текст, содержащий от 2 до 30 слов, в каждом из которых от 2 до 10 латинских...

Заменить первую строчную букву на заглавную в словах, имеющих выбранную длину
Заменить первую строчную букву на заглавную в словах, имеющих выбранную длину....

Напечатать все слова, отличные от последнего, поменяв первую и последнюю букву каждого слова
Дана последовательность, содержащая от 2 до 20 слов, в каждом из которых от 2...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru