aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy dot Net 2024-04-19 16:56:29 -07:00
parent 0df55f9f24
commit aec8ed51b6
1045 changed files with 18889 additions and 2777 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Task/Set-consolidation/APL/set-consolidation-1.apl Normal file
View file

@ -0,0 +1 @@
consolidate ← (⊢((⊂∘∪∘∊(/⍨)),(/⍨)∘~)(((⊃∘⍒+/)⊃↓)∘.(∨/∊)⍨))⍣≡

8
Task/Set-consolidation/APL/set-consolidation-2.apl Normal file
View file

@ -0,0 +1,8 @@
consolidate 'AB' 'CD'
AB CD
consolidate 'AB' 'BD'
ABD
consolidate 'AB' 'CD' 'DB'
ABCD
consolidate 'HIK' 'AB' 'CD' 'DB' 'FGH'
HIKFG ABCD

60
Task/Set-consolidation/BASIC256/set-consolidation.basic Normal file
View file

@ -0,0 +1,60 @@
dim test$(4)
test$[0] = "AB"
test$[1] = "AB,CD"
test$[2] = "AB,CD,DB"
test$[3] = "HIK,AB,CD,DB,FGH"
for t = 0 to 3 #test$[?]
print Consolidate(test$[t])
next t
end
function Consolidate(s$)
dim sets$(100)
# Split the string into substrings
pio = 1
n = 0
for i = 1 to length(s$)
if mid(s$, i, 1) = "," then
fin = i - 1
sets$[n] = mid(s$, pio, fin - pio + 1)
pio = i + 1
n += 1
end if
next i
sets$[n] = mid(s$, pio, length(s$) - pio + 1)
# Main logic
for i = 0 to n
p = i
ts$ = ""
for j = i to 0 step -1
if ts$ = "" then p = j
ts$ = ""
for k = 1 to length(sets$[p])
if j > 0 then
if instr(sets$[j-1], mid(sets$[p], k, 1)) = 0 then
ts$ += mid(sets$[p], k, 1)
end if
end if
next k
if length(ts$) < length(sets$[p]) then
if j > 0 then
sets$[j-1] = sets$[j-1] + ts$
sets$[p] = "-"
ts$ = ""
end if
else
p = i
end if
next j
next i
# Join the substrings into a string
temp$ = sets$[0]
for i = 1 to n
temp$ += "," + sets$[i]
next i
return s$ + " = " + temp$
end function

3
Task/Set-consolidation/C-sharp/set-consolidation.cs
View file

