Set consolidation: Difference between revisions
Add Draco
m (C# fixed tiny mistake) |
Not a robot (talk | contribs) (Add Draco) |
||
| (3 intermediate revisions by the same user not shown) | |||
Line 246:
{A, B, C, D}
{A, B, C, D}, {F, G, H, I, K}</pre>
=={{header|APL}}==
<syntaxhighlight lang="apl">consolidate ← (⊢((⊂∘∪∘∊(/⍨)),(/⍨)∘~)(((⊃∘⍒+/)⊃↓)∘.(∨/∊)⍨))⍣≡</syntaxhighlight>
{{out}}
<syntaxhighlight lang="apl"> consolidate 'AB' 'CD'
AB CD
consolidate 'AB' 'BD'
ABD
consolidate 'AB' 'CD' 'DB'
ABCD
consolidate 'HIK' 'AB' 'CD' 'DB' 'FGH'
HIKFG ABCD </syntaxhighlight>
=={{header|AutoHotkey}}==
Line 1,473 ⟶ 1,485:
["ABCD"]
["FGHIK", "ABCD"]</pre>
=={{header|Draco}}==
<syntaxhighlight lang="draco">type Set = word;
proc make_set(*char setdsc) Set:
Set set;
byte pos;
set := 0;
while setdsc* /= '\e' do
pos := setdsc* - 'A';
if pos < 16 then set := set | (1 << pos) fi;
setdsc := setdsc + 1
od;
set
corp
proc write_set(Set set) void:
char item;
write('(');
for item from 'A' upto ('A'+15) do
if set & 1 /= 0 then write(item) fi;
set := set >> 1
od;
write(')')
corp
proc consolidate([*]Set sets) word:
word i, j, n;
bool change;
n := dim(sets, 1);
change := true;
while change do
change := false;
for i from 0 upto n-1 do
for j from i+1 upto n-1 do
if sets[i] & sets[j] /= 0 then
sets[i] := sets[i] | sets[j];
sets[j] := 0;
change := true
fi
od
od
od;
for i from 1 upto n-1 do
if sets[i] = 0 then
for j from i+1 upto n-1 do
sets[j-1] := sets[j]
od
fi
od;
i := 0;
while i<n and sets[i] /= 0 do i := i+1 od;
i
corp
proc test([*]Set sets) void:
word i, n;
n := dim(sets, 1);
for i from 0 upto n-1 do write_set(sets[i]) od;
write(" -> ");
n := consolidate(sets);
for i from 0 upto n-1 do write_set(sets[i]) od;
writeln()
corp
proc main() void:
[2]Set ex1;
[2]Set ex2;
[3]Set ex3;
[5]Set ex4;
ex1[0]:=make_set("AB"); ex1[1]:=make_set("CD");
ex2[0]:=make_set("AB"); ex2[1]:=make_set("BC");
ex3[0]:=make_set("AB"); ex3[1]:=make_set("CD"); ex3[2]:=make_set("DB");
ex4[0]:=make_set("HIK"); ex4[1]:=make_set("AB"); ex4[2]:=make_set("CD");
ex4[3]:=make_set("DB"); ex4[4]:=make_set("FGH");
test(ex1);
test(ex2);
test(ex3);
test(ex4);
corp</syntaxhighlight>
{{out}}
<pre>(AB)(CD) -> (AB)(CD)
(AB)(BC) -> (ABC)
(AB)(CD)(BD) -> (ABCD)
(HIK)(AB)(CD)(BD)(FGH) -> (FGHIK)(ABCD)</pre>
=={{header|EchoLisp}}==
Line 2,702 ⟶ 2,804:
Results: {A,B,E,F,G,H} {C,D}
</pre>
=={{header|PL/M}}==
<syntaxhighlight lang="plm">100H:
BDOS: PROCEDURE (F,A); DECLARE F BYTE, A ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; GO TO 0; END EXIT;
PUTC: PROCEDURE (C); DECLARE C BYTE; CALL BDOS(2, C); END PUTC;
PUTS: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9, S); END PUTS;
BIT: PROCEDURE (I) ADDRESS;
DECLARE I BYTE;
IF I=0 THEN RETURN 1;
RETURN SHL(DOUBLE(1), I);
END BIT;
PRINT$SET: PROCEDURE (SET);
DECLARE SET ADDRESS, I BYTE;
CALL PUTC('(');
DO I=0 TO 15;
IF (BIT(I) AND SET) <> 0 THEN CALL PUTC('A' + I);
END;
CALL PUTC(')');
END PRINT$SET;
MAKE$SET: PROCEDURE (SETSTR) ADDRESS;
DECLARE SETSTR ADDRESS, ITEM BASED SETSTR BYTE;
DECLARE SET ADDRESS, POS ADDRESS;
SET = 0;
DO WHILE ITEM <> '$';
POS = ITEM - 'A';
IF POS < 16 THEN SET = SET OR BIT(POS);
SETSTR = SETSTR + 1;
END;
RETURN SET;
END MAKE$SET;
CONSOLIDATE: PROCEDURE (SETS, N) BYTE;
DECLARE (SETS, S BASED SETS) ADDRESS;
DECLARE (N, I, J, CHANGE) BYTE;
STEP:
CHANGE = 0;
DO I=0 TO N-1;
DO J=I+1 TO N-1;
IF (S(I) AND S(J)) <> 0 THEN DO;
S(I) = S(I) OR S(J);
S(J) = 0;
CHANGE = 1;
END;
END;
END;
IF CHANGE THEN GO TO STEP;
DO I=0 TO N-1;
IF S(I)=0 THEN
DO J=I+1 TO N-1;
S(J-1) = S(J);
END;
END;
DO I=0 TO N-1;
IF S(I)=0 THEN RETURN I;
END;
RETURN N;
END CONSOLIDATE;
TEST: PROCEDURE (SETS, N);
DECLARE (SETS, S BASED SETS) ADDRESS;
DECLARE (N, I) BYTE;
DO I=0 TO N-1;
CALL PRINT$SET(S(I));
END;
CALL PUTS(.' -> $');
N = CONSOLIDATE(SETS, N);
DO I=0 TO N-1;
CALL PRINT$SET(S(I));
END;
CALL PUTS(.(13,10,'$'));
END TEST;
DECLARE S (5) ADDRESS;
S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'CD$');
CALL TEST(.S, 2);
S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'BD$');
CALL TEST(.S, 2);
S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'CD$');
S(2) = MAKE$SET(.'DB$');
CALL TEST(.S, 3);
S(0) = MAKE$SET(.'HIK$'); S(1) = MAKE$SET(.'AB$');
S(2) = MAKE$SET(.'CD$'); S(3) = MAKE$SET(.'DB$');
S(4) = MAKE$SET(.'FGH$');
CALL TEST(.S, 5);
CALL EXIT;
EOF</syntaxhighlight>
{{out}}
<pre>(AB)(CD) -> (AB)(CD)
(AB)(BD) -> (ABD)
(AB)(CD)(BD) -> (ABCD)
(HIK)(AB)(CD)(BD)(FGH) -> (FGHIK)(ABCD)</pre>
=={{header|Python}}==
Line 2,957 ⟶ 3,158:
set(H, I, K) set(A, B) set(C, D) set(D, B) set(F, G, H)
==> set(A, B, C, D) set(H, I, K, F, G)</pre>
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
= <Test (A B) (C D)>
<Test (A B) (B D)>
<Test (A B) (C D) (D B)>
<Test (H I K) (A B) (C D) (D B) (F G H)>;
};
Test {
e.S = <Prout e.S ' -> ' <Consolidate e.S>>;
};
Consolidate {
e.SS, <Consolidate1 () e.SS>: {
e.SS = e.SS;
e.SS2 = <Consolidate e.SS2>;
};
};
Consolidate1 {
(e.CSS) = e.CSS;
(e.CSS) (e.S) e.SS,
<Consolidate2 (e.CSS) (e.S)>: e.CSS2 =
<Consolidate1 (e.CSS2) e.SS>;
};
Consolidate2 {
() (e.S) = (e.S);
((e.S1) e.SS) (e.S), <Overlap (e.S1) (e.S)>: {
True = (<Set e.S1 e.S>) e.SS;
False = (e.S1) <Consolidate2 (e.SS) (e.S)>;
};
};
Overlap {
(e.S1) () = False;
(e.S1) (s.I e.S2), e.S1: {
e.L s.I e.R = True;
e.S1 = <Overlap (e.S1) (e.S2)>;
};
};
Set {
= ;
s.I e.S, e.S: {
e.L s.I e.R = <Set e.S>;
e.S = s.I <Set e.S>;
};
};</syntaxhighlight>
{{out}}
<pre>(A B )(C D ) -> (A B )(C D )
(A B )(B D ) -> (A B D )
(A B )(C D )(D B ) -> (A B C D )
(H I K )(A B )(C D )(D B )(F G H ) -> (I K F G H )(A B C D )</pre>
=={{header|REXX}}==
| |||