Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Интересные и занимательные задачи по программированию > Pascal

Автор: Рыжий 20.6.2005, 15:31

Здравствуйте!
Вот пару задач, для разминки мозгов smile

:

Задача №1

Цитата

Даны два ненулевых числа. Найти их сумму, разность, произведение и частное.
пример входных данных:
6,3
пример выходных данных:
сумма - 9; произведение 18; частное 2.

Вопрос задал http://vingrad.ru/@PHP-Script

Задача №2

Цитата

Человек вводит 10 чисел, замените 3 максимальным а 7 минимальным.

пример входных данных:
10,20,30,40,50,60,55,45,35,25;

пример выходных данных:
10,20,60,40,50,60,10,45,35,25;

Вопрос задал http://vingrad.ru/@PHP-Script

Задача №3

Цитата

Дан номер месяца (1 — январь, 2 — февраль, ...10 - декабрь). Человек вводит номер месяца, Нужно вывести название соответствующего времени года ("зима", "весна" и т.д.).

пример входных данных:
7
пример выходных данных:
"лето"

Вопрос задал http://vingrad.ru/@PHP-Script

Задача№4

Цитата

Дано целое число в диапазоне 100 – 999. Вывести строку — словесное описание данного числа. пример входных данных:
256
пример выходных данных:
"двести пятьдесят шесть"

Вопрос задал http://vingrad.ru/@PHP-Script

Задача №5

Цитата

Даны два целых числа A и B (A < B). Вывести все целые числа, расположенные между данными числами (не включая сами эти числа), в порядке их убывания.

пример входных данных:
5,10
пример выходных данных:
9,8,7,6

Вопрос задал http://vingrad.ru/@PHP-Script

Автор: Pakshin A. S. 20.6.2005, 15:40

Никак не въеду... Можно примеры (точнее тесты) программ?

Автор: Рыжий 20.6.2005, 15:47

Задача №6

Цитата

Даны два числа m и n. Известно, что m/n - неправильная дробь. Задача: сократить эту дробь и выделить целую часть. Входные параметры - два числа (m,n). выходные - целая часть и оставшаяся несократимая правильная дробь.
Пример:
Вход: 33 6
Выход:5 1 2 (5 - челая часть, и дробь 1/2)

Вопрос задал http://vingrad.ru/@SPrograMMer

Задача №7

Цитата

Множество символов I-ричной системы счисления (2 <= I <= 36) образуют символы 0, ..., 9, A, B, ..., Z. Если I < 36, то соответствующее количество последних букв латинского алфавита в качестве цифр не используются. Если I < 10, то не используются соответствующие цифры. Необходимо написть программу, которая по двум текстовым строкам, означающим одно и то же число в I-ричной и J-ричной системе счисления, определяет минимальные значения I и J.
Пример входных данных:
10
2
Пример выходных данных:
2 3

http://forum.vingrad.ru/index.php?showuser=777&nickname=Pakshin%20A.%20S

Задача №8

Цитата

Имеется N точек и известны расстояния между некоторыми из них. Нужно написать программу, которая проверяет, можно ли эти точки расположить на плоскости так, чтобы указанные расстояния между ними сохранились.
INPUT
В файле исходных данных записано количество точчек N (1 <= N <= 100) и расстояния между некоторыми из них ы ыиде номер первой точки, нмер второй точки, расстояние. Расстояние - вещественное неотрицательное число, не превосходящее 1000. Номер точки - целое число из отрезка 1..N. Все числа разделяются проьелами и/или символами перевода строки.
OUTPUT
Ответом должно быть слово Yes или No соответственно.
EXAMPLE
INPUT:
3
1 2 10
2 3 20
3 1 100
OUTPUT:
No

http://forum.vingrad.ru/index.php?showuser=777&nickname=Pakshin%20A.%20S

Задача №9

Цитата

Составить программу SUBSETS, которая:
а) вводит с клавиатуры строку текста длиной N символов,
где каждый символ строки обозначает один элемент множества,
состоящего из N элементов;
б) выводит на экран число - количество подмножеств заданного
множества;
в) выводит на экран все подмножества заданного множества
по одному подмножеству в строке (в произвольном порядке).

Пример.
Введенная строка: "ABC"
Результаты:
8
<пустое множество>
A
B
C
AB
BC
AC
ABC

Вопрос задал http://vingrad.ru/@Fedor

