Архимедова спираль

Архимедова спираль имеет очень простые параметрические уравнения: x = t * cos(t); y = t * Sin(t).

Нарисовать её проще всего с помощью модуля PlotWPF.

uses PlotWPF,GraphWPF;

begin
  Window.SetSize(600,600);
  var seq := Range(0,20,0.1);
  var xx := seq.Select(t -> t * Cos(t));
  var yy := seq.Select(t -> t * Sin(t));
  LineGraphWPF.Create(xx,yy,Colors.Black);
end.

https://rosettacode.org/wiki/Archimedean_spiral#PascalABC.NET

Мужчина или мальчик

Тест Дональда Кнута позволяет выявить компиляторы, корректно реализующие рекурсию с нелокальными переменными.

Изначально тест был написан на Algol-60:

begin
  real procedure A (k, x1, x2, x3, x4, x5);
  value k; integer k;
  real x1, x2, x3, x4, x5;
  begin
    real procedure B;
    begin k:= k - 1;
          B:= A := A (k, B, x1, x2, x3, x4)
    end;
    if k <= 0 then A:= x4 + x5 else B
  end;
  outreal (A (10, 1, -1, -1, 1, 0))
end

PascalABC.NET успешно проходит этот тест:

function A(k: integer; x1, x2, x3, x4, x5: function: integer): integer;
begin
  var B: function: integer;
  B := () -> begin
    k := k - 1;
    Result := A(k, B, x1, x2, x3, x4);
  end;
  Result := if k <= 0 then x4() + x5() else B()
end;

begin
  Print(A(10, () -> 1, () -> -1, () -> -1, () -> 1, () -> 0))
end.

и выводит верное значение -67

https://rosettacode.org/wiki/Man_or_boy_test#PascalABC.NET

Определение сбалансированности скобок

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

function GenBracketExpr(n: integer): string;
begin
  var a := Arr('[',']')*n;
  Shuffle(a);
  Result := a.JoinToString
end;

function IsBalanced(s: string): boolean;
begin
  Result := True;
  var st := new Stack<char>;
  foreach var c in s do
    if c = '[' then
      st.Push(c)
    else if (st.Count > 0) and (st.Peek = '[') then
      st.Pop
    else begin
      Result := False;
      exit
    end;
end;

begin
  loop 10 do
  begin
    var s := GenBracketExpr(Random(2,5));
    Println(s, IsBalanced(s));    
  end;
end.

// https://rosettacode.org/wiki/Balanced_brackets#PascalABC.NET

Множество всех подмножеств

Рекурсивная функция генерации последовательности всех подмножеств заданного множества. Используется yield sequence.

function AllSubSets<T>(a: array of T; i: integer; lst: List<T>): sequence of List<T>;
begin
  if i = a.Length then
  begin  
    yield lst;
    exit;
  end;  
  lst.Add(a[i]);
  yield sequence AllSubSets(a, i + 1, lst);
  lst.RemoveAt(lst.Count-1);
  yield sequence AllSubSets(a, i + 1, lst);
end;

begin
  AllSubSets(Arr(1..4),0,new List<integer>).Print;
end.

Вывод:

[1,2,3,4] [1,2,3] [1,2,4] [1,2] [1,3,4] [1,3] [1,4] [1] [2,3,4] [2,3] [2,4] [2] [3,4] [3] [4] []

https://rosettacode.org/wiki/Power_set#PascalABC.NET

Общая часть путей

Задача. Дан массив директорий. Найти общую часть их путей

Решение. Превратим все пути в последовательности строк, обрежем их по минимальной длине и транспонируем.
Будем брать только те строки, в которых все элементы совпадают, а потом оставим у них первые элементы и превратим их в путь.

function CommonPrefix(arrs: array of array of string): array of string;
begin
  var min: integer := arrs.Min(a -> a.Length);
  var at := ArrGen(min, j -> ArrGen(arrs.Length, i -> arrs[i][j]));
  Result := at.TakeWhile(x -> x.Skip(1).All(y -> y = x.First)).Select(a -> a[0]).ToArray
end;

function CommonDirectoryPath(paths: array of string; sep: char := '/'): string;
begin
  var arrs := paths.Select(a -> a.Split(sep)).ToArray;
  Result := CommonPrefix(arrs).JoinToString(sep);
end;

begin
  Print(CommonDirectoryPath(|
   '/home/user1/tmp/coverage/test',
   '/home/user1/tmp/covert/operator',
   '/home/user1/tmp/coven/members'|))
end.

https://rosettacode.org/wiki/Find_common_directory_path#PascalABC.NET

Фрактальное дерево

Нарисуем фрактальное дерево? Это просто!

uses Turtle,GraphWPF;

