def div_check (int x, int y)
	try
		/ x y
		return false
	catch divzeroerror
		return true
	end try
end


Option Explicit

Sub Main()
Dim Div
    If CatchDivideByZero(152, 0, Div) Then Debug.Print Div Else Debug.Print "Error"
    If CatchDivideByZero(152, 10, Div) Then Debug.Print Div Else Debug.Print "Error"
End Sub

Function CatchDivideByZero(Num, Den, Div) As Boolean
    On Error Resume Next
    Div = Num / Den
    If Err = 0 Then CatchDivideByZero = True
    On Error GoTo 0
End Function


Function div(num,den)
	On Error Resume Next
	n = num/den
	If Err.Number <> 0 Then
		div = Err.Description & " is not allowed."
	Else
		div = n
	End If
End Function

WScript.StdOut.WriteLine div(6,3)
WScript.StdOut.WriteLine div(6,0)
WScript.StdOut.WriteLine div(7,-4)


Module DivByZeroDetection

    Sub Main()
        Console.WriteLine(safeDivision(10, 0))
    End Sub

    Private Function safeDivision(v1 As Integer, v2 As Integer) As Boolean
        Try
            Dim answer = v1 / v2
            Return False
        Catch ex As Exception
            Return True
        End Try
    End Function
End Module


var checkDivByZero = Fn.new { |a, b|
    var c = a / b
    if (c.isInfinity || c.isNan) return true
    return false
}

System.print("Division by zero?")
System.print("  0 / 0 -> %(checkDivByZero.call(0, 0))")
System.print("  1 / 0 -> %(checkDivByZero.call(1, 0))")
System.print("  1 / 1 -> %(checkDivByZero.call(1, 1))")


include c:\cxpl\codes;
int A, B;
[Trap(false);           \turn off error trapping
B:= 1234/(A-A);         \(error not detected at compile time)
if GetErr then Text(0, "Divide by zero");
]


func div_check(x, y) {
    if(catch(0x01))
        return 1;
    temp = x/y;
    return 0;
}


F collapse(s)
   V cs = ‘’
   V last = Char("\0")
   L(c) s
      I c != last
         cs ‘’= c
         last = c
   R cs

V strings = [
   ‘’,
   ‘"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ’,
   ‘..1111111111111111111111111111111111111111111111111111111111111117777888’,
   ‘I never give 'em hell, I just tell the truth, and they think it's hell. ’,
   ‘                                                   ---  Harry S Truman  ’,
   ‘The better the 4-wheel drive, the further you'll be from help when ya get stuck!’,
   ‘headmistressship’,
   ‘aardvark’
]

L(s) strings
   V c = collapse(s)
   print(‘original  : length = ’s.len‘, string = <<<’s‘>>>’)
   print(‘collapsed : length = ’c.len‘, string = <<<’c‘>>>’)
   print()


bdos:	equ	5
puts:	equ	9
	org	100h
	jmp	main
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Collapse the $-terminated string at [HL]
colaps:	mov	b,m	; B = last character seen
	inx	h	; First character never collapses
	mov	d,h	; DE = output pointer
	mov	e,l
	mov	a,b	; Empty string?
	cpi	'$'
	rz		; Then do nothing
cloop:	mov	a,m	; Get character
	inx	h	; Advance pointer
	cmp	b	; Same as last one?
	jz	cloop	; Then keep scanning
	mov	b,a	; Otherwise, it is a new one
	stax	d	; Store it,
	inx	d	; and increment output pointer.
	cpi	'$'	; Reached the end?
	jnz	cloop	; If not, next character
	ret
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Code to print the output in the required format
main:	lxi	h,strs	; List of string pointers
loop:	mov	e,m	; DE = string pointer
	inx	h
	mov	d,m
	inx	h
	mov	a,e	; If zero, end
	ora	d
	rz
	push	h	; Keep the list pointer
	push	d	; Keep the string pointer
	call	brstr	; Print original string in brackets
	pop	h	; Retrieve string pointer
	push	h
	call	colaps	; Collapse the string
	pop	d	; Retrieve string pointer
	call	brstr	; Print the collapsed string in brackets
	pop	h	; Retrieve the list pointer
	jmp	loop	; Next string
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Print string at DE in brackets with length
brstr:	push	d	; Store string pointer
	mvi	c,puts	; Print opening brackets
	lxi	d,open
	call	bdos
	pop	d	; Print original string
	push	d
	mvi	c,puts
	call	bdos
	mvi	c,puts	; Print closing brackets
	lxi	d,close
	call	bdos
	pop	h
	call	strlen	; Find string length
	mov	a,b
	jmp	prnum	; Print string length
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Figure out the length of a string (max 255)
strlen:	mvi	b,0	; Counter
	mvi	a,'$'	; Terminator
sloop:	cmp	m	; Reached the end yet?
	rz		; If so, stop
	inr	b	; If not, increment counter,
	inx	h	; and pointer,
	jmp	sloop	; and check next byte.
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Print number in A as decimal
prnum:	lxi	d,num	; End of number string
prdgt:	mvi	b,-1	; Quotient
ploop:	inr	b	; Increment quotient
	sui	10	; Subtract 10
	jnc	ploop	; Subtract until negative
	adi	'0'+10	; Make ASCII digit
	dcx	d	; Store in number string
	stax	d
	mov	a,b	; If more digits,
	ana	a
	jnz	prdgt	; find next digit
	mvi	c,puts	; When done, print string
	jmp	bdos
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Formatting strings
open:	db	'<<<$'
close:	db	'>>> $'
	db	'***'
num:	db	13,10,'$'
	;;;	Input strings
strs:	dw	str1,str2,str3,str4,str5,0
str1:	db	'$'	; Empty string
str2:	db	'"If I were two-faced, would I be wearing '
	db	'this one?" --- Abraham Lincoln $'
str3:	db	'..111111111111111111111111111111111111111'
	db	'1111111111111111111111117777888$'
str4:	db	'I never give ',39,'em hell, I just tell the truth, '
	db	'and they think it',39,'s hell. $'
str5:	db	'                                              '
	db	'      --- Harry S Truman  $'


PROC Collapse(CHAR ARRAY in,out)
  BYTE i,j
  CHAR c

  j=1 c=0
  FOR i=1 TO in(0)
  DO
    IF in(i)#c THEN
      c=in(i)
      out(j)=c
      j==+1
    FI
  OD
  out(0)=j-1
RETURN

PROC Test(CHAR ARRAY s)
  CHAR ARRAY c(100)
  BYTE CH=$02FC ;Internal hardware value for last key pressed

  Collapse(s,c)
  PrintF("<<<%S>>> (len=%B)%E",s,s(0))
  PrintF("<<<%S>>> (len=%B)%E",c,c(0))
  PutE()
  PrintE("Press any key to continue")
  PutE()

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN

PROC Main()
  Test("")
  Test("""If I were two-faced, would I be wearing this one?"" --- Abraham Lincoln ")
  Test("..1111111111111111111111111111111111111111111111111111111111111117777888")
  Test("I never give 'em hell, I just tell the truth, and they think it's hell. ")
  Test("                                                    --- Harry S Truman  ")
RETURN


with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Collapsible is
   procedure Collapse (S : in String) is
      Res : String (1 .. S'Length);
      Len : Natural := 0;
   begin
      Put_Line ("Input  = <<<" & S & ">>>, length =" & S'Length'Image);
      for I in S'Range loop
         if Len = 0 or else S(I) /= Res(Len) then
            Len := Len + 1;
            Res(Len) := S(I);
         end if;
      end loop;
      Put_Line ("Output = <<<" & Res (1 .. Len) & ">>>, length =" & Len'Image);
   end Collapse;
begin
   Collapse ("");
   Collapse ("""If I were two-faced, would I be wearing this one?"" --- Abraham Lincoln ");
   Collapse ("..1111111111111111111111111111111111111111111111111111111111111117777888");
   Collapse ("I never give 'em hell, I just tell the truth, and they think it's hell. ");
   Collapse ("                                                    --- Harry S Truman  ");
end Test_Collapsible;


BEGIN
    # returns a collapsed version of s                                    #
    #         i.e. s with adjacent duplicate characters removed           #
    PROC collapse = ( STRING s )STRING:
        IF s = ""
        THEN ""   # empty string                                          #
        ELSE      # non-empty string                                      #
            [ LWB s : UPB s ]CHAR result;
            INT     r pos   := LWB result;
            result[ r pos ] := s[ LWB s ];
            FOR s pos FROM LWB s + 1 TO UPB s DO
                IF result[ r pos ] /= s[ s pos ] THEN
                   r pos +:= 1;
                   result[ r pos ] := s[ s pos ]
                FI
            OD;
            result[ LWB result : r pos ]
        FI # callapse # ;
    # task test cases                                                     #
    []STRING tests = ( ""
                     , """If I were two-faced, would I be wearing this one?"" --- Abraham Lincoln "
                     , "..1111111111111111111111111111111111111111111111111111111111111117777888"
                     , "I never give 'em hell, I just tell the truth, and they think it's hell. "
                     , "                                                    --- Harry S Truman  "
                     );
    FOR t pos FROM LWB tests TO UPB tests DO
        STRING s = tests[ t pos ];
        STRING c = collapse( s );
        print( ( "       <<<", s, ">>> (length ", whole( ( UPB s + 1 ) - LWB s, 0 ), ")", newline ) );
        print( ( "result <<<", c, ">>> (length ", whole( ( UPB c + 1 ) - LWB c, 0 ), ")", newline ) )
    OD
END


task←{
   ⍝ Collapse a string
   collapse←{(1,¯1↓⍵≠1⌽⍵)/⍵}

   ⍝ Given a function ⍺⍺, display a string in brackets,
   ⍝ along with its length, and do the same for the result
   ⍝ of applying ⍺⍺ to the string.
   display←{
      bracket←{(⍕⍴⍵),' «««',⍵,'»»»'}
      ↑(⊂bracket ⍵),(⊂bracket ⍺⍺ ⍵)
   }

   ⍝ Strings from the task
   s1←''
   s2←'"If I were two-faced, would I be wearing this one?"'
   s2,←' --- Abraham Lincoln '
   s3←'..1111111111111111111111111111111111111111111111111'
   s3,←'111111111111117777888'
   s4←'I never give ''em hell, I just tell the truth, '
   s4,←'and they think it''s hell. '
   s5←'                                             '
   s5,←'       --- Harry S Truman  '
   strs←s1 s2 s3 s4 s5

   ⍝ Collapse each string and display it as specified
   ↑collapse display¨ strs
}


lines: [
    {::}
    {:"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln :}
    {:..1111111111111111111111111111111111111111111111111111111111111117777888:}
    {:I never give 'em hell, I just tell the truth, and they think it's hell. :}
    {:                                                    --- Harry S Truman  :}
]

loop lines 'line ->
    print squeeze line


collapsible_string(str){
	for i, ch in StrSplit(str){
		if (ch <> prev)
			res .= ch
		prev := ch
	}
	return "original string:`t" StrLen(str) " characters`t«««" str "»»»`nresultant string:`t" StrLen(res) " characters`t«««" res "»»»"
}


# syntax: GAWK -f DETERMINE_IF_A_STRING_IS_COLLAPSIBLE.AWK
BEGIN {
    for (i=1; i<=9; i++) {
      for (j=1; j<=i; j++) {
        arr[0] = arr[0] i
      }
    }
    arr[++n] = ""
    arr[++n] = "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
    arr[++n] = "..1111111111111111111111111111111111111111111111111111111111111117777888"
    arr[++n] = "I never give 'em hell, I just tell the truth, and they think it's hell. "
    arr[++n] = "                                                    --- Harry S Truman  "
    arr[++n] = "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"
    arr[++n] = "headmistressship"
    for (i=0; i<=n; i++) {
      main(arr[i])
    }
    exit(0)
}
function main(str,  c,i,new_str,prev_c) {
    for (i=1; i<=length(str); i++) {
      c = substr(str,i,1)
      if (prev_c != c) {
        prev_c = c
        new_str = new_str c
      }
    }
    printf("old: %2d <<<%s>>>\n",length(str),str)
    printf("new: %2d <<<%s>>>\n\n",length(new_str),new_str)
}


DATA ""
DATA "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
DATA "..1111111111111111111111111111111111111111111111111111111111111117777888"
DATA "I never give 'em hell, I just tell the truth, and they think it's hell. "
DATA "                                                    --- Harry S Truman  "
DATA "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"
DATA "headmistressship"

DOTIMES 7
    READ x$
    found = 0
    PRINT "<<<", x$, ">>> - length: ", LEN(x$)
    PRINT "<<<";
    FOR y = 1 TO LEN(x$)
        IF MID$(x$, y, 1) <> MID$(x$, y+1, 1) THEN
            PRINT MID$(x$, y, 1);
            INCR found
        ENDIF
    NEXT
    PRINT ">>> - length: ", found
DONE


10 READ N%
20 FOR A% = 1 TO N%
30 READ I$: GOSUB 100
40 PRINT LEN(I$); "<<<"; I$; ">>>"
50 PRINT LEN(O$); "<<<"; O$; ">>>"
55 PRINT
60 NEXT
70 END
100 REM Collapse I$ into O$
105 IF I$="" THEN O$=I$: RETURN
110 O$=SPACE$(LEN(I$))
120 P$=LEFT$(I$,1)
130 MID$(O$,1,1)=P$
140 O%=2
150 FOR I%=2 TO LEN(I$)
160 C$=MID$(I$,I%,1)
170 IF P$<>C$ THEN MID$(O$,O%,1)=C$: O%=O%+1: P$=C$
180 NEXT
190 O$=LEFT$(O$,O%-1)
200 RETURN
400 DATA 5: REM There are 5 strings
410 DATA ""
420 DATA "'If I were two-faced, would I be wearing this one?' --- Abraham Lincoln "
430 DATA "..1111111111111111111111111111111111111111111111111111111111111117777888"
440 DATA "I never give 'em hell, I just tell the truth, and they think it's hell. "
450 DATA "                                                    --- Harry S Truman  "


get "libhdr"

// Collapse a string
let collapse(in, out) = valof
$(  let o = 0
    for i = 1 to in%0
        unless i>1 & in%i = in%(i-1)
        $(  o := o + 1
            out%o := in%i
        $)
    out%0 := o
    resultis out
$)

// Print string with brackets and length
let brackets(s) be
    writef("%N: <<<%S>>>*N", s%0, s)

// Print original and collapsed version
let show(s) be
$(  let v = vec 1+255/BYTESPERWORD
    brackets(s)
    brackets(collapse(s, v))
    wrch('*N')
$)

let start() be
$(  show("")
    show("*"If I were two-faced, would I be wearing this one?*" --- Abraham Lincoln ")
    show("..1111111111111111111111111111111111111111111111111111111111111111111788")
    show("I never give 'em hell, I just tell the truth, and they think it's hell. ")
    show("                                                     --- Harry S Truman ")
$)


  ( colapse
  =   previous
    .   str
      $ ( vap
        $ ( (
            =
              .   !arg:!previous&
                | !arg:?previous
            )
          . !arg
          )
        )
  )
& ( testcolapse
  =   len
    .   ([email protected](!arg:? [?arg)&!arg)
      & out$(str$(««« !arg "»»» " len$!arg))
      & colapse$!arg:?arg
      & out$(str$(««« !arg "»»» " len$!arg))
  )
& testcolapse$
&   testcolapse
  $ "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
&   testcolapse
  $ "..1111111111111111111111111111111111111111111111111111111111111117777888"
&   testcolapse
  $ "I never give 'em hell, I just tell the truth, and they think it's hell. "
&   testcolapse
  $ "                                                    --- Harry S Truman  "


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

#define COLLAPSE 0
#define SQUEEZE 1

typedef struct charList{
    char c;
    struct charList *next;
} charList;

/*
Implementing strcmpi, the case insensitive string comparator, as it is not part of the C Standard Library.

Comment this out if testing on a compiler where it is already defined.
*/

int strcmpi(char* str1,char* str2){
    int len1 = strlen(str1), len2 = strlen(str2), i;

    if(len1!=len2){
        return 1;
    }

    else{
        for(i=0;i<len1;i++){
            if((str1[i]>='A'&&str1[i]<='Z')&&(str2[i]>='a'&&str2[i]<='z')&&(str2[i]-65!=str1[i]))
                return 1;
            else if((str2[i]>='A'&&str2[i]<='Z')&&(str1[i]>='a'&&str1[i]<='z')&&(str1[i]-65!=str2[i]))
                return 1;
            else if(str1[i]!=str2[i])
                return 1;
        }
    }

    return 0;
}

charList *strToCharList(char* str){
    int len = strlen(str),i;

    charList *list, *iterator, *nextChar;

    list = (charList*)malloc(sizeof(charList));
    list->c = str[0];
    list->next = NULL;

    iterator = list;

    for(i=1;i<len;i++){
        nextChar = (charList*)malloc(sizeof(charList));
        nextChar->c = str[i];
        nextChar->next = NULL;

        iterator->next = nextChar;
        iterator = nextChar;
    }

    return list;
}

char* charListToString(charList* list){
    charList* iterator = list;
    int count = 0,i;
    char* str;

    while(iterator!=NULL){
        count++;
        iterator = iterator->next;
    }

    str = (char*)malloc((count+1)*sizeof(char));
    iterator = list;

    for(i=0;i<count;i++){
        str[i] = iterator->c;
        iterator = iterator->next;
    }

    free(list);
    str[i] = '\0';

    return str;
}

char* processString(char str[100],int operation, char squeezeChar){
    charList *strList = strToCharList(str),*iterator = strList, *scout;

    if(operation==SQUEEZE){
        while(iterator!=NULL){
            if(iterator->c==squeezeChar){
                scout = iterator->next;

                while(scout!=NULL && scout->c==squeezeChar){
                        iterator->next = scout->next;
                        scout->next = NULL;
                        free(scout);
                        scout = iterator->next;
                }
            }
            iterator = iterator->next;
        }
    }

    else{
        while(iterator!=NULL && iterator->next!=NULL){
            if(iterator->c == (iterator->next)->c){
                scout = iterator->next;
                squeezeChar = iterator->c;

                while(scout!=NULL && scout->c==squeezeChar){
                        iterator->next = scout->next;
                        scout->next = NULL;
                        free(scout);
                        scout = iterator->next;
                }
            }
            iterator = iterator->next;
        }
    }

    return charListToString(strList);
}

void printResults(char originalString[100], char finalString[100], int operation, char squeezeChar){
    if(operation==SQUEEZE){
        printf("Specified Operation : SQUEEZE\nTarget Character : %c",squeezeChar);
    }

    else
        printf("Specified Operation : COLLAPSE");

    printf("\nOriginal %c%c%c%s%c%c%c\nLength : %d",174,174,174,originalString,175,175,175,(int)strlen(originalString));
    printf("\nFinal    %c%c%c%s%c%c%c\nLength : %d\n",174,174,174,finalString,175,175,175,(int)strlen(finalString));
}

int main(int argc, char** argv){
    int operation;
    char squeezeChar;

    if(argc<3||argc>4){
        printf("Usage : %s <SQUEEZE|COLLAPSE> <String to be processed> <Character to be squeezed, if operation is SQUEEZE>\n",argv[0]);
        return 0;
    }

    if(strcmpi(argv[1],"SQUEEZE")==0 && argc!=4){
        scanf("Please enter characted to be squeezed : %c",&squeezeChar);
        operation = SQUEEZE;
    }

    else if(argc==4){
        operation = SQUEEZE;
        squeezeChar = argv[3][0];
    }

    else if(strcmpi(argv[1],"COLLAPSE")==0){
        operation = COLLAPSE;
    }

    if(strlen(argv[2])<2){
        printResults(argv[2],argv[2],operation,squeezeChar);
    }

    else{
        printResults(argv[2],processString(argv[2],operation,squeezeChar),operation,squeezeChar);
    }

    return 0;
}


using System;
using static System.Linq.Enumerable;

public class Program
{
    static void Main()
    {
        string[] input = {
            "",
            "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
            "headmistressship",
            "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
            "..1111111111111111111111111111111111111111111111111111111111111117777888",
            "I never give 'em hell, I just tell the truth, and they think it's hell. ",
            "                                                    --- Harry S Truman  "
        };
        foreach (string s in input) {
            Console.WriteLine($"old: {s.Length} «««{s}»»»");
            string c = Collapse(s);
            Console.WriteLine($"new: {c.Length} «««{c}»»»");
        }
    }

    static string Collapse(string s) => string.IsNullOrEmpty(s) ? "" :
        s[0] + new string(Range(1, s.Length - 1).Where(i => s[i] != s[i - 1]).Select(i => s[i]).ToArray());
}


#include <string>
#include <iostream>
#include <algorithm>

template<typename char_type>
std::basic_string<char_type> collapse(std::basic_string<char_type> str) {
    auto i = std::unique(str.begin(), str.end());
    str.erase(i, str.end());
    return str;
}

void test(const std::string& str) {
    std::cout << "original string: <<<" << str << ">>>, length = " << str.length() << '\n';
    std::string collapsed(collapse(str));
    std::cout << "result string: <<<" << collapsed << ">>>, length = " << collapsed.length() << '\n';
    std::cout << '\n';
}

int main(int argc, char** argv) {
    test("");
    test("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ");
    test("..1111111111111111111111111111111111111111111111111111111111111117777888");
    test("I never give 'em hell, I just tell the truth, and they think it's hell. ");
    test("                                                    --- Harry S Truman  ");
    return 0;
}


F s_permutations(seq)
   V items = [[Int]()]
   L(j) seq
      [[Int]] new_items
      L(item) items
         V i = L.index
         I i % 2
            new_items [+]= (0 .. item.len).map(i -> @item[0 .< i] [+] [@j] [+] @item[i ..])
         E
            new_items [+]= (item.len .< -1).step(-1).map(i -> @item[0 .< i] [+] [@j] [+] @item[i ..])
      items = new_items

   R enumerate(items).map((i, item) -> (item, I i % 2 {-1} E 1))

F det(a)
   V result = 0.0
   L(sigma, _sign_) s_permutations(Array(0 .< a.len))
      V x = Float(_sign_)
      L(i) 0 .< a.len
         x *= a[i][sigma[i]]
      result += x
   R result

F perm(a)
   V result = 0.0
   L(sigma, _sign_) s_permutations(Array(0 .< a.len))
      V x = 1.0
      L(i) 0 .< a.len
         x *= a[i][sigma[i]]
      result += x
   R result

V a = [[1.0, 2.0],
       [3.0, 4.0]]

V b = [[Float( 1),  2,  3,  4],
       [Float( 4),  5,  6,  7],
       [Float( 7),  8,  9, 10],
       [Float(10), 11, 12, 13]]

V c = [[Float( 0),  1,  2,  3,  4],
       [Float( 5),  6,  7,  8,  9],
       [Float(10), 11, 12, 13, 14],
       [Float(15), 16, 17, 18, 19],
       [Float(20), 21, 22, 23, 24]]

print(‘perm: ’perm(a)‘ det: ’det(a))
print(‘perm: ’perm(b)‘ det: ’det(b))
print(‘perm: ’perm(c)‘ det: ’det(c))


(defn collapse [s]
  (let [runs (partition-by identity s)]
    (apply str (map first runs))))

(defn run-test [s]
  (let [out (collapse s)]
    (str (format "Input: <<<%s>>> (len %d)\n" s (count s))
         (format "becomes: <<<%s>>> (len %d)\n" out (count out)))))


% Collapse a string
collapse = proc (s: string) returns (string)
    out: array[char] := array[char]$[]
    last: char := '\000'

    for c: char in string$chars(s) do
        if c ~= last then
            last := c
            array[char]$addh(out,c)
        end
    end
    return (string$ac2s(out))
end collapse

% Show a string in brackets, with its length
brackets = proc (s: string)
    stream$putl(stream$primary_output(),
                    int$unparse(string$size(s))
                 || " <<<"
                 || s
                 || ">>>")
end brackets

% Show a string and its collapsed version, and the corresponding lengths
show = proc (s: string)
    brackets(s)
    brackets(collapse(s))
    stream$putl(stream$primary_output(), "")
end show

% Try the examples from the task description
start_up = proc ()
    examples: array[string] := array[string]$[
        "",
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                    --- Harry S Truman  "
    ]

    for ex: string in array[string]$elements(examples) do
        show(ex)
    end
end start_up


include "cowgol.coh";
include "strings.coh";

# Collapse the string at in, and store the result in the given buffer
sub collapse(in: [uint8], out: [uint8]) is
    var ch := [in];
    in := @next in;
    loop
        if ch == 0 then
            [out] := 0;
            return;
        elseif [in] != ch then
            [out] := ch;
            out := @next out;
            ch := [in];
        end if;
        in := @next in;
    end loop;
end sub;

# Given a string, collapse it and print all required output
sub show(str: [uint8]) is
    sub bracket_length(str: [uint8]) is
        print_i32(StrLen(str) as uint32);
        print(" <<<");
        print(str);
        print(">>>");
        print_nl();
    end sub;

    var buf: uint8[256];
    collapse(str, &buf[0]);
    bracket_length(str);
    bracket_length(&buf[0]);
    print_nl();
end sub;

# Strings from the task
var strings: [uint8][] := {
"",
"\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
"..1111111111111111111111111111111111111111111111111111111111111117777888",
"I never give 'em hell, I just tell the truth, and they think it's hell. ",
"                                                    --- Harry S Truman  "
};

# Collapse and print each string
var i: @indexof strings := 0;
while i < @sizeof strings loop
    show(strings[i]);
    i := i + 1;
end loop;


*        Matrix arithmetic         13/05/2016
MATARI   START
         STM    R14,R12,12(R13)    save caller's registers
         LR     R12,R15            set R12 as base register
         USING  MATARI,R12         notify assembler
         LA     R11,SAVEAREA       get the address of my savearea
         ST     R13,4(R11)         save caller's savearea pointer
         ST     R11,8(R13)         save my savearea pointer
         LR     R13,R11            set R13 to point to my savearea
         LA     R1,TT              @tt
         BAL    R14,DETER          call deter(tt)
         LR     R2,R0              R2=deter(tt)
         LR     R3,R1              R3=perm(tt)
         XDECO  R2,PG1+12          edit determinant
         XPRNT  PG1,80             print determinant
         XDECO  R3,PG2+12          edit permanent
         XPRNT  PG2,80             print permanent
EXITALL  L      R13,SAVEAREA+4     restore caller's savearea address
         LM     R14,R12,12(R13)    restore caller's registers
         XR     R15,R15            set return code to 0
         BR     R14                return to caller
SAVEAREA DS     18F                main savearea
TT       DC     F'3'               matrix size
         DC     F'2',F'9',F'4',F'7',F'5',F'3',F'6',F'1',F'8' <==input
PG1      DC     CL80'determinant='
PG2      DC     CL80'permanent='
XDEC     DS     CL12
*        recursive function        (R0,R1)=deter(t)   (python style)
DETER    CNOP   0,4                  returns determinant and permanent
         STM    R14,R12,12(R13)    save all registers
         LR     R9,R1              save R1
         L      R2,0(R1)           n
         BCTR   R2,0               n-1
         LR     R11,R2             n-1
         MR     R10,R2             (n-1)*(n-1)
         SLA    R11,2              (n-1)*(n-1)*4
         LA     R11,1(R11)         size of q array
         A      R11,=A(STACKLEN)   R11 storage amount required
         GETMAIN RU,LV=(R11)       allocate storage for stack
         USING  STACK,R10          make storage addressable
         LR     R10,R1             establish stack addressability
         LA     R1,SAVEAREB        get the address of my savearea
         ST     R13,4(R1)          save caller's savearea pointer
         ST     R1,8(R13)          save my savearea pointer
         LR     R13,R1             set R13 to point to my savearea
         LR     R1,R9              restore R1
         LR     R9,R1              @t
         L      R4,0(R9)           t(0)
         ST     R4,N               n=t(0)
IF1      CH     R4,=H'1'           if n=1
         BNE    SIF1               then
         L      R2,4(R9)             t(1)
         ST     R2,R                 r=t(1)
         ST     R2,S                 s=t(1)
         B      EIF1               else
SIF1     L      R2,N                 n
         BCTR   R2,0                 n-1
         ST     R2,Q                 q(0)=n-1
         ST     R2,NM1               nm1=n-1
         LA     R0,1                 1
         ST     R0,SGN               sgn=1
         SR     R0,R0                0
         ST     R0,R                 r=0
         ST     R0,S                 s=0
         LA     R6,1                 k=1
LOOPK    C      R6,N                 do k=1 to n
         BH     ELOOPK               leave k
         SR     R0,R0                  0
         ST     R0,JQ                  jq=0
         ST     R0,KTI                 kti=0
         LA     R7,1                   iq=1
LOOPIQ   C      R7,NM1                 do iq=1 to n-1
         BH     ELOOPIQ                leave iq
         LR     R2,R7                    iq
         LA     R2,1(R2)                 iq+1
         ST     R2,IT                    it=iq+1
         L      R2,KTI                   kti
         A      R2,N                     kti+n
         ST     R2,KTI                   kti=kti+n
         ST     R2,KT                    kt=kti
         LA     R8,1                     jt=1
LOOPJT   C      R8,N                     do jt=1 to n
         BH     ELOOPJT                  leave jt
         L      R2,KT                      kt
         LA     R2,1(R2)                   kt+1
         ST     R2,KT                      kt=kt+1
IF2      CR     R8,R6                      if jt<>k
         BE     EIF2                       then
         L      R2,JQ                        jq
         LA     R2,1(R2)                     jq+1
         ST     R2,JQ                        jq=jq+1
         L      R1,KT                        kt
         SLA    R1,2                         *4
         L      R2,0(R1,R9)                  t(kt)
         L      R1,JQ                        jq
         SLA    R1,2                         *4
         ST     R2,Q(R1)                     q(jq)=t(kt)
EIF2     EQU    *                          end if
         LA     R8,1(R8)                   jt=jt+1
         B      LOOPJT                   next jt
ELOOPJT  LA     R7,1(R7)                 iq=iq+1
         B      LOOPIQ                 next iq
ELOOPIQ  LR     R1,R6                  k
         SLA    R1,2                   *4
         L      R5,0(R1,R9)            t(k)
         LR     R2,R5                  R2,R5=t(k)
         LA     R1,Q                   @q
         BAL    R14,DETER              call deter(q)
         LR     R3,R0                  R3=deter(q)
         ST     R1,P                   p=perm(q)
         MR     R4,R3                  R5=t(k)*deter(q)
         M      R4,SGN                 R5=sgn*t(k)*deter(q)
         A      R5,R                   +r
         ST     R5,R                   r=r+sgn*t(k)*deter(q)
         LR     R5,R2                  t(k)
         M      R4,P                   R5=t(k)*perm(q)
         A      R5,S                   +s
         ST     R5,S                   s=s+t(k)*perm(q)
         L      R2,SGN                 sgn
         LCR    R2,R2                  -sgn
         ST     R2,SGN                 sgn=-sgn
         LA     R6,1(R6)               k=k+1
         B      LOOPK                next k
ELOOPK   EQU    *                    end do
EIF1     EQU    *                  end if
EXIT     L      R13,SAVEAREB+4     restore caller's savearea address
         L      R2,R               return value (determinant)
         L      R3,S               return value (permanent)
         XR     R15,R15            set return code to 0
         FREEMAIN A=(R10),LV=(R11) free allocated storage
         LR     R0,R2              first return value
         LR     R1,R3              second return value
         L      R14,12(R13)        restore caller's return address
         LM     R2,R12,28(R13)     restore registers R2 to R12
         BR     R14                return to caller
IT       DS     F                  static area (out of stack)
KT       DS     F                  "
JQ       DS     F                  "
KTI      DS     F                  "
P        DS     F                  "
         DROP   R12                base no longer needed
STACK    DSECT                     dynamic area (stack)
SAVEAREB DS     18F                function savearea
N        DS     F                  n
NM1      DS     F                  n-1
R        DS     F                  determinant accu
S        DS     F                  permanent accu
SGN      DS     F                  sign
STACKLEN EQU    *-STACK
Q        DS     F                  sub matrix q((n-1)*(n-1)+1)
         YREGS
         END    MATARI


printMatrix: function [m][
    loop m 'row -> print map row 'val [pad to :string .format:".2f" val 6]
    print "--------------------------------"
]

permutations: function [arr][
    d: 1
    c: array.of: size arr 0
    xs: new arr
    sign: 1

    ret: new @[@[xs, sign]]

    while [true][
        while [d > 1][
            d: d-1
            c\[d]: 0
        ]

        while [c\[d] >= d][
            d: d+1
            if d >= size arr -> return ret
        ]

        i: (1 = and d 1)? -> c\[d] -> 0
        tmp: xs\[i]
        xs\[i]: xs\[d]
        xs\[d]: tmp

        sign: neg sign
        'ret ++ @[new @[xs, sign]]
        c\[d]: c\[d] + 1
    ]

    return ret
]

perm: function [a][
    n: 0..dec size a
    result: new 0.0
    loop permutate n 'sigma [
        x: 1.0
        loop n 'i -> x: x * get a\[i] sigma\[i]
        'result + x
    ]
    return result
]

det: function [a][
    n: 0..dec size a
    result: new 0.0
    loop.with:'i permutations n 'p[
        x: p\1
        loop n 'i -> x: x * get a\[i] p\0\[i]
        'result + x
    ]
    return result
]

A: [[1.0 2.0]
    [3.0 4.0]]

B: [[ 1.0  2  3  4]
    [ 4.0  5  6  7]
    [ 7.0  8  9 10]
    [10.0 11 12 13]]

C: [[ 0.0  1  2  3  4]
    [ 5.0  6  7  8  9]
    [10.0 11 12 13 14]
    [15.0 16 17 18 19]
    [20.0 21 22 23 24]]

print ["A: perm ->" perm A "det ->" det A]
print ["B: perm ->" perm B "det ->" det B]
print ["C: perm ->" perm C "det ->" det C]


import std.stdio;

void collapsible(string s) {
    writeln("old: <<<", s, ">>>, length = ", s.length);

    write("new: <<<");
    char last = '\0';
    int len = 0;
    foreach (c; s) {
        if (c != last) {
            write(c);
            len++;
        }
        last = c;
    }
    writeln(">>>, length = ", len);

    writeln;
}

void main() {
    collapsible(``);
    collapsible(`"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln `);
    collapsible(`..1111111111111111111111111111111111111111111111111111111111111117777888`);
    collapsible(`I never give 'em hell, I just tell the truth, and they think it's hell. `);
    collapsible(`                                                    --- Harry S Truman  `);
}


program Determine_if_a_string_is_collapsible;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

procedure collapsible(s: string);
var
  c, last: char;
  len: Integer;
begin
  writeln('old: <<<', s, '>>>, length = ', s.length);
  write('new: <<<');
  last := #0;
  len := 0;
  for c in s do
  begin
    if c <> last then
    begin
      write(c);
      inc(len);
    end;
    last := c;
  end;
  writeln('>>>, length = ', len, #10);
end;

begin
  collapsible('');
  collapsible('"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ');
  collapsible('..1111111111111111111111111111111111111111111111111111111111111117777888');
  collapsible('I never give ''em hell, I just tell the truth, and they think it''s hell. ');
  collapsible('                                                    --- Harry S Truman  ');
  readln;
end.


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

double det_in(double **in, int n, int perm)
{
	if (n == 1) return in[0][0];

	double sum = 0, *m[--n];
	for (int i = 0; i < n; i++)
		m[i] = in[i + 1] + 1;

	for (int i = 0, sgn = 1; i <= n; i++) {
		sum += sgn * (in[i][0] * det_in(m, n, perm));
		if (i == n) break;

		m[i] = in[i] + 1;
		if (!perm) sgn = -sgn;
	}
	return sum;
}

/* wrapper function */
double det(double *in, int n, int perm)
{
	double *m[n];
	for (int i = 0; i < n; i++)
		m[i] = in + (n * i);

	return det_in(m, n, perm);
}

int main(void)
{
	double x[] = {	0, 1, 2, 3, 4,
			5, 6, 7, 8, 9,
			10, 11, 12, 13, 14,
			15, 16, 17, 18, 19,
			20, 21, 22, 23, 24 };

	printf("det:  %14.12g\n", det(x, 5, 0));
	printf("perm: %14.12g\n", det(x, 5, 1));

	return 0;
}


// Collapse a String. Nigel Galloway: June 9th., 2020
//As per the task description a function which 'determines if a character string is collapsible' by testing if any consecutive characters are the same.
let isCollapsible n=n|>Seq.pairwise|>Seq.tryFind(fun(n,g)->n=g)
//As per the task description a function which 'if the string is collapsable, collapses the string (by removing immediately repeated characters).
let collapse n=match isCollapsible n with
                Some _->let i=Seq.head n
                        let fN=let mutable g=i in (fun n->if n=g then false else g<-n; true)
                        let g=System.String([|yield i;yield! Seq.tail n|>Seq.filter fN|])
                        printfn "<<<%s>>> (length %d) colapses to <<<%s>>> (length %d)" n n.Length g g.Length
               |     _->printfn "<<<%s>>> (length %d) does not colapse" n n.Length

collapse ""
collapse "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
collapse "..1111111111111111111111111111111111111111111111111111111111111117777888"
collapse "I never give 'em hell, I just tell the truth, and they think it's hell. "
collapse "                                                    --- Harry S Truman  "
collapse "withoutConsecutivelyRepeatedCharacters"


USING: formatting io kernel sbufs sequences strings ;
IN: rosetta-code.string-collapse

: (collapse) ( str -- str )
    unclip-slice 1string >sbuf
    [ over last over = [ drop ] [ suffix! ] if ] reduce >string ;

: collapse ( str -- str ) [ "" ] [ (collapse) ] if-empty ;

: .str ( str -- ) dup length "«««%s»»» (length %d)\n" printf ;

: show-collapse ( str -- )
    [ "Before collapse: " write .str ]
    [ "After  collapse: " write collapse .str ] bi nl ;

: collapse-demo ( -- )
    {
        ""
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
        "..1111111111111111111111111111111111111111111111111111111111111117777888"
        "I never give 'em hell, I just tell the truth, and they think it's hell. "
        "                                                   ---  Harry S Truman  "
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"
        "headmistressship"
        "aardvark"
        "😍😀🙌💃😍😍😍🙌"
    } [ show-collapse ] each ;

MAIN: collapse-demo


Const numCad = 5
Data ""
Data "'If I were two-faced, would I be wearing this one?' --- Abraham Lincoln "
Data "..1111111111111111111111111111111111111111111111111111111111111117777888"
Data "I never give 'em hell, I just tell the truth, and they think it's hell. "
Data "                                                    --- Harry S Truman  "

Dim Shared As String cadIN, cadOUT

Sub Collapse
    Dim As String a, b
    If cadIN = "" Then cadOUT = cadIN: Exit Sub
    cadOUT = Space(Len(cadIN))
    a = Left(cadIN,1)
    Mid(cadOUT,1,1) = a
    Dim As Integer txtOUT = 2
    For i As Integer = 2 To Len(cadIN)
        b = Mid(cadIN,i,1)
        If a <> b Then Mid(cadOUT,txtOUT,1) = b: txtOUT += 1: a = b
    Next i
    cadOUT = Left(cadOUT,txtOUT-1)
End Sub

For j As Integer = 1 To numCad
    Read cadIN
    Collapse
    Print " <<<"; cadIN; ">>> (longitud "; Len(cadIN); _
    !")\n    se pliega a:\n <<<"; cadOUT; ">>> (longitud "; Len(cadOUT); !")\n"
Next j
Sleep


#include <iostream>
#include <vector>

template <typename T>
std::ostream &operator<<(std::ostream &os, const std::vector<T> &v) {
    auto it = v.cbegin();
    auto end = v.cend();

    os << '[';
    if (it != end) {
        os << *it;
        it = std::next(it);
    }
    while (it != end) {
        os << ", " << *it;
        it = std::next(it);
    }
    return os << ']';
}

using Matrix = std::vector<std::vector<double>>;

Matrix squareMatrix(size_t n) {
    Matrix m;
    for (size_t i = 0; i < n; i++) {
        std::vector<double> inner;
        for (size_t j = 0; j < n; j++) {
            inner.push_back(nan(""));
        }
        m.push_back(inner);
    }
    return m;
}

Matrix minor(const Matrix &a, int x, int y) {
    auto length = a.size() - 1;
    auto result = squareMatrix(length);
    for (int i = 0; i < length; i++) {
        for (int j = 0; j < length; j++) {
            if (i < x && j < y) {
                result[i][j] = a[i][j];
            } else if (i >= x && j < y) {
                result[i][j] = a[i + 1][j];
            } else if (i < x && j >= y) {
                result[i][j] = a[i][j + 1];
            } else {
                result[i][j] = a[i + 1][j + 1];
            }
        }
    }
    return result;
}

double det(const Matrix &a) {
    if (a.size() == 1) {
        return a[0][0];
    }

    int sign = 1;
    double sum = 0;
    for (size_t i = 0; i < a.size(); i++) {
        sum += sign * a[0][i] * det(minor(a, 0, i));
        sign *= -1;
    }
    return sum;
}

double perm(const Matrix &a) {
    if (a.size() == 1) {
        return a[0][0];
    }

    double sum = 0;
    for (size_t i = 0; i < a.size(); i++) {
        sum += a[0][i] * perm(minor(a, 0, i));
    }
    return sum;
}

void test(const Matrix &m) {
    auto p = perm(m);
    auto d = det(m);

    std::cout << m << '\n';
    std::cout << "Permanent: " << p << ", determinant: " << d << "\n\n";
}

int main() {
    test({ {1, 2}, {3, 4} });
    test({ {1, 2, 3, 4}, {4, 5, 6, 7}, {7, 8, 9, 10}, {10, 11, 12, 13} });
    test({ {0, 1, 2, 3, 4}, {5, 6, 7, 8, 9}, {10, 11, 12, 13, 14}, {15, 16, 17, 18, 19}, {20, 21, 22, 23, 24} });

    return 0;
}


collapse[str] := str =~ %s/(.)\1+/$1/g

lines = ["",
         """"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln """,
"..1111111111111111111111111111111111111111111111111111111111111117777888",
"I never give 'em hell, I just tell the truth, and they think it's hell. ",
"                                                    --- Harry S Truman  "]

for line = lines
   println[collapse[line]]


package main

import "fmt"

// Returns collapsed string, original and new lengths in
// unicode code points (not normalized).
func collapse(s string) (string, int, int) {
    r := []rune(s)
    le, del := len(r), 0
    for i := le - 2; i >= 0; i-- {
        if r[i] == r[i+1] {
            copy(r[i:], r[i+1:])
            del++
        }
    }
    if del == 0 {
        return s, le, le
    }
    r = r[:le-del]
    return string(r), le, len(r)
}

func main() {
    strings:= []string {
        "",
        `"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln `,
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                   ---  Harry S Truman  ",
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
        "headmistressship",
        "aardvark",
        "😍😀🙌💃😍😍😍🙌",
    }
    for _, s := range strings {
        cs, olen, clen := collapse(s)
        fmt.Printf("original : length = %2d, string = «««%s»»»\n", olen, s)
        fmt.Printf("collapsed: length = %2d, string = «««%s»»»\n\n", clen, cs)
    }
}


(defun determinant (rows &optional (skip-cols nil))
  (let* ((result 0) (sgn -1))
    (dotimes (col (length (car rows)) result)
      (unless (member col skip-cols)
        (if (null (cdr rows))
          (return-from determinant (elt (car rows) col))
          (incf result (* (setq sgn (- sgn)) (elt (car rows) col) (determinant (cdr rows) (cons col skip-cols)))) )))))

(defun permanent (rows &optional (skip-cols nil))
  (let* ((result 0))
    (dotimes (col (length (car rows)) result)
      (unless (member col skip-cols)
        (if (null (cdr rows))
          (return-from permanent (elt (car rows) col))
          (incf result (* (elt (car rows) col) (permanent (cdr rows) (cons col skip-cols)))) )))))

Test using the first set of definitions (from task description):

(setq m2
  '((1 2)
    (3 4)))

