Advent of Code 2023

exc-jdbi · 9. Dezember 2023, 07:16

Part 1

Part 2

Methoden

Source

Optimized

VaporiZed · 9. Dezember 2023, 10:47

Mist, ich dachte, es würde etwas bringen, wenn man weiß, dass

Spoiler anzeigen

Aber wurscht, hat trotzdem geklappt.

Spoiler anzeigen

VB.NET-Quellcode

Friend Class ValueCalculatorForDay8
Private ReadOnly Sequences As New List(Of IEnumerable(Of Long))
Private ReadOnly SequencePacks As New Stack(Of SequencePack)
Private Part1Value As Long
Private Part2Value As Long
Function GetValuesFor(FilePath As String) As (Long, Long)
Dim RawDataLines = GetRawDataFrom(FilePath)
ParseRawDataLines(RawDataLines)
CalculatePart1Values()
CalculatePart2Values()
Return (Part1Value, Part2Value)
End Function
Private Function GetRawDataFrom(FilePath As String) As IEnumerable(Of String)
Return IO.File.ReadAllLines(FilePath)
End Function
Private Sub ParseRawDataLines(RawDataLines As IEnumerable(Of String))
For Each RawDataLine In RawDataLines
Sequences.Add(RawDataLine.Split.Select(Function(x) Long.Parse(x)).ToArray)
Next
End Sub
Private Sub CalculatePart1Values()
For Each Sequence In Sequences
CalculatePart1ValueFor(Sequence)
Next
End Sub
Private Sub CalculatePart1ValueFor(Sequence As IEnumerable(Of Long))
AddNewSequencePack(Sequence)
Dim AdderOfPreviousSequence = 0L
Do
Dim TopSequencePack = SequencePacks.Pop()
Dim NextValue = TopSequencePack.GetNextValueFrom(AdderOfPreviousSequence)
AdderOfPreviousSequence = NextValue
If SequencePacks.Count = 0 Then
Part1Value += NextValue
Exit Do
End If
Loop
End Sub
Private Sub CalculatePart2Values()
For Each Sequence In Sequences
CalculatePart2ValueFor(Sequence)
Next
End Sub
Private Sub CalculatePart2ValueFor(Sequence As IEnumerable(Of Long))
AddNewSequencePack(Sequence)
Dim AdderOfPreviousSequence = 0L
Do
Dim TopSequencePack = SequencePacks.Pop()
Dim PreviousValue = TopSequencePack.GetPreviousValueFrom(AdderOfPreviousSequence)
AdderOfPreviousSequence = PreviousValue
If SequencePacks.Count = 0 Then
Part2Value += PreviousValue
Exit Do
End If
Loop
End Sub
Private Sub AddNewSequencePack(Sequence As IEnumerable(Of Long))
Dim NewSequencePack = New SequencePack(Sequence)
SequencePacks.Push(NewSequencePack)
If Not NewSequencePack.HasEqualAdders Then AddNewSequencePack(GetCurrentAddersFor(Sequence))
End Sub
Private Function GetCurrentAddersFor(Sequence As IEnumerable(Of Long)) As IEnumerable(Of Long)
Dim CurrentAdders As New List(Of Long)
For i = 1 To Sequence.Count - 1
CurrentAdders.Add(Sequence(i) - Sequence(i - 1))
Next
Return CurrentAdders
End Function
End Class
Friend Class SequencePack
Property Sequence As New List(Of Long)
Sub New(Sequence As IEnumerable(Of Long))
Me.Sequence.AddRange(Sequence)
End Sub
Function HasEqualAdders() As Boolean
Return Sequence.Distinct.Count = 1
End Function
Function GetNextValueFrom(Adder As Long) As Long
Return Sequence(Sequence.Count - 1) + Adder
End Function
Function GetPreviousValueFrom(Adder As Long) As Long
Return Sequence(0) - Adder
End Function
End Class

ISliceUrPanties · 9. Dezember 2023, 12:21

Tag 9

Part 1

Spoiler anzeigen

C#-Quellcode

using FileStream fs = File.OpenRead(@"C:\Dev\dotnet\AdventOfCode\2023\Day9\input.txt");
using StreamReader sr = new(fs);
int total = 0;
while (!sr.EndOfStream)
{
var lineSpan = sr.ReadLine().AsSpan();
int[] values = ParseValues(SplitLine(lineSpan), lineSpan);
Dictionary<int, IEnumerable<int>> differences = new();
int iter = 0;
differences.Add(iter++, values);
bool endReached = false;
while (!endReached)
{
List<int> l = new();
for (int i = 0; i < values.Length - 1; ++i)
{
// l.Add(Math.Abs(values[i] - values[i + 1]));
l.Add(values[i + 1] - values[i]);
}
endReached = l.All(i => i == 0);
values = l.ToArray();
differences.Add(iter, l);
++iter;
}
int last = 0;
for (int i = iter - 2; i >= 0; --i)
{
last += differences[i].Last();
}
total += last;
}
System.Console.WriteLine(total);
Range[] SplitLine(ReadOnlySpan<char> lines)
{
Range[] ranges = new Range[lines.Count(' ') + 1];
lines.Split(ranges, ' ');
return ranges;
}
int[] ParseValues(Range[] ranges, ReadOnlySpan<char> line)
{
int[] values = new int[ranges.Length];
for (int i = 0; i < ranges.Length; ++i)
{
values[i] = int.Parse(line[ranges[i]]);
}
return values;
}

Part 2

Spoiler anzeigen

Haudruferzappeltnoch · 9. Dezember 2023, 14:02

D9 Part 1

Part 2 wirkt erstmal stumpf, mal schauen, ob es wirklich so ist.

D9 Part2

@VaporiZed

Spoiler anzeigen

Elanda · 9. Dezember 2023, 21:08

Omg, dieses Jahr hab ich total darauf vergessen, war auch schon lange nicht mehr hier.
Glaub' für mich wird das nichts dieses Jahr, aber euch wünsche ich viel Spaß.

VaporiZed · 10. Dezember 2023, 12:19

Teil1 habe ich, aber Teil 2 kommt mir vor wie bei einem Malprogramm: Fülle alles aus, was innerhalb des unrandeten Bereichs liegt und zähl die Pixel

Haudruferzappeltnoch · 10. Dezember 2023, 14:25

Mein erster Versuch bei Part 1 ging in die Hose und ich weiß nicht warum. Da steht in der Aufgabe es gäbe nur eine einzige Schleife. Ich habe ein paar Mini-Schleifen drin, gut vielleicht Zufall, die konnte ich entfernen, aber gibt es da vielleicht noch andere kleine Schleifen > Länge 4? Das wäre zumindest eine mögliche Ursache, die ich begreife. Doofer Fehler habe erst ganz anders gezählt und dabei eben auch verzählt.

D10 Part 1

