Fortran - Parsing challenge to reduce blanks

Author

Parsing challenge to reduce blanks

David Frank

2005-08-02, 9:10 am

Heres a challenge thats O.T. in another topic and IMO deserves its own
topic.

Challenge:
Create a function that accepts a text line and returns a same length text
output line
but with no blank fields > 1 char in length.
! -----------------------------------------
function reduce_blanks(line) result(outline)
character(*) :: line
character(len(line)) :: outline

my 3 executable statements will be posted tomorrow, anyone know what they
might look like?
JVB claims he has a 2 statement solution but hasnt posted it..

end function

Rich Townsend

2005-08-02, 9:10 am

David Frank wrote:
> Heres a challenge thats O.T. in another topic and IMO deserves its own
> topic.
>
> Challenge:
> Create a function that accepts a text line and returns a same length text
> output line
> but with no blank fields > 1 char in length.
> ! -----------------------------------------
> function reduce_blanks(line) result(outline)
> character(*) :: line
> character(len(line)) :: outline
>
> my 3 executable statements will be posted tomorrow, anyone know what they
> might look like?
> JVB claims he has a 2 statement solution but hasnt posted it..
>
> end function

Well, JVB's same-length solution is, IMHO, obvious to anyone reading his
original post. With a little trival cutting and pasting, I get:

!---
program test_compress

implicit none
character(40) :: line = ' the quick brown fox jumps'

write(*,*) '|'//line//'|'
write(*,*) '|'//compress(line)//'|'

contains

pure recursive function compress(x) result(y)

character(*), intent(in) :: x
character(len(x)) :: y

y = x
if(index(trim(y),' ') /= 0) &
y = compress(y(1:index(trim(y),' '))// &
y(index(trim(y),' ')+2:len(y)))

end function compress

end program test_compress
!----

Kazzam, that's two executable statements!

Based on the exact problem spec, I can also come up with a solution that
uses one executable statement. The compress function is as follows:

!----
pure function compress(x) result (y)

character(*), intent(in) :: x
character(len(x)) :: y

y = REPEAT('&',LEN(x)

end function compress
!----

cheers,

Rich

David Frank

2005-08-02, 9:10 am

Well I cant argue JVB's RECURSIVE function doesnt work, however he didnt
obey the ground rules
which clearly spells out a NON-RECURSIVE READABLE solution.

function reduce_blanks (line) result (outline)

With that clarified, can anyone match/beat my 3 statement solution?

Rich Townsend

2005-08-02, 9:10 am

David Frank wrote:
> Well I cant argue JVB's RECURSIVE function doesnt work, however he didnt
> obey the ground rules
> which clearly spells out a NON-RECURSIVE READABLE solution.
>
> function reduce_blanks (line) result (outline)
>
> With that clarified, can anyone match/beat my 3 statement solution?
>
>
>
>

I don't recall seing the word 'non-recursive' anywhere in your previous
posts. Now that the goalposts have shifted once again, I'll have to
think some more.

cheers,

Rich

James Van Buskirk

2005-08-02, 9:10 am

"David Frank" <dave_frank@hotmail.com> wrote in message
news:b1wHe.1466$ns.1292@newsread1.news.atl.earthlink.net...

> Well I cant argue JVB's RECURSIVE function doesnt work, however he didnt
> obey the ground rules
> which clearly spells out a NON-RECURSIVE READABLE solution.

> function reduce_blanks (line) result (outline)

> With that clarified, can anyone match/beat my 3 statement solution?

<sigh>

program unreadable
character(40) :: line = ' the quick brown fox jumps'
line = reduce_blanks(line)
write (*,*) trim(line) ! " the quick brown fox jumps"
stop
contains
function reduce_blanks (line) result (outline)
character(*), intent(in) :: line
character(len(line)) outline

outline = transfer( &
pack( &
transfer( &
line, &
(/'x'/) &
), &
transfer( &
line, &
(/'x'/) &
) &
/= ' ' &
.OR. &
transfer( &
line(2:)//' ', &
(/'x'/) &
) &
/= ' ' &
), &
repeat( &
'x', &
count( &
transfer( &
line, &
(/'x'/) &
) &
/= ' ' &
.OR. &
transfer( &
line(2:)//' ', &
(/'x'/) &
) &
/= ' ' &
) &
) &
)
end function reduce_blanks
end program unreadable

If you want to claim the above is unreadable, you must find
an f95 compiler that can't read it! AND GFORTRAN IS CHEATING!!

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

FJRA

2005-08-02, 9:10 am

Well, I made one with 3 statments also,

function reduceblanks(strin) result(strout)
character(len=*), intent(IN) :: strin
character(len=len(strin)) :: strout
strout = strin
do 1 while(index(trim(strout), ' ') > 0)
1 strout(index(trim(strout),' '):) = strout(index(trim(strout),'
')+1:)
end function

FJRA

Rich Townsend

2005-08-02, 9:10 am

James Van Buskirk wrote:
> "David Frank" <dave_frank@hotmail.com> wrote in message
> news:b1wHe.1466$ns.1292@newsread1.news.atl.earthlink.net...
>
>
>
>
>
>
>
>
> <sigh>
>
> program unreadable
> character(40) :: line = ' the quick brown fox jumps'
> line = reduce_blanks(line)
> write (*,*) trim(line) ! " the quick brown fox jumps"
> stop
> contains
> function reduce_blanks (line) result (outline)
> character(*), intent(in) :: line
> character(len(line)) outline
>
> outline = transfer( &
> pack( &
> transfer( &
> line, &
> (/'x'/) &
> ), &
> transfer( &
> line, &
> (/'x'/) &
> ) &
> /= ' ' &
> .OR. &
> transfer( &
> line(2:)//' ', &
> (/'x'/) &
> ) &
> /= ' ' &
> ), &
> repeat( &
> 'x', &
> count( &
> transfer( &
> line, &
> (/'x'/) &
> ) &
> /= ' ' &
> .OR. &
> transfer( &
> line(2:)//' ', &
> (/'x'/) &
> ) &
> /= ' ' &
> ) &
> ) &
> )
> end function reduce_blanks
> end program unreadable
>
> If you want to claim the above is unreadable, you must find
> an f95 compiler that can't read it! AND GFORTRAN IS CHEATING!!
>

Hurrah! I am truly impressed -- the prize goes to JVB!

Now if only whirled peas could also be achieved using TRANSFER()...

cheers,

Rich

PS Quick question: I assume you are using TRANSFER() to achieve a
character string => array of single characters conversion?

Rich Townsend

2005-08-02, 9:10 am

FJRA wrote:
> Well, I made one with 3 statments also,
>
> function reduceblanks(strin) result(strout)
> character(len=*), intent(IN) :: strin
> character(len=len(strin)) :: strout
> strout = strin
> do 1 while(index(trim(strout), ' ') > 0)
> 1 strout(index(trim(strout),' '):) = strout(index(trim(strout),'
> ')+1:)
> end function
>
>
> FJRA
>

do...while isn't valid Fortran. So, unfortunately, this doesn't count.

cheers,

Rich

James Giles

2005-08-02, 9:10 am

Rich Townsend wrote:
> FJRA wrote:
....
[color=darkred]
> do...while isn't valid Fortran. So, unfortunately, this doesn't
> count.

DO <lab> WHILE (condition)
....
<lab> statement

is perfectly legal. See §8.1.4.1.1 of the F95 standard.

Unfortunately, there is an illegal line break without any
continuation marks in the code - probably an artifact of the
usenet tool though.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

Rich Townsend

2005-08-02, 9:10 am

James Giles wrote:
> Rich Townsend wrote:
>
>
> ...
>
>
>
>
> DO <lab> WHILE (condition)
> ...
> <lab> statement
>
> is perfectly legal. See §8.1.4.1.1 of the F95 standard.
>
> Unfortunately, there is an illegal line break without any
> continuation marks in the code - probably an artifact of the
> usenet tool though.

OK, my bad. For some reason, I've got into the habit of writing
constructs such as this as:

do
....
if(....) exit
....
enddo

Through my adherence to this style, I think I must have forgotten that
do while is also valid.

cheers,

Rich

James Van Buskirk

2005-08-02, 9:10 am

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:dcmbif$59c$1@scrotar.nss.udel.edu...

> PS Quick question: I assume you are using TRANSFER() to achieve a
> character string => array of single characters conversion?

Both ways. As an exercise, you should rewrite the function so
that its result is the correct length. Test with zero, one, and
two trailing blanks on input. Also replace the concatenations
with EOSHIFT.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

2005-08-02, 9:10 am

David Frank wrote:
>
> Heres a challenge thats O.T. in another topic and IMO deserves its own
> topic.

You're late - Microsoft thinks it warrants a patent! :)

http://appft1.uspto.gov/netacgi/nph...d+TTL/White&RS=((TTL/Adding+AND+T
TL/Removing)+AND+TTL/White)

David Frank

2005-08-02, 9:10 am

"James Van Buskirk" <not_valid@comcast.net> wrote in message
news:Baydnbehs4eTIHPfRVn-qA@comcast.com...
> "Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
> news:dcmbif$59c$1@scrotar.nss.udel.edu...
>
>
> Both ways. As an exercise, you should rewrite the function so
> that its result is the correct length. Test with zero, one, and
> two trailing blanks on input. Also replace the concatenations
> with EOSHIFT.
>

Trailing blanks removed length from a string function is not required in
F2003 when its readily achieved
as part of the subsequent assign using TRIM

character(:),allocatable :: line
line = trim(reduce_blanks(line)) // ' '

Congrats on your 1 statement solution using your fav keyword TRANSFER.
I have no comment as to its readability.
No-one wants to see my 3 statement solution now, right?

James Van Buskirk

2005-08-02, 9:10 am

"David Frank" <dave_frank@hotmail.com> wrote in message
news:PnEHe.9095$6f.215@newsread3.news.atl.earthlink.net...

> Trailing blanks removed length from a string function is not required in
> F2003 when its readily achieved
> as part of the subsequent assign using TRIM

> character(:),allocatable :: line
> line = trim(reduce_blanks(line)) // ' '

The above doesn't work if the original input had no trailing
blanks. It's possible to modify (and even possibly shorten)
my solution to handle this case correctly.

> I have no comment as to its readability.

:)

> No-one wants to see my 3 statement solution now, right?

No, go ahead and post your code. It's not a bad thing to
expose the readership to different styles.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

David Frank

2005-08-02, 9:10 am

"James Van Buskirk" <not_valid@comcast.net> wrote in message
news:IfadnQx3Noc3iXLfRVn-uQ@comcast.com...
> "David Frank" <dave_frank@hotmail.com> wrote in message
> news:PnEHe.9095$6f.215@newsread3.news.atl.earthlink.net...
>
>
>
> The above doesn't work if the original input had no trailing
> blanks. It's possible to modify (and even possibly shorten)
> my solution to handle this case correctly.
>

I assume you are referring to your solution, my solution (posted shortly)
has no problem.

>
> :)
>
>
> No, go ahead and post your code. It's not a bad thing to
> expose the readership to different styles.
>

Your master of the transfer function continually amazes (and befuddles) me,
I think I speak for many here that you might as well be writing in chinese.

David Frank

2005-08-02, 9:10 am

Here is my 3 statement solution as advertised..

! -------------
program demo ! blank reduction
character(27) :: line1= ' the quick brown fox' ! exact len
character(30) :: line2= ' the quick brown fox '
line1 = reduce_blanks(line1)
write (*,*) trim(line1) //' jumps' ! " the quick brown fox jumps"
line2 = reduce_blanks(line2)
write (*,*) trim(line2) //' jumps' ! " the quick brown fox jumps"
stop
contains
! --------------------------
function reduce_blanks(line) result (outline)
character(*) :: line
character(len(line)) :: outline
character :: a(len(line))

a = transfer(line,a)
forall (i=1:size(a)-1, a(i)==' '.and.a(i+1)==' ') a(i) = char(0)
outline = transfer(pack(a,a /= char(0), spread(' ',1,size(a))), outline)

end function reduce_blanks
end program

David Frank

2005-08-02, 9:10 am

"bv" <bvoh@Xsdynamix.com> wrote in message
news:42EEBCEC.1FCF6717@Xsdynamix.com...
> David Frank wrote:
>
> You're late - Microsoft thinks it warrants a patent! :)
>
> http://appft1.uspto.gov/netacgi/nph...d+TTL/White&RS=((TTL/Adding+AND
+TTL/Removing)+AND+TTL/White)
>