Задача №10

Цитата

Составить программу, которая:
вводит с клавиатуры последовательность нечетных чисел.
Как только вводится четное число, программа прекращает работу.

Пример работы программы:

Введите число= 11
Введите число= 1
Введите число= 3
Введите число= 1
Введите число= 2
Программа закончилась.

Вопрос задал http://vingrad.ru/@Fedor

Добавлено @ 15:49
Pakshin A. S.
Каких именно??
И еще, давай постить тут только задачки smile

А если есть вопросы/замечания/пердложения - я всегда отвечаю на PM

Автор: Pakshin A. S. 20.6.2005, 15:52

Цитата

Каких именно??

Вот вторая партия нравится, т. к. есть примеры работы программы... надо бы также оформить и первую партию задач...

Ok... будем следить, чтобы никаких вопросов - только задачи... Просто предупреждать нужно... smile

Автор: SoWa 1.7.2005, 12:09

Вот решите:

Цитата

Дано N (N<=32000). Определить последнюю цифру числа N^N.

Автор: SoWa 12.9.2005, 16:15

Классная задача:
Дано N, на выход дать матрицу, представляющую из себя магический квадрат со стороной N или выдать, что решений нет.

Автор: EdgarJ 15.1.2006, 00:38

Вот вам несколько задачь от меня. Эти задачи довались нам на школьной олимпиаде по информатики(программированию). Выполнить задания можно было на С, Turbo Pascal 7.0, QBasic. Звёздочки показывают сложность задачь.

1) *

"Осадки"

Вам даётсья задача зделать программу, которая работает с двумя текстовыми файламы (osadki.dat и osadki.rez) и делает при этом несколько вычислений. В 1. файл записаваетсья несколько строк. Первая строка содержит количество дней N, после которой следует количество строк (N). Начиная со второй строки в каждой записано два числа (отделены между собой пробелои) - температура воздуха и количество (в мм) осадков в день. Принимая во внимание, что
1) N <= 1000000
2) количество осадков не меньше 0 и не боль ше 100 мм
3) температура воздуха была между -50 и 50 градусами
4) если Температура меньше нуля падал снег,а во стольных случайах лил дождь
в файле osadki.rez надо вывести два числа отделённых между собой побелами - общая количество снега за все дни и общее количество дождя.
Пример
osadki.dat
3
-1 30
0 3
20 15

osadki.rez
30 18

2)**

"Дамы и кони"

На шахматном столе находятсья дамы (ферзи они же королевы) и кони. Надо узнать количество дам которые под ударам как минимум одного коня и количество коней которые находятсья под ударам как минимум одного коня. Края шахматного стола обозначаютсья числами 1,2,3,4,5,6,7,8 и латинскими буквами a,b,c,d,e,f,g,h. Тем самым получаетсья, что у каждога поля есть обазначение - буква+число (а3, h2).

Программа должна работать с двумя файлами - dk.dat и dk.rez. В первом файле в первой строке дано 2 числа (отделяемых пробелам) - количество дам(D) и коней(K) соответсвенно. В последующих строках D даны координаты дам, а после идут cтроки K с координатами коней. В файле dk.rez надо вывести два числа - количество дам, которые под ударам как минимум одного коня и количество коней, которые под ударам как минимум одной дамы. Количество фигур характиризуетсья так - 1<=K, D <= 64. Общее количество фигур не меньше 2 и не больше 64.
Пример
dk.dat
2 4
d3
d1
e1
c1
c2
h1

dk.rez
1 3

Я потом выложу задания 3., 4. и 5. уровней сложности.

Автор: Алиса 15.6.2006, 23:39

Такие задачки предлагает, а грамотно писать так и не научился...

Автор: Рыжий 16.6.2006, 00:32

Алиса, Уточняйте пожалуйста личность мерзавца...

Или, Вы, имели ввиду ошибки такого плана:

Цитата(EdgarJ @ 15.1.2006, 00:38

)

Вам даётсья задача зделать программу

Автор: Palladin 29.6.2006, 01:08

А решения этих задач здесь постить ненадо??? или это чисто для себя, чтоб не забыть smile

Автор: dvamaster 15.7.2006, 12:27

Вот моя задачка:

Код


Найти первые N простых чисел, цикл не должен содежать "пустых" итераций!!!

Автор: sgentstuff 17.7.2006, 11:34

