Building a training set of tags for fsharp about fsharp HOT 16 CLOSED

namespace ForgePlay

module HelloWorld = 

  let hello = "Hello, World!"

module CollatzConjecture

let (|Even|Odd|) input = 
    match input % 2 with
    | 0 -> Even
    | 1 -> Odd

let steps (number: int): int option =
    let rec calculate (number: int) (count: int) =
        match number with
        | i when i <= 0 -> None
        | 1 -> Some count
        | Even -> calculate (number / 2) (count + 1)
        | Odd -> calculate (number * 3 + 1) (count + 1)
    
    calculate number 0

module ArmstrongNumbers

open System

let round (x:float) = int (System.Math.Round x)

let isArmstrongNumber (number: int): bool =  
  let asStr = (string number)
  let lng = String.length asStr
  let sum = asStr |> 
      Seq.toList |> 
      List.map System.Char.GetNumericValue |> 
      List.sumBy (fun e -> pown e lng) |> 
      round

  sum = number  

module DifferenceOfSquares

type DifferenceOfSquares(x) = 
  let range = seq { 1 .. x }
  let square x = pown x 2

  member this.squareOfSums() = 
    Seq.sum range
    |> square

  member this.sumOfSquares() =
    Seq.map square range 
    |> Seq.sum

  member this.difference() = 
    this.squareOfSums() - this.sumOfSquares()

module Pangram

let isPangram (input: string): bool = failwith "You need to implement this function."

let isPangram (input: string): bool =
    let alphabetList = 'a'..'z'

    let mutable duplicateCheck = []

    let mutable counter = 0

    for letter in input do
        if alphabetList |> list.contains true && alphabetList |> duplicateCheck.contains false then
            duplicateCheck += letter
            counter += 1
            
            

module Meetup
open System

type Schedule = First | Second | Third | Fourth | Last | Teenth

let meetupDay (dayOfWeek: DayOfWeek) schedule year month =
    let d = if schedule = Teenth then DateTime(year, month, 13)
            elif schedule = Last then DateTime(year, month, DateTime.DaysInMonth(year, month) - 6)
            else DateTime(year, month, 1)
    let first = int d.DayOfWeek
    let dayNum = int dayOfWeek
    let firstGivenDay = if first < dayNum then d.AddDays (float dayNum - float first)
                        elif first > dayNum then d.AddDays (7. - float first + float dayOfWeek)
                        else d
    match schedule with
    | First | Teenth | Last -> firstGivenDay
    | Second -> firstGivenDay.AddDays 7.
    | Third -> firstGivenDay.AddDays 14.
    | Fourth -> firstGivenDay.AddDays 21.

module PythagoreanTriplet

let triplet x y z = 
    [x; y; z]
    |> List.sort
    |> function
       | [p; q; r] -> (p, q, r)
       | _ -> failwith ""

let isPythagorean (x, y, z) =
    x*x + y*y = z*z

let N = Seq.initInfinite id

let pairs =
    seq {for t in N do for x in [0..t] do yield (x, t - x)}

let triplets =
    seq {
        for (m, n) in pairs do
            let a = m*m - n*n
            let b = 2*m*n
            let c = m*m + n*n
            if a > 0 && b > 0 && c > 0
            then yield triplet a b c
    }

let pythagoreanTriplets low high =
    triplets
    |> Seq.skipWhile (fun (a, b, c) -> a < low || b < low || c < low)
    |> Seq.takeWhile (fun (a, b, c) -> a <= high && b <= high && c <= high)
    |> List.ofSeq

module PrimeFactors

let primes = 
    let rec primesRec candidates =
        seq {
            let nextPrime = candidates |> Seq.head
            yield int64 nextPrime

            let remainingCandidates = 
                candidates 
                |> Seq.tail
                |> Seq.filter (fun el -> el % nextPrime <> 0)   
            yield! primesRec remainingCandidates
        }
    let initialCandidates = Seq.initInfinite <| (+) 2
    primesRec initialCandidates

let factorsFor factors number =
    let rec f acc number =
        if number =1L then 
            acc |> List.rev
        else
            let factor =
                factors
                |> Seq.find (fun p -> number % p = 0L)
            f (factor :: acc) (number / factor) 
    f [] number

let primeFactorsFor = factorsFor primes

namespace RomanNumeral

type RomanNumeral() = 
    let numbers = 
        Map.empty
            .Add(1000, "M")
            .Add(900, "CM")
            .Add(500, "D")
            .Add(400, "CD")
            .Add(100, "C")
            .Add(90, "XC")
            .Add(50, "L")
            .Add(40, "XL")
            .Add(10, "X")
            .Add(9, "IX")
            .Add(5, "V")
            .Add(4, "IV")
            .Add(1, "I")
    let keys = numbers |> Map.toSeq |> Seq.map fst |> Seq.sortBy (fun x -> -x - 1) |> Seq.toList

    member this.toRoman(value: int) =
        this.addNumerals(value, 0)

    member private this.addNumerals(value: int, keyidx: int) =
        if (keyidx >= keys.Length)
        then ""
        else if (value >= keys.[keyidx])
             then (numbers.[keys.[keyidx]] + this.addNumerals(value - keys.[keyidx], keyidx))
             else this.addNumerals(value, keyidx + 1)

module CircularBuffer

type CircularBuffer<'a> = private {items: 'a option []; nextIn: int; nextOut: int}

module private Internal =
    type Write = Normal | Forced

    let nextIndex i buffer = (i + 1) % buffer.items.Length

    let write x buffer writeType =
        let newItems = Array.copy buffer.items

        let newNextOut =
            match (writeType, newItems.[buffer.nextIn]) with
            | (_, None)        -> buffer.nextOut
            | (Forced, Some _) -> nextIndex buffer.nextOut buffer
            | (Normal, Some _) -> failwith "Buffer full"

        newItems.[buffer.nextIn] <- Some x

        { items = newItems
          nextIn = nextIndex buffer.nextIn buffer
          nextOut = newNextOut }

open Internal

let mkCircularBuffer size =
    { items = Array.init size (fun _ -> None)
      nextIn = 0
      nextOut = 0 }

let write x buffer = Internal.write x buffer Normal

let read buffer =
    let newItems = Array.copy buffer.items
    let outValue = buffer.items.[buffer.nextOut].Value
    newItems.[buffer.nextOut] <- None

    let newBuffer =
        { buffer with
            items = newItems
            nextOut = nextIndex buffer.nextOut buffer }

    (outValue, newBuffer)

let clear buffer = mkCircularBuffer buffer.items.Length

let forceWrite x buffer = Internal.write x buffer Forced

module BankAccount

type BankAccount() = 
    
    let mutable (balance : float option) = None
    member t.Balance = balance

    member t.openAccount() = 
        balance <- Some(0.0)

    member t.updateBalance(x : float) = 
        if balance.IsSome then balance <- Some(balance.Value + x)
        else failwith("account closed")

    member t.getBalance() = balance.Value |> decimal

    member t.closeAccount() = 
        balance <- None

module ComplexNumbers

let create real imaginary = Complex(real, imaginary)

let mul z1 z2 = Complex.Multiply(z1, z2)

let add z1 z2 = Complex.Add(z1, z2)

let sub z1 z2 = Complex.Subtract(z1, z2)

let div z1 z2 = Complex.Divide(z1, z2)

let abs z = Complex.Abs z

let conjugate z = Complex.Conjugate z

let real (z: Complex) = z.Real

let imaginary (z: Complex) = z.Imaginary

let exp z = Complex.Exp z

module RailFenceCipher

open System

let private getPositions n length =
    Seq.init length (fun index ->
        let offset = ((index - 1) % (n - 1)) + 1
        match index with
        | 0 -> (0, 0)
        | _ -> match ((index - 1) / (n - 1)) % 2 with
                | 0 -> (index, offset)
                | _ -> (index, n - 1 - offset)
    )

let encode n input =
    Seq.zip
        ((getPositions n (Seq.length input)) |> Seq.map snd)
        input
    |> Seq.groupBy fst
    |> Seq.map snd
    |> Seq.map (fun row ->
        row
        |> Seq.map snd
        |> Seq.fold (sprintf "%s%c") String.Empty
    )
    |> Seq.fold (sprintf "%s%s") String.Empty

let decode n input =
    let tmp =
        getPositions n (Seq.length input)
        |> Seq.groupBy snd
        |> Seq.map snd
        |> Seq.concat
        |> Seq.map fst

    Seq.zip
        tmp
        input
    |> Seq.sort
    |> Seq.map snd
    |> Seq.fold (sprintf "%s%c") String.Empty

module Pov

type Graph<'a> = 
    | Graph of 'a * 'a Graph List
    member x.children = let (Graph(_, xs)) = x in xs
    member x.value = let (Graph(v, _)) = x in v
    override x.ToString() = 
        match x with
        | Graph(v,[]) -> v.ToString()
        | Graph(v,xs) -> sprintf "(%O,%O)" v xs

type Path<'a> = 
    | Top
    | Node of 'a * 'a Graph List * 'a Path * 'a Graph List
    override x.ToString() = 
        match x with
        | Top -> "T"
        | Node(v,xs,p,ys) -> sprintf "(%O,L%O,%O,R%O)" v xs p ys

type Location<'a> = 
    Loc of 'a Graph option * 'a Path

let left (Loc(t,p)) = 
    match t with
    | None -> failwith "left of none"
    | Some(g) -> 
        match p with
        | Top -> failwith "left of top"
        | Node(v,l::left,up,right) -> Loc(Some(l),Node(v,left,up,g::right))
        | Node(v,[],up,right) -> failwith "left of first"

let right (Loc(t,p)) = 
    match t with
    | None -> failwith "left of none"
    | Some(g) -> 
        match p with
        | Top -> failwith "right of top"
        | Node(v,left,up,r::right) -> Loc(Some(r),Node(v,g::left,up,right))
        | _ -> failwith "right of last"

let up (Loc(t,p)) = 
    match p with
    | Top -> failwith "up of top"
    | Node(v,left,up,right) -> 
        let rr = 
            match t with
            | None -> right
            | Some(x) -> x::right
        Loc(Some(Graph(v, (left |> List.rev) @ (rr))),up)

let down (Loc(t,p)) = 
    match t with
    | None -> failwith "down of none"
    | Some(Graph(_,[])) -> failwith "down of item"
    | Some(Graph(v,t1::graphs)) -> Loc(Some(t1),Node(v,[],p,graphs))

let rec toGraph lc = 
    match lc with
    | Loc(gr, Top) -> gr
    | lc -> toGraph (up lc)

let fromGraph gr = Loc(Some(gr), Top)

let mkGraph v xs = Graph(v,xs)

let rec search v lc = 
    match lc with
    | Loc(None,_) -> None
    | Loc(Some(Graph(x,_)),_) when v = x -> Some(lc)
    | Loc(Some(Graph(x,xs)),Top) -> 
        match xs with
        | [] -> None
        | _ ->
            //printfn "search down from top"
            lc |> down |> search v
    | Loc(Some(Graph(x,xs)),p) -> 
        match xs with
        | [] -> 
            match p with
            | Node(_,_,_,[]) -> None
            | _ -> 
                //printfn "search right from %O" x
                lc |> right |> search v
        | _ ->
            let downFounded = 
                //printfn "search down from %O" x
                lc |> down |> search v
            match downFounded with
            | Some(_) -> downFounded
            | None -> 
                match p with
                | Node(_,_,_,[]) -> None
                | _ -> 
                    //printfn "search right from %O" x
                    lc |> right |> search v

let delete (Loc(x,p)) = 
    match p with
    | Top -> failwith "delete of top"
    | Node(v,left,up,r::right) -> Loc(Some(r),Node(v,left,up,right))
    | Node(v,l::left,up,[]) -> Loc(Some(l),Node(v,left,up,[]))
    | Node(v,[],up,[]) -> Loc(None, p)

let rec fromPOVLoc lc = 
    match lc with
    | Loc(None,_) -> []
    | Loc(Some(gr),Top) -> [gr]
    | Loc(Some(Graph(x,children)),_) -> 
        let upperPOV = lc |> delete |> up |> fromPOVLoc
        [Graph(x, children@upperPOV)]

let rec fromPOV v tree = 
    let founded = 
        tree
        |> fromGraph
        |> search v
    match founded with
    | None -> None
    | Some(lc) -> 
        lc
        |> fromPOVLoc
        |> List.head
        |> Option.Some

let trace p tree = 
    let rec findInner acc t =
        match t with
        | Graph(n, _) when p(n) -> Some(acc@[n])
        | Graph(x, children) -> children |> Seq.choose (findInner (acc@[x])) 
                                          |> Seq.tryFind (fun _ -> true)
        | Graph(_, []) -> Some([])
    findInner [] tree

let tracePathBetween v1 v2 tree = 
    let pov = tree |> fromPOV v1
    match pov with
    | None -> None
    | Some(pv) -> pv |> trace (fun x -> x = v2)

module DndCharacter

open System

let modifier (x : int) =
    float(x - 10) / 2.0
    |> Math.Floor
    |> int

let ability() = 
    let seed = Random()
    let d6 = seed.Next(1,6)
    [ d6; d6 ; d6 ; d6 ]
    |> List.sortDescending
    |> List.take 3
    |> List.sum

type DndCharacter() =
    let (str, dex, con, wis, intel, chr) = 
        (ability(), ability(), ability(), ability(), ability(), ability())

    member __.Strength with get() = str
    member __.Dexterity with get() = dex
    member __.Constitution with get() = con
    member __.Intelligence with get() = intel
    member __.Wisdom with get() = wis
    member __.Charisma with get() = chr
    member __.Hitpoints with get() = 10 + modifier(__.Constitution)