(setq m3
  '((-2 2 -3)
    (-1 1  3)
    ( 2 0 -1)))

(setq m4
  '(( 1  2  3  4)
    ( 4  5  6  7)
    ( 7  8  9 10)
    (10 11 12 13)))

(setq m5
  '(( 0  1  2  3  4)
    ( 5  6  7  8  9)
    (10 11 12 13 14)
    (15 16 17 18 19)
    (20 21 22 23 24)))

(dolist (m (list m2 m3 m4 m5))
  (format t "~a determinant: ~a, permanent: ~a~%" m (determinant m) (permanent m)) )


class StringCollapsible {
    static void main(String[] args) {
        for ( String s : [
                "",
                "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
                "..1111111111111111111111111111111111111111111111111111111111111117777888",
                "I never give 'em hell, I just tell the truth, and they think it's hell. ",
                "                                                    --- Harry S Truman  ",
                "122333444455555666666777777788888888999999999",
                "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
                "headmistressship"]) {
            String result = collapse(s)
            System.out.printf("old:  %2d <<<%s>>>%nnew:  %2d <<<%s>>>%n%n", s.length(), s, result.length(), result)
        }
    }

    private static String collapse(String input) {
        StringBuilder sb = new StringBuilder()
        for ( int i = 0 ; i < input.length() ; i++ ) {
            if ( i == 0 || input.charAt(i-1) != input.charAt(i) ) {
                sb.append(input.charAt(i))
            }
        }
        return sb.toString()
    }
}