Предлагаю помимо задач выкладывать также и решения этих задач! Каждый, кто хочет решает задачу, выкладывает свое решение, чтобы можно было посмотреть чье решение эффективнее! В данный момент решаю вот эту задачу, пока не решил, давайте вместе ее решать, потом следующую и т.д., а то умирает эта тема!

Составить  алгоритм  заполнения  прямоугольной таблицы размером N*N целыми числами от 1 до N*N  по  спирали.
Пример для N=5.
1    2    3    4    5
16    17    18    19    6
15    24    25    20    7
14    23    22    21    8
13    12    11    10    9

Добавлено @ 11:36
SoWa, RooR и все остальные подключайтесь!

Автор: sgentstuff 17.7.2006, 18:47

Вобщем решил я эту задачку решение ниже.

Предлагаю помимо задач выкладывать также и решения этих задач! Каждый, кто хочет решает задачу, выкладывает свое решение, чтобы можно было посмотреть чье решение эффективнее! В данный момент решаю вот эту задачу, пока не решил, давайте вместе ее решать, потом следующую и т.д., а то умирает эта тема!

Составить  алгоритм  заполнения  прямоугольной таблицы размером N*N целыми числами от 1 до N*N  по  спирали.
Пример для N=5.
1    2    3    4    5
16    17    18    19    6
15    24    25    20    7
14    23    22    21    8
13    12    11    10    9

Ршение

Код


procedure TForm1.Button1Click(Sender: TObject);
const n=4;
var
ur,g,i,s:integer;
a:array[1..n,1..n] of integer;
str:string;
begin
//
g:=1;
s:=0;
while s<>n*n do
begin
        for i:=g to n-g+1 do
        begin
        inc(s);
        a[g,i]:=s;
        end;
        for i:=g to n-g do
        begin
        inc(s);
        a[i+1,n-g+1]:=s;
        end;
        for i:=n-g downto g do
        begin
        inc(s);
        a[n-g+1,i]:=s;
        end;
        for i:=n-g downto g+1 do
        begin
        inc(s);
        a[i,n-(n-g)]:=s;
        end;

inc(g);

end;
for i:=1 to n do
begin
str:='';
for g:=1 to n do
str:=str+IntToStr(a[i,g])+'  ';
memo1.Lines.add(str);
end;
end;

Кто может предложить более изящное решение, чем с 5- циклами?

Автор: sgentstuff 18.7.2006, 07:20

Задача r89_4
По кругу стоят N спортсменов с номерами от 1 до N. Начиная с какого-то человека, по кругу удаляется каждый k-ый спортсмен. После каждого удаления круг смыкается. Составить алгоритм определения последовательности номеров удаляемых спортсменов.

Автор: sgentstuff 19.7.2006, 06:52

Решение r89_4

Код


procedure TForm1.Button1Click(Sender: TObject);
const n = 6;
var
k,i:integer;
s,s1:TStringList;
begin
//
s:= TStringList.Create;
s1:= TStringList.Create;
for i:=0 to n do
s.Add(inttostr(i));
k:=0;
while s.Count>1 do
begin
  if k >= s.Count then
  begin
  k:=k-s.Count;[quote]

[/quote]
  end;
        if k=s.Count then
        begin
        s1.Add(s.Strings[k-1]);
        s.Delete(k-1);
        continue;
        end;
        s1.Add(s.Strings[k]);
        s.Delete(k);
        inc(k,2);
end;
memo1.Lines.Add(s1.Text);
end;

Автор: sgentstuff 19.7.2006, 07:20

Задача r89_6
Составить алгоритм подсчета количества способов, которыми можно разменять рубль медными монетами (достоинством 1, 2, 3, 5 копеек).

Автор: Palladin 22.7.2006, 15:14

Цитата(sgentstuff @ 19.7.2006, 07:20

)

Вот эта мне понравилась smile

ща буду решать, заодно и ТВИМС вспомню smile

Автор: AlexST 3.8.2006, 18:35

Прям неинтересно как-то.
Такие задачи решают в 5 классе по-моему.
В эту коллекцию "разминалок" могу кинуть еще пару примеров (кому интересно) типа:

Есть множество точек плоскости, соединить две из них отрезком так, чтобы с обоих сторон отрезка было равное количество точек.

или

Есть множество точек, составить из них несамопересекающуюся ломаную.

Хоть чуток посложнее smile