IMO, the concept that software can be patented is ridiculous, thanks for the
link...

Herman D. Knoble

2005-08-02, 9:10 am

Dick Hentrickson's solution posted a year ago
http://groups-beta.google.com/group...f415dc0daf19fcd
is even a shorter one-liner.

Skip

On Mon, 1 Aug 2005 15:44:49 -0600, "James Van Buskirk" <not_valid@comcast.net> wrote:

-|"David Frank" <dave_frank@hotmail.com> wrote in message
-|news:b1wHe.1466$ns.1292@newsread1.news.atl.earthlink.net...
-|
-|> Well I cant argue JVB's RECURSIVE function doesnt work, however he didnt
-|> obey the ground rules
-|> which clearly spells out a NON-RECURSIVE READABLE solution.
-|
-|> function reduce_blanks (line) result (outline)
-|
-|> With that clarified, can anyone match/beat my 3 statement solution?
-|
-|<sigh>
-|
-|program unreadable
-| character(40) :: line = ' the quick brown fox jumps'
-| line = reduce_blanks(line)
-| write (*,*) trim(line) ! " the quick brown fox jumps"
-| stop
-| contains
-| function reduce_blanks (line) result (outline)
-| character(*), intent(in) :: line
-| character(len(line)) outline
-|
-| outline = transfer( &
-| pack( &
-| transfer( &
-| line, &
-| (/'x'/) &
-| ), &
-| transfer( &
-| line, &
-| (/'x'/) &
-| ) &
-| /= ' ' &
-| .OR. &
-| transfer( &
-| line(2:)//' ', &
-| (/'x'/) &
-| ) &
-| /= ' ' &
-| ), &
-| repeat( &
-| 'x', &
-| count( &
-| transfer( &
-| line, &
-| (/'x'/) &
-| ) &
-| /= ' ' &
-| .OR. &
-| transfer( &
-| line(2:)//' ', &
-| (/'x'/) &
-| ) &
-| /= ' ' &
-| ) &
-| ) &
-| )
-| end function reduce_blanks
-|end program unreadable
-|
-|If you want to claim the above is unreadable, you must find
-|an f95 compiler that can't read it! AND GFORTRAN IS CHEATING!!

Rich Townsend

2005-08-02, 9:10 am

Herman D. Knoble wrote:
> Dick Hentrickson's solution posted a year ago
> http://groups-beta.google.com/group...f415dc0daf19fcd
> is even a shorter one-liner.
>
> Skip

From a quick read through, that removes *all* blanks, doesn't it?
Whereas the current problem is to condense multiple blanks to single blanks.

cheers,

Rich

Herman D. Knoble

2005-08-02, 9:10 am

FJRA

2005-08-02, 9:10 am

James Giles schrieb:

> Unfortunately, there is an illegal line break without any
> continuation marks in the code - probably an artifact of the
> usenet tool though.
>

Yes, it makes what it wants!

BTW, nice solutions!

FJRA

David Frank

2005-08-02, 5:02 pm

"FJRA" <a19980403@pucp.edu.pe> wrote in message
news:1122993255.232218.147670@g49g2000cwa.googlegroups.com...
>
> James Giles schrieb:
>
>
>
> Yes, it makes what it wants!
>
> BTW, nice solutions!
>
> FJRA
>

I tried your solution with ' the quick brown fox '
and got back series of concatenated thethethethe...
does FJRA's solution work for anyone?

James Van Buskirk

2005-08-02, 5:02 pm

"David Frank" <dave_frank@hotmail.com> wrote in message
news:JULHe.12735$oZ.10099@newsread2.news.atl.earthlink.net...

> I tried your solution with ' the quick brown fox '
> and got back series of concatenated thethethethe...
> does FJRA's solution work for anyone?

When you fixed the line break anomaly, did you make sure
to insert two spaces between the apostrophes? BTW, one
could prevent the line break entirely by not TRIMming in
statement labeled 1: it's only required in the WHILE
statement.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

James Van Buskirk

2005-08-02, 5:02 pm

"David Frank" <dave_frank@hotmail.com> wrote in message
news:neFHe.12621$oZ.9766@newsread2.news.atl.earthlink.net...

> function reduce_blanks(line) result (outline)
> character(*) :: line
> character(len(line)) :: outline
> character :: a(len(line))

> a = transfer(line,a)
> forall (i=1:size(a)-1, a(i)==' '.and.a(i+1)==' ') a(i) = char(0)
> outline = transfer(pack(a,a /= char(0), spread(' ',1,size(a))), outline)

> end function reduce_blanks

Your solution is fairly close to mine, spread out over more
statements. It suffers the same problem, though. Compressing
repeated spaces into one requires that

len(reduce_blanks('xxx'//repeat(' ',n))) = merge(4,3,n > 0)

Obviously this can be achieved without introducing further
executable statements.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

David Frank

2005-08-02, 5:02 pm

"James Van Buskirk" <not_valid@comcast.net> wrote in message
news:LtSdnYxDq_5JO3LfRVn-ow@comcast.com...
> "David Frank" <dave_frank@hotmail.com> wrote in message
> news:neFHe.12621$oZ.9766@newsread2.news.atl.earthlink.net...
>
>
>
>
> Your solution is fairly close to mine,

If you say so, altho I didnt see my technique of 1st marking the repeats
with a forall and then
discarding them with a pack that has a spread to fill in the trailing blanks
in your code.
Didnt you say your solution has a problem with exact size text in line?

> spread out over more statements. It suffers the same problem, though.
> Compressing
> repeated spaces into one requires that
>
> len(reduce_blanks('xxx'//repeat(' ',n))) = merge(4,3,n > 0)
>

Dont be so obtuse, show me a sample line that wont get properly reduced
because
my solution "suffers the same problem" as yours.

> Obviously this can be achieved without introducing further
> executable statements.
>

Well first show me my problem and I will try to fix it..

David Frank

2005-08-02, 5:02 pm

"James Van Buskirk" <not_valid@comcast.net> wrote in message
news:S-WdnXuAN_l7OXLfRVn-rg@comcast.com...
> "David Frank" <dave_frank@hotmail.com> wrote in message
> news:JULHe.12735$oZ.10099@newsread2.news.atl.earthlink.net...
>
>
> When you fixed the line break anomaly, did you make sure
> to insert two spaces between the apostrophes? BTW, one
> could prevent the line break entirely by not TRIMming in
> statement labeled 1: it's only required in the WHILE
> statement.
>
> --
> write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
> 6.0134700243160014d-154/),(/'x'/)); end
>
>

Yep, that was my problem..

James Van Buskirk

2005-08-02, 5:02 pm

"David Frank" <dave_frank@hotmail.com> wrote in message
news:h8OHe.1956$ns.1232@newsread1.news.atl.earthlink.net...

> "James Van Buskirk" <not_valid@comcast.net> wrote in message
> news:LtSdnYxDq_5JO3LfRVn-ow@comcast.com...

[color=darkred]
[color=darkred]
outline)
[color=darkred]
[color=darkred]
[color=darkred]
> If you say so, altho I didnt see my technique of 1st marking the repeats
> with a forall and then
> discarding them with a pack that has a spread to fill in the trailing
blanks
> in your code.

Well, yes, I didn't make that particular mistake. If the input
string already contained your sentinel character, the output
would not, so it would be incorrect.

> Didnt you say your solution has a problem with exact size text in line?

As does yours.

[color=darkred]
[color=darkred]
> Dont be so obtuse, show me a sample line that wont get properly reduced
> because
> my solution "suffers the same problem" as yours.

Your canonical sample suffers this problem.

[color=darkred]
> Well first show me my problem and I will try to fix it..

I'll try:

program test
implicit none
integer i

do i = 0,2
write(*,*) 'i = ', i
call showme('xxx'//repeat(' ',i))
end do
contains
function reduce_blanks(line) result (outline)
character(*) :: line
character(len(line)) :: outline
character :: a(len(line))

a = transfer(line,a)
forall (i=1:size(a)-1, a(i)==' '.and. &
a(i+1)==' ') a(i) = char(0)
outline = transfer(pack(a,a /= char(0), &
spread(' ',1,size(a))), outline)

end function reduce_blanks
subroutine showme(x)
character(*), intent(in) :: x

write(*,*) 'len = ', len(x)
write(*,*) 'x = ', x
end subroutine showme
end program test

The output I get with lf95 -f95 -nconcc is:

i = 0
len = 3
x = xxx
i = 1
len = 4
x = xxx
i = 2
len = 5
x = xxx

However, when i = 2, len(x) should be 4 because the two blanks
at the end should get compressed into one. Similar problems
occur with your test string, but your testing methodology
doesn't permit you to see the effect of the several trailing
blanks it has.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

David Frank

2005-08-02, 5:02 pm

"James Van Buskirk" <not_valid@comcast.net> wrote in message
news:AuadnSzA2pHaJnLfRVn-rA@comcast.com...
>
> Well, yes, I didn't make that particular mistake. If the input
> string already contained your sentinel character, the output
> would not, so it would be incorrect.
>

You consider NULL a ascii text character so it cant be used as a masking
char?
Is there any "sentinel" character that you dont object to using for a
"sentinel", how about char(1) ?

>
> As does yours.
>

OK, I see what you are complaining about, the first blank in the trailing
blanks returned is just part
of the trailing blanks, BFD.. I guess we dont agree its a problem that must
be addressed.

David Frank

2005-08-02, 5:02 pm

adding 1 trailing blank to a function's otherwise exact returned length
wont be a problem in F2003 syntax,
since
character(:),allocatable :: outline will be legal

James Van Buskirk

2005-08-02, 5:02 pm

"David Frank" <dave_frank@hotmail.com> wrote in message
news:BPPHe.1990$ns.357@newsread1.news.atl.earthlink.net...

> Is there any "sentinel" character that you dont object to using for a
> "sentinel", how about char(1) ?

Nope. The appropriate solution is an extra LOGICAL array to
hold the result of the test, not trying to store the results
back in the CHARACTER array somehow.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

James Van Buskirk

2005-08-02, 5:02 pm

"David Frank" <dave_frank@hotmail.com> wrote in message
news:nbQHe.9334$6f.6929@newsread3.news.atl.earthlink.net...

> adding 1 trailing blank to a function's otherwise exact returned length
> wont be a problem in F2003 syntax,
> since
> character(:),allocatable :: outline will be legal

But it makes the most sense to me for the function itself to
detect whether that trailing blank should be inserted and to
insert it if required without the need for further processing.
How useful would cos(x) be if you had to check whether the
input was some special value like pi/5 so you would in that
case have to substitute the correct value of (1+sqrt(5))/4
rather than just be able to accept the value of cos(x) without
further processing?

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end

James Giles

2005-08-02, 5:02 pm

James Van Buskirk wrote:
> "David Frank" <dave_frank@hotmail.com> wrote in message
> news:BPPHe.1990$ns.357@newsread1.news.atl.earthlink.net...
>
>
> Nope. The appropriate solution is an extra LOGICAL array to
> hold the result of the test, not trying to store the results
> back in the CHARACTER array somehow.

I agree. *All* the characters of ASCII are legitimate characters.
Any other choice imposes restrictions on the users of your
software. It should be their choice what characters they
consider legitimate. The same goes for any additional
characters your environment supports (for example, I often
rely on the characters in the range CHAR(160) through
CHAR(255) because I'm processing ISO Latin-1). You can't
embed sentenels in a string unless the value of the sentinel
in unambiguously out of range for any possible application.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

FJRA

2005-08-02, 5:02 pm

I was wondering, which solution was faster, and just looking at them
told me nothing. I always think forall is slower, but until I don't try
it, I don't make the statement. I change my solution taking out the
trim where not needed, and tested the 3 posted solutions. Here is the
result:

g95 -O3

Solution FJRA
time: 0.73500
Solution VanBuskirk
time: 0.59300
Solution Frank
time: 2.11000

g95 -O1

Solution FJRA
time: 0.65600
Solution VanBuskirk
time: 0.68800
Solution Frank
time: 2.26600

g95 (no options)

Solution FJRA
time: 0.67200
Solution VanBuskirk
time: 0.60900
Solution Frank
time: 2.20400

CVF with full optimization
Solution FJRA
time: 0.39062
Solution VanBuskirk
time: 0.26562
Solution Frank
time: 0.21875

CVF without optimization (/debug:full)
Solution FJRA
time: 0.39062
Solution VanBuskirk
time: 1.37500
Solution Frank
time: 0.46875

Conclusion:
1. it is compiler/optimization dependent.
2. forall is slow in g95.

Here is the test program (just in case I made a mistake), I just tested
with the "test string", but other string tests are welcome (hope no new
break lines :) ):

PROGRAM ReduceTiming
real t1, t2
integer i
integer, parameter :: n = 100000
character(40) :: line = ' the quick brown fox jumps'
character(40) :: newline

write(*,*) 'Solution FJRA'
call CPU_TIME(t1)
do i = 1, n
newline = reduce_blanks_FJRA(line)
enddo
call CPU_TIME(t2)
write(*,'("time: ", F10.5)') t2-t1

write(*,*) 'Solution VanBuskirk'
call CPU_TIME(t1)
do i = 1, n
newline = reduce_blanks_VanBuskirk(line)
enddo
call CPU_TIME(t2)
write(*,'("time: ", F10.5)') t2-t1

write(*,*) 'Solution Frank'
call CPU_TIME(t1)
do i = 1, n
newline = reduce_blanks_frank(line)
enddo
call CPU_TIME(t2)
write(*,'("time: ", F10.5)') t2-t1

CONTAINS

function reduce_blanks_FJRA(strin) result(strout)
character(len=*), intent(IN) :: strin
character(len=len(strin)) :: strout
strout = strin
do 1 while(index(trim(strout), ' ') > 0)
1 strout(index(strout,' '):) = strout(index(strout,' ')+1:)
end function reduce_blanks_FJRA

function reduce_blanks_VanBuskirk (line) result (outline)
character(*), intent(in) :: line
character(len(line)) outline

outline = transfer( &
pack( &
transfer( &
line, &
(/'x'/) &
), &
transfer( &
line, &
(/'x'/) &
) &
/= ' ' &
.OR. &
transfer( &
line(2:)//' ', &
(/'x'/) &
) &
/= ' ' &
), &
repeat( &
'x', &
count( &
transfer( &
line, &
(/'x'/) &
) &
/= ' ' &
.OR. &
transfer( &
line(2:)//' ', &
(/'x'/) &
) &
/= ' ' &
) &
) &
)
end function reduce_blanks_VanBuskirk

function reduce_blanks_frank(line) result (outline)
character(*) :: line
character(len(line)) :: outline
character :: a(len(line))

a = transfer(line,a)
forall (i=1:size(a)-1, a(i)==' '.and.a(i+1)==' ') a(i) = char(0)
outline = transfer(pack(a,a /= char(0), spread(' ',1,size(a))),
outline)

end function reduce_blanks_frank

END PROGRAM ReduceTiming

Rich Townsend

2005-08-02, 10:01 pm

James Giles wrote:
> James Van Buskirk wrote:
>
>
>
> I agree. *All* the characters of ASCII are legitimate characters.
> Any other choice imposes restrictions on the users of your
> software. It should be their choice what characters they
> consider legitimate. The same goes for any additional
> characters your environment supports (for example, I often
> rely on the characters in the range CHAR(160) through
> CHAR(255) because I'm processing ISO Latin-1). You can't
> embed sentenels in a string unless the value of the sentinel
> in unambiguously out of range for any possible application.
>

As a general thought on this thread, can I point out in a blatant act of
self promotion that my solution to the original column counting problem
-- of which the blank reduction was just one part -- worked without any
of the problems exhibited by the 'short' solutions posted by David &
James. Furthermore, my solution is clearly implemented and easily
maintainable.

This quest toward one-line solutions is interesting as a self-contained
challenge, but -- being non-maintainable and buggy -- has no place in
real software development. Grasping for metaphors, the phrase 'pissing
contest' (albeit an impressive one!) springs to mind.

cheers,

Rich

Gary L. Scott

2005-08-02, 10:01 pm

Rich Townsend wrote:

> James Giles wrote:
>
>
> As a general thought on this thread, can I point out in a blatant act of
> self promotion that my solution to the original column counting problem
> -- of which the blank reduction was just one part -- worked without any
> of the problems exhibited by the 'short' solutions posted by David &
> James. Furthermore, my solution is clearly implemented and easily
> maintainable.
>
> This quest toward one-line solutions is interesting as a self-contained
> challenge, but -- being non-maintainable and buggy -- has no place in
> real software development. Grasping for metaphors, the phrase 'pissing
> contest' (albeit an impressive one!) springs to mind.
>
> cheers,
>
> Rich
But they can be fun so long as everyone remains civil...which they seem
to be for the most part.

--

Gary Scott
mailto:garyscott@ev1.net

Fortran Library: http://www.fortranlib.com

Support the Original G95 Project: http://www.g95.org
-OR-
Support the GNU GFortran Project: http://gcc.gnu.org/fortran/index.html

Why are there two? God only knows.

If you want to do the impossible, don't hire an expert because he knows
it can't be done.

-- Henry Ford

James Giles

2005-08-02, 10:01 pm

Rich Townsend wrote:
....
> As a general thought on this thread, can I point out in a blatant
> act of self promotion that my solution to the original column
> counting problem -- of which the blank reduction was just one part
> -- worked without any of the problems exhibited by the 'short'
> solutions posted by David & James. Furthermore, my solution is
> clearly implemented and easily maintainable.
>
> This quest toward one-line solutions is interesting as a
> self-contained challenge [...]

I don't even agree with that, but close. The purpose of
programming is to write verifiably correct solutions to
specific problems. Minimizing line count isn't more
interesting than, say, arguing angels on pin-heads. It's
not a useful skill on real problems. More interesting
forms of play are those that shapen genuinely useful
abilities.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

glen herrmannsfeldt

2005-08-02, 10:01 pm

James Giles wrote:
> Rich Townsend wrote:

(snip)
[color=darkred]
> I don't even agree with that, but close. The purpose of
> programming is to write verifiably correct solutions to
> specific problems. Minimizing line count isn't more
> interesting than, say, arguing angels on pin-heads. It's
> not a useful skill on real problems. More interesting
> forms of play are those that shapen genuinely useful
> abilities.

It is common in sort algorithms to use a unique flag to identify
the end of the data in a buffer. (Though the algorithm must be
written such that it works right even if that occurs in the data.)

It has the advantage that the inner loop can be written with
just one test, and then outside that loop a test to see if
it is really the end.

Minimizing line count is nice, but speed is a more popular
goal. It often takes more code, and is less readable, too.

-- glen

James Giles

2005-08-02, 10:01 pm

glen herrmannsfeldt wrote:
....
> It is common in sort algorithms to use a unique flag to identify
> the end of the data in a buffer. (Though the algorithm must be
> written such that it works right even if that occurs in the data.)

Well, if the flag is really unique, then it clearly won't occur
in data. There's nothing wrong with a sentenel as long as it
really is unique.

> Minimizing line count is nice, but speed is a more popular
> goal. It often takes more code, and is less readable, too.

The *most* common goal should be "verifiably correct".
That usually requires legibility. Speed should only be
a goal if the code in question is provably a bottleneck
of one or more of your programs.

Note that sometimes legibility is the path *toward*
speed. Someone that frequently posts articles on this
newsgroup recently (well, within the last year) posted
a version of quicksort that was rather slow and *very*
illegible. By cleaning it up so that I could read it, I was
also able to speed it up considerably - without sacrificing
the its newfound legibility. After all, optimization most
often requires two things: 1) a thorough understanding
of the algorithm you're coding and the language you're
using, and 2) the ability to read and verify the optimizing
transformations you apply.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

Gordon Sande

2005-08-02, 10:01 pm

Rich Townsend wrote:
> James Giles wrote:
>
>
> As a general thought on this thread, can I point out in a blatant act of
> self promotion that my solution to the original column counting problem
> -- of which the blank reduction was just one part -- worked without any
> of the problems exhibited by the 'short' solutions posted by David &
> James. Furthermore, my solution is clearly implemented and easily
> maintainable.
>
> This quest toward one-line solutions is interesting as a self-contained
> challenge, but -- being non-maintainable and buggy -- has no place in
> real software development. Grasping for metaphors, the phrase 'pissing
> contest' (albeit an impressive one!) springs to mind.

The ultimate of this trend is the contest in which programmers present
one liners and ask "Guess what this does?" At one time some language
was described this way and an APL programmer objected to the criticism.
It turned out that the offending language had never mentioned but some
languages were defended by name.

> cheers,
>
> Rich

glen herrmannsfeldt

2005-08-03, 4:01 am

James Giles wrote:

> glen herrmannsfeldt wrote:

[color=darkred]
> Well, if the flag is really unique, then it clearly won't occur
> in data. There's nothing wrong with a sentenel as long as it
> really is unique.

If all values are legal, the flag can occur. Knuth's volume 3
describes many sort algorithms that use a flag value to exit the
loop, and still properly sort data containing that value.

[color=darkred]
> The *most* common goal should be "verifiably correct".
> That usually requires legibility. Speed should only be
> a goal if the code in question is provably a bottleneck
> of one or more of your programs.

I was considering the case where there is enough money
to do both. Syncsort for many years sold sort programs
for IBM mainframes that ran faster than the IBM supplied
ones. Presumably they were verifiably correct or they
wouldn't have stayed in business very long.

The inner loop of many algorithms is often provably a
bottleneck, and if it is small enough not hard to verify.

> Note that sometimes legibility is the path *toward*
> speed. Someone that frequently posts articles on this
> newsgroup recently (well, within the last year) posted
> a version of quicksort that was rather slow and *very*
> illegible. By cleaning it up so that I could read it, I was
> also able to speed it up considerably - without sacrificing
> the its newfound legibility. After all, optimization most
> often requires two things: 1) a thorough understanding
> of the algorithm you're coding and the language you're
> using, and 2) the ability to read and verify the optimizing
> transformations you apply.