Die "Corrected" Data wurde von Mini-Schleifen "F7JL" befreit. Man kann die Anzahl die dadurch verkehrt wird aber auch mit demselben Code berechnen, wenn man in den Connections das "S"c weglässt. Dann wäre Error = 2*result - 1

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllLines(FilePathOfCorrectedData)
'width 142
Dim Chars = input.Select(Function(s) s.ToCharArray).ToArray
Dim compareSequence = Chars.SelectMany(Function(s) s)
Dim ConnectLeft = {"-"c, "L"c, "F"c, "S"c}
Dim ConnectRight = {"-"c, "7"c, "J"c, "S"c}
Dim ConnectUp = {"|"c, "7"c, "F"c, "S"c}
Dim ConnectDown = {"|"c, "J"c, "L"c, "S"c}
Dim prevSequence = Array.Empty(Of Char)
While Not prevSequence.SequenceEqual(compareSequence)
prevSequence = Chars.SelectMany(Function(s) s).ToArray
For x = 1 To 140
For y = 1 To Chars.Length - 2
Select Case Chars(y)(x)
Case "F"c
If Not ConnectRight.Contains(Chars(y)(x + 1)) OrElse Not ConnectDown.Contains(Chars(y + 1)(x)) Then Chars(y)(x) = "."c
Case "J"c
If Not ConnectLeft.Contains(Chars(y)(x - 1)) OrElse Not ConnectUp.Contains(Chars(y - 1)(x)) Then Chars(y)(x) = "."c
Case "-"c
If Not ConnectLeft.Contains(Chars(y)(x - 1)) OrElse Not ConnectRight.Contains(Chars(y)(x + 1)) Then Chars(y)(x) = "."c
Case "|"c
If Not ConnectUp.Contains(Chars(y - 1)(x)) OrElse Not ConnectDown.Contains(Chars(y + 1)(x)) Then Chars(y)(x) = "."c
Case "7"c
If Not ConnectLeft.Contains(Chars(y)(x - 1)) OrElse Not ConnectDown.Contains(Chars(y + 1)(x)) Then Chars(y)(x) = "."c
Case "L"c
If Not ConnectUp.Contains(Chars(y - 1)(x)) OrElse Not ConnectRight.Contains(Chars(y)(x + 1)) Then Chars(y)(x) = "."c
End Select
Next
Next
End While
Dim result = compareSequence.Count(Function(c) c <> "."c) / 2
End Sub

D10 Part2

Entgegen der ursprünglichen Idee, hier etwas zur Pfadverfolgung.
Wenn man die Lösung aus Part 1 in eine Datei ausgibt und diese als input verwendet, dann wird hier widerum eine Datei ausgeben die alle eigeschlossenen Fläche mit I umrandet.
Große Flächen beinhalten weiterhin .. Die sind aber abzählbar

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllLines(FilePathOfInvalidTilesClearedData)
Dim Chars = input.Select(Function(s) s.ToCharArray).ToArray
Dim CharsAsSequence = Chars.SelectMany(Function(s) s).ToArray
Dim y = 31 'Position S
Dim x = 111 'Position S
Dim dir = Direction.Down
Dim system As New List(Of Tile) From {New Tile(Chars(y)(x), dir)}
While Chars(y + 1)(x) <> "S"c
Dim T = New Tile(Chars(y)(x), dir)
system.Add(T)
Select Case True
Case Chars(y)(x) = "7"c AndAlso dir = Direction.Right
If Chars(y - 1)(x) = "."c Then Chars(y - 1)(x) = "I"c
If Chars(y)(x + 1) = "."c Then Chars(y)(x + 1) = "I"c
Case Chars(y)(x) = "F"c AndAlso dir = Direction.Up
If Chars(y - 1)(x) = "."c Then Chars(y - 1)(x) = "I"c
If Chars(y)(x - 1) = "."c Then Chars(y)(x - 1) = "I"c
Case Chars(y)(x) = "-"c
If dir = Direction.Right AndAlso Chars(y - 1)(x) = "."c Then Chars(y - 1)(x) = "I"c
If dir = Direction.Left AndAlso Chars(y + 1)(x) = "."c Then Chars(y + 1)(x) = "I"c
Case Chars(y)(x) = "|"c
If dir = Direction.Up AndAlso Chars(y)(x - 1) = "."c Then Chars(y)(x - 1) = "I"c
If dir = Direction.Down AndAlso Chars(y)(x + 1) = "."c Then Chars(y)(x + 1) = "I"c
Case Chars(y)(x) = "J"c AndAlso dir = Direction.Down
If Chars(y + 1)(x) = "."c Then Chars(y + 1)(x) = "I"c
If Chars(y)(x + 1) = "."c Then Chars(y)(x + 1) = "I"c
Case Chars(y)(x) = "L"c AndAlso dir = Direction.Left
If Chars(y + 1)(x) = "."c Then Chars(y + 1)(x) = "I"c
If Chars(y)(x - 1) = "."c Then Chars(y)(x - 1) = "I"c
End Select
dir = T.ExitDirection
Select Case dir
Case Direction.Up
y -= 1
Case Direction.Down
y += 1
Case Direction.Left
x -= 1
Case Direction.Right
x += 1
End Select
End While
IO.File.WriteAllLines(FilePathOfResult, Chars.Select(Function(s) String.Join("", s)))
End Sub
Friend Enum Direction
Right
Down
Left
Up
End Enum
Friend Class Tile
ReadOnly Property [Char] As Char
ReadOnly Property EntryDirection As Direction
ReadOnly Property ExitDirection As Direction
Sub New(c As Char, entering As Direction)
_Char = c
_EntryDirection = entering
_ExitDirection = GetExit()
End Sub
Private Function GetExit() As Direction
Select Case _Char
Case "7"c
Return If(_EntryDirection = Direction.Right, Direction.Down, Direction.Left)
Case "F"c
Return If(_EntryDirection = Direction.Left, Direction.Down, Direction.Right)
Case "-"c
Return If(_EntryDirection = Direction.Right, Direction.Right, Direction.Left)
Case "|"c
Return If(_EntryDirection = Direction.Down, Direction.Down, Direction.Up)
Case "J"c
Return If(_EntryDirection = Direction.Down, Direction.Left, Direction.Up)
Case "L"c, "S"c
Return If(_EntryDirection = Direction.Down, Direction.Right, Direction.Up)
Case Else
Throw New Exception("Invalid Data")
End Select
End Function
End Class

exc-jdbi · 10. Dezember 2023, 14:27

Prime Directive

Part 1

Part 2

Methodes

C#-Quellcode