procedure FractalTree(n: integer; len,angle: real);
begin
  if n = 0 then exit;
  len := len * 0.8;
  Turn(angle);
  Forw(len);
  FractalTree(n-1,len,angle);
  Turn(180);
  Forw(len);
  Turn(180-2*angle);
  Forw(len);
  FractalTree(n-1,len,angle);
  Turn(180);
  Forw(len);
  Turn(180+angle);
end;

begin
  Window.Title := 'Fractal Tree';
  var len := 100;
  var angle := 22;
  ToPoint(400,500);
  Turn(-90);
  Down;
  Forw(100);
  FractalTree(10,len,angle);
end.

https://rosettacode.org/wiki/Fractal_tree#PascalABC.NET

Мы в Rosetta Code на 120 месте!

Загрузка JSON-строки

С помощью стандартной библиотеки System.Web.Extensions.dll можно манипулировать JSON-объектами: сериализовать их в JSON-формат из строки и словаря, а также десериализовать их

{$reference System.Web.Extensions.dll}
uses System.Web.Script.Serialization;

begin
  var serializer := new JavaScriptSerializer;
  var people := new Dictionary<string, object>;
  people.Add('1', 'John');
  people.Add('2', 'Susan');
  var json := serializer.Serialize(people);
  Println(json);
  var res := serializer.Deserialize&<Dictionary<string, object>>(json);
  Println(TypeName(res));
  Println(res);
  
  var jsonObject := serializer.DeserializeObject('{ "foo": 1, "bar": [10, "apples"] }')
    as Dictionary<string, object>;
  Println(jsonObject);
  var arr := jsonObject['bar'] as array of object;
  arr.Println;
end.

Результат:

{"1":"John","2":"Susan"}
Dictionary<string, Object>
{(1,John),(2,Susan)}
{(foo,1),(bar,[10,apples])}
10 apples

https://rosettacode.org/wiki/JSON#PascalABC.NET

Преобразование в римские числа

Составим функцию, преобразующую арабские числа в римские и применим её на списке чисел. Кто-нибудь напишет короче?

https://rosettacode.org/wiki/Roman_numerals#PascalABC.NET

var anums := |1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1|;
var rnums := 'M CM D CD C XC L XL X IX V IV I'.split;

function ToRoman(x: integer): string;
begin
  Result := '';
  foreach var (a,r) in anums.Zip(rnums) do
  begin
    var n := x div a;
    x := x mod a;
    Result += r * n;
  end;
end;

begin
  var test := |1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 25, 30, 40,
          50, 60, 69, 70, 80, 90, 99, 100, 200, 300, 400, 500, 600, 666, 700, 800, 900, 1000,
          1009, 1444, 1666, 1945, 1997, 1999, 2000, 2008, 2010, 2011, 2500, 3000, 3999|;
  foreach var x in test do
    Println($'{x} - {ToRoman(x)}')
end.

Niven numbers

Необходимо вывести 20 первых чисел, обладающих свойством - число делится на сумму своих цифр.

В PascalABC.NET с использованием модуля school сделать это - проще простого!

##
uses School;

function IsHarshad(n: integer) := n.Divs(n.Digits.Sum);

1.Step.Where(IsHarshad).Take(20).Println;
1.Step.Where(i -> (i > 1000) and IsHarshad(i)).First.Println;

Последняя строка выводит первое Niven-число, большее 1000.

https://rosettacode.org/wiki/Harshad_or_Niven_series#PascalABC.NET

И - мы в Rosetta Code уже на 115 месте!

Все простые числа с увеличивающимися цифрами

Функция AscendingSeq даёт последовательность всех чисел, у которых цифры упорядочены строго по возрастанию.
Обратите внимание на изящное применение yield sequence и рекурсии.

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

## 
uses School;

function AscendingSeq(n: integer): sequence of integer;
begin
  for var x := n*10 + n mod 10 + 1 to n*10 + 9 do
    yield sequence AscendingSeq(x) + x;
end;

AscendingSeq(0).Order.Where(n -> n.IsPrime).Print;

https://rosettacode.org/wiki/Ascending_primes#PascalABC.NET

Решайте задачи на Rosetta Code!

Точка пересечения прямой и плоскости

Данная программа иллюстрирует, как найти точку пересечения прямой и плоскости

type Point = auto class
  x,y,z: real;
  static function operator-(p1,p2: Point): Point := new Point (p1.x-p2.x, p1.y-p2.y, p1.z-p2.z);
  static function operator*(p1,p2: Point): real := p1.x*p2.x + p1.y*p2.y + p1.z*p2.z;
  static function operator*(p: Point; r: real): Point := new Point (p.x*r, p.y*r, p.z*r);
