Манипуляция csv-файлами

В PascalABC.NET нет модуля манипуляции csv-файлами, но это можно легко сделать

begin
  var lines := ReadLines('data.csv').Select((line,i) -> begin
    if i = 0 then 
      Result := line + ',SUM'
    else Result := line + ',' + line.Split(',').Sum(x -> x.ToInteger);
  end);
  WriteLines('outdata.csv',lines);
  lines.PrintLines;
end.

Исходный файл:

C1,C2,C3,C4,C5
1,5,9,13,17
2,6,10,14,18
3,7,11,15,19
4,8,12,16,20

Результат:

C1,C2,C3,C4,C5,SUM
1,5,9,13,17,45
2,6,10,14,18,50
3,7,11,15,19,55
4,8,12,16,20,60

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

Изменения, связанные со словарями

Готовимся к версии 3.10.

Из Kotlinа перекочевал ряд методов, конструкций и операций со словарями.

begin
  // Новая операция 1 to 2 - синоним KV(1,2)
  var d := Dict('cat' to 'кошка', 'dog' to 'собака');
  // Новая функция Pair - синоним KV
  var d0 := Dict(Pair('cat', 'кот'), Pair('camel', 'верблюд'));
  // Более сложная структура
  var dd := Dict('Иванов' to |5, 3, 3|, 'Петров' to |4, 4|);
  // Копия словаря
  var d1 := Dict(d);
  // Инициализация массивами ключей и значений
  var d2 := Dict(|11, 22|, |333, 444|);
  // Обновление значений и добавление новых
  d.Update(d0);
  // То же
  d += d0;
  // Слияние словарей
  var d3 := d + Dict('world' to 'мир', 'cloud' to 'облако');
  Println(d3);
  // Вычитание пар с данными ключами
  d3 -= Seq('cat', 'camel');
  Println(d3);
  d3 := d3 - 'world';
  Println(d3);
end.

Вывод:

{(cat,кот),(dog,собака),(camel,верблюд),(world,мир),(cloud,облако)}
{(dog,собака),(world,мир),(cloud,облако)}
{(dog,собака),(cloud,облако)}

#новое

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

Архимедова спираль имеет очень простые параметрические уравнения: 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

WPF - пример с радиокнопками

Новые элементы и методы в модуле WPF. Радиокнопки, граница, метод Bordered.

uses WPF;

begin
  MainWindow.FontSize := 16;
  MainWindow.Title := 'Радиокнопки, Border, Bordered, три панели';
  var grid := Panels.Grid(1,3);
  MainWindow.Content := grid;
  
  var st0 := Panels.StackPanel(Margin := 10, HAlign := HA.Center, VAlign := VA.Center);
  var rbs := Controls.RadioButtons(|'Alpha','Beta','Gamma','Delta'|, GroupName := 'GreekLetters');
  rbs[1].IsChecked := True;
  st0.AddElements(rbs);

  var st1 := Panels.StackPanel(Margin := 10, HAlign := HA.Center, VAlign := VA.Center);
  var rbs1 := Controls.RadioButtons(|'One','Two','Three','Four','Five'|, GroupName := 'Numbers');
  rbs1[0].IsChecked := True;
  st1.AddElements(rbs1);
  
  grid.Add(st0.Bordered(3,Brushes.Blue,20),0,0);
  grid.Add(Controls.Border(Background := Brushes.LightGreen, Margin := |0,20,0,20|),0,1);
  grid.Add(st1.Bordered(3,Brushes.Blue,20),0,2);
end.

Количество простых делителей и простых факторов в натуральном числе
Изменения в библиотеке School