private static (HashSet<(int X, int Y)> Route, int Turns) FollowRoute(Map map)
{
// - Start S suchen
// - Alle möglichen directionen festlegen.
// - Alle möglichen directionen in der aktuellen Position der Map
// prüfen, ob sie als Kacheln vorhanden sind, und wenn ja, nimm
// den ersten für die "route"
// - Folge der gegebenen Route bis der Startpunkt wieder erreicht wird.
// Hinweis: Da die 90°-Wendungen definiert sind, wird immer eine Route
// gefunden, sofern eine Route vorhanden ist.
var result = new HashSet<(int x, int y)>();
var start = map.Keys.Single(key => map[key] == 'S');
(int X, int Y)[] directions = new[] { (0, -1), (1, 0), (0, 1), (-1, 0) };
var next = directions.FirstOrDefault(d => Tile(map[Addition(start, d)]).Contains(d));
var turns = 0;
while (!result.Contains(start))
{
var prev = start;
result.Add(start);
start = Addition(start, next);
if (map[start] == 'S') break;
next = Tiles(map[start]).Single(til => Negate(til) != next);
turns += Clockwise(map[start], Addition(start, next), prev);
}
return (result, turns);
}
private static HashSet<(int x, int y)> FindInnerTiles(
Map map, HashSet<(int X, int Y)> route, bool isclockwise)
{
var r = route.ToList();
var result = new HashSet<(int x, int y)>();
for (var i = 1; i < route.Count; i++)
{
var (pos, prev) = (r[i], r[i - 1]);
var isleft = map[pos] switch
{
'|' => pos == Addition(prev, (0, -1)) ^ isclockwise,
'F' => pos == Addition(prev, (0, -1)) ^ isclockwise,
'L' => pos == Addition(prev, (-1, 0)) ^ isclockwise,
_ => false
};
if (isleft)
{
if (result.Contains(Addition(pos, (-1, 0))) || route.Contains(Addition(pos, (-1, 0)))) continue;
result.UnionWith(Recursiv(route, Addition(pos, (-1, 0))));
}
}
return result;
}
private static HashSet<(int X, int Y)> Recursiv(
HashSet<(int x, int y)> route, (int x, int y) startpos)
{
HashSet<(int x, int y)> result = [];
var directions = new[] { (0, -1), (1, 0), (0, 1), (-1, 0) };
void R((int x, int y) pos)
{
result.Add(pos);
foreach (var direct in directions)
{
var xy = Addition(pos, direct);
if (result.Contains(xy) || route.Contains(xy)) continue;
R(xy);
}
}
R(startpos);
return result;
}
private static Map ToMap(string[] grid)
{
var map = new Map();
for (var r = 0; r < grid.Length; r++)
for (var c = 0; c < grid[r].Length; c++)
map[(c, r)] = grid[r][c];
return map;
}
private static (int X, int Y) Negate((int x, int y) xy) => (-xy.x, -xy.y);
private static (int X, int Y) Addition((int x, int y) left, (int x, int y) right) =>
(left.x + right.x, left.y + right.y);
private static (int X, int Y) Subtraction((int x, int y) left, (int x, int y) right) =>
(left.x - right.x, left.y - right.y);
private static (int X, int Y)[] Tile(char ch) =>
Tiles(ch).Select(Negate).ToArray();
private static (int X, int Y)[] Tiles(char ch) =>
ch switch
{
'7' => [(-1, 0), (0, 1)],
'F' => [(1, 0), (0, 1)],
'L' => [(0, -1), (1, 0)],
'J' => [(0, -1), (-1, 0)],
'|' => [(0, -1), (0, 1)],
'-' => [(-1, 0), (1, 0)],
'S' => [(0, -1), (0, 1), (-1, 0), (1, 0)],
_ => []
};
private static int Clockwise(char ch, (int x, int y) start, (int x, int y) prev) =>
ch switch
{
'7' => Subtraction(start, prev) == (1, 1) ? 1 : -1,
'F' => Subtraction(start, prev) == (1, -1) ? 1 : -1,
'L' => Subtraction(start, prev) == (-1, -1) ? 1 : -1,
'J' => Subtraction(start, prev) == (-1, 1) ? 1 : -1,
_ => 0,
};

Source

VaporiZed · 11. Dezember 2023, 00:45

Diese verfluchte Erkennung, ob man in der Loop ist oder nicht …

Spoiler anzeigen

VB.NET-Quellcode

