@narpfel: Ist länger als Deins, aber sicherlich nicht lesbarer und läuft in 6m53s auf dem VIC-20:
Code: Alles auswählen
10 TI$="000000":R1=0:R2=0:DIM P(255),C(52),C2(52)
20 P=1:FOR I=ASC("A") TO ASC("Z"):P(I)=P:P=P+1:NEXT
30 FOR I=ASC("A") TO ASC("Z"):P(I)=P:P=P+1:NEXT
40 FOR I=1 TO 52:C2(I)=1:NEXT
100 OPEN 2,8,2,"INPUT03,S":LC=0
110 IF ST<> 0 THEN CLOSE 2:GOTO 999
120 FOR I=1 TO 52:C(I)=0:NEXT
130 INPUT#2,L$:L=LEN(L$):M=L/2:LC=LC+1
140 FOR I=1 TO M
150 C(P(ASC(MID$(L$,I,1))))=1
160 NEXT:FOR I=M+1 TO L
170 P=P(ASC(MID$(L$,I,1)))
180 IF C(P) THEN R1=R1+P:GOTO 200
190 NEXT:STOP
200 FOR I=M+1 TO L
210 C(P(ASC(MID$(L$,I,1))))=1:NEXT
220 FOR I=1 TO 52:C2(I)=C2(I) AND C(I):NEXT
230 IF LC<>3 THEN 110
240 FOR I=1 TO 52:IF C2(I) THEN R2=R2+I
250 C2(I)=1:NEXT:LC=0:GOTO 110
999 PRINT R1,R2:PRINT TI$
Nach GW-BASIC portiert ca 5m auf einem 8088er-PC, also kaum schneller, und das trotz mehr als 4× die Taktrate und schnellerem Dateizugriff:
Code: Alles auswählen
10 T1!=TIMER:DEFINT A-Z:R1=0:R2=0:DIM P(255),C(52),C2(52)
20 P=1:FOR I=ASC("a") TO ASC("z"):P(I)=P:P=P+1:NEXT
30 FOR I=ASC("A") TO ASC("Z"):P(I)=P:P=P+1:NEXT
40 FOR I=1 TO 52:C2(I)=1:NEXT:DEF FN P(I)=P(ASC(MID$(L$,I,1)))
50 OPEN "input03.txt" FOR INPUT AS #1:LC=0
60 WHILE NOT EOF(1):LINE INPUT#1,L$:LC=LC+1:L=LEN(L$):M=L\2
70 FOR I=1 TO 52:C(I)=0:NEXT:FOR I=1 TO M:C(FN P(I))=1:NEXT
80 FOR I=M+1 TO L:P=FN P(I):IF C(P) THEN R1=R1+P:GOTO 100
90 NEXT:STOP:REM No common item error.
100 FOR I=M+1 TO L:C(FN P(I))=1:NEXT
110 FOR I=1 TO 52:C2(I)=C2(I) AND C(I):NEXT:IF LC<>3 THEN 135
120 FOR I=1 TO 52:IF C2(I) THEN R2=R2+I
130 C2(I)=1:NEXT:LC=0
135 WEND:CLOSE 1
140 PRINT R1,R2:PRINT"In";TIMER-T1!;"seconds."
Bei der 1m18s die der QBasic-Port läuft weiss man dann schon eher warum man 1983 so schweineviel Geld ausgegeben hat im Vergleich zum VIC-20 — wenn man auf QBasic nicht noch fast 10 Jahre hätte warten müssen:
Code: Alles auswählen
DECLARE FUNCTION GetPrio% (s AS STRING, i AS INTEGER)
DECLARE SUB InitItemSet (s() AS INTEGER, value AS INTEGER)
DECLARE SUB TickItems (s() AS INTEGER, L AS STRING, a AS INTEGER, b AS INTEGER)
t1 = TIMER
DIM SHARED Byte2Prio(255) AS INTEGER
DIM items(52) AS INTEGER, groupItems(52) AS INTEGER
DIM r1 AS INTEGER, r2 AS INTEGER, p AS INTEGER, lc AS INTEGER
DIM i AS INTEGER, length AS INTEGER, middle AS INTEGER
' Init lookup table ASCII code -> priority.
p = 1
FOR i = ASC("a") TO ASC("z"): Byte2Prio(i) = p: p = p + 1: NEXT
FOR i = ASC("A") TO ASC("Z"): Byte2Prio(i) = p: p = p + 1: NEXT
r1 = 0: r2 = 0: lc = 0
InitItemSet groupItems(), 1
OPEN "input03.txt" FOR INPUT AS #1
DO WHILE NOT EOF(1)
LINE INPUT #1, L$: length = LEN(L$): middle = length \ 2
' Part 1
InitItemSet items(), 0
TickItems items(), L$, 1, middle
FOR i = middle + 1 TO length
p = GetPrio(L$, i): IF items(p) THEN r1 = r1 + p: EXIT FOR
NEXT
' Part 2
TickItems items(), L$, middle + 1, length
FOR i = 1 TO 52: groupItems(i) = groupItems(i) AND items(i): NEXT
lc = lc + 1
IF lc = 3 THEN ' Group complete.
lc = 0
FOR i = 1 TO 52
IF groupItems(i) THEN r2 = r2 + i: EXIT FOR
NEXT
InitItemSet groupItems(), 1
END IF
LOOP
CLOSE 1: PRINT r1, r2: PRINT "In"; TIMER - t1; "seconds."
FUNCTION GetPrio% (s AS STRING, i AS INTEGER)
GetPrio = Byte2Prio(ASC(MID$(s, i, 1)))
END FUNCTION
SUB InitItemSet (s() AS INTEGER, value AS INTEGER)
DIM i AS INTEGER
FOR i = 1 TO 52: s(i) = value: NEXT
END SUB
SUB TickItems (s() AS INTEGER, L AS STRING, a AS INTEGER, b AS INTEGER)
DIM i AS INTEGER
FOR i = a TO b: s(GetPrio(L, i)) = 1: NEXT
END SUB
In diesem strukturierteren Quelltext war mir übrigens erst aufgefallen, das ich die ”angefangene” Menge `items`/`C()` aus dem ersten Teil in Teil 2 einfach vervollständigen kann, statt das nochmal komplett neu zu machen. Liess sich wie man sieht auch einfach auf die beiden vorherigen Varianten zurück portieren.
So wirklich schnell wurde es dann aber erst mit einer Pascal-Lösung: 2,8s, also mehr als 100mal schneller als GW-BASIC:
Code: Alles auswählen
type
TPrio = 1..52;
TItems = set of TPrio;
const
AllItems = [Low(TPrio)..High(TPrio)];
var
charToPrioTable: array[0..255] of TPrio;
r1, r2: Word;
f: Text;
lineCount: Byte;
line: String;
middle: Byte;
items, groupItems: TItems;
prio: TPrio;
i: Byte;
procedure Init;
var
i: Byte;
p: TPrio;
begin
FillChar(charToPrioTable, SizeOf(charToPrioTable), 0);
p := 1;
for i := Ord('a') to Ord('z') do
begin
charToPrioTable[i] := p;
Inc(p);
end;
for i := Ord('A') to Ord('Z') do
begin
charToPrioTable[i] := p;
Inc(p);
end;
end;
function CharToPrio(c: Char): TPrio;
begin
CharToPrio := charToPrioTable[Ord(c)];
end;
procedure IncludeItems(var items: TItems; const line: String; i, j: Byte);
begin
for i := i to j do Include(items, CharToPrio(line[i]));
end;
begin
Init;
Assign(f, 'input03.txt');
Reset(f);
r1 := 0; r2 := 0; lineCount := 0; groupItems := AllItems;
while not Eof(f) do
begin
ReadLn(f, line);
middle := Length(line) DIV 2;
items := [];
{ Part 1 }
IncludeItems(items, line, 1, middle);
for i := middle + 1 to Length(line) do
begin
prio := CharToPrio(line[i]);
if prio in items then
begin
Inc(r1, prio);
Break;
end;
end;
{ Part 2 }
IncludeItems(items, line, middle + 1, Length(line));
groupItems := groupItems * items;
Inc(lineCount);
if lineCount = 3 then
begin
lineCount := 0;
for prio := Low(TPrio) to High(TPrio) do
begin
if prio in groupItems then
begin
Inc(r2, prio);
Break;
end;
end;
groupItems := AllItems;
end;
end;
Close(f);
WriteLn(r1, ' ', r2);
end.
An der Lösung fand ich interessant, dass Pascal einen Mengentyp hat.