Determine if a string is collapsible: Difference between revisions

m
Move PL/M to the right spot (oops)
(Add PL/M)
m (Move PL/M to the right spot (oops))
Line 1,880:
Collapsible: True
Length: 1 <<<A>>></pre>
 
=={{header|PL/M}}==
 
Because of the limited character set supported by the PL/M-80 compiler,
uppercase letters have been substituted for lowercase letters,
the question mark for the period,
and the single quotation mark for the double quotation mark.
This has no other effect on the output.
While it would be possible to write the ASCII values as numbers, this would make the code less clear.
The <code>COLLAPSE</code> procedure compares bytes and would be fine with any 8-bit input.
 
<lang plm>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
</lang>
{{out}}
<pre>0 <<<>>>
0 <<<>>>
 
72 <<<'IF I WERE TWO-FACED, WOULD I BE WEARING THIS ONE.' --- ABRAHAM LINCOLN >>>
70 <<<'IF I WERE TWO-FACED, WOULD I BE WEARING THIS ONE.' - ABRAHAM LINCOLN >>>
 
72 <<<..1111111111111111111111111111111111111111111111111111111111111117777888>>>
4 <<<.178>>>
 
72 <<<I NEVER GIVE 'EM HELL, I JUST TELL THE TRUTH, AND THEY THINK IT'S HELL. >>>
69 <<<I NEVER GIVE 'EM HEL, I JUST TEL THE TRUTH, AND THEY THINK IT'S HEL. >>>
 
72 <<< --- HARRY S TRUMAN >>>
17 <<< - HARY S TRUMAN >>></pre>
 
=={{header|Phix}}==
Line 2,118 ⟶ 2,012:
Original : <<<😍😀🙌💃😍😍😍🙌>>> (len=8)
Collapse : <<<😍😀🙌💃😍🙌>>> (len=6)</pre>
=={{header|PL/M}}==
 
Because of the limited character set supported by the PL/M-80 compiler,
uppercase letters have been substituted for lowercase letters,
the question mark for the period,
and the single quotation mark for the double quotation mark.
This has no other effect on the output.
While it would be possible to write the ASCII values as numbers, this would make the code less clear.
The <code>COLLAPSE</code> procedure compares bytes and would be fine with any 8-bit input.
 
<lang plm>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
</lang>
{{out}}
<pre>0 <<<>>>
0 <<<>>>
 
72 <<<'IF I WERE TWO-FACED, WOULD I BE WEARING THIS ONE.' --- ABRAHAM LINCOLN >>>
70 <<<'IF I WERE TWO-FACED, WOULD I BE WEARING THIS ONE.' - ABRAHAM LINCOLN >>>
 
72 <<<..1111111111111111111111111111111111111111111111111111111111111117777888>>>
4 <<<.178>>>
 
72 <<<I NEVER GIVE 'EM HELL, I JUST TELL THE TRUTH, AND THEY THINK IT'S HELL. >>>
69 <<<I NEVER GIVE 'EM HEL, I JUST TEL THE TRUTH, AND THEY THINK IT'S HEL. >>>
 
72 <<< --- HARRY S TRUMAN >>>
17 <<< - HARY S TRUMAN >>></pre>
 
=={{header|Prolog}}==
2,114

edits