Friend Class ValueCalculatorForDay8
Private ReadOnly Map As New Map
Function GetValuesFor(FilePath As String) As (Long, Long)
Dim RawDataLines = GetRawDataFrom(FilePath)
ParseRawDataLines(RawDataLines)
FindNextPipe()
CountTilesInLoop()
DrawMapIn("map.txt")
Return (Map.PositionsAlreadyVisited.Count \ 2, Map.TilesInLoop)
End Function
Private Function GetRawDataFrom(FilePath As String) As IEnumerable(Of String)
Return IO.File.ReadAllLines(FilePath)
End Function
Private Sub ParseRawDataLines(RawDataLines As IEnumerable(Of String))
ReDim Map.Tiles(RawDataLines(0).Count - 1, RawDataLines.Count - 1)
For y = 0 To RawDataLines.Count - 1
For x = 0 To RawDataLines(y).Count - 1
Dim PipeSymbol = RawDataLines(y)(x)
Select Case PipeSymbol
Case "|"c : Map.Tiles(x, y) = New Tile("│"c, 0, -1, 0, 1, TileType.Pipe)
Case "-"c : Map.Tiles(x, y) = New Tile("─"c, -1, 0, 1, 0, TileType.Pipe)
Case "L"c : Map.Tiles(x, y) = New Tile("└"c, 0, -1, 1, 0, TileType.Pipe)
Case "J"c : Map.Tiles(x, y) = New Tile("┘"c, 0, -1, -1, 0, TileType.Pipe)
Case "7"c : Map.Tiles(x, y) = New Tile("┐"c, -1, 0, 0, 1, TileType.Pipe)
Case "F"c : Map.Tiles(x, y) = New Tile("┌"c, 1, 0, 0, 1, TileType.Pipe)
Case "."c : Map.Tiles(x, y) = New Tile(" "c, 0, 0, 0, 0, TileType.Ground)
Case "S"c : Map.Tiles(x, y) = New Tile("X"c, 0, 0, 0, 0, TileType.StartPosition) : Map.RememberStartPosition(x, y)
End Select
Next
Next
End Sub
Private Sub FindNextPipe()
Dim CurrentPosition = Map.StartPosition
Do
CurrentPosition = Map.GetNextPosition(CurrentPosition)
Loop Until CurrentPosition.Is(Map.StartPosition)
End Sub
Private Sub CountTilesInLoop()
Map.CountTilesInLoop()
End Sub
Private Sub DrawMapIn(FilePath As String)
Map.RemoveDirt()
Map.DrawIn(FilePath)
End Sub
End Class
Friend Class Map
Property Tiles As Tile(,)
Property StartPosition As Position
Property TilesInLoop As Integer
ReadOnly Property PositionsAlreadyVisited As New List(Of Position)
Function GetNextPosition(Position As Position) As Position
Return GetNewPositionFrom(Position, Tiles(Position.X, Position.Y))
End Function
Private Function GetNewPositionFrom(Position As Position, Tile As Tile) As Position
Dim NewPosition As Position
If Tile.TileType = TileType.StartPosition AndAlso PositionsAlreadyVisited.Count = 0 Then
If Position.X - 1 >= 0 AndAlso Tiles(Position.X - 1, Position.Y).IsConnectedTo(Position, Position.X - 1, Position.Y) Then NewPosition = New Position With {.X = Position.X - 1, .Y = Position.Y}
If Position.Y - 1 >= 0 AndAlso Tiles(Position.X, Position.Y - 1).IsConnectedTo(Position, Position.X, Position.Y - 1) Then NewPosition = New Position With {.X = Position.X, .Y = Position.Y - 1}
If Position.X <= Tiles.GetUpperBound(0) AndAlso Tiles(Position.X + 1, Position.Y).IsConnectedTo(Position, Position.X + 1, Position.Y) Then NewPosition = New Position With {.X = Position.X + 1, .Y = Position.Y}
If Position.Y <= Tiles.GetUpperBound(1) AndAlso Tiles(Position.X, Position.Y + 1).IsConnectedTo(Position, Position.X, Position.Y + 1) Then NewPosition = New Position With {.X = Position.X, .Y = Position.Y + 1}
ElseIf Tile.TileType = TileType.Pipe Then
NewPosition = New Position With {.X = Position.X + Tile.Offset1.X, .Y = Position.Y + Tile.Offset1.Y}
If Tiles(NewPosition.X, NewPosition.Y).TileType = TileType.StartPosition AndAlso PositionsAlreadyVisited.Count > 1 Then
ElseIf PositionsAlreadyVisited.Contains(NewPosition) Then
NewPosition = New Position With {.X = Position.X + Tile.Offset2.X, .Y = Position.Y + Tile.Offset2.Y}
End If
End If
PositionsAlreadyVisited.Add(Position)
Return NewPosition
End Function
Sub RememberStartPosition(x As Integer, y As Integer)
StartPosition = New Position With {.X = x, .Y = y}
End Sub
Sub CountTilesInLoop()
Dim IsInsideOfLoop = False
For y = 0 To Tiles.GetUpperBound(1)
For x = 0 To Tiles.GetUpperBound(0)
Dim Position = New Position With {.X = x, .Y = y}
Dim CurrentPipeSymbol = Tiles(x, y).PipeSymbol
If PositionsAlreadyVisited.Contains(Position) AndAlso "┌│┐".Contains(Tiles(x, y).PipeSymbol) Then IsInsideOfLoop = Not IsInsideOfLoop
If Not PositionsAlreadyVisited.Contains(Position) AndAlso IsInsideOfLoop Then TilesInLoop += 1
Next
Next
End Sub
Sub RemoveDirt()
For y = 0 To Tiles.GetUpperBound(1)
For x = 0 To Tiles.GetUpperBound(0)
If Not PositionsAlreadyVisited.Contains(New Position With {.X = x, .Y = y}) Then Tiles(x, y).PipeSymbol = "█"c
Next
Next
End Sub
Sub DrawIn(FilePath As String)
Dim Text As New Text.StringBuilder
For y = 0 To Tiles.GetUpperBound(1)
For x = 0 To Tiles.GetUpperBound(0)
Text.Append(Tiles(x, y).PipeSymbol)
Next
Text.AppendLine()
Next
IO.File.WriteAllText(FilePath, Text.ToString)
End Sub
End Class
Friend Class Tile
Property TileType As TileType
Property Offset1 As Position
Property Offset2 As Position
Property PipeSymbol As Char
Sub New(PipeSymbol As Char, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, TileType As TileType)
Me.PipeSymbol = PipeSymbol
Me.TileType = TileType
Offset1 = New Position With {.X = x1, .Y = y1}
Offset2 = New Position With {.X = x2, .Y = y2}
End Sub
Function IsConnectedTo(Position As Position, X As Integer, Y As Integer) As Boolean
If X + Offset1.X = Position.X AndAlso Y + Offset1.Y = Position.Y Then Return True
If X + Offset2.X = Position.X AndAlso Y + Offset2.Y = Position.Y Then Return True
Return False
End Function
End Class
Friend Structure Position
Property X As Integer
Property Y As Integer
Function [Is](Position As Position) As Boolean
Return X = Position.X AndAlso Y = Position.Y
End Function
End Structure
Friend Enum TileType
Pipe
Ground
StartPosition
End Enum

Das Kartezeichnen ist für die Lösungsberechnung überflüssig, nicht aber für die Lösungsfindung.

exc-jdbi · 11. Dezember 2023, 08:16

Part 1 und 2

Methodes

C#-Quellcode

private static List<long> Compute(string[] grid, long expansion)
{
var galaxies = AllGalaxies(grid, '#');
var idxemptyrow = IndexOfEmptyRows(grid);
var idxemptycol = IndexOfEmptyCols(grid);
var result = new List<long>();
for (var x = 0; x < galaxies.Length; x++)
{
var (x1, y1) = galaxies[x];
for (var y = x + 1; y < galaxies.Length; y++)
{
var (x2, y2) = galaxies[y];
long distance = Math.Abs(x1 - x2) + Math.Abs(y1 - y2);
distance += idxemptyrow.Count(r => Between(r, y1, y2)) * expansion;
distance += idxemptycol.Count(r => Between(r, x1, x2)) * expansion;
result.Add(distance);
}
}
return result;
}
private static bool Between( int value, int min, int max) =>
Math.Min(min, max) <= value && value <= Math.Max(min, max);
private static int[] IndexOfEmptyRows(string[] grid) =>
Enumerable.Range(0,grid.Length).Where(r => grid[r].All(ch=>ch == '.')).ToArray();
private static int[] IndexOfEmptyCols(string[] grid) =>
Enumerable.Range(0, grid[0].Length).Where(c => grid.All(row => row[c] == '.')).ToArray();
private static (int X, int Y)[] AllGalaxies(string[] grid, char galaxie)
{
var result = new List<(int x, int y)>();
for (int r = 0; r < grid.Length; r++)
for (int c = 0; c < grid[0].Length; c++)
if (grid[r][c] == galaxie) result.Add((c, r));
return result.ToArray();
}

Source

VaporiZed · 11. Dezember 2023, 10:19

Eine Stunde Frust, bis ich bemerkt hatte, dass

Spoiler anzeigen

Code

VB.NET-Quellcode