import Text.Printf (printf)
import Data.Maybe (catMaybes)
import Control.Monad (guard)

input :: [String]
input = [ ""
        , "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"
        , "headmistressship"
        , "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
        , "..1111111111111111111111111111111111111111111111111111111111111117777888"
        , "I never give 'em hell, I just tell the truth, and they think it's hell. "
        , "                                                    --- Harry S Truman  "
        , "😍😀🙌💃😍😍😍🙌"
        ]

collapse :: Eq a => [a] -> [a]
collapse = catMaybes . (\xs -> zipWith (\a b -> guard (a /= b) >> a) (Nothing : xs) (xs <> [Nothing])) . map Just

main :: IO ()
main =
  mapM_ (\(a, b) -> printf "old: %3d «««%s»»»\nnew: %3d «««%s»»»\n\n" (length a) a (length b) b)
  $ ((,) <*> collapse) <$> input


import std.algorithm, std.range, std.traits, permutations2,
       permutations_by_swapping1;

auto prod(Range)(Range r) nothrow @safe @nogc {
    return reduce!q{a * b}(ForeachType!Range(1), r);
}

T permanent(T)(in T[][] a) nothrow @safe
in {
    assert(a.all!(row => row.length == a[0].length));
} body {
    auto r = a.length.iota;
    T tot = 0;
    foreach (const sigma; r.array.permutations)
        tot += r.map!(i => a[i][sigma[i]]).prod;
    return tot;
}

T determinant(T)(in T[][] a) nothrow
in {
    assert(a.all!(row => row.length == a[0].length));
} body {
    immutable n = a.length;
    auto r = n.iota;
    T tot = 0;
    //foreach (sigma, sign; n.spermutations) {
    foreach (const sigma_sign; n.spermutations) {
        const sigma = sigma_sign[0];
        immutable sign = sigma_sign[1];
        tot += sign * r.map!(i => a[i][sigma[i]]).prod;
    }
    return tot;
}

void main() {
    import std.stdio;

    foreach (/*immutable*/ const a; [[[1, 2],
                                      [3, 4]],

                                     [[1, 2, 3, 4],
                                      [4, 5, 6, 7],
                                      [7, 8, 9, 10],
                                      [10, 11, 12, 13]],

                                     [[ 0,  1,  2,  3,  4],
                                      [ 5,  6,  7,  8,  9],
                                      [10, 11, 12, 13, 14],
                                      [15, 16, 17, 18, 19],
                                      [20, 21, 22, 23, 24]]]) {
        writefln("[%([%(%2s, %)],\n %)]]", a);
        writefln("Permanent: %s, determinant: %s\n",
                 a.permanent, a.determinant);
    }
}


//  Title:  Determine if a string is collapsible

public class StringCollapsible {

    public static void main(String[] args) {
        for ( String s : new String[] {
              "",
              "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
              "..1111111111111111111111111111111111111111111111111111111111111117777888",
              "I never give 'em hell, I just tell the truth, and they think it's hell. ",
              "                                                    --- Harry S Truman  ",
              "122333444455555666666777777788888888999999999",
              "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
              "headmistressship"}) {
            String result = collapse(s);
            System.out.printf("old:  %2d <<<%s>>>%nnew:  %2d <<<%s>>>%n%n", s.length(), s, result.length(), result);
        }
    }

    private static String collapse(String in) {
        StringBuilder sb = new StringBuilder();
        for ( int i = 0 ; i < in.length() ; i++ ) {
            if ( i == 0 || in.charAt(i-1) != in.charAt(i) ) {
                sb.append(in.charAt(i));
            }
        }
        return sb.toString();
    }

}


print(‘Police     Sanitation         Fire’)
print(‘----------------------------------’)

L(police) (2..6).step(2)
   L(sanitation) 1..7
      L(fire) 1..7
         I police!=sanitation & sanitation!=fire & fire!=police & police+fire+sanitation==12
            print(police"\t\t"sanitation"\t\t"fire)


program Determinant_and_permanent;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TMatrix = TArray<TArray<Double>>;