Английское слово factor означает "множитель". От него берут свои названия и факториал, и факторизация.
Факториал натурального числа n, как известно, есть произведение всех натуральных чисел от единицы до n включительно. В факториале каждый сомножитель и есть тот самый "фактор".
Под факторизацией натурального числа n понимается его возможное представление в виде некоторого количества сомножителей, опять же, "факторов". Нас будут интересовать только такие сомножители-факторы, которые являются простыми числами.
Основная теорема арифметики гласит, что любое натуральное число большее единицы может быть представлено в виде произведения простых множителей, причём единственным образом, с точностью до порядка множителей. Процесс нахождения всех таких множителей для натурального числа n называется факторизацией. Для простых чисел приведенное выше определение оказывается неточным, ведь у простого числа только два делителя - единица и само это число. Вот только единица не является простым числом.

За факторизацию в библиотеке School отвечает функция Factorize( ). Знак числа она игнорирует. Для n = 0 возвращается 0, для n = 1 возвращается 1, для простого n возвращается n. Если абсолютное значение составного числа больше 3, возвращается список, содержащий все простые сомножители-факторы в порядке неубывания. Например, для n = 4 возвращается [2,2], а для n = 6 возвращается [2,3].

Функция PrimeDivisorsCount(n) возвращает количество уникальных сомножителей из списка, полученного при факторизации. Для n = 4 возвращается 1, для n = 6 возвращается 2. Для n < 2 возвращается ноль.

Функция PrimeFactorsCount(n) возвращает общее количество сомножителей из списка, полученного при факторизации. Для n = 4 возвращается 2, для n = 6 также возвращается 2. Для n < 2 возвращается ноль.

Все три вышеупомянутые функции имеют расширения, позволяющее встраивать их в цепочки с точечной нотацией:
n.Factorize, n.PrimeDivisorsCount, n.PrimeFactorsCount.

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

## uses School;

foreach var n in Range(-2, 16) + Range(MaxInt, Maxint - 10, -1) do
  Println(n, n.Factorize, n.PrimeFactorsCount, n.PrimeDivisorsCount);

{
-2 [2] 0 0
-1 [1] 0 0
0 [0] 0 0
1 [1] 0 0
2 [2] 1 1
3 [3] 1 1
4 [2,2] 2 1
5 [5] 1 1
6 [2,3] 2 2
7 [7] 1 1
8 [2,2,2] 3 1
9 [3,3] 2 1
10 [2,5] 2 2
11 [11] 1 1
12 [2,2,3] 3 2
13 [13] 1 1
14 [2,7] 2 2
15 [3,5] 2 2
16 [2,2,2,2] 4 1
2147483647 [2147483647] 1 1
2147483646 [2,3,3,7,11,31,151,331] 8 7
2147483645 [5,19,22605091] 3 3
2147483644 [2,2,233,1103,2089] 5 4
2147483643 [3,715827881] 2 2
2147483642 [2,23,46684427] 3 3
2147483641 [2699,795659] 2 2
2147483640 [2,2,2,3,5,29,43,113,127] 9 7
2147483639 [7,17,18046081] 3 3
2147483638 [2,2969,361651] 3 3
2147483637 [3,3,3,13,6118187] 5 3
}

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

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

Изначально тест был написан на 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!

Внешние функции Zip и Cartesian

В стандартной библиотеке реализованы внешние функции Zip и Cartesian с количеством последовательностей от 2 до 5 и необязательной функцией проекции

#новое

Внимание! Изменения в библиотеке School! Начиная с версии 3.9.0.3522 от 02.08.2024 в библиотеку добавлены функции (и расширения к ним) PrimeFactors(n) и PrineFactorsCount(n), соответственно возвращающие список всех простых факторов (делителей) числа n и количество всех простых факторов. Функции (и расширения к ним) PrimeDivisors(n) и PrimeDivisorsCount(n) возвращают соответственно список и количество уникальных простых делителей числа n. Функция (и ее расширение) Factorize(n) теперь является синонимом функции PrimeFactors(n).

Как преобразовать значение одного обобщенного типа к другому обобщенному типу

На скриншоте показано, как это сделать. Используется класс Convert. ТипыTFrom и TTo не связаны наследованием. Возможно исключение времени выполнения.

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

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

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 место!

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