Quicksort makes an interesting example. It can conveniently
be written using recursion, though it is usually faster written
as a loop. It is O(N logN) in the average case, but O(N**2)
worst case. One of the simplest, easy to prove cases turns
out to be O(N**2) for already sorted input.

-- glen

John Harper

2005-08-03, 4:01 am

In article <gDVHe.177733$tt5.114359@edtnps90>,
Gordon Sande <g.sande@worldnet.att.net> wrote:
>
>The ultimate of this trend is the contest in which programmers present
>one liners and ask "Guess what this does?"

That reminds me of the story that some Burroughs compiler used to have
an error message saying "If you know what that means, implement it."

John Harper, School of Mathematics, Statistics and Computer Science,
Victoria University, PO Box 600, Wellington, New Zealand
e-mail john.harper@vuw.ac.nz phone (+64)(4)463 5341 fax (+64)(4)463 5045

David Frank

2005-08-03, 4:01 am

"FJRA" <a19980403@pucp.edu.pe> wrote in message
news:1123017589.829098.26860@z14g2000cwz.googlegroups.com...
>I was wondering, which solution was faster, and just looking at them
> told me nothing. I always think forall is slower, but until I don't try
> it, I don't make the statement. I change my solution taking out the
> trim where not needed, and tested the 3 posted solutions. Here is the
> result:
>