function Minor(a: TMatrix; x, y: Integer): TMatrix;
begin
  var len := Length(a) - 1;
  SetLength(result, len, len);
  for var i := 0 to len - 1 do
  begin
    for var j := 0 to len - 1 do
    begin
      if ((i < x) and (j < y)) then
      begin
        result[i][j] := a[i][j];
      end
      else if ((i >= x) and (j < y)) then
      begin
        result[i][j] := a[i + 1][j];
      end
      else if ((i < x) and (j >= y)) then
      begin
        result[i][j] := a[i][j + 1];
      end
      else //i>x  and  j>y
        result[i][j] := a[i + 1][j + 1];
    end;
  end;
end;

function det(a: TMatrix): Double;
begin
  if length(a) = 1 then
    exit(a[0][0]);

  var sign := 1;
  result := 0.0;
  for var i := 0 to high(a) do
  begin
    result := result + sign * a[0][i] * det(minor(a, 0, i));
    sign := sign *  - 1;
  end;
end;

function perm(a: TMatrix): Double;
begin
  if Length(a) = 1 then
    exit(a[0][0]);
  Result := 0;
  for var i := 0 to high(a) do
    result := result + a[0][i] * perm(Minor(a, 0, i));
end;

function Readint(Min, Max: Integer; Prompt: string): Integer;
var
  val: string;
  vali: Integer;
begin
  Result := -1;
  repeat
    writeln(Prompt);
    Readln(val);
    if TryStrToInt(val, vali) then
      if (vali < Min) or (vali > Max) then
        writeln(vali, ' is out range [', Min, '...', Max, ']')
      else
        exit(vali)
    else
      writeln(val, ' is not a number valid');
  until false;
end;

function ReadDouble(Min, Max: double; Prompt: string): double;
var
  val: string;
  vali: double;
begin
  Result := -1;
  repeat
    writeln(Prompt);
    Readln(val);
    if TryStrToFloat(val, vali) then
      if (vali < Min) or (vali > Max) then
        writeln(vali, ' is out range [', Min, '...', Max, ']')
      else
        exit(vali)
    else
      writeln(val, ' is not a number valid');
  until false;
end;

procedure ShowMatrix(a: TMatrix);
begin
  var sz := length(a);
  for var i := 0 to sz - 1 do
  begin
    Write('[');
    for var j := 0 to sz - 1 do
      write(a[i][j]: 3: 2, ' ');
    Writeln(']');
  end;
end;

var
  a: TMatrix;
  sz: integer;

