Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit9568905

Browse files
committed
Haskell day 3
1 parentc5c4425 commit9568905

File tree

2 files changed

+139
-0
lines changed

2 files changed

+139
-0
lines changed

‎2018/03_1/haskell/appositum.hs‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
{-#LANGUAGE RecordWildCards #-}
2+
3+
importControl.Applicative (some)
4+
importData.Map (Map)
5+
importqualifiedData.MapasM
6+
importText.Parsec (char,digit,parse,spaces,Parsec)
7+
importSystem.Environment (getArgs)
8+
9+
dataClaim=MkClaim
10+
{claimId,leftEdge,topEdge,width,height::!Integer
11+
}deriving (Eq,Show)
12+
13+
typeFabric=Map (Integer,Integer)Integer
14+
typeParser=ParsecString()
15+
16+
main::IO()
17+
main=do
18+
args<- getArgs
19+
case argsof
20+
[]->putStrLn"Usage: ./appositum input.txt"
21+
(arg:_)->do
22+
readFile arg>>=print. overlap. cut. getClaims.lines
23+
24+
cut:: [Claim]->Fabric
25+
cut= occurrences.concatMap coords
26+
27+
overlap::Fabric->Integer
28+
overlap= count (>1)
29+
30+
count::Foldablet=> (a->Bool)->ta->Integer
31+
count p=foldr (\x acc->if p xthen acc+1else acc)0
32+
33+
occurrences::Orda=> [a]->MapaInteger
34+
occurrences=M.fromListWith(+).map (\x-> (x,1))
35+
36+
coords::Claim-> [(Integer,Integer)]
37+
coordsMkClaim{..}=do
38+
x<- [leftEdge.. leftEdge+ width-1]
39+
y<- [topEdge.. topEdge+ height-1]
40+
pure (x,y)
41+
42+
getClaims:: [String]-> [Claim]
43+
getClaims=map (justs. parse parseClaimmempty)where
44+
justs (Right x)= x
45+
46+
parseClaim::ParserClaim
47+
parseClaim=do
48+
char'#'
49+
claimID<- integer
50+
symbolic'@'
51+
left<- integer
52+
symbolic','
53+
top<- integer
54+
symbolic':'
55+
width<- integer
56+
char'x'
57+
height<- integer
58+
pure$MkClaim claimID left top width height
59+
60+
integer::ParserInteger
61+
integer=read<$> some digit
62+
63+
symbolic::Char->ParserChar
64+
symbolic c= spaces*> char c<* spaces

‎2018/03_2/haskell/appositum.hs‎

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
{-#LANGUAGE RecordWildCards #-}
2+
3+
importControl.Applicative (some)
4+
importControl.Monad (guard)
5+
importData.Map (Map)
6+
importqualifiedData.MapasM
7+
importText.Parsec (char,digit,parse,spaces,Parsec)
8+
importSystem.Environment (getArgs)
9+
10+
dataClaim=MkClaim
11+
{claimId,leftEdge,topEdge,width,height::!Integer
12+
}deriving (Eq,Show)
13+
14+
typeFabric=Map (Integer,Integer)Integer
15+
typeParser=ParsecString()
16+
17+
main::IO()
18+
main=do
19+
args<- getArgs
20+
case argsof
21+
[]->putStrLn"Usage: ./appositum input.txt"
22+
(arg:_)->do
23+
f<-readFile arg
24+
let claims= getClaims$lines f
25+
let fabric= cut claims
26+
print$ noOverlap fabric claims
27+
28+
cut:: [Claim]->Fabric
29+
cut= occurrences.concatMap coords
30+
31+
overlap::Fabric->Integer
32+
overlap= count (>1)
33+
34+
noOverlap::Fabric-> [Claim]->Integer
35+
noOverlap fabric getClaims=head$do
36+
claim<- getClaims
37+
let intersec=M.intersection fabric (cut [claim])
38+
guard$all (==1) intersec
39+
pure$ claimId claim
40+
41+
count::Foldablet=> (a->Bool)->ta->Integer
42+
count p=foldr (\x acc->if p xthen acc+1else acc)0
43+
44+
occurrences::Orda=> [a]->MapaInteger
45+
occurrences=M.fromListWith(+).map (\x-> (x,1))
46+
47+
coords::Claim-> [(Integer,Integer)]
48+
coordsMkClaim{..}=do
49+
x<- [leftEdge.. leftEdge+ width-1]
50+
y<- [topEdge.. topEdge+ height-1]
51+
pure (x,y)
52+
53+
getClaims:: [String]-> [Claim]
54+
getClaims=map (justs. parse parseClaimmempty)where
55+
justs (Right x)= x
56+
57+
parseClaim::ParserClaim
58+
parseClaim=do
59+
char'#'
60+
claimID<- integer
61+
symbolic'@'
62+
left<- integer
63+
symbolic','
64+
top<- integer
65+
symbolic':'
66+
width<- integer
67+
char'x'
68+
height<- integer
69+
pure$MkClaim claimID left top width height
70+
71+
integer::ParserInteger
72+
integer=read<$> some digit
73+
74+
symbolic::Char->ParserChar
75+
symbolic c= spaces*> char c<* spaces

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp