mirror of
https://github.com/Smaug123/fsharp-prefix-form
synced 2025-10-05 07:48:42 +00:00
First code dump
This commit is contained in:
Smaug123
25
.github/workflows/dotnet-core.yml
vendored
Normal file
25
.github/workflows/dotnet-core.yml
vendored
Normal file
@@ -0,0 +1,25 @@
|
||||
name: .NET Core
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [ main ]
|
||||
pull_request:
|
||||
branches: [ main ]
|
||||
|
||||
jobs:
|
||||
build:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
- name: Setup .NET Core
|
||||
uses: actions/setup-dotnet@v1
|
||||
with:
|
||||
dotnet-version: 5.0.100
|
||||
- name: Install dependencies
|
||||
run: dotnet restore Expression.sln
|
||||
- name: Build
|
||||
run: dotnet build Expression.sln --configuration Release --no-restore
|
||||
- name: Test
|
||||
run: dotnet test Expression.sln --no-restore --verbosity normal
|
||||
8
.gitignore
vendored
Normal file
8
.gitignore
vendored
Normal file
@@ -0,0 +1,8 @@
|
||||
bin/
|
||||
obj/
|
||||
/packages/
|
||||
riderModule.iml
|
||||
/_ReSharper.Caches/
|
||||
.idea/
|
||||
.ionide/
|
||||
AdventOfCode.sln.DotSettings.user
|
||||
22
Expression.sln
Normal file
22
Expression.sln
Normal file
@@ -0,0 +1,22 @@
|
||||
|
||||
Microsoft Visual Studio Solution File, Format Version 12.00
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Expression", "Expression\Expression.fsproj", "{5B7A23ED-C981-4C7D-87D5-40C0C0AD377D}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Test", "Test\Test.fsproj", "{15040E44-D6F4-43DE-9830-A43CB46715DA}"
|
||||
EndProject
|
||||
Global
|
||||
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
||||
Debug|Any CPU = Debug|Any CPU
|
||||
Release|Any CPU = Release|Any CPU
|
||||
EndGlobalSection
|
||||
GlobalSection(ProjectConfigurationPlatforms) = postSolution
|
||||
{5B7A23ED-C981-4C7D-87D5-40C0C0AD377D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{5B7A23ED-C981-4C7D-87D5-40C0C0AD377D}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{5B7A23ED-C981-4C7D-87D5-40C0C0AD377D}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{5B7A23ED-C981-4C7D-87D5-40C0C0AD377D}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{15040E44-D6F4-43DE-9830-A43CB46715DA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{15040E44-D6F4-43DE-9830-A43CB46715DA}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{15040E44-D6F4-43DE-9830-A43CB46715DA}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{15040E44-D6F4-43DE-9830-A43CB46715DA}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
EndGlobalSection
|
||||
EndGlobal
|
||||
179
Expression/Expression.fs
Normal file
179
Expression/Expression.fs
Normal file
@@ -0,0 +1,179 @@
|
||||
namespace Expression
|
||||
|
||||
open Expression.Internals
|
||||
|
||||
type BinaryOperation =
|
||||
| Plus
|
||||
| Minus
|
||||
| Times
|
||||
| Divide
|
||||
|
||||
type Expr =
|
||||
| Variable of char
|
||||
| Const of int
|
||||
| BinaryOperation of BinaryOperation * Expr * Expr
|
||||
|
||||
type Token =
|
||||
| BinaryOperation of BinaryOperation
|
||||
| Variable of char
|
||||
| Const of int
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Expr =
|
||||
[<RequireQualifiedAccess>]
|
||||
module Seq =
|
||||
let tokenise (input : string) : Token seq =
|
||||
seq {
|
||||
let mutable i = 0
|
||||
let mutable currentInt = None
|
||||
|
||||
while i < input.Length do
|
||||
match currentInt with
|
||||
| None ->
|
||||
match input.[i] with
|
||||
| '+' -> yield Token.BinaryOperation BinaryOperation.Plus
|
||||
| '*' -> yield Token.BinaryOperation BinaryOperation.Times
|
||||
| '-' -> yield Token.BinaryOperation BinaryOperation.Minus
|
||||
| '/' -> yield Token.BinaryOperation BinaryOperation.Divide
|
||||
| ' ' -> ()
|
||||
| Int j ->
|
||||
currentInt <- Some j
|
||||
| x -> yield Token.Variable x
|
||||
i <- i + 1
|
||||
| Some j ->
|
||||
match input.[i] with
|
||||
| Int k ->
|
||||
currentInt <- Some (10 * j + k)
|
||||
i <- i + 1
|
||||
| _ ->
|
||||
yield Token.Const j
|
||||
currentInt <- None
|
||||
|
||||
match currentInt with
|
||||
| None -> ()
|
||||
| Some j -> yield Token.Const j
|
||||
}
|
||||
|
||||
let make (t : Token seq) : Expr =
|
||||
use e = t.GetEnumerator ()
|
||||
let mutable opStack : (BinaryOperation * Expr option) list = []
|
||||
let mutable answer = None
|
||||
let rec addArg (expr : Expr) =
|
||||
match opStack with
|
||||
| [] ->
|
||||
match answer with
|
||||
| None -> answer <- Some expr
|
||||
| Some _ -> failwith "imbalance"
|
||||
| (op, None) :: rest ->
|
||||
opStack <- (op, Some expr) :: rest
|
||||
| (op, Some x) :: rest ->
|
||||
opStack <- rest
|
||||
addArg (Expr.BinaryOperation (op, x, expr))
|
||||
|
||||
while e.MoveNext () do
|
||||
match e.Current with
|
||||
| Token.Const i ->
|
||||
addArg (Expr.Const i)
|
||||
| Token.Variable x ->
|
||||
addArg (Expr.Variable x)
|
||||
| Token.BinaryOperation op ->
|
||||
opStack <- (op, None) :: opStack
|
||||
|
||||
match answer with
|
||||
| None -> failwith "still waiting"
|
||||
| Some a -> a
|
||||
|
||||
let tokenise (input : string) : Token list =
|
||||
let rec go (currentInt : int option) (acc : Token list) (i : int) =
|
||||
match currentInt with
|
||||
| None ->
|
||||
if i >= input.Length then acc else
|
||||
match input.[i] with
|
||||
| '+' -> go None (Token.BinaryOperation BinaryOperation.Plus :: acc) (i + 1)
|
||||
| '*' -> go None (Token.BinaryOperation BinaryOperation.Times :: acc) (i + 1)
|
||||
| '-' -> go None (Token.BinaryOperation BinaryOperation.Minus :: acc) (i + 1)
|
||||
| '/' -> go None (Token.BinaryOperation BinaryOperation.Divide :: acc) (i + 1)
|
||||
| ' ' -> go None acc (i + 1)
|
||||
| Int j -> go (Some j) acc (i + 1)
|
||||
| x -> go None (Token.Variable x :: acc) (i + 1)
|
||||
| Some j ->
|
||||
if i >= input.Length then Token.Const j :: acc else
|
||||
match input.[i] with
|
||||
| Int k -> go (Some (10 * j + k)) acc (i + 1)
|
||||
| _ -> go None (Token.Const j :: acc) i
|
||||
|
||||
go None [] 0
|
||||
|> List.rev
|
||||
|
||||
let make (t : Token list) : Expr =
|
||||
let rec go (t : Token list) : Expr * Token list =
|
||||
match t with
|
||||
| [] -> failwith "Received an empty token list!"
|
||||
| Token.BinaryOperation op :: rest ->
|
||||
let expr1, rest = go rest
|
||||
let expr2, rest = go rest
|
||||
Expr.BinaryOperation (op, expr1, expr2), rest
|
||||
| Token.Const i :: rest -> Expr.Const i, rest
|
||||
| Token.Variable x :: rest -> Expr.Variable x, rest
|
||||
|
||||
let expr, rest = go t
|
||||
if not rest.IsEmpty then failwith "Oh no!"
|
||||
expr
|
||||
|
||||
let rec eval (variables : Map<char, int Set>) (e : Expr) : int Set =
|
||||
match e with
|
||||
| Expr.Const i -> Set.singleton i
|
||||
| Expr.Variable x -> variables.[x]
|
||||
| Expr.BinaryOperation (op, e1, e2) ->
|
||||
let s1 = eval variables e1
|
||||
let s2 = eval variables e2
|
||||
Seq.allPairs s1 s2
|
||||
|> Seq.choose (fun (a, b) ->
|
||||
match op with
|
||||
| Plus -> Some (a + b)
|
||||
| Times -> Some (a * b)
|
||||
| Divide -> if b = 0 then None else Some (a / b)
|
||||
| Minus -> Some (a - b)
|
||||
)
|
||||
|> Set.ofSeq
|
||||
|
||||
let naiveMax (variables : Map<char, int Set>) (e : Expr) : int =
|
||||
eval variables e
|
||||
|> Set.maxElement
|
||||
|
||||
let mapUnion (resolve : 'v -> 'v -> 'v) (m1 : Map<'k, 'v>) (m2 : Map<'k, 'v>) : Map<'k, 'v> =
|
||||
m1
|
||||
|> Map.map (fun k v1 ->
|
||||
match Map.tryFind k m2 with
|
||||
| None -> v1
|
||||
| Some v2 -> resolve v1 v2
|
||||
)
|
||||
|
||||
let rec counts (e : Expr) : Map<char, int> =
|
||||
match e with
|
||||
| Expr.BinaryOperation (_, e1, e2) ->
|
||||
mapUnion (+) (counts e1) (counts e2)
|
||||
| Expr.Const _ -> Map.empty
|
||||
| Expr.Variable x -> Map.ofList [x, 1]
|
||||
|
||||
let max (variables : Map<char, int * int>) (e : Expr) : int =
|
||||
// If a variable appears only once in the expression, then the maximum will be attained at an extreme or at 0 or +-1.
|
||||
// I can't be bothered to think too carefully about that, so just try them all.
|
||||
let singleOccurrences =
|
||||
counts e
|
||||
|> Map.toSeq
|
||||
|> Seq.choose (fun (k, v) -> if v = 1 then Some k else None)
|
||||
|> Set.ofSeq
|
||||
let variables =
|
||||
variables
|
||||
|> Map.map (fun k (min, max) ->
|
||||
if Set.contains k singleOccurrences then
|
||||
if min < 0 && max > 0 then Set.ofList [min; -1; 0; 1; max]
|
||||
elif min < 0 && max = 0 then Set.ofList [min; -1; 0]
|
||||
elif min < 0 && max < 0 then Set.ofList [min; max]
|
||||
elif min = 0 then Set.ofList [0; 1; max]
|
||||
else Set.ofList [min ; max]
|
||||
else Set.ofList [min..max]
|
||||
)
|
||||
naiveMax variables e
|
||||
|
||||
12
Expression/Expression.fsproj
Normal file
12
Expression/Expression.fsproj
Normal file
@@ -0,0 +1,12 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net5.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Utils.fs" />
|
||||
<Compile Include="Expression.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
8
Expression/Utils.fs
Normal file
8
Expression/Utils.fs
Normal file
@@ -0,0 +1,8 @@
|
||||
namespace Expression.Internals
|
||||
|
||||
[<AutoOpen>]
|
||||
module ActivePatterns =
|
||||
let (|Int|_|) (c : char) : int option =
|
||||
if '0' <= c && c <= '9' then
|
||||
Some (int(c) - int('0'))
|
||||
else None
|
||||
22
Test/Test.fsproj
Normal file
22
Test/Test.fsproj
Normal file
@@ -0,0 +1,22 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net5.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FsUnit" Version="4.0.2" />
|
||||
<PackageReference Include="NUnit" Version="3.12.0" />
|
||||
<PackageReference Include="NUnit3TestAdapter" Version="3.16.1" />
|
||||
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="16.5.0" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="TestExpression.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\Expression\Expression.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
69
Test/TestExpression.fs
Normal file
69
Test/TestExpression.fs
Normal file
@@ -0,0 +1,69 @@
|
||||
namespace Expression.Test
|
||||
|
||||
open NUnit.Framework
|
||||
open FsUnitTyped
|
||||
open Expression
|
||||
|
||||
[<TestFixture>]
|
||||
module TestExpression =
|
||||
[<Test>]
|
||||
let ``Test tokenise`` () =
|
||||
Expr.tokenise "* + 2 x y"
|
||||
|> Expr.make
|
||||
|> shouldEqual (Expr.BinaryOperation (BinaryOperation.Times, Expr.BinaryOperation (BinaryOperation.Plus, Expr.Const 2, Expr.Variable 'x'), Expr.Variable 'y'))
|
||||
Expr.tokenise "+ 6 * - 4 + 2 3 8"
|
||||
|> Expr.make
|
||||
|> shouldEqual (Expr.BinaryOperation (BinaryOperation.Plus, Expr.Const 6, Expr.BinaryOperation (Times, Expr.BinaryOperation (Minus, Expr.Const 4, Expr.BinaryOperation (Plus, Expr.Const 2, Expr.Const 3)), Expr.Const 8)))
|
||||
|
||||
[<Test>]
|
||||
let ``Test Seq.tokenise`` () =
|
||||
Expr.Seq.tokenise "* + 2 x y"
|
||||
|> Expr.Seq.make
|
||||
|> shouldEqual (Expr.BinaryOperation (BinaryOperation.Times, Expr.BinaryOperation (BinaryOperation.Plus, Expr.Const 2, Expr.Variable 'x'), Expr.Variable 'y'))
|
||||
Expr.Seq.tokenise "+ 6 * - 4 + 2 3 8"
|
||||
|> Expr.Seq.make
|
||||
|> shouldEqual (Expr.BinaryOperation (BinaryOperation.Plus, Expr.Const 6, Expr.BinaryOperation (Times, Expr.BinaryOperation (Minus, Expr.Const 4, Expr.BinaryOperation (Plus, Expr.Const 2, Expr.Const 3)), Expr.Const 8)))
|
||||
|
||||
[<Test>]
|
||||
let testEval () =
|
||||
Expr.tokenise "* + 2 x y"
|
||||
|> Expr.make
|
||||
|> Expr.eval (Map.ofList ['x', Set.ofList [0 ; 1] ; 'y', Set.ofList [2 ; 3]])
|
||||
|> shouldEqual (Set.ofList [for x in 0..1 do for y in 2..3 do yield (2+x)*y])
|
||||
|
||||
Expr.tokenise "- 0 10"
|
||||
|> Expr.make
|
||||
|> Expr.eval Map.empty
|
||||
|> shouldEqual (Set.singleton -10)
|
||||
|
||||
Expr.tokenise "+ 6 * - 4 + 2 3 8"
|
||||
|> Expr.make
|
||||
|> Expr.eval Map.empty
|
||||
|> shouldEqual (Set.singleton -2)
|
||||
|
||||
Expr.tokenise "+*3 2 1"
|
||||
|> Expr.make
|
||||
|> Expr.eval Map.empty
|
||||
|> shouldEqual (Set.singleton 7)
|
||||
|
||||
[<Test>]
|
||||
let testEvalSeq () =
|
||||
Expr.Seq.tokenise "* + 2 x y"
|
||||
|> Expr.Seq.make
|
||||
|> Expr.eval (Map.ofList ['x', Set.ofList [0 ; 1] ; 'y', Set.ofList [2 ; 3]])
|
||||
|> shouldEqual (Set.ofList [for x in 0..1 do for y in 2..3 do yield (2+x)*y])
|
||||
|
||||
Expr.Seq.tokenise "- 0 10"
|
||||
|> Expr.Seq.make
|
||||
|> Expr.eval Map.empty
|
||||
|> shouldEqual (Set.singleton -10)
|
||||
|
||||
Expr.Seq.tokenise "+ 6 * - 4 + 2 3 8"
|
||||
|> Expr.Seq.make
|
||||
|> Expr.eval Map.empty
|
||||
|> shouldEqual (Set.singleton -2)
|
||||
|
||||
Expr.Seq.tokenise "+*3 2 1"
|
||||
|> Expr.Seq.make
|
||||
|> Expr.eval Map.empty
|
||||
|> shouldEqual (Set.singleton 7)
|
||||
Reference in New Issue
Block a user