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

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

.equ MAXI,   524

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Total  : @  pour @ \n"
szMessError:        .asciz "Number too large !!.\n"
szCarriageReturn:   .asciz "\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
tbNames:          .skip 8 * MAXI
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 // entry of program

    mov x0,#5
    bl functionG

    mov x0,#23
    bl functionG

    mov x0,#123
    bl functionG

    mov x0,#524
    bl functionG

    mov x0,#1234
    bl functionG
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
qAdrsMessResult:          .quad sMessResult
qAdrtbNames:              .quad tbNames
qAdrsZoneConv:            .quad sZoneConv
/******************************************************************/
/*            compute function G                                 */
/******************************************************************/
/* x0 contains N */
functionG:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    cmp x0,#MAXI + 1
    bge 2f
    mov x3,x0
    mov x2,#1
1:                               // loop compute every item
    mov x0,x2
    bl computeNumber
    add x2,x2,#1
    cmp x2,x3
    ble 1b

    ldr x1,qAdrsZoneConv         // result display
    bl conversion10              // call decimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv         // insert conversion in message
    bl strInsertAtCharInc
    mov x4,x0
    mov x0,x3
    ldr x1,qAdrsZoneConv         // result display
    bl conversion10              // call decimal conversion
    mov x0,x4
    ldr x1,qAdrsZoneConv         // insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    mov x0,#0
    b 100f
2:
    ldr x0,qAdrszMessError
    bl affichageMess
    mov x0,#-1
