Форум программистов, компьютерный форум, киберфорум
Наши страницы
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
#1

Исправить код программы - PascalABC.NET

18.01.2018, 16:41. Просмотров 256. Ответов 14
Метки нет (Все метки)

Из условия задачи:
п.1. - Напечатать все слова, отличные от последнего слова. Для каждой согласной буквы указать сколько раз она встречается в полученном предложении. Сообщение об одной и той же букве должно печататься не более одного раза.
п.2. - Напечатать все слова, отличные от последнего слова, удаляя те слова, которые целиком составлены из вхождений не более чем двух букв.

Все это в одной программе. В принципе, решение готово, но есть некоторые ошибки.
1) если после последнего слова добавить пробелы, то пробел определяется как последнее слово и программа работает некорректно. В принципе лучше бы удалять все лишние пробелы. Наверно из-за них тоже может работать некорректно.
2) Слова, состоящие из двух букв, должны удаляться. Например, MAMA тоже должно удаляться, но у меня удаляются только те, которые по сути просто из двух букв. Например, слово EEE не удалится, а надо, чтобы удалялось.

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
program IPR2;
 
function notglasn(c: char): boolean;
begin
  if (c in ['a', 'e', 'i', 'u', 'o', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', ' ']) then
    notglasn := false
  else
    notglasn := true;
end;
 
var
  s: string;
  last: string;
  j, i, n, k: integer;
  count: integer;
  c: char;
 
begin
  writeln('Введите текст: ');
  readln(s);
  k := length(s);
  while (k > 0) and (s[k] = ' ') do {Определение кол-ва слов на случай =0. Тогда выход из цикла}
    k := k - 1;
  if (k = 0) then
  begin
    writeln('В тексте нет слов');
    readln;
    halt;
  end;
  n := k;
  while (n > 0) and (s[n] <> ' ') do {Определение кол-ва слов на случай =1. Тогда выход из цикла}
    n := n - 1;
  if (n = 0) then
  begin
    writeln('В тексте только одно слово');
    readln;
    halt;
  end;
  {выполнение п.2 задания}
  i := 1; {начинаем с первого символа в строке}
  j := 0; {сначала длина слова равна нулю}
  while i <= k do 
  begin
    if s[i] <> ' ' then begin{если очередной символ не пробел}
      j := j + 1; {увеличиваем длину слова}
      i := i + 1; {переходим к следующей букве}
    end
    else begin{если очередной символ пробел}
      if j < 3 then begin{если длина слова < 2}
        delete(s, i - j, j + 1); {вырезаем вместе с пробелом после слова}
        k := length(s);
        i := i - j; {i в начало на длину вырезанной подстроки}
        j := 0; {обнуляем длину слова}
      end
      else begin{если длина слова > 2}
        i := i + 1; {переходим к следующей букве}
        j := 0; {обнуляем длину слова}
      end;
    end;
  end;
  
  if j > 0 then {если последнее слово > 0 букв}
    
    last := copy(s, i - j, j);
  writeln('Последнее слово: ', last);
  delete(s, i - j, j); {удаление последнего слова}
  writeln('Текст, кроме последнего слова и не более двух букв: ', s);
  
  writeln('Согласные буквы:'); {опрееление количества согласных букв}
  c := s[1];
  count := 0;
  if (notglasn(c)) then
  begin
    count := count + 1;
    for i := 2 to length(s) do
      if (s[i] = c) then
        count := count + 1;
    writeln(c, ': ', count);
  end;
  for i := 2 to length(s) do
  begin
    if (s[i] <> c) and (notglasn(s[i])) then
    begin
      count := 1;
      for j := i + 1 to length(s) do
        if (s[i] = s[j]) then
        begin
          count := count + 1;
          s[j] := c;
        end;
      writeln(s[i], ': ', count);
    end;
  end;
  readln; 
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.01.2018, 16:41
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Исправить код программы (PascalABC.NET):

Исправить код программы
Требуется вывести на экран среднее и сумму введенных данных (введённых с...

Прошу исправить код программы
Задание: Ввести с клавиатуры текст вида: ‘ 5 mod 3 = ‘ с произвольными целыми...

Немножко исправить код
пожалуйста сделайте рандомное число а целым. Добавлено через 31 секунду...

Крестики-нолики: исправить код
Процедура getcoordinates работает неправильно. Только для клеток 3,6,7,8,9...

Исправить код программы.
С помощью рекурсивной функции вычислить значение квадратного корня с заданой...

Входной и выходной файл. Исправить код программы
Имя входного файла: b.in Имя выходного файла: b.out Два сотрудника подали...

14
JuriiMW
1912 / 1020 / 1543
Регистрация: 10.12.2014
Сообщений: 3,773
19.01.2018, 06:52 #2
1)
Pascal
1
2
writeln('Введите текст: ');
  readln(s);
меняем на
Pascal
1
  var s := ReadLnString('Введите текст:');
2)
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
k := length(s);
  while (k > 0) and (s[k] = ' ') do {Определение кол-ва слов на случай =0. Тогда выход из цикла}
    k := k - 1;
  if (k = 0) then
  begin
    writeln('В тексте нет слов');
    readln;
    halt;
  end;
  n := k;
  while (n > 0) and (s[n] <> ' ') do {Определение кол-ва слов на случай =1. Тогда выход из цикла}
    n := n - 1;
  if (n = 0) then
  begin
    writeln('В тексте только одно слово');
    readln;
    halt;
  end;
меняем на
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
procedure Stop(msg : String);
begin
  WriteLn(msg);
  ReadLn;
  Halt;
end;
. . .
  var d := ' .,:;!?/'.ToCharArray;
  var words := s.ToWords(d);
  case words.Count of
    0 : Stop('В тексте нет слов.');
    1 : Stop('В тексте только одно слово.');
  end;
Вывод всех слов, отличных от последнего — теперь элементарное дело:
Pascal
1
2
3
4
5
6
  WriteLn('Последнее слово: ', words.Last);
  Write('Слова, отличные от последнего: ');
  foreach var word in words do
    if word.ToUpper <> words.Last.ToUpper then
      Print(word);
  WriteLn;
Согласные сколько раз:
Pascal
1
2
3
4
5
6
7
8
9
10
const sogl = 'БВГДЖЗЙКЛМНПРСТФХЦЧШЩ';
. . .
  var dict := New Dictionary<char,integer>;
  foreach var ch in s.ToUpper do
    if sogl.IndexOf(ch) > -1 then
      dict[ch] := dict.Get(ch) + 1;
  WriteLn('Согласные буквы и сколько раз встречаются:');
  foreach var v in dict do
    Print(String.Format('{0} - {1}  ', v.Key, v.Value));
  WriteLn;
Ну и вот что получается:
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
const sogl = 'БВГДЖЗЙКЛМНПРСТФХЦЧШЩ';
 
procedure Stop(msg : String);
begin
  WriteLn(msg);
  ReadLn;
  Halt;
end;
 
begin
  var s := ReadLnString('Введите текст:');
  var d := ' .,:;!?/'.ToCharArray;
  var words := s.ToWords(d);
  case words.Count of
    0 : Stop('В тексте нет слов.');
    1 : Stop('В тексте только одно слово.');
  end;
  WriteLn('Последнее слово: ', words.Last);
  Write('Слова, отличные от последнего: ');
  foreach var word in words do
    if word.ToUpper <> words.Last.ToUpper then
      Print(word);
  WriteLn;
  var dict := New Dictionary<char,integer>;
  foreach var ch in s.ToUpper do
    if sogl.IndexOf(ch) > -1 then
      dict[ch] := dict.Get(ch) + 1;
  WriteLn('Согласные буквы и сколько раз встречаются:');
  foreach var v in dict do
    Print(String.Format('{0} - {1}  ', v.Key, v.Value));
  WriteLn;
end.
По второму пункту можете сами доработать.
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 10:42  [ТС] #3
JuriiMW, Второй пункт - это и есть главная проблема. Уже получилось с пробелами лишними справиться, а вот слова, которые состоят из вхождений двух букв, не знаю как удалить
0
JuriiMW
1912 / 1020 / 1543
Регистрация: 10.12.2014
Сообщений: 3,773
19.01.2018, 10:50 #4
Pascal
32
33
  words := words.Where(word->word.Length<>2).toArray;
  Write('Слова кроме двухбуквенных: '); words.Println;
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 10:54  [ТС] #5
JuriiMW,
Цитата Сообщение от JuriiMW Посмотреть сообщение
words := words.Where(word->word.Length<>2).toArray;
* Write('Слова кроме двухбуквенных: '); words.Println;
что-то тут не работает
Слова кроме двухбуквенных: высульул ьмлкьмлдукьмлдук л лвлвлвлвлвл лсукльс
0
JuriiMW
1912 / 1020 / 1543
Регистрация: 10.12.2014
Сообщений: 3,773
19.01.2018, 11:10 #6
Где тут?
Всё нормально!
Среди выведенных слова нет двухбуквенных…

Добавлено через 1 минуту
Если нужно „больше двух букв“,
то исправьте условие на „>2“…

Добавлено через 26 секунд
Там же ясно написано: „Слова кроме двухбуквенных:“
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 11:21  [ТС] #7
JuriiMW, в том же тексте проверки программы выше есть слово "лвлвлвлвлвл" оно не должно выходить в итоговую строку, т.к. состоит из двух букв
0
JuriiMW
1912 / 1020 / 1543
Регистрация: 10.12.2014
Сообщений: 3,773
19.01.2018, 11:35 #8
Вот это, что ли, нужно:
Pascal
32
33
  words.Where(word->word.Distinct.Count<>2).PrintLn;
  words.Println;
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 11:39  [ТС] #9
JuriiMW, это работает в случае слова типа "лалалала". его удаляет. а слово "лллллллллл" оставляет
0
JuriiMW
1912 / 1020 / 1543
Регистрация: 10.12.2014
Сообщений: 3,773
19.01.2018, 11:41 #10
На условие посмотрите!
Так трудно самому поправить?
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 12:03  [ТС] #11
JuriiMW,
выдает в виде таком в самом конце
Pascal
1
2
ооаоаоаоаао оооооооо
лвалрвавмтое ооаоаоаоаао ыолоывокл оооооооо оывлмовлмо
скажите как из итоговой строки убрать эти самые ооаоаоаоаао и оооооооо?
0
JuriiMW
1912 / 1020 / 1543
Регистрация: 10.12.2014
Сообщений: 3,773
19.01.2018, 12:06 #12
Собрать её по новой: words.JoinIntoString…
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 12:29  [ТС] #13
JuriiMW, все равно не понимаю. у нас такого в учебном материале не было. у нас были операторы if then else, while do и т.п.
0
Cyborg Drone
Модератор
5252 / 3119 / 2433
Регистрация: 17.08.2012
Сообщений: 10,075
19.01.2018, 16:04 #14
Andrew_Helix, а Вам точно требуется решение на PascalABC.NET? Этот диалект паскаля радикально отличается от остальных диалектов паскаля.

Какая-то несостыковка получается: задаёте вопрос в PascalABC.NET, но утверждаете, что элементарных вещей из PascalABC.NET Вы не изучали, а изучали только операторы стандартного паскаля. Может быть, Вам требуется программа на простом PascalABC (без суффикса .NET)? Или на каком-либо другом диалекте паскаля?
0
Andrew_Helix
0 / 0 / 3
Регистрация: 12.01.2018
Сообщений: 17
19.01.2018, 16:26  [ТС] #15
Cyborg Drone, конкретно я компилирую в .NET, а по программе обучения у нас циклы, массивы и прочее.
0
19.01.2018, 16:26
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
19.01.2018, 16:26
Привет! Вот еще темы с решениями:

Произведение вектора на матрицу(исправить код программы)
Найти произведение вектора на матрицу. input(a1) ...

Найти строку матрицы в которой больше всего нулей(исправить код программы).
Найти строку матрицы в которой больше всего нулей. Вот, что у меня получилось:...

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

Как исправить код?
if w&gt;0 then F:= exp((2w)*1)+((-2w)*1) else F:=exp((w)*2)+((w)*3); После...


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

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

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