Автор: Berd 5.8.2006, 01:16

Для разнообразия тренирующихся.
Где-то когда-то вычитал:
...
"Составить программу, которая печатает сама себя.
Программа должна иметь как можно меньший размер."
...

Автор: AlexST 5.8.2006, 01:24

Чё-то, как-то не ясно задание. Если я его правильно понял, то в чём сложность?

Автор: DarlkElfTen 13.10.2006, 20:19

Цитата(Рыжий @ 20.6.2005, 15:31)

Здравствуйте!
Вот пару задач, для разминки мозгов smile

:

Задача №1

Цитата

Вопрос задал http://vingrad.ru/@PHP-Script

Задача №2

Цитата

Вопрос задал http://vingrad.ru/@PHP-Script

Задача №3

Цитата

Вопрос задал http://vingrad.ru/@PHP-Script

Задача№4

Цитата

Вопрос задал http://vingrad.ru/@PHP-Script

Задача №5

Цитата

Вопрос задал http://vingrad.ru/@PHP-Script

кхм...это же легко..=\
по моему это для тупых smile

Добавлено @ 20:19

Цитата(sgentstuff @ 19.7.2006, 07:20)

эта интереснее)

Автор: aved 15.10.2006, 11:17

DarlkElfTen, ещё 10, 15, 20, 50.

Задача

Цитата

Дано неизвестное количество блоков паралельно соеденённых резисторов, в кажом блоке неизвестное количество резисторов. Номинал резисторов вводится с клавиатуры. Отрицательное число - означает переход к следующему блоку, 0 - конец схемы. Найти общее сопротивление резисторов.

10 10 -1 10 10 0 = 10 Ом

user posted image

Автор: AligatorV 5.12.2006, 21:08

Ученые астрономы, сообщили правительство, что ровно через T секунд на
планете Олимпиада начнется метеоритный дождь. Правительство планеты срочно
начало эвакуацию людей и
важного оборудования - телескопических установок.
Для защиты телескопу его нужно транспортировать в специально отведенное
место - хранилище. В одном хранилище может вместиться лишь один телескоп.
Необходимо рассчитать максимальное количество телескопов которые можно
успеть спрятать к началу метеоритного дождя.

Входные данные (файл METEOR.DAT):
В первой строке число T - количество секунд через которую метеориты
упадут на планету.
Во второй строке число N - количество телескопов.
В третьей строке находится 2*N чисел - координаты телескопов (x, в)
В четвертой строке число M - количество хранилищ.
В пятой строке находится 2*M чисел - координаты хранилищ (x, в)
В шестой строке число V - скорость транспортировки телескопов.

Примечание:
0<T<1000000 ; 0<N,M<100 ; -30000 <= x,y <=30000 ; 0<V<1000
T, N, M, x, в - цели.

Выходные даны: (файл METEOR.SOL):
В единственную строку файла записать максимальное количество телескопов,
которые могут быть спрятанные к началу падения метеоритов.

Пример METEOR.DAT:
10
4
1 7 3 7 5 7 100 100
2
2 7 4 7
0.1

Пример METEOR.SOL:
2

Автор: AligatorV 5.12.2006, 23:57

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

Входные данные: (файл BOMBA.DAT):
В первой строке число N. (0<N<=100)
Во второй строке содержится N чисел, которые помечают состояние каждой лампочки (0 - выключенная, 1 - включенная).
В третьей строке содержится число M. (0<M<=100)
В каждом из следующих M строк содержится число K (количество лампочек состояние которых изменяет данный переключатель) и K чисел - номера соответствующих лампочек.
Выходные даны: (файл BOMBA.SOL):
Если бомбу обезвредить невозможно, запишите в исходный файл "NO" (без кавычек).
Если возможно спасти мир, то в первую строку запишите "YES" (без кавычек), а во вторую строку запишите номера переключателей которые необходимо задействовать.
Пример BOMBA.DAT:
5
0 1 1 0 1
4
3 2 3 4
3 1 4 5
2 4 5
2 2 4

Автор: aved 9.12.2006, 10:52

Дана матрица из нулей и единиц, найти количество областей состоящих из единиц ("пятна")

Н-р:
1 1 1 0 1 1 0 0 0 0
1 0 1 1 1 0 1 1 0 0
0 1 1 0 0 1 0 0 1 1
0 0 1 0 0 0 1 0 1 0
0 0 1 1 1 0 0 1 1 1
0 0 1 0 1 0 0 1 0 0
0 1 0 0 1 0 0 0 0 0