Interesting and thanks FJRA..

To improve my routine..
1. I added a logical delete array removing the char(0) sentinel.
2. got rid of the executable "spread(' ',1,size(a)) substituting a pre-set
array of blanks..

These changes have added to its legibility which IMO was already BY FAR the
most legible,
and made it significantly faster, (I confirm it has fastest timing on my CVF
system, 0.1256 sec)

see: FJRA's revised benchmark

http://home.earthlink.net/~dave_gemini/reduce.f90

David Frank

2005-08-03, 4:01 am

re: forall speed

I replaced my forall with a do loop and amazing enuf it ran slower (using
CVF)..
I wonder if CVF allows foralls to run faster because my 2.8Ghz Intel cpu
has hyper-threading?
Otherwise I dont have an explanation why CVF can make a forall run faster
than a do loop.
Can anyone confirm with their HT cpu?

David Frank

2005-08-03, 5:04 pm

"David Frank" <dave_frank@hotmail.com> wrote in message
news:8a%He.13$Je.12@newsread2.news.atl.earthlink.net...
> re: forall speed
>
> I replaced my forall with a do loop and amazing enuf it ran slower (using
> CVF)..
>

Scrub that result, when I increased the iterations x 10, the do loop was
faster,

David Frank

2005-08-03, 5:04 pm

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:dcp0lh$std$1@scrotar.nss.udel.edu...

>
> As a general thought on this thread, can I point out in a blatant act of
> self promotion that my solution to the original column counting problem --
> of which the blank reduction was just one part -- worked without any of
> the problems exhibited by the 'short' solutions posted by David & James.
> Furthermore, my solution is clearly implemented and easily maintainable.
>

You have admitted that the current standard has more or less obsoleted the
need for your
very large ISO VARYING module, but claim some string manipulation routines
like REPLACE
you provided are still useful.
I replied that such routine names conflict with user's use and your routines
can be easy duplicated
using the current standard syntax in F2003.

> This quest toward one-line solutions is interesting as a self-contained
> challenge, but -- being non-maintainable and buggy -- has no place in real
> software development. Grasping for metaphors, the phrase 'pissing contest'
> (albeit an impressive one!) springs to mind.
>

I for one never tried for a 1 line solution.
Also, I claimed your ISO VARYING REPLACE function can be replaced, and will
start a new topic
"Parsing challenge to replace text" which is a harder and not likely to
draw the interest just exhibited.

You are welcome to enter the contest as long as your solution doesnt require
your ISO varying module.

Rich Townsend

2005-08-03, 5:04 pm

David Frank wrote:
> "Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
> news:dcp0lh$std$1@scrotar.nss.udel.edu...
>
>
>
>
> You have admitted that the current standard has more or less obsoleted the
> need for your
> very large ISO VARYING module, but claim some string manipulation routines
> like REPLACE
> you provided are still useful.

Very large? You obviously don't work on problems over 10 lines long.

> I replied that such routine names conflict with user's use and your routines
> can be easy duplicated
> using the current standard syntax in F2003.
>

And I replied that that's too bad. REPLACE is part of the Fortran
standard, as are all of the other routines broung in by ISO_* modules
(e.g., the IEEE one); it's the user's problem if there is a conflict.
>
>
>
>
> I for one never tried for a 1 line solution.
> Also, I claimed your ISO VARYING REPLACE function can be replaced, and will
> start a new topic
> "Parsing challenge to replace text" which is a harder and not likely to
> draw the interest just exhibited.

As I understand it, your short blank reduction solution still gets it
wrong in some cases. When you post correct code, I might start taking
notice -- but don't hold your breath.
>
> You are welcome to enter the contest as long as your solution doesnt require
> your ISO varying module.
>

No thanks. I have little interest in coding challenges that do not,
apparently, even require that the presumed winner is correct.

cheers,

Rich

Herman D. Knoble

2005-08-03, 5:04 pm

David: Regarding the function, reduce_blanks_frank at:
http://home.earthlink.net/~dave_gemini/reduce.f90
Did you intentionally return the blanks removed (for timing
purposes only)? or did you mean (reversing .false. and .true.):

delete = .TRUE. ; pad = ' '
a = transfer(line,a)
do i = 1,size(a)-1
if (a(i) == ' '.and.a(i+1) == ' ') delete(i) = .FALSE.
end do
outline = transfer(pack(a, delete, pad),outline)

Skip

On Wed, 03 Aug 2005 07:44:41 GMT, "David Frank" <dave_frank@hotmail.com> wrote:

-|
-|"FJRA" <a19980403@pucp.edu.pe> wrote in message
-|news:1123017589.829098.26860@z14g2000cwz.googlegroups.com...
-|>I was wondering, which solution was faster, and just looking at them
-|> told me nothing. I always think forall is slower, but until I don't try
-|> it, I don't make the statement. I change my solution taking out the
-|> trim where not needed, and tested the 3 posted solutions. Here is the
-|> result:
-|>
-|
-|Interesting and thanks FJRA..
-|
-|To improve my routine..
-|1. I added a logical delete array removing the char(0) sentinel.
-|2. got rid of the executable "spread(' ',1,size(a)) substituting a pre-set
-|array of blanks..
-|
-|These changes have added to its legibility which IMO was already BY FAR the
-|most legible,
-|and made it significantly faster, (I confirm it has fastest timing on my CVF
-|system, 0.1256 sec)
-|
-|see: FJRA's revised benchmark
-|
-|http://home.earthlink.net/~dave_gemini/reduce.f90
-|

FJRA

2005-08-03, 5:04 pm

Well, it is important to win with a correct code. I've participated in
many ACM regional contests, and ther you have to have the exact answer!
No similar, but exactly the expected one (counting blanks!). And of
course with a time limit for running. But Fortran was not allowed, so I
used C. So, in this way I think a clear and fast algorithm is what one
has to try allways to do. But trying to reduce lines sometimes makes
you rethink the algorithm, what is good. But I prefer to reduce run
time (with the problem of being some times compiler dependent to
achieve this).

FJRA

David Frank

2005-08-03, 5:04 pm

"Herman D. Knoble" <SkipKnobleLESS@SPAMpsu.DOT.edu> wrote in message
news:ekk1f15u6kbe30l8rf9nn8qptgsi18876v@
4ax.com...
> David: Regarding the function, reduce_blanks_frank at:
> http://home.earthlink.net/~dave_gemini/reduce.f90
> Did you intentionally return the blanks removed (for timing
> purposes only)? or did you mean (reversing .false. and .true.):
>
> delete = .TRUE. ; pad = ' '
> a = transfer(line,a)
> do i = 1,size(a)-1
> if (a(i) == ' '.and.a(i+1) == ' ') delete(i) = .FALSE.
> end do
> outline = transfer(pack(a, delete, pad),outline)
>
> Skip
>

Whoops! The benchmark never shows the reduce text so that error escaped
detection..
I have made the following correction to reduce.f90 file at link above, as
otherwise I would have
to rename "delete" variable to something like "keep"

outline = transfer(pack(a, .not.delete, pad),outline)

Thanks for having a look at the output.

Rich Townsend

2005-08-03, 5:04 pm

David Frank wrote:
> "Herman D. Knoble" <SkipKnobleLESS@SPAMpsu.DOT.edu> wrote in message
> news:ekk1f15u6kbe30l8rf9nn8qptgsi18876v@
4ax.com...
>
>
>
> Whoops! The benchmark never shows the reduce text so that error escaped
> detection..

A benchmark where the correctness of the result is not checked?
Congratulations, David, you've outdone yourself!

cheers,

Rich

e p chandler

2005-08-03, 5:04 pm

Re: Benchmark blank reducing progrms

FJRA wrote:
> I was wondering, which solution was faster ....

I've added a brute force subroutine for reference:

function reduce_blanks_EPC(line) result (outline)
character(*), intent(in) :: line
character(len(line)) :: outline
integer :: p, q, l
logical :: f
character :: c

q=0
l=len(line)
f=.false.
outline=' '