Friend Class ValueCalculatorForDay8
Private ReadOnly Map As New Map
Function GetValueFor(FilePath As String) As Long
Map.Process(FilePath)
Return Map.Distances.Sum
End Function
End Class
Friend Class Map
Private ReadOnly GalaxyPositions As New List(Of Position)
Private ReadOnly RawMapLines As New List(Of String)
Property Distances As New List(Of Long)
Sub Process(FilePath As String)
CreateRawFrom(IO.File.ReadAllLines(FilePath))
CollectGalaxies()
CorrectBy(10) 'Part 1 = 2, Part 2 = 1000000
DetermineShortestPathsBetweenAllGalaxies()
End Sub
Private Sub CreateRawFrom(RawDataLines As IEnumerable(Of String))
RawMapLines.AddRange(RawDataLines)
End Sub
Private Sub CollectGalaxies()
Dim ID = 1
For y = 0 To RawMapLines.Count - 1
For x = 0 To RawMapLines(0).Count - 1
If RawMapLines(y)(x) = "#" Then GalaxyPositions.Add(New Position(ID, x, y)) : ID += 1
Next
Next
End Sub
Private Sub CorrectBy(Offset As Integer)
For y = RawMapLines.Count - 1 To 0 Step -1
Dim IsEmptyRow = RawMapLines(y).Distinct.Count = 1
If Not IsEmptyRow Then Continue For
Dim TempY = y
For Each GalaxyPosition In GalaxyPositions.Where(Function(x) x.Y > TempY).ToList
GalaxyPosition.Y += Offset - 1
Next
Next
For x = RawMapLines(0).Count - 1 To 0 Step -1
Dim TempX = x
Dim IsEmptyColumn = RawMapLines.Select(Function(a) a(TempX)).Distinct.Count = 1
If Not IsEmptyColumn Then Continue For
For Each GalaxyPosition In GalaxyPositions.Where(Function(a) a.X > TempX).ToList
GalaxyPosition.X += Offset - 1
Next
Next
End Sub
Private Sub DetermineShortestPathsBetweenAllGalaxies()
For i = 0 To GalaxyPositions.Count - 2
For j = i + 1 To GalaxyPositions.Count - 1
Distances.Add(RetrieveDistanceBetween(GalaxyPositions(i), GalaxyPositions(j)))
Next
Next
End Sub
Private Function RetrieveDistanceBetween(GalaxyPosition1 As Position, GalaxyPosition2 As Position) As Integer
Dim DeltaY = Math.Abs(GalaxyPosition1.Y - GalaxyPosition2.Y)
Dim DeltaX = Math.Abs(GalaxyPosition1.X - GalaxyPosition2.X)
Return DeltaX + DeltaY
End Function
End Class
Friend Class Position
Property ID As Integer
Property X As Integer
Property Y As Integer
Sub New(ID As Integer, X As Integer, Y As Integer)
Me.ID = ID
Me.X = X
Me.Y = Y
End Sub
End Class

Haudruferzappeltnoch · 11. Dezember 2023, 11:39

Ausnahmsweise beides in einem, wer reinguckt weiß warum.

D11 Achtung beide Parts

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllLines(FilePathOfData)
Dim sky = input.Select(Function(l) l.ToCharArray).ToArray
Dim skyExpanded = Transpose(Expand(Transpose(Expand(sky))))
Dim resultPart1 = CLng(CalcSumDistances(skyExpanded))
Dim resultPart2 = resultPart1 + 999998 * (resultPart1 - CalcSumDistances(sky))
End Sub
Private Function CalcSumDistances(input As Char()()) As Integer
Dim Positions As New Dictionary(Of Integer, Integer())
Dim k = 0
For y = 0 To input.Length - 1
For x = 0 To input(0).Length - 1
If input(y)(x) = "#"c Then
Positions.Add(k, {x, y})
k += 1
End If
Next
Next
Dim result = 0
For i = 0 To Positions.Count - 1
For j = i + 1 To Positions.Count - 1
Dim galaxy1 = Positions(i)
Dim galaxy2 = Positions(j)
result += Math.Abs(galaxy1(0) - galaxy2(0)) + Math.Abs(galaxy1(1) - galaxy2(1))
Next
Next
Return result
End Function
Private Function Transpose(input As Char()()) As Char()()
Dim output(input(0).Length - 1)() As Char
For y = 0 To output.Length - 1
Dim line(input.Length - 1) As Char
output(y) = line
Next
For y = 0 To output.Length - 1
For x = 0 To output(0).Length - 1
output(y)(x) = input(x)(y)
Next
Next
Return output
End Function
Private Function Expand(input As Char()()) As Char()()
Dim output = New List(Of Char())
For Each line In input
output.Add(line)
If line.Distinct.Count = 1 Then output.Add(line)
Next
Return output.ToArray
End Function

Haudruferzappeltnoch · 12. Dezember 2023, 14:34

D12 Part1

Hier wird alles stumpf durchprobiert

VB.NET-Quellcode

Sub Main()
Dim Comparer As New List(Of String)
Dim Build As New List(Of Integer())
Dim input = IO.File.ReadAllLines(PathOfFileData)
For Each l In input
Dim compandbuild = l.Split(" "c)
Comparer.Add(compandbuild(0))
Build.Add(compandbuild(1).Split(","c).Select(AddressOf Integer.Parse).ToArray)
Next
Dim result As Integer
For n = 0 To Comparer.Count - 1
result += Test(Comparer(n), Build(n))
Next
End Sub
Private Function Test(comp As String, build As Integer()) As Integer
Dim hold As Char()
Dim result As Integer
Dim idxs = comp.Select(Function(c, i) If(c = "?"c, i, -1)).Where(Function(i) i > -1).ToArray
For k = 0 To CInt(2 ^ idxs.Length) - 1
hold = comp.ToCharArray
Dim a = Convert.ToString(k, 2).PadLeft(hold.Count(Function(c) c = "?"c), "0"c).ToCharArray
For i = 0 To idxs.Length - 1
hold(idxs(i)) = If(a(i) = "1"c, "."c, "#"c)
Next
Dim check = New String(hold).Split("."c, StringSplitOptions.RemoveEmptyEntries).Select(Function(x) x.Length).ToArray
If check.SequenceEqual(build) Then result += 1
Next
Return result
End Function

Für Part 2 reicht es daher nicht, weil der Möglichkeitsraum gesprengt wird. Weder ein Trick für Part 1 (der Part 2 dann vermutlich durchführbar macht), noch eine Umrechnung der Part 1 Ergebnisse will mir einfallen. Bleibt weiter zu knobeln.

Zu Part2: Eine direkte Umrechnung für die Lösung eines einfacheren, aber immer noch zeitaufwendigen Problems:

Spoiler anzeigen

Das Ergebnis der Verfünffachung einer Zeile (F) ergibt sich aus dem Ergebnis einer Zeile (E) und dem Ergebnis der Verdopplung einer Zeile (D) wie folgt:
F = D^4/E^3

exc-jdbi · 13. Dezember 2023, 10:12

Day 12

Part 1 / 2

Methodes

Source

Day 13

Part 1

Part 2

Methodes

C#-Quellcode

