Task: Rare numbers



C#: using System;
using System.Collections.Generic;
using System.Linq;
using static System.Console;
using UI = System.UInt64;
using LST = System.Collections.Generic.List<System.Collections.Generic.List<sbyte>>;
using Lst = System.Collections.Generic.List<sbyte>;
using DT = System.DateTime;

class Program {

    const sbyte MxD = 19;

    public struct term { public UI coeff; public sbyte a, b;
        public term(UI c, int a_, int b_) { coeff = c; a = (sbyte)a_; b = (sbyte)b_; } }

    static int[] digs;   static List<UI> res;   static sbyte count = 0;
    static DT st; static List<List<term>> tLst; static List<LST> lists;
    static Dictionary<int, LST> fml, dmd; static Lst dl, zl, el, ol, il;
    static bool odd; static int nd, nd2; static LST ixs;
    static int[] cnd, di; static LST dis; static UI Dif;

    
    static UI ToDif() { UI r = 0; for (int i = 0; i < digs.Length; i++)
            r = r * 10 + (uint)digs[i]; return r; }
    
    
    static UI ToSum() { UI r = 0; for (int i = digs.Length - 1; i >= 0; i--)
            r = r * 10 + (uint)digs[i]; return Dif + (r << 1); }

    
    static bool IsSquare(UI nmbr) { if ((0x202021202030213 & (1 << (int)(nmbr & 63))) != 0)
        { UI r = (UI)Math.Sqrt((double)nmbr); return r * r == nmbr; } return false; }

    
    static Lst Seq(sbyte from, int to, sbyte stp = 1) { Lst res = new Lst();
        for (sbyte item = from; item <= to; item += stp) res.Add(item); return res; }

    
    static void Fnpr(int lev) { if (lev == dis.Count) { digs[ixs[0][0]] = fml[cnd[0]][di[0]][0];
            digs[ixs[0][1]] = fml[cnd[0]][di[0]][1]; int le = di.Length, i = 1;
            if (odd) digs[nd >> 1] = di[--le]; foreach (sbyte d in di.Skip(1).Take(le - 1)) {
                digs[ixs[i][0]] = dmd[cnd[i]][d][0]; digs[ixs[i][1]] = dmd[cnd[i++]][d][1]; }
            if (!IsSquare(ToSum())) return; res.Add(ToDif()); WriteLine("{0,16:n0}{1,4}   ({2:n0})",
                (DT.Now - st).TotalMilliseconds, ++count, res.Last()); }
        else foreach (var n in dis[lev]) { di[lev] = n; Fnpr(lev + 1); } }

    
    static void Fnmr (LST list, int lev) { if (lev == list.Count) { Dif = 0; sbyte i = 0;
            foreach (var t in tLst[nd2]) { if (cnd[i] < 0) Dif -= t.coeff * (UI)(-cnd[i++]);
                else Dif += t.coeff * (UI)cnd[i++]; } if (Dif <= 0 || !IsSquare(Dif)) return;
            dis = new LST { Seq(0, fml[cnd[0]].Count - 1) };
            foreach (int ii in cnd.Skip(1)) dis.Add(Seq(0, dmd[ii].Count - 1));
            if (odd) dis.Add(il); di = new int[dis.Count]; Fnpr(0);
        } else foreach(sbyte n in list[lev]) { cnd[lev] = n; Fnmr(list, lev + 1); } }

    static void init() { UI pow = 1;
        
        tLst = new List<List<term>>(); foreach (int r in Seq(2, MxD)) {
            List<term> terms = new List<term>(); pow *= 10; UI p1 = pow, p2 = 1;
            for (int i1 = 0, i2 = r - 1; i1 < i2; i1++, i2--) {
                terms.Add(new term(p1 - p2, i1, i2)); p1 /= 10; p2 *= 10; }
            tLst.Add(terms); }
        
        fml = new Dictionary<int, LST> {
            [0] = new LST { new Lst { 2, 2 }, new Lst { 8, 8 } },
            [1] = new LST { new Lst { 6, 5 }, new Lst { 8, 7 } },
            [4] = new LST { new Lst { 4, 0 } },
            [6] = new LST { new Lst { 6, 0 }, new Lst { 8, 2 } } };
        
        dmd = new Dictionary<int, LST>();
        for (sbyte i = 0; i < 10; i++) for (sbyte j = 0, d = i; j < 10; j++, d--) {
                if (dmd.ContainsKey(d)) dmd[d].Add(new Lst { i, j });
                else dmd[d] = new LST { new Lst { i, j } }; }
        dl = Seq(-9, 9);    
        zl = Seq( 0, 0);    
        el = Seq(-8, 8, 2); 
        ol = Seq(-9, 9, 2); 
        il = Seq( 0, 9); lists = new List<LST>();
        foreach (sbyte f in fml.Keys) lists.Add(new LST { new Lst { f } }); }