do p=1,l
c=line(p:p)
if (c .eq. ' ') then
if (.not. f) then
q = q + 1
outline(q:q) = c
f = .true.
end if
else
q = q + 1
outline(q:q) = c
f = .false.
end if
end do

end function reduce_blanks_EPC

Results for g95 (2005-07-31, MinGW, 2.8 GHz P4HT, WinXP(SP2))

C:\g95>g95 q.f95

C:\g95>a
Solution FJRA
time: 1.29688
Solution VanBuskirk
time: 1.70313
Solution Frank
time: 1.45313
Solution EPC
| the quick brown fox jumps |
time: 0.40625
| the quick brown fox jumps |

C:\g95>g95 -O3 q.f95

C:\g95>a
Solution FJRA
time: 1.31250
Solution VanBuskirk
time: 1.65625
Solution Frank
time: 1.39063
Solution EPC
| the quick brown fox jumps |
time: 0.37500
| the quick brown fox jumps |

C:\g95>

FJRA

2005-08-03, 5:04 pm

good timing! But most of times brute force is slower!

CVF with optimization (2GHz)

Solution FJRA
time: 3.90625
Solution VanBuskirk
time: 2.62500
Solution Frank
time: 1.62500
Solution EPC
time: 1.00000

CVF without optimization

Solution FJRA
time: 3.92188
Solution VanBuskirk
time: 13.59375
Solution Frank
time: 3.82812
Solution EPC
time: 4.32812

g95

I:\pruebas\pruebas>g95 pruebareduce.f90 -o pruebareduce.exe

I:\pruebas\pruebas>pruebareduce
Solution FJRA
time: 6.75000
Solution VanBuskirk
time: 5.92200
Solution Frank
time: 18.89100
Solution EPC
time: 8.82800

Conclusion:
1. my code can almost not be optimized! :)
2. It is machine/compiler/optimization depeden (obvious of course).

FJRA

David Frank

2005-08-03, 5:04 pm

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:dcqlqr$fn9$1@scrotar.nss.udel.edu...

> A benchmark where the correctness of the result is not checked?
> Congratulations, David, you've outdone yourself!
>
> cheers,
>
> Rich

I didnt write the benchmark (your irritation at my pointing out the
obsoleteness of ISO VARYING)
is coming thru loud and clear...

Rich Townsend

2005-08-03, 5:04 pm

David Frank wrote:
> "Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
> news:dcqlqr$fn9$1@scrotar.nss.udel.edu...
>
>
>
>
> I didnt write the benchmark (your irritation at my pointing out the
> obsoleteness of ISO VARYING)
> is coming thru loud and clear...
>
>

No, your claim about varying strings is meaningless, since your
definition of 'obsolete' is wholly in the eyes of the beholder. My
frustration, if that's what you can call it, relates wholly to dealing
with you as an individual -- the shifting goalposts, the non-standard
code, the wild claims, the ill-designed benchmarks, etc, etc.

cheers,

Rich

Duane Bozarth

2005-08-03, 5:04 pm

David Frank wrote:
>
> "Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
> news:dcqlqr$fn9$1@scrotar.nss.udel.edu...
>
>
> I didnt write the benchmark (your irritation at my pointing out the
> obsoleteness of ISO VARYING)
> is coming thru loud and clear...

OTOH, <YOUR> insistence at harping about a perceived problem that isn't
is getting rather annoying for the rest of us here...let it rest, ok?
:(

If you don't want to use it, fine...others may choose to do so (or not),
don't see that it has any impact on you...

David Frank

2005-08-04, 4:03 am

"e p chandler" <epc8@juno.com> wrote in message
news:1123080924.833488.282170@z14g2000cwz.googlegroups.com...
> Re: Benchmark blank reducing progrms
>
> FJRA wrote:
>
> I've added a brute force subroutine for reference:
>

I have added your routine and CVF's timings to link below,
you have fastest optimized time, 2nd fastest unoptimized.

http://home.earthlink.net/~dave_gemini/reduce.f90

David Frank

2005-08-04, 9:04 am

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:dcqnvm$gbr$1@scrotar.nss.udel.edu...
> David Frank wrote:
>
> No, your claim about varying strings is meaningless, since your definition
> of 'obsolete' is wholly in the eyes of the beholder. My frustration, if
> that's what you can call it, relates wholly to dealing with you as an
> individual -- the shifting goalposts, the non-standard code, the wild
> claims, the ill-designed benchmarks, etc, etc.
>
> cheers,
>
> Rich

OK, I bit the bullet and tried your replace to reduce blanks
as you specified..

type (varying_string) line
line = 'the quick brown fox'
line = replace(line,' ',' ', .true.)
call put(string=line) ! outputs: "the quick brown fox"

which doesnt hack it, does it?

Also I object to not being able to use Fortran i/o with your
varying string variables, when Fortran allows it with other
non varying type variables.

read (*,*) line doesnt work
write (*,*) line "

Rich Townsend

2005-08-04, 5:04 pm

David Frank wrote:
> "Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
> news:dcqnvm$gbr$1@scrotar.nss.udel.edu...
>
>
>
>
> OK, I bit the bullet and tried your replace to reduce blanks
> as you specified..
>
> type (varying_string) line
> line = 'the quick brown fox'
> line = replace(line,' ',' ', .true.)
> call put(string=line) ! outputs: "the quick brown fox"
>
> which doesnt hack it, does it?

Of course it doesn't. If you took the time and courtesy to read my
original post on this subject, you would find that I use this code
sequence (see

--
type(VARYING_STRING) :: line
integer :: len_line
integer :: len_prev
integer :: n_columns
integer :: i_blank

! Read a line of data

call GET(line)

! Reduce multiple blanks to single blank

len_prev = 0

reduce_loop : do

len_line = LEN(line)

if(len_line == len_prev) exit

line = REPLACE(line, ' ', ' ', EVERY=.TRUE.)

len_prev = len_line

end do reduce_loop
--

But that's the problem, isn't it David? You're so bought into your own
perceived correctness that you fail to recognize the egg regularly
dripping off your face. If you are unable to raise your game a little,
then I won't bother debating you further; it's too much like shooting
fish in a barrel, which to me is deeply unsatisfying.

cheers,

Rich

PS I've yet to see working blank-reduction code from you, David. So you
continue to fail it.

David Frank

2005-08-04, 5:04 pm

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:dctfs9$bft$1@scrotar.nss.udel.edu...
Rich
>
> PS I've yet to see working blank-reduction code from you, David. So you
> continue to fail it.

Sure you have,
write (*,*) trim(reduce_blanks('the quick brown fox ')) ! outputs: "the
quick brown fox'

Gary L. Scott

2005-08-04, 10:01 pm

David Frank wrote:

> "Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
> news:dctfs9$bft$1@scrotar.nss.udel.edu...
> Rich
>
>
>
> Sure you have,
> write (*,*) trim(reduce_blanks('the quick brown fox ')) ! outputs: "the
> quick brown fox'
>
>
I wonder what it does following a period (". ")? I'd want it to leave
two spaces, others might want it to leave only one space.

--

Gary Scott
mailto:garyscott@ev1.net

Fortran Library: http://www.fortranlib.com

Support the Original G95 Project: http://www.g95.org
-OR-
Support the GNU GFortran Project: http://gcc.gnu.org/fortran/index.html

Why are there two? God only knows.

If you want to do the impossible, don't hire an expert because he knows
it can't be done.

-- Henry Ford

FJRA

2005-08-04, 10:01 pm

Gary L. Scott schrieb:

> I wonder what it does following a period (". ")? I'd want it to leave
> two spaces, others might want it to leave only one space.
>

You can make some ". " -> ". " replacement (look the post for replace
:) ). I never need that posibility, because in spanish it is not used
to leave two spaces following period :).

FJRA

David Frank

2005-08-05, 4:01 am

"Gary L. Scott" <garyscott@ev1.net> wrote in message
news:11f594afjmdudde@corp.supernews.com...
> David Frank wrote:
>
> I wonder what it does following a period (". ")? I'd want it to leave
> two spaces, others might want it to leave only one space.
>

Lets consider the purpose of what IMO the OVERWHELMING majority of users
wants in a blank reduction string function.
I say its to reduce multiple blanks BETWEEN words to one blank and return
the line with trailing blanks
reflecting the shortened length.
At that point, user is free to attach text depending on last char returned.

character(200) :: line1 = 'the quick brown fox', line2 = "jumps over
the lazy dog's back."
line1 = reduce_blanks(line1)
n = len_trim(line) ; last_char = line(n:n)
if (last_char == ".") then

David Frank

2005-08-05, 9:01 am

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:dctfs9$bft$1@scrotar.nss.udel.edu...
>
> PS I've yet to see working blank-reduction code from you, David. So you
> continue to fail it.

See a poor man's version of your elaborate varying module that allows me to
output:

| the quick brown fox jumps | <- one trailing blank

that runs even faster due to 1 statement being eliminated ( pad = ' ' )

http://home.earthlink.net/~dave_gemini/reduce.f90

plus thanks to Skip Knoble for finding there IS a need for
implicit none
integer :: i
in my reduce_blanks function

David Frank

2005-08-05, 5:02 pm

Further improvement to my reduce_blanks function allows output to be padded
with either a blank or null,

! -----------------------------------------------
module c_varying ! provide varying string support via C strings
contains
! ----------------
function ctrim(s1) result(s2)
character(*) :: s1
character(clen(s1)) :: s2 ! set output length to 1st null -1
s2 = s1
end function ctrim
! ------------------------
pure integer function clen(s)
character(*),intent(in) :: s
clen = index(s,char(0))-1
end function clen
! -------------------------
function reduce_blanks(line,pad) result (outline)
implicit none
character(*) :: line
character(len(line)) :: outline
character :: pad, pads(len(line)), a(len(line))
logical :: packlist(len(line))
integer :: i

packlist = .true. ; pads = pad ! pad == ' ' or null
a = transfer(line,a)
do i = 1,size(a)-1
if (a(i) == ' '.and.a(i+1) == ' ') packlist(i) = .false.
end do
outline = transfer(pack(a, packlist, pads),outline)
end function reduce_blanks
end module c_varying

! --------------------------
program demo_reduce_blanks ! with 1 trailing blank possible via c string
use c_varying
character,parameter :: null = char(0)
character(70) :: line = ' the quick brown fox'

write (*,*) '|', trim(reduce_blanks(line,' ')), '|' ! returned
trailiing blanks
write (*,*) '|', ctrim(reduce_blanks(line,null)),'|' ! return c string
write (*,*) '|', ctrim(reduce_blanks(trim(line),null)),'|
' ! return c
string
end program

! 3 writes above generate:
! | the quick brown fox| <- trimmed trailing blanks
! | the quick brown fox | <- ctrim of c string last char = blank
! | the quick brown fox| <- ctrim of c string last char /= blank

Gary L. Scott

2005-08-05, 10:01 pm

David Frank wrote:
> "Gary L. Scott" <garyscott@ev1.net> wrote in message
> news:11f594afjmdudde@corp.supernews.com...
>
>
>
> Lets consider the purpose of what IMO the OVERWHELMING majority of users
> wants in a blank reduction string function.
> I say its to reduce multiple blanks BETWEEN words to one blank and return
> the line with trailing blanks
> reflecting the shortened length.
> At that point, user is free to attach text depending on last char returned.

Maybe so, but it wouldn't take much to allow this optional variation of
processing with neglible impact to performance. If you're restricting
to English, automatically handling punctuation of various types would
be useful. Also for example, what if the repeated spaces are in quotes
" " and are in the middle of a string (a quoted string within the
string to be processed). In that case, you might not want them to be
reduced. May as well make it more useful. There's a small number of
"obvious" extensions of this form.

>

> character(200) :: line1 = 'the quick brown fox', line2 = "jumps over
> the lazy dog's back."
> line1 = reduce_blanks(line1)
> n = len_trim(line) ; last_char = line(n:n)
> if (last_char == ".") then
>
>
>
>
>

--

Gary Scott
mailto:garyscott@ev1.net

Fortran Library: http://www.fortranlib.com

Support the Original G95 Project: http://www.g95.org
-OR-
Support the GNU GFortran Project: http://gcc.gnu.org/fortran/index.html

Why are there two? God only knows.

If you want to do the impossible, don't hire an expert because he knows
it can't be done.

-- Henry Ford

James Giles

2005-08-10, 5:06 pm

> The *most* common goal should be "verifiably correct".
> That usually requires legibility. Speed should only be
> a goal if the code in question is provably a bottleneck
> of one or more of your programs.
>
> Note that sometimes legibility is the path *toward*
> speed.

As an exercise in the value of legibility, I spent a few minutes
this morning to write a solution to the challenge of this thread
which is intended to be as legible as possible. Here it is
without comments:

Pure function reduce_blanks_jlg_1(in_str) result(out_str)
Implicit none
Character(*), intent(in) :: in_str
Character(len(in_str)) :: out_str

Integer :: dest, source, blanks
blanks = 0
dest = 1

Do source = 1, len(in_str)

blanks = merge(0, blanks+1, in_str(source:source)/=" ")

If(blanks > 1) Cycle

out_str(dest:dest) = in_str(source:source)
dest = dest+1

End do

out_str(dest:) = " "

End function reduce_blanks_jlg_1

Now, if any explanation is needed: SOURCE is the location
of the current character in the input, DEST is the location in
the result where the next character to be kept will go, and
BLANKS is the number of consecutive blanks since the
last non-blank character. If this code were to be included
in a library or something, comments to that effect would be
included. Given that information, I think anyone that knows
Fortran can easily verify that the procedure removes redundant
blanks as desired. Also, by initializing BLANKS to 1 instead
of zero before the loop, all leading blanks could be removed.
And, changing the last assignment could mark the end of the
processed data with a null if that was desired.

Well, it's not 3 statements or less. But it's more legible than
those. I tried it (only on an old AMD 1.2 GHz, with CVF6.6c),
and at all optimization levels it beats the "fewest lines possible"
solutions at all optimization levels (including compiling from
the command line with no options). The one solution that
consistently beats this code is the NucWiz version - which
is somewhat of a puzzle since it's structurally similar. The
only important difference is that he TRANSFERs the string
to an array and uses the array as the intermediate. Well,
that prompted my second solution:

Pure function reduce_blanks_jlg_2(in_str) result(out_str)
Implicit none
Character(*), intent(in) :: in_str
Character(len(in_str)) :: out_str

Character :: c(len(in_str))
Integer :: dest, source, blanks

c = transfer(in_str,c)
blanks = 0
dest = 1

Do source = 1, size(c)

blanks = merge(0, blanks+1, c(source)/=" ")

If(blanks > 1) Cycle

c(dest) = c(source)
dest = dest+1

End do

c(dest:) = " "

out_str = transfer(c, out_str)

End function reduce_blanks_jlg_2

This solution, at all optimization levels (including using the
command line with no options specified) is faster than any of
the other solutions posted. (Well, I didn't test JvB's recursive
version. I doubt it was particularly fast.)

Now, I don't actually understand why this second solution is
faster than the first. It ought to be about the same except for
the cost of the TRANSFER calls. And, on the assumption
that TRANSFER probably makes a copy (at least), those
calls should cost something. But, perhaps CVF always
does string manipulation, even when only single character
substrings are referenced, as multi-character loops.
I didn't look at the object code. It's possible that on
some other compiler (like the one EPC used where
his similar solution ran well) my first solution might be
faster than my second. (It might even be faster than
EPC's.)

Given the fact that these are legible and easily verified,
I can think of only two reasons to even consider trying
something else: 1) *IF* these were, say, an order of
magnitude slower than the alternatives, then it might
be worth some optimization just on general principles;
2) *IF* you could prove this procedure was *THE*
bottleneck of a vital time-critical program. Since the
first reason clearly doesn't apply, and the second hasn't
been suggested, legibility wins out: even if on *some*
environments these fail to be the very fastest - they're
likely fast enough.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

James Giles

2005-08-10, 10:02 pm

By the way, here's a more legible version of JvB's solution.
It's also faster than his "one-liner" (actually, several lines,
but only one statement) on my test system. It's still slower
than my scalar loop though. It might be expected that a
code of this sort be more efficient than a scalar loop on
a hardware platform with lots of parallel operations
and maybe specialized support for a fast version of
PACK. I don't have one of those.

function reduce_blanks_my_jvb (line) result (outline)
character(*), intent(in) :: line
character(len(line)) outline

character :: c(len(line))
logical :: flag(len(line))

c = transfer(line,c)

flag = c .eq. ' '
flag(2:) = .not.(flag(:len(line)-1) .and. flag(2:))
c(:count(flag)) = pack(c, flag)
c(count(flag)+1:) = ' '

outline = transfer(c, outline)

end function reduce_blanks_my_jvb

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

David Frank

2005-08-11, 9:03 am

"James Giles" <jamesgiles@worldnet.att.net> wrote in message
news:J0vKe.583234$cg1.302631@bgtnsc04-news.ops.worldnet.att.net...
> By the way, here's a more legible version of JvB's solution.
> It's also faster than his "one-liner" (actually, several lines,
> but only one statement) on my test system. It's still slower
> than my scalar loop though. It might be expected that a
> code of this sort be more efficient than a scalar loop on
> a hardware platform with lots of parallel operations
> and maybe specialized support for a fast version of
> PACK. I don't have one of those.
>
> function reduce_blanks_my_jvb (line) result (outline)
> character(*), intent(in) :: line
> character(len(line)) outline
>
> character :: c(len(line))
> logical :: flag(len(line))
>
> c = transfer(line,c)
>
> flag = c .eq. ' '
> flag(2:) = .not.(flag(:len(line)-1) .and. flag(2:))
> c(:count(flag)) = pack(c, flag)
> c(count(flag)+1:) = ' '
>
> outline = transfer(c, outline)
>
> end function reduce_blanks_my_jvb
>
>
> --
> J. Giles
>

