Мы с вами знаем, что санкт-петербург менял свое название несколько раз. составить программу(pascal abc), которая на введенную дату выдает название города. если: с 1703 – 1914 г. – санкт петербург, с 1914 – 1924 г. петроград, с 1924 – 1991 г. ленинград, с 1991г. – санкт петербург. заранее )

👇

Ответ:

karmazinakata67890

23.12.2021

Var a:integer;
Begin
Write('Введите год: '); readln(a);
if (a>=1703) and (a<1914) then writeln('Санкт Петербург');
if (a>=1914) and (a<1924) then writeln('Петроград');
if (a>=1924) and (a<1991) then writeln('Ленинград');
if (a>=1991) then writeln('Санкт Петербург');

End.

4,8(99 оценок)

Открыть все ответы

Ответ:

kjhf2225

23.12.2021

"Типовой школьный" Паскаль:

// PascalABC.Net 3.0, сборка 1064
const
k = 100;

var
s, wd: string;
i, j, m, n, pt, step: integer;
Words, WordsSort: array[1..k] of string;
InOrder: boolean;

begin
Write('Введите строку: '); Readln(s);
n := Length(s); pt := 1; m := 0;
repeat
    // Пропускаем все символы до первого непробельного
    while pt <= n do
      if Ord(s[pt]) <= 32 then Inc(pt) else break;
    if pt <= n then begin
      // Выделяем очередное слово
      wd := '';
      while pt <= n do
        if Ord(s[pt]) > 32 then begin wd := wd + s[pt];Inc(pt) end
        else break;
      if wd <> '' then begin Inc(m);Words[m] := wd end
    end
until pt > n;
// Теперь Words содержит все m слов.
// Отсортируем их в массиве WordsSort методом Шелла
for i := 1 to m do WordsSort[i] := Words[i];
step := m div 2;
while step > 0 do begin
    for j := m - step downto 1 do begin
      i := j;
      while i <= m - step do begin
        if WordsSort[i] > WordsSort[i + step] then begin
          wd := WordsSort[i];
          WordsSort[i] := WordsSort[i + 1];
          WordsSort[i + 1] := wd
        end;
        i := i + step
      end
    end;
    step := step div 2
end;
// Осталось поэлементно сравнить оба массива
InOrder := true; i := 1;
while InOrder and (i <= m) do
begin InOrder := (Words[i] = WordsSort[i]); Inc(i) end;
if m = 0 then Writeln('Строка не содержит слов')
else
    if InOrder then Writeln('Cлова упорядочены')
    else Writeln('Cлова не упорядочены')
end.

Тестовое решение:
Введите строку: слово1    слово2    слово3    слово4 слово5
Cлова упорядочены

Введите строку: слово1    слово2    слово4    слово3 слово5
Cлова не упорядочены

"Современный" вариант решения на Паскале:

// PascalABC.Net 3.0, сборка 1064
var
s:string;
begin
Write('Введите строку: '); Readln(s);
var Delim:=Range(0,32).Select(x->Chr(x)).ToArray;
var Words:=s.Split(Delim).Where(x->x<>'');
var WordsSort:=Words.Sorted;
if Words.SequenceEqual(WordsSort) then Writeln('Cлова упорядочены')
else Writeln('Cлова не упорядочены')
end.

Тестовое решение совпадает с вышеприведенным.

4,6(59 оценок)

Ответ:

sgjisgop

23.12.2021

1. Pascal ABC

const
nn=100;
var
M,C:array[1..nn] of integer;
x,i,n,s,max:integer;
m1,r:real;
begin
Write('x=');
Read(x);
Write('>');
s:=0;
n:=0;
for i:=1 to x do begin
    Read(M[i]);
    if M[i]>3 then begin
      s:=s+M[i];
      n:=n+1
    end
end;
if n>0 then m1:=s/n
else m1:=0;
max:=M[x];
for i:=x-1 downto x-9 do
    if M[i]>max then max:=M[i];
r:=max/m1;
n:=0;
for i:=1 to x do
    if M[i]>r then begin
      n:=n+1;
      C[n]:=M[i];
      Write(C[n],' ')
      end;
end.

Пример
x=18
>-15 -19 -32 3 2 35 32 12 -44 39 -36 16 31 5 17 21 -43 -20
3 2 35 32 12 39 16 31 5 17 21

2. PascalABC.NET 3.2, сборка 1370 от 24.12.2016
Если программа не работает, обновите версию!

begin
var M:=ReadArrInteger('>',ReadInteger('x='));
var r:=(M.TakeLast(10).Max)/(M.Where(b->b>3).Average);
var C:=M.Where(b->b>r).ToArray; C.Println
end.

Пример
x= 18
> -15 -19 -32 3 2 35 32 12 -44 39 -36 16 31 5 17 21 -43 -20
3 2 35 32 12 39 16 31 5 17 21

Сравнение явно не в пользу школьного программирования...

4,4(71 оценок)

Это интересно:

Стиль-и-уход-за-собой

05.08.2021

Как правильно надеть кимоно: советы и рекомендации...

Стиль-и-уход-за-собой

31.01.2023

Как избавиться от раздражения кожи после бритья: полезные советы и трюки...

Дом-и-сад

15.06.2022

Ядовитый дуб: как уничтожить и избавиться от него навсегда...

Компьютеры-и-электроника