100:
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrszMessError:         .quad szMessError
/******************************************************************/
/*            random door test strategy                           */
/******************************************************************/
/* x0 contains N */
computeNumber:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    ldr x6,qAdrtbNames           // table address
    mov x1,#1
    str x1,[x6]                  // init item 0
    mov x1,#0
    str x1,[x6,x0,lsl #3]        // init item N
    mov x2,#1                    // indice
1:
    add x3,x2,x2, lsl #1
    sub x4,x3,#1
    mul x4,x2,x4
    lsr x4,x4,#1
    subs x3,x0,x4                // compute new indice
    blt 90f
    tst x2,#1                    // indice owen ?
    beq 2f
    ldr x4,[x6,x3,lsl #3]
    ldr x5,[x6,x0,lsl #3]
    add x5,x5,x4                 // addition
    str x5,[x6,x0,lsl #3]
    b 3f
2:                               // else substrac
    ldr x4,[x6,x3,lsl #3]
    ldr x5,[x6,x0,lsl #3]
    sub x5,x5,x4
    str x5,[x6,x0,lsl #3]
3:
    subs x3,x3,x2                // compute new indice
    blt 90f

    tst x2,#1                    // owen ?
    beq 4f
    ldr x4,[x6,x3,lsl #3]
    ldr x5,[x6,x0,lsl #3]
    add x5,x5,x4
    str x5,[x6,x0,lsl #3]
    b 5f
4:
    ldr x4,[x6,x3,lsl #3]
    ldr x5,[x6,x0,lsl #3]
    sub x5,x5,x4
    str x5,[x6,x0,lsl #3]
5:
    add x2,x2,#1
    cmp x2,x0
    ble 1b
90:
   ldr x0,[x6,x0,lsl #3]         // return last item of table
100:
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Text_IO;
with Ada.Numerics.Big_Numbers.Big_Integers;

procedure Names_Of_God is

   NN         : constant := 100_000;
   Row_Count  : constant := 25;
   Max_Column : constant := 79;

   package Triangle is
      procedure Print;
   end Triangle;

   package Row_Summer is
      procedure Calc (N : Integer);
      procedure Put_Sums;
   end Row_Summer;

   package body Row_Summer is
      use Ada.Text_IO;
      use Ada.Numerics.Big_Numbers.Big_Integers;

      P : array (0 .. NN + 1) of Big_Integer := (1, others => 0);

      procedure Calc (N : Integer) is
      begin
         P (N) := 0;

         for K in 1 .. N + 1 loop
            declare
               Add : constant Boolean := K mod 2 /= 0;
               D_1 : constant Integer := N - K * (3 * K - 1) / 2;
               D_2 : constant Integer := D_1 - K;
            begin
               exit when D_1 < 0;

               if Add
               then P (N) := P (N) + P (D_1);
               else P (N) := P (N) - P (D_1);
               end if;

               exit when D_2 < 0;

               if Add
               then P (N) := P (N) + P (D_2);
               else P (N) := P (N) - P (D_2);
               end if;
            end;
         end loop;
      end Calc;

      procedure Put_Wrapped (Item : Big_Integer) is
         Image : constant String := To_String (Item);
      begin
         Set_Col (11);
         for I in Image'Range loop
            if Ada.Text_IO.Col >= Max_Column then
               Set_Col (12);
            end if;
            Put (Image (I));
         end loop;
      end Put_Wrapped;

      procedure Put_Sums
      is
         package Integer_IO is new Ada.Text_IO.Integer_IO (Integer);

         Printout : constant array (Natural range <>) of Integer :=
           (23, 123, 1234, 12_345, 20_000, 30_000, 40_000, 50_000, NN);

         Next : Natural := Printout'First;
      begin
         for A in 1 .. Printout (Printout'Last) loop
            Calc (A);
            if A = Printout (Next) then
               Put ("G (");
               Integer_IO.Put (A, Width => 0);
               Put (")");
               Put_Wrapped (P (A));
               New_Line;
               Next := Next + 1;
            end if;
         end loop;
      end Put_Sums;

   end Row_Summer;

   package body Triangle is

      Triangle : array (0 .. Row_Count,
                        0 .. Row_Count) of Integer := (others => (others => 0));

      procedure Calculate is
      begin
         Triangle (1,1) := 1;
         Triangle (2,1) := 1;
         Triangle (2,2) := 1;
         Triangle (3,1) := 1;
         Triangle (3,2) := 1;
         Triangle (3,3) := 1;
         for Row in 4 .. Row_Count loop
            for Col in 1 .. Row loop
               if Col * 2 > Row then
                  Triangle (Row, Col) := Triangle (Row - 1, Col - 1);
               else
                  Triangle (Row, Col) :=
                    Triangle (Row - 1, Col - 1) +
                    Triangle (Row - Col, Col);
               end if;
            end loop;
         end loop;
      end Calculate;

      procedure Print
      is
         use Ada.Text_IO;
         Width : array (1 .. Row_Count) of Natural := (others => 0);
      begin
         for Row in 1 .. Row_count loop
            for Col in 1 .. Row loop
               Width (Row) := Width (Row) + Triangle (Row, Col)'Image'Length;
            end loop;
         end loop;

         for Row in 1 .. Row_Count loop
            Set_Col (1 + Positive_Count (1 + Width (Width'Last)
                                           - Width (Row)) / 2);
            for Col in 1 .. Row loop
               Put (Triangle (Row, Col)'Image);
            end loop;
            New_Line;
         end loop;
      end Print;

   begin
      Calculate;
   end Triangle;

begin
   Triangle.Print;
   Row_Summer.Put_Sums;
end Names_Of_God;


blocks <- rbind(c("B","O"),
 c("X","K"),
 c("D","Q"),
 c("C","P"),
 c("N","A"),
 c("G","T"),
 c("R","E"),
 c("T","G"),
 c("Q","D"),
 c("F","S"),
 c("J","W"),
 c("H","U"),
 c("V","I"),
 c("A","N"),
 c("O","B"),
 c("E","R"),
 c("F","S"),
 c("L","Y"),
 c("P","C"),
 c("Z","M"))

canMake <- function(x) {
  x <- toupper(x)
  used <- rep(FALSE, dim(blocks)[1L])
  charList <- strsplit(x, character(0))
  tryChars <- function(chars, pos, used, inUse=NA) {
    if (pos > length(chars)) {
      TRUE
    } else {
      used[inUse] <- TRUE
      possible <- which(blocks == chars[pos] & !used, arr.ind=TRUE)[, 1L]
      any(vapply(possible, function(possBlock) tryChars(chars, pos + 1, used, possBlock), logical(1)))
    }
  }
  setNames(vapply(charList, tryChars, logical(1), 1L, used), x)
}
canMake(c("A",
           "BARK",
           "BOOK",
           "TREAT",
           "COMMON",
           "SQUAD",
           "CONFUSE"))


#lang racket
(define block-strings
  (list "BO" "XK" "DQ" "CP" "NA"
        "GT" "RE" "TG" "QD" "FS"
        "JW" "HU" "VI" "AN" "OB"
        "ER" "FS" "LY" "PC" "ZM"))
(define BLOCKS (map string->list block-strings))

(define (can-make-word? w)
  (define (usable-block blocks word-char)
    (for/first ((b (in-list blocks)) #:when (memf (curry char-ci=? word-char) b)) b))

  (define (inner word-chars blocks tried-blocks)
    (cond
      [(null? word-chars) #t]
      [(usable-block blocks (car word-chars))
       =>
       (lambda (b)
         (or
          (inner (cdr word-chars) (append tried-blocks (remove b blocks)) null)
          (inner word-chars (remove b blocks) (cons b tried-blocks))))]
      [else #f]))
  (inner (string->list w) BLOCKS null))

(define WORD-LIST '("" "A" "BARK" "BOOK" "TREAT" "COMMON" "SQUAD" "CONFUSE"))
(define (report-word w)
  (printf "Can we make: ~a? ~a~%"
          (~s w #:min-width 9)
          (if (can-make-word? w) "yes" "no")))

(module+ main
  (for-each report-word WORD-LIST))

(module+ test
  (require rackunit)
  (check-true  (can-make-word? ""))
  (check-true  (can-make-word? "A"))
  (check-true  (can-make-word? "BARK"))
  (check-false (can-make-word? "BOOK"))
  (check-true  (can-make-word? "TREAT"))
  (check-false (can-make-word? "COMMON"))
  (check-true  (can-make-word? "SQUAD"))
  (check-true  (can-make-word? "CONFUSE")))


/* ARM assembly Raspberry PI  */
/*  program integerName.s   */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

.equ MAXI,   127

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Total  : @  \n"
szMessError:        .asciz "Number too large !!.\n"
szCarriageReturn:   .asciz "\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
tbNames:          .skip 4 * MAXI
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 @ entry of program

    mov r0,#5
    bl functionG

    mov r0,#23
    bl functionG

    mov r0,#123
    bl functionG

    mov r0,#1234
    bl functionG

100:                                  @ standard end of the program
    mov r0, #0                        @ return code
    mov r7, #EXIT                     @ request to exit program
    svc #0                            @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrtbNames:               .int tbNames
iAdrsZoneConv:            .int sZoneConv
/******************************************************************/
/*            compute function G                                 */
/******************************************************************/
/* r0 contains N */
functionG:
    push {r1-r3,lr}              @ save registers
    cmp r0,#MAXI + 1
    bge 2f
    mov r3,r0
    mov r2,#1
1:                               @ loop compute every item
    mov r0,r2
    bl computeNumber
    add r2,r2,#1
    cmp r2,r3
    ble 1b

    ldr r1,iAdrsZoneConv         @ result display
    bl conversion10              @ call decimal conversion
    ldr r0,iAdrsMessResult
    ldr r1,iAdrsZoneConv         @ insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    mov r0,#0
    b 100f
2:
    ldr r0,iAdrszMessError
    bl affichageMess
    mov r0,#-1
100:
    pop {r1-r3,lr}
    bx lr                         @ return
iAdrszMessError:         .int szMessError
/******************************************************************/
/*            random door test strategy                           */
/******************************************************************/
/* r0 contains N */
computeNumber:
    push {r1-r7,lr}              @ save registers
    ldr r6,iAdrtbNames           @ table address
    mov r1,#1
    str r1,[r6]                  @ init item 0
    mov r1,#0
    str r1,[r6,r0,lsl #2]        @ init item N
    mov r2,#1                    @ indice
1:
    add r3,r2,r2, lsl #1
    sub r4,r3,#1
    mul r4,r2,r4
    lsr r4,r4,#1
    subs r3,r0,r4                @ compute new indice
    blt 90f
    tst r2,#1                    @ indice owen ?
    beq 2f
    ldr r4,[r6,r3,lsl #2]
    ldr r5,[r6,r0,lsl #2]
    add r5,r5,r4                 @ addition
    str r5,[r6,r0,lsl #2]
    b 3f
2:                               @ else substrac
    ldr r4,[r6,r3,lsl #2]
    ldr r5,[r6,r0,lsl #2]
    sub r5,r5,r4
    str r5,[r6,r0,lsl #2]
3:
    subs r3,r3,r2                @ compute new indice
    blt 90f

    tst r2,#1                    @ owen ?
    beq 4f
    ldr r4,[r6,r3,lsl #2]
    ldr r5,[r6,r0,lsl #2]
    add r5,r5,r4
    str r5,[r6,r0,lsl #2]
    b 5f
4:
    ldr r4,[r6,r3,lsl #2]
    ldr r5,[r6,r0,lsl #2]
    sub r5,r5,r4
    str r5,[r6,r0,lsl #2]
5:
    add r2,r2,#1
    cmp r2,r0
    ble 1b
90:
   ldr r0,[r6,r0,lsl #2]         @ return last item of table
100:
    pop {r1-r7,lr}
    bx lr                        @ return

/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


multi can-spell-word(Str $word, @blocks) {
    my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) }
    can-spell-word $word.uc.comb.list, @regex;
}

multi can-spell-word([$head,*@tail], @regex) {
    for @regex -> $re {
        if $head ~~ $re {
            return True unless @tail;
            return False if @regex == 1;
            return True if can-spell-word @tail, list @regex.grep: * !=== $re;
        }
    }
    False;
}

my @b = <BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM>;

for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {
    say "$_     &can-spell-word($_, @b)";
}


SetBatchLines -1

InputBox, Enter_value, Enter the no. of lines sought
array := []
Loop, % 2*Enter_value - 1
	Loop, % x := A_Index
		y := A_Index, Array[x, y] := 1

x := 3

Loop
{
	base_r := x - 1
	, x++
	, y := 2
	, index := x
	, new := 1

	Loop, % base_r - 1
	{
		array[x, new+1] := array[x-1, new] + array[base_r, y]
		, x++
		, new ++
		, y++
	}
	x := index
	If ( mod(x,2) = 0 )
	{
		to_run := floor(x - x/2)
		, y2 := to_run + 1
	}
	Else
	{
		to_run := x - floor(x/2)
		, y2 := to_run
	}
	Loop, % to_run
	{
		array[x, y2] := array[x-1, y2-1]
		, y2++
		If ( y2 = Enter_value + 1 ) && ( x = Enter_value )
		{
			Loop, % Enter_value
			{
				Loop, % x11 := A_Index
				{
					y11 := A_Index
					, string2 .= " " array[x11, y11]
				}
				string2 .= "`n"
			}
			MsgBox % string2
			ExitApp
		}
	}
}

~Esc::ExitApp


dim Blocks as string
dim InWord as string

Function CanMakeWord (FInWord as string, FBlocks as string) as integer
    dim WIndex as integer, BIndex as integer

    FBlocks = UCase$(FBlocks) - " " - ","
    FInWord = UCase$(FInWord)

    for WIndex = 1 to len(FInWord)
        BIndex = instr(FBlocks, FInWord[WIndex])

        if BIndex then
            FBlocks = Replace$(FBlocks,"**",iif(BIndex mod 2,BIndex,BIndex-1))
        else
            Result = 0
            exit function
        end if
    next

    Result = 1
end function

InWord = "Confuse"
Blocks = "BO, XK, DQ, CP, NA, GT, RE, TG, QD, FS, JW, HU, VI, AN, OB, ER, FS, LY, PC, ZM"
showmessage "Can make: " + InWord + " = " + iif(CanMakeWord(InWord, Blocks), "True", "False")


Red []
test: func [ s][
p: copy "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
forever [
    if 0 = length? s [  return  'true   ]               ;; if string cleared, all chars found/removed
    if tail? p  [  return 'false   ]                      ;; if at end of search block - not found
    rule: reduce [  first p  '| second p]                 ;; construct parse rule from string
    either parse s [  to rule remove rule to end ] [    ;; remove found char from string
      remove/part p 2                                     ;;character found , remove block
      p: head p                                             ;;start from remaining string at beginning aka head
    ] [  p: skip p 2  ]                                      ;; else move to next block
]
]
foreach word split {A bark book TrEAT COmMoN SQUAD conFUsE}  space [
  print reduce [ pad copy word 8 ":" test word]
 ]


#include <stdio.h>
#include <gmp.h>

#define N 100000
mpz_t p[N + 1];

void calc(int n)
{
	mpz_init_set_ui(p[n], 0);

	for (int k = 1; k <= n; k++) {
		int d = n - k * (3 * k - 1) / 2;
		if (d < 0) break;

		if (k&1)mpz_add(p[n], p[n], p[d]);
		else	mpz_sub(p[n], p[n], p[d]);

		d -= k;
		if (d < 0) break;

		if (k&1)mpz_add(p[n], p[n], p[d]);
		else	mpz_sub(p[n], p[n], p[d]);
	}
}

int main(void)
{
	int idx[] = { 23, 123, 1234, 12345, 20000, 30000, 40000, 50000, N, 0 };
	int at = 0;

	mpz_init_set_ui(p[0], 1);

	for (int i = 1; idx[at]; i++) {
		calc(i);
		if (i != idx[at]) continue;

		gmp_printf("%2d:\t%Zd\n", i, p[i]);
		at++;
	}
}


/*REXX pgm finds if words can be spelt from a pool of toy blocks (each having 2 letters)*/
list= 'A bark bOOk treat common squaD conFuse'   /*words can be:  upper/lower/mixed case*/
blocks= 'BO  XK  DQ  CP  NA  GT  RE  TG  QD  FS  JW  HU  VI  AN  OB  ER  FS  LY  PC  ZM'
              do k=1  for  words(list)           /*traipse through a list of some words.*/
              call  spell  word(list, k)         /*display if word can be spelt (or not)*/
              end   /*k*/                        /* [↑]  tests each word in the list.   */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
spell: procedure expose blocks;  arg x           /*ARG  uppercases the word to be spelt.*/
                         L= length(x);   @.= 0   /*get length of the word to be spelt.  */
           do try=1  for L;  z= blocks;  upper z /*use a fresh copy of the  "Z"  blocks.*/
             do n=1  for L;  y= substr(x, n, 1)  /*attempt another letter in the word.  */
             @.n= pos(y, z, 1 + @.n);    if @.n==0  then leave   /*not found?  Try again*/
             z= overlay(' ', z, @.n)             /*mutate the toy block  ───►  a onesy. */
                do q=1  for words(z);    if length(word(z,q))==1  then z= delword(z, q, 1)
                end   /*q*/                      /* [↑]  elide any existing onesy block.*/
             if n==L  then leave try             /*was last letter used in the spelling?*/
             end      /*n*/                      /* [↑]  end of a  toy block  usage.    */
           end        /*try*/                    /* [↑]  end of a  "TRY"  permute.      */
       say right( arg(1), 30)    right( word( "can't can", (n==L) + 1), 6)     'be spelt.'
       return


using System;
using System.Collections.Generic;
using System.Linq;
using System.Numerics;

namespace NamesOfGod
{
    public class RowSummer
    {
        const int N = 100000;
        public BigInteger[] p;

        private void calc(int n)
            /* Translated from C */
        {
            p[n] = 0;

            for (int k = 1; k <= n; k++)
            {
                int d = n - k * (3 * k - 1) / 2;
                if (d < 0) break;

                if ((k & 1) != 0) p[n] += p[d];
                else p[n] -= p[d];

                d -= k;
                if (d < 0) break;

                if ((k & 1) != 0) p[n] += p[d];
                else p[n] -= p[d];
            }

        }
        public void PrintSums()
            /* translated from C */
        {
            p = new BigInteger[N + 1];
            var idx = new int[] { 23, 123, 1234, 12345, 20000, 30000, 40000, 50000, N, 0 };
            int at = 0;

            p[0] = 1;

            for (int i = 1; idx[at] > 0; i++)
            {
                calc(i);
                if (i != idx[at]) continue;
                Console.WriteLine(i + ":\t" + p[i]);
                at++;
            }
        }
    }

    public class RowPrinter
        /* translated from Python */
    {
        List<List<int>> cache;
        public RowPrinter()
        {
            cache = new List<List<int>> { new List<int> { 1 } };
        }
        public List<int> cumu(int n)
        {
            for (int l = cache.Count; l < n + 1; l++)
            {
                var r = new List<int> { 0 };
                for (int x = 1; x < l + 1; x++)
                    r.Add(r.Last() + cache[l - x][Math.Min(x, l - x)]);
                cache.Add(r);
            }
            return cache[n];
        }
        public List<int> row(int n)
        {
            var r = cumu(n);
            return (from i in Enumerable.Range(0, n) select r[i + 1] - r[i]).ToList();
        }
        public void PrintRows()
        {
            var rows = Enumerable.Range(1, 25).Select(x => string.Join(" ", row(x))).ToList();
            var widest = rows.Last().Length;
            foreach (var r in rows)
                Console.WriteLine(new String(' ', (widest - r.Length) / 2) + r);
        }
    }

    class Program
    {
        static void Main(string[] args)
        {
            var rpr = new RowPrinter();
            rpr.PrintRows();
            var ros = new RowSummer();
            ros.PrintSums();
            Console.ReadLine();
        }
    }
}


Blocks = [ :BO, :XK, :DQ, :CP, :NA, :GT, :RE, :TG, :QD, :FS, :JW, :HU, :VI, :AN, :OB, :ER, :FS, :LY, :PC, :ZM ]
Words = [ :A, :BARK, :BOOK, :TREAT, :COMMON, :SQUAD, :CONFUSE ]

for x in words
see '>>> can_make_word("' + upper(x) + '")' + nl
if checkword(x,blocks) see "True" + nl
else see "False" + nl
ok
next

func CheckWord Word,Blocks
cBlocks = BLocks
for x in word
Found = false
for y = 1 to len(cblocks)
if x = cblocks[y][1] or x = cblocks[y][2]
cblocks[y] = "--"
found = true
exit
ok
next
if found = false return false ok
next
return true


words = %w(A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE) << ""

words.each do |word|
  blocks = "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
  res = word.each_char.all?{|c| blocks.sub!(/\w?#{c}\w?/i, "")}  #regexps can be interpolated like strings
  puts "#{word.inspect}: #{res}"
end


F shortest_abbreviation_length(line, list_size)
   V words = line.split(‘ ’)
   V word_count = words.len
   I word_count != list_size
      X ValueError(‘Not enough entries, expected #. found #.’.format(list_size, word_count))

   V abbreviation_length = 1
   L
      V abbreviations = Set(words.map(word -> word[0 .< @abbreviation_length]))
      I abbreviations.len == list_size
         R abbreviation_length
      abbreviation_length++

F automatic_abbreviations(filename, words_per_line)
   L(line) File(filename).read().split("\n")
      I line.len > 0
         V length = shortest_abbreviation_length(line, words_per_line)
         print(‘#2 #.’.format(length, line))
      E
         print()

automatic_abbreviations(‘daysOfWeek.txt’, 7)


// Calculate hypotenuse n of OTT assuming only nothingness, unity, and hyp[n-1] if n>1
// Nigel Galloway, May 6th., 2013
#include <gmpxx.h>
int N{123456};
mpz_class hyp[N-3];
const mpz_class G(const int n,const int g){return g>n?0:(g==1 or n-g<2)?1:hyp[n-g-2];};
void G_hyp(const int n){for(int i=0;i<N-2*n-1;i++) n==1?hyp[n-1+i]=1+G(i+n+1,n+1):hyp[n-1+i]+=G(i+n+1,n+1);}
}


(defn nine-billion-names [row column]
  (cond (<= row 0) 0
        (<= column 0) 0
        (< row column) 0
        (= row 1) 1
        :else (let [addend (nine-billion-names (dec row) (dec column))
                    augend (nine-billion-names (- row column) column)]
	            (+ addend augend))))

(defn print-row [row]
  (doseq [x (range 1 (inc row))]
    (print (nine-billion-names row x) \space))
    (println))

(defn print-triangle [rows]
  (doseq [x (range 1 (inc rows))]
    (print-row x)))

(print-triangle 25)


blocks$    = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM"
makeWord$  = "A,BARK,BOOK,TREAT,COMMON,SQUAD,Confuse"
b          = int((len(blocks$) /3) +  1)
dim blk$(b)

for i = 1 to len(makeWord$)
  wrd$ = word$(makeWord$,i,",")
  dim hit(b)
  n = 0
  if wrd$ = "" then exit for
  for k = 1 to len(wrd$)
    w$ = upper$(mid$(wrd$,k,1))
    for j = 1 to b
     if hit(j) = 0 then
      if w$ = left$(word$(blocks$,j,","),1) or w$ = right$(word$(blocks$,j,","),1) then
        hit(j) = 1
        n = n + 1
        exit for
      end if
     end if
    next j
  next k
  print wrd$;chr$(9);
  if n = len(wrd$) then print " True" else print " False"
next i


use std::iter::repeat;

fn rec_can_make_word(index: usize, word: &str, blocks: &[&str], used: &mut[bool]) -> bool {
    let c = word.chars().nth(index).unwrap().to_uppercase().next().unwrap();
    for i in 0..blocks.len() {
        if !used[i] && blocks[i].chars().any(|s| s == c) {
            used[i] = true;
            if index == 0 || rec_can_make_word(index - 1, word, blocks, used) {
                return true;
            }
            used[i] = false;
        }
    }
    false
}

fn can_make_word(word: &str, blocks: &[&str]) -> bool {
    return rec_can_make_word(word.chars().count() - 1, word, blocks,
                             &mut repeat(false).take(blocks.len()).collect::<Vec<_>>());
}

fn main() {
    let blocks = [("BO"), ("XK"), ("DQ"), ("CP"), ("NA"), ("GT"), ("RE"), ("TG"), ("QD"), ("FS"),
                  ("JW"), ("HU"), ("VI"), ("AN"), ("OB"), ("ER"), ("FS"), ("LY"), ("PC"), ("ZM")];
    let words = ["A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"];
    for word in &words {
        println!("{} -> {}", word, can_make_word(word, &blocks))
    }
}


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program abbrAuto64.s   */
/* store list of day in a file listDays.txt*/
/* and run the program  abbrAuto64 listDays.txt */

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

.equ BUFFERSIZE,   10000
.equ NBMAXIDAYS, 7

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessTitre:            .asciz "Nom du fichier : "
szCarriageReturn:      .asciz "\n"
szMessErreur:          .asciz "Error detected.\n"
szMessErrBuffer:       .asciz "buffer size too less !!"
szSpace:               .asciz " "
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:      .skip 24
qAdrFicName:    .skip 8
iTabAdrDays:    .skip 8 * NBMAXIDAYS
iTabAdrDays2:   .skip 8 * NBMAXIDAYS
sBufferDays:    .skip BUFFERSIZE
sBuffer:        .skip BUFFERSIZE
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                // INFO: main
    mov x0,sp                        // stack address for load parameter
    bl traitFic                      // read file and process

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
qAdrsZoneConv:             .quad sZoneConv

/******************************************************************/
/*     read file                                                   */
/******************************************************************/
/* x0 contains address stack begin           */
traitFic:                             // INFO: traitFic
    stp x1,lr,[sp,-16]!               // save  registres
    stp x2,x3,[sp,-16]!               // save  registres
    stp x4,x5,[sp,-16]!               // save  registres
    stp x6,x7,[sp,-16]!               // save  registres
    stp x8,fp,[sp,-16]!               // save  registres
    mov fp,x0                         //  fp <- start address
    ldr x4,[fp]                       // number of Command line arguments
    cmp x4,#1
    ble 99f
    add x5,fp,#16                      // second parameter address
    ldr x5,[x5]
    ldr x0,qAdrqAdrFicName
    str x5,[x0]
    ldr x0,qAdrszMessTitre
    bl affichageMess                  // display string
    mov x0,x5
    bl affichageMess
    ldr x0,qAdrszCarriageReturn
    bl affichageMess                  // display carriage return

    mov x0,AT_FDCWD
    mov x1,x5                         // file name
    mov x2,#O_RDWR                    // flags
    mov x3,#0                         // mode
    mov x8, #OPEN                     // call system OPEN
    svc 0
    cmp x0,#0                         // error ?
    ble 99f
    mov x7,x0                         // File Descriptor
    ldr x1,qAdrsBufferDays             // buffer address
    mov x2,#BUFFERSIZE                // buffer size
    mov x8,#READ                      // read file
    svc #0
    cmp x0,#0                         // error ?
    blt 99f
    // extraction datas
    ldr x1,qAdrsBufferDays             // buffer address
    add x1,x1,x0
    mov x0,#0                         // store zéro final
    strb w0,[x1]
    ldr x0,qAdriTabAdrDays             // key string command table
    ldr x1,qAdrsBufferDays             // buffer address
    bl extracDatas
                                       // close file
    mov x0,x7
    mov x8, #CLOSE
    svc 0
    mov x0,#0
    b 100f
99:                                    // error
    ldr x0,qAdrszMessErreur            // error message
    bl  affichageMess
    mov x0,#-1
100:
    ldp x8,fp,[sp],16                  // restaur des  2 registres
    ldp x6,x7,[sp],16                  // restaur des  2 registres
    ldp x4,x5,[sp],16                  // restaur des  2 registres
    ldp x2,x3,[sp],16                  // restaur des  2 registres
    ldp x1,lr,[sp],16                  // restaur des  2 registres
    ret
qAdrqAdrFicName:              .quad qAdrFicName
qAdrszMessTitre:              .quad szMessTitre
qAdrszMessErreur:             .quad szMessErreur
qAdrsBuffer:                  .quad sBuffer
qAdrsBufferDays:              .quad sBufferDays
qAdriTabAdrDays:              .quad iTabAdrDays
/******************************************************************/
/*     extrac lines file buffer                                   */
/******************************************************************/
/* x0 contains strings address           */
/* x1 contains buffer address         */
extracDatas:                     // INFO: extracDatas
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,fp,[sp,-16]!          // save  registres
    mov x7,x0
    mov x6,x1
    mov x2,#0                    // string buffer indice
    mov x4,x1                    // start string
    mov x5,#0                    // string index
1:
    ldrb w3,[x6,x2]
    cmp w3,#0
    beq 4f                       // end
    cmp w3,#0xA
    beq 2f
    cmp w3,#' '                  // end string
    beq 3f
    add x2,x2,#1
    b 1b
2:
    mov x3,#0
    strb w3,[x6,x2]
    ldrb w3,[x6,x2]
    cmp w3,#0xD
    bne 21f
    add x2,x2,#2
    b 22f
21:
    add x2,x2,#1
22:
    mov x0,x4                   // store last day of line in table
    str x4,[x7,x5,lsl #3]
    mov x0,x5                   // days number
    bl traitLine                // process a line of days
    mov x5,#0                   // new line
    b 5f

3:
    mov x3,#0
    strb w3,[x6,x2]
    add x2,x2,#1
4:
    mov x0,x4
    str x4,[x7,x5,lsl #3]
    add x5,x5,#1
5:                              // supress spaces
    ldrb w3,[x6,x2]
    cmp w3,#0
    beq 100f
    cmp w3,#' '
    cinc x2,x2,eq
    beq 5b

    add x4,x6,x2                 // new start address
    b 1b
100:
    ldp x8,fp,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     processing a line                                          */
/******************************************************************/
/* x0 contains days number in table   */
traitLine:                    // INFO: traitLine
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    stp x10,x11,[sp,-16]!          // save  registres
    stp x12,x13,[sp,-16]!          // save  registres
    cmp x0,#1                 // one day ?
    bgt 1f                    // no

    ldr x0,qAdrszCarriageReturn // yes display empty line
    bl affichageMess
    b 100f
1:                            // line OK
    mov x6,x0                 // days number
    ldr x0,qAdriTabAdrDays
    ldr x1,qAdriTabAdrDays2
    mov x2,#0
11:                           // copy days table into other for display final
    ldr x3,[x0,x2,lsl #3]
    str x3,[x1,x2,lsl #3]
    add x2,x2,#1
    cmp x2,x6
    ble 11b
    ldr x0,qAdriTabAdrDays    // and sort first table
    mov x1,#0
    add x2,x6,#1
    bl insertionSort

    mov x8,#1                 // abbrevations counter
    ldr x12,qAdriTabAdrDays
    mov x2,#0
    ldr x10,[x12,x2,lsl #3]   // load first sorting day
    mov x11,#0
    mov x3,#1
2:                            // begin loop
    ldr x4,[x12,x3,lsl #3]    // load other day
    mov x0,x10                // day1
    mov x1,x4                 // day 2
    mov x2,#0                 // position 0
    bl compareChar
    cmp x0,#0                 // first letter equal ?
    beq 3f
    mov x10,x4                // no -> move day 2 in day 1
    b 6f
3:                            // if equal
    mov x7,x1                 // characters length (1,2,3)
    mov x11,#1                // letters position
4:                            // loop to compare letters days
    mov x0,x10
    mov x1,x4
    mov x2,x7
    bl compareChar
    cmp x0,#0
    bne 5f
    cmp x5,#0                 // if end
    beq 5f
    add x7,x7,x1              // next character
    add x11,x11,#1            // count letter
    b 4b
5:
    add x11,x11,#1            // increment letters position
    cmp x11,x8                // and store if > position précedente
    csel x8,x11,x8,gt
    //movgt x8,x11
    mov x10,x4                 // and day1 = day2

6:
    add x3,x3,#1              // increment day
    cmp x3,x6
    ble 2b                    // and loop

    mov x0,x8                 // display position letter
    ldr x1,qAdrsZoneConv
    bl conversion10
    //mov x2,#0
    //strb x2,[x1,x0]
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrszSpace
    bl affichageMess
    ldr x0,qAdriTabAdrDays2   // and display list origine days
    mov x1,x6
    bl displayListDays

100:
    ldp x12,x13,[sp],16         // restaur des  2 registres
    ldp x10,x11,[sp],16         // restaur des  2 registres
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrszSpace:          .quad szSpace
qAdriTabAdrDays2:     .quad iTabAdrDays2
/******************************************************************/
/*     comparison character unicode                               */
/******************************************************************/
/* x0 contains address first string            */
/* x1 contains address second string */
/* x2 contains the character position to compare  */
/* x0 return 0 if equal 1 if > -1 if < */
/* x1 return character S1 size in octet if equal */
/* x2 return character S2 size in octet */
compareChar:
    stp lr,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    ldrb w3,[x0,x2]
    ldrb w4,[x1,x2]
    cmp w3,w4                    // compare first byte
    blt 3f
    bgt 4f
    bne 100f
    and w3,w3,#0b11100000           // 3 bytes ?
    cmp w3,#0b11100000
    bne 1f
    add x2,x2,#1
    ldrb w3,[x0,x2]
    ldrb w4,[x1,x2]
    cmp w3,w4
    blt 3f
    bgt 4f
    bne 100f
    add x2,x2,#1
    ldrb w3,[x0,x2]
    ldrb w4,[x1,x2]
    cmp w3,w4
    blt 3f
    bgt 4f
    bne 100f
    mov x0,#0
    mov x1,#3
    b 100f
1:
    cmp w3,#0b11000000           // 2 bytes ?
    bne 2f
    add x2,x2,#1
    ldrb w3,[x0,x2]
    ldrb w4,[x1,x2]
    cmp w3,w4
    blt 3f
    bgt 4f
    bne 100f
    mov x0,#0
    mov x1,#2
    b 100f
2:                              // 1 byte
    mov x0,#0
    mov x1,#1
    b 100f
3:
    mov x0,#-1
    b 100f
4:
    mov x0,#1
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp lr,x3,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     control load                                      */
/******************************************************************/
/* x0 contains string table           */
/* x1 contains days number */
displayListDays:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    mov x5,x0
    mov x2,#0
1:
    cmp x2,x1
    bgt 2f
    ldr x0,[x5,x2,lsl #3]
    bl affichageMess
    ldr x0,qAdrszSpace
    bl affichageMess
    add x2,x2,#1
    b 1b
2:
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/************************************/
/* 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  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    mov x2,#0                // counter
1:
    ldrb w3,[x0,x2]          // byte string 1
    ldrb w4,[x1,x2]          // byte string 2
    cmp w3,w4
    blt 2f
    bgt 3f
    bne 100f                 // not equals
    cmp w3,#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 des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*         insertion sort                                              */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first element    */
/* x2 contains the number of element */
insertionSort:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    mov x6,x0
    add x3,x1,#1                       // start index i
1:                                     // start loop
    ldr x1,[x6,x3,lsl #3]              // load value A[i]
    sub x5,x3,#1                       // index j
2:
    ldr x4,[x6,x5,lsl #3]              // load value A[j]
    mov x0,x4
    bl comparStrings
    cmp x0,#1                          // compare value
    bne 3f
    add x5,x5,#1                          // increment index j
    str x4,[x6,x5,lsl #3]              // store value A[j+1]
    subs x5,x5,#2                         // j = j - 1
    bge 2b                             // loop if j >= 0
3:
    add x5,x5,#1                          // increment index j
    str x1,[x6,x5,lsl #3]              // store value A[i] in A[j+1]
    add x3,x3,#1                          // increment index i
    cmp x3,x2                          // end ?
    blt 1b                             // no -> loop

100:
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Containers.Indefinite_Vectors;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Text_IO;

procedure Abbreviations is

   package String_Vectors is
     new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                            Element_Type => String);
   use Ada.Text_IO, String_Vectors;

   function Split (Line : String) return Vector is
      Result : Vector;
      First  : Natural;
      Last   : Natural := Line'First - 1;
   begin
      while Last + 1 in Line'Range loop
         Ada.Strings.Fixed.Find_Token
           (Line, Ada.Strings.Maps.To_Set (" "), Last + 1,
            Ada.Strings.Outside, First, Last);
         exit when Last = 0;
         Append (Result, Line (First .. Last));
      end loop;
      return Result;
   end Split;

   function Abbrev_Length (Items : Vector) return Natural is
      use type Ada.Containers.Count_Type;
      Max     : Natural := 0;
      Abbrevs : Vector;
   begin
      for Item of Items loop
         Max := Natural'Max (Max, Item'Length);
      end loop;

      for Length in 1 .. Max loop
         Abbrevs := Empty_Vector;
         for Item of Items loop
            declare
               Last : constant Natural
                 := Natural'Min (Item'Last, Item'First + Length - 1);

               Abbrev : String renames Item (Item'First .. Last);
            begin
               exit when Abbrevs.Contains (Abbrev);
               Abbrevs.Append (Abbrev);
            end;
         end loop;
         if Abbrevs.Length = Items.Length then
            return Length;
         end if;
      end loop;
      return 0;
   end Abbrev_Length;

   procedure Process (Line : String) is
      package Natural_IO is new Ada.Text_IO.Integer_IO (Natural);
      Words  : constant Vector  := Split (Line);
      Length : constant Natural := Abbrev_Length (Words);
   begin
      Natural_IO.Put (Length, Width => 2);
      Put (" ");
      Put_Line (Line);
   end Process;

begin
   while not End_Of_File loop
      Process (Get_Line);
   end loop;
end Abbreviations;


(defun 9-billion-names (row column)
  (cond ((<= row 0) 0)
        ((<= column 0) 0)
	((< row column) 0)
	((equal row 1) 1)
	(t (let ((addend (9-billion-names (1- row) (1- column)))
		 (augend (9-billion-names (- row column) column)))
	     (+ addend augend)))))

(defun 9-billion-names-triangle (rows)
  (loop for row from 1 to rows
     collect (loop for column from 1 to row
		collect (9-billion-names row column))))

(9-billion-names-triangle 25)


def g(n, g)
  return 1 unless 1 < g && g < n-1
  (2..g).reduce(1){ |res, q| res + (q > n-g ? 0 : g(n-g, q)) }
end

(1..25).each { |n| puts (1..n).map { |g| "%4s" % g(n, g) }.join }


object AbcBlocks extends App {

  protected class Block(face1: Char, face2: Char) {

    def isFacedWith(that: Char) = { that == face1 || that == face2 }
    override def toString() = face1.toString + face2
  }
  protected object Block {
    def apply(faces: String) = new Block(faces.head, faces.last)
  }

  type word = Seq[Block]

  private val blocks = List(Block("BO"), Block("XK"), Block("DQ"), Block("CP"), Block("NA"),
    Block("GT"), Block("RE"), Block("TG"), Block("QD"), Block("FS"),
    Block("JW"), Block("HU"), Block("VI"), Block("AN"), Block("OB"),
    Block("ER"), Block("FS"), Block("LY"), Block("PC"), Block("ZM"))

  private def isMakeable(word: String, blocks: word) = {

    def getTheBlocks(word: String, blocks: word) = {

      def inner(word: String, toCompare: word, rest: word, accu: word): word = {
        if (word.isEmpty || rest.isEmpty || toCompare.isEmpty) accu
        else if (toCompare.head.isFacedWith(word.head)) {
          val restant = rest diff List(toCompare.head)
          inner(word.tail, restant, restant, accu :+ toCompare.head)
        } else inner(word, toCompare.tail, rest, accu)
      }
      inner(word, blocks, blocks, Nil)
    }

    word.lengthCompare(getTheBlocks(word, blocks).size) == 0
  }

  val words = List("A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSED", "ANBOCPDQERSFTGUVWXLZ")
  // Automatic tests
  assert(isMakeable(words(0), blocks))
  assert(isMakeable(words(1), blocks))
  assert(!isMakeable(words(2), blocks)) // BOOK not
  assert(isMakeable(words(3), blocks))
  assert(!isMakeable(words(4), blocks)) // COMMON not
  assert(isMakeable(words(5), blocks))
  assert(isMakeable(words(6), blocks))
  assert(isMakeable(words(7), blocks))

  //words(7).mkString.permutations.foreach(s => assert(isMakeable(s, blocks)))

  words.foreach(w => println(s"$w can${if (isMakeable(w, blocks)) " " else "not "}be made."))
}


#include <jambo.h>

#define MAX_LINE   150
Main
   Break on
   days of week = 0, fd=0, length=0, days=0, temp=0

   Open in("dias_de_la_semana.txt")( fd )
   If ( Not( File error ) )
      Loop if (Not (Eof(fd)) )
         Using( MAX_LINE ), Split( Readlin(fd) » (days), days of week, " ")

         Continue if( Zero( Length( days of week ) » (length) ) )
         i=1
         Loop
            Let( temp := Ucase(Left( i, days of week )))
            aSort(temp)
            Break if ( Eq(Length(Unique(temp)), length ) )
            ++i
         Back

         Printnl( Cpad(" ",3,Str(i))," : ", Utf8(Ansi(days)) )
      Back
      Close(fd)
   Else
      Printnl("Error en archivo: ", ~Get str file error)
   End If
End


/* ARM assembly Raspberry PI  */
/*  program abbrAuto.s   */
/* store list of day in a file listDays.txt*/
/* and run the program  abbrAuto listDays.txt */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

.equ STDIN,  0     @ Linux input console
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ READ,   3     @ Linux syscall
.equ WRITE,  4     @ Linux syscall
.equ OPEN,   5     @ Linux syscall
.equ CLOSE,  6     @ Linux syscall

.equ O_RDWR,    0x0002        @ open for reading and writing

.equ BUFFERSIZE,   10000
.equ NBMAXIDAYS, 7

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessTitre:            .asciz "Nom du fichier : "
szCarriageReturn:      .asciz "\n"
szMessErreur:          .asciz "Error detected.\n"
szMessErrBuffer:       .asciz "buffer size too less !!"
szSpace:               .asciz " "
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:      .skip 24
iAdrFicName:    .skip 4
iTabAdrDays:    .skip 4 * NBMAXIDAYS
iTabAdrDays2:   .skip 4 * NBMAXIDAYS
sBufferDays:    .skip BUFFERSIZE
sBuffer:        .skip BUFFERSIZE
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                @ INFO: main
    mov r0,sp                        @ stack address for load parameter
    bl traitFic                      @ read file and process

100:                                 @ standard end of the program
    mov r0, #0                       @ return code
    mov r7, #EXIT                    @ request to exit program
    svc #0                           @ perform the system call

iAdrszCarriageReturn:      .int szCarriageReturn
//iAdrszMessErrBuffer:       .int szMessErrBuffer
iAdrsZoneConv:             .int sZoneConv

/******************************************************************/
/*     read file                                                   */
/******************************************************************/
/* r0 contains address stack begin           */
traitFic:                             @ INFO: traitFic
    push {r1-r8,fp,lr}                @ save  registers
    mov fp,r0                         @  fp <- start address
    ldr r4,[fp]                       @ number of Command line arguments
    cmp r4,#1
    movle r0,#-1
    ble 99f
    add r5,fp,#8                      @ second parameter address
    ldr r5,[r5]
    ldr r0,iAdriAdrFicName
    str r5,[r0]
    ldr r0,iAdrszMessTitre
    bl affichageMess                  @ display string
    mov r0,r5
    bl affichageMess
    ldr r0,iAdrszCarriageReturn
    bl affichageMess                  @ display carriage return

    mov r0,r5                         @ file name
    mov r1,#O_RDWR                    @ flags
    mov r2,#0                         @ mode
    mov r7, #OPEN                     @ call system OPEN
    svc 0
    cmp r0,#0                         @ error ?
    ble 99f
    mov r8,r0                         @ File Descriptor
    ldr r1,iAdrsBufferDays             @ buffer address
    mov r2,#BUFFERSIZE                @ buffer size
    mov r7,#READ                      @ read file
    svc #0
    cmp r0,#0                         @ error ?
    blt 99f
    @ extraction datas
    ldr r1,iAdrsBufferDays             @ buffer address
    add r1,r0
    mov r0,#0                         @ store zéro final
    strb r0,[r1]
    ldr r0,iAdriTabAdrDays             @ key string command table
    ldr r1,iAdrsBufferDays             @ buffer address
    bl extracDatas
                                      @ close file
    mov r0,r8
    mov r7, #CLOSE
    svc 0
    mov r0,#0
    b 100f
99:                                   @ error
    ldr r1,iAdrszMessErreur           @ error message
    bl   displayError
    mov r0,#-1
100:
    pop {r1-r8,fp,lr}                 @ restaur registers
    bx lr                             @return
iAdriAdrFicName:              .int iAdrFicName
iAdrszMessTitre:              .int szMessTitre
iAdrszMessErreur:             .int szMessErreur
iAdrsBuffer:                  .int sBuffer
iAdrsBufferDays:              .int sBufferDays
iAdriTabAdrDays:              .int iTabAdrDays
/******************************************************************/
/*     extrac lines file buffer                                   */
/******************************************************************/
/* r0 contains strings address           */
/* r1 contains buffer address         */
extracDatas:                     @ INFO: extracDatas
    push {r1-r8,lr}              @ save  registers
    mov r7,r0
    mov r6,r1
    mov r2,#0                    @ string buffer indice
    mov r4,r1                    @ start string
    mov r5,#0                    @ string index
1:
    ldrb r3,[r6,r2]
    cmp r3,#0
    beq 4f                       @ end
    cmp r3,#0xA
    beq 2f
    cmp r3,#' '                  @ end string
    beq 3f
    add r2,#1
    b 1b
2:
    mov r3,#0
    strb r3,[r6,r2]
    ldrb r3,[r6,r2]
    cmp r3,#0xD
    addeq r2,#2
    addne r2,#1
    mov r0,r4                   @ store last day of line in table
    str r4,[r7,r5,lsl #2]
    mov r0,r5                   @ days number
    bl traitLine                @ process a line of days
    mov r5,#0                   @ new line
    b 5f

3:
    mov r3,#0
    strb r3,[r6,r2]
    add r2,#1
4:
    mov r0,r4
    str r4,[r7,r5,lsl #2]
    add r5,#1
5:                              @ supress spaces
    ldrb r3,[r6,r2]
    cmp r3,#0
    beq 100f
    cmp r3,#' '
    addeq r2,r2,#1
    beq 5b

    add r4,r6,r2                 @ new start address
    b 1b
100:
    pop {r1-r8,lr}               @ restaur registers
    bx lr                        @return

/******************************************************************/
/*     processing a line                                          */
/******************************************************************/
/* r0 contains days number in table   */
traitLine:                    @ INFO: traitLine
    push {r1-r12,lr}           @ save  register
    cmp r0,#1                 @ one day ?
    bgt 1f                    @ no

    ldr r0,iAdrszCarriageReturn @ yes display empty line
    bl affichageMess
    b 100f
1:                            @ line OK
    mov r6,r0                 @ days number
    ldr r0,iAdriTabAdrDays
    ldr r1,iAdriTabAdrDays2
    mov r2,#0
11:                           @ copy days table into other for display final
    ldr r3,[r0,r2,lsl #2]
    str r3,[r1,r2,lsl #2]
    add r2,#1
    cmp r2,r6
    ble 11b
    ldr r0,iAdriTabAdrDays    @ and sort first table
    mov r1,#0
    add r2,r6,#1
    bl insertionSort

    mov r8,#1                 @ abbrevations counter
    ldr r12,iAdriTabAdrDays
    mov r2,#0
    ldr r10,[r12,r2,lsl #2]   @ load first sorting day
    mov r11,#0
    mov r3,#1
2:                            @ begin loop
    ldr r4,[r12,r3,lsl #2]    @ load other day
    @ 1er lettre identique
    mov r0,r10                @ day1
    mov r1,r4                 @ day 2
    mov r2,#0                 @ position 0
    bl compareChar
    cmp r0,#0                 @ first letter equal ?
    movne r10,r4              @ no -> move day 2 in day 1
    bne 6f
3:                            @ if equal
    mov r7,r1                 @ characters length (1,2,3)
    mov r11,#1                @ letters position
4:                            @ loop to compare letters days
    mov r0,r10
    mov r1,r4
    mov r2,r7
    bl compareChar
    cmp r0,#0
    bne 5f
    cmp r5,#0                 @ if end
    beq 5f
    add r7,r7,r1              @ next character
    add r11,r11,#1            @ count letter
    b 4b
5:
    add r11,r11,#1            @ increment letters position
    cmp r11,r8                @ and store if > position précedente
    movgt r8,r11
    mov r10,r4                 @ and day1 = day2

6:
    add r3,r3,#1              @ increment day
    cmp r3,r6
    ble 2b                    @ and loop

    mov r0,r8                 @ display position letter
    ldr r1,iAdrsZoneConv
    bl conversion10
    mov r2,#0
    strb r2,[r1,r0]
    ldr r0,iAdrsZoneConv
    bl affichageMess
    ldr r0,iAdrszSpace
    bl affichageMess
    ldr r0,iAdriTabAdrDays2   @ and display list origine days
    mov r1,r6
    bl displayListDays

100:
    pop {r1-r12,lr}              @ restaur registers
    bx lr                        @return
iAdrszSpace:          .int szSpace
iAdriTabAdrDays2:     .int iTabAdrDays2
/******************************************************************/
/*     comparison character unicode                               */
/******************************************************************/
/* r0 contains address first string            */
/* r1 contains address second string */
/* r2 contains the character position to compare  */
/* r0 return 0 if equal 1 if > -1 if < */
/* r1 return character S1 size in octet if equal */
/* r2 return character S2 size in octet */
compareChar:
    push {r3-r8,lr}              @ save  registers
    ldrb r3,[r0,r2]
    ldrb r4,[r1,r2]
    cmp r3,r4                    @ compare first byte
    movlt r0,#-1
    movgt r0,#1
    bne 100f
    and r3,#0b11100000           @ 3 bytes ?
    cmp r3,#0b11100000
    bne 1f
    add r2,#1
    ldrb r3,[r0,r2]
    ldrb r4,[r1,r2]
    cmp r3,r4
    movlt r0,#-1
    movgt r0,#1
    bne 100f
    add r2,#1
    ldrb r3,[r0,r2]
    ldrb r4,[r1,r2]
    cmp r3,r4
    movlt r0,#-1
    movgt r0,#1
    bne 100f
    mov r0,#0
    mov r1,#3
    b 100f
1:
    and r3,#0b11100000           @ 2 bytes ?
    cmp r3,#0b11000000
    bne 2f
    add r2,#1
    ldrb r3,[r0,r2]
    ldrb r4,[r1,r2]
    cmp r3,r4
    movlt r0,#-1
    movgt r0,#1
    bne 100f
    mov r0,#0
    mov r1,#2
    b 100f
2:                              @ 1 byte
    mov r0,#0
    mov r1,#1

100:
    pop {r3-r8,lr}              @ restaur registers
    bx lr                       @return
/******************************************************************/
/*     control load                                      */
/******************************************************************/
/* r0 contains string table           */
/* r1 contains days number */
displayListDays:
    push {r1-r8,lr}              @ save  registers
    mov r5,r0
    mov r2,#0
1:
    cmp r2,r1
    bgt 2f
    ldr r0,[r5,r2,lsl #2]
    bl affichageMess
    ldr r0,iAdrszSpace
    bl affichageMess
    add r2,r2,#1
    b 1b
2:
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
100:
    pop {r1-r8,lr}               @ restaur registers
    bx lr                        @return
/************************************/
/* Strings case sensitive comparisons  */
/************************************/
/* r0 et r1 contains the address of strings */
/* return 0 in r0 if equals */
/* return -1 if string r0 < string r1 */
/* return 1  if string r0 > string r1 */
comparStrings:
    push {r1-r4}             @ save des registres
    mov r2,#0                @ counter
1:
    ldrb r3,[r0,r2]          @ byte string 1
    ldrb r4,[r1,r2]          @ byte string 2
    cmp r3,r4
    movlt r0,#-1             @ small
    movgt r0,#1              @ greather
    bne 100f                 @ not equals
    cmp r3,#0                @ 0 end string
    moveq r0,#0              @ equal
    beq 100f                 @ end string
    add r2,r2,#1             @ else add 1 in counter
    b 1b                     @ and loop
100:
    pop {r1-r4}
    bx lr
/******************************************************************/
/*         insertion sort                                              */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first element    */
/* r2 contains the number of element */
insertionSort:
    push {r1-r6,lr}                    @ save registers
    mov r6,r0
    add r3,r1,#1                       @ start index i
1:                                     @ start loop
    ldr r1,[r6,r3,lsl #2]              @ load value A[i]
    sub r5,r3,#1                       @ index j
2:
    ldr r4,[r6,r5,lsl #2]              @ load value A[j]
    mov r0,r4
    bl comparStrings
    cmp r0,#1                          @ compare value
    bne 3f
    add r5,#1                          @ increment index j
    str r4,[r6,r5,lsl #2]              @ store value A[j+1]
    subs r5,#2                         @ j = j - 1
    bge 2b                             @ loop if j >= 0
3:
    add r5,#1                          @ increment index j
    str r1,[r6,r5,lsl #2]              @ store value A[i] in A[j+1]
    add r3,#1                          @ increment index i
    cmp r3,r2                          @ end ?
    blt 1b                             @ no -> loop

100:
    pop {r1-r6,lr}
    bx lr
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


import std.stdio, std.bigint, std.algorithm, std.range;

auto cumu(in uint n) {
    __gshared cache = [[1.BigInt]];
    foreach (l; cache.length .. n + 1) {
        auto r = [0.BigInt];
        foreach (x; 1 .. l + 1)
            r ~= r.back + cache[l - x][min(x, l - x)];
        cache ~= r;
    }
    return cache[n];
}

auto row(in uint n) {
    auto r = n.cumu;
    return n.iota.map!(i => r[i + 1] - r[i]);
}

void main() {
    writeln("Rows:");
    foreach (x; 1 .. 11)
        writefln("%2d: %s", x, x.row);

    writeln("\nSums:");
    foreach (x; [23, 123, 1234])
        writeln(x, " ", x.cumu.back);
}


(define *blocks*
  '((#\B #\O) (#\X #\K) (#\D #\Q) (#\C #\P) (#\N #\A)
    (#\G #\T) (#\R #\E) (#\T #\G) (#\Q #\D) (#\F #\S)
    (#\J #\W) (#\H #\U) (#\V #\I) (#\A #\N) (#\O #\B)
    (#\E #\R) (#\F #\S) (#\L #\Y) (#\P #\C) (#\Z #\M)))

(define (exists p? li)
  (and (not (null? li))
       (or (p? (car li))
           (exists p? (cdr li)))))

(define (remove-one x li)
  (cond
    ((null? li) '())
    ((equal? (car li) x) (cdr li))
    (else (cons (car li) (remove-one x (cdr li))))))

(define (can-make-list? li blocks)
  (or (null? li)
      (exists
       (lambda (block)
         (and
          (member (char-upcase (car li)) block)
          (can-make-list? (cdr li) (remove-one block blocks))))
       blocks)))

(define (can-make-word? word)
  (can-make-list? (string->list word) *blocks*))

(define *words*
  '("A" "Bark" "book" "TrEaT" "COMMON" "squaD" "CONFUSE"))

(for-each
 (lambda (word)
   (display (if (can-make-word? word)
                "   Can make word: "
                "Cannot make word: "))
   (display word)
   (newline))
 *words*)


# syntax: GAWK -f ABBREVIATIONS_AUTOMATIC.AWK ABBREVIATIONS_AUTOMATIC.TXT
{ dow_arr[NR] = $0 }
END {
    for (i=1; i<=NR; i++) {
      if (split(dow_arr[i],arr1,FS) != 7) {
        printf("NG %s\n",dow_arr[i])
        continue
      }
      col_width = 0
      for (j=1; j<=7; j++) {
        col_width = max(col_width,length(arr1[j]))
      }
      for (col=1; col<=col_width; col++) {
        delete arr2
        for (j=1; j<=7; j++) {
          arr2[toupper(substr(arr1[j],1,col))]
        }
        if (length(arr2) == 7) {
          break
        }
        if (col >= col_width) { # catches duplicate day names
          col = "NG"
          break
        }
      }
      printf("%2s %s\n",col,dow_arr[i])
    }
    exit(0)
}
function max(x,y) { return((x > y) ? x : y) }


Split ← (⊢-˜+`×¬)∘=⊔⊢

Abbrnum ← 1⊸{
  𝕊⟨⟩:@;
  ((⊢≡⍷)𝕨↑¨𝕩)◶⟨(𝕨+1)⊸𝕊,𝕨⟩𝕩}
words ← ' ' Split¨ •FLines "abbrs.txt"

(•Show Abbrnum ≍○< ⊢)¨words


import 'dart:math';

List<BigInt> partitions(int n) {
  var cache = List<List<BigInt>>.filled(1, List<BigInt>.filled(1, BigInt.from(1)), growable: true);
  for(int length = cache.length; length < n + 1; length++) {
    var row = List<BigInt>.filled(1, BigInt.from(0), growable: true);
    for(int index = 1; index < length + 1; index++) {
      var partAtIndex = row[row.length - 1] + cache[length - index][min(index, length - index)];
      row.add(partAtIndex);
    }
    cache.add(row);
  }
  return cache[n];
}

List<BigInt> row(int n) {
  var parts = partitions(n);
  return List<BigInt>.generate(n, (int index) => parts[index + 1] - parts[index]);
}

void printRows({int min = 1, int max = 11}) {
  int maxDigits = max.toString().length;
  print('Rows:');
  for(int i in List.generate(max - min, (int index) => index + min)) {
    print((' ' * (maxDigits - i.toString().length)) + '$i: ${row(i)}');
  }
}

void printSums(List<int> args) {
  print('Sums:');
  for(int i in args) {
    print('$i: ${partitions(i)[i]}');
  }
}


var cache = [[1]]

func namesOfGod(n) {
    for l in cache.Length()..n {
        var r = [0]
        if l == 1 {
            r.Add(r[r.Length() - 1] + cache[0][0])
        } else {
            for x in 1..l {
                r.Add(r[r.Length() - 1] + cache[l - x][min(x, l-x)])
            }
        }
        cache.Add(r)
    }
    return cache[n]
}

func row(n) {
    let r = namesOfGod(n)
    var xs = []
    for i in 0..<n {
        xs.Add(r[i + 1] - r[i])
    }
    return xs
}

for x in 1..25 {
    print("\(x): \(row(x))")
}


defmodule God do
  def g(n,g) when g == 1 or n < g, do: 1
  def g(n,g) do
    Enum.reduce(2..g, 1, fn q,res ->
      res + (if q > n-g, do: 0, else: g(n-g,q))
    end)
  end
end

Enum.each(1..25, fn n ->
  IO.puts Enum.map(1..n, fn g -> "#{God.g(n,g)} " end)
end)


$ include "seed7_05.s7i";

const func boolean: canMakeWords (in array string: blocks, in string: word) is func
  result
    var boolean: okay is FALSE;
  local
    var integer: index is 1;
  begin
    if word = "" then
      okay := TRUE;
    elsif length(blocks) <> 0 then
      while index <= length(blocks) and not okay do
        if blocks[index][1] = word[1] or blocks[index][2] = word[1] then
          okay := canMakeWords(blocks[.. pred(index)] & blocks[succ(index) ..], word[2 ..]);
        end if;
        incr(index);
      end while;
    end if;
  end func;

const array string: blocks is [] ("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
                                  "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM");

const func boolean: canMakeWords (in string: word) is
  return canMakeWords(blocks, upper(word));

const proc: main is func
  local
    var string: word is "";
  begin
    for word range [] ("", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse") do
      writeln(word rpad 10 <& canMakeWords(word));
    end for;
  end func;


function CanMakeWord word

	put [
		("B", "O"),
		("X", "K"),
		("D", "Q"),
		("C", "P"),
		("N", "A"),
		("G", "T"),
		("R", "E"),
		("T", "G"),
		("Q", "D"),
		("F", "S"),
		("J", "W"),
		("H", "U"),
		("V", "I"),
		("A", "N"),
		("O", "B"),
		("E", "R"),
		("F", "S"),
		("L", "Y"),
		("P", "C"),
		("Z", "M")
	] into blocks

	repeat with each character letter of word
		put False into found
		repeat with each item block of blocks by reference
			if item 1 of block is letter ignoring case or item 2 of block is letter ignoring case
				delete block
				put True into found
				exit repeat
			end if
		end repeat
		if found is False
			return False
		end if
	end repeat
	return True

end CanMakeWord


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

void process(int lineNum, char buffer[]) {
    char days[7][64];
    int i = 0, d = 0, j = 0;

    while (buffer[i] != 0) {
        if (buffer[i] == ' ') {
            days[d][j] = '\0';
            ++d;
            j = 0;
        } else if (buffer[i] == '\n' || buffer[i] == '\r') {
            days[d][j] = '\0';
            ++d;
            break;
        } else {
            days[d][j] = buffer[i];
            ++j;
        }

        if (d >= 7) {
            printf("There aren't 7 days in line %d\n", lineNum);
            return;
        }
        ++i;
    }
    if (buffer[i] == '\0') {
        days[d][j] = '\0';
        ++d;
    }

    if (d < 7) {
        printf("There aren't 7 days in line %d\n", lineNum);
        return;
    } else {
        int len = 0;

        for (len = 1; len < 64; ++len) {
            int d1;
            for (d1 = 0; d1 < 7; ++d1) {
                int d2;
                for (d2 = d1 + 1; d2 < 7; ++d2) {
                    int unique = 0;
                    for (i = 0; i < len; ++i) {
                        if (days[d1][i] != days[d2][i]) {
                            unique = 1;
                            break;
                        }
                    }
                    if (!unique) {
                        goto next_length;
                    }
                }
            }

            // uniqueness found for this length
            printf("%2d ", len);
            for (i = 0; i < 7; ++i) {
                printf(" %s", days[i]);
            }
            printf("\n");
            return;

            // a duplication was found at the current length
        next_length: {}
        }
    }

    printf("Failed to find uniqueness within the bounds.");
}

int main() {
    char buffer[1024];
    int lineNum = 1, len;
    FILE *fp;

    fp = fopen("days_of_week.txt", "r");
    while (1) {
        memset(buffer, 0, sizeof(buffer));

        fgets(buffer, sizeof(buffer), fp);
        len = strlen(buffer);

        if (len == 0 || buffer[len - 1] == '\0') {
            break;
        }

        process(lineNum++, buffer);
    }
    fclose(fp);

    return 0;
}


-module(triangle).
-export([start/1]).
start(N)->
  print(1,1,N).
print(N,N,N)->
1;
print(A,B,N) when A>=B->
   io:format("~p ",[formula(A,B)]),
   print(A,B+1,N);
print(A,B,N) when B>A->
   io:format("~n"),
   print(A+1,1,N).

formula(_,0)->
  0;
formula(B,B)->
  1;
formula(A,B) when B>A->
  0;
formula(A1,B1)->
  formula(A1-1,B1-1)+formula(A1-B1,B1).


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

main(args(2)) :=
	let
		result[i] := args[i] ++ ": " ++ boolToString(can_make_word(args[i], InitBlocks));
	in
		delimit(result, '\n');

InitBlocks :=  ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"];

can_make_word(word(1), blocks(2)) :=
	let
		choices[i] := i when some(blocks[i] = toUpper(head(word)));
		blocksAfterChoice[i] := blocks[(1 ... (choices[i] - 1)) ++ ((choices[i] + 1) ... size(blocks))];
	in
		true when size(word) = 0
	else
		false when size(choices) = 0
	else
		some(can_make_word(tail(word), blocksAfterChoice));

toUpper(letter(0)) :=
	let
		ascii := asciiToInt(letter);
	in
		letter when ascii >= 65 and ascii <= 90
	else
		intToAscii(ascii -  32);


func can_make_word(word, blocks) {

    blocks.map! { |b| b.uc.chars.sort.join }.freq!

    func(word, blocks) {
        var char = word.shift
        var candidates = blocks.keys.grep { |k| 0 <= k.index(char) }

        for candidate in candidates {
            blocks{candidate} <= 0 && next;
            local blocks{candidate} = (blocks{candidate} - 1);
            return true if (word.is_empty || __FUNC__(word, blocks));
        }

        return false;
    }(word.uc.chars, blocks)
}


using System;
using System.Collections.Generic;

namespace Abbreviations {
    class Program {
        static void Main(string[] args) {
            string[] lines = System.IO.File.ReadAllLines("days_of_week.txt");
            int i = 0;

            foreach (string line in lines) {
                i++;
                if (line.Length > 0) {
                    var days = line.Split();
                    if (days.Length != 7) {
                        throw new Exception("There aren't 7 days in line " + i);
                    }

                    Dictionary<string, int> temp = new Dictionary<string, int>();
                    foreach (string day in days) {
                        if (temp.ContainsKey(day)) {
                            Console.WriteLine(" ∞  {0}", line);
                            continue;
                        }
                        temp.Add(day, 1);
                    }

                    int len = 1;
                    while (true) {
                        temp.Clear();
                        foreach(string day in days) {
                            string key;
                            if (len < day.Length) {
                                key = day.Substring(0, len);
                            } else {
                                key = day;
                            }
                            if (temp.ContainsKey(key)) {
                                break;
                            }
                            temp.Add(key, 1);
                        }
                        if (temp.Count == 7) {
                            Console.WriteLine("{0,2:D}  {1}", len, line);
                            break;
                        }
                        len++;
                    }
                }
            }
        }
    }
}


USING: combinators io kernel math math.ranges memoize prettyprint
sequences ;

MEMO: p ( m n -- o )
    {
        { [ dup zero? ] [ nip ] }
        { [ 2dup = ] [ 2drop 1 ] }
        { [ 2dup < ] [ 2drop 0 ] }
        [ [ [ 1 - ] [email protected] p ] [ [ - ] [ ] bi p + ] 2bi ]
    } cond ;

: row ( n -- seq ) dup [1,b] [ p ] with map ;

: .row ( n -- ) row [ pprint bl ] each nl ;

: .triangle ( n -- ) [1,b] [ .row ] each ;

: G ( n -- sum ) row sum ;

25 .triangle nl
"Sums:" print { 23 123 1234 12345 } [ dup pprint bl G . ] each


NEEDS -xopg
ANEW -nbnog \ The Nine Billion Names of God
.arbitrary.p

#100000 =: N
CREATE idx[ #23 , #123 , #1234 , #12345 , #20000 , #30000 , #40000 , #50000 , N , 0 ,
N GARRAY p

: CALC ( n -- )
	0 LOCALS| d n |
	n 1+ 1 ?DO  I 3 * 1-  I 2 */  n SWAP -  TO d   d 0< ?LEAVE
		    I 1 AND IF  LET p[n]=p[n]+p[d]: ELSE  LET p[n]=p[n]-p[d]: ENDIF
		    I -TO d   d 0< ?LEAVE
		    I 1 AND IF  LET p[n]=p[n]+p[d]: ELSE  LET p[n]=p[n]-p[d]: ENDIF
	      LOOP ;

: .GOD ( -- )
	0 LOCAL at
	LET p[0]=1: N 1 DO  I CALC
			    idx[ at CELL[] @ I = IF  CR I 5 .R ." : " LET. p[I]:
			    			     1 +TO at
			    		      ENDIF
		      LOOP ;

: .ABOUT ( -- ) ." Try: .GOD" ;


' version 03-11-2016
' compile with: fbc -s console

#Include Once "gmp.bi"

Sub partitions(max As ULong, p() As MpZ_ptr)
    ' based on Numericana code example
    Dim As ULong a, b, i, k
    Dim As Long j

    Dim As Mpz_ptr s = Allocate(Len(__mpz_struct)) : Mpz_init(s)

    Mpz_set_ui(p(0), 1)

    For i = 1 To max
        j = 1 : k = 1 : b = 2 : a = 5
        While j > 0
            ' j = i - (3*k*k+k) \ 2
            j = i - b : b = b + a : a = a + 3
            If j >= 0 Then
                If k And 1 Then Mpz_add(s, s, p(j)) Else Mpz_sub(s, s, p(j))
            End If
            j = j + k
            If j >= 0 Then
                If k And 1 Then Mpz_add(s, s, p(j)) Else Mpz_sub(s, s, p(j))
            End If
            k = k +1
        Wend
        Mpz_swap(p(i), s)
    Next

    Mpz_clear(s)

End Sub

' ------=< MAIN >=------

Dim As ULong n, k, max = 25              ' with max > 416 the numbers become
Dim As ULongInt p(max, max)              ' to big for a 64bit unsigned integer

p(1, 1) = 1                              ' fill the first 3 rows
p(2, 1) = 1 : p(2, 2) = 1
p(3, 1) = 1 : p(3, 2) = 1 : p(3, 3) = 1

For n = 4 To max                         ' fill the rest
    For k = 1 To n
        If k * 2 > n  Then
           p(n,k)= p(n-1,k-1)
        Else
           p(n,k) = p(n-1,k-1) + p(n-k, k)
        End If
    Next
Next

For n = 1 To 25                          ' print the triangle
    Print Space((max - n) * 2);
    For k = 1 To n
        Print Using "####"; p(n, k);
    Next
    Print
Next
Print : print

                                         ' calculate the integer partition
max = 123456                             ' 1234567 takes about ten minutes
Dim As ZString Ptr ans

ReDim big_p(max) As Mpz_ptr
For n = 0 To max
    big_p(n) = Allocate(Len(__mpz_struct)) : Mpz_init(big_p(n))
Next

partitions(max, big_p())

For n = 1 To Len(Str(max))
    k = Val(Left(Str(max), n))
    ans = Mpz_get_str (0, 10, big_p(k))
    Print Space(10 - n); "P("; Str(k); ") = "; *ans
Next

For n = 0 To max
    Mpz_clear(big_p(n))
Next

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


COMMENT ABC PROBLEM;
BEGIN

    CLASS BLOCK(CH1, CH2); CHARACTER CH1, CH2;
    BEGIN
        BOOLEAN USED;
    END;

    CLASS GAME(WORD, POSSIBLE); TEXT WORD; BOOLEAN POSSIBLE;;

    BOOLEAN PROCEDURE CANMAKEWORD(WORD); TEXT WORD;
    BEGIN
        INTEGER I, NUMBLOCKS;
        BOOLEAN ALLPOSSIBLE, FOUND;
        NUMBLOCKS := UPPERBOUND(BLOCKS, 1);
        FOR I := 1 STEP 1 UNTIL NUMBLOCKS DO
            BLOCKS(I).USED := FALSE;
        ALLPOSSIBLE := TRUE;

        WORD.SETPOS(1);
        WHILE ALLPOSSIBLE AND WORD.MORE DO
        BEGIN
            CHARACTER WORDCHAR;
            WORDCHAR := WORD.GETCHAR;
            FOUND := FALSE;
            FOR I := 1 STEP 1 UNTIL NUMBLOCKS DO
            BEGIN
                INSPECT BLOCKS(I) DO
                BEGIN
                    IF (WORDCHAR = CH1 OR WORDCHAR = CH2) AND NOT USED THEN
                    BEGIN
                        USED := FOUND := TRUE;
                        GOTO L;
                    END;
                END;
            END;
        L:
            IF NOT FOUND THEN
                ALLPOSSIBLE := FALSE;
        END;
        CANMAKEWORD := ALLPOSSIBLE;
    END CANMAKEWORD;

    REF(BLOCK) ARRAY BLOCKS(1:20);
    REF(GAME) ARRAY GAMES(1:7);
    TEXT WORD;
    BEGIN
        INTEGER I;
        I := I+1; BLOCKS(I) :- NEW BLOCK('B', 'O');
        I := I+1; BLOCKS(I) :- NEW BLOCK('X', 'K');
        I := I+1; BLOCKS(I) :- NEW BLOCK('D', 'Q');
        I := I+1; BLOCKS(I) :- NEW BLOCK('C', 'P');
        I := I+1; BLOCKS(I) :- NEW BLOCK('N', 'A');
        I := I+1; BLOCKS(I) :- NEW BLOCK('G', 'T');
        I := I+1; BLOCKS(I) :- NEW BLOCK('R', 'E');
        I := I+1; BLOCKS(I) :- NEW BLOCK('T', 'G');
        I := I+1; BLOCKS(I) :- NEW BLOCK('Q', 'D');
        I := I+1; BLOCKS(I) :- NEW BLOCK('F', 'S');
        I := I+1; BLOCKS(I) :- NEW BLOCK('J', 'W');
        I := I+1; BLOCKS(I) :- NEW BLOCK('H', 'U');
        I := I+1; BLOCKS(I) :- NEW BLOCK('V', 'I');
        I := I+1; BLOCKS(I) :- NEW BLOCK('A', 'N');
        I := I+1; BLOCKS(I) :- NEW BLOCK('O', 'B');
        I := I+1; BLOCKS(I) :- NEW BLOCK('E', 'R');
        I := I+1; BLOCKS(I) :- NEW BLOCK('F', 'S');
        I := I+1; BLOCKS(I) :- NEW BLOCK('L', 'Y');
        I := I+1; BLOCKS(I) :- NEW BLOCK('P', 'C');
        I := I+1; BLOCKS(I) :- NEW BLOCK('Z', 'M');
    END;
    BEGIN
        INTEGER N, I; BOOLEAN ANSWER;
        N := N+1; GAMES(N) :- NEW GAME("A",       TRUE);
        N := N+1; GAMES(N) :- NEW GAME("BARK",    TRUE);
        N := N+1; GAMES(N) :- NEW GAME("BOOK",    FALSE);
        N := N+1; GAMES(N) :- NEW GAME("TREAT",   TRUE);
        N := N+1; GAMES(N) :- NEW GAME("COMMON",  FALSE);
        N := N+1; GAMES(N) :- NEW GAME("SQUAD",   TRUE);
        N := N+1; GAMES(N) :- NEW GAME("CONFUSE", TRUE);
        FOR I := 1 STEP 1 UNTIL N DO
        BEGIN
            INSPECT GAMES(I) DO
            BEGIN
                OUTTEXT(WORD);
                OUTTEXT(" => ");
                ANSWER := CANMAKEWORD(WORD);
                OUTCHAR(IF ANSWER THEN 'T' ELSE 'F');
                IF ANSWER EQV POSSIBLE
                    THEN OUTTEXT(" OK")
                    ELSE OUTTEXT(" ------------- WRONG!");
                OUTIMAGE;
            END;
        END;
    END;

END.


ABCPuzzle>>test
	#('A' 'BARK' 'BOOK' 'TreaT' 'COMMON' 'sQUAD' 'CONFuSE') do: [ :each |
		Transcript crShow: each, ': ', (self solveFor: each) asString ]

ABCPuzzle>>solveFor: letters
	| blocks |
	blocks := #('BO' 'XK' 'DQ' 'CP' 'NA' 'GT' 'RE' 'TG' 'QD' 'FS' 'JW' 'HU' 'VI' 'AN' 'OB' 'ER' 'FS' 'LY' 'PC' 'ZM').
	^ self solveFor: letters asUppercase with: blocks asOrderedCollection

ABCPuzzle>>solveFor: letters with: blocks
	| l ldash matches |
	letters isEmpty ifTrue: [ ^ true ].
	l := letters first.
	ldash := letters allButFirst.
	matches := blocks select: [  :b | b includes: l ].
	matches isEmpty ifTrue: [ ^ false ].
	matches do: [  :m | | bdash |
		bdash := blocks copy.
		bdash remove: m.
		(self solveFor: ldash with: bdash) ifTrue: [ ^ true ] ].
	^ false


#include <iomanip>
#include <iostream>
#include <fstream>
#include <map>
#include <sstream>
#include <string>
#include <vector>

std::vector<std::string> split(const std::string& str, char delimiter) {
    std::vector<std::string> tokens;
    std::string token;
    std::istringstream tokenStream(str);
    while (std::getline(tokenStream, token, delimiter)) {
        tokens.push_back(token);
    }
    return tokens;
}

int main() {
    using namespace std;
    string line;
    int i = 0;

    ifstream in("days_of_week.txt");
    if (in.is_open()) {
        while (getline(in, line)) {
            i++;
            if (line.empty()) {
                continue;
            }

            auto days = split(line, ' ');
            if (days.size() != 7) {
                throw std::runtime_error("There aren't 7 days in line " + i);
            }

            map<string, int> temp;
            for (auto& day : days) {
                if (temp.find(day) != temp.end()) {
                    cerr << " ∞  " << line << '\n';
                    continue;
                }
                temp[day] = 1;
            }

            int len = 1;
            while (true) {
                temp.clear();
                for (auto& day : days) {
                    string key = day.substr(0, len);
                    if (temp.find(key) != temp.end()) {
                        break;
                    }
                    temp[key] = 1;
                }
                if (temp.size() == 7) {
                    cout << setw(2) << len << "  " << line << '\n';
                    break;
                }
                len++;
            }
        }
    }

    return 0;
}


class PartitionCount
{
   // Array of elements
   class var triangle = [[0],[0,1]]

   // Array of cumulative sums in each row.
   class var sumTriangle = [[1],[0,1]]

   class calcRowsTo[toRow] :=
   {
      for row = length[triangle] to toRow
      {
         [email protected] = workrow = new array[[row+1],0]
         [email protected] = sumworkrow = new array[[row+1],0]
         oversum = 0
         for col = 1 to row
         {
            otherRow = row-col
            sum = [email protected]@min[col,otherRow]
            [email protected] = sum
            oversum = oversum + sum
            [email protected] = oversum
         }
      }
   }

   class rowSum[row] :=
   {
      calcRowsTo[row]
      return [email protected]@row
   }
}

PartitionCount.calcRowsTo[25]
for row=1 to 25
{
   for col=1 to row
      print[[email protected]@col + " "]
   println[]
}

// Test against Frink's built-in much faster partitionCount function that uses
// Euler's pentagonal method for counting partitions.
testRow[row] :=
{
   sum = PartitionCount.rowSum[row]
   println["$row\t$sum\t" + (sum == partitionCount[row] ? "correct" : "incorrect")]
}

println[]
testRow[23]
testRow[123]
testRow[1234]
testRow[12345]


package main

import (
	"fmt"
	"math/big"
)

func main() {

	intMin := func(a, b int) int {
		if a < b {
			return a
		} else {
			return b
		}
	}

	var cache = [][]*big.Int{{big.NewInt(1)}}

	cumu := func(n int) []*big.Int {
		for y := len(cache); y <= n; y++ {
			row := []*big.Int{big.NewInt(0)}
			for x := 1; x <= y; x++ {
				cacheValue := cache[y-x][intMin(x, y-x)]
				row = append(row, big.NewInt(0).Add(row[len(row)-1], cacheValue))
			}
			cache = append(cache, row)
		}
		return cache[n]
	}

	row := func(n int) {
		e := cumu(n)
		for i := 0; i < n; i++ {
			fmt.Printf(" %v ", (big.NewInt(0).Sub(e[i+1], e[i])).Text(10))
		}
		fmt.Println()
	}

	fmt.Println("rows:")
	for x := 1; x < 11; x++ {
		row(x)
	}
	fmt.Println()

	fmt.Println("sums:")
	for _, num := range [...]int{23, 123, 1234, 12345} {
		r := cumu(num)
		fmt.Printf("%d %v\n", num, r[len(r)-1].Text(10))
	}
}


* Program: abc.sbl,
* To run: sbl -r abc.sbl
* Comment: Tested using the Spitbol for Linux version of SNOBOL4

* Read in blocks to construct the blocks string
in1
	line = replace(input,&lcase,&ucase) :f(in1end)
	line ? breakx(' ') . pre ' ' rem . post :f(in1end)
	blocks = blocks "," pre post
	:(in1)
in1end

* Function to determine if a word can be constructed with the given blocks
	define('abc(blocks,word)s,i,let')
		abcpat = (breakx(',') ',') . pre (*let len(1) | len(1) *let) rem . post
	:(abc_end)
abc
	eq(size(word),0) :s(abc3)
	s = replace(word,&lcase,&ucase)
	i = 0
abc2
	i = lt(i,size(s)) i + 1 :f(abc4)
	let = substr(s,i,1)
	blocks ? abcpat = pre post :f(abc3)
	:(abc2)
abc3
	abc = 'False' :(abc5)
abc4
	abc = 'True'  :(abc5)
abc5
	output = lpad('can_make_word("' word '"): ',26) abc
	abc = ""
	:(return)
abc_end

* Check words
*	output = abc(blocks,"")
*	output = abc(blocks," ")
	output = abc(blocks,'A')
	output = abc(blocks,'bark')
	output = abc(blocks,'BOOK')
	output = abc(blocks,'TrEAT')
	output = abc(blocks,'COMMON')
	output = abc(blocks,'SQUAD')
	output = abc(blocks,'CONFUSE')

* The blocks are entered below, after the following END label
END
b o
X K
D Q
C P
N A
G T
R E
T G
Q D
F S
J W
H U
V I
A N
O B
E R
F S
L Y
P C
Z M


blocks:List Tuple Symbol:= _
  [(B,O),(X,K),(D,Q),(C,P),(N,A),(G,T),(R,E),(T,G),(Q,D),(F,S), _
   (J,W),(H,U),(V,I),(A,N),(O,B),(E,R),(F,S),(L,Y),(P,C),(Z,M)]

findComb(l:List List NNI):List List NNI ==
  #l=0 => []
  #l=1 => [[s] for s in first l]
  r:List List NNI:=[]
  for y in findComb(rest l) repeat
    r:=concat(r,[concat(x,y) for x in first l])
  return r

canMakeWord?(word,blocks) ==
  word:=upperCase word
  bchr:=[map(char,map(string,s::List(Symbol))) for s in blocks]
  c:=[[j for j in 1..#blocks | member?(word.k,bchr.j)] for k in 1..#word]
  reduce(_or,[test(#removeDuplicates(l)=#word) for l in findComb(c)])

Example:=["a","bark","book","treat","common","squad","confuse"]

[canMakeWord?(s,blocks) for s in Example]


            IDENTIFICATION DIVISION.
            PROGRAM-ID. AUTO-ABBREVIATIONS.

            ENVIRONMENT DIVISION.

            INPUT-OUTPUT SECTION.
            FILE-CONTROL.
              SELECT DOW ASSIGN TO "days-of-week.txt"
              ORGANIZATION IS LINE SEQUENTIAL.

            DATA DIVISION.
              FILE SECTION.
              FD DOW.
              01 DOW-FILE PIC X(200).

              WORKING-STORAGE SECTION. *> a.k.a. variables
              01 DOW-LINE PIC X(200).
              01 ENDO PIC 9(1).
              01 ENDO2 PIC 9(1).
              01 CURDAY PIC X(50).
              01 ABPTR PIC 999.
              01 LINE-NUM PIC 9(3) VALUE 1.
              01 CHARAMT PIC 9(3) VALUE 1.
              01 LARGESTCHARAMT PIC 9(3).
              01 DAYNUM PIC 9(3) VALUE 1.
              01 ABRESTART PIC 9(1).
              01 CURABBR PIC X(50).
              01 TMP1 PIC 9(3).
              01 TMP2 PIC 9(3).
              01 TINDEX PIC 9(3) VALUE 1.
              01 ABBRLIST.
                05 ABBRITEM PIC X(50) OCCURS 7 TIMES.

            PROCEDURE DIVISION.
              OPEN INPUT DOW.
                PERFORM UNTIL ENDO = 1
                  READ DOW INTO DOW-LINE
                    AT END MOVE 1 TO ENDO
                    NOT AT END PERFORM
                      *> loop through each line
                      IF DOW-LINE = "" THEN
                        DISPLAY ""
                      ELSE
                        MOVE 0 TO ENDO2
                        MOVE 0 TO CHARAMT

                        PERFORM UNTIL ENDO2 > 0
                          MOVE 1 TO ABPTR
                          MOVE 1 TO DAYNUM
                          MOVE 0 TO ABRESTART

                          ADD 1 TO CHARAMT

                          *> reset the abbreviation table
                          MOVE 1 TO TINDEX
                          PERFORM 7 TIMES
                            MOVE SPACE TO ABBRITEM(TINDEX)
                            ADD 1 TO TINDEX
                          END-PERFORM

                          *> loop through each day
                          PERFORM 7 TIMES
                            UNSTRING DOW-LINE DELIMITED BY SPACE
                              INTO CURDAY
                              WITH POINTER ABPTR
                            END-UNSTRING

                            MOVE 0 TO TMP1
                            MOVE 0 TO TMP2
                            INSPECT CURDAY
                              TALLYING TMP1 FOR ALL CHARACTERS
                            INSPECT CURDAY
                              TALLYING TMP2 FOR ALL SPACE
                            SUBTRACT TMP2 FROM TMP1
                            IF TMP1 > LARGESTCHARAMT THEN
                              MOVE TMP1 TO LARGESTCHARAMT
                            END-IF

                            *> not enough days error
                            IF CURDAY = "" THEN
                              MOVE 3 TO ENDO2
                            END-IF

                            MOVE CURDAY(1:CHARAMT) TO CURABBR

                            *> check if the current abbreviation is already taken
                            MOVE 1 TO TINDEX
                            PERFORM 7 TIMES
                              IF ABBRITEM(TINDEX) = CURABBR THEN
                                MOVE 1 TO ABRESTART
                              END-IF
                              ADD 1 TO TINDEX
                            END-PERFORM

                            MOVE CURABBR TO ABBRITEM(DAYNUM)

                            ADD 1 TO DAYNUM

                          END-PERFORM

                          IF ABRESTART = 0 THEN
                            MOVE 1 TO ENDO2
                          END-IF

                          *> identical days error
                          IF CHARAMT > LARGESTCHARAMT THEN
                            MOVE 2 TO ENDO2
                          END-IF

                        END-PERFORM

                        DISPLAY "Line " LINE-NUM ": " WITH NO ADVANCING

                        IF ENDO2 = 3 THEN
                          DISPLAY "Error: not enough " WITH NO ADVANCING
                          DISPLAY "days"
                        ELSE IF ENDO2 = 2 THEN
                          DISPLAY "Error: identical " WITH NO ADVANCING
                          DISPLAY "days"
                        ELSE
                          DISPLAY CHARAMT ": " WITH NO ADVANCING

                          *> loop through each day and display its abbreviation
                          MOVE 1 TO TINDEX
                          PERFORM 7 TIMES
                            MOVE ABBRITEM(TINDEX) TO CURABBR

                            MOVE 0 TO TMP1
                            MOVE 0 TO TMP2
                            INSPECT CURABBR
                              TALLYING TMP1 FOR ALL CHARACTERS
                            INSPECT CURABBR
                              TALLYING TMP2 FOR TRAILING SPACES
                            SUBTRACT TMP2 FROM TMP1

                            DISPLAY CURABBR(1:TMP1) WITH NO ADVANCING
                            DISPLAY "." WITH NO ADVANCING

                            IF TINDEX < 7 THEN
                              DISPLAY SPACE WITH NO ADVANCING
                            ELSE
                              DISPLAY X"0a" WITH NO ADVANCING *> go to next line
                            END-IF

                            ADD 1 TO TINDEX
                          END-PERFORM
                        END-IF

                      END-IF

                    END-PERFORM
                  END-READ

                  ADD 1 TO LINE-NUM
                END-PERFORM.
              CLOSE DOW.
              STOP RUN.


def partitions(c)
{

    def p=[];
    int k = 0;
     p[k] = c;
    int counter=0;
    def counts=[];
	for (i in 0..c-1)
	{counts[i]=0;}
    while (true)
    {

        counter++;
		counts[p[0]-1]=counts[p[0]-1]+1;
		int rem_val = 0;
        while (k >= 0 && p[k] == 1)
        { rem_val += p[k];
            k--;}
        if (k < 0)  { break;}
        p[k]--;
        rem_val++;
        while (rem_val > p[k])
        {
            p[k+1] = p[k];
            rem_val = rem_val - p[k];
            k++;
        }
        p[k+1] = rem_val;
        k++;
    }
	println counts;
	return counter;
}

static void  main(String[] args)
{
for( i in 1..25 )
{partitions(i);}
}


val BLOCKS = [(#"B",#"O"), (#"X",#"K"), (#"D",#"Q"), (#"C",#"P"), (#"N",#"A"), (#"G",#"T"),
 (#"R",#"E"), (#"T",#"G"), (#"Q",#"D"), (#"F",#"S"), (#"J",#"W"), (#"H",#"U"), (#"V",#"I"),
 (#"A",#"N"),(#"O",#"B"), (#"E",#"R"), (#"F",#"S"), (#"L",#"Y"), (#"P",#"C"), (#"Z",#"M")];
val words = ["A","BARK","BOOK","TREaT","COMMON","SQUAD","CONFUSE"];
open List;

local
 val remove = fn x => fn B => (fn (a,b) => (tl a)@b ) (partition ( fn a=> x=a) B)
in
fun cando ([]  , Done, B )  = true
 |  cando (h::t, Done, [])  = false
 |  cando (h::t, Done, B )  =
 let
  val S =  find (fn (a,b) => a=h orelse b=h) B
 in
  if isSome S then cando (t, (h,valOf S)::Done, remove (valOf S) B)
  else
  let
   val T = find ( fn(_,(a,b)) => a=h orelse b=h) Done
   val U = if isSome T then find (fn (a,b) => a = #1 (valOf T) orelse b = #1 (valOf T) ) B else NONE
  in
   if isSome T andalso isSome U
    then  cando ( t, (#1 (valOf T),(valOf U))::(h,#2 (valOf T))::(remove (valOf T) Done), remove (valOf U) B)
   else false
  end
 end
end;

map (fn st => cando(map Char.toUpper (String.explode st),[],BLOCKS)) words;

val BLOCKS = [(#"U",#"S"), (#"T",#"Z"), (#"A",#"O"), (#"Q",#"A")];
val words = ["A","UTAH","AutO"];
map (fn st => cando(map Char.toUpper (String.explode st),[],BLOCKS)) words;


(defun max-mismatch (list)
  (if (cdr list)
    (max (apply #'max (mapcar #'(lambda (w2) (mismatch (car list) w2)) (cdr list))) (max-mismatch (cdr list)))
    0 ))

(with-open-file (f "days-of-the-week.txt" :direction :input)
  (do* ((row (read-line f nil nil) (read-line f nil nil)))
       ((null row) t)
    (format t "~d ~a~%" (1+ (max-mismatch (SPLIT-SEQUENCE:split-sequence #\Space row))) row) ))


import std.conv;
import std.exception;
import std.range;
import std.stdio;
import std.string;

void main() {
    foreach (size_t i, dstring line; File("days_of_week.txt").lines) {
        line = chomp(line);
        if (!line.empty) {
            auto days = line.split;
            enforce(days.length==7, text("There aren't 7 days in line ", i+1));

            int[dstring] temp;
            foreach(day; days) {
                temp[day]++;
            }
            if (days.length < 7) {
                writeln(" ∞  ", line);
                continue;
            }
            int len = 1;
            while (true) {
                temp.clear();
                foreach (day; days) {
                    temp[day.take(len).array]++;
                }
                if (temp.length == 7) {
                    writefln("%2d  %s", len, line);
                    break;
                }
                len++;
            }
        }
    }
}


import Data.List (mapAccumL)

cumu :: [[Integer]]
cumu = [1] : map (scanl (+) 0) rows

rows :: [[Integer]]
rows = snd $ mapAccumL f [] cumu where
    f r row = (rr, new_row) where
        new_row = map head rr
        rr = map tailKeepOne (row:r)
    tailKeepOne [x] = [x]
    tailKeepOne (_:xs) = xs

sums n = cumu !! n !! n
--curiously, the following seems to be faster
--sums = sum . (rows!!)

main :: IO ()
main = do
    mapM_ print $ take 10 rows
    mapM_ (print.sums) [23, 123, 1234, 12345]


procedure main(A)
    n := integer(!A) | 10
    every r := 2 to (n+1) do write(right(r-1,2),": ",showList(row(r)))
    write()
    every r := 23 | 123 | 1234 | 12345 do write(r," ",cumu(r+1)[-1])
end

procedure cumu(n)
    static cache
    initial cache := [[1]]
    every l := *cache to n do {
        every (r := [0], x := !l) do put(r, r[-1]+cache[1+l-x][1+min(x,l-x)])
        put(cache, r)
        }
    return cache[n]
end

procedure row(n)
    return (r := cumu(n), [: (i := !(*r-1), r[i+1]-r[i]) :]) | r
end

procedure showList(A)
    every (s := "[") ||:= (!A||", ")
    return s[1:-2]||"]"
end


import Foundation

func Blockable(str: String) -> Bool {

    var blocks = [
        "BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
        "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM" ]

    var strUp = str.uppercaseString
    var final = ""

    for char: Character in strUp {
        var CharString: String = ""; CharString.append(char)
        for j in 0..<blocks.count {
            if blocks[j].hasPrefix(CharString) ||
               blocks[j].hasSuffix(CharString) {
                final.append(char)
                blocks[j] = ""
                break
            }
        }
    }

    return final == strUp
}

func CanOrNot(can: Bool) -> String {
    return can ? "can" : "cannot"
}

for str in [ "A", "BARK", "BooK", "TrEaT", "comMON", "sQuAd", "Confuse" ] {
    println("'\(str)' \(CanOrNot(Blockable(str))) be spelled with blocks.")
}


package require Tcl 8.6

proc abc {word {blocks {BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM}}} {
    set abc {{letters blocks abc} {
	set rest [lassign $letters ch]
	set i 0
	foreach blk $blocks {
	    if {$ch in $blk && (![llength $rest]
		    || [apply $abc $rest [lreplace $blocks $i $i] $abc])} {
		return true
	    }
	    incr i
	}
	return false
    }}
    return [apply $abc [split $word ""] [lmap b $blocks {split $b ""}] $abc]
}

foreach word {"" A BARK BOOK TREAT COMMON SQUAD CONFUSE} {
    puts [format "Can we spell %9s? %s" '$word' [abc $word]]
}