begin
  sz := Readint(1, 10, 'Enter with matrix size: ');
  SetLength(a, sz, sz);
  for var i := 0 to sz - 1 do
    for var j := 0 to sz - 1 do
    begin
      a[i][j] := ReadDouble(-1000, 1000, format('Enter a value of position (%d,%d):',
        [i, j]));
    end;

  writeln('Matrix defined: ');
  ShowMatrix(a);
  writeln(#10'Determinant: ', det(a): 3: 2);
  writeln(#10'Permanent: ', perm(a): 3: 2);
  readln;
end.


String.prototype.collapse = function() {
  let str = this;
  for (let i = 0; i < str.length; i++) {
    while (str[i] == str[i+1]) str = str.substr(0,i) + str.substr(i+1);
  }
  return str;
}

// testing
let strings = [
  '',
  '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ',
  '..1111111111111111111111111111111111111111111111111111111111111117777888',
  `I never give 'em hell, I just tell the truth, and they think it's hell. `,
  '                                                    --- Harry S Truman  '
];
for (let i = 0; i < strings.length; i++) {
  let str = strings[i], col = str.collapse();
  console.log(`«««${str}»»» (${str.length})`);
  console.log(`«««${col}»»» (${col.length})`);
}


# Input: an array
# Output: a stream
def uniq: foreach .[] as $x ({x:nan, y:.[0]}; {x:$x, y:.x}; select(.x != .y) | .x);

def collapse: explode | [uniq] | implode;


	org	100h
	lxi	h,obuf	; HL = output buffer
	mvi	b,2	; B = police
pol:	mvi	c,1	; C = sanitation
san:	mvi	d,1	; D = fire
fire:	mov	a,b	; Fire equal to police?
	cmp	d
	jz	next	; If so, invalid combination
	mov	a,c	; Fire equal to sanitation?
	cmp	d
	jz	next	; If so, invalid combination
	mov	a,b	; Total equal to 12?
	add	c
	add	d
	cpi	12
	jnz	next	; If not, invalid combination
	mov	a,b	; Combination is valid, add to output
	call	num
	mov	a,c
	call 	num
	mov	a,d
	call	num
	mvi	m,13	; Add a newline to the output
	inx	h
	mvi	m,10
	inx	h
next:	mvi	a,7	; Load 7 to compare to
	inr	d	; Next fire number
	cmp	d	; Reached the end?
	jnc	fire	; If not, next fire number
	inr	c	; Otherwise, next sanitation number
	cmp	c	; Reached the end?
	jnc	san	; If not, next sanitation number
	inr	b	; Increment police number twice
	inr	b	; (twice, because it must be even)
	cmp	b	; Reached the end?
	jnc	pol 	; If not, next police number
	mvi	m,'$'	; If so, we're done - add CP/M string terminator
	mvi	c,9	; Print the output string
	lxi	d,ohdr
	jmp	5
num:	adi	'0'	; Add number A and space to the output
	mov	m,a
	inx	h
	mvi	m,' '
	inx	h
	ret
ohdr:	db	'P S F',13,10
obuf:	equ	$	; Output buffer goes after program


	cpu	8086
	bits	16
	org	100h
section	.text
	mov	di,obuf		; Output buffer
	mov	bl,2		; BL = police
pol:	mov	cl,1		; CL = sanitation
san:	mov	dl,1		; DL = fire
fire:	cmp	bl,cl		; Police equal to sanitation?
	je	next		; Invalid combination
	cmp	bl,dl		; Police equal to fire?
	je	next		; Invalid combination
	cmp	cl,dl		; Sanitation equal to fire?
	je	next		; Invalid combination
	mov	al,bl		; Total equal to 12?
	add	al,cl
	add	al,dl
	cmp	al,12
	jne	next		; If not, invalid combination
	mov	al,bl		; Combination is valid, write the three numbers
	call	num
	mov	al,cl
	call 	num
	mov	al,dl
	call 	num
	mov	ax,0A0Dh	; And a newline
	stosw
next:	mov	al,7		; Load 7 to compare to
	inc	dx		; Increment fire number
	cmp	al,dl		; If 7 or less,
	jae	fire		; next fire number.
	inc	cx		; Otherwise, ncrement sanitation number
	cmp	al,cl		; If 7 or less,
	jae	san		; next sanitation number
	inc	bx		; Increment police number twice
	inc	bx		; (it must be even)
	cmp	al,bl		; If 7 or less,
	jae	pol		; next police number.
	mov	byte [di],'$'	; At the end, terminate the string
	mov	dx,ohdr		; Tell MS-DOS to print it
	mov	ah,9
	int	21h
	ret
num:	mov	ah,' '		; Space
	add	al,'0'		; Add number to output
	stosw			; Store number and space
	ret
section	.data
ohdr:	db	'P S F',13,10	; Header
obuf:	equ	$		; Place to write output


(lib 'list)
(lib 'matrix)

;; adapted from Racket
(define (permanent M)
    (let (( n (matrix-row-num M)))
    (for/sum ([σ (in-permutations n)])
        (for/product ([i n] [σi σ])
            (array-ref M i σi)))))

;; output
(define A (list->array '(1 2 3 4) 2 2))
(array-print A)
  1  2
  3  4
(determinant A) → -2
(permanent A) → 10

(define M (list->array (iota 25) 5 5))
(array-print M)
   0   1   2   3   4
   5   6   7   8   9
  10  11  12  13  14
  15  16  17  18  19
  20  21  22  23  24
(determinant M) → 0
(permanent M) → 6778800


const teststrings = [
    "",
    """"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln """,
    "..1111111111111111111111111111111111111111111111111111111111111117777888",
    """I never give 'em hell, I just tell the truth, and they think it's hell. """,
    "                                                    --- Harry S Truman  "]

function collapse(s)
    len = length(s)
    if len < 2
        return s, len, s, len
    end
    result = last = s[1]
    for c in s[2:end]
        if c != last
            last = c
            result *= c
        end
    end
    return s, len, result, length(result)
end

function testcollapse(arr)
    for s in arr
        (s1, len1, s2, len2) = collapse(s)
        println("«««$s1»»» (length $len1)\n    collapses to:\n«««$s2»»» (length $len2).\n")
    end
end

testcollapse(teststrings)


fun collapse(s: String): String {
    val cs = StringBuilder()
    var last: Char = 0.toChar()
    for (c in s) {
        if (c != last) {
            cs.append(c)
            last = c
        }
    }
    return cs.toString()
}

fun main() {
    val strings = arrayOf(
        "",
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                   ---  Harry S Truman  ",
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
        "headmistressship",
        "aardvark"
    )
    for (s in strings) {
        val c = collapse(s)
        println("original : length = ${s.length}, string = «««$s»»»")
        println("collapsed : length = ${c.length}, string = «««$c»»»")
        println()
    }
}


#!/bin/ksh

# Determine if a string is collapsible (repeated letters)

#	# Variables:
#
typeset -a strings
strings[0]=""
strings[1]='"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln'
strings[2]="..1111111111111111111111111111111111111111111111111111111111111117777888"
strings[3]="I never give 'em hell, I just tell the truth, and they think it's hell."
strings[4]="                                                    --- Harry S Truman"

typeset -a Guillemet=( "«««" "»»»" )

#	# Functions:
#
#	# Function _collapse(str) - return colapsed version of str
#
function _collapse {
	typeset _str ; _str="$1"
	typeset _i _buff ; integer _i

	for ((_i=1; _i<${#_str}; _i++)); do
		if [[ "${_str:$((_i-1)):1}" == "${_str:${_i}:1}" ]]; then
			continue
		else
			_buff+=${_str:$((_i-1)):1}
		fi
	done
	[[ "${_str:$((_i-1)):1}" != "${_str:${_i}:1}" ]] && _buff+=${_str:$((_i-1)):1}
	echo "${_buff}"
}

 ######
# main #
 ######
for ((i=0; i<${#strings[*]}; i++)); do
	str=$(_collapse "${strings[i]}")
	print ${#strings[i]} "${Guillemet[0]}${strings[i]}${Guillemet[1]}"
	print ${#str} "${Guillemet[0]}${str}${Guillemet[1]}\n"
done


function collapse(s)
    local ns = ""
    local last = nil
    for c in s:gmatch"." do
        if last then
            if last ~= c then
                ns = ns .. c
            end
            last = c
        else
            ns = ns .. c
            last = c
        end
    end
    return ns
end

function test(s)
    print("old: " .. s:len() .. " <<<" .. s .. ">>>")
    local a = collapse(s)
    print("new: " .. a:len() .. " <<<" .. a .. ">>>")
end

function main()
    test("")
    test("The better the 4-wheel drive, the further you'll be from help when ya get stuck!")
    test("headmistressship")
    test("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ")
    test("..1111111111111111111111111111111111111111111111111111111111111117777888")
    test("I never give 'em hell, I just tell the truth, and they think it's hell. ")
    test("                                                    --- Harry S Truman  ")
end

main()


PROC Main()
  BYTE p,s,f

  PrintE("P S F")
  FOR p=2 TO 6 STEP 2
  DO
    FOR s=1 TO 7
    DO
      FOR f=1 TO 7
      DO
        IF p#s AND p#f AND s#f AND p+s+f=12 THEN
          PrintF("%B %B %B%E",p,s,f)
        FI
      OD
    OD
  OD
RETURN


with Ada.Text_IO;

procedure Department_Numbers is
   use Ada.Text_IO;
begin
   Put_Line (" P S F");
   for Police in 2 .. 6 loop
      for Sanitation in 1 .. 7 loop
         for Fire in 1 .. 7 loop
            if
              Police mod 2 = 0                and
              Police + Sanitation + Fire = 12 and
              Sanitation /= Police            and
              Sanitation /= Fire              and
              Police     /= Fire
            then
               Put_Line (Police'Image & Sanitation'Image & Fire'Image);
            end if;
         end loop;
      end loop;
   end loop;
end Department_Numbers;


USING: fry kernel math.combinatorics math.matrices sequences ;

: permanent ( matrix -- x )
    dup square-matrix? [ "Matrix must be square." throw ] unless
    [ dim first <iota> ] keep
    '[ [ _ nth nth ] map-index product ] map-permutations sum ;


S" fsl-util.fs" REQUIRED
S" fsl/dynmem.seq" REQUIRED
[UNDEFINED] defines [IF] SYNONYM defines IS [THEN]
S" fsl/structs.seq" REQUIRED
S" fsl/lufact.seq" REQUIRED
S" fsl/dets.seq" REQUIRED
S" permute.fs" REQUIRED

VARIABLE the-mat
: add-perm ( p0 p1 p2 ... pn n s -- )
  DROP  \ sign
  1E
  1 DO
    the-mat @ SWAP 1- I 1- }} [email protected] F*
  LOOP
  DROP  \ Dummy element because we're using 1-based indexing
  F+ ;
: permanent ( len mat -- ) ( F: -- perm )
  the-mat !
  0E
  ['] add-perm perms ;

3 SET-PRECISION
2 2 float matrix m2{{
1e 2e  3e 4e  2 2 m2{{ }}fput
lumatrix lmat
3 3 float matrix m3{{
2e 9e 4e  7e 5e 3e  6e 1e 8e  3 3 m3{{ }}fput

lmat 2 lu-malloc
m2{{ lmat lufact
lmat det F. 2 m2{{ permanent F. CR
lmat lu-free

lmat 3 lu-malloc
m3{{ lmat lufact
lmat det F. 3 m3{{ permanent F. CR
lmat lu-free


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Sat May 18 23:25:42
!
!a=./F && make $a && $a < unixdict.txt
!f95 -Wall -ffree-form F.F -o F
! j example, determinant:    7.00000000
! j example, permanent:      5.00000000
! maxima, determinant:      -360.000000
! maxima, permanent:         900.000000
!
!Compilation finished at Sat May 18 23:25:43

!   NB. example computed by J
!   NB. fixed seed random matrix
!   _2+3 [email protected]$5
! 2 _1  1
!_1 _2  1
!_1 _1 _1
!
!   (-/ .*)_2+3 [email protected]$5  NB. determinant
!7
!   (+/ .*)_2+3 [email protected]$5  NB. permanent
!5

!maxima example
!a: matrix([2, 9, 4], [7, 5, 3], [6, 1, 8])$
!determinant(a);
!-360
!
!permanent(a);
!900

! compute permanent or determinant
program f
  implicit none
  real, dimension(3,3) :: j, m
  data j/ 2,-1, 1,-1,-2, 1,-1,-1,-1/
  data m/2, 9, 4, 7, 5, 3, 6, 1, 8/
  write(6,*) 'j example, determinant: ',det(j,3,-1)
  write(6,*) 'j example, permanent:   ',det(j,3,1)
  write(6,*) 'maxima, determinant:    ',det(m,3,-1)
  write(6,*) 'maxima, permanent:      ',det(m,3,1)

contains

  recursive function det(a,n,permanent) result(accumulation)
    ! setting permanent to 1 computes the permanent.
    ! setting permanent to -1 computes the determinant.
    real, dimension(n,n), intent(in) :: a
    integer, intent(in) :: n, permanent
    real, dimension(n-1, n-1) :: b
    real :: accumulation
    integer :: i, sgn
    if (n .eq. 1) then
      accumulation = a(1,1)
    else
      accumulation = 0
      sgn = 1
      do i=1, n
        b(:, :(i-1)) = a(2:, :i-1)
        b(:, i:) = a(2:, i+1:)
        accumulation = accumulation + sgn * a(1, i) * det(b, n-1, permanent)
        sgn = sgn * permanent
      enddo
    endif
  end function det

end program f


ClearAll[StringCollapse]
StringCollapse[s_String] := FixedPoint[StringReplace[y_ ~~ y_ :> y], s]
strings = {"",
"\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
"..1111111111111111111111111111111111111111111111111111111111111117777888",
"I never give 'em hell, I just tell the truth, and they think it's hell. ",
"                                                    --- Harry S Truman  "};
Do[
 Print["«««" <> s <> "»»»"];
 Print["Length = ", StringLength[s]];
 Print["«««" <> StringCollapse[s] <> "»»»"];
 Print["Length = ", StringLength[StringCollapse[s]]]
 ,
 {s, strings}
 ]


function r = collapse(s)
  ix=find((s(1:end-1)==s(2:end))+1;
  r=s;
  r(ix)=[];

  fprintf(1,'Input:  <<<%s>>>  length: %d\n',s,length(s));
  fprintf(1,'Output: <<<%s>>>  length: %d\n',r,length(r));
  fprintf(1,'Character to be squeezed: "%s"\n',c);

end

collapse('', ' ')
collapse('║╚═══════════════════════════════════════════════════════════════════════╗', '-')
collapse('║"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ║', '7')
collapse('║..1111111111111111111111111111111111111111111111111111111111111117777888║', '.')
collapse('║I never give ''em hell, I just tell the truth, and they think it''s hell. ║', '.')
collapse('║                                                    --- Harry S Truman  ║', '.')
collapse('║                                                    --- Harry S Truman  ║', '-')
collapse('║                                                    --- Harry S Truman  ║', 'r')


MODULE StrCollapse;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
FROM Strings IMPORT Length;

(* Collapse a string *)
PROCEDURE Collapse(in: ARRAY OF CHAR; VAR out: ARRAY OF CHAR);
    VAR i, o: CARDINAL;
BEGIN
    i := 0;
    o := 0;
    WHILE (i < HIGH(in)) AND (in[i] # CHR(0)) DO
        IF (o = 0) OR (out[o-1] # in[i]) THEN
            out[o] := in[i];
            INC(o);
        END;
        INC(i);
    END;
    out[o] := CHR(0);
END Collapse;

(* Display a string and collapse it as stated in the task *)
PROCEDURE Task(s: ARRAY OF CHAR);
    VAR buf: ARRAY [0..127] OF CHAR;
    PROCEDURE LengthAndBrackets(s: ARRAY OF CHAR);
    BEGIN
        WriteCard(Length(s), 2);
        WriteString(" <<<");
        WriteString(s);
        WriteString(">>>");
        WriteLn();
    END LengthAndBrackets;
BEGIN
    LengthAndBrackets(s);
    Collapse(s, buf);
    LengthAndBrackets(buf);
    WriteLn();
END Task;

BEGIN
    Task("");
    Task('"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ');
    Task("..1111111111111111111111111111111111111111111111111111111111111117777888");
    Task("I never give 'em hell, I just tell the truth, and they think it's hell. ");
    Task("                                                    --- Harry S Truman  ");
END StrCollapse.


BEGIN
    # show possible department number allocations for police, sanitation and fire departments #
    # the police department number must be even, all department numbers in the range 1 .. 7   #
    # the sum of the department numbers must be 12                                            #
    INT max department number =  7;
    INT department sum        = 12;
    print( ( "police sanitation fire", newline ) );
    FOR police FROM 2 BY 2 TO max department number DO
        FOR sanitation TO max department number DO
            IF sanitation /= police THEN
                INT fire = ( department sum - police ) - sanitation;
                IF  fire > 0 AND fire <= max department number
                AND fire /= sanitation
                AND fire /= police
                THEN
                    print( ( whole( police,      -6 )
                           , whole( sanitation, -11 )
                           , whole( fire,        -5 )
                           , newline
                           )
                         )
                FI
            FI
        OD
    OD
END


begin
    % show possible department number allocations for police, sanitation and fire departments %
    % the police department number must be even, all department numbers in the range 1 .. 7   %
    % the sum of the department numbers must be 12                                            %
    integer MAX_DEPARTMENT_NUMBER, DEPARTMENT_SUM;
    MAX_DEPARTMENT_NUMBER :=  7;
    DEPARTMENT_SUM        := 12;
    write( "police sanitation fire" );
    for police := 2 step 2  until MAX_DEPARTMENT_NUMBER do begin
        for sanitation := 1 until MAX_DEPARTMENT_NUMBER do begin
            IF sanitation not = police then begin
                integer fire;
                fire := ( DEPARTMENT_SUM - police ) - sanitation;
                if  fire > 0 and fire <= MAX_DEPARTMENT_NUMBER and fire not = sanitation and fire not = police then begin
                    write( s_w := 0, i_w := 6, police, i_w := 11, sanitation, i_w := 5, fire )
                end if_valid_combination
            end if_sanitation_ne_police
        end for_sanitation
    end for_police
end.


sub make_S( M() as double, S() as double, i as uinteger, j as uinteger )
    'removes row j, column i from the matrix, stores result in S()
    dim as uinteger ii, jj, size=ubound(M), ix, jx
    for ii = 1 to size-1
        if ii<i then ix = ii else ix = ii + 1
        for jj = 1 to size-1
            if jj<j then jx = jj else jx = jj + 1
            S(ii, jj) = M(ix, jx)
        next jj
    next ii
end sub

function deperminant( M() as double, det as boolean ) as double
    'calculates the determinant or the permanent of a square matrix M
    'det = true  for determinant, false for permanent
    'assumes a square matrix
    dim as uinteger size = ubound(M,1), i
    dim as integer sign
    dim as double S(1 to size-1, 1 to size-1)
    dim as double ret = 0.0, inc
    if size = 1 then return M(1,1)                                       'matrices of size < 3 are easy to calculate
    if size = 2 and det then return M(1,1)*M(2,2) - M(1,2)*M(2,1)
    if size = 2         then return M(1,1)*M(2,2) + M(1,2)*M(2,1)
    for i = 1 to size
            if det then sign = (-1)^(i+1) else sign = 1                 'this bit is what distinguishes a determinant from a permanent
            make_S( M(), S(), i, 1 )
            inc = sign*M(i,1)*deperminant( S(), det )                   'recursively call on submatrices
            ret += inc
    next i
    return ret
end function

dim as double A(1 to 2, 1 to 2) = {{1,2},{3,4}}

dim as double B(1 to 4, 1 to 4) = {_
    {1,2,3,4}, {4,5,6,7}, {7,8,9,10}, {10,11,12,13} }

dim as double C(1 to 5, 1 to 5) = {_
     {  0,  1,  2,  3,  4 },_
     {  5,  6,  7,  8,  9 },_
     { 10, 11, 12, 13, 14 },_
     { 15, 16, 17, 18, 19 },_
     { 20, 21, 22, 23, 24 } }

print deperminant( A(), true ), deperminant( A(), false )
print deperminant( B(), true ), deperminant( B(), false )
print deperminant( C(), true ), deperminant( C(), false )


fs:remove_file(‘output.txt’)
fs:remove_dir(‘docs’)
fs:remove_file(‘/output.txt’)
fs:remove_dir(‘/docs’)


to-report split [ string ]
  ;; utility reporter to split a string into a list
  report n-values length string [ [ n ] -> item n string ]
end

to-report collapse [ string ]
  ;; reporter that actually does the collapse function
  ifelse ( string = "" )
  [ report "" ]
  [ report reduce [ [ a b ] -> (word a ifelse-value last a != b [ b ] [ "" ] ) ] split string ]
end

to-report format [ string ]
  ;; reporter to format the output as required
  report ( word "<<<" string ">>> " length string )
end

to demo-collapse [ string ]
  ;; procedure to display the required output
  output-print format string
  output-print format collapse string
end

to demo
  ;; procedure to perform the test cases
  foreach
  [ ""
    "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
    "..1111111111111111111111111111111111111111111111111111111111111117777888"
    "I never give 'em hell, I just tell the truth, and they think it's hell. "
    "                                                    --- Harry S Truman  "
  ]
  demo-collapse
end


import unicode, strformat

proc collapse(s: string) =
  let original = s.toRunes
  echo fmt"Original:  length = {original.len}, string = «««{s}»»»"
  var previous = Rune(0)
  var collapsed: seq[Rune]
  for rune in original:
    if rune != previous:
      collapsed.add(rune)
      previous = rune
  echo fmt"Collapsed: length = {collapsed.len}, string = «««{collapsed}»»»"
  echo ""

const Strings = ["",
        "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ",
        "..1111111111111111111111111111111111111111111111111111111111111117777888",
        "I never give 'em hell, I just tell the truth, and they think it's hell. ",
        "                                                   ---  Harry S Truman  ",
        "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
        "headmistressship",
        "aardvark",
        "😍😀🙌💃😍😍😍🙌",]

for s in Strings:
  s.collapse()


use strict;
use warnings;
use utf8;
binmode STDOUT, ":utf8";

my @lines = split "\n", <<~'STRINGS';

    "If I were two-faced, would I be wearing this one?" --- Abraham Lincoln
    ..1111111111111111111111111111111111111111111111111111111111111117777888
    I never give 'em hell, I just tell the truth, and they think it's hell.
                                                        --- Harry S Truman
    The American people have a right to know if their president is a crook.
                                                        --- Richard Nixon
    AАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑ
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    STRINGS

for (@lines) {
    my $squish = s/(.)\1+/$1/gr;
    printf "\nLength: %2d <<<%s>>>\nCollapsible: %s\nLength: %2d <<<%s>>>\n",
      length($_), $_, $_ ne $squish ? 'True' : 'False', length($squish), $squish
}


on run
    script
        on |λ|(x)
            script
                on |λ|(y)
                    script
                        on |λ|(z)
                            if y ≠ z and 1 ≤ z and z ≤ 7 then
                                {{x, y, z} as string}
                            else
                                {}
                            end if
                        end |λ|
                    end script

                    concatMap(result, {12 - (x + y)}) --Z
                end |λ|
            end script

            concatMap(result, {1, 2, 3, 4, 5, 6, 7}) --Y
        end |λ|
    end script

    unlines(concatMap(result, {2, 4, 6})) --X
end run

-- GENERIC FUNCTIONS ----------------------------------------------------------

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lst to {}
    set lng to length of xs
    tell mReturn(f)
        repeat with i from 1 to lng
            set lst to (lst & |λ|(contents of item i of xs, i, xs))
        end repeat
    end tell
    return lst
end concatMap

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- unlines :: [String] -> String
on unlines(xs)
    intercalate(linefeed, xs)
end unlines


def sgn( p ) = product( (if s(0) < s(1) xor i(0) < i(1) then -1 else 1) | (s, i) <- p.combinations(2).zip( (0:p.length()).combinations(2) ) )

def perm( m ) = sum( product(m(i, sigma(i)) | i <- 0:m.length()) | sigma <- (0:m.length()).permutations() )

def det( m ) = sum( sgn(sigma)*product(m(i, sigma(i)) | i <- 0:m.length()) | sigma <- (0:m.length()).permutations() )


"input.txt" f:rm drop
"/input.txt" f:rm drop
"docs" f:rmdir drop
"/docs" f:rmdir drop


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

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

.equ UNLINK, 35

.equ AT_REMOVEDIR, 0x200           // flag for delete directory

/******************************************/
/* Initialized data                       */
/******************************************/
.data
szMessDeleteDirOk:   .asciz "Delete directory Ok.\n"
szMessErrDeleteDir:  .asciz "Unable delete dir. \n"
szMessDeleteFileOk:  .asciz "Delete file Ok.\n"
szMessErrDeleteFile: .asciz "Unable delete file. \n"

szNameDir:          .asciz "Docs"
szNameFile:         .asciz "input.txt"

/******************************************/
/* UnInitialized data                     */
/******************************************/
.bss
/******************************************/
/*  code section                          */
/******************************************/
.text
.global main
main:                           // entry of program
    // delete file
    mov x0,AT_FDCWD             // current directory
    ldr x1,qAdrszNameFile       // file name
    mov x8,UNLINK               // code call system delete file
    svc 0                       // call systeme
    cmp x0,0                    // error ?
    blt 99f
    ldr x0,qAdrszMessDeleteFileOk // delete file OK
    bl affichageMess
                               // delete directory
    mov x0,AT_FDCWD            // current directory
    ldr x1,qAdrszNameDir       // directory name
    mov x2,AT_REMOVEDIR
    mov x8,UNLINK              // code call system delete directory
    svc 0                      // call systeme
    cmp x0,0                   // error ?
    blt 98f
    ldr x0,qAdrszMessDeleteDirOk // display  message ok directory
    bl affichageMess
                               // end Ok
    b 100f

98:                            // display error message delete directory
    ldr x0,qAdrszMessErrDeleteDir
    bl affichageMess
    b 100f
99:                            // display error message delete file
    ldr x0,qAdrszMessErrDeleteFile
    bl affichageMess
    b 100f
100:                           // standard end of the program
    mov x0,0                   // return code
    mov x8,EXIT                // request to exit program
    svc 0                      // perform the system call
qAdrszMessDeleteDirOk:        .quad szMessDeleteDirOk
qAdrszMessErrDeleteDir:       .quad szMessErrDeleteDir
qAdrszMessDeleteFileOk:       .quad szMessDeleteFileOk
qAdrszNameFile:               .quad szNameFile
qAdrszMessErrDeleteFile:      .quad szMessErrDeleteFile
qAdrszNameDir:                .quad szNameDir
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


PROC Dir(CHAR ARRAY filter)
  CHAR ARRAY line(255)
  BYTE dev=[1]

  Close(dev)
  Open(dev,filter,6)
  DO
    InputSD(dev,line)
    PrintE(line)
    IF line(0)=0 THEN
      EXIT
    FI
  OD
  Close(dev)
RETURN

PROC DeleteFile(CHAR ARRAY fname)
  BYTE dev=[1]

  Close(dev)
  Xio(dev,0,33,0,0,fname)
RETURN

PROC Main()
  CHAR ARRAY filter="D:*.*", fname="D:INPUT.TXT"

  PrintF("Dir ""%S""%E",filter)
  Dir(filter)

  PrintF("Delete file ""%S""%E%E",fname)
  DeleteFile(fname)

  PrintF("Dir ""%S""%E",filter)
  Dir(filter)
RETURN


with Ada.Directories;  use Ada.Directories;


remove ("input.txt")
remove ("/input.txt")
remove ("docs")
remove ("/docs")


remove("input.txt");
remove("/input.txt");
remove("docs");
remove("/docs");


with javascript_semantics
constant tests = {"",
                  `"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln `,
                  "..1111111111111111111111111111111111111111111111111111111111111117777888",
                  "I never give 'em hell, I just tell the truth, and they think it's hell. ",
                  "                                                    --- Harry S Truman  "},
         fmt = """
length %2d  input: <<<%s>>>
length %2d output: <<<%s>>>
"""
for i=1 to length(tests) do
    string ti = tests[i], ci = unique(ti, "PRESORTED")
    printf(1,fmt,{length(ti),ti,length(ci),ci})
end for

function collapsible(string t)
--  sequence utf32 = utf8_to_utf32(t) -- maybe
--  for i=2 to length(utf32) do       --  """
--      if utf32[i]=utf32[i-1] then   --  """
    for i=2 to length(t) do
        if t[i]=t[i-1] then
            return true
        end if
    end for
    return false
end function

puts(1,"\nAs predicate: ")
for i=1 to length(tests) do
    printf(1,"%t ",collapsible(tests[i]))
end for
puts(1,"\n")


<?php

function collapseString($string) {
    $previousChar = null;
    $collapse = '';
    $charArray = preg_split('//u', $string, -1, PREG_SPLIT_NO_EMPTY);
    for ($i = 0 ; $i < count($charArray) ; $i++) {
        $currentChar = $charArray[$i];
        if ($previousChar !== $currentChar) {
            $collapse .= $charArray[$i];
        }
        $previousChar = $currentChar;
    }
    return $collapse;
}

function isCollapsible($string) {
    return ($string !== collapseString($string));
}

$strings = array(
    '',
    'another non colapsing string',
    '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ',
    '..1111111111111111111111111111111111111111111111111111111111111117777888',
    "I never give 'em hell, I just tell the truth, and they think it's hell. ",
    '                                                    --- Harry S Truman  ',
    '0112223333444445555556666666777777778888888889999999999',
    "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
    'headmistressship',
    "😍😀🙌💃😍😍😍🙌",
);

foreach ($strings as $original) {
    echo 'Original : <<<', $original, '>>> (len=', mb_strlen($original), ')', PHP_EOL;
    if (isCollapsible($original)) {
        $collapse = collapseString($original);
        echo 'Collapse : <<<', $collapse, '>>> (len=', mb_strlen($collapse), ')', PHP_EOL, PHP_EOL;
    } else {
        echo 'Collapse : string is not collapsing...', PHP_EOL, PHP_EOL;
    }
}


loop 1..7 'x [
    loop 1..7 'y [
        loop 1..7 'z [
            if all? @[
                even? x
                12 = sum @[x y z]
                3 = size unique @[x y z]
            ] -> print [x y z]
        ]
    ]
]


write("--police--  --sanitation--  --fire--");

for(int police = 2; police < 6; police += 2) {
  for(int sanitation = 1; sanitation < 7; ++sanitation) {
    for(int fire = 1; fire < 7; ++fire) {
      if(police != sanitation && sanitation != fire && fire != police && police+fire+sanitation == 12){
        write("    ", police, suffix=none);
        write("             ", sanitation, suffix=none);
        write("            ", fire);
      }
    }
  }
}


package main

import (
    "fmt"
    "permute"
)

func determinant(m [][]float64) (d float64) {
    p := make([]int, len(m))
    for i := range p {
        p[i] = i
    }
    it := permute.Iter(p)
    for s := it(); s != 0; s = it() {
        pr := 1.
        for i, σ := range p {
            pr *= m[i][σ]
        }
        d += float64(s) * pr
    }
    return
}

func permanent(m [][]float64) (d float64) {
    p := make([]int, len(m))
    for i := range p {
        p[i] = i
    }
    it := permute.Iter(p)
    for s := it(); s != 0; s = it() {
        pr := 1.
        for i, σ := range p {
            pr *= m[i][σ]
        }
        d += pr
    }
    return
}

var m2 = [][]float64{
    {1, 2},
    {3, 4}}

var m3 = [][]float64{
    {2, 9, 4},
    {7, 5, 3},
    {6, 1, 8}}

func main() {
    fmt.Println(determinant(m2), permanent(m2))
    fmt.Println(determinant(m3), permanent(m3))
}


main:(
  PROC remove = (STRING file name)INT:
  BEGIN
    FILE actual file;
    INT errno = open(actual file, file name, stand back channel);
    IF errno NE 0 THEN stop remove FI;
    scratch(actual file); # detach the book and burn it #
    errno
  EXIT
  stop remove:
      errno
  END;
  remove("input.txt");
  remove("/input.txt");
  remove("docs");
  remove("/docs")
)


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

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

.equ RMDIR,  0x28
.equ UNLINK, 0xA
/******************************************/
/* Initialized data                       */
/******************************************/
.data
szMessDeleteDirOk:   .asciz "Delete directory Ok.\n"
szMessErrDeleteDir:  .asciz "Unable delete dir. \n"
szMessDeleteFileOk:  .asciz "Delete file Ok.\n"
szMessErrDeleteFile: .asciz "Unable delete file. \n"

szNameDir:          .asciz "Docs"
szNameFile:         .asciz "input.txt"

/******************************************/
/* UnInitialized data                     */
/******************************************/
.bss
/******************************************/
/*  code section                          */
/******************************************/
.text
.global main
main:                           @ entry of program
    @ delete file
    ldr r0,iAdrszNameFile       @ file name

    mov r7,#UNLINK              @ code call system delete file
    svc #0                      @ call systeme
    cmp r0,#0                   @ error ?
    blt 99f
    ldr r0,iAdrszMessDeleteFileOk @ delete file OK
    bl affichageMess
                                @ delete directory
    ldr r0,iAdrszNameDir        @ directory name
    mov r7, #RMDIR              @ code call system delete directory
    swi #0                      @ call systeme
    cmp r0,#0                   @ error ?
    blt 98f
    ldr r0,iAdrszMessDeleteDirOk @ display  message ok directory
    bl affichageMess
                                @ end Ok
    b 100f

98:                             @ display error message delete directory
    ldr r0,iAdrszMessErrDeleteDir
    bl affichageMess
    b 100f
99:                             @ display error message delete file
    ldr r0,iAdrszMessErrDeleteFile
    bl affichageMess
    b 100f
100:                            @ standard end of the program
    mov r0, #0                  @ return code
    mov r7, #EXIT               @ request to exit program
    swi 0                       @ perform the system call
iAdrszMessDeleteDirOk:        .int szMessDeleteDirOk
iAdrszMessErrDeleteDir:       .int szMessErrDeleteDir
iAdrszMessDeleteFileOk:       .int szMessDeleteFileOk
iAdrszNameFile:               .int szNameFile
iAdrszMessErrDeleteFile:      .int szMessErrDeleteFile
iAdrszNameDir:                .int szNameDir
/***************************************************/
/*      ROUTINES INCLUDE                 */
/***************************************************/
.include "../affichage.inc"


100H:
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9, S); END PRINT;

/* PRINT NUMBER */
PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (6) BYTE INITIAL ('.....$');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P - 1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$NUMBER;

/* STRING LENGTH */
STR$LEN: PROCEDURE (STR) ADDRESS;
    DECLARE (STR, I) ADDRESS, S BASED STR BYTE;
    I = 0;
    DO WHILE S(I) <> '$';
        I = I + 1;
    END;
    RETURN I;
END STR$LEN;

/* COLLAPSE */
COLLAPSE: PROCEDURE (IN, OUT);
    DECLARE (IN, OUT) ADDRESS, (I BASED IN, O BASED OUT, C) BYTE;
    C = I;
    DO WHILE C <> '$';
        IN = IN + 1;
        IF I <> C THEN DO;
            O = C;
            OUT = OUT + 1;
            C = I;
        END;
    END;
    O = '$';
END COLLAPSE;

/* PRINT STRING AND LENGTH WITH BRACKETS */
PRINT$BRACKETS: PROCEDURE (S);
    DECLARE S ADDRESS;
    CALL PRINT$NUMBER(STR$LEN(S));
    CALL PRINT(.' <<<$');
    CALL PRINT(S);
    CALL PRINT(.('>>>',13,10,'$'));
END PRINT$BRACKETS;

/* GIVEN A STRING, PRINT IT AND ITS COLLAPSED FORM */
SHOW: PROCEDURE (S);
    DECLARE S ADDRESS, BUFFER (256) BYTE;
    CALL COLLAPSE(S, .BUFFER);
    CALL PRINT$BRACKETS(S);
    CALL PRINT$BRACKETS(.BUFFER);
    CALL PRINT(.(13,10,'$'));
END SHOW;

/* STRINGS FROM THE TASK */
DECLARE X (5) ADDRESS;
X(0)=.'$';
X(1)=.('''IF I WERE TWO-FACED, WOULD I BE WEARING ',
       'THIS ONE.'' --- ABRAHAM LINCOLN $');
X(2)=.('..111111111111111111111111111111111111111',
       '1111111111111111111111117777888$');
X(3)=.('I NEVER GIVE ''EM HELL, I JUST TELL THE TR',
       'UTH, AND THEY THINK IT''S HELL. $');
X(4)=.('                                         ',
       '            --- HARRY S TRUMAN $');

DECLARE I BYTE;
DO I=0 TO LAST(X);
    CALL SHOW(X(I));
END;
CALL EXIT;
EOF


collapse_( [], [] ).
collapse_( [A], [A] ).
collapse_( [A,A|T], R ) :- collapse_( [A|T], R ).
collapse_( [A,B|T], [A|R] ) :- dif( A, B ), collapse_( [B|T], R ).

collapse( Str, Collapsed ) :-
    string_chars( Str, Chars ),
    collapse_( Chars, Result ),
    string_chars( Collapsed, Result ).


EnableExplicit
DataSection
  STR1:
  Data.s ""
  STR2:
  Data.s "'If I were two-faced, would I be wearing this one?' --- Abraham Lincoln "
  STR3:
  Data.s "..1111111111111111111111111111111111111111111111111111111111111117777888"
  STR4:
  Data.s "I never give 'em hell, I just tell the truth, and they think it's hell. "
  STR5:
  Data.s "                                                    --- Harry S Truman  "
EndDataSection

Procedure.s collapse(txt$)
  Define *c.Character=@txt$, last.c=0, result$
  While *c\c
    If *c\c<>last
      result$+Chr(*c\c)
      last=*c\c
    EndIf
    *c+SizeOf(Character)
  Wend
  ProcedureReturn result$
EndProcedure

OpenConsole("")
Define *p_data=?STR1, buf$
While *p_data<=?STR4+StringByteLength(PeekS(?STR4))+2
  buf$=PeekS(*p_data)
  PrintN("Before collapse: «««"+buf$+"»»» (length: "+Str(Len(buf$))+")")
  buf$=collapse(PeekS(*p_data))
  PrintN("After  collapse: «««"+buf$+~"»»» (length: "+Str(Len(buf$))+~")\n")
  *p_data+StringByteLength(PeekS(*p_data))+2
Wend
Input()


perm(elements, n, opt:="", Delim:="", str:="", res:="", j:=0, dup:="") {
	res := IsObject(res) ? res : [], dup := IsObject(dup) ? dup : []
	if (n > j)
		Loop, parse, elements, % Delim
			res := !(InStr(str, A_LoopField) && !(InStr(opt, "rep"))) ? perm(elements, n, opt, Delim, trim(str Delim A_LoopField, Delim), res, j+1, dup) : res
	else if !(dup[x := perm_sort(str, Delim)] && (InStr(opt, "comb")))
		dup[x] := 1, res.Insert(str)
	return res, j++
}

perm_sort(str, Delim){
	Loop, Parse, str, % Delim
		res .= A_LoopField "`n"
	Sort, res, D`n
	return StrReplace(res, "`n", Delim)
}


# syntax: GAWK -f DEPARTMENT_NUMBERS.AWK
BEGIN {
    print(" # FD PD SD")
    for (fire=1; fire<=7; fire++) {
      for (police=1; police<=7; police++) {
        for (sanitation=1; sanitation<=7; sanitation++) {
          if (rules() ~ /^1+$/) {
            printf("%2d %2d %2d %2d\n",++count,fire,police,sanitation)
          }
        }
      }
    }
    exit(0)
}
function rules(  stmt1,stmt2,stmt3) {
    stmt1 = fire != police && fire != sanitation && police != sanitation
    stmt2 = fire + police + sanitation == 12
    stmt3 = police % 2 == 0
    return(stmt1 stmt2 stmt3)
}


sPermutations :: [a] -> [([a], Int)]
sPermutations = flip zip (cycle [1, -1]) . foldl aux [[]]
  where
    aux items x = do
      (f, item) <- zip (cycle [reverse, id]) items
      f (insertEv x item)
    insertEv x [] = [[x]]
    insertEv x l@(y:ys) = (x : l) : ((y :) <$>) (insertEv x ys)

elemPos :: [[a]] -> Int -> Int -> a
elemPos ms i j = (ms !! i) !! j

prod
  :: Num a
  => ([[a]] -> Int -> Int -> a) -> [[a]] -> [Int] -> a
prod f ms = product . zipWith (f ms) [0 ..]

sDeterminant
  :: Num a
  => ([[a]] -> Int -> Int -> a) -> [[a]] -> [([Int], Int)] -> a
sDeterminant f ms = sum . fmap (\(is, s) -> fromIntegral s * prod f ms is)

determinant
  :: Num a
  => [[a]] -> a
determinant ms =
  sDeterminant elemPos ms . sPermutations $ [0 .. pred . length $ ms]

permanent
  :: Num a
  => [[a]] -> a
permanent ms =
  sum . fmap (prod elemPos ms . fst) . sPermutations $ [0 .. pred . length $ ms]

-- TEST -----------------------------------------------------------------------
result
  :: (Num a, Show a)
  => [[a]] -> String
result ms =
  unlines
    [ "Matrix:"
    , unlines (show <$> ms)
    , "Determinant:"
    , show (determinant ms)
    , "Permanent:"
    , show (permanent ms)
    ]

main :: IO ()
main =
  mapM_
    (putStrLn . result)
    [ [[5]]
    , [[1, 0, 0], [0, 1, 0], [0, 0, 1]]
    , [[0, 0, 1], [0, 1, 0], [1, 0, 0]]
    , [[4, 3], [2, 5]]
    , [[2, 5], [4, 3]]
    , [[4, 4], [2, 2]]
    ]


file: "input.txt"
docs: "docs"

delete file
delete.directory file

delete join.path ["/" file]
delete.directory join.path ["/" docs]


FileDelete, input.txt
FileDelete, \input.txt
FileRemoveDir, docs, 1
FileRemoveDir, \docs, 1


system("rm input.txt")
system("rm /input.txt")
system("rm -rf docs")
system("rm -rf /docs")


KILL "INPUT.TXT"
KILL "C:\INPUT.TXT"
SHELL "RMDIR /S /Q DIR"
SHELL "RMDIR /S /Q C:\DIR"


from itertools import groupby

def collapser(txt):
    return ''.join(item for item, grp in groupby(txt))

if __name__ == '__main__':
    strings = [
            "",
            '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ',
            "..1111111111111111111111111111111111111111111111111111111111111117777888",
            "I never give 'em hell, I just tell the truth, and they think it's hell. ",
            "                                                   ---  Harry S Truman  ",
            "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
            "headmistressship",
            "aardvark",
            "😍😀🙌💃😍😍😍🙌",
            ]
    for txt in strings:
        this = "Original"
        print(f"\n{this:14} Size: {len(txt)} «««{txt}»»»" )
        this = "Collapsed"
        sqz = collapser(txt)
        print(f"{this:>14} Size: {len(sqz)} «««{sqz}»»»" )


  [ false -1 rot
    witheach
      [ 2dup = iff
          [ drop dip not
            conclude ]
        else nip ]
    drop ]                       is collapsible ( $ --> b )

  [ [] -1 rot
    witheach
      [ 2dup = iff drop
        else
          [ nip dup dip join ] ]
    drop ]                       is collapse    ( $ --> $ )

  [ dup collapsible iff
      [ dup collapse
        swap 2 ]
    else
      [ say "(Not collapsible.)" cr
        1 ]
    times
      [ say "<<<"
        dup echo$
        say ">>>" cr
        say "   Length: "
        size echo
        say " characters" cr cr ]
    cr ]                         is task     ( $ -->   )

$ "" task
$ '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ' task
$ "..1111111111111111111111111111111111111111111111111111111111111117777888" task
$ "I never give 'em hell, I just tell the truth, and they think it's hell. " task
$ "                                                    --- Harry S Truman  " task


collapse_string <- function(string){

    str_iterable <- strsplit(string, "")[[1]]

    message(paste0("Original String: ", "<<<", string, ">>>\n",
                   "Length: ", length(str_iterable)))

    detect <- rep(TRUE, length(str_iterable))

    for(i in 2:length(str_iterable)){

      if(length(str_iterable)==0) break

      if(str_iterable[i] == str_iterable[i-1])

        detect[i] <- FALSE
    }

    collapsed_string <- paste(str_iterable[detect],collapse = "")

    message(paste0("Collapsed string: ", "<<<",collapsed_string, ">>>\n",
                   "Length: ", length(str_iterable[detect])), "\n")

}

test_strings <- c(
  "",
  "'If I were two-faced, would I be wearing this one?' --- Abraham Lincoln ",
  "..1111111111111111111111111111111111111111111111111111111111111117777888",
  "I never give 'em hell, I just tell the truth, and they think it's hell. ",
  "                                                    --- Harry S Truman  ",
  "The better the 4-wheel drive, the further you'll be from help when ya get stuck!",
  "headmistressship",
  "aardvark",
  "Ciao Mamma, guarda come mi diverto!!"
)

for(test in test_strings){
  collapse_string(test)
}


#lang racket

(define (collapse text)
  (if (< (string-length text) 2)
      text
      (string-append
       (if (equal? (substring text 0 1) (substring text 1 2))
           "" (substring text 0 1))
       (collapse (substring text 1)))))

; Test cases
(define tcs
  '(""
    "\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln "
    "..1111111111111111111111111111111111111111111111111111111111111117777888"
    "I never give 'em hell, I just tell the truth, and they think it's hell. "
    "                                                   ---  Harry S Truman  "
    "The better the 4-wheel drive, the further you'll be from help when ya get stuck!"
    "headmistressship"
    "aardvark"
    "😍😀🙌💃😍😍😍🙌"))

(for ([text tcs])
  (let ([collapsed (collapse text)])
    (display (format "Original  (size ~a): «««~a»»»\nCollapsed (size ~a): «««~a»»»\n\n"
                     (string-length text) text
                     (string-length collapsed) collapsed))))


get "libhdr"

let start() be
    for p=2 to 6 by 2
        for s=1 to 7
            for f=1 to 7
                if p~=s & s~=f & p~=f & p+s+f=12 then
                    writef("%N %N %N*N", p, s, f)


print "--police--  --sanitation--  --fire--"

for police = 2 to 7 step 2
    for fire = 1 to 7
        if fire = police then continue for
        sanitation = 12 - police - fire
        if sanitation = fire or sanitation = police then continue for
        if sanitation >= 1 and sanitation <= 7 then
            print rjust(police, 6); rjust(fire, 13); rjust(sanitation, 12)
        end if
    next fire
next police


#include<stdio.h>

int main()
{
	int police,sanitation,fire;

	printf("Police     Sanitation         Fire\n");
	printf("----------------------------------");

	for(police=2;police<=6;police+=2){
		for(sanitation=1;sanitation<=7;sanitation++){
			for(fire=1;fire<=7;fire++){
				if(police!=sanitation && sanitation!=fire && fire!=police && police+fire+sanitation==12){
					printf("\n%d\t\t%d\t\t%d",police,sanitation,fire);
				}
			}
		}
	}

	return 0;
}