private static (int, int)[] EqualsPairHorizontal(string[] lines)
{
var result = new List<(int, int)>();
for (var i = 1; i < lines.Length; i++)
if (lines[i] == lines[i - 1])
result.Add((i - 1, i));
return [.. result];
}
private static ((int, int) RPair, int Length)[]
ReflexionHorizontal(string[] lines, (int, int)[] pairs)
{
var result = new List<((int, int) rpair, int length)>();
foreach (var pair in pairs)
{
var flag = true;
var row = pair.Item1;
var max = Math.Min(row, lines.Length - row - 2);
for (var j = 0; flag && j <= max; j++)
if (lines[row - j] != lines[row + j + 1])
flag = false;
if (flag)
result.Add((pair, max + 1));
}
return [.. result];
}
private static ((int, int) RPair, int Length)[]
ReflexionVertical(string[] lines, (int, int)[] pairs) =>
ReflexionHorizontal(lines.Select(x => x.ToCharArray())
.Transpose().Select(x => string.Join("", x)).ToArray(), pairs);
private static (int, int)[] EqualsPairVertical(string[] lines) =>
EqualsPairHorizontal(lines.Select(x => x.ToCharArray())
.Transpose().Select(x => string.Join("", x)).ToArray());

Source

Haudruferzappeltnoch · 13. Dezember 2023, 15:46

D13 Part 1

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllText(FilePathOfData).Split(vbCrLf & vbCrLf)
Dim Patterns = input.Select(Function(t) t.Split(vbCrLf))
Dim result = Patterns.Sum(Function(p) 100 * FindReflLine(p) + FindReflLine(Transpose(p)))
End Sub
Private Function FindReflLine(pattern As String()) As Long
Dim middle = pattern.Length / 2
For i = 1 To pattern.Length - 1
Dim Cut = {pattern.Take(i), pattern.Skip(i)}
If i > middle Then
If Cut(1).SequenceEqual(Cut(0).Reverse.Take(pattern.Length - i)) Then Return i
Else
If Cut(0).SequenceEqual(Cut(1).Reverse.TakeLast(i)) Then Return i
End If
Next
Return 0
End Function
Private Function Transpose(Strs As String()) As String()
Dim input = Strs.Select(Function(s) s.ToCharArray).ToArray
Dim output(input(0).Length - 1)() As Char
For y = 0 To output.Length - 1
Dim line(input.Length - 1) As Char
output(y) = line
Next
For y = 0 To output.Length - 1
For x = 0 To output(0).Length - 1
output(y)(x) = input(x)(y)
Next
Next
Return output.Select(Function(cs) New String(cs)).ToArray
End Function

D13 Part 2

Bastelt man die SequenceEqual selbst geht beides in einem

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllText(FilePathOfData).Split(vbCrLf & vbCrLf)
Dim Patterns = input.Select(Function(t) t.Split(vbCrLf)).ToList
Dim resultPart1 As Integer
Dim resultPart2 As Integer
For i = 0 To Patterns.Count - 1
Dim add2 = 0
resultPart1 += 100 * FindReflLine(Patterns(i), add2) : resultPart2 += 100 * add2
add2 = 0
resultPart1 += FindReflLine(Transpose(Patterns(i)), add2) : resultPart2 += add2
Next
End Sub
Private Function FindReflLine(pattern As String(), ByRef addPart2 As Integer) As Integer
Dim middle = pattern.Length / 2
Dim result1 = 0
For i = 1 To pattern.Length - 1
Dim Cut = {pattern.Take(i), pattern.Skip(i)}
Dim check As Integer
If i > middle Then
check = SequenceEqual(Cut(0).Reverse.Take(pattern.Length - i).ToArray, Cut(1).ToArray)
Else
check = SequenceEqual(Cut(0).ToArray, Cut(1).Reverse.TakeLast(i).ToArray)
End If
If check < 2 Then
result += i * (1 - check)
addPart2 += i * check
End If
Next
Return result1
End Function
Private Function SequenceEqual(arr1 As String(), arr2 As String()) As Integer
Dim countErrors As Integer
For y = 0 To arr1.Length - 1
For x = 0 To arr1(0).Length - 1
If arr1(y)(x) <> arr2(y)(x) Then countErrors += 1
If countErrors > 1 Then Return countErrors
Next
Next
Return countErrors
End Function

VaporiZed · 13. Dezember 2023, 22:45

Den 12. erstmal überspringend (obwohl mir im Traum eine Idee kam …)
Tag 13:

Spoiler anzeigen

VB.NET-Quellcode

Friend Class ValueCalculatorForDay9
Private ReadOnly Blocks As New List(Of Block)
Private FinalValue As Integer = 0
Function GetValueFor(FilePath As String) As Long
RetrieveBlocksFrom(FilePath)
Blocks.ForEach(Sub(x) Analyze(x, 1)) 'Analyze(x, y) - y bei Part 1 = 0, Part 2 = 1
Return FinalValue
End Function
Private Sub RetrieveBlocksFrom(FilePath As String)
Dim NewBlock As New Block
Dim ID = 0
For Each Line In IO.File.ReadLines(FilePath)
If String.IsNullOrEmpty(Line) Then
NewBlock.ID = ID
Blocks.Add(NewBlock)
ID += 1
NewBlock = New Block
Else
NewBlock.Rows.Add(Line)
End If
Next
NewBlock.ID = ID
Blocks.Add(NewBlock)
End Sub
Private Sub Analyze(Block As Block, TargetDifference As Integer)
For x = 0 To Block.Rows(0).Length - 2
If IsMirrorYAxis(Block, x, TargetDifference) Then FinalValue += x + 1 : Return
Next
For y = 0 To Block.Rows.Count - 2
If IsMirrorXAxis(Block, y, TargetDifference) Then FinalValue += 100 * (y + 1) : Return
Next
End Sub
Private Function IsMirrorYAxis(Block As Block, x As Integer, TargetDifference As Integer) As Boolean
Dim CountOfDifferentCharacters = 0
Dim Offset = 0
Do
For y = 0 To Block.Rows.Count - 1
If Block.Rows(y)(x - Offset) <> Block.Rows(y)(x + Offset + 1) Then CountOfDifferentCharacters += 1
If CountOfDifferentCharacters > TargetDifference Then Return False
Next
Offset += 1
Loop Until x - Offset = -1 OrElse x + Offset + 1 = Block.Rows(0).Count
Return CountOfDifferentCharacters = TargetDifference
End Function
Private Function IsMirrorXAxis(Block As Block, y As Integer, TargetDifference As Integer) As Boolean
Dim CountOfDifferentCharacters = 0
Dim Offset = 0
Do
For x = 0 To Block.Rows(0).Count - 1
If Block.Rows(y - Offset)(x) <> Block.Rows(y + Offset + 1)(x) Then CountOfDifferentCharacters += 1
If CountOfDifferentCharacters > TargetDifference Then Return False
Next
Offset += 1
Loop Until y - Offset = -1 OrElse y + Offset + 1 = Block.Rows.Count
Return CountOfDifferentCharacters = TargetDifference
End Function
End Class
Friend Class Block
Property ID As Integer
Property Rows As New List(Of String)
End Class

Haudruferzappeltnoch · 14. Dezember 2023, 09:37

