layout problem
Γιώργος Κοσμίδης
gkosmidis@epsilon7.gr
Wed, 18 Sep 2002 16:32:35 +0300
This is a multi-part message in MIME format.
------=_NextPart_000_0086_01C25F30.FEC22340
Content-Type: text/plain;
charset="iso-8859-7"
Content-Transfer-Encoding: quoted-printable
Hello everyone.
I have a problem with a assessment.
The problem is with the layout.
I cannot understand what is wrong.
Here is the code
module Main where
import IO
import System
import List
import Maybe
import Char
import Numeric
type Word=3DString
type WordCount=3DInt
type WordTup=3D(word,wordCount)
type WordList=3D[WordTup]
main=3Ddo args<-getArgs
textLines<-getText
switchArgs args textLines
where
switchArgs args textLines
|(isMemberOf "-f" args) && (isMemberOf "-i" args)
=3DprintFreq(sortWordCount(parseLcLine =
textLines))
|(isMemberOf "-f" args)
=3DprintFreq(sortWordCount (parseLine =
textLines))
|(isMemberOf "-i" args)
=3DprintFreq(sortWordCount (parseLcLine =
textLines))
|otherwise
=3DprintFreq(sortName (parseLine textLines))
getText::IO String
getText=3Ddo c<-getChar
e<-isEOF
if (e)
then return "" else
(do nc<-getText
return (:nc))
parseLine::String->Wordlist
parseLine line
|(line/=3D"")&&(isWantedChar (headline))
=3DfillWordList w(parseLine newLine)
|(line/=3D"")&&(not(isWantedChar (headline)))
=3DparseLine(tail line)
isMemberOf::String->[String]->Bool
isMemberOf arg args=20
=3D[]/=3D[a|a<-args,a=3D=3Darg]
printFreq::WordList->IO()
printFreq wl=3Ddo sequence (map putWordStat wl)
where=20
putWordStat(Word,WordCount)->IO()
putWordStat(w,wc)
do putStr w
putSpc (20 (length w) (length(show wc)))
putStr (show wc)
putSpc 8
putStr (showFFloat (Just 2) (fromIntegral =
(wc) * 100.0/fromIntegral (wLength))"")
putChar '%'
putChar '\n'
return()
wlLength-countWords wl;
putSpc::Int->IO()
putSpc n
|n>1 do putChar ''
putSpc (n-1)
return()
|otherwise=3DputChar ''
countWords:Wordlist->Int
countWords [ ]
countWords ((w,wc):wl)=3Dwc+countWords wl
sortName::WordList->WordList
sortName [ ] =3D [ ]=20
sortName (wn:ws)=3DsortName [(w,wc) (w,wc) <-ws,not (isGreater =
(w,wc)wc)]
++[wn]++sortName[(w,wc)|(w,wc)<-ws, isGreater (w,wc) =
wn]
where
isGreater (wl,wcl) (w2,wc2)
|ord(head(wl))-ord(head(x2))>0=3DTrue
|ord(head(wl))-ord(head(x2))<0=3DFalse
|length wl>l && length w2>l
=3DisGreater(tail(wl),wcl) (tail(w2,wc2)
|otherwise =3D []
where
w=3DparseWord line
newline=3Ddrop (length w) line
parseLcLine::String->WordList
parseLcLine line
|(line/=3D"") && (isWantedChar (head =
line))=3DfillWordList w (parseLcLine newline)
|(line/=3D"") && (not (isWantedChar (head =
line)))=3DparseLcLine (tail line)
|otherwise =3D []
where
w=3Dmap toLower (parseWord line)
newline=3Ddrop (lenfth w) line
parseWord::Word->Word
parseWord w
|(w/=3D"") && (isWantedChar (head w))=3D(head w): =
parseWord (tail w))
|otherwise =3D ""
isWantedChar::Char->Bool
isWantedChar c
| (c=3D=3D'a'|| c=3D=3D'b'|| c=3D=3D'c'|| =
c=3D=3D'd'|| c=3D=3D'e'|| c=3D=3D'f'|| c=3D=3D'g'|| c=3D=3D'h'|| =
c=3D=3D'i'|| c=3D=3D'j'|| c=3D=3D'k'|| c=3D=3D'l'|| c=3D=3D'm'|| =
c=3D=3D'n'|| c=3D=3D'o'|| c=3D=3D'p'|| c=3D=3D'q'|| c=3D=3D'r'|| =
c=3D=3D's'|| c=3D=3D't'|| c=3D=3D'u'|| c=3D=3D'v'|| c=3D=3D'w'|| =
c=3D=3D'x'|| c=3D=3D'y'|| c=3D=3D'z'||c=3D=3D'A'|| c=3D=3D'B'|| =
c=3D=3D'C'|| c=3D=3D'D'|| c=3D=3D'E'|| c=3D=3D'F'|| c=3D=3D'G'|| =
c=3D=3D'H'|| c=3D=3D'I'|| c=3D=3D'J'|| c=3D=3D'K'|| c=3D=3D'L'|| =
c=3D=3D'M'|| c=3D=3D'N'|| c=3D=3D'O'|| c=3D=3D'P'|| c=3D=3D'Q'|| =
c=3D=3D'R'|| c=3D=3D'S'|| c=3D=3D'T'|| c=3D=3D'U'|| c=3D=3D'V'|| =
c=3D=3D'W'|| c=3D=3D'X'|| c=3D=3D'Y'|| c=3D=3D'Z'|| =3D True)
|otherwise =3D False
fillWordList::Word->WordList->WordList
fillWordList w wordlistl
|cWord/=3D [] =
=3DcWord++[wordl,wordCountl)|(wordl,wordCountl<-wordListl,wordl/=3Dw]
|otherwise =3D (w,l):wordListl
where
cWord=3D[(wordl,(wordCountl-l)) | =
(wordl,wordCountl)<-wordListl,wordl=3D=3Dw]
|length w1>1 && length =
w2=3D=3D1=3DTrue
|otherwise =3D False
sortWordCount::WordList->WordList
sortWordCount [] =3D []
sortWordCount ((wn,wcn):ws=3DsortWordCount =
[(w,wc|cw,wc)<-ws,ws<=3Dwvn++=20
[(wn,wcn)]++sortWordCount =
[(cw,wc)|(w,wc)<-ws,wcs,wcn]
------=_NextPart_000_0086_01C25F30.FEC22340
Content-Type: text/html;
charset="iso-8859-7"
Content-Transfer-Encoding: quoted-printable
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META content=3D"text/html; charset=3Diso-8859-7" =
http-equiv=3DContent-Type>
<META content=3D"MSHTML 5.00.3504.2500" name=3DGENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=3D#ffffff>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>Hello=20
everyone.</FONT></DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>I have a =
problem with a=20
assessment.</FONT></DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>The problem =
is with the=20
layout.</FONT></DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>I cannot =
understand what is=20
wrong.</FONT></DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>Here is the=20
code</FONT></DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>module Main =
where<BR>import=20
IO<BR>import System<BR>import List<BR>import Maybe<BR>import =
Char<BR>import=20
Numeric</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>type =
Word=3DString<BR>type=20
WordCount=3DInt<BR>type WordTup=3D(word,wordCount)<BR>type=20
WordList=3D[WordTup]</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS" size=3D2>main=3Ddo=20
args<-getArgs<BR> =20
textLines<-getText<BR> =
switchArgs=20
args textLines<BR> =20
where<BR> switchArgs args=20
textLines<BR> =
|(isMemberOf=20
"-f" args) && (isMemberOf "-i"=20
args)<BR> &nbs=
p;  =
; =20
=3DprintFreq(sortWordCount(parseLcLine=20
textLines))<BR> &nbs=
p;  =
; =20
|(isMemberOf "-f"=20
args)<BR> &nbs=
p;  =
; =20
=3DprintFreq(sortWordCount (parseLine=20
textLines))<BR> &nbs=
p;  =
; =20
|(isMemberOf "-i"=20
args)<BR> &nbs=
p;  =
; =20
=3DprintFreq(sortWordCount (parseLcLine=20
textLines))<BR> &nbs=
p;  =
; =20
|otherwise<BR>  =
; =
=20
=3DprintFreq(sortName (parseLine=20
textLines))<BR> getText::IO=20
String<BR> getText=3Ddo=20
c<-getChar<BR> &n=
bsp; =20
e<-isEOF<BR> &nbs=
p; =20
if=20
(e)<BR> =
=20
then return ""=20
else<BR>  =
; =20
(do=20
nc<-getText<BR> &=
nbsp; &n=
bsp; =20
return (:nc))<BR> =20
parseLine::String->Wordlist<BR> &nb=
sp;=20
parseLine=20
line<BR>  =
; =20
|(line/=3D"")&&(isWantedChar=20
(headline))<BR> &nbs=
p; =20
=3DfillWordList w(parseLine=20
newLine)<BR> &=
nbsp; =20
|(line/=3D"")&&(not(isWantedChar=20
(headline)))<BR> &nb=
sp; =20
=3DparseLine(tail line)</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS"=20
size=3D2> =20
isMemberOf::String->[String]->Bool<BR>  =
; =20
isMemberOf arg args=20
<BR> &nb=
sp; =20
=3D[]/=3D[a|a<-args,a=3D=3Darg]</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS"=20
size=3D2> =20
printFreq::WordList->IO()<BR>  =
;=20
printFreq wl=3Ddo sequence (map putWordStat=20
wl)<BR> =
=
where=20
<BR> &nb=
sp; =20
putWordStat(Word,WordCount)->IO()<BR> &nb=
sp; &nbs=
p; =20
putWordStat(w,wc)<BR> &nbs=
p;  =
; =20
do putStr=20
w<BR> &n=
bsp; &nb=
sp; =20
putSpc (20 (length w) (length(show=20
wc)))<BR> &nbs=
p;  =
; =20
putStr (show=20
wc)<BR> =
&=
nbsp; =20
putSpc=20
8<BR> &n=
bsp; &nb=
sp; =20
putStr (showFFloat (Just 2) (fromIntegral (wc) * 100.0/fromIntegral=20
(wLength))"")<BR> &n=
bsp; &nb=
sp; =20
putChar=20
'%'<BR> =
&=
nbsp; =20
putChar=20
'\n'<BR>  =
; =
=20
return()<BR> &=
nbsp; &n=
bsp;=20
wlLength-countWords wl;</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS"=20
size=3D2> =20
putSpc::Int->IO()<BR> =
putSpc=20
n<BR> &n=
bsp; =20
|n>1 do putChar=20
''<BR> &=
nbsp; =20
putSpc=20
(n-1)<BR> &nbs=
p; =20
return()<BR> &=
nbsp; =20
|otherwise=3DputChar ''</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS"=20
size=3D2> =20
countWords:Wordlist->Int<BR> =
=20
countWords [ ]<BR> countWords=20
((w,wc):wl)=3Dwc+countWords =
wl<BR> =20
sortName::WordList->WordList<BR> &n=
bsp;=20
sortName [ ] =3D [ ] <BR> =
sortName=20
(wn:ws)=3DsortName [(w,wc) (w,wc) <-ws,not (isGreater=20
(w,wc)wc)]<BR>  =
; =20
++[wn]++sortName[(w,wc)|(w,wc)<-ws, isGreater (w,wc)=20
wn]<BR> =
=20
where<BR> &nbs=
p; =20
isGreater (wl,wcl)=20
(w2,wc2)<BR> &=
nbsp; &n=
bsp; =20
|ord(head(wl))-ord(head(x2))>0=3DTrue<BR>  =
; =
=20
|ord(head(wl))-ord(head(x2))<0=3DFalse<BR> &nbs=
p;  =
; =20
|length wl>l && length=20
w2>l<BR> &n=
bsp; &nb=
sp; =20
=3DisGreater(tail(wl),wcl)=20
(tail(w2,wc2)<BR> &n=
bsp; &nb=
sp; =20
|otherwise =3D=20
[]<BR> &=
nbsp; &n=
bsp; =20
where<BR> &nbs=
p;  =
; =20
w=3DparseWord=20
line<BR>  =
; =
=20
newline=3Ddrop (length w) =
line<BR> =20
parseLcLine::String->WordList<BR> &=
nbsp;=20
parseLcLine=20
line<BR>  =
; =20
|(line/=3D””) && (isWantedChar (head =
line))=3DfillWordList w (parseLcLine=20
newline)<BR> &=
nbsp; =20
|(line/=3D””) && (not (isWantedChar (head =
line)))=3DparseLcLine (tail=20
line)<BR> &nbs=
p; =20
|otherwise =3D=20
[]<BR> &=
nbsp; =20
where<BR> &nbs=
p; =20
w=3Dmap toLower (parseWord=20
line)<BR> &nbs=
p; =20
newline=3Ddrop (lenfth w) =
line<BR> =20
parseWord::Word->Word<BR> =
parseWord=20
w<BR> &n=
bsp; =20
|(w/=3D””) && (isWantedChar (head w))=3D(head w): =
parseWord (tail=20
w))<BR> =
=20
|otherwise =3D “”</FONT></DIV>
<DIV> </DIV>
<DIV><FONT color=3D#0000ff face=3D"Comic Sans MS"=20
size=3D2> =20
isWantedChar::Char->Bool<BR> =
=20
isWantedChar=20
c<BR> &n=
bsp; =20
| (c=3D=3D’a’|| c=3D=3D’b’|| =
c=3D=3D’c’|| c=3D=3D’d’|| =
c=3D=3D’e’|| c=3D=3D’f’|| =
c=3D=3D’g’|| c=3D=3D’h’||=20
c=3D=3D’i’|| c=3D=3D’j’|| =
c=3D=3D’k’|| c=3D=3D’l’|| =
c=3D=3D’m’|| c=3D=3D’n’|| =
c=3D=3D’o’|| c=3D=3D’p’||=20
c=3D=3D’q’|| c=3D=3D’r’|| =
c=3D=3D’s’|| c=3D=3D’t’|| =
c=3D=3D’u’|| c=3D=3D’v’|| =
c=3D=3D’w’|| c=3D=3D’x’|| =
c=3D=3D’y’||=20
c=3D=3D’z’||c=3D=3D’A’|| =
c=3D=3D’B’|| c=3D=3D’C’|| =
c=3D=3D’D’|| c=3D=3D’E’|| =
c=3D=3D’F’|| c=3D=3D’G’|| =
c=3D=3D’H’||=20
c=3D=3D’I’|| c=3D=3D’J’|| =
c=3D=3D’K’|| c=3D=3D’L’|| =
c=3D=3D’M’|| c=3D=3D’N’|| =
c=3D=3D’O’|| c=3D=3D’P’||=20
c=3D=3D’Q’|| c=3D=3D’R’|| =
c=3D=3D’S’|| c=3D=3D’T’|| =
c=3D=3D’U’|| c=3D=3D’V’|| =
c=3D=3D’W’|| c=3D=3D’X’|| =
c=3D=3D’Y’||=20
c=3D=3D’Z’|| =3D=20
True)<BR> &nbs=
p; =20
|otherwise =3D False<BR> =20
fillWordList::Word->WordList->WordList<BR> &=
nbsp; =20
fillWordList w=20
wordlistl<BR> =
=20
|cWord/=3D []=20
=3DcWord++[wordl,wordCountl)|(wordl,wordCountl<-wordListl,wordl/=3Dw]<=
BR> &nbs=
p; =20
|otherwise =3D=20
(w,l):wordListl<BR> =
=20
where<BR> &nbs=
p; =20
cWord=3D[(wordl,(wordCountl-l)) |=20
(wordl,wordCountl)<-wordListl,wordl=3D=3Dw]<BR>  =
; =
&=
nbsp; &n=
bsp; =20
|length w1>1 && length=20
w2=3D=3D1=3DTrue<BR>  =
; =
&=
nbsp; &n=
bsp; =20
|otherwise =3D False<BR> =20
sortWordCount::WordList->WordList<BR> &nb=
sp; =20
sortWordCount [] =3D []<BR> =20
sortWordCount ((wn,wcn):ws=3DsortWordCount =
[(w,wc|cw,wc)<-ws,ws<=3Dwvn++=20
<BR> &nb=
sp; =20
[(wn,wcn)]++sortWordCount =
[(cw,wc)|(w,wc)<-ws,wcs,wcn]<BR></FONT></DIV>
<DIV> </DIV></BODY></HTML>
------=_NextPart_000_0086_01C25F30.FEC22340--