end;

function IntersectionPoint(RayDir, RayPoint, PlaneNormal, PlanePoint: Point): Point
  := RayPoint - RayDir * (((RayPoint - PlanePoint) * PlaneNormal) / (RayDir * PlaneNormal));

begin
  var RayDir := new Point(0.0, -1.0, -1.0);
  var RayPoint := new Point(0.0, 0.0, 10.0);
  var PlaneNormal := new Point(0.0, 0.0, 1.0);
  var PlanePoint := new Point(0.0, 0.0, 5.0);
  Print(IntersectionPoint(RayDir, RayPoint, PlaneNormal, PlanePoint));
end.

https://rosettacode.org/wiki/Find_the_intersection_of_a_line_with_a_plane#Perl#PascalABC.NET

Найти недостающую перестановку

Даны перестановки - все кроме одной. Найти недостающую

О, это совсем просто. Перебираем все перестановки и сравниваем их как множества, используя операцию разности.

Тут и многострочная строка, и метод ToLines. Ну и перестановки как множества - а как еще искать недостающую?

begin
  var s := '''
  ABCD
  CABD
  ACDB
  DACB
  BCDA
  ACBD
  ADCB
  CDAB
  DABC
  BCAD
  CADB
  CDBA
  CBAD
  ABDC
  ADBC
  BDCA
  DCBA
  BACD
  BADC
  BDAC
  CBDA
  DBCA
  DCAB
  ''';
  var perms := s.ToLines;
  Print(('ABCD'.Permutations.ToHashSet - perms.ToHashSet).First);
end.

https://rosettacode.org/wiki/Find_the_missing_permutation#PascalABC.NET

Последовательность, возвращающая функции

В данной задаче из Rosetta Code с помощью метода Zip возвращается последовательность функций.

Собственно ничего интересного в этой задаче нет кроме того, что мы в Rosetta Code вырвались на 107 место!

https://rosettacode.org/wiki/First-class_functions/Use_numbers_analogously#PascalABC.NET

Ввод Y или N без нажатия клавиши Enter

begin
  repeat
    var q := console.ReadKey;
    if q.Key in |System.ConsoleKey.Y,System.ConsoleKey.N| then
    begin  
      Print($'{q.Key} pressed');
      exit
    end;  
  until False;
end.

https://rosettacode.org/wiki/Keyboard_input/Obtain_a_Y_or_N_response#PascalABC.NET

106 место!

Спасибо всем, кто активно помогает решать задачи!

Мы - в Top-100 языков Rosetta code!

Кривая Гильберта - одна из известнейших фрактальных кривых.

Ниже приводится алгоритм рисования кривой Гильберта с помощью новой Черепахи. Это - 334-я задача, решенная на Rosetta Code:

https://rosettacode.org/wiki/Hilbert_curve#PascalABC.NET

uses Turtle;

procedure Hilbert(level: integer; angle,step: real);
begin
  if level = 0 then
    exit;
  TurnRight(angle);
  Hilbert(level-1, -angle, step);
  
  Forw(step);
  TurnLeft(angle);
  Hilbert(level-1, angle, step);
  
  Forw(step);
  Hilbert(level-1, angle, step);
  
  TurnLeft(angle);
  Forw(step);
  Hilbert(level-1, -angle, step);
  TurnRight(angle);
end;

begin
  SetWidth(2);
  ToPoint(-9,-9);
  Down;
  Hilbert(6,90,0.3);
end.

Красота!

🌐 Работа с сетевыми библиотеками .NET в PascalABC.NET 🌐

PascalABC.NET позволяет использовать мощные сетевые библиотеки .NET для создания приложений, которые могут взаимодействовать с веб-сервисами и сетевыми ресурсами. Сегодня рассмотрим, как с помощью класса System.Net.WebClient можно легко загружать данные из интернета.

📡 Пример: Загрузка веб-страницы с помощью .NET

uses System.Net;

begin
  var url := 'https://yandex.ru';
  var client := new WebClient;
  try
    var content := client.DownloadString(url);
    Println(content[:1000]);
  except
    on e: Exception do
      Println('Ошибка при загрузке данных:', e.Message);
  end;
end.

⚙️ В этом примере мы используем класс WebClient для получения данных с веб-страницы. С помощью методов этой библиотеки можно загружать как строки, так и файлы, а также отправлять запросы к API.

📡 Применение: Этот пример можно использовать для парсинга данных с веб-сайтов или создания простого сетевого клиента.

Откройте для себя возможности сетевых приложений с PascalABC.NET и библиотеками .NET!

#PascalABC #dotNET #Сети #Программирование #Pascal #Web

Новые множества

В PascalABC.NET обновлена реализация встроенных множеств set of T, просуществовавшая 17 лет. За это время в PascalABC.NET внесено огромное количество улучшений: появились обобщенные классы, перегрузка операций, методы расширения, реализация интерфейсов, последовательности. Именно благодаря этим средствам реализация новых множеств стала возможной.

В результате новые множества значительно ускорены, приближаясь по эффективности к HashSet<T>.

На скриншоте - программа, которая работает в старой версии примерно в 1000 медленнее.

Обновите Паскаль - скачайте новую версию!

#PascalABC #новое

begin
  var s: set of integer;
  var n := 10000000;
  for var i:=1 to n do
    s += [i];
  Print(MillisecondsDelta);
end.

Корни n-той степени из комплексной единицы

Известно, что имеется ровно n корней n-той степени из единицы если рассматривать её в комплексной плоскости.

Код очень прост:

function RootsOfUnity(n: integer) 
  := (0..n-1).Select(x -> Complex.FromPolarCoordinates(1, 2 * PI * x / n));

begin
  RootsOfUnity(3).PrintLines
end.

И вывод

1+0i
-0.5+0.866025403784439i
-0.5-0.866025403784438i

А мы в Rosetta Code - на 72 месте с 511 задачами. Позади уже Prolog и PHP.

Болеем за наших! И хвалим claude.ai за сгенерированную картинку!

Алгоритм Дейкстры на Rosetta Code

Алгоритм полностью сгенерирован ChatGPT по коду на Python с минимальными правками.

https://rosettacode.org/wiki/Dijkstra%27s_algorithm#PascalABC.NET

Ну а мы в Rosetta Code уже на 67 месте с 553 задачами благодаря стараниям тайного друга. Позади Elixir, Erlang, PowerShell и Groovy.

type
  Edge = auto class
    start, &end: char;
    cost: real;
  end;

  Graph = auto class
    edges: array of Edge;
    vertices: HashSet<char>;
    
    constructor(params edges: array of (char, char, real));
    begin
      Self.edges := edges.Select(e -> new Edge(e[0], e[1], e[2])).ToArray;
      Self.vertices := new HashSet<char>(
        Self.edges.Select(e -> e.start) + Self.edges.Select(e -> e.end)
      );
    end;
    
    function Dijkstra(source, dest: char): sequence of char;
    begin
      assert(vertices.Contains(source));
      
      var inf := real.MaxValue;
      var dist := Dict(vertices.Select(v -> (v, inf)));
      var previous := Dict(vertices.Select(v -> (v, ' ')));
      dist[source] := 0;
      
      var q := vertices.ToHashSet;
      var neighbours := Dict(vertices.Select(v -> (v, new HashSet<(char, real)>)));
      
      foreach var edge in edges do
      begin
        neighbours[edge.start].Add((edge.end, edge.cost));
        neighbours[edge.end].Add((edge.start, edge.cost));
      end;
      
      while q.Count > 0 do
      begin
        var u := q.MinBy(v -> dist[v]);
        q.Remove(u);
        
        if (dist[u] = inf) or (u = dest) then
          break;
        
        foreach var (v, cost) in neighbours[u] do
        begin
          var alt := dist[u] + cost;
          if alt < dist[v] then
          begin
            dist[v] := alt;
            previous[v] := u;
          end;
        end;
      end;
      
      var s := new List<char>;
      var u := dest;
      
      while previous[u] <> ' ' do
      begin
        s.Insert(0, u);
        u := previous[u];
      end;
      
      s.Insert(0, u);
      Result := s;
    end;
  end;

begin
  var gr := new Graph(
    ('a', 'b', 7.0), ('a', 'c', 9.0), ('a', 'f', 14.0),
    ('b', 'c', 10.0), ('b', 'd', 15.0), ('c', 'd', 11.0),
    ('c', 'f', 2.0), ('d', 'e', 6.0), ('e', 'f', 9.0)
  );

  gr.Dijkstra('a', 'e').Println;  // Результат: ['a', 'c', 'f', 'e']
end.

Рисуем псевдографикой

Замечательная программа неизвестного автора на Rosetta Code.

// https://rosettacode.org/wiki/One-dimensional_cellular_automata#PascalABC.NET

А мы в Rosetta Code на 65 месте с 589 решениями!

##
var gen := '_###_##_#_#_#_#__#__'.Select(ch -> (if ch = '#' then 1 else 0)).ToList;
loop 10 do
begin
  gen.Select(n -> (if n = 1 then '#' else '_')).Println;
  gen := (0 + gen + 0).ToList;
  gen := (1..gen.Count - 2).Select(m -> (if gen[m - 1:m + 2].Sum = 2 then 1 else 0)).ToList;
end;