D14 Part 1

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllLines(FilePathOfData)
Dim Tilted = Tilt(input, Direction.North)
Dim result = Tilted.Select(Function(l, i) (i + 1) * l.Count(Function(c) c = "O"c)).Sum
End Sub
Private Function Tilt(input As String(), dir As Direction) As String()
Dim rocklines = Array.Empty(Of String)
Dim reverse = False
Select Case dir
Case Direction.North
rocklines = Transpose(input)
Case Direction.West
rocklines = input
Case Direction.South
rocklines = Transpose(input)
reverse = True
Case Direction.East
rocklines = input
reverse = True
Case Else
Return input
End Select
For i = 0 To rocklines.Length - 1
Dim borders = rocklines(i).Split("#"c)
For j = 0 To borders.Length - 1
Dim rockcount = borders(j).Count(Function(c) c = "O"c)
borders(j) = borders(j).Replace("O"c, String.Empty)
Dim pad = borders(j).Length + rockcount
borders(j) = If(reverse, borders(j).PadRight(pad, "O"c), borders(j).PadLeft(pad, "O"c))
Next
rocklines(i) = String.Join("#"c, borders)
Next
Select Case dir
Case Direction.North
Return Transpose(rocklines)
Case Direction.West
Return rocklines
Case Direction.South
Return Transpose(rocklines)
End Select
Return rocklines
End Function
Private Function Transpose(Strs As IEnumerable(Of String)) As String()
Dim input = Strs.Select(Function(s) s.ToCharArray).ToArray
Dim output(input(0).Length - 1)() As Char
For y = 0 To output.Length - 1
Dim line(input.Length - 1) As Char
output(y) = line
Next
For y = 0 To output.Length - 1
For x = 0 To output(0).Length - 1
output(y)(x) = input(x)(y)
Next
Next
Return output.Select(Function(cs) New String(cs)).ToArray
End Function
Friend Enum Direction
North
West
South
East
End Enum

D14 Part 2

Da lässt sich noch Einiges verbessern, aber naja

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllLines(FilePathOfData)
Dim resultPart1 = Tilt(input, Direction.North).Select(Function(l, k) (l.Length - k) * l.Count(Function(c) c = "O"c)).Sum
Dim lstRes As New List(Of Integer)
Dim CycleEstablished = 200 '100 war zu klein, ggf. weiter erhöhen
Dim resultPart2 As Integer
For t = 1 To 100 'Grob analysiert ergab sich für ein nxn Grid eine Zyklusgröße < n, allerdings habe ich das noch nicht bewiesen. Ggf erhöhen.
Console.WriteLine(t)
For Each i In {CycleEstablished - t, CycleEstablished, CycleEstablished + t} 'Naiv, da Zahlen groß genug im Haupttest
Dim Cycle1 = Spin(input, i)
lstRes.Add(Cycle1.Select(Function(l, k) (l.Length - k) * l.Count(Function(c) c = "O"c)).Sum)
Next
If lstRes.Distinct.Count = 1 Then
resultPart2 = Spin(input, CycleEstablished + ((1000000000 - CycleEstablished) Mod t)).Select(Function(l, k) (l.Length - k) * l.Count(Function(c) c = "O"c)).Sum
Exit For
End If
lstRes.Clear()
Next
End Sub
Private Function Spin(input As String(), n As Integer) As String()
Dim k As Long
Dim output = input
While k < n
For i As Direction = 0 To Direction.East
output = Tilt(output, i)
Next
k += 1
End While
Return output
End Function

VaporiZed · 15. Dezember 2023, 00:12

Beim Finalwert von Part 2 hab ich aufgrund von Müdigkeit getrickst und

Spoiler anzeigen

manell aufgrund des Zykluses den richtigen Wert rausgefischt

VB.NET-Quellcode

Friend Class ValueCalculatorForDay14
Private ReadOnly Block As New Block
Private FinalValue As Integer = 0
Function GetValueFor(FilePath As String) As (Integer, Integer)
RetrieveBlockDataFrom(FilePath)
Dim Values As New List(Of Integer)
For i = 1 To 200
FinalValue = 0
Block.TiltBy(0, -1)
Block.TiltBy(-1, 0)
Block.TiltBy(0, 1)
Block.TiltBy(1, 0)
Values.Add(Block.Calculate())
Next
FinalValue = Block.Calculate()
Return (FinalValue, 0)
End Function
Private Sub RetrieveBlockDataFrom(FilePath As String)
Dim RawDataLines = IO.File.ReadLines(FilePath)
ReDim Block.Tiles(RawDataLines(0).Count, RawDataLines.Count)
For y = 0 To RawDataLines.Count - 1
For x = 0 To RawDataLines(0).Count - 1
Block.Tiles(x, y) = GetTileTypeFrom(RawDataLines(y)(x))
Next
Next
End Sub
Private Function GetTileTypeFrom(Character As Char) As TileType
Select Case Character
Case "#"c : Return TileType.FixedRock
Case "O"c : Return TileType.MoveableRock
Case Else : Return TileType.Void
End Select
End Function
End Class
Friend Class Block
Property Tiles As Integer(,)
Sub TiltBy(XSign As Integer, YSign As Integer)
Dim StartX = If(XSign = 1, Tiles.GetUpperBound(0) - 1, 0)
Dim EndX = If(XSign = 1, 0, Tiles.GetUpperBound(0) - 1)
Dim StartY = If(YSign = 1, Tiles.GetUpperBound(1) - 1, 0)
Dim EndY = If(YSign = 1, 0, Tiles.GetUpperBound(1) - 1)
For x = StartX To EndX Step If(XSign = 0, 1, -XSign)
For y = StartY To EndY Step If(YSign = 0, 1, -YSign)
If Tiles(x, y) <> TileType.MoveableRock Then Continue For
Dim EndPositionX = If(XSign = -1, 0, If(XSign = 0, x, Tiles.GetUpperBound(0) - 1))
Dim EndPositionY = If(YSign = -1, 0, If(YSign = 0, y, Tiles.GetUpperBound(1) - 1))
If YSign <> 0 Then
For YToCheck = y + YSign To If(YSign = -1, 0, Tiles.GetUpperBound(1) - 1) Step YSign
If Tiles(x, YToCheck) <> TileType.Void Then EndPositionY = YToCheck - YSign : Exit For
Next
End If
If XSign <> 0 Then
For XToCheck = x + XSign To If(XSign = -1, 0, Tiles.GetUpperBound(0) - 1) Step XSign
If Tiles(XToCheck, y) <> TileType.Void Then EndPositionX = XToCheck - XSign : Exit For
Next
End If
Tiles(x, y) = TileType.Void
Tiles(EndPositionX, EndPositionY) = TileType.MoveableRock
Next
Next
End Sub
Function Calculate() As Integer
Dim FinalValue = 0
For y = 0 To Tiles.GetUpperBound(1) - 1
For x = 0 To Tiles.GetUpperBound(0) - 1
If Tiles(x, y) <> TileType.MoveableRock Then Continue For
Dim Value = Tiles.GetUpperBound(1) - y
FinalValue += Value
Next
Next
Return FinalValue
End Function
Private Function GetCharacterFrom(TileType As Integer) As String
Select Case TileType
Case 0 : Return "O"
Case 1 : Return "#"
Case Else : Return "."
End Select
End Function
End Class
Friend Enum TileType
MoveableRock
FixedRock
Void
End Enum

