2121578
/
pr3-elm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

PU2: Finished system logic 

Signed-off-by: Skyball2000 <thomas3654william@gmail.com>
main
Yan Wittmann 2022-12-13 18:17:48 +01:00 committed by Skyball2000
parent c69417493e
commit 6dbc61fa6b
3 changed files with 255 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

231
aufgaben/src/Date.elm
View File

@ -1,203 +1,96 @@
module Pflichtuebung_01.Date exposing (..)
module Date exposing (..) module Date exposing (..)
import String exposing (fromInt)
type Weekday
= Mon
| Tue
| Wed
| Thu
| Fri
| Sat
| Sun
type alias Day = type alias Day =
Int Int
type alias Month = type alias Month =
Int Int
type alias Year = type alias Year =
Int Int
type alias Date = type alias Date =
( Day, Month, Year ) ( Day, Month, Year )
-- 1 Punkt:
year : Date -> Year year : Date -> Year
year ( _, _, y ) = year (_, _, c) = c
y
month : Date -> Month month : Date -> Month
month ( _, m, _ ) = month (_, b, _) = b
m
day : Date -> Day day : Date -> Day
day ( d, _, _ ) = day (a, _, _) = a
d
-- 1 Punkt:
lt : Date -> Date -> Bool lt : Date -> Date -> Bool
lt ( d1, m1, y1 ) ( d2, m2, y2 ) = lt date1 date2 =
(y1 < y2) || (y1 == y2 && m1 < m2) || (y1 == y2 && m1 == m2 && d1 < d2) let (d1, m1, y1) = date1
(d2, m2, y2) = date2
in y1 < y2 || (y1 == y2 && (m1 < m2 || (m1 == m2 && d1 < d2)))
eq : Date -> Date -> Bool eq : Date -> Date -> Bool
eq ( d1, m1, y1 ) ( d2, m2, y2 ) = eq date1 date2 =
y1 == y2 && m1 == m2 && d1 == d2 let (d1, m1, y1) = date1
(d2, m2, y2) = date2
in y1 == y2 && m1 == m2 && d1 == d2
gt : Date -> Date -> Bool gt : Date -> Date -> Bool
gt ( d1, m1, y1 ) ( d2, m2, y2 ) = gt date1 date2 =
(y1 > y2) || (y1 == y2 && m1 > m2) || (y1 == y2 && m1 == m2 && d1 > d2) let (d1, m1, y1) = date1
(d2, m2, y2) = date2
in y1 > y2 || (y1 == y2 && (m1 > m2 || (m1 == m2 && d1 > d2)))
-- 1 Punkt:
toString : Date -> String toString : Date -> String
toString ( d, m, y ) = toString (a,b,c) = (if a < 10 then "0" ++ String.fromInt(a) else String.fromInt(a)) ++ "."
let ++ (if b < 10 then "0" ++ String.fromInt(b) else String.fromInt(b)) ++ "."
d0 = ++ (if c < 10 then "000" ++ String.fromInt(c)
if (d // 10) == 0 then else if c < 100 then "00" ++ String.fromInt(c)
"0" else if c < 1000 then "0" ++ String.fromInt(c)
else String.fromInt(c))
else
""
m0 = -- https://web.archive.org/web/20170507133619/https://alcor.concordia.ca/~gpkatch/gdate-algorithm.html
if (m // 10) == 0 then
"0"
else convertDateToDayNumber : Date -> Int
"" convertDateToDayNumber (a, b, c) =
let m = (modBy 12 (b + 9))
y = c - m // 10
in 365 * y + y // 4 - y // 100 + y // 400 + (m * 306 + 5) // 10 + ( a - 1 )
convertDayNumberToDate : Int -> Date
convertDayNumberToDate g =
let y = (10000 * g + 14780) // 3652425
ddd = g - (365 * y + y // 4 - y // 100 + y // 400)
in in
d0 ++ fromInt d ++ "." ++ m0 ++ fromInt m ++ "." ++ fromInt y if (ddd < 0) then
let y2 = y - 1 -- y = y2
ddd2 = g - (365 * y2 + y2 // 4 - y2 // 100 + y2 // 400) -- ddd = ddd2
next : Date -> Date mi = (100 * ddd2 + 52) // 3060
next ( d, m, y ) = mm = (modBy (12) (mi + 2)) + 1
case ( d, m, y ) of y3 = y2 + (mi + 2) // 12 -- y = y3
( 31, 12, _ ) -> dd = ddd2 - (mi * 306 + 5) // 10 + 1
( 1, 1, y + 1 ) in (dd, mm, y3)
else
( 30, 11, _ ) -> let mi = (100 * ddd + 52) // 3060
( 1, 12, y ) mm = (modBy (12) (mi + 2)) + 1
y2 = y + (mi + 2) // 12 -- y = y2
( 31, 10, _ ) -> dd = ddd - (mi * 306 + 5) // 10 + 1
( 1, 11, y ) in (dd, mm, y2)
( 30, 9, _ ) ->
( 1, 10, y )
( 31, 8, _ ) ->
( 1, 9, y )
( 31, 7, _ ) ->
( 1, 8, y )
( 30, 6, _ ) ->
( 1, 7, y )
( 31, 5, _ ) ->
( 1, 6, y )
( 30, 4, _ ) ->
( 1, 5, y )
( 31, 3, _ ) ->
( 1, 4, y )
( 29, 2, _ ) ->
( 1, 3, y )
( 28, 2, _ ) ->
if leapyear y then
( 29, 2, y )
else
( 1, 3, y )
( 31, 1, _ ) ->
( 1, 2, y )
_ ->
( d + 1, m, y )
prev : Date -> Date
prev ( d, m, y ) =
case ( d, m, y ) of
( 1, 12, _ ) ->
( 30, 11, y )
( 1, 11, _ ) ->
( 31, 10, y )
( 1, 10, _ ) ->
( 30, 9, y )
( 1, 9, _ ) ->
( 31, 8, y )
( 1, 8, _ ) ->
( 31, 7, y )
( 1, 7, _ ) ->
( 30, 6, y )
( 1, 6, _ ) ->
( 31, 5, y )
( 1, 5, _ ) ->
( 30, 4, y )
( 1, 4, _ ) ->
( 31, 3, y )
( 1, 3, _ ) ->
if leapyear y then
( 29, 2, y )
else
( 28, 2, y )
( 1, 2, _ ) ->
( 31, 1, y )
( 1, 1, _ ) ->
( 31, 12, y - 1 )
_ ->
( d - 1, m, y )
-- 1 Punkt:
leapyear : Year -> Bool leapyear : Year -> Bool
leapyear y = leapyear y = ((modBy 4 y == 0) && (modBy 100 y /= 0)) || (modBy 400 y == 0)
(modBy 4 y == 0) && ((modBy 100 y /= 0) || (modBy 400 y == 0))
-- 2 Punkte:
next : Date -> Date
next date = convertDayNumberToDate ((convertDateToDayNumber date) + 1)
-- 2 Punkte:
prev : Date -> Date
prev date = convertDayNumberToDate ((convertDateToDayNumber date) - 1)
-- 2 Punkte:
sub : Date -> Date -> Int sub : Date -> Date -> Int
sub d1 d2 = sub date1 date2 = convertDateToDayNumber date1 - convertDateToDayNumber date2
subHelp 0 d1 d2
{- um optimierbare End-Rekursion zu erreichen: Akkumulator als Argument -}
subHelp : Int -> Date -> Date -> Int
subHelp diff d1 d2 =
if gt d1 d2 then
subHelp (diff + 1) d1 (next d2)
else if lt d1 d2 then
subHelp (diff - 1) d1 (prev d2)
else
diff

40
pu2/src/Date.elm
View File

@ -179,6 +179,8 @@ leapyear : Year -> Bool
leapyear y = leapyear y =
(modBy 4 y == 0) && ((modBy 100 y /= 0) || (modBy 400 y == 0)) (modBy 4 y == 0) && ((modBy 100 y /= 0) || (modBy 400 y == 0))
{-
BROKEN IMPLEMENTATION:
sub : Date -> Date -> Int sub : Date -> Date -> Int
sub d1 d2 = sub d1 d2 =
@ -199,5 +201,39 @@ subHelp diff d1 d2 =
else else
diff diff
-}
sub : Date -> Date -> Int
sub date1 date2 = convertDateToDayNumber date1 - convertDateToDayNumber date2
-- https://web.archive.org/web/20170507133619/https://alcor.concordia.ca/~gpkatch/gdate-algorithm.html
convertDateToDayNumber : Date -> Int
convertDateToDayNumber (a, b, c) =
let m = (modBy 12 (b + 9))
y = c - m // 10
in 365 * y + y // 4 - y // 100 + y // 400 + (m * 306 + 5) // 10 + ( a - 1 )
convertDayNumberToDate : Int -> Date
convertDayNumberToDate g =
let y = (10000 * g + 14780) // 3652425
ddd = g - (365 * y + y // 4 - y // 100 + y // 400)
in
if (ddd < 0) then
let y2 = y - 1 -- y = y2
ddd2 = g - (365 * y2 + y2 // 4 - y2 // 100 + y2 // 400) -- ddd = ddd2
mi = (100 * ddd2 + 52) // 3060
mm = (modBy (12) (mi + 2)) + 1
y3 = y2 + (mi + 2) // 12 -- y = y3
dd = ddd2 - (mi * 306 + 5) // 10 + 1
in (dd, mm, y3)
else
let mi = (100 * ddd + 52) // 3060
mm = (modBy (12) (mi + 2)) + 1
y2 = y + (mi + 2) // 12 -- y = y2
dd = ddd - (mi * 306 + 5) // 10 + 1
in (dd, mm, y2)

225
pu2/src/Main.elm
View File

@ -12,12 +12,50 @@ import Time exposing (Posix)
import Date exposing (..) import Date exposing (..)
{-
NOTE:
The Date.sub implementation provided is broken. It will not terminate given specific parameters, such as (29, 2, 2022) (21, 12, 2022).
We have replaced it with our own implementation seen below, which is also more efficient, running in O(1) compared to O(n):
sub : Date -> Date -> Int
sub date1 date2 = convertDateToDayNumber date1 - convertDateToDayNumber date2
-- https://web.archive.org/web/20170507133619/https://alcor.concordia.ca/~gpkatch/gdate-algorithm.html
convertDateToDayNumber : Date -> Int
convertDateToDayNumber (a, b, c) =
let m = (modBy 12 (b + 9))
y = c - m // 10
in 365 * y + y // 4 - y // 100 + y // 400 + (m * 306 + 5) // 10 + ( a - 1 )
convertDayNumberToDate : Int -> Date
convertDayNumberToDate g =
let y = (10000 * g + 14780) // 3652425
ddd = g - (365 * y + y // 4 - y // 100 + y // 400)
in
if (ddd < 0) then
let y2 = y - 1 -- y = y2
ddd2 = g - (365 * y2 + y2 // 4 - y2 // 100 + y2 // 400) -- ddd = ddd2
mi = (100 * ddd2 + 52) // 3060
mm = (modBy (12) (mi + 2)) + 1
y3 = y2 + (mi + 2) // 12 -- y = y3
dd = ddd2 - (mi * 306 + 5) // 10 + 1
in (dd, mm, y3)
else
let mi = (100 * ddd + 52) // 3060
mm = (modBy (12) (mi + 2)) + 1
y2 = y + (mi + 2) // 12 -- y = y2
dd = ddd - (mi * 306 + 5) // 10 + 1
in (dd, mm, y2)
-}
type alias Model = type alias Model =
{ {
arbeit : Arbeit arbeit : Arbeit
, beginndatum : Date , beginndatum : Date
, besprechungsWochentag : Weekday , besprechungsWochentag : Weekday
, anzahlWochenZwischenBesprechung : Int , anzahlWochenZwischenBesprechung : Int
, status : String
, zone : Time.Zone , zone : Time.Zone
, time : Time.Posix , time : Time.Posix
} }
@ -42,6 +80,7 @@ init _ = (
, beginndatum = (21, 12, 2022) , beginndatum = (21, 12, 2022)
, besprechungsWochentag = Mon , besprechungsWochentag = Mon
, anzahlWochenZwischenBesprechung = 1 , anzahlWochenZwischenBesprechung = 1
, status = ""
, zone = Time.utc , zone = Time.utc
, time = Time.millisToPosix 0 , time = Time.millisToPosix 0
} , Task.perform AdjustTimeZone Time.here } , Task.perform AdjustTimeZone Time.here
@ -67,17 +106,14 @@ getWeekday date =
addWeekdays : Int -> Weekday -> Weekday addWeekdays : Int -> Weekday -> Weekday
addWeekdays count day = addWeekdays count day =
if count < 0 if count < 0 then
then case count of
case count of 0 -> day
0 -> day _ -> addWeekdays (count + 1) (prevWeekDay day)
_ -> addWeekdays (count + 1) (prevWeekDay day) else if count > 0 then
else case count of
if count == 0 0 -> day
then _ -> addWeekdays (count - 1) (nextWeekDay day)
case count of
0 -> day
_ -> addWeekdays (count - 1) (nextWeekDay day)
else day else day
nextWeekDay : Weekday -> Weekday nextWeekDay : Weekday -> Weekday
@ -94,13 +130,13 @@ nextWeekDay day =
prevWeekDay : Weekday -> Weekday prevWeekDay : Weekday -> Weekday
prevWeekDay day = prevWeekDay day =
case day of case day of
Mon -> Tue Mon -> Sun
Tue -> Wed Tue -> Mon
Wed -> Thu Wed -> Tue
Thu -> Fri Thu -> Wed
Fri -> Sat Fri -> Thu
Sat -> Sun Sat -> Fri
Sun -> Mon Sun -> Sat
getMonthLength : Date -> Int getMonthLength : Date -> Int
getMonthLength date = getMonthLength date =
@ -119,6 +155,8 @@ getMonthLength date =
12 -> 31 12 -> 31
_ -> 30 _ -> 30
{- will increment the month count by the given amount. Supports a max of 12 months to be added. Will limit the day to
the amount of days the new month has. -}
addMonthsLiterally : Int -> Date -> Date addMonthsLiterally : Int -> Date -> Date
addMonthsLiterally count date = addMonthsLiterally count date =
let newMonth = (Date.month date) + count let newMonth = (Date.month date) + count
@ -126,6 +164,32 @@ addMonthsLiterally count date =
newDateMonthLength = getMonthLength newDate newDateMonthLength = getMonthLength newDate
in if Date.day newDate > newDateMonthLength then (Date.day date, newDateMonthLength, Date.year date) else newDate in if Date.day newDate > newDateMonthLength then (Date.day date, newDateMonthLength, Date.year date) else newDate
skipWeekend : Date -> Date
skipWeekend date =
case getWeekday date of
Sat -> addDays 2 date
Sun -> addDays 1 date
_ -> date
{- will advance the date so long until all days in [Mon, Tue, Wed, Thu, Fri] are covered.
This does not include the first day -}
advanceByEntireWorkWeek : Date -> Date
advanceByEntireWorkWeek date =
date
|> skipDaysWhilstSkippingWeekend 5
|> skipWeekend
skipDaysWhilstSkippingWeekend : Int -> Date -> Date
skipDaysWhilstSkippingWeekend count date =
if count <= 0 then date else
skipDaysWhilstSkippingWeekend (count - 1) (date
|> skipWeekend
|> Date.next)
formatDateOutput : Date -> String
formatDateOutput date =
String.fromInt (Date.day date) ++ "." ++ String.fromInt (Date.month date) ++ "." ++ String.fromInt (Date.year date)
calculateAbgabeEndDate : Arbeit -> Date -> Date calculateAbgabeEndDate : Arbeit -> Date -> Date
calculateAbgabeEndDate arbeit date = calculateAbgabeEndDate arbeit date =
case arbeit of case arbeit of
@ -133,15 +197,41 @@ calculateAbgabeEndDate arbeit date =
Master -> Date.prev (addMonthsLiterally 6 date) Master -> Date.prev (addMonthsLiterally 6 date)
validiereModel : Model -> Result String String validateModel : Model -> Result String String
validiereModel model = validateModel model =
case model.besprechungsWochentag of case model.besprechungsWochentag of
Sat -> Err "Datum darf kein Samstag sein" Sat -> Err "Datum darf kein Samstag sein"
Sun -> Err "Datum darf kein Sonntag sein" Sun -> Err "Datum darf kein Sonntag sein"
_ -> Ok "Alles klärchen" _ -> case model.beginndatum of
(day, month, year) -> if day > getMonthLength (day, month, year) || day < 0 then
Err "Tag ist außerhalb des Monats"
else if month < 1 || month > 12 then
Err "Monat muss zwischen 1 und 12 liegen"
else if year < 1000 || year > 9999 then
Err "Jahr muss größer als 1000 und kleiner als 9999 sein"
else Ok ""
findNextDateOfWeekday : Date -> Weekday -> Date
findNextDateOfWeekday date weekday =
if getWeekday date == weekday then date else findNextDateOfWeekday (Date.next date) weekday
berechneDaten : Model -> List String berechneDaten : Model -> List String
berechneDaten model = [] {- TODO -} berechneDaten model =
let beginndatum = model.beginndatum
enddatum = calculateAbgabeEndDate model.arbeit beginndatum
besprechungsWochentag = model.besprechungsWochentag
anzahlWochenZwischenBesprechung = model.anzahlWochenZwischenBesprechung
in List.concat [
((formatDateOutput beginndatum) ++ " (Beginn)") :: (berechneZwischentermine (findNextDateOfWeekday (Date.next beginndatum) besprechungsWochentag) enddatum anzahlWochenZwischenBesprechung besprechungsWochentag)
, [(formatDateOutput enddatum) ++ " (Ende)"]
]
berechneZwischentermine : Date -> Date -> Int -> Weekday -> List String
berechneZwischentermine datum enddatum wochenAbstand wochentag =
let nextBesprechung = addDays (wochenAbstand * 7) datum
isOver = Date.gt datum enddatum || Date.eq datum enddatum
in if isOver then [] else
((formatDateOutput datum) ++ " (Besprechung)") :: (berechneZwischentermine nextBesprechung enddatum wochenAbstand wochentag)
monthToIndex : Time.Month -> Int monthToIndex : Time.Month -> Int
monthToIndex month = monthToIndex month =
@ -161,47 +251,50 @@ monthToIndex month =
getCurrentDate : Model -> Date getCurrentDate : Model -> Date
getCurrentDate model = getCurrentDate model =
let date = Time.now (
in Time.toDay model.zone model.time
( , monthToIndex (Time.toMonth model.zone model.time)
Time.toDay model.zone model.time , Time.toYear model.zone model.time
, monthToIndex (Time.toMonth model.zone model.time) )
, Time.toYear model.zone model.time
)
update : Msg -> Model -> (Model, Cmd Msg) update : Msg -> Model -> (Model, Cmd Msg)
update msg model = update msg model =
(case msg of let newModel = case msg of
SetStartDate date -> SetStartDate date ->
{model | beginndatum = ( {model | beginndatum = (
case (String.split " " date) of case (String.split " " date) of
["asap"] -> getCurrentDate model ["asap"] -> advanceByEntireWorkWeek (getCurrentDate model)
["ASAP"] -> getCurrentDate model ["ASAP"] -> advanceByEntireWorkWeek (getCurrentDate model)
[d, m, y] -> case [String.toInt d, String.toInt m, String.toInt y] of [d, m, y] -> case [String.toInt d, String.toInt m, String.toInt y] of
[Just a, Just b, Just c] -> (a, b, c) [Just a, Just b, Just c] -> (a, b, c)
_ -> (21, 12, 2022) _ -> (21, 12, 2022)
_ ->(21, 12, 2022) _ -> (21, 12, 2022)
) } ) }
SetDegree arbeits -> SetDegree arbeits ->
case arbeits of case arbeits of
"Bachelor" -> {model | arbeit = Bachelor} "Bachelor" -> {model | arbeit = Bachelor}
"Master" -> {model | arbeit = Master} "Master" -> {model | arbeit = Master}
_ -> model _ -> model
SetInterval str -> SetInterval str ->
{model | anzahlWochenZwischenBesprechung = String.toInt str |> Maybe.withDefault 0} {model | anzahlWochenZwischenBesprechung = String.toInt str |> Maybe.withDefault 0}
SetBesprechundsWochentag weekday -> SetBesprechundsWochentag weekday ->
{model | besprechungsWochentag = case weekday of {model | besprechungsWochentag = case weekday of
"Montag" -> Mon "Montag" -> Mon
"Dienstag" -> Tue "Dienstag" -> Tue
"Mittwoch" -> Wed "Mittwoch" -> Wed
"Donnerstag" -> Thu "Donnerstag" -> Thu
"Freitag" -> Fri "Freitag" -> Fri
_ -> Mon _ -> Mon
} }
Tick newTime -> { model | time = newTime } Tick newTime -> { model | time = newTime }
AdjustTimeZone newZone -> { model | zone = newZone } AdjustTimeZone newZone -> { model | zone = newZone }
, Cmd.none) in case validateModel newModel of
Ok a -> ({ newModel | status = case msg of
Tick i -> newModel.status
AdjustTimeZone i -> newModel.status
_ -> a
}, Cmd.none)
Err a -> ({ model | status = a }, Cmd.none)
view : Model -> Html Msg view : Model -> Html Msg
@ -235,15 +328,6 @@ view model =
(model (model
|> berechneDaten |> berechneDaten
|> List.map (\datum -> li [] [text datum])) |> List.map (\datum -> li [] [text datum]))
, text (Debug.toString model.besprechungsWochentag), br[][]
, text (Debug.toString model.beginndatum), br[][]
, text (Debug.toString model.arbeit), br[][]
, text (Debug.toString model.anzahlWochenZwischenBesprechung), br[][]
, text (Debug.toString (getWeekday model.beginndatum)), br[][]
, text (Debug.toString (calculateAbgabeEndDate Bachelor model.beginndatum)), br[][]
, text (Debug.toString (calculateAbgabeEndDate Master model.beginndatum)), br[][]
, text (Debug.toString (getMonthLength model.beginndatum)), br[][]
, text (Debug.toString (Date.sub model.beginndatum (21, 12, 2022))), br[][]
] ]
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
@ -255,4 +339,5 @@ main = Browser.element {
, update = update , update = update
, view = view , view = view
, subscriptions = subscriptions , subscriptions = subscriptions
} }