Помогите пожалуйста составить программу ** Паскале(подробно). Дан текст. Выведите в...

0 голосов
54 просмотров

Помогите пожалуйста составить программу на Паскале(подробно). Дан текст. Выведите в алфавитном порядке все буквы текста, входящие в него: - не более двух раз


Информатика (44 баллов) | 54 просмотров
0

Частотный словарик за 5 баллов? Ну-ну...

Дано ответов: 2
0 голосов
Правильный ответ

Что же, можно и покороче решить, но поймете ли решение?

// PascalABC.NET 3.1, сборка 1230 от 27.04.2016
begin
  var s:=ReadlnString('Введите строку:').ToUpper.
    Where(c->c in ['A'..'Z','А'..'Я','Ё']);
  var d:=new dictionary;
  foreach var c in s do d[c]:=d.Get(c)+1;
  d.Where(k->k.Value<=2).OrderBy(k->k.key).
    Select(k->k.key).Println(',');
end.

Тестовое решение
Введите строку: А роза упала на лапу Азора. Карл у Клары украл кораллы.
З,Н,П,Ы

(142k баллов)
0

в том то и дело что не поняла, смешано все

0

Если только что где и смешано - то в Ваших мыслях.

0

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

0 голосов

//Pascal ABC.NET v3.1 сборка 1219

Const chb:set of char=['а'..'я','a'..'z']; //множество букв

Var
 ar,s,st:string;
 i,j,n:integer;
 c:char;
begin
 readln(s); //читаем текст
 n:=0; //обнуляем счётчик
 for i:=1 to length(s) do {всё в нижнем регистре, чтобы не считать заглавную и строчную буквы разными}
 s[i]:=lowcase(s[i]);
 for i:=1 to length(s) do //снова пройдёмся по каждой букве
  begin
   st:=s; {передаём переменной текст, тем самым не трогая "оригинал"}
    while pos(s[i],st)<>0 do //пока в копии есть символ с заданным циклом for индексом
     begin
      delete(st,pos(s[i],st),1); {...удаляем этот символ(по одному за шаг вложенного цикла)}
      inc(n); //увеличиваем число удалённых
     end; {таким образом, данный цикл позволяет проверить количество вхождений символа в строку}
    if (n<=2) and (pos(s[i],ar)=0) and (s[i] in chb) then ar:=ar+s[i]; {если вхождений не больше 2 и символа нет в конечной строке(чтобы не было повторов) и символ есть в множестве букв(чтобы не было знаков препинания), то добаляем в конечную строку}<br>    n:=0; //обнуляем счётчик 
 end;
 for i:=1 to length(ar)-1 do {Здесь могла быть "быстрая сортировка", но люди не знающие ничего, кроме "пузырька" будут против}
  for j:=i+1 to length(ar) do
   if ar[i]>ar[j] then {сравниваем символы. Тип char является целочислительным, следовательно, нам можно}
    begin 
    c:=ar[i];
     ar[i]:=ar[j];
     ar[j]:=c;
    end;
 writeln('Result:'); //вывод конечной строки
 for i:=1 to length(ar) do
  write(ar[i],' ');
end.

Пример ввода:
Daaaaaaaaaaaaaads.
Пример вывода:
Result:
d s

(38.6k баллов)
0

а можно эту программу без объяснений написать все как есть?)) пожалуйста

0

Const
chb:set of char=['а'..'я','a'..'z'];

Var
ar,s,st:string;
i,j,n:integer;
c:char;
begin
readln(s);
n:=0;
for i:=1 to length(s) do
s[i]:=lowcase(s[i]);
for i:=1 to length(s) do
begin
st:=s;
while pos(s[i],st)<>0 do
begin
delete(st,pos(s[i],st),1);
inc(n);
end;
if (n<=2) and (pos(s[i],ar)=0) and (s[i] in chb) then ar:=ar+s[i]; <br> n:=0;
end;

0

for i:=1 to length(ar)-1 do
for j:=i+1 to length(ar) do
if ar[i]>ar[j] then
begin
c:=ar[i];
ar[i]:=ar[j];
ar[j]:=c;
end;
writeln('Result:');
for i:=1 to length(ar) do
write(ar[i],' ');
end.

0

ухх, какая длинная программа. Спасибо)