    static void Main(string[] args) { init(); res = new List<UI>(); st = DT.Now; count = 0;
        WriteLine("{0,5}{1,12}{2,4}{3,14}", "digs", "elapsed(ms)", "R/N", "Unordered Rare Numbers");
        for (nd = 2, nd2 = 0, odd = false; nd <= MxD; nd++, nd2++, odd = !odd) { digs = new int[nd];
            if (nd == 4) { lists[0].Add(zl); lists[1].Add(ol); lists[2].Add(el); lists[3].Add(ol); }
            else if (tLst[nd2].Count > lists[0].Count) foreach (LST list in lists) list.Add(dl);
            ixs = new LST(); 
            foreach (term t in tLst[nd2]) ixs.Add(new Lst { t.a, t.b });
            foreach (LST list in lists) { cnd = new int[list.Count]; Fnmr(list, 0); }
            WriteLine("  {0,2}  {1,10:n0}", nd, (DT.Now - st).TotalMilliseconds); }
        res.Sort();
        WriteLine("\nThe {0} rare numbers with up to {1} digits are:", res.Count, MxD);
        count = 0; foreach (var rare in res) WriteLine("{0,2}:{1,27:n0}", ++count, rare);
        if (System.Diagnostics.Debugger.IsAttached) ReadKey(); }
}






VB: Imports System.Console
Imports DT = System.DateTime
Imports Lsb = System.Collections.Generic.List(Of SByte)
Imports Lst = System.Collections.Generic.List(Of System.Collections.Generic.List(Of SByte))
Imports UI = System.UInt64

Module Module1
    Const MxD As SByte = 15

    Public Structure term
        Public coeff As UI : Public a, b As SByte
        Public Sub New(ByVal c As UI, ByVal a_ As Integer, ByVal b_ As Integer)
            coeff = c : a = CSByte(a_) : b = CSByte(b_)
        End Sub
    End Structure

    Dim nd, nd2, count As Integer, digs, cnd, di As Integer()
    Dim res As List(Of UI), st As DT, tLst As List(Of List(Of term))
    Dim lists As List(Of Lst), fml, dmd As Dictionary(Of Integer, Lst)
    Dim dl, zl, el, ol, il As Lsb, odd As Boolean, ixs, dis As Lst, Dif As UI

    
    Function ToDif() As UI
        Dim r As UI = 0 : For i As Integer = 0 To digs.Length - 1 : r = r * 10 + digs(i)
        Next : Return r
    End Function

    
    Function ToSum() As UI
        Dim r As UI = 0 : For i As Integer = digs.Length - 1 To 0 Step -1 : r = r * 10 + digs(i)
        Next : Return Dif + (r << 1)
    End Function

    
    Function IsSquare(nmbr As UI) As Boolean
        If (&H202021202030213 And (1UL << (nmbr And 63))) <> 0 Then _
            Dim r As UI = Math.Sqrt(nmbr) : Return r * r = nmbr Else Return False
    End Function

    
    Function Seq(from As SByte, upto As Integer, Optional stp As SByte = 1) As Lsb
        Dim res As Lsb = New Lsb()
        For item As SByte = from To upto Step stp : res.Add(item) : Next : Return res
    End Function

    
    Sub Fnpr(ByVal lev As Integer)
        If lev = dis.Count Then
            digs(ixs(0)(0)) = fml(cnd(0))(di(0))(0) : digs(ixs(0)(1)) = fml(cnd(0))(di(0))(1)
            Dim le As Integer = di.Length, i As Integer = 1
            If odd Then le -= 1 : digs(nd >> 1) = di(le)
            For Each d As SByte In di.Skip(1).Take(le - 1)
                digs(ixs(i)(0)) = dmd(cnd(i))(d)(0)
                digs(ixs(i)(1)) = dmd(cnd(i))(d)(1) : i += 1 : Next
            If Not IsSquare(ToSum()) Then Return
            res.Add(ToDif()) : count += 1
            WriteLine("{0,16:n0}{1,4}   ({2:n0})", (DT.Now - st).TotalMilliseconds, count, res.Last())
        Else
            For Each n In dis(lev) : di(lev) = n : Fnpr(lev + 1) : Next
        End If
    End Sub

    
    Sub Fnmr(ByVal list As Lst, ByVal lev As Integer)
        If lev = list.Count Then
            Dif = 0 : Dim i As SByte = 0 : For Each t In tLst(nd2)
                If cnd(i) < 0 Then Dif -= t.coeff * CULng(-cnd(i)) _
                              Else Dif += t.coeff * CULng(cnd(i))
                i += 1 : Next
            If Dif <= 0 OrElse Not IsSquare(Dif) Then Return
            dis = New Lst From {Seq(0, fml(cnd(0)).Count - 1)}
            For Each i In cnd.Skip(1) : dis.Add(Seq(0, dmd(i).Count - 1)) : Next
            If odd Then dis.Add(il)
            di = New Integer(dis.Count - 1) {} : Fnpr(0)
        Else
            For Each n As SByte In list(lev) : cnd(lev) = n : Fnmr(list, lev + 1) : Next
        End If
    End Sub

    Sub init()
        Dim pow As UI = 1
        
        tLst = New List(Of List(Of term))() : For Each r As Integer In Seq(2, MxD)
            Dim terms As List(Of term) = New List(Of term)()
            pow *= 10 : Dim p1 As UI = pow, p2 As UI = 1
            Dim i1 As Integer = 0, i2 As Integer = r - 1
            While i1 < i2 : terms.Add(New term(p1 - p2, i1, i2))
                p1 = p1 / 10 : p2 = p2 * 10 : i1 += 1 : i2 -= 1 : End While
            tLst.Add(terms) : Next
        
        fml = New Dictionary(Of Integer, Lst)() From {
            {0, New Lst() From {New Lsb() From {2, 2}, New Lsb() From {8, 8}}},
            {1, New Lst() From {New Lsb() From {6, 5}, New Lsb() From {8, 7}}},
            {4, New Lst() From {New Lsb() From {4, 0}}},
            {6, New Lst() From {New Lsb() From {6, 0}, New Lsb() From {8, 2}}}}
        
        dmd = New Dictionary(Of Integer, Lst)()
        For i As SByte = 0 To 10 - 1 : Dim j As SByte = 0, d As SByte = i
            While j < 10 : If dmd.ContainsKey(d) Then dmd(d).Add(New Lsb From {i, j}) _
                Else dmd(d) = New Lst From {New Lsb From {i, j}}
                j += 1 : d -= 1 : End While : Next
        dl = Seq(-9, 9)    
        zl = Seq(0, 0)     
        el = Seq(-8, 8, 2) 
        ol = Seq(-9, 9, 2) 
        il = Seq(0, 9)
        lists = New List(Of Lst)()
        For Each f As SByte In fml.Keys : lists.Add(New Lst From {New Lsb From {f}}) : Next
    End Sub

    Sub Main(ByVal args As String())
        init() : res = New List(Of UI)() : st = DT.Now : count = 0
        WriteLine("{0,5}{1,12}{2,4}{3,14}", "digs", "elapsed(ms)", "R/N", "Rare Numbers")
        nd = 2 : nd2 = 0 : odd = False : While nd <= MxD
            digs = New Integer(nd - 1) {} : If nd = 4 Then
                lists(0).Add(zl) : lists(1).Add(ol) : lists(2).Add(el) : lists(3).Add(ol)
            ElseIf tLst(nd2).Count > lists(0).Count Then
                For Each list As Lst In lists : list.Add(dl) : Next : End If
            ixs = New Lst() : For Each t As term In tLst(nd2) : ixs.Add(New Lsb From {t.a, t.b}) : Next
            For Each list As Lst In lists : cnd = New Integer(list.Count - 1) {} : Fnmr(list, 0) : Next
            WriteLine("  {0,2}  {1,10:n0}", nd, (DT.Now - st).TotalMilliseconds)
            nd += 1 : nd2 += 1 : odd = Not odd : End While
        res.Sort() : WriteLine(vbLf & "The {0} rare numbers with up to {1} digits are:", res.Count, MxD)
        count = 0 : For Each rare In res : count += 1 : WriteLine("{0,2}:{1,27:n0}", count, rare) : Next
        If System.Diagnostics.Debugger.IsAttached Then ReadKey()
    End Sub
End Module