' FB 1.05.0 Win64

Type IndexedWord
  As String word
  As Integer index
End Type

' selection sort, quick enough for sorting small number of letters
Sub sortWord(s As String)
  Dim As Integer i, j, m, n = Len(s)
  For i = 0 To n - 2
    m = i
    For j = i + 1 To n - 1
      If s[j] < s[m] Then m = j
    Next j
    If m <> i Then Swap s[i], s[m]
  Next i
End Sub

' quicksort for sorting whole dictionary of IndexedWord instances by sorted word
Sub quicksort(a() As IndexedWord, first As Integer, last As Integer)
  Dim As Integer length = last - first + 1
  If length < 2 Then Return
  Dim pivot As String = a(first + length\ 2).word
  Dim lft As Integer = first
  Dim rgt As Integer = last
  While lft <= rgt
    While a(lft).word < pivot
      lft +=1
    Wend
    While a(rgt).word > pivot
      rgt -= 1
    Wend
    If lft <= rgt Then
       Swap a(lft), a(rgt)
       lft += 1
       rgt -= 1
    End If
  Wend
  quicksort(a(), first, rgt)
  quicksort(a(), lft, last)
End Sub

Function isDeranged(s1 As String, s2 As String) As Boolean
  For i As Integer = 0 To Len(s1) - 1
    If s1[i] = s2[i] Then Return False
  Next
  Return True
End Function

Dim t As Double = timer
Dim As String w()  '' array to hold actual words
Open "undict.txt" For Input As #1
Dim count As Integer = 0
While Not Eof(1)
  count +=1
  Redim Preserve w(1 To count)
  Line Input #1, w(count)
Wend
Close #1

Dim As IndexedWord iw(1 To count) '' array to hold sorted words and their index into w()
Dim word As String
For i As Integer = 1 To count
  word = w(i)
  sortWord(word)
  iw(i).word = word
  iw(i).index = i
Next
quickSort iw(), 1, count  '' sort the IndexedWord array by sorted word

Dim As Integer startIndex = 1, maxLength, ub
Dim As Integer maxIndex()
Dim As IndexedWord iWord = iw(1)
maxLength = 0

For i As Integer = 2 To count
  If iWord.word = iw(i).word Then
    If isDeranged(w(iword.index), w(iw(i).index)) Then
      If startIndex + 1 < i Then Swap iw(i), iw(startIndex + 1)
      If Len(iWord.word) > maxLength Then
        maxLength = Len(iWord.word)
        Erase maxIndex
        ub = 1
        Redim maxIndex(1 To ub)
        maxIndex(ub) = startIndex
        startIndex += 2
        i = startIndex
        iWord = iw(i)
      ElseIf Len(iWord.word) = maxLength Then
        ub += 1
        Redim Preserve maxIndex(1 To ub)
        maxIndex(ub) = startIndex
        startIndex += 2
        i = startIndex
        iWord = iw(i)
      End If
    End If
  ElseIf i = count Then
    Exit For
  Else
    For j As Integer = i To count - 1
      iWord = iw(j)
      If Len(iWord.word) >= maxLength Then
        startIndex = j
        i = startIndex
        Exit For
      End If
    Next
  End If
Next

Print Str(count); " words in the dictionary"
Print "The deranged anagram pair(s) with the greatest length (namely"; maxLength; ") is:"
Print
Dim iws(1 To maxLength) As IndexedWord  '' array to hold each deranged anagram pair
For i As Integer = 1 To UBound(maxIndex)
  For j As Integer = maxIndex(i) To maxIndex(i) + 1
    iws(j - maxIndex(i) + 1) = iw(j)
  Next j
  If iws(1).index > iws(2).index Then swap iws(1), iws(2) '' ensure pair is in correct order
  For j As Integer = 1 To 2
    Print w(iws(j).index); " ";
  Next j
  Print
Next i

Print
Print "Took ";
Print Using "#.###"; timer - t;
Print " seconds on i3 @ 2.13 GHz"

Print
Print "Press any key to quit"
Sleep


void setup() {
  for (int i = 1; i <= 5; i++) {
    int count = 0;
    print("k = " + i + ": ");
    int n = 2;
    while (count < 10) {
      if (isAlmostPrime(i, n)) {
        count++;
        print(n + " ");
      }
      n++;
    }
    println();
  }
}

boolean isAlmostPrime(int k, int n) {
  if (countPrimeFactors(n) == k) {
    return true;
  } else {
    return false;
  }
}

int countPrimeFactors(int n) {
  int count = 0;
  int i = 2;
  while (n > 1) {
    if (n % i == 0) {
      n /= i;
      count++;
    } else {
      i++;
    }
  }
  return count;
}


EnableExplicit

Procedure.b kprime(n.i, k.i)
  Define p.i = 2,
         f.i = 0

  While f < k And p*p <= n
    While n % p = 0
      n / p
      f + 1
    Wend
    p + 1
  Wend

  ProcedureReturn Bool(f + Bool(n > 1) = k)

EndProcedure

;___main____
If Not OpenConsole("Almost prime")
  End -1
EndIf

Define i.i,
       c.i,
       k.i

For k = 1 To 5
  Print("k = " + Str(k) + ":")

  i = 2
  c = 0
  While c < 10
    If kprime(i, k)
      Print(RSet(Str(i),4))
      c + 1
    EndIf
    i + 1
  Wend
  PrintN("")
Next

Input()


(ns example
  (:gen-class))