I added this routine as your entry to
http://home.earthlink.net/~davegemini/reduce.f90
for reasons apparent below..

I replaced your last 3 statements
c(:count(flag)) = pack(c, flag)
c(count(flag)+1:) = ' '
outline = transfer(c, outline)
with
outline = transfer(pack(c,flag),outline)

this reduced its runtime from 1.19 sec and since you use pack output I took
the opportunity
to also write its output as a CTRIM(...) thus joining my solution in
producing the CORRECT result.
see below..

Chandler 0.72 sec | the quick brown fox jumps|
NucWiz 0.94 sec | the quick brown fox jumps|
Giles 1.09 sec | the quick brown fox jumps |
Frank 1.30 sec | the quick brown fox jumps |
Vanbuskirk 1.53 sec | the quick brown fox jumps|
FJRA 2.84 sec | the quick brown fox jumps|

David Frank

2005-08-11, 9:03 am

<crap> in my previous,
I again left the _ out of dave_gemini in my
http://home.earthlink.net/~dave_gemini/reduce.f90

David Frank

2005-08-11, 9:03 am

David Frank

2005-08-11, 9:03 am

Herman D. Knoble

2005-08-11, 9:03 am

James Giles

2005-08-11, 5:03 pm

....[color=darkred]

I notice this has a bug in it :-(. At least I found it before
anyone else complained. If the first character of the input
line is a blank, the above will delete it. Just befor the
line with PACK in it should be the line:

flag(1) = .true.

I haven't tested what that does to speed.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

Rich Townsend

2005-08-11, 5:03 pm

David Frank wrote:
> Replacing my FORALL with your flag setting statement, reduces my runtime
> to yours
> at the expense of considerable legibility.
>
> http://home.earthlink.net/~dave_gemini/reduce.f90
>
>
> Chandler 0.73 sec | the quick brown fox jumps|
> NucWiz 0.89 sec | the quick brown fox jumps|
> Giles 1.09 sec | the quick brown fox jumps |
> Frank 1.09 sec | the quick brown fox jumps |
> Vanbuskirk 1.56 sec | the quick brown fox jumps|
> FJRA 2.80 sec | the quick brown fox jumps|
>
>

OK, on my 1.6GHz Pentium M laptop, compiling with ifort -O3, I get:

Giles_1 0.55 sec | the quick brown fox jumps|
Chandler 0.55 sec | the quick brown fox jumps|
NucWiz 1.04 sec | the quick brown fox jumps|
Giles_2 1.41 sec | the quick brown fox jumps |
Frank 1.44 sec | the quick brown fox jumps |
Vanbuskirk 7.87 sec | the quick brown fox jumps|
FJRA 3.50 sec | the quick brown fox jumps|

....and my own entry (source below; I'm sure someone can do better)

reduce.pl 4.88 sec | the quick brown fox jumps|

Interesting to see that, although Perl comes low in the pecking order,
it isn't really that slow compared to the Fortran programs. Note that
the blank reduction in Perl takes a single, trivial line -- but that's
what Perl is for, of course.

cheers,

Rich

---CUT HERE--
#!/usr/bin/perl -w

use Time::HiRes qw (gettimeofday tv_interval);

my $t0 = [gettimeofday];

my $line = ' the quick brown fox jumps';
my $newline;
my $n = 1000000;

for($i = 0; $i < $n; $i++) {
$newline = $line;
1 while $newline =~ s/ / /go;
}

printf("reduce.pl %4.2f sec |%s|\n", tv_interval($t0), $newline);
---CUT HERE---

James Giles

2005-08-11, 5:03 pm

In case someone saw my previous (no canceled) message
on this - ignore it. That's what I get for posting before
coffee. The problem with the code is that it deletes the
first character if it's *not* a blank (my test lines started
with blanks). The correct code for my version of
JvB's method is the same as I wrote in the aborted
message (repeated here completely):

function reduce_blanks_my_jvb (line) result (outline)
character(*), intent(in) :: line
character(len(line)) outline

character :: c(len(line))
logical :: flag(len(line))

c = transfer(line,c)
flag = c == ' '
flag(2:) = .not.(flag(:len(line)-1) .and. flag(2:))
flag(1) = .true.
c(:count(flag)) = pack(c, flag)
c(count(flag)+1:) = ' '
outline = transfer(c, outline)

end function reduce_blanks_my_jvb

There's probably a better way. I'll maybe think of it later.

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

David Frank

2005-08-11, 5:03 pm

"James Giles" <jamesgiles@worldnet.att.net> wrote in message
news:wjMKe.88432$5N3.52301@bgtnsc05-news.ops.worldnet.att.net...
> In case someone saw my previous (no canceled) message
> on this - ignore it. That's what I get for posting before
> coffee. The problem with the code is that it deletes the
> first character if it's *not* a blank (my test lines started
> with blanks). The correct code for my version of
> JvB's method is the same as I wrote in the aborted
> message (repeated here completely):
>

You are completely ignoring my "fix" that has following advantages:
1. runs faster
2. doesnt delete leading blank (but neither does your original version
without the extra flag(1) = .true. statement
3. unlike ANYTHING you have posted so far, it outputs the correct result

>
> There's probably a better way. I'll maybe think of it later.
>

Dont bother, I already thunk of it.
! Giles_1 0.69 sec | the quick brown fox jumps|
! Chandler 0.75 sec | the quick brown fox jumps|
! NucWiz 0.89 sec | the quick brown fox jumps|
! Giles_2 1.09 sec | the quick brown fox jumps |
! Frank 1.09 sec | the quick brown fox jumps |
! Vanbuskirk 1.56 sec | the quick brown fox jumps|
! FJRA 2.81 sec | the quick brown fox jumps|
! ----------------------------------
function reduce_blanks_giles_2(line) result (outline)
character(*), intent(in) :: line
character(len(line)) outline

character :: c(len(line))
logical :: flag(len(line))

c = transfer(line,c)

flag = c .eq. ' '
flag(2:) = .not.(flag(:len(line)-1) .and. flag(2:))

! c(:count(flag)) = pack(c, flag)
! c(count(flag)+1:) = ' '
! outline = transfer(c, outline)
outline = transfer(pack(c,flag),outline)

end function reduce_blanks_giles_2

Rich Townsend

2005-08-11, 5:03 pm

David Frank wrote:
> "James Giles" <jamesgiles@worldnet.att.net> wrote in message
> news:wjMKe.88432$5N3.52301@bgtnsc05-news.ops.worldnet.att.net...
>
>
>
> You are completely ignoring my "fix" that has following advantages:
> 1. runs faster
> 2. doesnt delete leading blank (but neither does your original version
> without the extra flag(1) = .true. statement
> 3. unlike ANYTHING you have posted so far, it outputs the correct result
>

Can you remind me which having a trailing blank is 'correct', when no
such blank appears in the initial string? I'm a little

here.

cheers,

Rich

James Giles

2005-08-11, 5:03 pm

David Frank wrote:
> "James Giles" <jamesgiles@worldnet.att.net> wrote in message
> news:wjMKe.88432$5N3.52301@bgtnsc05-news.ops.worldnet.att.net...
>
> You are completely ignoring my "fix" that has following advantages:
> 1. runs faster

On your system. And entirely because of a change unrelated to
my fix of flag(1).

> 2. doesnt delete leading blank (but neither does your original
> version without the extra flag(1) = .true. statement

But, if the leading character of the input line is *not* a blank,
even your modification incorrectly deletes it. That's the point
of resetting flag(1). My test lines (and yours too) all start
with blanks and didn't adequately test this behavior. I've
corrected that in my tests.

> 3. unlike ANYTHING you have posted so far, it outputs the correct
> result

On my test, my version prints the correct result which is the
length of the returned string - the same length as the input
string since it's declared as:

character(len(line)) outline

What CTRIM does is something I've never bothered to research.
I suspect I don't care. It's not in any version of the Fortran
standard (not even the current standard: F2003).

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare

David Frank

2005-08-11, 5:03 pm

"Rich Townsend" <rhdt@barVOIDtol.udel.edu> wrote in message
news:ddg4i0$il$1@scrotar.nss.udel.edu...

>
> Can you remind me which having a trailing blank is 'correct', when no such
> blank appears in the initial string? I'm a little

here.
>

reduce.f90 benchmark code has declaration for the line being used:

character(40) :: line = ' the quick brown fox jumps'

therefor there are a BUNCH of trailing blanks presented to EVERYONE's
reduce_blanks(line)
that must be reduced to 1 blank