*        Count occurrences of a substring  05/07/2016
COUNTSTR CSECT
         USING  COUNTSTR,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         MVC    HAYSTACK,=CL32'the three truths'
         MVC    LENH,=F'17'        lh=17
         MVC    NEEDLE,=CL8'th'    needle='th'
         MVC    LENN,=F'2'         ln=2
         BAL    R14,SHOW           call show
         MVC    HAYSTACK,=CL32'ababababab'
         MVC    LENH,=F'11'        lh=11
         MVC    NEEDLE,=CL8'abab'  needle='abab'
         MVC    LENN,=F'4'         ln=4
         BAL    R14,SHOW           call show
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
HAYSTACK DS     CL32               haystack
NEEDLE   DS     CL8                needle
LENH     DS     F                  length(haystack)
LENN     DS     F                  length(needle)
*------- ----   show---------------------------------------------------
SHOW     ST     R14,SAVESHOW       save return address
         BAL    R14,COUNT          count(haystack,needle)
         LR     R11,R0             ic=count(haystack,needle)
         MVC    PG(20),HAYSTACK    output haystack
         MVC    PG+20(5),NEEDLE    output needle
         XDECO  R11,PG+25          output ic
         XPRNT  PG,80              print buffer
         L      R14,SAVESHOW       restore return address
         BR     R14                return to caller
SAVESHOW DS     A                  return address of caller
PG       DC     CL80' '            buffer
*------- ----   count--------------------------------------------------
COUNT    ST     R14,SAVECOUN       save return address
         SR     R7,R7              n=0
         LA     R6,1               istart=1
         L      R10,LENH           lh
         S      R10,LENN           ln
         LA     R10,1(R10)         lh-ln+1
LOOPI    CR     R6,R10             do istart=1 to lh-ln+1
         BH     ELOOPI
         LA     R8,NEEDLE          @needle
         L      R9,LENN            ln
         LA     R4,HAYSTACK-1      @haystack[0]
         AR     R4,R6              +istart
         LR     R5,R9              ln
         CLCL   R4,R8              if substr(haystack,istart,ln)=needle
         BNE    NOTEQ
         LA     R7,1(R7)           n=n+1
         A      R6,LENN            istart=istart+ln
NOTEQ    LA     R6,1(R6)           istart=istart+1
         B      LOOPI
ELOOPI   LR     R0,R7              return(n)
         L      R14,SAVECOUN       restore return address
         BR     R14                return to caller
SAVECOUN DS     A                  return address of caller
*        ----   -------------------------------------------------------
         YREGS
         END    COUNTSTR


	org	100h
	jmp	demo
	;;;	Count non-overlapping substrings (BC) in string (HL)
	;;;	Returns amount of matches in DE
subcnt:	lxi	d,0	; Amount of matches
s_scan:	mov	a,m	; Get current character
	ana	a	; End of string?
	rz		; Then stop
	push	b	; Keep start of substring search
	push	h 	; Keep current location in string
s_cmp:	ldax	b	; Get character from substring
	cmp	m	; Compare to curent charracter of search string
	inx	b	; Advance pointers
	inx	h
	jz	s_cmp	; Keep going if they were equal
	ana	a	; Did we reach the end of the substring?
	jz	s_find	; If so, we found a match
	pop	h	; Otherwise, no match - restore search position
	pop	b	; Restore start of substring
	inx	h	; Try next position
	jmp	s_scan
s_find:	inx	d	; We found a match
	pop	b	; Discard start of the search, keep going after match
	pop 	b	; Restore start of substring
	dcx	h	; The comparison routine overshoots by one
	jmp	s_scan
	;;;	Test on a few strings
demo:	lxi	h,pairs
loop:	mov	e,m	; Load string pointer
	inx	h
	mov	d,m
	inx	h
	mov	a,d	; If 0, stop
	ora	e
	rz
	mov	c,m	; Load substring pointer
	inx	h
	mov	b,m
	inx	h
	push	h	; Save example pointer
	xchg		; Put string pointer in HL
	call	subcnt	; Count substrings
	mvi	a,'0'	; Assuming output is <10, print output
	add	e	; (This is true for all examples, and a proper numeric
	mov	e,a	; output routine is big and not relevant.)
	mvi	c,2	; CP/M character output
	call	5
	pop	h	; Restore example pointer
	jmp	loop
pairs:	dw	str1,sub1,str2,sub2,str3,sub3,0
str1:	db	'the three truths',0
sub1:	db	'th',0		; result should be 3
str2:	db	'ababababab',0
sub2:	db	'abab',0	; result should be 2
str3:	db	'cat',0
sub3:	db	'dog',0		; result should be 0


	cpu	8086
	org	100h
section	.text
	jmp	demo
	;;;	Count non-overlapping substrings [ES:DI] in [DS:SI]
	;;;	Return count in AX
subcnt:	xor	ax,ax		; Set count to 0
	xor	dl,dl		; Zero to compare to
	mov	bp,di		; Keep copy of substring pointer
.scan:	cmp	dl,[si]		; End of string?
	je	.out		; Then we're done
	mov	bx,si		; Keep copy of search position
	mov	di,bp		; Start at beginning of substring
.cmp:	xor	cx,cx
	dec	cx
	repe	cmpsb		; Scan until no match
	dec	si		; Go to first non-match
	dec	di
	cmp	dl,[es:di]	; Reached end of substring?
	je	.match		; Then we found a match
	mov	si,bx 		; If not, continue searching one
	inc	si		; position further
	jmp	.scan
.match:	inc	ax		; Found a match - increment count
	jmp	.scan
.out:	ret
	;;;	Test the routine on a few examples
demo:	mov	si,pairs
.loop:	lodsw			; Load string pointer
	test	ax,ax		; If 0, stop
	jz	.out
	xchg	dx,ax
	lodsw			; Load substring pointer
	xchg	di,ax
	push	si		; Keep example pointer
	xchg	si,dx
	call	subcnt		; Count substrings
	call	prax		; Print amount of substrings
	pop	si		; Restore example pointer
	jmp	.loop
.out:	ret
	;;;	Print AX as number
prax:	mov	bx,num		; Pointer to end of number string
	mov	cx,10 		; Divisor
.dgt:	xor	dx,dx		; Divide by 10
	div	cx
	add	dl,'0'		; Add ASCII 0 to remainder
	dec	bx		; Store digit
	mov	[bx],dl
	test	ax,ax		; If number not zero yet
	jnz	.dgt		; Find rest of digits
	mov	dx,bx		; Print number string
	mov	ah,9
	int	21h
	ret
section	.data
	db	'*****'		; Output number placeholder
num:	db	' $'
	;;;	Examples
pairs:	dw	.str1,.sub1,.str2,.sub2,.str3,.sub3,0
.str1:	db	'the three truths',0
.sub1:	db	'th',0		; result should be 3
.str2:	db	'ababababab',0
.sub2:	db	'abab',0	; result should be 2
.str3:	db	'cat',0
.sub3:	db	'dog',0		; result should be 0


changes: function [amount coins][
	ways: map 0..amount+1 [x]-> 0
	ways\0: 1

	loop coins 'coin [
		loop coin..amount 'j ->
			set ways j (get ways j) + get ways j-coin
	]

	ways\[amount]
]

print changes 100 [1 5 10 25]
print changes 100000 [1 5 10 25 50 100]


countChange(amount){
	return cc(amount, 4)
}

cc(amount, kindsOfCoins){
	if ( amount == 0 )
		return 1
	if ( amount < 0 ) || ( kindsOfCoins == 0 )
		return 0
	return cc(amount, kindsOfCoins-1)
	    +  cc(amount - firstDenomination(kindsOfCoins), kindsOfCoins)
}

firstDenomination(kindsOfCoins){
	return [1, 5, 10, 25][kindsOfCoins]
}
MsgBox % countChange(100)


defmodule Table do
  defp put_rows(n) do
    Enum.map_join(1..n, fn i ->
      "
#{i}	" <>
      Enum.map_join(1..3, fn _ ->
        "#{:rand.uniform(2000)}	"
      end) <> "
\n"
    end)
  end

  def create_table(n\\3) do
    "
\n" <>
    "	X	Y	Z	\n" <>
    put_rows(n) <>
    "
"
  end
end

IO.puts Table.create_table


-module( create_html_table ).

-export( [external_format/1, html_table/3, task/0] ).

external_format( XML ) -> remove_quoutes( lists:flatten(xmerl:export_simple_content([XML], xmerl_xml)) ).

html_table( Table_options, Headers, Contents ) ->
	Header = html_table_header( Headers ),
	Records = [html_table_record(X) || X <- Contents],
	{table, Table_options, [Header | Records]}.

task() ->
	Headers = [" ", "X", "Y", "Z"],
	Contents = [[erlang:integer_to_list(X), random(), random(), random()] || X <- lists:seq(1, 3)],
	external_format( html_table([{border, 1}, {cellpadding, 10}], Headers, Contents) ).

html_table_header( Items ) -> {tr, [], [{th, [], [X]} || X <- Items]}.

html_table_record( Items ) -> {tr, [], [{td, [], [X]} || X <- Items]}.

random() -> erlang:integer_to_list( random:uniform(1000) ).

remove_quoutes( String ) -> lists:flatten( string:tokens(String, "\"") ).


BYTE FUNC CountSubstring(CHAR ARRAY s,sub)
  BYTE i,j,res,found

  i=1 res=0
  WHILE i-1+sub(0)<=s(0)
  DO
    found=1
    FOR j=1 TO sub(0)
    DO
      IF s(j+i-1)#sub(j) THEN
        found=0
        EXIT
      FI
    OD

    IF found=1 THEN
      i==+sub(0)
      res==+1
    ELSE
      i==+1
    FI
  OD
RETURN (res)

PROC Test(CHAR ARRAY s,sub)
  BYTE c

  c=CountSubstring(s,sub)
  PrintF("%B ""%S"" in ""%S""%E",c,sub,s)
RETURN

PROC Main()
  Test("the three truths","th")
  Test("ababababab","abab")
  Test("11111111","11")
  Test("abcdefg","123")
RETURN


with Ada.Strings.Fixed, Ada.Integer_Text_IO;

procedure Substrings is
begin
   Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source  => "the three truths",
                                                     Pattern => "th"));
   Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source  => "ababababab",
                                                     Pattern => "abab"));
end Substrings;


#!/usr/local/bin/a68g --script #

PROC count string in string = (STRING needle, haystack)INT: (
  INT start:=LWB haystack, next, out:=0;
  FOR count WHILE string in string(needle, next, haystack[start:]) DO
    start+:=next+UPB needle-LWB needle;
    out:=count
  OD;
  out
);

printf(($d" "$,
  count string in string("th", "the three truths"),    # expect 3 #
  count string in string("abab", "ababababab"),        # expect 2 #
  count string in string("a*b", "abaabba*bbaba*bbab"), # expect 2 #
  $l$
))


#!/usr/bin/awk -f

BEGIN {
    print cc(100)
    exit
}

function cc(amount, coins,    numPennies, numNickles, numQuarters, p, n, d, q, s, count) {
    numPennies = amount
    numNickles = int(amount / 5)
    numDimes = int(amount / 10)
    numQuarters = int(amount / 25)

    count = 0
    for (p = 0; p <= numPennies; p++) {
        for (n = 0; n <= numNickles; n++) {
            for (d = 0; d <= numDimes; d++) {
                for (q = 0; q <= numQuarters; q++) {
                    s = p + n * 5 + d * 10 + q * 25;
                    if (s == 100) count++;
                }
            }
        }
    }
    return count;
}


      DIM uscoins%(3)
      uscoins%() = 1, 5, 10, 25
      PRINT FNchange(100, uscoins%()) " ways of making $1"
      PRINT FNchange(1000, uscoins%()) " ways of making $10"

      DIM ukcoins%(7)
      ukcoins%() = 1, 2, 5, 10, 20, 50, 100, 200
      PRINT FNchange(100, ukcoins%()) " ways of making £1"
      PRINT FNchange(1000, ukcoins%()) " ways of making £10"
      END

      DEF FNchange(sum%, coins%())
      LOCAL C%, D%, I%, N%, P%, Q%, S%, table()
      C% = 0
      N% = DIM(coins%(),1) + 1
      FOR I% = 0 TO N% - 1
        D% = coins%(I%)
        IF D% <= sum% IF D% >= C% C% = D% + 1
      NEXT
      C% *= N%
      DIM table(C%-1)
      FOR I% = 0 TO N%-1 : table(I%) = 1 : NEXT

      P% = N%
      FOR S% = 1 TO sum%
        FOR I% = 0 TO N% - 1
          IF I% = 0 IF P% >= C% P% = 0
          IF coins%(I%) <= S% THEN
            Q% = P% - coins%(I%) * N%
            IF Q% >= 0 table(P%) = table(Q%) ELSE table(P%) = table(Q% + C%)
          ENDIF
          IF I% table(P%) += table(P% - 1)
          P% += 1
        NEXT
      NEXT
      = table(P%-1)