Ответ: 3

Автор: Kann 16.12.2006, 20:26

Цитата(aved @ 9.12.2006, 10:52)

Код


const n=7;
      m=10;
var f:text;
    a:array[1..n,1..m,0..1] of byte;
    i,j,p:integer;
procedure search(i,j:integer);
begin
if i<>1 then if (a[i-1,j,0]=1) and (a[i-1,j,1]=0) then
begin
a[i-1,j,1]:=a[i,j,1];
search(i-1,j);
end;

if i<n then if (a[i+1,j,0]=1) and (a[i+1,j,1]=0) then
begin
a[i+1,j,1]:=a[i,j,1];
search(i+1,j);
end;

if j<>1 then if (a[i,j-1,0]=1) and (a[i,j-1,1]=0) then
begin
a[i,j-1,1]:=a[i,j,1];
search(i,j-1);
end;

if j<m then if (a[i,j+1,0]=1) and (a[i,j+1,1]=0)  then
begin
a[i,j+1,1]:=a[i,j,1];
search(i,j+1);
end;

end;
function ch(i,j:integer):boolean;
begin
ch:=false;
if not i>n then if a[i+1,j,0]=1 then ch:=true;
if not i<1 then if a[i-1,j,0]=1 then ch:=true;
if not j>m then if a[i,j+1,0]=1 then ch:=true;
if not i<1 then if a[i,j-1,0]=1 then ch:=true;
end;
begin
assign(f,'c:\in.txt');
reset(f);
for i:=1 to n do
for j:=1 to m do
read(f,a[i,j,0]);
p:=1;
for i:=1 to n do
for j:=1 to m do
if  ch(i,j) then
if (a[i,j,0]=1) and (a[i,j,1]=0) then
begin
a[i,j,1]:=p;
inc(p);
search(i,j);
end;
dec(p);
writeln(p);
end.

Автор: Strannik 28.1.2007, 19:58

Вот чуть более эффективная реализация:

Код


const md: array [1..4,1..2] of shortint=((0,1),(1,0),(-1,0),(0,-1));
var a: array [1..100,1..100] of byte;
      i,j,kol,n,m: longint;

procedure search(x,y: integer);
var tx,ty,i: integer;
begin
 a[x,y]:=0;
 for i:=1 to 4 do
  begin
   tx:=x+md[i,1];
   ty:=y+md[i,2];
   if a[tx,ty]=1 then
    begin
     search(tx,ty);
    end;
  end;
end;

begin
 assign(input,'input.txt');
 reset(input);
 readln(m,n);
 fillchar(a,sizeof(a),0);
 for i:=1 to m do
  for j:=1 to n do
    read(a[i,j]);
 kol:=0; 
 for i:=1 to m do
  for j:=1 to n do
   if (a[i,j]=1) then
    begin
     inc(kol);
     search(i,j);
    end;
 writeln(kol); 
 close(input);
end.

П.С. Не компилировал и не тестировал, так что за описки не пинать а идея и так понятна...

Добавлено @ 20:04
Ну и от меня задачка:

На шахматной доске есть два коня, они делают ходы одновременно. Определить за какое минимальное кол-во ходов они могут встретиться на одной клетке. Если не могут - вывести "-1"

input.txt
a1 a3
-------
a1 a2

output.txt
1
-----
-1

Добавлено @ 20:07
Я вам этих задач столько напихать могу.... Если кому нечем мозги занять - обращайтесь, подыщем индивидуальную программу!

Автор: Michael_Rybak 30.1.2007, 19:34

Расскажи откуда пихать будешь smile

Автор: Strannik 30.1.2007, 23:04

У-у-у.... в сети столько этого добра (ну не мне ж тебе рассказывать). Плюс задачи которые точно мало кто видел (например наша район-область прошлых годов). Да и дело не в том что тут будет что-то эксклюзивное... Просто человек например не будет специально искать архивы задач, а здесь увидит парочку, может быть заинтересуется этим делом...

Автор: Michael_Rybak 30.1.2007, 23:39

Ну я думал может ресурс какой-нить в мою коллекцию новый smile

Автор: volvo877 31.1.2007, 00:01

Цитата(Strannik @ 28.1.2007, 18:58

)

Вот чуть более эффективная реализация:

Вполне возможно, только ничего, что она результат неправильный выдавать будет?

Цитата(Strannik @ 28.1.2007, 18:58

)

П.С. Не компилировал и не тестировал, так что за описки не пинать а идея и так понятна...

Интересная позиция... Только вот идея - она и так понятна, тебе не показалось? А ты почему-то очевидного не заметил... Условие еще раз перечитай, и посмотри, есть ли в матрице отдельно стоящие единицы. Так вот их учитывать не надо (судя по тому, что автор выделил только единицы, стоящие ГРУППОЙ), а твоя программа это будет делать...

Автор: Strannik 31.1.2007, 14:57

Цитата

Дана матрица из нулей и единиц, найти количество областей состоящих из единиц ("пятна")

Одна единица - область состоящая из единиц.

Я решил эту задачу и не несу ответственность за несоответствие примеров или некорректную постановку задачи.

Автор: WTF4XZ 22.7.2007, 13:40

Ещё пример тупенькой задачки:

На вход программе подаются строчные английскме буквы. Ввод этих символов заканчивается точкой. Требуется написать программу, которая будет печатать буквы, встречающиеся во входной последовательности, в порядке уменьшения частоты их встречаемости. Каждая буква должна быть распечатана один раз. Точка при этом не учитывается.
Если какие-то буквы встречаются одинаковое количество раз, то они выводятся в алфавитном порядке.
Пример входных данных:
batat.
Вывод:
atb

Автор: sentry 24.7.2007, 19:39

Цитата(SoWa @ 12.9.2005, 16:15

)

Дано N, на выход дать матрицу, представляющую из себя магический квадрат со стороной N или выдать, что решений нет.

А это разве для любого N можно сделать?

Цитата(AlexST @ 3.8.2006, 18:35

)

Есть множество точек плоскости, соединить две из них отрезком так, чтобы с обоих сторон отрезка было равное количество точек.

Скорее провести прямую, а не отрезок. Решается через знак отклонения точки от прямой.

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

Автор: Aristarh_Dark 25.7.2007, 05:22

Цитата(Berd @ 5.8.2006, 06:16)

Бейсик

Код


10 List

Автор: zusichka 10.12.2007, 00:25

Квадратная матрица, симметричная относительно главной диагонали, заданная верхним треугольником в виде одномерного масива. Возобновить начальную матрицу и напечатать по строкам.

как вам? .решите

Автор: mr.Anderson 16.12.2007, 16:17

Цитата

На вход программе подаются строчные английскме буквы. Ввод этих символов заканчивается точкой. Требуется написать программу, которая будет печатать буквы, встречающиеся во входной последовательности, в порядке уменьшения частоты их встречаемости. Каждая буква должна быть распечатана один раз. Точка при этом не учитывается.
Если какие-то буквы встречаются одинаковое количество раз, то они выводятся в алфавитном порядке.
Пример входных данных:
batat.
Вывод:
atb

Заинтересовался. Сча попробую сделать...

Автор: mr.Anderson 16.12.2007, 16:41

Гм. Решил. Но вряд ли решение оптимально, прошу подсказать более правильный вариант.

Код


program engLetters;

{$APPTYPE CONSOLE}

var
 l : array [1..130] of Word;
 i : Word;
 s : String;
 c : Word;
 m : Word;
begin
 fillchar( l, sizeof(l), 0 );

 c := 0;

 readln( s );

 for i:=1 to Length(s) do
 begin
  if( s[i] = '.' ) then
   break;

  inc( l[ ord(s[i]) ] );
  inc( c );
 end;

 m := 0;

 while( c > 0 ) do
 begin
  for i:=1 to 130 do
  begin
   if( l[i] > m ) then
    m := l[i]
   else
    m := m;
  end;

  for i:=1 to 130 do
   if( l[i] = m ) then
   begin
    write( chr(i) );
    l[i] := 0;
   end;

  dec( c );
 end;
end.

Автор: klubnichka13 14.4.2009, 19:48

привет!кто-нибудь помогите пожалста!решить задачу:
Описать процедуру StringFileToText(Name) / TextFileToString(Name), преобразующую двоичный строковый в текстовый файл с именем Name, и текстовый в двоичный строковый файл с тем же именем. Используя эту процедуру, преобразовать два данных строковых/текстовых файла с именами Name1 и Name2 в текстовыйе/строковые.

