Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.57/7: Рейтинг темы: голосов - 7, средняя оценка - 4.57
4 / 4 / 4
Регистрация: 07.12.2015
Сообщений: 29
1

Найти все такие слова, в которых все буквы различны

30.03.2016, 14:28. Просмотров 1304. Ответов 7
Метки нет (Все метки)

В данном тексте найти все такие слова, в которых все буквы различны. Словом в строке будем считать последовательность символов русского алфавита; слова отделяются друг от друга пробелами или знаками препинания. Регистр букв, не различать, то есть слова "Слово" и "сЛоВо" считать одинаковыми.Текст-это строка символов.
Пример: Привет, этот теКст бЫл написан, для ПриМера.
Результат: Привет, был, для.

Добавлено через 17 часов 32 минуты
Помогите пожалуйста с заданием, Срочно!!!!
1
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
30.03.2016, 14:28
Ответы с готовыми решениями:

Найти из всех четырехзначных чисел, такие числа, в записи которых все цифры различны
Задание: Написать программу с использованием подпрограмм. В подпрограммах не должно присутствовать...

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

Вывести только те слова, все буквы которых различны
Помогите сделать надо чтобы вводились слова и выводились только те в которых все буквы разные

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

7
Puporev
30.03.2016, 14:42
  #2

Не по теме:

Цитата Сообщение от izh_love Посмотреть сообщение
Срочно!!!!
Я аж обмочился от страха...

0
CAPITAL OF ROCK!
1280 / 707 / 982
Регистрация: 03.03.2010
Сообщений: 2,286
30.03.2016, 22:42 3
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

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
96
97
98
99
100
101
102
103
104
105
106
107
{$MODE TP}
const
    separators: Set Of Char = [' ', '.', ',', '!', '?', ':', ';']; //остальные по желанию самостоятельно
type
    TArray = Array[Byte] Of String;
 
function RusLowerCase(s: String): String;
var
    i: Byte;
begin
    for i := 1 to Length(s) do
    begin
        if (Ord(s[i]) = 240)
        then
            s[i] := Chr(241);
        if (Ord(s[i]) in [128..143])
        then
            s[i] := Chr(Ord(s[i]) + 32);
        if (Ord(s[i]) in [144..159])
        then
            s[i] := Chr(Ord(s[i]) + 80);
    end;
    RusLowerCase := s;
end;
 
function ClipWord(var s: String): String;
var
    Result: String;
begin
    Result := '';
    while ((Length(s) > 0) And (s[1] in separators)) do
        Delete(s, 1, 1);
    while ((Length(s) > 0) And Not(s[1] in separators)) do
    begin
        Result := Result + s[1];
        Delete(s, 1, 1);
    end;
    ClipWord := RusLowerCase(Result);
end;
 
function IsDiff(const s: String): Boolean;
var
    Result: Boolean;
    i: Byte;
    st: Set Of Char;
begin
    Result := (Length(s) <> 0);
    if (Result)
    then
    begin
        i := 1; st := [];
        while ((i <= Length(s)) And Result) do
        begin
            Result := Not (s[i] in st);
            Include(st, s[i]);
            Inc(i);
        end;
    end;
    IsDiff := Result;
end;
 
function IsUniqWord(const s: String; const ar: TArray; const n: Byte): Boolean;
var
    Result: Boolean;
    i: Byte;
begin
    Result := (n = 0);
    if Not (Result)
    then
    begin
        for i := 0 to n - 1 do
        begin
            Result := (ar[i] <> s);
            if Not (Result)
            then
                break;
        end;
    end;
    IsUniqWord := Result;
end;
 
var
    s, si: String;
    uniq: TArray;
    i, n: Byte;
begin
    n := 0;
    ReadLn(s);
    s := s + ' ';
    while (Length(s) > 0) do
    begin
        si := ClipWord(s);
        if (IsDiff(si) And IsUniqWord(si, uniq, n))
        then
        begin
            uniq[n] := si;
            Inc(n);
        end;
    end;
    Write('Result: ');
    if (n = 0)
    then
        Write('No one!')
    else
        for i := 0 to n - 1 do
            Write(uniq[i], ' ');
end.
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5645 / 3367 / 2422
Регистрация: 22.11.2013
Сообщений: 9,481
31.03.2016, 21:11 4
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Перевод в нижний регистр можно существенно упростить:
Pascal
1
2
3
4
5
6
7
8
9
10
11
function LowerCase(s: String): String;
var i: Integer;
begin
  for i := 1 to Length(s) do
    case s[i] of
    'A'..'Z','А'..'П': Inc(s[i],32);
    'Р'..'Я': Inc(s[i],80);
    'Ё': Inc(s[i]);
    end;
  LowerCase := s;