@ -31,8 +31,7 @@ public class SetConsolidation
private static IEnumerable<IEnumerable<T>> ConsolidateSets1<T>(IEnumerable<IEnumerable<T>> sets,
IEqualityComparer<T> comparer = null)
{
if (comparer == null) comparer = EqualityComparer<T>.Default;
var elements = new Dictionary<T, Node<T>>();
var elements = new Dictionary<T, Node<T>>(comparer );
foreach (var set in sets) {
Node<T> top = null;
foreach (T value in set) {

83
Task/Set-consolidation/Draco/set-consolidation.draco Normal file
View file

@ -0,0 +1,83 @@
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

56
Task/Set-consolidation/FreeBASIC/set-consolidation.basic Normal file
View file

@ -0,0 +1,56 @@
Function Consolidate(s As String) As String
Dim As Integer i, j, k, p, n, pio, fin
Dim As String ts, sets(0 To 100), temp
' Split the string into substrings
pio = 1
n = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = "," Then
fin = i - 1
sets(n) = Mid(s, pio, fin - pio + 1)
pio = i + 1
n += 1
End If
Next i
sets(n) = Mid(s, pio, Len(s) - pio + 1)
' Main logic
For i = 0 To n
p = i
ts = ""
For j = i To 0 Step -1
If ts = "" Then p = j
ts = ""
For k = 1 To Len(sets(p))
If j > 0 Then
If Instr(sets(j-1), Mid(sets(p), k, 1)) = 0 Then ts += Mid(sets(p), k, 1)
End If
Next k
If Len(ts) < Len(sets(p)) Then
If j > 0 Then
sets(j-1) += ts
sets(p) = "-"
ts = ""
End If
Else
p = i
End If
Next j
Next i
' Join the substrings into a string
temp = sets(0)
For i = 1 To n
temp += "," + sets(i)
Next i
Return s + " = " + temp
End Function
Dim As String test(3) = {"AB", "AB,CD", "AB,CD,DB", "HIK,AB,CD,DB,FGH"}
For t As Integer = Lbound(test) To Ubound(test)
Print Consolidate(test(t))
Next t
Sleep

31
Task/Set-consolidation/GW-BASIC/set-consolidation.basic Normal file
View file

@ -0,0 +1,31 @@
100 CLS
110 S$ = "AB" : GOSUB 160
120 S$ = "AB,CD" : GOSUB 160
130 S$ = "AB,CD,DB" : GOSUB 160
140 S$ = "HIK,AB,CD,DB,FGH" : GOSUB 160
150 END
160 DIM R$(20)
170 N = 0
180 FOR I = 1 TO LEN(S$)
190 IF MID$(S$,I,1) = "," THEN N = N+1 : GOTO 210
200 R$(N) = R$(N)+MID$(S$,I,1)
210 NEXT I
220 FOR I = 0 TO N
230 P = I
240 TS$ = ""
250 FOR J = I TO 0 STEP -1
260 IF TS$ = "" THEN P = J
270 TS$ = ""
280 FOR K = 1 TO LEN(R$(P))
290 IF J > 0 THEN IF INSTR(R$(J-1),MID$(R$(P),K,1)) = 0 THEN TS$ = TS$+MID$(R$(P),K,1)
300 NEXT K
310 IF LEN(TS$) < LEN(R$(P)) THEN IF J > 0 THEN R$(J-1) = R$(J-1)+TS$ : R$(P) = "-" : TS$ = ""
320 NEXT J
330 NEXT I
340 T$ = R$(0)
350 FOR I = 1 TO N
360 T$ = T$+","+R$(I)
370 NEXT I
380 PRINT S$;" = ";T$
390 ERASE R$
400 RETURN

58
Task/Set-consolidation/Gambas/set-consolidation.gambas Normal file
View file

@ -0,0 +1,58 @@
Public test As String[] = ["AB", "AB,CD", "AB,CD,DB", "HIK,AB,CD,DB,FGH"]
Public Sub Main()
For t As Integer = 0 To test.Max
Print Consolidate(test[t])
Next
End
Public Function Consolidate(s As String) As String
Dim sets As New String[100]
Dim n As Integer, i As Integer, j As Integer, k As Integer, p As Integer
Dim ts As String, tmp As String
n = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = "," Then
n += 1
Else
sets[n] = sets[n] & Mid(s, i, 1)
Endif
Next
For i = 0 To n
p = i
ts = ""
For j = i To 0 Step -1
If ts = "" Then p = j
ts = ""
For k = 1 To Len(sets[p])
If j > 0 Then
If InStr(sets[j - 1], Mid(sets[p], k, 1)) = 0 Then
ts &= Mid(sets[p], k, 1)
Endif
Endif
Next
If Len(ts) < Len(sets[p]) Then
If j > 0 Then
sets[j - 1] &= ts
sets[p] = "-"
ts = ""
Endif
Else
p = i
Endif
Next
Next
tmp = sets[0]
For i = 1 To n
tmp &= "," & sets[i]
Next
Return s & " = " & tmp
End

92
Task/Set-consolidation/PL-M/set-consolidation.plm Normal file
View file

@ -0,0 +1,92 @@
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

60
Task/Set-consolidation/PureBasic/set-consolidation.basic Normal file
View file

@ -0,0 +1,60 @@
Procedure.s Consolidate(s.s)
Dim sets.s(100)
Define.i n, i, j, k, p
Define.s ts.s, temp.s
n = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = ",":
n + 1
Else
sets(n) = sets(n) + Mid(s, i, 1)
EndIf
Next i
For i = 0 To n
p = i
ts = ""
For j = i To 0 Step -1
If ts = "":
p = j
EndIf
ts = ""
For k = 1 To Len(sets(p))
If j > 0:
If FindString(sets(j-1), Mid(sets(p), k, 1)) = 0:
ts = ts + Mid(sets(p), k, 1)
EndIf
EndIf
Next k
If Len(ts) < Len(sets(p)):
If j > 0:
sets(j-1) = sets(j-1) + ts
sets(p) = "-"
ts = ""
EndIf
Else
p = i
EndIf
Next j
Next i
temp = sets(0)
For i = 1 To n
temp = temp + "," + sets(i)
Next i
ProcedureReturn s + " = " + temp
EndProcedure
OpenConsole()
Dim test.s(3) ;= {"AB","AB,CD","AB,CD,DB","HIK,AB,CD,DB,FGH"}
test(0) = "AB"
test(1) = "AB,CD"
test(2) = "AB,CD,DB"
test(3) = "HIK,AB,CD,DB,FGH"
For t.i = 0 To 3
PrintN(Consolidate(test(t)))
Next t
PrintN(#CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()

54
Task/Set-consolidation/QBasic/set-consolidation.basic Normal file
View file

@ -0,0 +1,54 @@
SUB consolidate (s$)
DIM sets$(100)
n = 0
FOR i = 1 TO LEN(s$)
IF MID$(s$, i, 1) = "," THEN
n = n + 1
ELSE
sets$(n) = sets$(n) + MID$(s$, i, 1)
END IF
NEXT i
FOR i = 0 TO n
p = i
ts$ = ""
FOR j = i TO 0 STEP -1
IF ts$ = "" THEN
p = j
END IF
ts$ = ""
FOR k = 1 TO LEN(sets$(p))
IF j > 0 THEN
IF INSTR(sets$(j - 1), MID$(sets$(p), k, 1)) = 0 THEN
ts$ = ts$ + MID$(sets$(p), k, 1)
END IF
END IF
NEXT k
IF LEN(ts$) < LEN(sets$(p)) THEN
IF j > 0 THEN
sets$(j - 1) = sets$(j - 1) + ts$
sets$(p) = "-"
ts$ = ""
END IF
ELSE
p = i
END IF
NEXT j
NEXT i
temp$ = sets$(0)
FOR i = 1 TO n
temp$ = temp$ + "," + sets$(i)
NEXT i
PRINT s$; " = "; temp$
END SUB
DIM test$(3)
test$(0) = "AB"
test$(1) = "AB,CD"
test$(2) = "AB,CD,DB"
test$(3) = "HIK,AB,CD,DB,FGH"
FOR t = 0 TO 3
CALL consolidate(test$(t))
NEXT t

48
Task/Set-consolidation/Refal/set-consolidation.refal Normal file
View file

@ -0,0 +1,48 @@
$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>;
};
};

52
Task/Set-consolidation/Run-BASIC/set-consolidation.basic Normal file
View file

@ -0,0 +1,52 @@
function consolidate$(s$)
dim sets$(100)
n = 0
for i = 1 to len(s$)
if mid$(s$, i, 1) = "," then
n = n + 1
else
sets$(n) = sets$(n) + mid$(s$, i, 1)
end if
next i
for i = 0 to n
p = i
ts$ = ""
for j = i to 0 step -1
if ts$ = "" then p = j
ts$ = ""
for k = 1 to len(sets$(p))
if j > 0 then
if instr(sets$(j-1), mid$(sets$(p), k, 1)) = 0 then
ts$ = ts$ + mid$(sets$(p), k, 1)
end if
end if
next k
if len(ts$) < len(sets$(p)) then
if j > 0 then
sets$(j-1) = sets$(j-1) + ts$
sets$(p) = "-"
ts$ = ""
end if
else
p = i
end if
next j
next i
temp$ = sets$(0)
for i = 1 to n
temp$ = temp$ + "," + sets$(i)
next i
consolidate$ = s$ + " = " + temp$
end function
dim test$(3)
test$(0) = "AB"
test$(1) = "AB,CD"
test$(2) = "AB,CD,DB"
test$(3) = "HIK,AB,CD,DB,FGH"
for t = 0 to 3
print consolidate$(test$(t))
next t

68
Task/Set-consolidation/XBasic/set-consolidation.basic Normal file
View file

@ -0,0 +1,68 @@
PROGRAM "Set consolidation"
VERSION "0.0001"
DECLARE FUNCTION Entry ()
DECLARE FUNCTION Consolidate$ (s$)
FUNCTION Entry ()
DIM test$[4]
test$[0] = "AB"
test$[1] = "AB,CD"
test$[2] = "AB,CD,DB"
test$[3] = "HIK,AB,CD,DB,FGH"
FOR t = 0 TO 3
PRINT Consolidate$(test$[t])
NEXT t
END FUNCTION
FUNCTION Consolidate$ (s$)
DIM sets$[100]
' Split the STRING into substrings
pio = 1
n = 0
FOR i = 1 TO LEN(s$)
IF MID$(s$, i, 1) = "," THEN
fin = i - 1
sets$[n] = MID$(s$, pio, fin - pio + 1)
pio = i + 1
INC n
END IF
NEXT i
sets$[n] = MID$(s$, pio, LEN(s$) - pio + 1)
' Main logic
FOR i = 0 TO n
p = i
ts$ = ""
FOR j = i TO 0 STEP -1
IF ts$ = "" THEN p = j
ts$ = ""
FOR k = 1 TO LEN(sets$[p])
IF j > 0 THEN
IF INSTR(sets$[j-1], MID$(sets$[p], k, 1)) = 0 THEN
ts$ = ts$ + MID$(sets$[p], k, 1)
END IF
END IF
NEXT k
IF LEN(ts$) < LEN(sets$[p]) THEN
IF j > 0 THEN
sets$[j-1] = sets$[j-1] + ts$
sets$[p] = "-"
ts$ = ""
END IF
ELSE
p = i
END IF
NEXT j
NEXT i
' Join the substrings into a STRING
temp$ = sets$[0]
FOR i = 1 TO n
temp$ = temp$ + "," + sets$[i]
NEXT i
RETURN s$ + " = " + temp$
END FUNCTION
END PROGRAM

60
Task/Set-consolidation/Yabasic/set-consolidation.basic Normal file
View file

@ -0,0 +1,60 @@
dim test$(3)
test$(0) = "AB"
test$(1) = "AB,CD"
test$(2) = "AB,CD,DB"
test$(3) = "HIK,AB,CD,DB,FGH"
for t = 0 to arraysize(test$(), 1)
print Consolidate$(test$(t))
next t
end
sub Consolidate$(s$)
dim sets$(100)
// Split the string into substrings
pio = 1
n = 0
for i = 1 to len(s$)
if mid$(s$, i, 1) = "," then
fin = i - 1
sets$(n) = mid$(s$, pio, fin - pio + 1)
pio = i + 1
n = n + 1
fi
next i
sets$(n) = mid$(s$, pio, len(s$) - pio + 1)
// Main logic
for i = 0 to n
p = i
ts$ = ""
for j = i to 0 step -1
if ts$ = "" p = j
ts$ = ""
for k = 1 to len(sets$(p))
if j > 0 then
if instr(sets$(j-1), mid$(sets$(p), k, 1)) = 0 then
ts$ = ts$ + mid$(sets$(p), k, 1)
fi
fi
next k
if len(ts$) < len(sets$(p)) then
if j > 0 then
sets$(j-1) = sets$(j-1) + ts$
sets$(p) = "-"
ts$ = ""
fi
else
p = i
fi
next j
next i
// Join the substrings into a string
temp$ = sets$(0)
for i = 1 to n
temp$ = temp$ + "," + sets$(i)
next i
return s$ + " = " + temp$
end sub