(defn factors [n]
  " Find the proper factors of a number "
  (into (sorted-set)
        (mapcat (fn [x] (if (= x 1) [x] [x (/ n x)]))
                (filter #(zero? (rem n %)) (range 1 (inc (Math/sqrt n)))) )))

(def find-pairs (into #{}
               (for [n (range  2 20000)
                  :let [f (factors n)     ; Factors of n
                        M (apply + f)     ; Sum of factors
                        g (factors M)     ; Factors of sum
                        N (apply + g)]    ; Sum of Factors of sum
                  :when (= n N)           ; (sum(proDivs(N)) = M and sum(propDivs(M)) = N
                  :when (not= M N)]       ; N not-equal M
                 (sorted-set n M))))      ; Found pair

;; Output Results
(doseq [q find-pairs]
  (println q))


% Generate proper divisors from 1 to max
proper_divisors = proc (max: int) returns (array[int])
    divs: array[int] := array[int]$fill(1, max, 0)
    for i: int in int$from_to(1, max/2) do
        for j: int in int$from_to_by(i*2, max, i) do
            divs[j] := divs[j] + i
        end
    end
    return(divs)
end proper_divisors

% Are A and B and amicable pair, given the proper divisors?
amicable = proc (divs: array[int], a, b: int) returns (bool)
    return(divs[a] = b & divs[b] = a)
end amicable

% Find all amicable pairs up to 20 000
start_up = proc ()
    max = 20000
    po: stream := stream$primary_output()
    divs: array[int] := proper_divisors(max)

    for a: int in int$from_to(1, max) do
        for b: int in int$from_to(a+1, max) do
            if amicable(divs, a, b) then
                stream$putl(po, int$unparse(a) || ", " || int$unparse(b))
            end
        end
    end
end start_up


IsDeranged := function(a, b)
	local i, n;
	for i in [1 .. Size(a)] do
		if a[i] = b[i] then
			return false;
		fi;
	od;
	return true;
end;

# This solution will find all deranged pairs of any length.
Deranged := function(name)
	local sol, ana, u, v;
	sol := [ ];
	ana := Anagrams(name);
	for u in ana do
		for v in Combinations(u, 2) do
			if IsDeranged(v[1], v[2]) then
				Add(sol, v);
			fi;
		od;
	od;
	return sol;
end;

# Now we find all deranged pairs of maximum length
a := Deranged("unixdict.txt");;
n := Maximum(List(a, x -> Size(x[1])));
Filtered(a, x -> Size(x[1]) = n);
# [ [ "excitation", "intoxicate" ] ]


package main
import (
	"fmt"
	"io/ioutil"
	"strings"
	"sort"
)

func deranged(a, b string) bool {
	if len(a) != len(b) {
		return false
	}
	for i := range(a) {
		if a[i] == b[i] { return false }
	}
	return true
}

func main() {
	/* read the whole thing in. how big can it be? */
	buf, _ := ioutil.ReadFile("unixdict.txt")
	words := strings.Split(string(buf), "\n")

	m := make(map[string] []string)
	best_len, w1, w2 := 0, "", ""

	for _, w := range(words) {
		// don't bother: too short to beat current record
		if len(w) <= best_len { continue }

		// save strings in map, with sorted string as key
		letters := strings.Split(w, "")
		sort.Strings(letters)
		k := strings.Join(letters, "")

		if _, ok := m[k]; !ok {
			m[k] = []string { w }
			continue
		}

		for _, c := range(m[k]) {
			if deranged(w, c) {
				best_len, w1, w2 = len(w), c, w
				break
			}
		}

		m[k] = append(m[k], w)
	}

	fmt.Println(w1, w2, ": Length", best_len)
}


from prime_decomposition import decompose
from itertools import islice, count
try:
    from functools import reduce
except:
    pass

def almostprime(n, k=2):
    d = decompose(n)
    try:
        terms = [next(d) for i in range(k)]
        return reduce(int.__mul__, terms, 1) == n
    except:
        return False

if __name__ == '__main__':
    for k in range(1,6):
        print('%i: %r' % (k, list(islice((n for n in count() if almostprime(n, k)), 10))))


  [ stack ]                    is quantity     (     --> s )
  [ stack ]                    is factors      (     --> s )

  [ factors put
    quantity put
    [] 1
    [ over size
      quantity share != while
      1+ dup primefactors
      size factors share = if
        [ tuck join swap ]
      again ]
    drop
    factors release
    quantity release ]         is almostprimes ( n n --> [ )

  5 times
    [ 10 i^ 1+ dup echo sp
      almostprimes echo cr ]


(let ((cache (make-hash-table)))
  (defun sum-proper-divisors (n)
    (or (gethash n cache)
        (setf (gethash n cache)
              (loop for x from 1 to (/ n 2)
                    when (zerop (rem n x))
                      sum x)))))

(defun amicable-pairs-up-to (n)
  (loop for x from 1 to n
        for sum-divs = (sum-proper-divisors x)
        when (and (< x sum-divs) (= x (sum-proper-divisors sum-divs)))
          collect (list x sum-divs)))

(amicable-pairs-up-to 20000)


include "cowgol.coh";

const LIMIT := 20000;

# Calculate sums of proper divisors
var divSum: uint16[LIMIT + 1];
var i: @indexof divSum;
var j: @indexof divSum;

i := 2;
while i <= LIMIT loop
    divSum[i] := 1;
    i := i + 1;
end loop;

i := 2;
while i <= LIMIT/2 loop
    j := i * 2;
    while j <= LIMIT loop
        divSum[j] := divSum[j] + i;
        j := j + i;
    end loop;
    i := i + 1;
end loop;

# Test each pair
i := 2;
while i <= LIMIT loop
    j := i + 1;
    while j <= LIMIT loop
        if divSum[i] == j and divSum[j] == i then
            print_i32(i as uint32);
            print(", ");
            print_i32(j as uint32);
            print_nl();
        end if;
        j := j + 1;
    end loop;
    i := i + 1;
end loop;


def map = new TreeMap<Integer,Map<String,List<String>>>()

new URL('http://www.puzzlers.org/pub/wordlists/unixdict.txt').eachLine { word ->
    def size = - word.size()
    map[size] = map[size] ?: new TreeMap<String,List<String>>()
    def norm = word.toList().sort().sum()
    map[size][norm] = map[size][norm] ?: []
    map[size][norm] << word
}

def result = map.findResult { negasize, normMap ->
    def size = - negasize
    normMap.findResults { x, anagrams ->
        def n = anagrams.size()
        (0..<(n-1)).findResults { i ->
            ((i+1)..<n).findResult { j ->
                (0..<size).every { k -> anagrams[i][k] != anagrams[j][k] } \
                    ? anagrams[i,j]
                    : null
            }
        }?.flatten() ?: null
    }?.flatten() ?: null
}

if (result) {
    println "Longest deranged anagram pair: ${result}"
} else {
    println 'Deranged anagrams are a MYTH!'
}


void main() @safe /*@nogc*/ {
    import std.stdio, std.algorithm, std.range, std.typecons, std.array;

    immutable properDivs = (in uint n) pure nothrow @safe /*@nogc*/ =>
        iota(1, (n + 1) / 2 + 1).filter!(x => n % x == 0);

    enum rangeMax = 20_000;
    auto n2d = iota(1, rangeMax + 1).map!(n => properDivs(n).sum);

    foreach (immutable n, immutable divSum; n2d.enumerate(1))
        if (n < divSum && divSum <= rangeMax && n2d[divSum - 1] == n)
            writefln("Amicable pair: %d and %d with proper divisors:\n    %s\n    %s",
                     n, divSum, properDivs(n), properDivs(divSum));
}


/* Fill a given array such that for each N,
 * P[n] is the sum of proper divisors of N */
proc nonrec propdivs([*] word p) void:
    word i, j, max;
    max := dim(p,1)-1;
    for i from 0 upto max do p[i] := 0 od;
    for i from 1 upto max/2 do
        for j from i*2 by i upto max do
            p[j] := p[j] + i
        od
    od
corp

/* Find all amicable pairs between 0 and 20,000 */
proc nonrec main() void:
    word MAX = 20000;
    word i, j;
    [MAX] word p;
    propdivs(p);

    for i from 1 upto MAX-1 do
        for j from i+1 upto MAX-1 do
            if p[i]=j and p[j]=i then
                writeln(i:5, ", ", j:5)
            fi
        od
    od
corp


{-# LANGUAGE TupleSections #-}

import Data.List (maximumBy, sort, unfoldr)
import Data.Ord (comparing)
import qualified Data.Map as M
import qualified Data.Set as S

-- Lists of words grouped by their "signatures".  A signature is a sorted
-- list of characters.  Duplicate words stored in sets.
groupBySig :: [String] -> [(String, S.Set String)]
groupBySig = map ((,) . sort <*> S.singleton)

-- Groups as lists of equivalent words.
equivs :: [(String, S.Set String)] -> [[String]]
equivs = map (S.toList . snd) . M.toList . M.fromListWith S.union

-- True if a pair of words differs in all character positions.
isDerangement :: (String, String) -> Bool
isDerangement (a, b) = and $ zipWith (/=) a b

-- All pairs of elements, ignoring order.
pairs :: [t] -> [(t, t)]
pairs = concat . unfoldr step
  where
    step (x:xs) = Just (map (x, ) xs, xs)
    step [] = Nothing

-- All anagram pairs in the input string.
anagrams :: [String] -> [(String, String)]
anagrams = concatMap pairs . equivs . groupBySig

-- The pair of words forming the longest deranged anagram.
maxDerangedAnagram :: [String] -> Maybe (String, String)
maxDerangedAnagram = maxByLen . filter isDerangement . anagrams
  where
    maxByLen [] = Nothing
    maxByLen xs = Just $ maximumBy (comparing (length . fst)) xs

main :: IO ()
main = do
  input <- readFile "unixdict.txt"
  case maxDerangedAnagram $ words input of
    Nothing -> putStrLn "No deranged anagrams were found."
    Just (a, b) -> putStrLn $ "Longest deranged anagrams: " <> a <> " and " <> b


#lang racket
(require (only-in math/number-theory factorize))

(define ((k-almost-prime? k) n)
  (= k (for/sum ((f (factorize n))) (cadr f))))

(define KAP-table-values
  (for/list ((k (in-range 1 (add1 5))))
    (define kap? (k-almost-prime? k))
    (for/list ((j (in-range 10)) (i (sequence-filter kap? (in-naturals 1))))
      i)))

(define (format-table t)
  (define longest-number-length
    (add1 (order-of-magnitude (argmax order-of-magnitude (cons (length t) (apply append t))))))
  (define (fmt-val v) (~a v #:width longest-number-length #:align 'right))
  (string-join
   (for/list ((r t) (k (in-naturals 1)))
     (string-append
      (format "║ k = ~a║ " (fmt-val k))
      (string-join (for/list ((c r)) (fmt-val c)) "| ")
      "║"))
   "\n"))

(displayln (format-table KAP-table-values))


link strings     # for csort() procedure

procedure main()
    anagrams := table()                     # build lists of anagrams
    every *(word := !&input) > 1 do {
        canon := csort(word)
        /anagrams[canon] := []
        put(anagrams[canon], word)
        }

    longest := 1                            # find a longest derangement
    every *(aList := !anagrams) > 1 do
        if derangement := derange(aList) then
            if longest <:= *derangement[1] then long := derangement

    every writes((!\long||" ")|"\n")        # show longest
end

procedure derange(aList)    # Return a single derangement from this list
    while aWord := get(aList) do return noMatch(aWord, !aList)
end

procedure noMatch(s1,s2)    # Produce pair only if s1,s2 are deranged.
    every i := 1 to *s1 do if s1[i] == s2[i] then fail
    return [s1,s2]
end


/*REXX program  computes and displays  the  first  N  K─almost  primes  from   1 ──► K. */
parse arg N K .                                  /*get optional arguments from the C.L. */
if N=='' | N==","  then N=10                     /*N  not specified?   Then use default.*/
if K=='' | K==","  then K= 5                     /*K   "      "          "   "     "    */
                                                 /*W: is the width of K, used for output*/
    do m=1  for  K;     $=2**m;  fir=$           /*generate & assign 1st K─almost prime.*/
    #=1;                if #==N  then leave      /*#: K─almost primes; Enough are found?*/
    #=2;                $=$  3*(2**(m-1))        /*generate & append 2nd K─almost prime.*/
    if #==N  then leave                          /*#: K─almost primes; Enough are found?*/
    if m==1  then _=fir + fir                    /* [↓]  gen & append 3rd K─almost prime*/
             else do;  _=9 * (2**(m-2));    #=3;    $=$  _;    end
        do j=_ + m - 1   until #==N              /*process an  K─almost prime  N  times.*/
        if factr()\==m  then iterate             /*not the correct  K─almost  prime?    */
        #=# + 1;         $=$ j                   /*bump K─almost counter; append it to $*/
        end   /*j*/                              /* [↑]   generate  N  K─almost  primes.*/
    say right(m, length(K))"─almost ("N') primes:'     $
    end       /*m*/                              /* [↑]  display a line for each K─prime*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
factr: z=j;                    do f=0  while z// 2==0;  z=z% 2;  end  /*divisible by  2.*/
                               do f=f  while z// 3==0;  z=z% 3;  end  /*divisible  "  3.*/
                               do f=f  while z// 5==0;  z=z% 5;  end  /*divisible  "  5.*/
                               do f=f  while z// 7==0;  z=z% 7;  end  /*divisible  "  7.*/
                               do f=f  while z//11==0;  z=z%11;  end  /*divisible  " 11.*/
                               do f=f  while z//13==0;  z=z%13;  end  /*divisible  " 13.*/
         do p=17  by 6  while  p<=z              /*insure  P  isn't divisible by three. */
         parse var  p   ''  -1  _                /*obtain the right─most decimal digit. */
                                                 /* [↓]  fast check for divisible by 5. */
         if _\==5  then do; do f=f+1  while z//p==0; z=z%p; end;  f=f-1; end  /*÷ by P? */
         if _ ==3  then iterate                  /*fast check for  X  divisible by five.*/
         x=p+2;             do f=f+1  while z//x==0; z=z%x; end;  f=f-1       /*÷ by X? */
         end   /*i*/                             /* [↑]  find all the factors in  Z.    */

       if f==0  then return 1                    /*if  prime (f==0),  then return unity.*/
                     return f                    /*return to invoker the number of divs.*/


open monad io number list

divisors n = filter ((0 ==) << (n `mod`)) [1..(n `div` 2)]
range = [1 .. 20000]
divs = zip range $ map (sum << divisors) range
pairs = [(n, m) \\ (n, nd) <- divs, (m, md) <- divs | n < m && nd == m && md == n]

do putLn pairs ::: IO


import extensions;
import system'routines;

const int N = 20000;

extension op
{
    ProperDivisors
        = Range.new(1,self / 2).filterBy:(n => self.mod:n == 0);

    get AmicablePairs()
    {
        var divsums := Range
                         .new(0, self + 1)
                         .selectBy:(i => i.ProperDivisors.summarize(Integer.new()))
                         .toArray();

        ^ 1.repeatTill(divsums.Length)
            .filterBy:(i)
            {
                var ii := i;

                var sum := divsums[i];
                ^ (i < sum) && (sum < divsums.Length) && (divsums[sum] == i)
            }
            .selectBy:(i => new { Item1 = i; Item2 = divsums[i]; })
    }
}

public program()
{
    N.AmicablePairs.forEach:(pair)
    {
        console.printLine(pair.Item1, " ", pair.Item2)
    }
}


defmodule Proper do
  def divisors(1), do: []
  def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort

  defp divisors(k,_n,q) when k>q, do: []
  defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q)
  defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)]
  defp divisors(k,n,q)                , do: [k,div(n,k) | divisors(k+1,n,q)]
end

map = Map.new(1..20000, fn n -> {n, Proper.divisors(n) |> Enum.sum} end)
Enum.filter(map, fn {n,sum} -> map[sum] == n and n < sum end)
|> Enum.sort
|> Enum.each(fn {i,j} -> IO.puts "#{i} and #{j}" end)


   #words=: 'b' freads 'unixdict.txt'
25104
   #anagrams=: (#~ 1 < #@>) (</.~ /:~&>) words
1303
   #maybederanged=: (#~ (1 [email protected] #@~."1)@|:@:>&>) anagrams
432
   #longest=: (#~ [: (= >./) #@>@{[email protected]>) maybederanged
1
   longest
┌───────────────────────┐
│┌──────────┬──────────┐│
││excitation│intoxicate││
│└──────────┴──────────┘│
└───────────────────────┘


import java.io.File;
import java.io.IOException;
import java.nio.file.Files;
import java.util.ArrayList;
import java.util.Arrays;
import java.util.Comparator;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

public class DerangedAnagrams {

    public static void main(String[] args) throws IOException {
        List<String> words = Files.readAllLines(new File("unixdict.txt").toPath());
        printLongestDerangedAnagram(words);
    }

    private static void printLongestDerangedAnagram(List<String> words) {
        words.sort(Comparator.comparingInt(String::length).reversed().thenComparing(String::toString));

        Map<String, ArrayList<String>> map = new HashMap<>();
        for (String word : words) {
            char[] chars = word.toCharArray();
            Arrays.sort(chars);
            String key = String.valueOf(chars);

            List<String> anagrams = map.computeIfAbsent(key, k -> new ArrayList<>());
            for (String anagram : anagrams) {
                if (isDeranged(word, anagram)) {
                    System.out.printf("%s %s%n", anagram, word);
                    return;
                }
            }
            anagrams.add(word);
        }
        System.out.println("no result");
    }

    private static boolean isDeranged(String word1, String word2) {
        for (int i = 0; i < word1.length(); i++) {
            if (word1.charAt(i) == word2.charAt(i)) {
                return false;
            }
        }
        return true;
    }
}


for ap = 1 to 5
    see "k = " + ap + ":"
    aList = []
    for n = 1 to 200
        num = 0
        for nr = 1 to n
            if n%nr=0 and isPrime(nr)=1
               num = num + 1
               pr = nr
               while true
                     pr = pr * nr
                     if n%pr = 0
                        num = num + 1
                     else exit ok
               end ok
        next
        if (ap = 1 and isPrime(n) = 1) or (ap > 1 and num = ap)
           add(aList, n)
           if len(aList)=10 exit ok ok
     next
     for m = 1 to len(aList)
           see " " + aList[m]
     next
     see nl
next

func isPrime num
     if (num <= 1) return 0 ok
     if (num % 2 = 0 and num != 2) return 0 ok
     for i = 3 to floor(num / 2) -1 step 2
         if (num % i = 0) return 0 ok
     next
     return 1


require 'prime'

def almost_primes(k=2)
  return to_enum(:almost_primes, k) unless block_given?
  1.step {|n| yield n if n.prime_division.sum( &:last ) == k }
end

(1..5).each{|k| puts almost_primes(k).take(10).join(", ")}


fn is_kprime(n: u32, k: u32) -> bool {
    let mut primes = 0;
    let mut f = 2;
    let mut rem = n;
    while primes < k && rem > 1{
        while (rem % f) == 0 && rem > 1{
            rem /= f;
            primes += 1;
        }
        f += 1;
    }
    rem == 1 && primes == k
}

struct KPrimeGen {
    k: u32,
    n: u32,
}

impl Iterator for KPrimeGen {
    type Item = u32;
    fn next(&mut self) -> Option<u32> {
        self.n += 1;
        while !is_kprime(self.n, self.k) {
            self.n += 1;
        }
        Some(self.n)
    }
}

fn kprime_generator(k: u32) -> KPrimeGen {
    KPrimeGen {k: k, n: 1}
}

fn main() {
    for k in 1..6 {
        println!("{}: {:?}", k, kprime_generator(k).take(10).collect::<Vec<_>>());
    }
}


-module(properdivs).
-export([amicable/1,divs/1,sumdivs/1]).

amicable(Limit) -> amicable(Limit,[],3,2).

amicable(Limit,List,_Current,Acc) when Acc >= Limit -> List;
amicable(Limit,List,Current,Acc) when Current =< Acc/2  ->
    amicable(Limit,List,Acc,Acc+1);
amicable(Limit,List,Current,Acc) ->
    CS = sumdivs(Current),
    AS = sumdivs(Acc),
    if
        CS == Acc andalso AS == Current andalso Acc =/= Current ->
          io:format("A: ~w, B: ~w, ~nL: ~w~w~n",  [Current,Acc,divs(Current),divs(Acc)]),
          NL = List ++ [{Current,Acc}],
          amicable(Limit,NL,Acc+1,Acc+1);
        true ->
          amicable(Limit,List,Current-1,Acc) end.

divs(0) -> [];
divs(1) -> [];
divs(N) -> lists:sort(divisors(1,N)).

divisors(1,N) ->
     [1] ++ divisors(2,N,math:sqrt(N)).

divisors(K,_N,Q) when K > Q -> [];
divisors(K,N,_Q) when N rem K =/= 0 ->
    [] ++ divisors(K+1,N,math:sqrt(N));
divisors(K,N,_Q) when K * K  == N ->
    [K] ++ divisors(K+1,N,math:sqrt(N));
divisors(K,N,_Q) ->
    [K, N div K] ++ divisors(K+1,N,math:sqrt(N)).

sumdivs(N) -> lists:sum(divs(N)).


#!/usr/bin/env js

function main() {
    var wordList = read('unixdict.txt').split(/\s+/);
    var anagrams = findAnagrams(wordList);
    var derangedAnagrams = findDerangedAnagrams(anagrams);
    var longestPair = findLongestDerangedPair(derangedAnagrams);
    print(longestPair.join(' '));

}

function findLongestDerangedPair(danas) {
    var longestLen = danas[0][0].length;
    var longestPair = danas[0];
    for (var i in danas) {
        if (danas[i][0].length > longestLen) {
            longestLen = danas[i][0].length;
            longestPair = danas[i];
        }
    }
    return longestPair;
}

function findDerangedAnagrams(anagrams) {
    var deranged = [];

    function isDeranged(w1, w2) {
        for (var c = 0; c < w1.length; c++) {
            if (w1[c] == w2[c]) {
                return false;
            }
        }
        return true;
    }

    function findDeranged(anas) {
        for (var a = 0; a < anas.length; a++) {
            for (var b = a + 1; b < anas.length; b++) {
                if (isDeranged(anas[a], anas[b])) {
                    deranged.push([anas[a], anas[b]]);
                }
            }
        }
    }

    for (var a in anagrams) {
        var anas = anagrams[a];
        findDeranged(anas);
    }

    return deranged;
}

function findAnagrams(wordList) {
    var anagrams = {};

    for (var wordNum in wordList) {
        var word = wordList[wordNum];
        var key = word.split('').sort().join('');
        if (!(key in anagrams)) {
            anagrams[key] = [];
        }
        anagrams[key].push(word);
    }

    for (var a in anagrams) {
        if (anagrams[a].length < 2) {
            delete(anagrams[a]);
        }
    }

    return anagrams;
}

main();


def isKPrime(n: Int, k: Int, d: Int = 2): Boolean = (n, k, d) match {
    case (n, k, _) if n == 1 => k == 0
    case (n, _, d) if n % d == 0 => isKPrime(n / d, k - 1, d)
    case (_, _, _) => isKPrime(n, k, d + 1)
}

def kPrimeStream(k: Int): Stream[Int] = {
    def loop(n: Int): Stream[Int] =
        if (isKPrime(n, k)) n #:: loop(n+ 1)
        else loop(n + 1)
    loop(2)
}

for (k <- 1 to 5) {
    println( s"$k: [${ kPrimeStream(k).take(10) mkString " " }]" )
}


$ include "seed7_05.s7i";

const func boolean: kprime (in var integer: number, in integer: k) is func
  result
    var boolean: kprime is FALSE;
  local
    var integer: p is 2;
    var integer: f is 0;
  begin
    while f < k and p * p <= number do
      while number rem p = 0 do
        number := number div p;
        incr(f);
      end while;
      incr(p);
    end while;
    kprime := f + ord(number > 1) = k;
  end func;

const proc: main is func
  local
    var integer: k is 0;
    var integer: number is 0;
    var integer: count is 0;
  begin
    for k range 1 to 5 do
      write("k = " <& k <& ":");
      count := 0;
      for number range 2 to integer.last until count >= 10 do
        if kprime(number, k) then
          write(" " <& number);
          incr(count);
        end if;
      end for;
      writeln;
    end for;
  end func;


PROGRAM AMICABLE

CONST LIMIT=20000

PROCEDURE SUMPROP(NUM->M)
  IF NUM<2 THEN M=0 EXIT PROCEDURE
  SUM=1
  ROOT=SQR(NUM)
  FOR I=2 TO ROOT-1 DO
     IF (NUM=I*INT(NUM/I)) THEN
         SUM=SUM+I+NUM/I
     END IF
     IF (NUM=ROOT*INT(NUM/ROOT)) THEN
         SUM=SUM+ROOT
     END IF
  END FOR
  M=SUM
END PROCEDURE

BEGIN
  PRINT(CHR$(12);) ! CLS
  PRINT("Amicable pairs < ";LIMIT)
  FOR N=1 TO LIMIT DO
    SUMPROP(N->M1)
    SUMPROP(M1->M2)
    IF (N=M2 AND N<M1) THEN PRINT(N,M1)
  END FOR
END PROGRAM


[2..20000 - 1]
|> List.map (fun n-> n, ([1..n/2] |> List.filter (fun x->n % x = 0) |> List.sum))
|> List.map (fun (a,b) ->if a<b then (a,b) else (b,a))
|> List.groupBy id
|> List.map snd
|> List.filter (List.length >> ((=) 2))
|> List.map List.head
|> List.iter (printfn "%A")


# Input: an array of strings
# Output: a stream of arrays
def anagrams:
  reduce .[] as $word (
    {table: {}, max: 0};   # state
    ($word | explode | sort | implode) as $hash
    | .table[$hash] += [ $word ]
    | .max   = ([ .max, ( .table[$hash] | length) ] | max ) )
  | .table | .[]  | select(length>1);

# Check whether the input and y are deranged,
# on the assumption that they are anagrams:
def deranged(y):
  explode as $x                             # explode is fast
  | (y | explode) as $y
  | all( range(0;length); $x[.] != $y[.] );

# The task: loop through the anagrams,
# retaining only the best set of deranged anagrams so far.
split("\n") | select(length>0)              # read all the words as an array
| reduce anagrams as $words ([];            # loop through all the anagrams
    reduce $words[] as $v (.;
      reduce ($words - [$v])[] as $w (.;    # $v and $w are distinct members of $words
        if $v|deranged($w)
        then if length == 0 then [$v,$w]
             elif ($v|length) == (.[0]|length) then . + [$v,$w]
             elif ($v|length) >  (.[0]|length) then [$v,$w]
	     else .
	     end
        else .
        end) ) )
| unique


using Base.isless
# Let's define the less than operator for any two vectors that have the same type:
# This does lexicographic comparison, we use it on vectors of chars in this task.
function Base.isless(t1, t2)
    for (a, b) in zip(t1, t2) # zip only to the shorter length
        if !isequal(a, b)
            return isless(a, b)
        end
    end
    return length(t1) < length(t2)
end

# The sort function of Julia doesn't work on strings, so we write one:
# This returns a sorted vector of the chars of the given string
sortchars(s::AbstractString) = sort(collect(Char, s))

# Custom comparator function for sorting the loaded wordlist
sortanagr(s1::AbstractString, s2::AbstractString) =
    if length(s1) != length(s2) length(s1) < length(s2) else sortchars(s1) < sortchars(s2) end

# Tests if two strings are deranged anagrams, returns a bool:
# in our case s2 is never longer than s1
function deranged(s1::AbstractString, s2::AbstractString)
    # Tests for derangement first
    for (a, b) in zip(s1, s2)
        if a == b return false end
    end
    # s1 and s2 are deranged, but are they anagrams at all?
    return sortchars(s1) == sortchars(s2)
end

# Task starts here, we load the wordlist line by line, strip eol char, and sort the wordlist
# in a way that ensures that longer words come first and anagrams go next to each other
words = sort(open(readlines, "./data/unixdict.txt"), rev = true, lt = sortanagr)

# Now we just look for deranged anagrams in the neighbouring words of the sorted wordlist
for i in 1:length(words)-1
    if deranged(words[i], words[i+1])
        # The first match is guaranteed to be the longest due to the custom sorting
        println("The longest deranged anagrams are $(words[i]) and $(words[i+1])")
        break
    end
end


import <Utilities/Conversion.sl>;
import <Utilities/Sequence.sl>;

main(args(2)) :=
	let
		result := firstNKPrimes(1 ... 5, 10);

		output[i] := "k = " ++ intToString(i) ++ ": " ++ delimit(intToString(result[i]), ' ');
	in
		delimit(output, '\n');

firstNKPrimes(k, N) := firstNKPrimesHelper(k, N, 2, []);

firstNKPrimesHelper(k, N, current, result(1)) :=
	let
		newResult := result when not isKPrime(k, current) else result ++ [current];
	in
		result when size(result) = N
	else
		firstNKPrimesHelper(k, N, current + 1, newResult);

isKPrime(k, n) := size(primeFactorization(n)) = k;


func is_k_almost_prime(n, k) {
    for (var (p, f) = (2, 0); (f < k) && (p*p <= n); ++p) {
        (n /= p; ++f) while (p `divides` n)
    }
    n > 1 ? (f.inc == k) : (f == k)
}

{ |k|
    var x = 10
    say gather {
        { |i|
            if (is_k_almost_prime(i, k)) {
                take(i)
                --x == 0 && break
            }
        } << 1..Inf
    }
} << 1..5


USING: grouping math.primes.factors math.ranges ;

: pdivs      ( n -- seq )   divisors but-last ;
: dsum       ( n -- sum )   pdivs sum ;
: dsum=      ( n m -- ? )   dsum = ;
: both-dsum= ( n m -- ? )   [ dsum= ] [ swap dsum= ] 2bi and ;
: amicable?  ( n m -- ? )   [ both-dsum= ] [ = not ] 2bi and ;
: drange     ( -- seq )     2 20000 [a,b) ;
: dsums      ( -- seq )     drange [ dsum ] map ;
: is-am?-seq ( -- seq )     dsums drange [ amicable? ] 2map ;
: am-nums    ( -- seq )     t is-am?-seq indices ;
: am-nums-c  ( -- seq )     am-nums [ 2 + ] map ;
: am-pairs   ( -- seq )     am-nums-c 2 group ;
: print-am   ( -- )         am-pairs [ >array . ] each ;

print-am


: proper-divisors ( n -- 1..n )
  dup 2 / 1+ 1 ?do
    dup i mod 0= if i swap then
  loop drop ;

: divisors-sum ( 1..n -- n )
  dup 1 = if exit then
  begin over + swap
  1 = until ;

: pair ( n -- n )
  dup 1 = if exit then
  proper-divisors divisors-sum ;

: ?paired ( n -- t | f )
  dup pair 2dup pair
  = >r < r> and ;

: amicable-list
  1+ 1 do
    i ?paired if cr i . i pair . then
  loop ;

20000 amicable-list


   / anagram clusters
   a:{x [email protected]&1<#:'g:={[email protected]<x}'x}@0:"unixdict.txt";

   / derangements in these clusters
   [email protected]&c=|/c:{#x[0]}'b:[email protected]&{0=+//{x=y}':x}'a
("excitation"
 "intoxicate")


// version 1.0.6

import java.io.BufferedReader
import java.io.InputStreamReader
import java.net.URL

fun isDeranged(s1: String, s2: String): Boolean {
    return (0 until s1.length).none { s1[it] == s2[it] }
}

fun main(args: Array<String>) {
    val url = URL("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
    val isr = InputStreamReader(url.openStream())
    val reader = BufferedReader(isr)
    val anagrams = mutableMapOf<String, MutableList<String>>()
    var count = 0
    var word = reader.readLine()
    while (word != null) {
        val chars = word.toCharArray()
        chars.sort()
        val key = chars.joinToString("")
        if (!anagrams.containsKey(key)) {
            anagrams.put(key, mutableListOf<String>())
            anagrams[key]!!.add(word)
        }
        else {
            val deranged = anagrams[key]!!.any { isDeranged(it, word) }
            if (deranged) {
                anagrams[key]!!.add(word)
                count = Math.max(count, word.length)
            }
        }
        word = reader.readLine()
    }
    reader.close()
    anagrams.values
        .filter { it.size > 1 && it[0].length == count }
        .forEach { println(it) }
}


struct KPrimeGen: Sequence, IteratorProtocol {
  let k: Int
  private(set) var n: Int

  private func isKPrime() -> Bool {
    var primes = 0
    var f = 2
    var rem = n

    while primes < k && rem > 1 {
      while rem % f == 0 && rem > 1 {
        rem /= f
        primes += 1
      }

      f += 1
    }

    return rem == 1 && primes == k
  }

  mutating func next() -> Int? {
    n += 1

    while !isKPrime() {
      n += 1
    }

    return n
  }
}

for k in 1..<6 {
  print("\(k): \(Array(KPrimeGen(k: k, n: 1).lazy.prefix(10)))")
}


package require Tcl 8.6
package require math::numtheory

proc firstNprimes n {
    for {set result {};set i 2} {[llength $result] < $n} {incr i} {
	if {[::math::numtheory::isprime $i]} {
	    lappend result $i
	}
    }
    return $result
}

proc firstN_KalmostPrimes {n k} {
    set p [firstNprimes $n]
    set i [lrepeat $k 0]
    set c {}

    while true {
	dict set c [::tcl::mathop::* {*}[lmap j $i {lindex $p $j}]] ""
	for {set x 0} {$x < $k} {incr x} {
	    lset i $x [set xx [expr {([lindex $i $x] + 1) % $n}]]
	    if {$xx} break
	}
	if {$x == $k} break
    }
    return [lrange [lsort -integer [dict keys $c]] 0 [expr {$n - 1}]]
}

for {set K 1} {$K <= 5} {incr K} {
    puts "$K => [firstN_KalmostPrimes 10 $K]"
}


DefaultDict[String, Array[String]] anagram
L(word) File(‘unixdict.txt’).read().split("\n")
   anagram[sorted(word).join(‘’)].append(word)

V count = max(anagram.values().map(ana -> ana.len))

L(ana) anagram.values()
   I ana.len == count
      print(ana)


' FreeBASIC v1.05.0 win64

Function SumProperDivisors(number As Integer) As Integer
  If number < 2 Then Return 0
  Dim sum As Integer = 0
  For i As Integer = 1 To number \ 2
    If number Mod i = 0 Then sum += i
  Next
  Return sum
End Function

Dim As Integer n, f
Dim As Integer sum(19999)

For n = 1 To 19999
  sum(n) = SumProperDivisors(n)
Next

Print "The pairs of amicable numbers below 20,000 are :"
Print

For n = 1 To 19998
  ' f = SumProperDivisors(n)
  f = sum(n)
  If f <= n OrElse f < 1 OrElse f > 19999 Then Continue For
  If f = sum(n) AndAlso n = sum(f) Then
    Print Using "#####"; n;
    Print " and "; Using "#####"; sum(n)
  End If
Next

Print
Print "Press any key to exit the program"
Sleep
End


n = 1
seen = new set

do
{
   n = n + 1
   if seen.contains[n]
      next

   sum = sum[allFactors[n, true, false, false]]
   if sum != n and sum[allFactors[sum, true, false, false]] == n
   {
      println["$n, $sum"]
      seen.put[sum]
   }
} while n <= 20000


local(
	anagrams	= map,
	words		= include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt') -> split('\n'),
	key,
	max		= 0,
	wordsize,
	findings	= array,
	derangedtest	= { // this code snippet is not executed until the variable is invoked. It will return true if the compared words are a deranged anagram
		local(
			w1		= #1,
			w2		= #2,
			testresult	= true
		)

		loop(#w1 -> size) => {
			#w1 -> get(loop_count) == #w2 -> get(loop_count) ? #testresult = false
		}
		return #testresult
	}
)

// find all anagrams
with word in #words do {
	#key = #word -> split('') -> sort& -> join('')
	not(#anagrams >> #key) ? #anagrams -> insert(#key = array)
	#anagrams -> find(#key) -> insert(#word)
}

// step thru each set of anagrams to find deranged ones
with ana in #anagrams
let ana_size = #ana -> size
where #ana_size > 1
do {
	#wordsize = #ana -> first -> size

	if(#wordsize >= #max) => {

		loop(#ana_size - 1) => {
			if(#derangedtest -> detach & invoke(#ana -> get(loop_count), #ana -> get(loop_count + 1))) => {
				// we only care to save the found deranged anagram if it is longer than the previous longest one
				if(#wordsize > #max) => {
					#findings = array(#ana -> get(loop_count) + ', ' + #ana -> get(loop_count + 1))
				else
					#findings -> insert(#ana -> get(loop_count) + ', ' + #ana -> get(loop_count + 1))
				}
				#max = #wordsize
			}
		}

	}
}

#findings -> join('<br />\n')


print "Loading dictionary file."
open "unixdict.txt" for input as #1
a$=input$(#1,lof(#1))
close #1

dim theWord$(30000)
dim ssWord$(30000)

c10$ = chr$(10)
i = 1
print "Creating array of words."
while instr(a$,c10$,i) <> 0
  j     = instr(a$,c10$,i)
  ln    = j - i
  again = 1
  sWord$ = mid$(a$,i,j-i)
  n = n + 1
 theWord$(n) = sWord$

 while again = 1
   again  = 0
   for kk = 1 to len(sWord$) - 1
   if mid$(sWord$,kk,1) > mid$(sWord$,kk +1,1) then
     sWord$ = left$(sWord$,kk-1);mid$(sWord$,kk+1,1);mid$(sWord$,kk,1);mid$(sWord$,kk+2)
     again  = 1
   end if
   next kk
 wend
 ssWord$(n) = sWord$
 i = j + 1
wend
print "Checking for deranged anagrams."
for i = 1 to n
  if len(theWord$(i)) > maxLen then
    for j = 1 to n
      if ssWord$(i) = ssWord$(j) and i <> j then
        cnt = 0
    for k = 1 to len(theWord$(i))
      if mid$(theWord$(i),k,1) = mid$(theWord$(j),k,1) then cnt = cnt + 1
    next k
    if cnt = 0 then
      maxLen = len(theWord$(i))
      maxPtrI = i
      maxPtrJ = j
    end if
      end if
    next j
  end if
next i

print theWord$(maxPtrI);" => ";theWord$(maxPtrJ)
end


    REM Almost prime
    LET K=1
10  IF K>5 THEN END
    PRINT "k = ",K,":"
    LET I=2
    LET C=0
20  IF C>=10 THEN GOTO 40
    LET N=I
    GOSUB 500
    IF P=0 THEN GOTO 30
    PRINT I
    LET C=C+1
30  LET I=I+1
    GOTO 20
40  LET K=K+1
    GOTO 10

    REM Check if N is a K prime (result: P)
500 LET F=0
    LET J=2
510 IF (N/J)*J<>N THEN GOTO 520
    IF F=K THEN GOTO 530
    LET F=F+1
    LET N=N/J
    GOTO 510
520 LET J=J+1
    IF J<=N THEN GOTO 510
    LET P=0
    IF F=K THEN LET P=-1
    RETURN
530 LET P=0
    RETURN


// Almost prime

function isKPrime(n: number, k: number): bool {
  var f = 0;
  for (var i = 2; i <= n; i++)
    while (n % i == 0) {
      if (f == k)
        return false;
      ++f;
      n = Math.floor(n / i);
    }
  return f == k;
}

for (var k = 1; k <= 5; k++) {
  process.stdout.write(`k = ${k}:`);
  var i = 2, c = 0;
  while (c < 10) {
    if (isKPrime(i, k)) {
      process.stdout.write(" " + i.toString().padStart(3, ' '));
      ++c;
    }
    ++i;
  }
  console.log();
}


\
\ anagrams.8th
\ Rosetta Code - Anagrams problem
\ Using the word list at:
\   http://wiki.puzzlers.org/pub/wordlists/unixdict.txt,
\ find the sets of words that share the same characters
\ that contain the most words in them.
\

ns: anagrams

m:new var, anamap
a:new var, anaptr
0 var, analen

\ sort a string
: s:sort \ s -- s                             \
  null s:/                                    \ a
  ' s:cmpi a:sort                             \ a
  "" a:join                                   \ s
  ;

: process-words \ word --                     \ word
  s:lc                                        \ word
  dup                                         \ word word
  >r                                          \ word | word
  \ 1. we create a sorted version of the curret word (sword)
  s:sort                                      \ sword | word
  \ We check if sword can be found in map anamap
  anamap @                                    \ sword anamap | word
  over                                        \ sword anamap sword | word
  m:exists?                                   \ sword anamap boolean | word
  if                                          \ sword anamap | word
  \ If sword already exists in anamap:
  \    - get mapvalue, which is an array
  \    - add the original word to that array
  \    - store the array in the map with key sword
    over                                      \ sword anamap sword | word
    m:@                                       \ sword anamap array | word
    r>                                        \ sword anamap array word
    a:push                                    \ sword anamap array
    rot                                       \ anamap array sword
    swap                                      \ anamap sword array
    m:!                                       \ anamap
  else                                        \ sword anamap | word
  \ If sword does not yet exist in anamap:
  \    - create empty array
  \    - put the original word into that array
  \    - store the array in the map with key sword
    swap                                      \ anamap sword | word
    a:new                                     \ anamap sword array | word
    r>                                        \ anamap sword array word
    a:push                                    \ anamap sword array
    m:!                                       \ anamap
  then
  drop                                        \
  ;

\ Read and check all words in array analist
: read-and-check-words \ --                   \
  "analist.txt"                               \ fname
  f:open-ro                                   \ f
  ' process-words f:eachline                  \ f
  f:close                                     \
  ;

: len< \ key array arraylen --                \ key array arraylen
  2drop                                       \ key
  drop                                        \
  ;

: len= \ key array arraylen --                \ key array arraylen
  2drop                                       \ key
  anaptr @                                    \ key anaptr
  swap                                        \ anaptr key
  a:push                                      \ anaptr
  drop                                        \
  ;

: len> \ key array arraylen --                \ key array arraylen
  analen                                      \ key array arraylen analen
  !                                           \ key array
  drop                                        \ key
  anaptr @                                    \ key anaptr
  a:clear                                     \ key anaptr
  swap                                        \ anaptr key
  a:push                                      \ anaptr
  drop                                        \
  ;

: fetch-longest-list \ key array --           \ key array
  a:len                                       \ key array arraylen
  analen @                                    \ key array arraylen analen
  2dup                                        \ key array arraylen analen arraylen analen
  n:cmp                                       \ key array arraylen analen value
  1 n:+                                       \ key array arraylen analen value
  nip                                         \ key array arraylen value
  [ ' len< , ' len= , ' len> ]                \ key array arraylen value swarr
  swap                                        \ key array arraylen swarr value
  caseof                                      \
  ;

: list-words-1 \ ix value --                  \ ix value
  nip                                         \ value
  "\t" . .                                    \
  ;

: list-words \ ix value --                    \ ix value
  nip                                         \ value
  anamap @                                    \ value anamap
  swap                                        \ anamap value
  m:@                                         \ anamap array
  nip                                         \ array
  ' list-words-1 a:each                       \ array
  cr                                          \ array
  drop                                        \
  ;

: app:main

  \ Create a map, where the values are arrays, containing all words
  \ which are the same when sorted (sword); sword is used as key
  read-and-check-words

  \ Create an array that holds the keys for anamap, for which the value,
  \ which is the array of anagrams, has the biggest length found.
  anamap @ ' fetch-longest-list m:each

  \ Dump the resulting words to the console
  anaptr @ ' list-words a:each drop
  bye
  ;


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program anagram64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ MAXI,         40000
.equ BUFFERSIZE,   300000

/*********************************/
/* Initialized data              */
/*********************************/
.data
szFileName:           .asciz "./listword.txt"
szMessErreur:         .asciz "FILE ERROR."
szCarriageReturn:     .asciz "\n"
szMessSpace:          .asciz " "

ptBuffex1:            .quad sBuffex1
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
ptTabBuffer:                .skip 8 * MAXI
ptTabAna:                   .skip 8 * MAXI
tbiCptAna:                  .skip 8 * MAXI
iNBword:                    .skip 8
sBuffer:                    .skip BUFFERSIZE
sBuffex1:                   .skip BUFFERSIZE

/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                      // entry of program
    mov x4,#0              // loop indice
    mov x0,AT_FDCWD        // current directory
    ldr x1,qAdrszFileName  // file name
    mov x2,#O_RDWR         // flags
    mov x3,#0              // mode
    mov x8,#OPEN           //
    svc 0
    cmp x0,#0              // error open
    ble 99f
    mov x19,x0              // FD save Fd
    ldr x1,qAdrsBuffer     // buffer address
    ldr x2,qSizeBuf        // buffersize
    mov x8, #READ
    svc 0
    cmp x0,#0              // error read ?
    blt 99f
    mov x5,x0              // save size read bytes
    ldr x4,qAdrsBuffer     // buffer address
    ldr x0,qAdrsBuffer     // start word address
    mov x2,#0
    mov x1,#0              // word length
1:
    cmp x2,x5
    bge 2f
    ldrb w3,[x4,x2]
    cmp w3,#0xD            // end word ?
    cinc x1,x1,ne          // increment word length
    cinc x2,x2,ne          // increment indice
    bne 1b                 // and loop
    strb wzr,[x4,x2]        // store final zero
    bl anaWord             // sort word letters
    add x2,x2,#2           // jump OD and 0A
    add x0,x4,x2           // new address begin word
    mov x1,#0              // init length
    b 1b                   // and loop

2:
    strb wzr,[x4,x2]       // zero final
    bl anaWord             // last word

    mov x0,x19              // file Fd
    mov x8, #CLOSE
    svc 0
    cmp x0,#0              // error close ?
    blt 99f

    ldr x0,qAdrptTabAna    // address sorted string area
    mov x1,#0              // first indice
    ldr x2,qAdriNBword
    ldr x2,[x2]            // last indice
    ldr x3,qAdrptTabBuffer // address sorted string area
    bl triRapide           // quick sort
    ldr x4,qAdrptTabAna    // address sorted string area
    ldr x7,qAdrptTabBuffer // address sorted string area
    ldr x10,qAdrtbiCptAna  // address counter occurences
    mov x9,x2              // size word array
    mov x8,#0              // indice first occurence
    ldr x3,[x4,x8,lsl #3]  // load first value
    mov x2,#1              // loop indice
    mov x6,#0              // counter
    mov x12,#0             // counter value max
3:
    ldr x5,[x4,x2,lsl #3]  // load next value
    mov x0,x3
    mov x1,x5
    bl comparStrings
    cmp x0,#0              // sorted strings equal ?
    bne 4f
    add x6,x6,#1           // yes increment counter
    b 5f
4:                         // no
    str x6,[x10,x8,lsl #3] // store counter in first occurence
    cmp x6,x12             // counter > value max
    csel x12,x6,x12,gt     // yes  counter -> value max
    //movgt x12,x6           // yes  counter -> value max
    mov x6,#0              // raz counter
    mov x8,x2              // init index first occurence
    mov x3,x5              // init value first occurence
5:
    add x2,x2,#1           // increment indice
    cmp x2,x9              // end word array ?
    blt 3b                 // no -> loop

    mov x2,#0              // raz indice
6:                         // display loop
    ldr x6,[x10,x2,lsl #3] // load counter
    cmp x6,x12             // equal to max value ?
    bne 8f
    ldr x0,[x7,x2,lsl #3]  // load address first word
    bl affichageMess
    add x3,x2,#1           // increment new indixe
    mov x4,#0              // counter
7:
    ldr x0,qAdrszMessSpace
    bl affichageMess
    ldr x0,[x7,x3,lsl #3]  // load address other word
    bl affichageMess
    add x3,x3,#1           // increment indice
    add x4,x4,#1           // increment counter
    cmp x4,x6              // max value ?
    blt 7b                 // no loop
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
8:
    add x2,x2,#1           // increment indice
    cmp x2,x9              // maxi ?
    blt 6b                 // no -> loop

    b 100f
99:                        // display error
    ldr x0,qAdrszMessErreur
    bl affichageMess

100:                       // standard end of the program
    mov x0, #0             // return code
    mov x8, #EXIT          // request to exit program
    svc #0                 // perform the system call
qAdrszCarriageReturn:        .quad szCarriageReturn
qAdrszFileName:              .quad szFileName
qAdrszMessErreur:            .quad szMessErreur
qAdrsBuffer:                 .quad sBuffer
qSizeBuf:                    .quad BUFFERSIZE
qAdrszMessSpace:             .quad szMessSpace
qAdrtbiCptAna:               .quad tbiCptAna
/******************************************************************/
/*     analizing word                                   */
/******************************************************************/
/*  x0  word address */
/*  x1 word length   */
anaWord:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    stp x6,x7,[sp,-16]!           // save  registers
    mov x5,x0
    mov x6,x1
    ldr x1,qAdrptTabBuffer
    ldr x2,qAdriNBword
    ldr x3,[x2]
    str x0,[x1,x3,lsl #3]

    ldr x1,qAdrptTabAna
    ldr x4,qAdrptBuffex1
    ldr x0,[x4]
    add x6,x6,x0
    add x6,x6,#1
    str x6,[x4]
    str x0,[x1,x3,lsl #3]

    add x3,x3,#1
    str x3,[x2]
    mov x1,x0
    mov x0,x5
    bl triLetters         // sort word letters
    mov x2,#0
100:
    ldp x6,x7,[sp],16              // restaur  2 registers
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrptTabBuffer:        .quad ptTabBuffer
qAdrptTabAna:           .quad ptTabAna
qAdriNBword:            .quad iNBword
qAdrptBuffex1:          .quad ptBuffex1
/******************************************************************/
/*     sort word letters                                  */
/******************************************************************/
/* x0  address begin word */
/* x1  address recept array */
triLetters:
    stp x1,lr,[sp,-16]!     // save  registers
    stp x2,x3,[sp,-16]!     // save  registers
    stp x4,x5,[sp,-16]!     // save  registers
    stp x6,x7,[sp,-16]!     // save  registers
    mov x2,#0
1:
    ldrb w3,[x0,x2]         // load letter
    cmp w3,#0               // end word ?
    beq 6f
    cmp x2,#0               // first letter ?
    bne 2f
    strb w3,[x1,x2]         // yes store in first position
    add x2,x2,#1            // increment indice
    b 1b                    // and loop
2:
    mov x4,#0
3:                          // begin loop to search insertion position
    ldrb w5,[x1,x4]         // load letter
    cmp w3,w5               // compare
    blt 4f                  // to low -> insertion
    add x4,x4,#1            // increment indice
    cmp x4,x2               // compare to letters number in place
    blt 3b                  // search loop
    strb w3,[x1,x2]         // else store in last position
    add x2,x2,#1
    b 1b                    // and loop
4:                          // move first letters in one position
    sub x6,x2,#1            // start indice
5:
    ldrb w5,[x1,x6]         // load letter
    add x7,x6,#1            // store indice - 1
    strb w5,[x1,x7]         // store letter
    sub x6,x6,#1            // decrement indice
    cmp x6,x4               // end ?
    bge 5b                  // no loop
    strb w3,[x1,x4]         // else store letter in free position
    add x2,x2,#1
    b 1b                    // and loop
6:
    strb wzr,[x1,x2]        // final zéro
100:
    ldp x6,x7,[sp],16       // restaur  2 registers
    ldp x4,x5,[sp],16       // restaur  2 registers
    ldp x2,x3,[sp],16       // restaur  2 registers
    ldp x1,lr,[sp],16       // restaur  2 registers
    ret                     // return to address lr x30
/***************************************************/
/*   Appel récursif Tri Rapide quicksort           */
/***************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item  */
/* x2 contains the number of elements  > 0  */
/* x3 contains the address of table 2 */
triRapide:
    stp x1,lr,[sp,-16]!     // save  registers
    stp x2,x3,[sp,-16]!     // save  registers
    stp x4,x5,[sp,-16]!     // save  registers
    stp x6,x7,[sp,-16]!     // save  registers
    mov x6,x3
    sub x2,x2,#1               // last item index
    cmp x1,x2               // first > last ?
    bge 100f                // yes -> end
    mov x4,x0               // save x0
    mov x5,x2               // save x2
    mov x3,x6
    bl partition1           // cutting.quado 2 parts
    mov x2,x0               // index partition
    mov x0,x4               // table address
    bl triRapide            // sort lower part
    mov x0,x4               // table address
    add x1,x2,#1            // index begin = index partition + 1
    add x2,x5,#1            // number of elements
    bl triRapide            // sort higter part

 100:                       // end function
    ldp x6,x7,[sp],16       // restaur  2 registers
    ldp x4,x5,[sp],16       // restaur  2 registers
    ldp x2,x3,[sp],16       // restaur  2 registers
    ldp x1,lr,[sp],16       // restaur  2 registers
    ret                     // return to address lr x30

/******************************************************************/
/*      Partition table elements                                */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item  */
/* x2 contains index of last item   */
/* x3 contains the address of table 2 */
partition1:
    stp x1,lr,[sp,-16]!     // save  registers
    stp x2,x3,[sp,-16]!     // save  registers
    stp x4,x5,[sp,-16]!     // save  registers
    stp x6,x7,[sp,-16]!     // save  registers
    stp x8,x9,[sp,-16]!     // save  registers
    stp x10,x12,[sp,-16]!   // save  registers
    mov x8,x0               // save address table 2
    mov x9,x1
    ldr x10,[x8,x2,lsl #3]  // load string address last index
    mov x4,x9               // init with first index
    mov x5,x9               // init with first index
1:                          // begin loop
    ldr x6,[x8,x5,lsl #3]   // load string address
    mov x0,x6
    mov x1,x10
    bl comparStrings
    cmp x0,#0
    bge 2f
    ldr x7,[x8,x4,lsl #3]    // if < swap value table
    str x6,[x8,x4,lsl #3]
    str x7,[x8,x5,lsl #3]
    ldr x7,[x3,x4,lsl #3]    // swap array 2
    ldr x12,[x3,x5,lsl #3]
    str x7,[x3,x5,lsl #3]
    str x12,[x3,x4,lsl #3]
    add x4,x4,#1             // and increment index 1
2:
    add x5,x5,#1             // increment index 2
    cmp x5,x2                // end ?
    blt 1b                   // no -> loop
    ldr x7,[x8,x4,lsl #3]    // swap value
    str x10,[x8,x4,lsl #3]
    str x7,[x8,x2,lsl #3]
    ldr x7,[x3,x4,lsl #3]    // swap array 2
    ldr x12,[x3,x2,lsl #3]
    str x7,[x3,x2,lsl #3]
    str x12,[x3,x4,lsl #3]

    mov x0,x4                // return index partition
100:
    ldp x10,x12,[sp],16     // restaur  2 registers
    ldp x8,x9,[sp],16       // restaur  2 registers
    ldp x6,x7,[sp],16       // restaur  2 registers
    ldp x4,x5,[sp],16       // restaur  2 registers
    ldp x2,x3,[sp],16       // restaur  2 registers
    ldp x1,lr,[sp],16       // restaur  2 registers
    ret                     // return to address lr x30
/************************************/
/* Strings case sensitive comparisons  */
/************************************/
/* x0 et x1 contains the address of strings */
/* return 0 in x0 if equals */
/* return -1 if string x0 < string x1 */
/* return 1  if string x0 > string x1 */
comparStrings:
    stp x1,lr,[sp,-16]! // save  registers
    stp x2,x3,[sp,-16]! // save  registers
    stp x4,x5,[sp,-16]! // save  registers
    mov x2,#0           // counter
1:
    ldrb w3,[x0,x2]     // byte string 1
    ldrb w4,[x1,x2]     // byte string 2
    cmp w3,w4
    blt 2f              // small
    bgt 3f              // greather
    cmp x3,#0           // 0 end string
    beq 4f              // end string
    add x2,x2,#1        // else add 1 in counter
    b 1b                // and loop
2:
    mov x0,#-1          // small
    b 100f
3:
    mov x0,#1           // greather
    b 100f
4:
   mov x0,#0            // equal
100:
    ldp x4,x5,[sp],16   // restaur  2 registers
    ldp x2,x3,[sp],16   // restaur  2 registers
    ldp x1,lr,[sp],16   // restaur  2 registers
    ret                 // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


fun divisors(n: int): []int =
  filter (fn x => n%x == 0) (map (1+) (iota (n/2)))

fun amicable((n: int, nd: int), (m: int, md: int)): bool =
  n < m && nd == m && md == n

fun getPair (divs: [upper](int, int)) (flat_i: int): ((int,int), (int,int)) =
  let i = flat_i / upper
  let j = flat_i % upper
  in unsafe (divs[i], divs[j])

fun main(upper: int): [][2]int =
  let range = map (1+) (iota upper)
  let divs = zip range (map (fn n => reduce (+) 0 (divisors n)) range)
  let amicable = filter amicable (map (getPair divs) (iota (upper*upper)))
  in map (fn (np,mp) => [#1 np, #1 mp]) amicable


OPENW 1
CLEARW 1
'
DIM f%(20001) ! sum of proper factors for each n
FOR i%=1 TO 20000
  f%(i%)[email protected]_proper_divisors(i%)
NEXT i%
' look for pairs
FOR i%=1 TO 20000
  FOR j%=i%+1 TO 20000
    IF f%(i%)=j% AND i%=f%(j%)
      PRINT "Amicable pair ";i%;" ";j%
    ENDIF
  NEXT j%
NEXT i%
'
PRINT
PRINT "-- found all amicable pairs"
~INP(2)
CLOSEW 1
'
' Compute the sum of proper divisors of given number
'
FUNCTION sum_proper_divisors(n%)
  LOCAL i%,sum%,root%
  '
  IF n%>1 ! n% must be 2 or larger
    sum%=1 ! start with 1
    root%=SQR(n%) ! note that root% is an integer
    ' check possible factors, up to sqrt
    FOR i%=2 TO root%
      IF n% MOD i%=0
        sum%=sum%+i% ! i% is a factor
        IF i%*i%<>n% ! check i% is not actual square root of n%
          sum%=sum%+n%/i% ! so n%/i% will also be a factor
        ENDIF
      ENDIF
    NEXT i%
  ENDIF
  RETURN sum%
ENDFUNC


package main

import "fmt"

func pfacSum(i int) int {
    sum := 0
    for p := 1; p <= i/2; p++ {
        if i%p == 0 {
            sum += p
        }
    }
    return sum
}

func main() {
    var a[20000]int
    for i := 1; i < 20000; i++ {
        a[i] = pfacSum(i)
    }
    fmt.Println("The amicable pairs below 20,000 are:")
    for n := 2; n < 19999; n++ {
        m := a[n]
        if m > n && m < 20000 && n == a[m] {
            fmt.Printf("  %5d and %5d\n", n, m)
        }
    }
}


string.tacnoc = function(str) -- 'inverse' of table.concat
  local arr={}
  for ch in str:gmatch(".") do arr[#arr+1]=ch end
  return arr
end

local function deranged(s1, s2)
  if s1==s2 then return false end
  local t1, t2 = s1:tacnoc(), s2:tacnoc()
  for i,v in ipairs(t1) do if t2[i]==v then return false end end
  return true
end

local dict = {}
local f = io.open("unixdict.txt", "r")
for word in f:lines() do
  local ltrs = word:tacnoc()
  table.sort(ltrs)
  local hash = table.concat(ltrs)
  dict[hash] = dict[hash] or {}
  table.insert(dict[hash], word)
end

local answer = { word="", anag="", len=0 }
for _,list in pairs(dict) do
  if #list>1 and #list[1]>answer.len then
    for _,word in ipairs(list) do
      for _,anag in ipairs(list) do
        if deranged(word, anag) then
          answer.word, answer.anag, answer.len = word, anag, #word
        end
      end
    end
  end
end
print(answer.word, answer.anag, answer.len)


Local(3)

For [email protected] = 1 To 5
  Print "k = ";[email protected];": ";

  [email protected]=0

  For [email protected] = 2 Step 1 While [email protected] < 10
    If FUNC(_kprime ([email protected],[email protected])) Then
       [email protected] = [email protected] + 1
       Print " ";[email protected];
    EndIf
  Next

  Print
Next

End

_kprime Param(2)
  Local(2)

  [email protected] = 0
  For [email protected] = 2 Step 1 While ([email protected] < [email protected]) * (([email protected] * [email protected]) < ([email protected] + 1))
    Do While ([email protected] % [email protected]) = 0
      [email protected] = [email protected] / [email protected]
      [email protected] = [email protected] + 1
    Loop
  Next
Return ([email protected] = ([email protected] + ([email protected] > 1)))


Private Function kprime(ByVal n As Integer, k As Integer) As Boolean
    Dim p As Integer, factors As Integer
    p = 2
    factors = 0
    Do While factors < k And p * p <= n
        Do While n Mod p = 0
            n = n / p
            factors = factors + 1
        Loop
        p = p + 1
    Loop
    factors = factors - (n > 1) 'true=-1
    kprime = factors = k
End Function

Private Sub almost_primeC()
    Dim nextkprime As Integer, count As Integer
    Dim k As Integer
    For k = 1 To 5
        Debug.Print "k ="; k; ":";
        nextkprime = 2
        count = 0
        Do While count < 10
            If kprime(nextkprime, k) Then
                Debug.Print " "; Format(CStr(nextkprime), "@@@@@");
                count = count + 1
            End If
            nextkprime = nextkprime + 1
        Loop
        Debug.Print
    Next k
End Sub


report zz_anagrams no standard page heading.
define update_progress.
  call function 'SAPGUI_PROGRESS_INDICATOR'
    exporting
      text = &1.
end-of-definition.

" Selection screen segment allowing the person to choose which file will act as input.
selection-screen begin of block file_choice.
  parameters p_file type string lower case.
selection-screen end of block file_choice.

" When the user requests help with input, run the routine to allow them to navigate the presentation server.
at selection-screen on value-request for p_file.
  perform getfile using p_file.

at selection-screen output.
  %_p_file_%_app_%-text = 'Input File: '.

start-of-selection.
  data: gt_data type table of string.

  " Read the specified file from the presentation server into memory.
  perform readfile using p_file changing gt_data.
  " After the file has been read into memory, loop through it line-by-line and make anagrams.
  perform anagrams using gt_data.

" Subroutine for generating a list of anagrams.
" The supplied input is a table, with each entry corresponding to a word.
form anagrams using it_data like gt_data.
  types begin of ty_map.
    types key type string.
    types value type string.
  types end of ty_map.

  data: lv_char     type c,
        lv_len      type i,
        lv_string   type string,
        ls_entry    type ty_map,
        lt_anagrams type standard table of ty_map,
        lt_c_tab    type table of string.

  field-symbols: <fs_raw> type string.
  " Loop through each word in the table, and make an associative array.
  loop at gt_data assigning <fs_raw>.
    " First, we need to re-order the word alphabetically. This generated a key. All anagrams will use this same key.
    " Add each character to a table, which we will then sort alphabetically.
    lv_len = strlen( <fs_raw> ).
    refresh lt_c_tab.
    do lv_len times.
      lv_len = sy-index  - 1.
      append <fs_raw>+lv_len(1) to lt_c_tab.
    enddo.
    sort lt_c_tab as text.
    " Now append the characters to a string and add it as a key into the map.
    clear lv_string.
    loop at lt_c_tab into lv_char.
      concatenate lv_char lv_string into lv_string respecting blanks.
    endloop.
    ls_entry-key = lv_string.
    ls_entry-value = <fs_raw>.
    append ls_entry to lt_anagrams.
  endloop.
  " After we're done processing, output a list of the anagrams.
  clear lv_string.
  loop at lt_anagrams into ls_entry.
    " Is it part of the same key --> Output in the same line, else a new entry.
    if lv_string = ls_entry-key.
        write: ', ', ls_entry-value.
    else.
      if sy-tabix <> 1.
        write: ']'.
      endif.
      write:  / '[', ls_entry-value.
    endif.
    lv_string = ls_entry-key.
  endloop.
  " Close last entry.
  write ']'.
endform.

" Read a specified file from the presentation server.
form readfile using i_file type string changing it_raw like gt_data.
  data: l_datat type string,
        l_msg(2048),
        l_lines(10).

  " Read the file into memory.
  update_progress 'Reading file...'.
  call method cl_gui_frontend_services=>gui_upload
    exporting
      filename = i_file
    changing
      data_tab = it_raw
    exceptions
      others   = 1.
  " Output error if the file could not be uploaded.
  if sy-subrc <> 0.
    write : / 'Error reading the supplied file!'.
    return.
  endif.
endform.


divisors :: (Integral a) => a -> [a]
divisors n = filter ((0 ==) . (n `mod`)) [1 .. (n `div` 2)]

main :: IO ()
main = do
  let range = [1 .. 20000 :: Int]
      divs = zip range $ map (sum . divisors) range
      pairs = [(n, m) | (n, nd) <- divs, (m, md) <- divs,
               n < m, nd == m, md == n]
  print pairs


For k = 1 To 5
	count = 0
	increment = 1
	WScript.StdOut.Write "K" & k & ": "
	Do Until count = 10
		If PrimeFactors(increment) = k Then
			WScript.StdOut.Write increment & " "
			count = count + 1
		End If
		increment = increment + 1
	Loop
	WScript.StdOut.WriteLine
Next

Function PrimeFactors(n)
	PrimeFactors = 0
	arrP = Split(ListPrimes(n)," ")
	divnum = n
	Do Until divnum = 1
		For i = 0 To UBound(arrP)-1
			If divnum = 1 Then
				Exit For
			ElseIf divnum Mod arrP(i) = 0 Then
				divnum = divnum/arrP(i)
				PrimeFactors = PrimeFactors + 1
			End If
		Next
	Loop
End Function

Function IsPrime(n)
	If n = 2 Then
		IsPrime = True
	ElseIf n <= 1 Or n Mod 2 = 0 Then
		IsPrime = False
	Else
		IsPrime = True
		For i = 3 To Int(Sqr(n)) Step 2
			If n Mod i = 0 Then
				IsPrime = False
				Exit For
			End If
		Next
	End If
End Function

Function ListPrimes(n)
	ListPrimes = ""
	For i = 1 To n
		If IsPrime(i) Then
			ListPrimes = ListPrimes & i & " "
		End If
	Next
End Function


Module Module1

    Class KPrime
        Public K As Integer

        Public Function IsKPrime(number As Integer) As Boolean
            Dim primes = 0
            Dim p = 2
            While p * p <= number AndAlso primes < K
                While number Mod p = 0 AndAlso primes < K
                    number = number / p
                    primes = primes + 1
                End While
                p = p + 1
            End While
            If number > 1 Then
                primes = primes + 1
            End If
            Return primes = K
        End Function

        Public Function GetFirstN(n As Integer) As List(Of Integer)
            Dim result As New List(Of Integer)
            Dim number = 2
            While result.Count < n
                If IsKPrime(number) Then
                    result.Add(number)
                End If
                number = number + 1
            End While
            Return result
        End Function
    End Class

    Sub Main()
        For Each k In Enumerable.Range(1, 5)
            Dim kprime = New KPrime With {
                .K = k
            }
            Console.WriteLine("k = {0}: {1}", k, String.Join(" ", kprime.GetFirstN(10)))
        Next
    End Sub

End Module


with Ada.Text_IO;  use Ada.Text_IO;

with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;

procedure Words_Of_Equal_Characters is
   package Set_Of_Words is new Ada.Containers.Indefinite_Ordered_Sets (String);
   use Ada.Containers, Set_Of_Words;
   package Anagrams is new Ada.Containers.Indefinite_Ordered_Maps (String, Set);
   use Anagrams;

   File   : File_Type;
   Result : Map;
   Max    : Count_Type := 1;

   procedure Put (Position : Anagrams.Cursor) is
      First : Boolean := True;
      List  : Set renames Element (Position);
      procedure Put (Position : Set_Of_Words.Cursor) is
      begin
         if First then
            First := False;
         else
            Put (',');
         end if;
         Put (Element (Position));
      end Put;
   begin
      if List.Length = Max then
         Iterate (List, Put'Access);
         New_Line;
      end if;
   end Put;

begin
   Open (File, In_File, "unixdict.txt");
   loop
      declare
         Word : constant String     := Get_Line (File);
         Key  : String (Word'Range) := (others => Character'Last);
         List : Set;
         Position : Anagrams.Cursor;
      begin
         for I in Word'Range loop
            for J in Word'Range loop
               if Key (J) > Word (I) then
                  Key (J + 1..I) := Key (J..I - 1);
                  Key (J) := Word (I);
                  exit;
               end if;
            end loop;
         end loop;
         Position := Find (Result, Key);
         if Has_Element (Position) then
            List := Element (Position);
            Insert (List, Word);
            Replace_Element (Result, Position, List);
         else
            Insert (List, Word);
            Include (Result, Key, List);
         end if;
         Max := Count_Type'Max (Max, Length (List));
      end;
   end loop;
exception
   when End_Error =>
      Iterate (Result, Put'Access);
      Close (File);
end Words_Of_Equal_Characters;


factors=: [: /:[email protected], */&>@{@((^ [email protected]>:)&.>/)@q:~&__
properDivisors=: factors -. -.&1


import java.util.Map;
import java.util.function.Function;
import java.util.stream.Collectors;
import java.util.stream.LongStream;

public class AmicablePairs {

    public static void main(String[] args) {
        int limit = 20_000;

        Map<Long, Long> map = LongStream.rangeClosed(1, limit)
                .parallel()
                .boxed()
                .collect(Collectors.toMap(Function.identity(), AmicablePairs::properDivsSum));

        LongStream.rangeClosed(1, limit)
                .forEach(n -> {
                    long m = map.get(n);
                    if (m > n && m <= limit && map.get(m) == n)
                        System.out.printf("%s %s %n", n, m);
                });
    }

    public static Long properDivsSum(long n) {
        return LongStream.rangeClosed(1, (n + 1) / 2).filter(i -> n % i == 0).sum();
    }
}


import algorithm
import tables
import times

var anagrams: Table[seq[char], seq[string]]  # Mapping sorted_list_of chars -> list of anagrams.

#---------------------------------------------------------------------------------------------------

func deranged(s1, s2: string): bool =
  ## Return true if "s1" and "s2" are deranged anagrams.

  for i, c in s1:
    if s2[i] == c:
      return false
  result = true

#---------------------------------------------------------------------------------------------------

let t0 = getTime()

# Build the anagrams table.
for word in lines("unixdict.txt"):
  anagrams.mgetOrPut(sorted(word), @[]).add(word)

# Find the longest deranged anagrams.
var bestLen = 0
var best1, best2: string
for (key, list) in anagrams.pairs:
  if key.len > bestLen:
    var s1 = list[0]
    for i in 1..list.high:
      let s2 = list[i]
      if deranged(s1, s2):
        # Found a better pair.
        best1 = s1
        best2 = s2
        bestLen = s1.len
        break

echo "Longest deranged anagram pair: ", best1, " ", best2
echo "Processing time: ", (getTime() - t0).inMilliseconds, " ms."


let sort_chars s =
  let r = String.copy s in
  for i = 0 to (String.length r) - 2 do
    for j = i + 1 to (String.length r) - 1 do
      if r.[i] > r.[j] then begin
        let tmp = r.[i] in
        r.[i] <- r.[j];
        r.[j] <- tmp;
      end
    done
  done;
  (r)

let deranged (s1, s2) =
  let len1 = String.length s1
  and len2 = String.length s2 in
  if len1 <> len2 then false else
  try
    for i = 0 to pred len1 do
      if s1.[i] = s2.[i] then raise Exit
    done;
    true
  with Exit -> false

let pairs_of_list lst =
  let rec aux acc = function
    | [] -> acc
    | x::xs ->
        aux (List.fold_left (fun acc y -> (x,y)::acc) acc xs) xs
  in
  aux [] lst

let () =
  let h = Hashtbl.create 3571 in
  let ic = open_in "unixdict.txt" in
  try while true do
    let word = input_line ic in
    let key = sort_chars word in
    let l =
      try Hashtbl.find h key
      with Not_found -> []
    in
    Hashtbl.replace h key (word::l);
  done with End_of_file ->
    close_in ic;
    let lst =
      Hashtbl.fold (fun _ lw acc ->
        if List.length lw < 2 then acc else lw::acc) h []
    in
    let lst =
      List.fold_left (fun acc anagrams ->
        let pairs = pairs_of_list anagrams in
        (List.filter deranged pairs) @ acc
      ) [] lst
    in
    let res, _ =
      List.fold_left (fun (res, n) (w1, w2) ->
        let len = String.length w1 in
        match Pervasives.compare len n with
        | 0 -> ((w1, w2)::res, n)
        | 1 -> ([w1, w2], len)
        | _ -> (res, n)
      ) ([], 0) lst
    in
    List.iter (fun (w1, w2) -> Printf.printf "%s, %s\n" w1 w2) res


fn k_prime(n int, k int) bool {
    mut nf := 0
    mut nn := n
    for i in 2 .. nn+1 {
        for nn % i == 0 {
            if nf == k {
                return false
            }
            nf++
            nn/=i
        }
    }
    return nf == k
}

fn gen(k int, n int) []int {
    mut r := []int{len:n}
    mut nx := 2
    for i in 0 .. n {
        for !k_prime(nx, k) {
            nx++
        }
        r[i] = nx
        nx++
    }
    return r
}

fn main(){
    for k in 1..6 {
        println('$k ${gen(k,10)}')
    }
}


var kPrime = Fn.new { |n, k|
    var nf = 0
    var i = 2
    while (i <= n) {
        while (n%i == 0) {
            if (nf == k) return false
            nf = nf + 1
            n = (n/i).floor
        }
        i = i + 1
    }
    return nf == k
}

var gen = Fn.new { |k, n|
    var r = List.filled(n, 0)
    n = 2
    for (i in 0...r.count) {
        while (!kPrime.call(n, k)) n = n + 1
        r[i] = n
        n = n + 1
    }
    return r
}

for (k in 1..5) System.print("%(k) %(gen.call(k, 10))")


# find longest list(s) of words that are anagrams in a list of words #
# use the associative array in the Associate array/iteration task    #
PR read "aArray.a68" PR

# returns the number of occurances of ch in text #
PROC count = ( STRING text, CHAR ch )INT:
     BEGIN
         INT result := 0;
         FOR c FROM LWB text TO UPB text DO IF text[ c ] = ch THEN result +:= 1 FI OD;
         result
     END # count # ;

# returns text with the characters sorted into ascending order #
PROC char sort = ( STRING text )STRING:
     BEGIN
         STRING sorted := text;
         FOR end pos FROM UPB sorted - 1 BY -1 TO LWB sorted
         WHILE
             BOOL swapped := FALSE;
             FOR pos FROM LWB sorted TO end pos DO
                 IF sorted[ pos ] > sorted[ pos + 1 ]
                 THEN
                     CHAR  t           := sorted[ pos     ];
                     sorted[ pos     ] := sorted[ pos + 1 ];
                     sorted[ pos + 1 ] := t;
                     swapped           := TRUE
                 FI
             OD;
             swapped
         DO SKIP OD;
         sorted
    END # char sort # ;

# read the list of words and store in an associative array           #

CHAR separator = "|"; # character that will separate the anagrams #

IF  FILE input file;
    STRING file name = "unixdict.txt";
    open( input file, file name, stand in channel ) /= 0
THEN
    # failed to open the file #
    print( (  "Unable to open """ + file name + """", newline ) )
ELSE
    # file opened OK #
    BOOL at eof := FALSE;
    # set the EOF handler for the file #
    on logical file end( input file, ( REF FILE f )BOOL:
                                     BEGIN
                                         # note that we reached EOF on the #
                                         # latest read #
                                         at eof := TRUE;
                                         # return TRUE so processing can continue #
                                         TRUE
                                     END
                       );
    REF AARRAY words := INIT LOC AARRAY;
    STRING word;
    WHILE NOT at eof
    DO
        STRING word;
        get( input file, ( word, newline ) );
        words // char sort( word ) +:= separator + word
    OD;
    # close the file #
    close( input file );

    # find the maximum number of anagrams #

    INT max anagrams := 0;

    REF AAELEMENT e := FIRST words;
    WHILE e ISNT nil element DO
        IF  INT anagrams := count( value OF e, separator );
            anagrams > max anagrams
        THEN
            max anagrams := anagrams
        FI;
        e := NEXT words
    OD;

    print( ( "Maximum number of anagrams: ", whole( max anagrams, -4 ), newline ) );
    # show the anagrams with the maximum number #
    e := FIRST words;
    WHILE e ISNT nil element DO
        IF  INT anagrams := count( value OF e, separator );
            anagrams = max anagrams
        THEN
            print( ( ( value OF e )[ ( LWB value OF e ) + 1: ], newline ) )
        FI;
        e := NEXT words
    OD
FI


(function (max) {

    // Proper divisors
    function properDivisors(n) {
        if (n < 2) return [];
        else {
            var rRoot = Math.sqrt(n),
                intRoot = Math.floor(rRoot),

                lows = range(1, intRoot).filter(function (x) {
                    return (n % x) === 0;
                });

            return lows.concat(lows.slice(1).map(function (x) {
                return n / x;
            }).reverse().slice((rRoot === intRoot) | 0));
        }
    }

    // [m..n]
    function range(m, n) {
        var a = Array(n - m + 1),
            i = n + 1;
        while (i--) a[i - 1] = i;
        return a;
    }

    // Filter an array of proper divisor sums,
    // reading the array index as a function of N (N-1)
    // and the sum of proper divisors as a potential M

    var pairs = range(1, max).map(function (x) {
        return properDivisors(x).reduce(function (a, d) {
            return a + d;
        }, 0)
    }).reduce(function (a, m, i, lst) {
        var n = i + 1;

        return (m > n) && lst[m - 1] === n ? a.concat([[n, m]]) : a;
    }, []);

    // [[a]] -> bool -> s -> s
    function wikiTable(lstRows, blnHeaderRow, strStyle) {
        return '{| class="wikitable" ' + (
            strStyle ? 'style="' + strStyle + '"' : ''
        ) + lstRows.map(function (lstRow, iRow) {
            var strDelim = ((blnHeaderRow && !iRow) ? '!' : '|');

            return '\n|-\n' + strDelim + ' ' + lstRow.map(function (v) {
                return typeof v === 'undefined' ? ' ' : v;
            }).join(' ' + strDelim + strDelim + ' ');
        }).join('') + '\n|}';
    }

    return wikiTable(
        [['N', 'M']].concat(pairs),
        true,
        'text-align:center'
    ) + '\n\n' + JSON.stringify(pairs);

})(20000);


-- This assumes you've already downloaded the following file and placed it
-- in the current directory: http://www.puzzlers.org/pub/wordlists/unixdict.txt

-- There are several different ways of reading the file.  I chose the
-- supplier method just because I haven't used it yet in any other examples.
source = .stream~new('unixdict.txt')~supplier
-- this holds our mappings of the anagrams.  This is good use for the
-- relation class
anagrams = .relation~new
count = 0    -- this is used to keep track of the maximums

loop while source~available
    word = source~item
    -- this produces a string consisting of the characters in sorted order
    -- Note: the ~~ used to invoke sort makes that message return value be
    -- the target array.  The sort method does not normally have a return value.
    key = word~makearray('')~~sort~tostring("l", "")
    -- add this to our mapping.  This creates multiple entries for each
    -- word that uses the same key
    anagrams[key] = word
    source~next
end

-- now get the set of unique keys
keys = .set~new~~putall(anagrams~allIndexes)
-- the longest count tracker
longest = 0
-- our list of the longest pairs
pairs = .array~new

loop key over keys
    -- don't even bother doing the deranged checks for any key
    -- shorter than our current longest
    if key~length < longest then iterate

    words = anagrams~allAt(key)
    -- singletons aren't anagrams at all
    newCount = words~items
    loop i = 1 to newCount - 1
        word1 = words[i]
        loop j = 1 to newCount
            word2 = words[j]
            -- bitxor will have '00'x in every position where these
            -- strings match.  If found, go around and check the
            -- next one
            if word1~bitxor(word2)~pos('00'x) > 0 then iterate
            -- we have a match
            else do
                if word1~length > longest then do
                    -- throw away anything we've gathered so far
                    pairs~empty
                    longest = word1~length
                end
                pairs~append(.array~of(word1, word2))
            end
        end
    end
end

say "The longest deranged anagrams we found are:"
loop pair over pairs
     say pair[1] pair[2]
end


' Almost prime
PROGRAM "almostprime"
VERSION "0.0002"

DECLARE FUNCTION Entry()
INTERNAL FUNCTION KPrime(n%%, k%%)

FUNCTION Entry()
  FOR k@@ = 1 TO 5
    PRINT "k ="; k@@; ":";
    i%% = 2
    c%% = 0
    DO WHILE c%% < 10
      IFT KPrime(i%%, k@@) THEN
        PRINT FORMAT$(" ###", i%%);
        INC c%%
      END IF
      INC i%%
    LOOP
    PRINT
  NEXT k@@
END FUNCTION

FUNCTION KPrime(n%%, k%%)
  f%% = 0
  FOR i%% = 2 TO n%%
    DO WHILE n%% MOD i%% = 0
      IF f%% = k%% THEN RETURN $$FALSE
      INC f%%
      n%% = n%% \ i%%
    LOOP
  NEXT i%%
  RETURN f%% = k%%
END FUNCTION

END PROGRAM


func Factors(N);        \Return number of (prime) factors in N
int  N, F, C;
[C:= 0;  F:= 2;
repeat  if rem(N/F) = 0 then
                [C:= C+1;
                N:= N/F;
                ]
        else    F:= F+1;
until   F > N;
return C;
];

int K, C, N;
[for K:= 1 to 5 do
    [C:= 0;
    N:= 2;
    IntOut(0, K);  Text(0, ": ");
    loop [if Factors(N) = K then
            [IntOut(0, N);  ChOut(0, ^ );
            C:= C+1;
            if C >= 10 then quit;
            ];
            N:= N+1;
         ];
         CrLf(0);
    ];
]


anagrams←{
    tie←⍵ ⎕NTIE 0
    dict←⎕NREAD tie 80(⎕NSIZE tie)0
    boxes←((⎕UCS 10)≠dict)⊆dict
    ana←(({⍵[⍋⍵]}¨boxes)({⍵}⌸)boxes)
    ({~' '∊¨(⊃/¯1↑[2]⍵)}ana)⌿ana ⋄ ⎕NUNTIE
}


use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
-- Uses the customisable AppleScript-coded sort shown at <https://macscripter.net/viewtopic.php?pid=194430#p194430>.
-- It's assumed scripters will know how and where to install it as a library.
use sorter : script "Custom Iterative Ternary Merge Sort"
use scripting additions

on largestAnagramGroups(listOfWords)
    script o
        property wordList : listOfWords
        property doctoredWords : {}
        property longestRanges : {}
        property output : {}
    end script

    ignoring case
        -- Build another list containing doctored versions of the input words with their characters lexically sorted.
        set astid to AppleScript's text item delimiters
        set AppleScript's text item delimiters to ""
        repeat with thisWord in o's wordList
            set theseChars to thisWord's characters
            -- A straight ascending in-place sort here.
            tell sorter to sort(theseChars, 1, -1, {}) -- Params: (list, start index, end index, customisation spec.).
            set end of o's doctoredWords to theseChars as text
        end repeat
        set AppleScript's text item delimiters to astid

        -- Sort the list of doctored words to group them, rearranging the original-word list in parallel.
        tell sorter to sort(o's doctoredWords, 1, -1, {slave:{o's wordList}})

        -- Find the range(s) of the longest run(s) of equal texts in the doctored-word list.
        set longestRunLength to 1
        set i to 1
        set currentText to beginning of o's doctoredWords
        repeat with j from 2 to (count o's doctoredWords)
            set thisText to item j of o's doctoredWords
            if (thisText is not currentText) then
                set thisRunLength to j - i
                if (thisRunLength > longestRunLength) then
                    set o's longestRanges to {{i, j - 1}}
                    set longestRunLength to thisRunLength
                else if (thisRunLength = longestRunLength) then
                    set end of o's longestRanges to {i, j - 1}
                end if
                set currentText to thisText
                set i to j
            end if
        end repeat
        set finalRunLength to j - i + 1
        if (finalRunLength > longestRunLength) then
            set o's longestRanges to {{i, j}}
        else if (finalRunLength = longestRunLength) then
            set end of o's longestRanges to {i, j}
        end if

        -- Get the group(s) of words occupying the same range(s) in the original-word list.
        -- The stable parallel sort above will have kept each group's words in the same order with respect to each other.
        repeat with thisRange in o's longestRanges
            set {i, j} to thisRange
            set end of o's output to items i thru j of o's wordList
        end repeat

        -- As a final flourish, sort the list of groups by their first items.
        script byFirstItem
            on isGreater(a, b)
                return (a's beginning > b's beginning)
            end isGreater
        end script
        tell sorter to sort(o's output, 1, -1, {comparer:byFirstItem})
    end ignoring

    return o's output
end largestAnagramGroups

-- The closing values of AppleScript 'run handler' variables not explicity declared local are
-- saved back to the script file afterwards — and "unixdict.txt" contains 25,104 words!
local wordFile, wordList
-- The words in "unixdict.txt" are arranged one per line in alphabetical order.
-- Some contain punctuation characters, so they're best extracted as 'paragraphs' rather than as 'words'.
set wordFile to ((path to desktop as text) & "unixdict.txt") as «class furl»
set wordList to paragraphs of (read wordFile as «class utf8»)
return largestAnagramGroups(wordList)


# unordered
def proper_divisors:
  . as $n
  | if $n > 1 then 1,
      (sqrt|floor as $s
      | range(2; $s+1) as $i
      | if ($n % $i) == 0 then $i,
           (if $i * $i == $n then empty else ($n / $i) end)
	else empty
	end)
    else empty
    end;

def addup(stream): reduce stream as $i (0; . + $i);

def task(n):
  (reduce range(0; n+1) as $n
    ( [];  . + [$n | addup(proper_divisors)] )) as $listing
  | range(1;n+1) as $j
  | range(1;$j) as $k
  | if $listing[$j] == $k and $listing[$k] == $j
    then "\($k) and \($j) are amicable"
    else empty
    end ;

task(20000)


using Primes, Printf

function pcontrib(p::Int64, a::Int64)
    n = one(p)
    pcon = one(p)
    for i in 1:a
        n *= p
        pcon += n
    end
    return pcon
end

function divisorsum(n::Int64)
    dsum = one(n)
    for (p, a) in factor(n)
        dsum *= pcontrib(p, a)
    end
    dsum -= n
end

function amicables(L = 2*10^7)
    acnt = 0
    println("Amicable pairs not greater than ", L)
    for i in 2:L
        !isprime(i) || continue
        j = divisorsum(i)
        j < i && divisorsum(j) == i || continue
        acnt += 1
        println(@sprintf("%4d", acnt), " => ", j, ", ", i)
    end
end

amicables()


dict=readstr("unixdict.txt");
len=apply(s->#s, dict);
getLen(L)=my(v=List()); for(i=1,#dict, if(len[i]==L, listput(v, dict[i]))); Vec(v);
letters(s)=vecsort(Vec(s));
getAnagrams(v)=my(u=List(),L=apply(letters,v),t,w); for(i=1,#v-1, w=List(); t=L[i]; for(j=i+1,#v, if(L[j]==t, listput(w, v[j]))); if(#w, listput(u, concat([v[i]], Vec(w))))); Vec(u);
deranged(s1,s2)=s1=Vec(s1);s2=Vec(s2); for(i=1,#s1, if(s1[i]==s2[i], return(0))); 1
getDeranged(v)=my(u=List(),w); for(i=1,#v-1, for(j=i+1,#v, if(deranged(v[i], v[j]), listput(u, [v[i], v[j]])))); Vec(u);
f(n)=my(t=getAnagrams(getLen(n))); if(#t, concat(apply(getDeranged, t)), []);
forstep(n=vecmax(len),1,-1, t=f(n); if(#t, return(t)))


// Returns boolean indicating whether n is k-almost prime
sub almostPrime(n, k)
    local divisor, count

    divisor = 2

    while(count < (k + 1) and n <> 1)
        if not mod(n, divisor) then
            n = n / divisor
            count = count + 1
        else
            divisor = divisor + 1
        end if
    wend
    return count = k
end sub

// Generates table containing first ten k-almost primes for given k
sub kList(k, kTab())
    local n, i

    n = 2^k : i = 1
    while(i < 11)
        if almostPrime(n, k) then
            kTab(i) = n
            i = i + 1
        end if
        n = n + 1
    wend
end sub

// Main procedure, displays results from five calls to kList()
dim kTab(10)
for k = 1 to 5
    print "k = ", k, " : ";
    kList(k, kTab())
    for n = 1 to 10
        print kTab(n), ", ";
    next
    print "..."
next


primes:=Utils.Generator(Import("sieve").postponed_sieve);
(p10:=ar:=primes.walk(10)).println();
do(4){
   (ar=([[(x,y);ar;p10;'*]] : Utils.Helpers.listUnique(_).sort()[0,10])).println();
}


10 FOR k=1 TO 5
20 PRINT k;":";
30 LET c=0: LET i=1
40 IF c=10 THEN GO TO 100
50 LET i=i+1
60 GO SUB 1000
70 IF r THEN PRINT " ";i;: LET c=c+1
90 GO TO 40
100 PRINT
110 NEXT k
120 STOP
1000 REM kprime
1010 LET p=2: LET n=i: LET f=0
1020 IF f=k OR (p*p)>n THEN GO TO 1100
1030 IF n/p=INT (n/p) THEN LET n=n/p: LET f=f+1: GO TO 1030
1040 LET p=p+1: GO TO 1020
1100 LET r=(f+(n>1)=k)
1110 RETURN