Автор: Semmi 20.7.2009, 23:01

Цитата(sgentstuff @ 17.7.2006, 18:47)

Код


procedure TForm1.Button1Click(Sender: TObject);
const n=4;
var
ur,g,i,s:integer;
a:array[1..n,1..n] of integer;
str:string;
begin
//
g:=1;
s:=0;
while s<>n*n do
begin
        for i:=g to n-g+1 do
        begin
        inc(s);
        a[g,i]:=s;
        end;
        for i:=g to n-g do
        begin
        inc(s);
        a[i+1,n-g+1]:=s;
        end;
        for i:=n-g downto g do
        begin
        inc(s);
        a[n-g+1,i]:=s;
        end;
        for i:=n-g downto g+1 do
        begin
        inc(s);
        a[i,n-(n-g)]:=s;
        end;

inc(g);

end;
for i:=1 to n do
begin
str:='';
for g:=1 to n do
str:=str+IntToStr(a[i,g])+'  ';
memo1.Lines.add(str);
end;
end;

Кто может предложить более изящное решение, чем с 5- циклами?

создаем массив из (n+2)*(n+2) элементов заполненый след образом:
пример для n=3
00000
0***0
0***0
0***0
00000 и начиная с элемета [2,2] заполняем массив числами 1 до n^2. как только встретили 0 или НЕ *, то меняем направление заполнения.
в итоге один цикл от 1 до n^2

Автор: fukusu 29.1.2010, 12:00

Цитата(sgentstuff @ 17.7.2006, 18:47)

Код


procedure TForm1.Button1Click(Sender: TObject);
const n=4;
var
ur,g,i,s:integer;
a:array[1..n,1..n] of integer;
str:string;
begin
//
g:=1;
s:=0;
while s<>n*n do
begin
        for i:=g to n-g+1 do
        begin
        inc(s);
        a[g,i]:=s;
        end;
        for i:=g to n-g do
        begin
        inc(s);
        a[i+1,n-g+1]:=s;
        end;
        for i:=n-g downto g do
        begin
        inc(s);
        a[n-g+1,i]:=s;
        end;
        for i:=n-g downto g+1 do
        begin
        inc(s);
        a[i,n-(n-g)]:=s;
        end;

inc(g);

end;
for i:=1 to n do
begin
str:='';
for g:=1 to n do
str:=str+IntToStr(a[i,g])+'  ';
memo1.Lines.add(str);
end;
end;

Кто может предложить более изящное решение, чем с 5- циклами?

Собственно не совсем паскаль, но сути это не меняет.
Вот решение с одним циклом, причем для случая, когда не квадрат, а прямоугольник (но для квадрата тоже работает smile

)

Код


    Dim Arr(20, 20) As Integer
    Dim Orient As Integer
    Dim Col As Integer
    Dim Row As Integer
    Dim Col2 As Integer
    Dim Row2 As Integer
    Dim Sign As Integer
    Dim MoveX As Integer
    Dim MoveY As Integer
    Dim I As Integer, J As Integer
    Dim bChangeDirct As Boolean
    Dim N As Integer
    Dim M As Integer

    N = Range("inputN").Value
    M = Range("inputM").Value
    Orient = 1
    Col = 1
    Row = 0
    I = 0
    bChangeDirct = False
    
    While I < N * M
        Sign = IIf(2 - Orient >= 0, 1, -1)
        MoveX = Orient Mod 2
        MoveY = 1 - MoveX
       
        I = I + 1
        Row = Row + Sign * MoveX
        Col = Col + Sign * MoveY
        Arr(Col, Row) = I
        
        Row2 = Row + Sign * MoveX
        Col2 = Col + Sign * MoveY
        If Row2 > N Or Col2 > M Or Row2 < 1 Or Col2 < 1 Then
            bChangeDirct = True
        Else
            If Arr(Col2, Row2) <> 0 Then bChangeDirct = True
        End If
        
        If bChangeDirct Then
            bChangeDirct = False
            If Orient < 4 Then Orient = Orient + 1 Else Orient = 1
        End If
    Wend

Собственно, считаю решение более изящным

Автор: Uliya20 1.6.2010, 22:05

Модератор: Сообщение скрыто.

Автор: LoveMeCozImBLONDE 1.6.2010, 23:25

Модератор: Сообщение скрыто.

Автор: jtxstyle 13.11.2010, 22:13