end;
Добавлено через 6 минут
Проверку на уникальность тоже можно несколько сократить:
Pascal
1
2
3
4
5
6
7
function IsUniqWord(const s: String; const ar: TArray; const n: Integer): Boolean;
var i: Integer;
begin
  IsUniqWord:=False;
  for i:=0 to n-1 do if s=ar[i] then Exit;
  IsUniqWord:=True;
end;
Добавлено через 4 минуты
Вывод ответа через запятую, как в примере:
Pascal
1
2
3
4
  if n=0 then WriteLn('<искомых слов нет>')
  else begin
    Write(uniq[0]); for i:=1 to n-1 do Write(', ',uniq[i]); WriteLn;
  end;
0
4 / 4 / 4
Регистрация: 07.12.2015
Сообщений: 29
31.03.2016, 21:50  [ТС] 5
Цитата Сообщение от bormant Посмотреть сообщение
Перевод в нижний регистр можно существенно упростить:
Pascal
1
2
3
4
5
6
7
8
9
10
11
function LowerCase(s: String): String;
var i: Integer;
begin
  for i := 1 to Length(s) do
    case s[i] of
    'A'..'Z','А'..'П': Inc(s[i],32);
    'Р'..'Я': Inc(s[i],80);
    'Ё': Inc(s[i]);
    end;
  LowerCase := s;
end;
Если конечно я правильна вставил ваш код в программу, то на выходе я получаю иероглифы, если на вход подаю заглавные буквы, можно как-то исправить?
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5645 / 3367 / 2422
Регистрация: 22.11.2013
Сообщений: 9,481
31.03.2016, 22:21 6
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Какая кодировка текста используется вами в исходнике и при выполнении?
Для 866 можно отвязаться от кодировки исходника так:
Pascal
1
2
3
4
5
6
7
8
9
10
11
function LowerCase(s: String): String;
var i: Integer;
begin
  for i := 1 to Length(s) do
    case s[i] of
    'A'..'Z',#128..#143: Inc(s[i],32);
    #144..#159: Inc(s[i],80);
    #240: Inc(s[i]);
    end;
  LowerCase := s;
end;
0
Модератор
8257 / 4046 / 2823
Регистрация: 17.08.2012
Сообщений: 12,931
03.04.2016, 09:01 7
Эта тема находится в общей ветке паскаля. Чтобы функция не зависела от кодировки, по-моему, проще всего её "в лоб" написать:
Pascal
1
2
3
4
5
6
7
8
9
10
function LowerCase(s: String): String;
const b = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
      m = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
var i: Integer;
begin
  for i := 1 to Length(s) do
    if Pos(s[i], b) > 0
      then s[i] := m[Pos(s[i], b)];
  LowerCase := s
end;
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5645 / 3367 / 2422
Регистрация: 22.11.2013
Сообщений: 9,481
03.04.2016, 09:44 8
Для однобайтовых вариантов выбор-то обычно не особо и велик:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
function LowerCase(s: String): String;
var i: Integer;
begin
  for i := 1 to Length(s) do
    {$IFDEF ANSI} {cp1251}
    case s[i] of
    'A'..'Z',#$C0..#$DF: Inc(s[i],32);
    #$A8: Inc(s[i],16);
    end;
    {$ELSE} {cp866}
    case s[i] of
    'A'..'Z',#$80..#$8F: Inc(s[i],32);
    #$90..#$9F: Inc(s[i],80);
    #$F0: Inc(s[i]);
    end;
    {$ENDIF}
  LowerCase := s;
end;
Добавлено через 55 секунд
А пример с неправильной кодировкой исходника -- он прямо в этой теме под #5.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
03.04.2016, 09:44

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

Вывести все слова четной длины, у которых все буквы из первой половины слова встречаются во второй
Задача: Дана последовательность символов, состоящая из слов четной длины. Вывести на экран все...

Найти все четырехзначные числа, у которых все цифры различны
4)Найти все четырехзначные числа, у которых все цифры различны.

Найти все четырехзначные числа, у которых все цифры различны
Операторы цикла: найти все четырехзначные числа, у которых все цифры различны.

Найти все четырехзначные числа, у которых все цифры различны
Найти все четырехзначные числа, у которых все цифры различны.


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

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

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