Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
Другие темы раздела
Pascal В прямоугольном массиве с помощью процедуры убрать все строки, у которых оба конца – с четными значениями https://www.cyberforum.ru/ pascal/ thread1698249.html
Программа В прямоугольном массиве с по-мощью процедуры убрать все строки, у которых оба конца – с четными значениями. Исходные данные из файла читать, начиная с 44 числа. Процедуры (Функции) 1)...
Pascal Вывести 3 случайных числа от 0 до 100 без повторений
Вывести 3 случайных числа от 0 до 100 без повторений.
Pascal Найти минимум функции одной переменной
Пожалуйста, помогите с заданием! Очень нужно! Найти минимум функции одной переменной двумя методами: одним из методов нулевого порядка и одним из методов первого или второго порядка, проверив...
Pascal Определить принадлежность точки области Помогите составить условие принадлежности точки области https://www.cyberforum.ru/ pascal/ thread1698055.html
Pascal Разработка алгоритмов поиска https://www.cyberforum.ru/ pascal/ thread1697678.html
программно реализовать линейный поиск. Ввод массива, вывод массива и поиск оформить в виде подпрограмм. Подсчитать количество сравнений и операций присваивания при выполнении поиска.
Создать программу используя модуль DOS Pascal
Создать программу на языке Pascal используя не менее 5 процедур и ф-ций модуля DOS.
Составить любую программу с использованием не менее 5 процедур и функций модуля DOS Pascal
Составить программу на языке Pascal с использованием не менее 5 процедур и функций модуля DOS
Pascal Выведите количество способов изменить ровно один коэффициент многочлена недавно закончился турнир на codeforces, там была следующая задачка: D. Медвежонок и многочлены ограничение по времени на тест2 секунды ограничение по памяти на тест256 мегабайт... https://www.cyberforum.ru/ pascal/ thread1697429.html
Pascal Почему Pascal ABC не читает файлы (программы паскаля ) IDE глючит? Есть альтернатива? https://www.cyberforum.ru/ pascal/ thread1697237.html
ну например: var f : text; s : string; begin assign(f, 'start'); reset(f); while eof(f) do begin readln(f, s);
Pascal Readkey клавиши "вправо" Что бы программа могла проверить что нажата клавиша "up" Для "вверх", "влево" и "вниз" - я нашёл знаки, а вот для "вправо"! вот если что: uses crt; var key : char; begin https://www.cyberforum.ru/ pascal/ thread1697041.html
CAPITAL OF ROCK!
1280 / 707 / 982
Регистрация: 03.03.2010
Сообщений: 2,286
30.03.2016, 22:42 0

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

30.03.2016, 22:42. Просмотров 1315. Ответов 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
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
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
30.03.2016, 22:42

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

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

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

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

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

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