puts(1,"
\n")
puts(1,"
	X	Y	Z
\n")
for i = 1 to 3 do
    printf(1,"
%d	",i)
    for j = 1 to 3 do
        printf(1,"%d	",rand(10000))
    end for
    puts(1,"
\n")
end for
puts(1,"
")


String substr = 'ABC';
String str = 'ABCZZZABCYABCABCXXABC';
Integer substrLen = substr.length();
Integer count = 0;
Integer index = str.indexOf(substr);
while (index >= 0) {
    count++;
    str = str.substring(index+substrLen);
    index = str.indexOf(substr);
}
System.debug('Count String : '+count);


use framework "OSAKit"

on run
    {countSubstring("the three truths", "th"), ¬
        countSubstring("ababababab", "abab")}
end run

on countSubstring(str, subStr)
    return evalOSA("JavaScript", "var matches = '" & str & "'" & ¬
        ".match(new RegExp('" & subStr & "', 'g'));" & ¬
        "matches ? matches.length : 0") as integer
end countSubstring

-- evalOSA :: ("JavaScript" | "AppleScript") -> String -> String
on evalOSA(strLang, strCode)

    set ca to current application
    set oScript to ca's OSAScript's alloc's initWithSource:strCode ¬
        |language|:(ca's OSALanguage's languageForName:(strLang))

    set {blnCompiled, oError} to oScript's compileAndReturnError:(reference)

    if blnCompiled then
        set {oDesc, oError} to oScript's executeAndReturnError:(reference)
        if (oError is missing value) then return oDesc's stringValue as text
    end if

    return oError's NSLocalizedDescription as text
end evalOSA


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

// ad hoc 128 bit integer type; faster than using GMP because of low
// overhead
typedef struct { uint64_t x[2]; } i128;

// display in decimal
void show(i128 v) {
	uint32_t x[4] = {v.x[0], v.x[0] >> 32, v.x[1], v.x[1] >> 32};
	int i, j = 0, len = 4;
	char buf[100];
	do {
		uint64_t c = 0;
		for (i = len; i--; ) {
			c = (c << 32) + x[i];
			x[i] = c / 10, c %= 10;
		}

		buf[j++] = c + '0';
		for (len = 4; !x[len - 1]; len--);
	} while (len);

	while (j--) putchar(buf[j]);
	putchar('\n');
}

i128 count(int sum, int *coins)
{
	int n, i, k;
	for (n = 0; coins[n]; n++);

	i128 **v = malloc(sizeof(int*) * n);
	int *idx = malloc(sizeof(int) * n);

	for (i = 0; i < n; i++) {
		idx[i] = coins[i];
		// each v[i] is a cyclic buffer
		v[i] = calloc(sizeof(i128), coins[i]);
	}

	v[0][coins[0] - 1] = (i128) {{1, 0}};

	for (k = 0; k <= sum; k++) {
		for (i = 0; i < n; i++)
			if (!idx[i]--) idx[i] = coins[i] - 1;

		i128 c = v[0][ idx[0] ];

		for (i = 1; i < n; i++) {
			i128 *p = v[i] + idx[i];

			// 128 bit addition
			p->x[0] += c.x[0];
			p->x[1] += c.x[1];
			if (p->x[0] < c.x[0]) // carry
				p->x[1] ++;
			c = *p;
		}
	}

	i128 r = v[n - 1][idx[n-1]];

	for (i = 0; i < n; i++) free(v[i]);
	free(v);
	free(idx);

	return r;
}

// simple recursive method; slow
int count2(int sum, int *coins)
{
	if (!*coins || sum < 0) return 0;
	if (!sum) return 1;
	return count2(sum - *coins, coins) + count2(sum, coins + 1);
}

int main(void)
{
	int us_coins[] = { 100, 50, 25, 10, 5, 1, 0 };
	int eu_coins[] = { 200, 100, 50, 20, 10, 5, 2, 1, 0 };

	show(count(   100, us_coins + 2));
	show(count(  1000, us_coins));

	show(count(  1000 * 100, us_coins));
	show(count( 10000 * 100, us_coins));
	show(count(100000 * 100, us_coins));

	putchar('\n');

	show(count(     1 * 100, eu_coins));
	show(count(  1000 * 100, eu_coins));
	show(count( 10000 * 100, eu_coins));
	show(count(100000 * 100, eu_coins));

	return 0;
}


open System.Xml

type XmlDocument with
    member this.Add element =
        this.AppendChild element
    member this.Element name =
        this.CreateElement(name) :> XmlNode
    member this.Element (name, (attr : (string * string) list)) =
        let node = this.CreateElement(name)
        for a in attr do
            node.SetAttribute (fst a, snd a)
        node
    member this.Element (name, (text : string)) =
        let node = this.CreateElement(name)
        node.AppendChild(this.Text text) |> ignore
        node
    member this.Text text =
        this.CreateTextNode(text)
    end

type XmlNode with
    member this.Add element =
        this.AppendChild element
    end

let head = [""; "X"; "Y"; "Z"]

let xd = new XmlDocument()
let html = xd.Add (xd.Element("html"))
html.Add(xd.Element("head"))
    .Add(xd.Element("title", "RosettaCode: Create_an_HTML_table"))
let table = html.Add(xd.Element("body")).Add(xd.Element("table", [("style", "text-align:right")]))
let tr1 = table.Add(xd.Element("tr"))
for th in head do
    tr1.Add(xd.Element("th", th)) |> ignore
for i in [1; 2; 3] do
    let tr = table.Add(xd.Element("tr"))
    tr.Add(xd.Element("th", i.ToString())) |> ignore
    for j in [1; 2; 3] do
        tr.Add(xd.Element("td", ((i-1)*3+j+1000).ToString())) |> ignore

let xw = new XmlTextWriter(System.Console.Out)
xw.Formatting <- Formatting.Indented
xd.WriteContentTo(xw)


countOccurrences: function [str, substr]-> size match str substr

loop [["the three truths" "th"] ["ababababab" "abab"]] 'pair ->
    print [
        ~"occurrences of '|last pair|' in '|first pair|':"
        countOccurrences first pair last pair
    ]


MsgBox % countSubstring("the three truths","th") ; 3
MsgBox % countSubstring("ababababab","abab")     ; 2

CountSubstring(fullstring, substring){
   StringReplace, junk, fullstring, %substring%, , UseErrorLevel
   return errorlevel
}


#
# countsubstring(string, pattern)
#   Returns number of occurrences of pattern in string
#   Pattern treated as a literal string (regex characters not expanded)
#
function countsubstring(str, pat,    len, i, c) {
  c = 0
  if( ! (len = length(pat) ) )
    return 0
  while(i = index(str, pat)) {
    str = substr(str, i + len)
    c++
  }
  return c
}
#
# countsubstring_regex(string, regex_pattern)
#   Returns number of occurrences of pattern in string
#   Pattern treated as regex
#
function countsubstring_regex(str, pat,    c) {
  c = 0
  c += gsub(pat, "", str)
  return c
}
BEGIN {
  print countsubstring("[do&d~run?d!run&>run&]", "run&")
  print countsubstring_regex("[do&d~run?d!run&>run&]", "run[&]")
  print countsubstring("the three truths","th")
}


    // Adapted from http://www.geeksforgeeks.org/dynamic-programming-set-7-coin-change/
    class Program
    {
        static long Count(int[] C, int m, int n)
        {
            var table = new long[n + 1];
            table[0] = 1;
            for (int i = 0; i < m; i++)
                for (int j = C[i]; j <= n; j++)
                    table[j] += table[j - C[i]];
            return table[n];
        }
        static void Main(string[] args)
        {
            var C = new int[] { 1, 5, 10, 25 };
            int m = C.Length;
            int n = 100;
            Console.WriteLine(Count(C, m, n));  //242
            Console.ReadLine();
        }
    }


#include <iostream>
#include <stack>
#include <vector>

struct DataFrame {
  int sum;
  std::vector<int> coins;
  std::vector<int> avail_coins;
};

int main() {
  std::stack<DataFrame> s;
  s.push({ 100, {}, { 25, 10, 5, 1 } });
  int ways = 0;
  while (!s.empty()) {
    DataFrame top = s.top();
    s.pop();
    if (top.sum < 0) continue;
    if (top.sum == 0) {
      ++ways;
      continue;
    }
    if (top.avail_coins.empty()) continue;
    DataFrame d = top;
    d.sum -= top.avail_coins[0];
    d.coins.push_back(top.avail_coins[0]);
    s.push(d);
    d = top;
    d.avail_coins.erase(std::begin(d.avail_coins));
    s.push(d);
  }
  std::cout << ways << std::endl;
  return 0;
}


USING: html.streams literals prettyprint random xml.writer ;

: rnd ( -- n ) 10,000 random ;

{
     { "" "X" "Y" "Z" }
    ${ 1  rnd rnd rnd }
    ${ 2  rnd rnd rnd }
    ${ 3  rnd rnd rnd }
}
[ simple-table. ] with-html-writer pprint-xml


include random.hsf

\ parser routines
:  totag
               [char] < PARSE pad place              \ parse input up to '<' char
                -1 >in +!                            \ move the interpreter pointer back 1 char
                pad count type  ;

: '"'        [char] " emit ;
: '"..'      '"'  space ;                            \ output a quote char with trailing space

: toquote                                            \ parse input to " then print as quoted text
              '"' [char] " PARSE pad place
              pad count type '"..' ;

: >          [char] > emit space  ;                  \ output the '>' with trailing space

\ Create some HTML extensions to the Forth interpreter
:
         ."
" cr ;          :
   ."
"  cr ;
: <table          ." <table " ;
: style="         ." style="  toquote ;
: align="         ." align="  toquote ;
: border="        ." border=" toquote ;
: width="         ." width="  toquote ;
: cellspacing="   ." cellspacing="  toquote ;
: colspacing="    ." colspacing="   toquote ;

:
       ."
" cr ;                  :
      ."
"  cr ;
:        ."  "  totag  ;            : 	      ." 	"  cr ;
: <td        ." <td " ;
:
    ."
" ;                  :
   ."
" ;
:        ." " ;                     : 	      ." 	"  cr ;
: <th        ." <th "  ;
: <tbody     ." <tbody " ;                  :
   ."
 " ;
:
  cr ."
"  totag  ;     :
 ."
"  cr ;

\ Write the source code that generates HTML in our EXTENDED FORTH
cr

 This table was created with FORTH HTML tags

 ." A"
 ." B"
 ." C"

        1 .
 1000 RND .
 1000 RND .
 1000 RND .

        2 .
 1000 RND .
 1000 RND .
 1000 RND .

        3 .
 1000 RND .
 1000 RND .
 1000 RND .


FUNCTION Uniq_Tally(text$, part$)
    LOCAL x
    WHILE TALLY(text$, part$)
        INCR x
        text$ = MID$(text$, INSTR(text$, part$)+LEN(part$))
    WEND
    RETURN x
END FUNCTION

PRINT "the three truths - th: ", Uniq_Tally("the three truths", "th")
PRINT "ababababab - abab: ", Uniq_Tally("ababababab", "abab")


DECLARE FUNCTION countSubstring& (where AS STRING, what AS STRING)

PRINT "the three truths, th:", countSubstring&("the three truths", "th")
PRINT "ababababab, abab:", countSubstring&("ababababab", "abab")

FUNCTION countSubstring& (where AS STRING, what AS STRING)
    DIM c AS LONG, s AS LONG
    s = 1 - LEN(what)
    DO
        s = INSTR(s + LEN(what), where, what)
        IF 0 = s THEN EXIT DO
        c = c + 1
    LOOP
    countSubstring = c
END FUNCTION


(def denomination-kind [1 5 10 25])

(defn- cc [amount denominations]
  (cond (= amount 0) 1
        (or (< amount 0) (empty? denominations)) 0
        :else (+ (cc amount (rest denominations))
                 (cc (- amount (first denominations)) denominations))))

(defn count-change
  "Calculates the number of times you can give change with the given denominations."
  [amount denominations]
  (cc amount denominations))

(count-change 15 denomination-kind) ; = 6


       identification division.
       program-id. CountCoins.

       data division.
       working-storage section.
       77  i                      pic 9(3).
       77  j                      pic 9(3).
       77  m                      pic 9(3) value 4.
       77  n                      pic 9(3) value 100.
       77  edited-value           pic z(18).
       01  coins-table            value "01051025".
           05 coin                pic 9(2) occurs 4.
       01  ways-table.
           05 way                 pic 9(18) occurs 100.

       procedure division.
       main.
           perform calc-count
           move way(n) to edited-value
           display function trim(edited-value)
           stop run
           .
       calc-count.
           initialize ways-table
           move 1 to way(1)
           perform varying i from 1 by 1 until i > m
              perform varying j from coin(i) by 1 until j > n
                 add way(j - coin(i)) to way(j)
              end-perform
           end-perform
           .


MODULE PARAMETERS	!Assorted oddities that assorted routines pick and choose from.
       CHARACTER*5 I AM		!Assuage finicky compilers.
       PARAMETER (IAM = "Gnash")	!I AM!
       INTEGER		LUSERCODE	!One day, I'll get around to devising some string protocol.
       CHARACTER*28	USERCODE		!I'm not too sure how long this can be.
       DATA		USERCODE,LUSERCODE/"",0/!Especially before I have a text.
      END MODULE PARAMETERS

      MODULE ASSISTANCE
      CONTAINS	!Assorted routines that seem to be of general use but don't seem worth isolating..
      Subroutine Croak(Gasp)	!A dying message, when horror is suddenly encountered.
Casts out some final words and STOP, relying on the SubInOut stuff to have been used.
Cut down from the full version of April MMI, that employed the SubIN and SubOUT protocol..
       Character*(*) Gasp	!The last gasp.
       COMMON KBD,MSG
       WRITE (MSG,1) GASP
    1  FORMAT ("Oh dear! ",A)
       STOP "I STOP now. Farewell..."	!Whatever pit I was in, I'm gone.
      End Subroutine Croak	!That's it.

       INTEGER FUNCTION LSTNB(TEXT)  !Sigh. Last Not Blank.
Concocted yet again by R.N.McLean (whom God preserve) December MM.
Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness!
Can't   DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ')	!Control chars. regarded as spaces.
Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully.
Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable.
Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone.
Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only.
Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L!
Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB.
        CHARACTER*(*),INTENT(IN):: TEXT	!The bumf. If there must be copy-in, at least there need not be copy back.
        INTEGER L		!The length of the bumf.
         L = LEN(TEXT)		!So, what is it?
    1    IF (L.LE.0) GO TO 2	!Are we there yet?
         IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2	!Control chars are regarded as spaces also.
         L = L - 1		!Step back one.
         GO TO 1		!And try again.
    2    LSTNB = L		!The last non-blank, possibly zero.
        RETURN			!Unsafe to use LSTNB as a variable.
       END FUNCTION LSTNB	!Compilers can bungle it.
       CHARACTER*2 FUNCTION I2FMT(N)	!These are all the same.
        INTEGER*4 N			!But, the compiler doesn't offer generalisations.
         IF (N.LT.0) THEN	!Negative numbers cop a sign.
           IF (N.LT.-9) THEN	!But there's not much room left.
             I2FMT = "-!"	!So this means 'overflow'.
            ELSE			!Otherwise, room for one negative digit.
             I2FMT = "-"//CHAR(ICHAR("0") - N)	!Thus. Presume adjacent character codes, etc.
           END IF		!So much for negative numbers.
         ELSE IF (N.LT.10) THEN	!Single digit positive?
           I2FMT = " " //CHAR(ICHAR("0") + N)	!Yes. This.
         ELSE IF (N.LT.100) THEN	!Two digit positive?
           I2FMT = CHAR(N/10      + ICHAR("0"))	!Yes.
     1            //CHAR(MOD(N,10) + ICHAR("0")) !These.
         ELSE			!Otherwise,
           I2FMT = "+!" 	!Positive overflow.
         END IF			!So much for that.
       END FUNCTION I2FMT	!No WRITE and FORMAT unlimbering.
       CHARACTER*8 FUNCTION I8FMT(N)	!Oh for proper strings.
        INTEGER*4 N
        CHARACTER*8 HIC
         WRITE (HIC,1) N
    1    FORMAT (I8)
         I8FMT = HIC
       END FUNCTION I8FMT
       CHARACTER*42 FUNCTION ERRORWORDS(IT)	!Look for an explanation. One day, the system may offer coherent messages.
Curious collection of encountered codes. Will they differ on other systems?
Compaq's compiler was taken over by unintel; http://software.intel.com/sites/products/documentation/hpc/compilerpro/en-us/fortran/lin/compiler_f/bldaps_for/common/bldaps_rterrs.htm
contains a schedule of error numbers that matched those I'd found for Compaq, and so some assumptions are added.
Copying all (hundreds!) is excessive; these seem possible for the usage so far made of error diversion.
Compaq's compiler interface ("visual" blah) has a help offering, which can provide error code information.
Compaq messages also appear in http://cens.ioc.ee/local/man/CompaqCompilers/cf/dfuum028.htm#tab_runtime_errors
Combines IOSTAT codes (file open, read etc) with STAT codes (allocate/deallocate) as their numbers are distinct.
Completeness and context remains a problem. Excess brevity means cause and effect can be confused.
        INTEGER IT			!The error code in question.
        INTEGER LASTKNOWN 		!Some codes I know about.
        PARAMETER (LASTKNOWN = 26)	!But only a few, discovered by experiment and mishap.
        TYPE HINT			!For them, I can supply a table.
         INTEGER	CODE		!The code number. (But, different systems..??)
         CHARACTER*42	EXPLICATION	!An explanation. Will it be the answer?
        END TYPE HINT			!Simple enough.
        TYPE(HINT) ERROR(LASTKNOWN)	!So, let's have a collection.
        PARAMETER (ERROR = (/		!With these values.
     1   HINT(-1,"End-of-file at the start of reading!"),	!From examples supplied with the Compaq compiler involving IOSTAT.
     2   HINT( 0,"No worries."),			!Apparently the only standard value.
     3   HINT( 9,"Permissions - read only?"),
     4   HINT(10,"File already exists!"),
     5   HINT(17,"Syntax error in NameList input."),
     6   HINT(18,"Too many values for the recipient."),
     7   HINT(19,"Invalid naming of a variable."),
     8   HINT(24,"Surprise end-of-file during read!"),	!From example source.
     9   HINT(25,"Invalid record number!"),
     o   HINT(29,"File name not found."),
     1   HINT(30,"Unavailable - exclusive use?"),
     2   HINT(32,"Invalid fileunit number!"),
     3   HINT(35,"'Binary' form usage is rejected."),	!From example source.
     4   HINT(36,"Record number for a non-existing record!"),
     5   HINT(37,"No record length has been specified."),
     6   HINT(38,"I/O error during a write!"),
     7   HINT(39,"I/O error during a read!"),
     8   HINT(41,"Insufficient memory available!"),
     9   HINT(43,"Malformed file name."),
     o   HINT(47,"Attempting a write, but read-only is set."),
     1   HINT(66,"Output overflows single record size."),	!This one from experience.
     2   HINT(67,"Input demand exceeds single record size."),	!These two are for unformatted I/O.
     3   HINT(151,"Can't allocate: already allocated!"),	!These different numbers are for memory allocation failures.
     4   HINT(153,"Can't deallocate: not allocated!"),
     5   HINT(173,"The fingered item was not allocated!"),	!Such as an ordinary array that was not allocated.
     6   HINT(179,"Size exceeds addressable memory!")/))
        INTEGER I		!A stepper.
         DO I = LASTKNOWN,1,-1	!So, step through the known codes.
           IF (IT .EQ. ERROR(I).CODE) GO TO 1	!This one?
         END DO			!On to the next.
    1    IF (I.LE.0) THEN	!Fail with I = 0.
           ERRORWORDS = I8FMT(IT)//" is a novel code!"	!Reveal the mysterious number.
          ELSE			!But otherwise, it is found.
           ERRORWORDS = ERROR(I).EXPLICATION	!And these words might even apply.
         END IF			!But on all systems?
       END FUNCTION ERRORWORDS	!Hopefully, helpful.
      END MODULE ASSISTANCE

      MODULE LOGORRHOEA
       CONTAINS
        SUBROUTINE ECART(TEXT)	!Produces trace output with many auxiliary details.
         CHARACTER*(*) TEXT	!The text to be annotated.
         COMMON KBD,MSG		!I/O units.
          WRITE (MSG,1) TEXT	!Just roll the text.
    1     FORMAT ("Trace: ",A)	!Lacks the names of the invoking routine, and that which invoked it.
        END SUBROUTINE ECART
       SUBROUTINE WRITE(OUT,TEXT,ON)	!We get here in the end. Cast forth some pearls.
C   Once upon a time, there was just confusion between ASCII and EBCDIC character codes and glyphs,
c after many variant collections caused annoyance. Now I see that modern computing has introduced
c many new variations, so that one text editor may display glyphs differing from those displayed
c by another editor and also different from those displayed when a programme writes to the screen
c in "teletype" mode, which is to say, employing the character/glyph combination of the moment.
c And in particular, decimal points and degree symbols differ and annoyance has grown.
c   So, on re-arranging SAY to not send output to multiple distinations depending on the value of OUT,
c except for the special output to MSG that is echoed to TRAIL, it became less messy to make an assault
c on the text that goes to MSG, but after it was sent to TRAIL. I would have preferred to fiddle the
c "code page" for text output that determines what glyph to show for which code, but not only
c is it unclear how to do this, even if facilities were available, I suspect that the screen display
c software only loads the mysterious code page during startup.
c   This fiddling means that any write to MSG should be done last, and writes of text literals
c should not include characters that will be fiddled, as text literals may be protected against change.
C   Somewhere along the way, the cent character (¢) has disappeared. Perhaps it will return in "unicode".
        USE ASSISTANCE		!But might still have difficulty.
        INTEGER OUT		!The destination.
        CHARACTER*(*) TEXT	!The message. Possibly damaged. Any trailing spaces will be sent forth.
        LOGICAL ON		!Whether to terminate the line... TRUE sez that someone will be carrying on.
        INTEGER IOSTAT		!Furrytran gibberish.
c        INCLUDE "cIOUnits.for"	!I/O unit numbers.
        COMMON KBD,MSG
c        INTEGER*2,SAVE:: I Be	!Self-identification.
c         CALL SUBIN("Write",I Be)	!Hullo!
         IF (OUT.LE.0) GO TO 999	!Goodbye?
c         IF (IOGOOD(OUT)) THEN	!Is this one in good heart?
c           IF (IOCOUNT(OUT).LE.0 .AND. OUT.NE.MSG) THEN	!Is it attached to a file?
c             IF (IONAME(OUT).EQ."") IONAME(OUT) = "Anome"	!"No name".
c     1         //I2FMT(OUT)//".txt"	!Clutch at straws.
c             IF (.NOT.OPEN(OUT,IONAME(OUT),"REPLACE","WRITE")) THEN	!Just in time?
c               IOGOOD(OUT) = .FALSE.	!No! Strangle further usage.
c               GO TO 999		!Can't write, so give up!
c             END IF			!It might be better to hit the WRITE and fail.
c           END IF		!We should be ready now.
c           IF (OUT.EQ.MSG .AND. SCRAGTEXTOUT) CALL SCRAG(TEXT)	!Output to the screen is recoded for the screen.
           IF (ON) THEN		!Now for the actual output at last. This is annoying.
             WRITE (OUT,1,ERR = 666,IOSTAT = IOSTAT) TEXT	!Splurt.
    1        FORMAT (A,$)	!Don't move on to a new line. (The "$"! Is it not obvious?)
c             IOPART(OUT) = IOPART(OUT) + 1	!Thus count a part-line in case someone fusses.
            ELSE		!But mostly, write and advance.
             WRITE (OUT,2,ERR = 666,IOSTAT = IOSTAT) TEXT	!Splurt.
    2        FORMAT (A)		!*-style "free" format chops at 80 or some such.
           END IF		!So much for last-moment dithering.
c           IOCOUNT(OUT) = IOCOUNT(OUT) + 1	!Count another write (whole or part) so as to be not zero..
c         END IF			!So much for active passages.
c  999    CALL SUBOUT("Write")	!I am closing.
  999   RETURN			!Done.
Confusions.
  666    IF (OUT.NE.MSG) CALL CROAK("Can't write to unit "//I2FMT(OUT)	!Why not?
c     1    //" (file "//IONAME(OUT)(1:LSTNB(IONAME(OUT)))	!Possibly, no more disc space! In which case, this may fail also!
     2    //") message "//ERRORWORDS(IOSTAT)			!Hopefully, helpful.
     3    //" length "//I8FMT(LEN(TEXT))//", this: "//TEXT)	!The instigation.
        STOP "Constipation!"	!Just so.
       END SUBROUTINE WRITE	!The moving hand having writ, moves on.

       SUBROUTINE SAY(OUT,TEXT)	!And maybe a copy to the trail file as well.
        USE PARAMETERS		!Odds and ends.
        USE ASSISTANCE		!Just a little.
        INTEGER OUT		!The orifice.
        CHARACTER*(*) TEXT	!The blather. Can be modified if to MSG and certain characters are found.
        CHARACTER*120 IS	!For a snatched question.
        INTEGER L		!A finger.
c        INCLUDE "cIOUnits.for"	!I/O unit numbers.
        COMMON KBD,MSG
c        INTEGER*2,SAVE:: I Be	!Self-identification.
c         CALL SUBIN("Say",I Be)	!Me do be Me, I say!
Chop off trailing spaces.
         L = LEN(TEXT)		!What I say may be rather brief.
    1    IF (L.GT.0) THEN	!So, is there a last character to look at?
           IF (ICHAR(TEXT(L:L)).LE.ICHAR(" ")) THEN	!Yes. Is it boring?
             L = L - 1			!Yes! Trim it!
             GO TO 1			!And check afresh.
           END IF		!A DO-loop has overhead with its iteration count as well.
         END IF			!Function LEN_TRIM copies the text first!!
Contemplate the disposition of TEXT(1:L)
c         IF (OUT.NE.MSG) THEN	!Normal stuff?
           CALL WRITE(OUT,TEXT(1:L),.FALSE.)	!Roll.
c          ELSE			!Echo what goes to MSG to the TRAIL file.
c           CALL WRITE(TRAIL,TEXT(1:L),.FALSE.)	!Thus.
c           CALL WRITE(  MSG,TEXT(1:L),.FALSE.)	!Splot to the screen.
c           IF (.NOT.BLABBERMOUTH) THEN		!Do we know restraint?
c             IF (IOCOUNT(MSG).GT.BURP) THEN	!Yes. Consider it.
c               WRITE (MSG,100) IOCOUNT(MSG)	!Alas, triggered. So remark on quantity,
c  100          FORMAT (//I9," lines! Your spirit might flag."	!Hint. (Not copied to the TRAIL file)
c     1          /," Type quit to set GIVEOVER to TRUE, with hope for "
c     2           ,"a speedy palliation,",
c     3          /,"   or QUIT to abandon everything, here, now",
c     4          /,"   or blabber to abandon further restraint,",
c     5          /,"   or anything else to carry on:")
c               IS = REPLY("QUIT, quit, blabber or continue")	!And ask.
c               IF (IS.EQ."QUIT") CALL CROAK("Enough of this!")	!No UPDATE, nothing.
c               CALL UPCASE(IS)		!Now we're past the nice distinction, simplify.
c               IF (IS.EQ."QUIT") GIVEOVER = .TRUE.	!Signal to those who listen.
c               IF (IS.EQ."BLABBER") BLABBERMOUTH = .TRUE.	!Well?
c               IF (GIVEOVER) WRITE (MSG,101)			!Announce hope.
c  101          FORMAT ("Let's hope that the babbler notices...")	!Like, IF (GIVEOVER) GO TO ...
c               IF (.NOT.GIVEOVER) WRITE (MSG,102)	!Alternatively, firm resolve.
c  102          FORMAT("Onwards with renewed vigour!")	!Fight the good fight.
c               BURP = IOCOUNT(MSG) + ENOUGH	!The next pause to come.
c             END IF			!So much for last-moment restraint.
c           END IF			!So much for restraint.
c         END IF			!So much for selection.
c         CALL SUBOUT("Say")	!I am merely the messenger.
       END SUBROUTINE SAY	!Enough said.
       SUBROUTINE SAYON(OUT,TEXT)	!Roll to the screen and to the trail file as well.
C This differs by not ending the line so that further output can be appended to it.
        USE ASSISTANCE
        INTEGER OUT		!The orifice.
        CHARACTER*(*) TEXT	!The blather.
        INTEGER L		!A finger.
c        INCLUDE "cIOUnits.for"	!I/O unit numbers.
        COMMON KBD,MSG
c        INTEGER*2,SAVE:: I Be	!Self-identification.
c         CALL SUBIN("SayOn",I Be)	!Me do be another. Me, I say on!
         L = LEN(TEXT)			!How much say I on?
    1    IF (L.GT.0) THEN		!I say on anything?
           IF (ICHAR(TEXT(L:L)).LE.ICHAR(" ")) THEN	!I end it spaceish?
             L = L - 1				!Yes. Trim such.
             GO TO 1				!And look afresh.
           END IF			!So much for trailing off.
         END IF			!Continue with L fingering the last non-blank.
c         IF (OUT.EQ.MSG) CALL WRITE(TRAIL,TEXT(1:L),.TRUE.)	!Writes to the screen go also to the TRAIL.
                         CALL WRITE(  OUT,TEXT(1:L),.TRUE.)	!It is said, and more is expected.
c         CALL SUBOUT("SayOn")	!I am merely the messenger.
       END SUBROUTINE SAYON	!And further messages impend.

      END MODULE LOGORRHOEA

      MODULE HTMLSTUFF	!Assists with the production of decorated output.
Can't say I think much of the scheme. How about <+blah> ... <-blah> rather than the assymetric <blah> ... </blah>?
Cack-handed comment format as well...
       USE PARAMETERS	!To ascertain who I AM.
       USE ASSISTANCE	!To get at LSTNB.
       USE LOGORRHOEA	!To get at SAYON and SAY.
       INTEGER INDEEP,HOLE	!I keep track of some details.
       PRIVATE INDEEP,HOLE	!Amongst myselves.
       DATA INDEEP,HOLE/0,0/	!Initially, I'm not doing anything.
Choose amongst output formats.
       INTEGER LASTFILETYPENAME		!Certain file types are recognised.
       PARAMETER (LASTFILETYPENAME = 2)	!Thus, three options.
       INTEGER OUTTYPE,OUTTXT,OUTCSV,OUTHTML	!The recognition.
       CHARACTER*5 OUTSTYLE,FILETYPENAME(0:LASTFILETYPENAME)	!Via the tail end of a file name.
       PARAMETER (FILETYPENAME = (/".txt",".CSV",".HTML"/))	!Thusly. Note that WHATFILETYPE will not recognise ".txt" directly.
       PARAMETER (OUTTXT = 0,OUTCSV = 1,OUTHTML = 2)	!Mnemonics.
       DATA OUTSTYLE/""/	!So OUTTYPE = OUTTXT. But if an output file is specified, its file type will be inspected.
       TYPE HTMLMNEMONIC	!I might as well get systematic, as these are global names.
        CHARACTER* 9 COMMAH		!This looks like a comma
        CHARACTER* 9 COMMAD		!And in another context, so does this.
        CHARACTER* 6 SPACE		!Some spaces are to be atomic.
        CHARACTER*18 RED		!Decoration and
        CHARACTER* 7 DER		!noitaroceD.
       END TYPE HTMLMNEMONIC	!That's enough for now.
       TYPE(HTMLMNEMONIC) HTMLA	!I'll have one set, please.
       PARAMETER (HTMLA = HTMLMNEMONIC(	!With these values.
     1  "	",			!But .html has its variants. For a heading.
     2  "	",			!For a table datum.
     3  " ",			!A space that is not to be split.
     4  '',		!Dabble in decoration.
     5  ''))			!Grrrr. A font is for baptismal water.
      CONTAINS	!Mysterious assistants.
       SUBROUTINE HTML(TEXT)	!Rolls some text, with suitable indentation.
        CHARACTER*(*) TEXT	!The text.
c        INCLUDE "cIOUnits.for"	!I/O unit numbers.
         IF (LEN(TEXT).LE.0) RETURN	!Possibly boring.
         IF (INDEEP.GT.0) THEN		!Some indenting desired?
           CALL WRITE(HOLE,REPEAT(" ",INDEEP),.TRUE.)	!Yep. SAYON trims trailing spaces.
c           IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,REPEAT(" ",INDEEP),.TRUE.)	!So I must copy.
         END IF			!Enough indenting.
         CALL SAY(HOLE,TEXT)	!Say the piece and end the line.
       END SUBROUTINE HTML	!Maintain stacks? Check entry/exit matching?

       SUBROUTINE HTML3(HEAD,BUMF,TAIL)	!Rolls some text, with suitable indentation.
Checks the BUMF for decimal points only. HTMLALINE handles text to HTML for troublesome characters, replacing them with special names for the desired glyph.
Confusion might arise, if & is in BUMF and is not to be converted. "&" vs "&so on"; similar worries with < and >.
        CHARACTER*(*) HEAD	!If not "", the start of the line, with indentation supplied.
        CHARACTER*(*) BUMF	!The main body of the text.
        CHARACTER*(*) TAIL	!If not "", this is for the end of the line.
        INTEGER LB,L1,L2	!A length and some fingers for scanning.
        CHARACTER*1 MUMBLE	!These symbols may not be presented properly.
        CHARACTER*8 MUTTER	!But these encodements may be interpreted as desired.
        PARAMETER (MUMBLE = "·")	!I want certain glyphs, but encodement varies.
        PARAMETER (MUTTER = "·")	!As does recognition.
c        INCLUDE "cIOUnits.for"	!I/O unit numbers.
        COMMON KBD,MSG
Commence with a new line?
         IF (HEAD.NE."") THEN	!Is a line to be started? (Spaces are equivalent to "" as well)
           IF (INDEEP.GT.0) THEN	!Some indentation is good.
             CALL WRITE(HOLE,REPEAT(" ",INDEEP),.TRUE.)	!Yep. SAYON trims trailing spaces.
c             IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,	!So I must copy for the log.
c     1        REPEAT(" ",INDEEP),.TRUE.)	!Hopefully, not generated a second time.
            ELSE			!The accountancy may be bungled.
             CALL ECART("HTML huh? InDeep="//I8FMT(INDEEP))	!So, complain.
           END IF			!Also, REPEAT has misbehaved.
           CALL SAYON(HOLE,HEAD)	!Thus a suitable indentation.
         END IF			!So much for a starter.
Cast forth the bumf. Any trailing spaces will be dropped by SAYON.
         LB = LEN(BUMF)		!How much bumf? Trailing spaces will be rolled.
         L1 = 1			!Waiting to be sent.
         L2 = 0			!Syncopation.
    1    L2 = L2 + 1		!Advance to the next character to be inspected..
         IF (L2.GT.LB) GO TO 2	!Is there another?
         IF (ICHAR(BUMF(L2:L2)).NE.ICHAR(MUMBLE)) GO TO 1	!Yes. Advance through the untroublesome.
         IF (L1.LT.L2) THEN		!A hit. Have any untroubled ones been passed?
           CALL WRITE(HOLE,BUMF(L1:L2 - 1),.TRUE.)	!Yes. Send them forth.
c           IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,BUMF(L1:L2 - 1),.TRUE.)	!With any trailing spaces included.
         END IF				!Now to do something in place of BUMF(L2)
         L1 = L2 + 1			!Moving the marker past it, like.
         CALL SAYON(HOLE,MUTTER)	!The replacement for BUMF(L2 as was).
         GO TO 1		!Continue scanning.
    2    IF (L2.GT.L1) THEN	!Any tail end, but not ending the output line.
           CALL WRITE(HOLE,BUMF(L1:L2 - 1),.TRUE.)	!Yes. Away it goes.
c           IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,BUMF(L1:L2 - 1),.TRUE.)	!And logged.
         END IF				!So much for the bumf.
Consider ending the line.
    3    IF (TAIL.NE."") CALL SAY(HOLE,TAIL)	!Enough!
       END SUBROUTINE HTML3	!Maintain stacks? Check entry/exit matching?

       SUBROUTINE HTMLSTART(OUT,TITLE,DESC)	!Roll forth some gibberish.
        INTEGER OUT		!The mouthpiece, mentioned once only at the start, and remembered for future use.
        CHARACTER*(*) TITLE	!This should be brief.
        CHARACTER*(*) DESC	!This a little less brief.
        CHARACTER*(*) METAH	!Some repetition.
        PARAMETER (METAH = '<Meta Name="')	!The syntax is dubious.
        CHARACTER*8 D		!YYYYMMDD
        CHARACTER*10 T		!HHMMSS.FFF
         HOLE = OUT		!Keep a local copy to save on parameters.
         INDEEP = 0		!We start.
         CALL HTML('<!DOCTYPE HTML PUBLIC "'	!Before we begin, we wave hands.
     1    //'-//W3C//DTD HTML 4.01 Transitional//EN"'	!Otherwise "nowrap" is objected to, as in http://validator.w3.org/check
     2    //' "http://www.w3.org/TR/html4/loose.dtd">')	!Endless blather.
         CALL HTML('')	!  H E R E   W E   G O !
         INDEEP = 1				!Its content.
         CALL HTML("")			!And the first decoration begins.
         INDEEP = 2				!Its content.
         CALL HTML("<Title>"//I AM//" "	!This appears in the web page tag.
     1    // TITLE(1:LSTNB(TITLE)) //"</Title>")!So it should be short.
         CALL HTML('<Meta http-equiv="Content-Type"'	!Crazed gibberish.
     1    //' content="text/html; charset=utf-8">') 		!But said to be worthy.
         CALL HTML(METAH//'Description" Content="'//DESC//'">')	!Hopefully, helpful.
         CALL HTML(METAH//'Generator"   Content="'//I AM//'">')	!I said.
         CALL DATE_AND_TIME(DATE = D,TIME = T)			!Not assignments, but attachments.
         CALL HTML(METAH//'Created"     Content="'		!Convert the timestamp
     1    //D(1:4)//"-"//D(5:6)//"-"//D(7:8)			!Into an international standard.
     2    //" "//T(1:2)//":"//T(3:4)//":"//T(5:10)//'">')	!For date and time.
         IF (LUSERCODE.GT.0) CALL HTML(METAH			!Possibly, the user's code is known.
     1    //'Author"      Content="'//USERCODE(1:LUSERCODE)	!If so, reveal.
     2    //'"> ')	!Disclaiming responsibility...
         INDEEP = 1		!Finishing the content of the header.
         CALL HTML("")	!Enough of that.
         CALL HTML("")	!A fresh line seems polite.
         INDEEP = 2		!Its content follows..
       END SUBROUTINE HTMLSTART	!Others will follow on. Hopefully, correctly.
       SUBROUTINE HTMLSTOP	!And hopefully, this will be a good closure.
Could be more sophisticated and track the stack via INDEEP+- and names, to enable a desperate close-off if INDEEP is not 2.
         IF (INDEEP.NE.2) CALL ECART("Misclosure! InDeep not 2 but"	!But,
     1    //I8FMT(INDEEP))	!It may not be.
         INDEEP = 1		!Retreat to the first level.
         CALL HTML("")	!End the "body".
         INDEEP = 0		!Retreat to the start level.
         CALL HTML("")	!End the whole thing.
       END SUBROUTINE HTMLSTOP	!Ah...

       SUBROUTINE HTMLTSTART(B,SUMMARY)	!Start a table.
        INTEGER B		!Border thickness.
        CHARACTER*(*) SUMMARY	!Some well-chosen words.
         CALL HTML("
')	!Not displayed, but potentially used by non-display agencies...
         INDEEP = INDEEP + 1		!Another level dug.
       END SUBROUTINE HTMLTSTART!That part was easy.
       SUBROUTINE HTMLTSTOP	!And the ending is easy too.
         INDEEP = INDEEP - 1		!Withdraw a level.
         CALL HTML("
")		!Hopefully, aligning.
       END SUBROUTINE HTMLTSTOP	!The bounds are easy.

       SUBROUTINE HTMLTHEADSTART	!Start a table's heading.
         CALL HTML("
")		!Thus.
         INDEEP = INDEEP + 1		!Dig deeper.
       END SUBROUTINE HTMLTHEADSTART	!Content should follow.
       SUBROUTINE HTMLTHEADSTOP		!And now, enough.
         INDEEP = INDEEP - 1		!Retreat a level.
         CALL HTML("
")		!And end the head.
       END SUBROUTINE HTMLTHEADSTOP	!At the neck of the body?

       SUBROUTINE HTMLTHEAD(N,TEXT)	!Cast forth a whole-span table heading.
        INTEGER N		!The count of columns to be spanned.
        CHARACTER*(*) TEXT	!A brief description to place there.
         CALL HTML3("
',"")	!Start the specification.
         CALL HTML3("",TEXT(1:LSTNB(TEXT)),"
")	!This text, possibly verbose.
       END SUBROUTINE HTMLTHEAD		!Thus, all contained on one line.

       SUBROUTINE HTMLTBODYSTART	!Start on the table body.
         CALL HTML('
 ')		!And I don't think much of the "comment" formalism, either.
         INDEEP = INDEEP + 1	!Anyway, we're ready with the alignment.
       END SUBROUTINE HTMLTBODYSTART	!Others will provide the body.
       SUBROUTINE HTMLTBODYSTOP	!And, they've had enough.
         INDEEP = INDEEP - 1		!So, up out of the hole.
         CALL HTML("
")		!Take a breath.
       END SUBROUTINE HTMLTBODYSTOP	!And wander off.
       SUBROUTINE HTMLTROWTEXT(TEXT,N)	!Roll a row of column headings.
        CHARACTER*(*) TEXT(:)	!The headings.
        INTEGER N		!Their number.
        INTEGER I,L		!Assistants.
         CALL HTML3("
","","")	!Start a row of headings-to-come, and don't end the line.
         DO I = 1,N			!Step through the headings.
           L = LSTNB(TEXT(I))		!Trailing spaces are to be ignored.
           IF (L.LE.0) THEN		!Thus discovering blank texts.
             CALL HTML3(""," 	","")	!This prevents the cell being collapsed.
            ELSE				!But for those with text,
             CALL HTML3("",""//TEXT(I)(1:L)//"	","")	!Roll it.
           END IF			!So much for that text.
         END DO				!On to the next.
         CALL HTML3("","","
")	!Finish the row, and thus the line.
       END SUBROUTINE HTMLTROWTEXT	!So much for texts.
       SUBROUTINE HTMLTROWINTEGER(V,N)	!Now for all integers.
        INTEGER V(:)	!The integers.
        INTEGER N	!Their number.
        INTEGER I	!A stepper.
         CALL HTML3('
',"","")	!Start a row of entries.
         DO I = 1,N			!Work through the row's values.
           CALL HTML3("",""//I8FMT(V(I))//"	","")	!One by one.
         END DO				!On to the next.
         CALL HTML3("","","
")	!Finish the row, and thus the line.
       END SUBROUTINE HTMLTROWINTEGER	!All the same type is not troublesome.
      END MODULE HTMLSTUFF	!Enough already.

      PROGRAM MAKETABLE
      USE PARAMETERS
      USE ASSISTANCE
      USE HTMLSTUFF
      INTEGER KBD,MSG
      INTEGER NCOLS		!The usage of V must conform to this!
      PARAMETER (NCOLS = 4)	!Specified number of columns.
      CHARACTER*3 COLNAME(NCOLS)	!And they have names.
      PARAMETER (COLNAME = (/"","X","Y","Z"/))	!As specified.
      INTEGER V(NCOLS)		!A scratchpad for a line's worth.
      COMMON KBD,MSG		!I/O units.
      KBD = 5			!Keyboard.
      MSG = 6			!Screen.
      CALL GETLOG(USERCODE)		!Who has poked me into life?
      LUSERCODE = LSTNB(USERCODE)	!Ah, text gnashing.

      CALL HTMLSTART(MSG,"Powers","Table of integer powers")		!Output to the screen will do.
       CALL HTMLTSTART(1,"Successive powers of successive integers")	!Start the table.
        CALL HTMLTHEADSTART						!The table heading.
         CALL HTMLTHEAD(NCOLS,"Successive powers")			!A full-width heading.
         CALL HTMLTROWTEXT(COLNAME,NCOLS)				!Headings for each column.
        CALL HTMLTHEADSTOP						!So much for the heading.
        CALL HTMLTBODYSTART						!Now for the content.
        DO I = 1,10		!This should be enough.
          V(1) = I		!The unheaded row number.
          V(2) = I**2		!Its square.
          V(3) = I**3		!Cube.
          V(4) = I**4		!Fourth power.
          CALL HTMLTROWINTEGER(V,NCOLS)					!Show a row's worth..
        END DO			!On to the next line.
        CALL HTMLTBODYSTOP						!No more content.
       CALL HTMLTSTOP							!End the table.
      CALL HTMLSTOP
      END


@echo off
setlocal enabledelayedexpansion

	::Main
call :countString "the three truths","th"
call :countString "ababababab","abab"
pause>nul
exit /b
	::/Main

	::Procedure
:countString
	set input=%~1
	set cnt=0

	:count_loop
	set trimmed=!input:*%~2=!
	if "!trimmed!"=="!input!" (echo.!cnt!&goto :EOF)
	set input=!trimmed!
	set /a cnt+=1
	goto count_loop


      tst$ = "the three truths"
      sub$ = "th"
      PRINT ; FNcountSubstring(tst$, sub$) " """ sub$ """ in """ tst$ """"
      tst$ = "ababababab"
      sub$ = "abab"
      PRINT ; FNcountSubstring(tst$, sub$) " """ sub$ """ in """ tst$ """"
      END

      DEF FNcountSubstring(A$, B$)
      LOCAL I%, N%
      I% = 1 : N% = 0
      REPEAT
        I% = INSTR(A$, B$, I%)
        IF I% THEN N% += 1 : I% += LEN(B$)
      UNTIL I% = 0
      = N%


get "libhdr"

let countsubstr(str, match) = valof
$(  let i, count = 1, 0
    while i <= str%0 do
        test valof
        $(  for j = 1 to match%0
                unless match%j = str%(i+j-1)
                    resultis false
            resultis true
        $)
        then
        $(  count := count + 1
            i := i + match%0
        $)
        else
            i := i + 1
    resultis count
$)

let show(str, match) be
    writef("*"%S*" in *"%S*": %N*N",
        match, str, countsubstr(str, match))

let start() be
$(  show("the three truths", "th")
    show("ababababab", "abab")
    show("cat", "dog")
$)


changes = (amount, coins) ->
    ways = [1].concat [0] * amount
    for coin of coins
        for j from coin to amount
            ways[j] += ways[j - coin]
    ways[amount]

console.log changes 100, [1 5 10 25]


5 m=100:rem money = $1.00 or 100 pennies.
10 print chr$(147);chr$(14);"This program will calculate the number"
11 print "of combinations of 'change' that can be"
12 print "given for a $1 bill."
13 print:print "The coin values are:"
14 print "0.01 = Penny":print "0.05 = Nickle"
15 print "0.10 = Dime":print "0.25 = Quarter"
16 print
20 print "Would you like to see each combination?"
25 get k$:yn=(k$="y"):if k$="" then 25
100 p=m:ti$="000000"
130 q=int(m/25)
140 count=0:ps=1
147 if yn then print "Count  P    N    D    Q"
150 for qc=0 to q:d=int((m-qc*25)/10)
160 for dc=0 to d:n=int((m-dc*10)/5)
170 for nc=0 to n:p=m-nc*5
180 for pc=0 to p step 5
190 s=pc+nc*5+dc*10+qc*25
200 if s=m then count=count+1:if yn then gosub 1000
210 next:next:next:next
245 en$=ti$
250 print:print count;"different combinations found in"
260 print tab(len(str$(count))+1);
265 print left$(en$,2);":";mid$(en$,3,2);":";right$(en$,2);"."
270 end
1000 print count;tab(6);pc;tab(11);nc;tab(16);dc;tab(21);qc:return


Dim As Integer ncols = 3, nrows = 4
Dim As Integer col, row

Print "<!DOCTYPE html>" & Chr(10) & ""
Print "" & Chr(10) & ""
Print "
"

For row = 0 To nrows
    If row = 0 Then
        Print "
	" ;
    Else
        Print "
" & row & "	" ;
    End If
    For col = 1 To ncols
        If row = 0 Then
            Print "" & Chr(87 + col) & "	" ;
        Else
            Print "" & Rnd(9999) & "	" ;
        End If
    Next col
    Print "
"
Next row

Print "
"
Print "" & Chr(10) & ""
Sleep


  ( count-substring
  =   n S s p
    .     0:?n:?p
        & !arg:(?S.?s)
        & @( !S
           :   ?
               ( [!p ? !s [?p ?
               & !n+1:?n
               & ~
               )
           )
      | !n
  )
& out$(count-substring$("the three truths".th))
& out$(count-substring$(ababababab.abab))
& ;


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

int match(const char *s, const char *p, int overlap)
{
        int c = 0, l = strlen(p);

        while (*s != '\0') {
                if (strncmp(s++, p, l)) continue;
                if (!overlap) s += l - 1;
                c++;
        }
        return c;
}

int main()
{
        printf("%d\n", match("the three truths", "th", 0));
        printf("overlap:%d\n", match("abababababa", "aba", 1));
        printf("not:    %d\n", match("abababababa", "aba", 0));
        return 0;
}


using System;

class SubStringTestClass
{
   public static int CountSubStrings(this string testString, string testSubstring)
   {
        int count = 0;

        if (testString.Contains(testSubstring))
        {
            for (int i = 0; i < testString.Length; i++)
            {
                if (testString.Substring(i).Length >= testSubstring.Length)
                {
                    bool equals = testString.Substring(i, testSubstring.Length).Equals(testSubstring);
                    if (equals)
                    {
                        count++;
                        i += testSubstring.Length - 1;  // Fix: Don't count overlapping matches
                    }
                }
            }
        }
        return count;
   }
}


(defun count-change (amount coins
                    &optional
                    (length (1- (length coins)))
                    (cache  (make-array (list (1+ amount) (length coins))
                                        :initial-element nil)))
  (cond ((< length 0) 0)
        ((< amount 0) 0)
        ((= amount 0) 1)
        (t (or (aref cache amount length)
               (setf (aref cache amount length)
                     (+ (count-change (- amount (first coins)) coins length cache)
                        (count-change amount (rest coins) (1- length) cache)))))))

; (compile 'count-change) ; for CLISP

(print (count-change 100 '(25 10 5 1)))		   ; = 242
(print (count-change 100000 '(100 50 25 10 5 1)))  ; = 13398445413854501
(terpri)


import std.stdio, std.bigint;

auto changes(int amount, int[] coins) {
    auto ways = new BigInt[amount + 1];
    ways[0] = 1;
    foreach (coin; coins)
        foreach (j; coin .. amount + 1)
            ways[j] += ways[j - coin];
    return ways[$ - 1];
}

void main() {
    changes(   1_00, [25, 10, 5, 1]).writeln;
    changes(1000_00, [100, 50, 25, 10, 5, 1]).writeln;
}


package main

import (
    "fmt"
    "html/template"
    "os"
)

type row struct {
    X, Y, Z int
}

var tmpl = `

	X	Y	Z

{{range $ix, $row := .}}
{{$ix}}
        {{$row.X}}
        {{$row.Y}}
        {{$row.Z}}

{{end}}

`

func main() {
    // create template
    ct := template.Must(template.New("").Parse(tmpl))

    // make up data
    data := make([]row, 4)
    for r := range data {
        data[r] = row{r*3, r*3+1, r*3+2}
    }

    // apply template to data
    if err := ct.Execute(os.Stdout, data); err != nil {
        fmt.Println(err)
    }
}


#include <iostream>
#include <string>

// returns count of non-overlapping occurrences of 'sub' in 'str'
int countSubstring(const std::string& str, const std::string& sub)
{
    if (sub.length() == 0) return 0;
    int count = 0;
    for (size_t offset = str.find(sub); offset != std::string::npos;
	 offset = str.find(sub, offset + sub.length()))
    {
        ++count;
    }
    return count;
}

int main()
{
    std::cout << countSubstring("the three truths", "th")    << '\n';
    std::cout << countSubstring("ababababab", "abab")        << '\n';
    std::cout << countSubstring("abaabba*bbaba*bbab", "a*b") << '\n';

    return 0;
}


(defn re-quote
  "Produces a string that can be used to create a Pattern
   that would match the string text as if it were a literal pattern.
   Metacharacters or escape sequences in text will be given no special
   meaning"
  [text]
  (java.util.regex.Pattern/quote text))

(defn count-substring [txt sub]
  (count (re-seq (re-pattern (re-quote sub)) txt)))


var cache = new Map();

main() {
    var stopwatch = new Stopwatch()..start();

    // use the brute-force recursion for the small problem
    int amount = 100;
    list coinTypes = [25,10,5,1];
    print (coins(amount,coinTypes).toString() + " ways for $amount using $coinTypes coins.");

    // use the cache version for the big problem
    amount = 100000;
    coinTypes = [100,50,25,10,5,1];
    print (cachedCoins(amount,coinTypes).toString() + " ways for $amount using $coinTypes coins.");

    stopwatch.stop();
    print ("... completed in " + (stopwatch.elapsedMilliseconds/1000).toString() + " seconds");
}

coins(int amount, list coinTypes) {
    int count = 0;

    if(coinTypes.length == 1) return (1);   // just pennies available, so only one way to make change

    for(int i=0; i<=(amount/coinTypes[0]).toInt(); i++){                // brute force recursion
      count += coins(amount-(i*coinTypes[0]),coinTypes.sublist(1));     // sublist(1) is like lisp's '(rest ...)'
    }

    // uncomment if you want to see intermediate steps
    //print("there are " + count.toString() +" ways to count change for ${amount.toString()} using ${coinTypes} coins.");
    return(count);
  }

  cachedCoins(int amount, list coinTypes) {
      int count = 0;

      // this is more efficient, looks at last two coins.  but not fast enough for the optional exercise.
      if(coinTypes.length == 2) return ((amount/coinTypes[0]).toInt() + 1);

      var key = "$amount.$coinTypes";         // lookes like "100.[25,10,5,1]"
      var cacheValue = cache[key];            // check whether we have seen this before

      if(cacheValue != null) return(cacheValue);

      count = 0;
      // same recursion as simple method, but caches all subqueries too
      for(int i=0; i<=(amount/coinTypes[0]).toInt(); i++){
        count += cachedCoins(amount-(i*coinTypes[0]),coinTypes.sublist(1));     // sublist(1) is like lisp's '(rest ...)'
      }

      cache[key] = count;                     // add this to the cache
      return(count);
    }


program Count_the_coins;

{$APPTYPE CONSOLE}

function Count(c: array of Integer; m, n: Integer): Integer;
var
  table: array of Integer;
  i, j: Integer;
begin
  SetLength(table, n + 1);
  table[0] := 1;
  for i := 0 to m - 1 do
    for j := c[i] to n do
      table[j] := table[j] + table[j - c[i]];
  Exit(table[n]);
end;

var
  c: array of Integer;
  m, n: Integer;

begin
  c := [1, 5, 10, 25];

  m := Length(c);
  n := 100;
  Writeln(Count(c, m, n));  //242
  Readln;
end.


import groovy.xml.MarkupBuilder

def createTable(columns, rowCount) {
    def writer = new StringWriter()
    new MarkupBuilder(writer).table(style: 'border:1px solid;text-align:center;') {
        tr {
            th()
            columns.each { title -> th(title)}
        }
        (1..rowCount).each { row ->
            tr {
                td(row)
                columns.each { td((Math.random() * 9999) as int ) }
            }
        }
    }
    writer.toString()
}

println createTable(['X', 'Y', 'Z'], 3)


       IDENTIFICATION DIVISION.
       PROGRAM-ID. testing.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  occurrences             PIC 99.

       PROCEDURE DIVISION.
           INSPECT "the three truths" TALLYING occurrences FOR ALL "th"
           DISPLAY occurrences

           MOVE 0 TO occurrences
           INSPECT "ababababab" TALLYING occurrences FOR ALL "abab"
           DISPLAY occurrences

           MOVE 0 TO occurrences
           INSPECT "abaabba*bbaba*bbab" TALLYING occurrences
               FOR ALL "a*b"
           DISPLAY occurrences

           GOBACK
           .


countSubstring = (str, substr) ->
  n = 0
  i = 0
  while (pos = str.indexOf(substr, i)) != -1
    n += 1
    i = pos + substr.length
  n

console.log countSubstring "the three truths", "th"
console.log countSubstring "ababababab", "abab"


(defun count-sub (str pat)
  (loop with z = 0 with s = 0 while s do
	(when (setf s (search pat str :start2 s))
	  (incf z) (incf s (length pat)))
	finally (return z)))

(count-sub "ababa" "ab")  ; 2
(count-sub "ababa" "aba") ; 1


func countCoins(coins, n) {
    var xs = Array.Empty(n + 1, 0)
    xs[0] = 1
    for c in coins {
        var cj = c
        while cj <= n {
            xs[cj] += xs[cj - c]
            cj += 1
        }
    }
    return xs[n]
}

var coins = [1, 5, 10, 25]
print(countCoins(coins, 100))


import Data.List (unfoldr)
import Control.Monad (forM_)

import qualified Text.Blaze.Html5 as B
import Text.Blaze.Html.Renderer.Pretty (renderHtml)

import System.Random (RandomGen, getStdGen, randomRs, split)

makeTable
  :: RandomGen g
  => [String] -> Int -> g -> B.Html
makeTable headings nRows gen =
  B.table $
  do B.thead $ B.tr $ forM_ (B.toHtml <$> headings) B.th
     B.tbody $
       forM_
         (zip [1 .. nRows] $ unfoldr (Just . split) gen)
         (\(x, g) ->
             B.tr $
             forM_
               (take (length headings) (x : randomRs (1000, 9999) g))
               (B.td . B.toHtml))

main :: IO ()
main = do
  g <- getStdGen
  putStrLn $ renderHtml $ makeTable ["", "X", "Y", "Z"] 3 g


include "cowgol.coh";

sub countSubstring(str: [uint8], match: [uint8]): (count: uint8) is
    count := 0;

    while [str] != 0 loop
        var find := match;
        var loc := str;
        while [loc] == [find] loop
            find := @next find;
            loc := @next loc;
        end loop;
        if [find] == 0 then
            str := loc;
            count := count + 1;
        else
            str := @next str;
        end if;
    end loop;
end sub;

print_i8(countSubstring("the three truths","th")); # should print 3
print_nl();
print_i8(countSubstring("ababababab","abab")); # should print 2
print_nl();
print_i8(countSubstring("cat","dog")); # should print 0
print_nl();


void main() {
    import std.stdio, std.algorithm;

    "the three truths".count("th").writeln;
    "ababababab".count("abab").writeln;
}


program OccurrencesOfASubstring;

{$APPTYPE CONSOLE}

uses StrUtils;

function CountSubstring(const aString, aSubstring: string): Integer;
var
  lPosition: Integer;
begin
  Result := 0;
  lPosition := PosEx(aSubstring, aString);
  while lPosition <> 0 do
  begin
    Inc(Result);
    lPosition := PosEx(aSubstring, aString, lPosition + Length(aSubstring));
  end;
end;

begin
  Writeln(CountSubstring('the three truths', 'th'));
  Writeln(CountSubstring('ababababab', 'abab'));
end.


(lib 'compile) ;; for (compile)
(lib 'bigint)  ;; integer results > 32 bits
(lib 'hash)    ;; hash table

;; h-table
(define Hcoins (make-hash))

;; the function to memoize
(define (sumways cents coins)
	(+ (ways cents (cdr coins)) (ways (- cents (car coins)) coins)))

;; accelerator : ways (cents, coins) = ways ((cents  - cents % 5) , coins)
(define (ways cents coins)
  (cond ((null? coins) 0)
        ((negative? cents) 0)
        ((zero? cents) 1)
        ((eq? coins c-1) 1) ;; if coins = (1) --> 1
        (else (hash-ref! Hcoins (list (- cents (modulo cents 5)) coins) sumways))))

(compile 'ways) ;; speed-up things


["Count the coins" problem for Rosetta Code.]
[EDSAC program, Initial Orders 2.]

            T51K  P56F [G parameter: print subroutine]
            T54K  P94F [C parameter: coins subroutine]
            T47K P200F [M parameter: main routine]

[========================== M parameter ===============================]
            E25K TM GK
[Parameter block for US coins. For convenience, all numbers
 are in the address field, e.g. 25 cents is P25F not P12D.]
      [0]   UF SF   [2-letter ID]
            P100F   [amount to be made with coins]
            P4F     [number of coin values]
            P1F P5F P10F P25F [list of coin values]
      [8]   [email protected]      [address of US parameter block]
[Parameter block for UK coins]
      [9]   UF KF
            P100F
            P7F
            P1F P2F P5F P10F P20F P50F P100F
     [20]   [email protected]     [address of UK parameter block]
[Enter with acc = 0]
     [21]   [email protected]     [load address of parameter block for US coins]
            T4F     [pass to subroutine in 4F]
     [23]   [email protected]    [call subroutine to calculate and print result]
            G13C
            [email protected]    [same for UK coins]
            T4F
     [27]   [email protected]
            G13C
            ZF      [halt program]

[========================== C parameter ===============================]
[Subroutine to calculate and print the result for the given amount and
 set of coins. Address of parameter block (see above) is passed in 4F.]

            E25K TC GK
      [0]   SF      [S order for start of coin list]
      [1]   A1023F  [start table at top of memory and work downwarda]
      [2]   PF      [S order for exclusive end of coin list]
      [3]   P2F     [to increment address by 2]
      [4]   OF      [(1) add to address to make O order
                     (2) add to A order to make T order with same address]
      [5]   SF      [add to address to make S order]
      [6]   K4095F  [add to S order to make A order, dec address]
      [7]   K2048F  [set teleprinter to letters]
      [8]   #F      [set teleprinter to figures]
      [9]   !F      [space character]
     [10]   @F      [carriage return]
     [11]   &F      [line feed]
     [12]   K4096F  [teleprinter null]
[Subroutine entry. In this EDSAC program, the table used
 in the algorithm grows downward from the top of memory.]
     [13]   A3F     [plant jump back to caller, as usual]
            [email protected]
            A4F     [load address of parameter block]
            [email protected]     [skip 2-letter ID]
            [email protected]     [make S order for amount]
            [email protected]    [plant in code]
            [email protected]     [make S order for first coin value]
            [email protected]      [store it]
            [email protected]     [make A order for number of coins]
            [email protected]    [plant in code]
            A2F     [load 1 (in address field)]
     [24]   T1023F  [store at start of table]
[Set all other table entries to 0]
            [email protected]
            [email protected]
     [27]   SF      [acc := -amount]
     [28]   TF      [set negative count in 0F]
            [email protected]    [decrement address in manufactured order]
            S2F
            [email protected]
     [32]   TF      [manufactured: set table entry to 0]
            AF      [update negative count]
            A2F
            [email protected]    [loop until count = 0]
[Here acc = 0. Manufactured order (4 lines up) is T order
 for inclusive end of table; this is used again below.]
            [email protected]      [load S order for first coin value]
            [email protected]    [plant in code]
     [38]   AF      [make S order for exclusive end of coin list]
            [email protected]     [store for comparison]
[Start of outer loop, round coin values]
     [40]   TF      [clear acc]
            [email protected]     [load A order for start of table]
            [email protected]    [plant in code]
     [43]   SF      [manufactured order: subtract coin value]
[Start of inner loop, round table entries]
     [44]   [email protected]    [plant A order in code]
            [email protected]     [make T order for same address]
            [email protected]    [plant in code]
[The next 3 orders are manufactured at run time]
     [47]   AF      [load table entry]
     [48]   AF      [add earlier table entry]
     [49]   TF      [update table entry]
            [email protected]    [load T order for inclusive end of table]
            [email protected]    [reached end of table?]
            [email protected]    [if yes, jump out of inner loop]
            TF      [clear acc]
            [email protected]    [update the 3 manufactured instructions]
            S2F
            [email protected]
            [email protected]
            S2F
            [email protected]    [always loops back, since A < 0]
[End of inner loop]
     [60]   TF      [clear acc]
            [email protected]    [update S order for coin value]
            A2F
            [email protected]
            [email protected]     [reached exclusive end?]
            [email protected]    [if no, loop back]
[End of outer loop]
[Here with acc = 0 and result at end of table]
[Value is in address field, so shift 1 right for printing]
            [email protected]    [load T order for end of tab;e]
            [email protected]     [make A order for same address]
            [email protected]    [plant in code]
            A4F     [load address of parameter block]
            [email protected]     [make O order for 1st char of ID]
            [email protected]    [plant in code]
            A2F     [same for 2nd char]
            [email protected]
            [email protected]     [set teleprinter to letters]
     [75]   OF      [print ID, followed by space]
     [76]   OF [email protected]
            [email protected]     [set teleprinter to figures]
     [79]   AF      [maunfactured order to load result]
            RD      [shift 1 right for printing]
            TF      [pass to print routine]
            [email protected]     [replace leading 0's with space]
            T1F
     [84]   [email protected]    [call print routine]
            GG
            [email protected] [email protected]  [print CR, LF]
            [email protected]    [print null to flush teleprinter buffer]
     [89]   ZF      [replaced by jump back to caller]

[============================= G parameter ===============================]
            E25K TG GK
[Subroutine to print non-negative 17-bit integer. Always prints 5 chars.
 Caller specifies character for leading 0 (typically 0, space or null).
 Parameters: 0F = integer to be printed (not preserved)
             1F = character for leading zero (preserved)
 Workspace: 4F..7F, 38 locations]
            [email protected]@T6FT4#[email protected]#[email protected]@O7FA2F
            T6FT5FV4#FYFL8FT4#[email protected]@ZFP4FZ219DTF

[========================== M parameter again ===============================]
            E25K TM GK
            E21Z    [define entry point]
            PF      [enter with acc = 0]


procedure main()
printf("
\n
	X	Y	Z	")
every r := 1 to 4 do {
   printf("
\n
%d	",r)
   every 1 to 3 do printf("%d	",?9999)  # random 4 digit numbers per cell
   }
printf("
\n
\n")
end

link printf


func countSubstring(str, val) {
    var idx = 0
    var count = 0
    while true {
        idx = str.IndexOf(val, idx)
        if idx == -1 {
            break
        }
        idx += val.Length()
        count += 1
    }
    return count
}

print(countSubstring("the three truths", "th"))
print(countSubstring("ababababab", "abab"))


!. count "the three truths" "th"
!. count "ababababab" "abab"


;; from Racket
(define count-substring
   (compose length regexp-match*))

(count-substring "aab" "graabaabdfaabgh") ;; substring
    → 3
(count-substring "/ .e/" "Longtemps je me suis couché de bonne heure") ;; regexp
    → 4


program CountStrings

    function main()
        SysLib.writeStdout("Remove and Count:");
        SysLib.writeStdout(countSubstring("th", "the three truths"));
        SysLib.writeStdout(countSubstring("abab", "ababababab"));
        SysLib.writeStdout(countSubstring("a*b", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstring("a", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstring(" ", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstring("", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstring("a", ""));
        SysLib.writeStdout(countSubstring("", ""));

        SysLib.writeStdout("Manual Loop:");
        SysLib.writeStdout(countSubstringWithLoop("th", "the three truths"));
        SysLib.writeStdout(countSubstringWithLoop("abab", "ababababab"));
        SysLib.writeStdout(countSubstringWithLoop("a*b", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstringWithLoop("a", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstringWithLoop(" ", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstringWithLoop("", "abaabba*bbaba*bbab"));
        SysLib.writeStdout(countSubstringWithLoop("a", ""));
        SysLib.writeStdout(countSubstringWithLoop("", ""));
    end

    function countSubstring(substr string in, str string in) returns(int)
        if(str.length() > 0 and substr.length() > 0)
	    return (str.length() - str.replaceStr(subStr, "").length()) / subStr.length();
	else
	    return 0;
	end
    end

    function countSubstringWithLoop(substr string in, str string in) returns(int)
        count int = 0;
        loc, index int = 1;
        strlen int = str.length();
        substrlen int = substr.length();

        if(strlen > 0 and substrlen > 0)
            while(loc != 0 and index <= strlen)
                loc = str.indexOf(substr, index);
                if(loc > 0)
                    count += 1;
                    index = loc + substrlen;
                end
            end
        end
        return count;
    end

end


defmodule Coins do
  def find(coins,lim) do
    vals = Map.new(0..lim,&{&1,0}) |> Map.put(0,1)
    count(coins,lim,vals)
      |> Map.values
      |> Enum.max
      |> IO.inspect
  end

  defp count([],_,vals), do: vals
  defp count([coin|coins],lim,vals) do
    count(coins,lim,ways(coin,coin,lim,vals))
  end

  defp ways(num,_coin,lim,vals) when num > lim, do: vals
  defp ways(num, coin,lim,vals) do
    ways(num+1,coin,lim,ad(coin,num,vals))
  end

  defp ad(a,b,c), do: Map.put(c,b,c[b]+c[b-a])
end

Coins.find([1,5,10,25],100)
Coins.find([1,5,10,25,50,100],100_000)


-module(coins).
-compile(export_all).

count(Amount, Coins) ->
    {N,_C} = count(Amount, Coins, dict:new()),
    N.

count(0,_,Cache) ->
    {1,Cache};
count(N,_,Cache) when N < 0 ->
    {0,Cache};
count(_N,[],Cache) ->
    {0,Cache};
count(N,[C|Cs]=Coins,Cache) ->
    case dict:is_key({N,length(Coins)},Cache) of
        true ->
            {dict:fetch({N,length(Coins)},Cache), Cache};
        false ->
            {N1,C1} = count(N-C,Coins,Cache),
            {N2,C2} = count(N,Cs,C1),
            {N1+N2,dict:store({N,length(Coins)},N1+N2,C2)}
    end.

print(Amount, Coins) ->
    io:format("~b ways to make change for ~b cents with ~p coins~n",[count(Amount,Coins),Amount,Coins]).

test() ->
    A1 = 100, C1 = [25,10,5,1],
    print(A1,C1),
    A2 = 100000, C2 = [100, 50, 25, 10, 5, 1],
    print(A2,C2).


public class HTML {

	public static String array2HTML(Object[][] array){
		StringBuilder html = new StringBuilder(
				"
");
		for(Object elem:array[0]){
			html.append("" + elem.toString() + "	");
		}
		for(int i = 1; i < array.length; i++){
			Object[] row = array[i];
			html.append("
");
			for(Object elem:row){
				html.append("" + elem.toString() + "	");
			}
			html.append("
");
		}
		html.append("
");
		return html.toString();
	}

	public static void main(String[] args){
		Object[][] ints = {{"","X","Y","Z"},{1,1,2,3},{2,4,5,6},{3,7,8,9},{4,10,11,12}};
		System.out.println(array2HTML(ints));
	}
}


class
	APPLICATION
inherit
	ARGUMENTS
create
	make
feature {NONE} -- Initialization
	make
			-- Run application.
		do
			occurance := 0
			from
				index := 1
			until
				index > text.count
			loop
				temp := text.fuzzy_index(search_for, index, 0)
				if
					temp /= 0
				then
					index := temp + search_for.count
					occurance := occurance + 1
				else
					index := text.count + 1
				end
			end
			print(occurance)
		end

	index:INTEGER
	temp:INTEGER
	occurance:INTEGER
	text:STRING = "ababababab"
	search_for:STRING = "abab"
end


countSubstring = fn(_, "") -> 0
                   (str, sub) -> length(String.split(str, sub)) - 1 end

data = [ {"the three truths", "th"},
         {"ababababab", "abab"},
         {"abaabba*bbaba*bbab", "a*b"},
         {"abaabba*bbaba*bbab", "a"},
         {"abaabba*bbaba*bbab", " "},
         {"abaabba*bbaba*bbab", ""},
         {"", "a"},
         {"", ""} ]

Enum.each(data, fn{str, sub} ->
  IO.puts countSubstring.(str, sub)
end)


%% Count non-overlapping substrings in Erlang for the rosetta code wiki.
%% Implemented by J.W. Luiten

-module(substrings).
-export([main/2]).

%% String and Sub exhausted, count a match and present result
match([], [], _OrigSub, Acc) ->
  Acc+1;

%% String exhausted, present result
match([], _Sub, _OrigSub, Acc) ->
  Acc;

%% Sub exhausted, count a match
match(String, [], Sub, Acc) ->
  match(String, Sub, Sub, Acc+1);

%% First character matches, advance
match([X|MainTail], [X|SubTail], Sub, Acc) ->
  match(MainTail, SubTail, Sub, Acc);

%% First characters do not match. Keep scanning for sub in remainder of string
match([_X|MainTail], [_Y|_SubTail], Sub, Acc)->
  match(MainTail, Sub, Sub, Acc).

main(String, Sub) ->
   match(String, Sub, Sub, 0).


let changes amount coins =
    let ways = Array.zeroCreate (amount + 1)
    ways.[0] <- 1L
    List.iter (fun coin ->
        for j = coin to amount do ways.[j] <- ways.[j] + ways.[j - coin]
    ) coins
    ways.[amount]

[<EntryPoint>]
let main argv =
    printfn "%d" (changes    100 [25; 10; 5; 1]);
    printfn "%d" (changes 100000 [100; 50; 25; 10; 5; 1]);
    0


USING: combinators kernel locals math math.ranges sequences sets sorting ;
IN: rosetta.coins

<PRIVATE
! recursive-count uses memoization and local variables.
! coins must be a sequence.
MEMO:: recursive-count ( cents coins -- ways )
    coins length :> types
    {
        ! End condition: 1 way to make 0 cents.
        { [ cents zero? ] [ 1 ] }
        ! End condition: 0 ways to make money without any coins.
        { [ types zero? ] [ 0 ] }
        ! Optimization: At most 1 way to use 1 type of coin.
        { [ types 1 number= ] [
            cents coins first mod zero? [ 1 ] [ 0 ] if
        ] }
        ! Find all ways to use the first type of coin.
        [
            ! f = first type, r = other types of coins.
            coins unclip-slice :> f :> r
            ! Loop for 0, f, 2*f, 3*f, ..., cents.
            0 cents f <range> [
                ! Recursively count how many ways to make remaining cents
                ! with other types of coins.
                cents swap - r recursive-count
            ] [ + ] map-reduce          ! Sum the counts.
        ]
    } cond ;
PRIVATE>

! How many ways can we make the given amount of cents
! with the given set of coins?
: make-change ( cents coins -- ways )
    members [ ] inv-sort-with   ! Sort coins in descending order.
    recursive-count ;


function countSubstring(sequence s, sequence sub)
    integer from,count
    count = 0
    from = 1
    while 1 do
        from = match_from(sub,s,from)
        if not from then
            exit
        end if
        from += length(sub)
        count += 1
    end while
    return count
end function

? countSubstring("the three truths","th")
? countSubstring("ababababab","abab")


open System

let countSubstring (where :string) (what : string) =
    match what with
    | "" -> 0 // just a definition; infinity is not an int
    | _ -> (where.Length - where.Replace(what, @"").Length) / what.Length

[<EntryPoint>]
let main argv =
    let show where what =
        printfn @"countSubstring(""%s"", ""%s"") = %d" where what (countSubstring where what)
    show "the three truths" "th"
    show "ababababab" "abab"
    show "abc" ""
    0


USING: math sequences splitting ;
: occurences ( seq subseq -- n ) split-subseq length 1 - ;


\ counting change (SICP section 1.2.2)

: table create does> swap cells + @ ;
table coin-value 0 , 1 , 5 , 10 , 25 , 50 ,

: count-change ( total coin -- n )
  over 0= if
    2drop 1
  else over 0< over 0= or if
    2drop 0
  else
    2dup coin-value - over recurse
    >r 1- recurse r> +
  then then ;

100 5 count-change .


' version 09-10-2016
' compile with: fbc -s console

Function count(S() As UInteger, n As UInteger) As ULongInt

  Dim As Integer i, j
  ' calculate m from array S()
  Dim As UInteger m = UBound(S) - LBound(S) +1
  Dim As ULongInt x, y

  '' We need n+1 rows as the table is consturcted in bottom up manner using
  '' the base case 0 value case (n = 0)
  Dim As ULongInt table(n +1, m)

  '' Fill the enteries for 0 value case (n = 0)
  For i = 0 To m -1
    table(0, i) = 1
  Next

  '' Fill rest of the table enteries in bottom up manner
  For i = 1 To n
    For j = 0 To m -1
      '' Count of solutions including S[j]
      x = IIf (i >= S(j), table(i - S(j), j), 0)
      '' Count of solutions excluding S[j]
      y = IIf (j >= 1, table(i, j -1), 0)
      ''total count
      table(i, j) = x + y
    Next
  Next

  Return table(n, m -1)

End Function

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

Dim As UInteger n
Dim As UInteger value()

ReDim value(3)
value(0) = 1 : value(1) = 5 : value(2) = 10 : value(3) = 25

n = 100
print
Print " There are "; count(value(), n); " ways to make change for $";n/100;" with 4 coins"
Print

n = 100000
Print " There are "; count(value(), n); " ways to make change for $";n/100;" with 4 coins"
Print

ReDim value(5)
value(0) =  1 : value(1) =  5 : value(2) =  10
value(3) = 25 : value(4) = 50 : value(5) = 100

n = 100000
Print " There are "; count(value(), n); " ways to make change for $";n/100;" with 6 coins"
Print

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


def html_row:
  "
",
  "  \(.[] | "\(.)	")",
  "
";

def html_header:
  "
",
  "  \(html_row)",
  "
";

 def html_table(header):
  "
",
  "  \(header | html_header)",
  "
",
  "    \(.[] | html_row)",
  "  </tbody",
  "
";

# Prepend the sequence number
def html_table_with_sequence(header):
  length as $length
  | . as $in
  | [range(0;length) | [.+1] + $in[.]] |  html_table(header);


function tag(x::Pair, attr::Pair...)
    t, b = x
    attrstr = join(" $n=\"$p\"" for (n, p) in attr)
    return "<$t$attrstr>$b</$t>"
end

colnames = split(",X,Y,Z", ',')

header = join(tag(:th => txt) for txt in colnames) * "\n"
rows   = collect(tag(:tr => join(tag(:td => i, :style => "font-weight: bold;") * join(tag(:td => rand(1000:9999)) for j in 1:3))) for i in 1:6)
body   = "\n" * join(rows, '\n') * "\n"
table  = tag(:table => string('\n', header, body, '\n'), :style => "width: 60%")
println(table)


: str-count ( s1 len s2 len -- n )
  2swap 0 >r
  begin 2over search
  while 2over nip /string
        r> 1+ >r
  repeat 2drop 2drop r> ;

s" the three truths" s" th" str-count .    \ 3
s" ababababab" s" abab" str-count .     \ 2


program Example
  implicit none
  integer :: n

  n = countsubstring("the three truths", "th")
  write(*,*) n
  n = countsubstring("ababababab", "abab")
  write(*,*) n
  n = countsubstring("abaabba*bbaba*bbab", "a*b")
  write(*,*) n

contains

function countsubstring(s1, s2) result(c)
  character(*), intent(in) :: s1, s2
  integer :: c, p, posn

  c = 0
  if(len(s2) == 0) return
  p = 1
  do
    posn = index(s1(p:), s2)
    if(posn == 0) return
    c = c + 1
    p = p + posn + len(s2) - 1
  end do
end function
end program


' FB 1.05.0 Win64

Function countSubstring(s As String, search As String) As Integer
  If s = "" OrElse search = "" Then Return 0
  Dim As Integer count = 0, length = Len(search)
  For i As Integer = 1 To Len(s)
    If Mid(s, i, length) = Search Then
      count += 1
      i += length - 1
    End If
  Next
  Return count
End Function

Print countSubstring("the three truths","th")
Print countSubstring("ababababab","abab")
Print countSubString("zzzzzzzzzzzzzzz", "z")
Print
Print "Press any key to quit"
Sleep


include "NSLog.incl"

void local fn Doit
  long penny, nickel, dime, quarter, count = 0

  NSLogSetTabInterval(30)

  for penny = 0 to 100
    for nickel = 0 to 20
      for dime = 0 to 10
        for quarter = 0 to 4
          if penny + nickel * 5 + dime * 10 + quarter * 25 == 100
            NSLog(@"%ld pennies\t%ld nickels\t%ld dimes\t%ld quarters",penny,nickel,dime,quarter)
            count++
          end if
        next quarter
      next dime
    next nickel
  next penny

  NSLog(@"\n%ld ways to make a dollar",count)
end fn

fn DoIt

HandleEvents


package main

import "fmt"

func main() {
    amount := 100
    fmt.Println("amount, ways to make change:", amount, countChange(amount))
}

func countChange(amount int) int64 {
    return cc(amount, 4)
}

func cc(amount, kindsOfCoins int) int64 {
    switch {
    case amount == 0:
        return 1
    case amount < 0 || kindsOfCoins == 0:
        return 0
    }
    return cc(amount, kindsOfCoins-1) +
        cc(amount - firstDenomination(kindsOfCoins), kindsOfCoins)
}

func firstDenomination(kindsOfCoins int) int {
    switch kindsOfCoins {
    case 1:
        return 1
    case 2:
        return 5
    case 3:
        return 10
    case 4:
        return 25
    }
    panic(kindsOfCoins)
}


// version 1.1.3

import java.util.Random

fun main(args: Array<String>) {
    val r = Random()
    val sb = StringBuilder()
    val i = "   "  // indent
    with (sb) {
        append("\n\n")
        append("\n\n\n")
        append("
\n")
        append("$i
\n")
        append("$i$i
	")
        for (c in 'X'..'Z') append("$c	")
        append("
\n")
        append("$i
\n")
        append("$i
\n")
        val f = "$i$i
%d	%d	%d	%d
\n"
        for (j in 1..4) {
            append(f.format(j, r.nextInt(10000), r.nextInt(10000), r.nextInt(10000)))
        }
        append("$i
\n")
        append("
\n")
        append("\n")
    }
    println(sb.toString())
}


import util.Regex

def countSubstring( str, substr ) = Regex( substr ).findAllMatchIn( str ).length()

println( countSubstring("the three truths", "th") )
println( countSubstring("ababababab", "abab") )


package main
import (
        "fmt"
        "strings"
)

func main() {
        fmt.Println(strings.Count("the three truths", "th")) // says: 3
        fmt.Println(strings.Count("ababababab", "abab"))     // says: 2
}


def ccR
ccR = { BigInteger tot, List<BigInteger> coins ->
    BigInteger n = coins.size()
    switch ([tot:tot, coins:coins]) {
        case { it.tot == 0 } :
            return 1g
        case { it.tot < 0 || coins == [] } :
            return 0g
        default:
            return ccR(tot, coins[1..<n]) +
                ccR(tot - coins[0], coins)
    }
}


count :: (Integral t, Integral a) => t -> [t] -> a
count 0 _ = 1
count _ [] = 0
count x (c:coins) =
  sum
    [ count (x - (n * c)) coins
    | n <- [0 .. (quot x c)] ]

main :: IO ()
main = print (count 100 [1, 5, 10, 25])


{table
 {@ style="background:#ffe; width:50%;"}
 {tr {@ style="text-align:right; font:bold 1.0em arial;"}
     {td } {td X} {td Y} {td Z}}
 {map {lambda {:i}
       {tr {td {b :i}}
           {map {lambda {_}
            {td {@ style="text-align:right; font:italic 1.0em courier;"}
                {floor {* {random} 10000}} }}
      {serie 1 3}}}}
      {serie 1 3}}}


define rand4dig => integer_random(9999, 1)

local(
	output = '
\n
'
)

with el in (' ,X,Y,Z') -> split(',') do {
	#output -> append('' + #el + '	')
}
#output -> append('
\n')

loop(5) => {
	#output -> append('
\n' + loop_count + '	')
	loop(3) => {
		#output -> append('' + rand4dig + '	')
	}
	#output -> append('
\n')
}
#output -> append('
\n')

#output


println (('the three truths' =~ /th/).count)
println (('ababababab' =~ /abab/).count)
println (('abaabba*bbaba*bbab' =~ /a*b/).count)
println (('abaabba*bbaba*bbab' =~ /a\*b/).count)


import Data.Text hiding (length)

-- Return the number of non-overlapping occurrences of sub in str.
countSubStrs str sub = length $ breakOnAll (pack sub) (pack str)

main = do
  print $ countSubStrs "the three truths" "th"
  print $ countSubStrs "ababababab" "abab"


procedure main()
every A := ![ ["the three truths","th"], ["ababababab","abab"] ] do
   write("The string ",image(A[2])," occurs as a non-overlapping substring ",
         countSubstring!A , " times in ",image(A[1]))
end

procedure countSubstring(s1,s2) #: return count of non-overlapping substrings
c := 0
s1 ? while tab(find(s2)) do {
   move(*s2)
   c +:= 1
   }
return c
end


procedure main()

   US_coins       := [1, 5, 10, 25]
   US_allcoins    := [1,5,10,25,50,100]
   EU_coins       := [1, 2, 5, 10, 20, 50, 100, 200]
   CDN_coins      := [1,5,10,25,100,200]
   CDN_allcoins   := [1,5,10,25,50,100,200]

   every trans := ![ [15,US_coins],
                     [100,US_coins],
                     [1000*100,US_allcoins]
                  ] do
      printf("There are %i ways to count change for %i using %s coins.\n",CountCoins!trans,trans[1],ShowList(trans[2]))
end

procedure ShowList(L)            # helper list to string
every (s := "[ ") ||:= !L || " "
return s || "]"
end


100 PROGRAM "Coins.bas"
110 LET MONEY=100
120 LET COUNT=0
125 PRINT "Count  Pennies Nickles Dimes Quaters"
130 FOR QC=0 TO INT(MONEY/25)
150   FOR DC=0 TO INT((MONEY-QC*25)/10)
170     FOR NC=0 TO INT((MONEY-DC*10)/5)
190       FOR PC=0 TO MONEY-NC*5 STEP 5
200         LET S=PC+NC*5+DC*10+QC*25
210         IF S=MONEY THEN
220           LET COUNT=COUNT+1
230           PRINT COUNT,PC,NC,DC,QC
240         END IF
250       NEXT
260     NEXT
270   NEXT
280 NEXT
290 PRINT COUNT;"different combinations found."


nomainwin

    quote$ =chr$( 34)

    html$  =""

    html$ =html$ +"
  	  X 	  Y 	  Z 	"

    for i =1 to 4
        d1$ =str$( i)
        d2$ =str$( int( 10000 *rnd( 1)))
        d3$ =str$( int( 10000 *rnd( 1)))
        d4$ =str$( int( 10000 *rnd( 1)))
        html$ =html$ +"
 "; d1$; " 	 " +d2$ +" 	 " +d3$ +" 	 " +d4$ +"
"
    next i

    html$ =html$ +"
"

    html$ =html$ +""

    open "table.html" for output as #o
        #o html$;
    close #o

    address$ ="table.html"
    run "explorer.exe "; address$

    timer 5000, [on]
    wait
    [on]
    timer 0

    kill "table.html"

    wait

sub quit w$
    close #w$
    end
end sub


require'strings'
countss=: #@] %~ #@[ - [ #@rplc '';~]


public class CountSubstring {
	public static int countSubstring(String subStr, String str){
		return (str.length() - str.replace(subStr, "").length()) / subStr.length();
	}

	public static void main(String[] args){
		System.out.println(countSubstring("th", "the three truths"));
		System.out.println(countSubstring("abab", "ababababab"));
		System.out.println(countSubstring("a*b", "abaabba*bbaba*bbab"));
	}
}


function countSubstring(str, subStr) {
    var matches = str.match(new RegExp(subStr, "g"));
    return matches ? matches.length : 0;
}


merge=: ({:"1 (+/@:({."1),{:@{:)/. ])@;
count=: {[email protected]] <@,. {:@] - [ * [ [email protected]>:@<[email protected]%~ {:@]
init=: (1 ,. ,.)^:(0=#@$)
nsplits=: 0 { [: +/ [: ([email protected]:(count"1) init)/ }[email protected]/:[email protected][email protected],


import java.util.Arrays;
import java.math.BigInteger;

class CountTheCoins {
    private static BigInteger countChanges(int amount, int[] coins){
        final int n = coins.length;
        int cycle = 0;
        for (int c : coins)
            if (c <= amount && c >= cycle)
                cycle = c + 1;
        cycle *= n;
        BigInteger[] table = new BigInteger[cycle];
        Arrays.fill(table, 0, n, BigInteger.ONE);
        Arrays.fill(table, n, cycle, BigInteger.ZERO);

        int pos = n;
        for (int s = 1; s <= amount; s++) {
            for (int i = 0; i < n; i++) {
                if (i == 0 && pos >= cycle)
                    pos = 0;
                if (coins[i] <= s) {
                    final int q = pos - (coins[i] * n);
                    table[pos] = (q >= 0) ? table[q] : table[q + cycle];
                }
                if (i != 0)
                    table[pos] = table[pos].add(table[pos - 1]);
                pos++;
            }
        }

        return table[pos - 1];
    }

    public static void main(String[] args) {
        final int[][] coinsUsEu = {{100, 50, 25, 10, 5, 1},
                                   {200, 100, 50, 20, 10, 5, 2, 1}};

        for (int[] coins : coinsUsEu) {
            System.out.println(countChanges(     100,
                Arrays.copyOfRange(coins, 2, coins.length)));
            System.out.println(countChanges(  100000, coins));
            System.out.println(countChanges( 1000000, coins));
            System.out.println(countChanges(10000000, coins) + "\n");
        }
    }
}


on htmlTable (data)
  str = "
"

  -- table head
  put "

 	" after str
  repeat with cell in data[1]
    put ""&cell&"	" after str
  end repeat
  put "

" after str

  -- table body
  put "
" after str
  cnt = data.count
  repeat with i = 2 to cnt
    put "
"&(i-1)&"	" after str
    repeat with cell in data[i]
      put ""&cell&"	" after str
    end repeat
    put "
" after str
  end repeat
  put "
" after str

  put "
" after str
  return str
end


function htmlTable (data)
    local html = "
\n
\n	\n"
    for _, heading in pairs(data[1]) do
        html = html .. "" .. heading .. "	" .. "\n"
    end
    html = html .. "
\n"
    for row = 2, #data do
        html = html .. "
\n" .. row - 1 .. "	\n"
        for _, field in pairs(data[row]) do
            html = html .. "" .. field .. "	\n"
        end
        html = html .. "
\n"
    end
    return html .. "
"
end

local tableData = {
    {"X", "Y", "Z"},
    {"1", "2", "3"},
    {"4", "5", "6"},
    {"7", "8", "9"}
}

print(htmlTable(tableData))


def countSubstring(sub):
  [match(sub; "g")] | length;


matchall(r::Regex, s::String[, overlap::Bool=false]) -> Vector{String}

   Return a vector of the matching substrings from eachmatch.


  "the three truths" _ss "th"
0 4 13

  #"the three truths" _ss "th"
3

  "ababababab" _ss "abab"
0 4

  #"ababababab" _ss "abab"
2


include ..\Utilitys.tlhy

:count %s !s
    0 >ps
    [ps> 1 + >ps
     $s len nip + snip nip] [$s find dup] while
    drop drop ps>
;

"the three truths" "th" count ?
"ababababab" "abab" count ?

" " input


// version 1.0.6

fun countSubstring(s: String, sub: String): Int = s.split(sub).size - 1

fun main(args: Array<String>) {
    println(countSubstring("the three truths","th"))
    println(countSubstring("ababababab","abab"))
    println(countSubstring("",""))
}


function countcoins(t, o) {
    'use strict';
    var targetsLength = t + 1;
    var operandsLength = o.length;
    t = [1];

    for (var a = 0; a < operandsLength; a++) {
        for (var b = 1; b < targetsLength; b++) {

            // initialise undefined target
            t[b] = t[b] ? t[b] : 0;

            // accumulate target + operand ways
            t[b] += (b < o[a]) ? 0 : t[b - o[a]];
        }
    }

    return t[targetsLength - 1];
}


# How many ways are there to make "target" cents, given a list of coin
# denominations as input.
# The strategy is to record at total[n] the number of ways to make n cents.
def countcoins(target):
  . as $coin
  | reduce range(0; length) as $a
      ( [1];   # there is 1 way to make 0 cents
        reduce range(1; target + 1) as $b
          (.;                                      # total[]
           if $b < $coin[$a] then .
           else  .[$b - $coin[$a]] as $count
           | if $count == 0 then .
             else .[$b] += $count
             end
           end ) )
  | .[target] ;