Haudruferzappeltnoch · 15. Dezember 2023, 09:43

D15 Part 1

D15 Part 2

VB.NET-Quellcode

Sub Main()
Dim input = IO.File.ReadAllText(FilePathOfData).Split(","c)
Dim resultPart1 = input.Sum(AddressOf GetHash)
Dim Boxes = New Dictionary(Of Integer, List(Of Lens))
For i = 0 To 255
Boxes.Add(i, New List(Of Lens))
Next
Dim Lenses = input.Select(AddressOf ToLens)
For Each lens In Lenses
Dim _lens = Boxes(lens.Box).FirstOrDefault(Function(l) l.Name = lens.Name)
If _lens Is Nothing AndAlso lens.FocalLength > 0 Then Boxes(lens.Box).Add(lens)
If lens.FocalLength = 0 AndAlso _lens IsNot Nothing Then
Boxes(lens.Box).Remove(_lens)
ElseIf _lens IsNot Nothing Then
_lens.FocalLength = lens.FocalLength
End If
Next
Dim resultPart2 = Boxes.Sum(Function(p) (p.Key + 1) * p.Value.Select(Function(l, i) l.FocalLength * (i + 1)).Sum)
End Sub
Private Function GetHash(value As String) As Integer
Return CInt(value.Select(Function(c) CLng(Asc(c))).Aggregate(Function(n, m) (n * 17) + m) * 17 Mod 256)
End Function
Private Function ToLens(value As String) As Lens
Dim lensandlength = value.Split("="c, "-"c)
Return New Lens() With {
.Name = lensandlength(0),
.Box = GetHash(lensandlength(0)),
.FocalLength = If(lensandlength(1) = String.Empty, 0, CInt(lensandlength(1)))}
End Function
Friend Class Lens
Property Name As String
Property Box As Integer
Property FocalLength As Integer
End Class

Edit nach Post 100 @VaporiZed Definitiv, hab mich 5 Minuten gefragt woran man die "richtige" Box erkennen soll, bis ich den Paragraph gefunden hab wo das steht, hab den mehrfach überlesen.

VaporiZed · 15. Dezember 2023, 11:32

Die Beschreibung von Tag 2 kam mir komplizierter als die eigentliche Problemlöösung vor

Spoiler anzeigen

VB.NET-Quellcode

Friend Class ValueCalculatorForDay15
Private ReadOnly Boxes As New List(Of Box)
Function GetValueFor(FilePath As String) As (Integer, Integer)
Dim Text = IO.File.ReadAllText(FilePath).Split(","c)
Return (GetValueForPart1(Text), GetValueForPart2(Text))
End Function
Private Function GetValueForPart1(Text As IEnumerable(Of String)) As Integer
Dim FinalValue = 0
For Each Part In Text
Dim Value = 0
For Each Character In Part
Dim AsciiValue = Microsoft.VisualBasic.Asc(Character)
Value = ((Value + AsciiValue) * 17) Mod 256
Next
FinalValue += Value
Next
Return FinalValue
End Function
Private Function GetValueForPart2(Text As IEnumerable(Of String)) As Integer
CreateBoxesFrom(Text)
ApplyLensSequence(Text)
Return GetFocusPower()
End Function
Private Sub CreateBoxesFrom(Text As IEnumerable(Of String))
For Each Part In Text
Dim BoxLabel = String.Empty
For Each Character In Part
If "=-".Contains(Character) Then Exit For
BoxLabel &= Character
Next
Dim BoxID = GetBoxIdFrom(BoxLabel)
If Not Boxes.Any(Function(x) x.ID = BoxID) Then Boxes.Add(New Box With {.ID = BoxID, .Label = BoxLabel})
Next
End Sub
Private Function GetBoxIdFrom(BoxLabel As String) As Integer
Dim BoxID = 0
For Each Character In BoxLabel
Dim AsciiValue = Microsoft.VisualBasic.Asc(Character)
BoxID = ((BoxID + AsciiValue) * 17) Mod 256
Next
Return BoxID
End Function
Private Sub ApplyLensSequence(Text As IEnumerable(Of String))
For Each Part In Text
Dim OperationPack = GetOperationPackFrom(Part)
Apply(OperationPack)
Next
End Sub
Private Function GetOperationPackFrom(Part As String) As OperationPack
Dim OperationPack As New OperationPack
Dim BoxLabel = String.Empty
Dim CollectBoxID = True
For i = 0 To Part.Count - 1
If CollectBoxID Then
If Not "=-".Contains(Part(i)) Then
BoxLabel &= Part(i)
Else
OperationPack.BoxID = GetBoxIdFrom(BoxLabel)
OperationPack.LensID = BoxLabel
OperationPack.Operation = If(Part(i) = "-"c, OperationType.RemoveLens, OperationType.SetLens)
CollectBoxID = False
End If
Else
If OperationPack.Operation = OperationType.SetLens Then OperationPack.FocusLength = Integer.Parse(Part.Substring(i))
End If
Next
Return OperationPack
End Function
Private Sub Apply(OperationPack As OperationPack)
Dim Box = Boxes.Single(Function(x) x.ID = OperationPack.BoxID)
If Box.Lenses.Any(Function(x) x.ID = OperationPack.LensID) Then
For i = 0 To Box.Lenses.Count - 1
If i = Box.Lenses.Count Then Exit For
If Box.Lenses(i).ID <> OperationPack.LensID Then Continue For
If OperationPack.Operation = OperationType.SetLens Then Box.Lenses(i).FocalLength = OperationPack.FocusLength
If OperationPack.Operation = OperationType.RemoveLens Then Box.Lenses.RemoveAt(i) : i = -1
Next
Else
If OperationPack.Operation = OperationType.SetLens Then Box.Lenses.Add(New Lens With {.ID = OperationPack.LensID, .FocalLength = OperationPack.FocusLength})
End If
End Sub
Private Function GetFocusPower() As Integer
Dim FinalValue = 0
For Each Box In Boxes
For i = 0 To Box.Lenses.Count - 1
FinalValue += (Box.ID + 1) * (i + 1) * Box.Lenses(i).FocalLength
Next
Next
Return FinalValue
End Function
End Class
Friend Class Box
Property ID As Integer
Property Label As String
Property Lenses As New List(Of Lens)
End Class
Friend Class Lens
Property ID As String
Property FocalLength As Integer
End Class
Friend Class OperationPack
Property BoxID As Integer
Property LensID As String
Property Operation As OperationType
Property FocusLength As Integer
End Class
Friend Enum OperationType
RemoveLens
SetLens
End Enum

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

VB.NET-Quellcode

C#-Quellcode

C#-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

VB.NET-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

C#-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Ähnliche Themen

8 Benutzer haben hier geschrieben