"Parsing" a string

Hello! I have to read a PGM image and transform it into a list of Int values. I read the image (this is an ASCII PGM format) using the readFile function and get a string with the contents of the file. This string contains height and widht of the image at the beginning, and then the pixel values follow. I need to read the height and width, then "cut" them from the string, create an array (or finite map) of Int's (for this I need to know the height and width), and then recursively process the pixel values (i. e. put them into the array). The string is structured as follows: <string> P2 # comment # comment 320<WHITESPACE>243<WHITESPACE>255 130 130 130 130 130 130 130 130 130 130 </string> P2 is the magic number. All lines starting with # are comments and must be ignored. 320 and 243 are width and height. <WHITESPACE> is either a space, or tab, or newline. At the moment, I don't have an idea about how to read width and height. One possible approach would be to convert the string into a list of strings A, using newline as separator. Then, I could create list A' with comments removed. Then, A' can be transformed into a string A'' again. From A'' I know that width is contained between the end of P2 and the first occurrence of whitespace (Char.isSpace). I also know that height is contained between first and second occurrence of white space. I could use some sort of regular expression analogons to access width and height. I have several questions concerning this approach: 1) How can I transform a string into a list of strings, separated by some character (in Java one uses StringTokenizer for this) ? 2) How do the aforementioned "regular expressions' analogons" work in Haskell? Thanks in advance Dmitri Pissarenko -- Dmitri Pissarenko Software Engineer http://dapissarenko.com

Over the past years I became more and more aware that common mathematical notation is full of inaccuracies, abuses and stupidity. I wonder if mathematical notation is subject of a mathematical branch and whether there are papers about this topic, e.g. how one can improve common mathematical notation with the knowledge of functional languages. Things I'm unhappy about are for instance f(x) \in L(\R) where f \in L(\R) is meant F(x) = \int f(x) \dif x where x shouldn't be visible outside the integral O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming) a < b < c which is a short-cut of a < b \land b < c f(.) which means \x -> f x or just f All of these examples expose a common misunderstanding of functions, so I assume that the pioneers of functional programming also must have worried about common mathematical notation.

Henning Thielemann
Over the past years I became more and more aware that common mathematical notation is full of inaccuracies, abuses and stupidity. I wonder if mathematical notation is subject of a mathematical branch and whether there are papers about this topic, e.g. how one can improve common mathematical notation with the knowledge of functional languages.
I would like to know too! But I would hesitate with some of your examples, because they may simply illustrate that mathematical notation is a language with side effects -- see the third and fifth examples below.
Things I'm unhappy about are for instance f(x) \in L(\R) where f \in L(\R) is meant
(I'm not sure what you are referring to here -- is there a specific L that you have in mind?)
F(x) = \int f(x) \dif x where x shouldn't be visible outside the integral
(Not to mention that F(x) is only determined up to a constant.)
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
I'm worried about this analysis, because would O(1) mean O(\n -> 1), and 1/O(n^2) mean 1/O(\n -> n^2)? And what about the equal sign in front of most uses of big-O notation? I would rather analyze this notation as O = shift k. exists g. g is an asymptotically bounded function and k(g(n)) where "shift" is Danvy and Filinski's control operator (paired with "reset"). This way, we can use (as people do) reset(f(n) = 2^{-O(n)}) to mean that exists g. g is an asymptotically bounded function and f(n) = 2^{-g(n)*n}. Note that the argument to g is not specified in the original notation, and neither is the reset explicit. But the parentheses in "O(n)" is now regarded as mere multiplication (making "O-of-n" a mispronunciation). With some more trickery underlying the equal sign, one can state meanings such that "O(n) = O(n^2)" is true but "O(n^2) = O(n)" is false.
a < b < c which is a short-cut of a < b \land b < c
What do you think of [a,b,c] for lists?
f(.) which means \x -> f x or just f
I regard this as reset(f(shift k. k)). Besides, even Haskell has (3+).
All of these examples expose a common misunderstanding of functions, so I assume that the pioneers of functional programming also must have worried about common mathematical notation.
But AFAIK, nobody ever promised that the mathematical notation used to talk about functions must denote functions themselves. To take another example, even though programs are morphisms, we don't always program in point-free style. And the English word "nobody" does not denote anybody! -- Edit this signature at http://www.digitas.harvard.edu/cgi-bin/ken/sig War crimes will be prosecuted. War criminals will be punished. And it will be no defense to say, "I was just following orders."' George W. Bush, address to the nation, 2003-03-17 http://www.whitehouse.gov/news/releases/2003/03/20030317-7.html

On Fri, 28 Jan 2005, Chung-chieh Shan wrote:
Henning Thielemann
wrote in article in gmane.comp.lang.haskell.cafe: Over the past years I became more and more aware that common mathematical notation is full of inaccuracies, abuses and stupidity. I wonder if mathematical notation is subject of a mathematical branch and whether there are papers about this topic, e.g. how one can improve common mathematical notation with the knowledge of functional languages.
I would like to know too!
But I would hesitate with some of your examples, because they may simply illustrate that mathematical notation is a language with side effects -- see the third and fifth examples below.
I can't imagine mathematics with side effects, because there is no order of execution.
Things I'm unhappy about are for instance f(x) \in L(\R) where f \in L(\R) is meant
(I'm not sure what you are referring to here -- is there a specific L that you have in mind?)
Erm yes, my examples are taken from functional analysis. L(\R) means the space of Lebesgue integrable functions mapping from \R to \R.
F(x) = \int f(x) \dif x where x shouldn't be visible outside the integral
(Not to mention that F(x) is only determined up to a constant.)
right, so \int needs a further parameter for the constant
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
I'm worried about this analysis, because would O(1) mean O(\n -> 1), and 1/O(n^2) mean 1/O(\n -> n^2)?
O(n^2) means O(\n -> n^2), yes. People say, it is obvious what O(n^2) means. For me it is obvious that they probably want to pass a constant function in, because O takes a function as argument and because I know people often don't distinguish between constant functions and scalar values. Then O(n) = O(n^2) because O(n) and O(n^2) denote the set of constant functions. :-) But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
And what about the equal sign in front of most uses of big-O notation?
This must be an \in and this prevents us from any trouble.
I would rather analyze this notation as
O = shift k. exists g. g is an asymptotically bounded function and k(g(n))
where "shift" is Danvy and Filinski's control operator (paired with "reset"). This way, we can use (as people do)
reset(f(n) = 2^{-O(n)})
to mean that
exists g. g is an asymptotically bounded function and f(n) = 2^{-g(n)*n}.
I never heard about shift and reset operators, but they don't seem to be operators in the sense of higher-order functions.
With some more trickery underlying the equal sign, one can state meanings such that "O(n) = O(n^2)" is true but "O(n^2) = O(n)" is false.
Sticking to the set definition of O we would need no tricks at all: O(\n -> n) \subset O(\n -> n^2) and O(\n -> n) /= O(\n -> n^2)
a < b < c which is a short-cut of a < b \land b < c
What do you think of [a,b,c] for lists?
I learnt to dislike separators like commas, because 1. (practical reason) it's harder to reorder lists in a editor 2. (theoretical reason) it's inconsistent since there is always one separator less than list elements, except when the list is empty. In this case there are 0 separators instead of -1. So I think (a:b:c:[]) is the better notation.
f(.) which means \x -> f x or just f
I regard this as reset(f(shift k. k)). Besides, even Haskell has (3+).
Hm, (3+) is partial application, a re-ordered notation of ((+) 3), which is only possible if the omitted value is needed only once. But I see people writing f(.) + f(.-t) and they don't tell, whether this means (\x -> f x) + (\x -> f (x-t)) or (\x -> f x + f (x-t)) In this case for most mathematicians this doesn't matter because in the above case (+) is silently lifted to the addition of functions. It seems to me that the dot is somehow more variable than variables, and a dot-containing expression represents a function where the function arguments are inserted where the dots are.
All of these examples expose a common misunderstanding of functions, so I assume that the pioneers of functional programming also must have worried about common mathematical notation.
But AFAIK, nobody ever promised that the mathematical notation used to talk about functions must denote functions themselves.
I found that using a notation respecting the functional idea allows very clear terms. So I used Haskell notation above to explain, what common mathematical terms may mean.

On 2005-01-28T20:16:59+0100, Henning Thielemann wrote:
On Fri, 28 Jan 2005, Chung-chieh Shan wrote:
But I would hesitate with some of your examples, because they may simply illustrate that mathematical notation is a language with side effects -- see the third and fifth examples below. I can't imagine mathematics with side effects, because there is no order of execution.
To clarify, I'm not saying that mathematics may have side effects, but that the language we use to talk about mathematics may have side effects, even control effects with delimited continuations. Shift and reset, and other delimited control operators such as control and prompt (which date earlier than shift and reset), are neat. Given that we are talking about language semantics, you may be interested in my paper at http://www.eecs.harvard.edu/~ccshan/cw2004/cw.pdf (which quickly introduces shift and reset).
F(x) = \int f(x) \dif x where x shouldn't be visible outside the integral (Not to mention that F(x) is only determined up to a constant.) right, so \int needs a further parameter for the constant
Or you can take integration to return a set of functions, and = as \in. That's not actually how I would ultimately analyze things, but it seems to be a start.
People say, it is obvious what O(n^2) means. For me it is obvious that they probably want to pass a constant function in, because O takes a function as argument and because I know people often don't distinguish between constant functions and scalar values. Then O(n) = O(n^2) because O(n) and O(n^2) denote the set of constant functions. :-)
I am interested in "descriptive mathematical notation" rather than "prescriptive mathematical notation" (these are just my terms), in the sense that I want to first ask people what they take certain existing pieces of mathematical notation to mean, then figure out formal rules that underlie these "obvious" interpretations.
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
Wait a minute -- would you also say that "1+x" has no meaning at the first glance, because "x" is a variable whereas "1" is an integer, so some lifting is called for?
I never heard about shift and reset operators, but they don't seem to be operators in the sense of higher-order functions.
Right; they are control operators in the sense that call/cc is a control operator.
With some more trickery underlying the equal sign, one can state meanings such that "O(n) = O(n^2)" is true but "O(n^2) = O(n)" is false. Sticking to the set definition of O we would need no tricks at all: O(\n -> n) \subset O(\n -> n^2) and O(\n -> n) /= O(\n -> n^2)
By "trickery" I meant taking "=" to not denote equality. So for me, taking "=" to denote the subset relation would count as a trick.
f(.) which means \x -> f x or just f
I regard this as reset(f(shift k. k)). Besides, even Haskell has (3+).
Hm, (3+) is partial application, a re-ordered notation of ((+) 3), which is only possible if the omitted value is needed only once. But I see people writing f(.) + f(.-t) and they don't tell, whether this means (\x -> f x) + (\x -> f (x-t)) or (\x -> f x + f (x-t)) In this case for most mathematicians this doesn't matter because in the above case (+) is silently lifted to the addition of functions.
Yes, so in my mind an environment monad is in effect (so to speak) here, and the difference between the two meanings you pointed out is the difference between liftM2 (+) (liftM f ask) (liftM f (liftM2 (-) ask (return t))) and (+) (liftM f ask) (liftM f (liftM2 (-) ask (return t))) (where import Monad and Control.Monad.Reader :).
But AFAIK, nobody ever promised that the mathematical notation used to talk about functions must denote functions themselves. I found that using a notation respecting the functional idea allows very clear terms. So I used Haskell notation above to explain, what common mathematical terms may mean.
But Haskell notation does -not- respect the functional idea. First there's the issue of variables: to respect the functional idea we must program in point-free style. Second there's the issue of types: to respect the (set-theoretic) functional idea we must abolish polymorphism and annotate our lambda abstractions in Church style. Surely we don't want the meaning of our mathematical formulas to depend on the semantics of System F(-omega)! Or, as I would prefer, we could design our notation to be both intuitive and formally tractable, without requiring that the concrete syntax of our language directly correspond to the semantics of mathematics or programming. The (simply-typed, pure) lambda-calculus does that, at the (very reasonable) cost of having us specify things like alpha-conversion and substitution. -- Edit this signature at http://www.digitas.harvard.edu/cgi-bin/ken/sig War crimes will be prosecuted. War criminals will be punished. And it will be no defense to say, "I was just following orders."' George W. Bush, address to the nation, 2003-03-17 http://www.whitehouse.gov/news/releases/2003/03/20030317-7.html

Chung-chieh Shan wrote:
On 2005-01-28T20:16:59+0100, Henning Thielemann wrote:
I can't imagine mathematics with side effects, because there is no order of execution.
To clarify, I'm not saying that mathematics may have side effects, but that the language we use to talk about mathematics may have side effects, even control effects with delimited continuations.
I understand.
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
Wait a minute -- would you also say that "1+x" has no meaning at the first glance, because "x" is a variable whereas "1" is an integer, so some lifting is called for?
For me 'x' is a place holder for a value. For the expression '1+x' I conclude by type inference that 'x' must be a variable for a scalar value, since '1' is, too. But the expression '1/O(n^2)' has the scalar value '1' on the left of '/' and a set of functions at the right side. Type inference fails, so my next try is to make the operands compatible in a somehow natural way. Since mathematical notation invokes many implicit conversions, it's sometimes no longer unique or obvious what implicit conversion to use. Many users of O(n^2) seem to consider it as a placeholder for some expression, where the value of the expression is bounded by n^2.
I never heard about shift and reset operators, but they don't seem to be operators in the sense of higher-order functions.
Right; they are control operators in the sense that call/cc is a control operator.
So they seem to be operators that work on expressions rather than values. In this respect they are similar to the lambda operator, aren't they?
But I see people writing f(.) + f(.-t) and they don't tell, whether this means (\x -> f x) + (\x -> f (x-t)) or (\x -> f x + f (x-t)) In this case for most mathematicians this doesn't matter because in the above case (+) is silently lifted to the addition of functions.
Yes, so in my mind an environment monad is in effect (so to speak) here, and the difference between the two meanings you pointed out is the difference between
liftM2 (+) (liftM f ask) (liftM f (liftM2 (-) ask (return t)))
and
(+) (liftM f ask) (liftM f (liftM2 (-) ask (return t)))
(where import Monad and Control.Monad.Reader :).
You use 'ask' twice in the second expression. Does this mean that there may be two different values for 'ask'? If this is the case your second interpretation differs from my second interpretation.
I found that using a notation respecting the functional idea allows very clear terms. So I used Haskell notation above to explain, what common mathematical terms may mean.
But Haskell notation does -not- respect the functional idea. First there's the issue of variables: to respect the functional idea we must program in point-free style.
Hm, you are right, I also use function definitions like (\x -> f x + g x) ... Sure, I know from the theory of partial recursive functions that I can do "everything" with "notationally pure functions", but I don't know if it is convenient.
Second there's the issue of types: to respect the (set-theoretic) functional idea we must abolish polymorphism and annotate our lambda abstractions in Church style. Surely we don't want the meaning of our mathematical formulas to depend on the semantics of System F(-omega)!
Church style, System F(-omega), alpha-conversion, lambda calculus, eta reduction, currying - Where can I find some introduction to them? What about Haskell Curry? What about Bourbaki? - I have heard they worked hard to find a unified notation.

On Fri, Jan 28, 2005 at 08:16:59PM +0100, Henning Thielemann wrote:
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
My first guess is Omega(1/n^2). -- wli

(Resurrecting a somewhat old thread...) On Fri, Jan 28, 2005 at 08:16:59PM +0100, Henning Thielemann wrote:
On Fri, 28 Jan 2005, Chung-chieh Shan wrote:
But I would hesitate with some of your examples, because they may simply illustrate that mathematical notation is a language with side effects -- see the third and fifth examples below. I can't imagine mathematics with side effects, because there is no order of execution.
Not all side effects require an order of execution. For instance, dependence on the environment is a side effect (in the sense that it is related to a monad), but it does not depend on the order of execution. There are many other examples too, like random variables.
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
I don't think this can be right. Ken argued around this point, but here's a more direct argument: in f(x) = x + 1 + O(1/x) all the 'x's refer to the same variable; so you shouldn't go and capture the one inside the 'O'. This is established mathematical notation, it's very useful, and can be explained almost coherently. The one deficiency is that we should interpret 'O' as "an asymptotically bounded function of..." but that doesn't say what it is a function of and where we should take the asymptotics. But the patch you suggest doesn't really help.
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
I think this is the only reasonable generalization from the established usage of, e.g., 2^(O(n)). In practice, this means that 1/O(n^2) is the set of functions asymptotically bounded below by 1/kn^2 for some k.
Hm, (3+) is partial application, a re-ordered notation of ((+) 3), which is only possible if the omitted value is needed only once. But I see people writing f(.) + f(.-t) and they don't tell, whether this means
(\x -> f x) + (\x -> f (x-t))
or
(\x -> f x + f (x-t))
Have you really seen people use that notation with either of those meanings? That's really horrible and inconsistent. I would have interpreted f(.) + f(.-t) as \x \y -> f(x) + f(y-t) to be consistent with notation like .*. , which seems to mean \x \y -> x*y in my experience.
It seems to me that the dot is somehow more variable than variables, and a dot-containing expression represents a function where the function arguments are inserted where the dots are.
Right. I don't know how to formalize this, but that doesn't mean it can't be done. Peace, Dylan

On Fri, Jan 28, 2005 at 08:16:59PM +0100, Henning Thielemann wrote:
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
On Thu, Feb 03, 2005 at 08:16:49PM -0500, Dylan Thurston wrote:
I think this is the only reasonable generalization from the established usage of, e.g., 2^(O(n)). In practice, this means that 1/O(n^2) is the set of functions asymptotically bounded below by 1/kn^2 for some k.
Careful, 2^x is monotone increasing; 1/x is monotone decreasing. I said 1/O(n^2) is Omega(1/n^2) for a good reason. Inequalities are reversed by monotone decreasing functions. Likewise, sech(O(n^2)) = Omega(sech(n^2)), which is happily immune to the effects of sign. Usually f(n) = O(g(n)) is done as there exist N, K so that |f(n)| <= K*|g(n)| for all n > N so e.g. e^x \in O((-1)^{\chi_\mathbb{Q}}\cdot e^x) etc. Also, you're in a bit of trouble wrt. 2^(O(n)). O(2^n) is something rather different. O(2^n) has |f(n)| <= K*|2^n| but 2^(O(n)) is 2^|f(n)| where |f(n)| <= K*|n|. If K >= 1/log(2) is sharp then then we have 2^|f(n)| >= e^|n| \in omega(2^n). -- wli

On Fri, Feb 04, 2005 at 05:47:20AM -0800, William Lee Irwin III wrote:
On Fri, Jan 28, 2005 at 08:16:59PM +0100, Henning Thielemann wrote:
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
On Thu, Feb 03, 2005 at 08:16:49PM -0500, Dylan Thurston wrote:
I think this is the only reasonable generalization from the established usage of, e.g., 2^(O(n)). In practice, this means that 1/O(n^2) is the set of functions asymptotically bounded below by 1/kn^2 for some k.
Careful, 2^x is monotone increasing; 1/x is monotone decreasing. I said 1/O(n^2) is Omega(1/n^2) for a good reason. Inequalities are reversed by monotone decreasing functions.
Sorry, isn't that what I said? Am I confused?
Also, you're in a bit of trouble wrt. 2^(O(n)). O(2^n) is something rather different. O(2^n) has |f(n)| <= K*|2^n| but 2^(O(n)) is 2^|f(n)| where |f(n)| <= K*|n|. If K >= 1/log(2) is sharp then then we have 2^|f(n)| >= e^|n| \in omega(2^n).
I don't follow the last sentence, but yes, O(2^n) and 2^(O(n)) are different. In particular 2^(O(n)) and (e.g.) 3^(O(n)) are the same. Peace, Dylan

On Thu, 3 Feb 2005, Dylan Thurston wrote:
On Fri, Jan 28, 2005 at 08:16:59PM +0100, Henning Thielemann wrote:
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
I don't think this can be right. Ken argued around this point, but here's a more direct argument: in
f(x) = x + 1 + O(1/x)
all the 'x's refer to the same variable; so you shouldn't go and capture the one inside the 'O'.
I didn't argue, that textually replacing all O(A) by O(\n -> A) is a general solution. For your case I suggest (\x -> f(x) - x - 1) \in O (\x -> 1/x)
But what do you mean with 1/O(n^2) ? O(f) is defined as the set of functions bounded to the upper by f. So 1/O(f) has no meaning at the first glance. I could interpret it as lifting (1/) to (\f x -> 1 / f x) (i.e. lifting from scalar reciprocal to the reciprocal of a function) and then as lifting from a reciprocal of a function to the reciprocal of each function of a set. Do you mean that?
I think this is the only reasonable generalization from the established usage of, e.g., 2^(O(n)). In practice, this means that 1/O(n^2) is the set of functions asymptotically bounded below by 1/kn^2 for some k.
I haven't yet seen the expression 2^(O(n)). I would interpret it as lifting (\x -> 2^x) to sets of functions, then applying it to the function set O(\n -> n). But I assume that this set can't be expressed by an O set.
But I see people writing f(.) + f(.-t) and they don't tell, whether this means
(\x -> f x) + (\x -> f (x-t))
or
(\x -> f x + f (x-t))
Have you really seen people use that notation with either of those meanings?
In principle, yes.
That's really horrible and inconsistent. I would have interpreted f(.) + f(.-t) as
\x \y -> f(x) + f(y-t)
to be consistent with notation like .*. , which seems to mean \x \y -> x*y in my experience.
The problems with this notation are: You can't represent constant functions, which is probably no problem for most people, since they identify scalar values with constant functions. But the bigger problem is the scope of the dot: How much shall be affected by the 'functionisation' performed by the dot? The minimal scope is the dot itself, that is . would mean the id function. But in principle it could also mean the whole expression. I think there are good reasons why such a notation isn't implemented for Haskell. But I have seen it in SuperCollider.

On Thu, 3 Feb 2005, Dylan Thurston wrote:
I think this is the only reasonable generalization from the established usage of, e.g., 2^(O(n)). In practice, this means that 1/O(n^2) is the set of functions asymptotically bounded below by 1/kn^2 for some k.
On Fri, Feb 04, 2005 at 03:08:51PM +0100, Henning Thielemann wrote:
I haven't yet seen the expression 2^(O(n)). I would interpret it as lifting (\x -> 2^x) to sets of functions, then applying it to the function set O(\n -> n). But I assume that this set can't be expressed by an O set.
You're right, it can't be expressed as O(g(n)) for any g(n). For that matter, and neither can sech(O(n^2)) be expressed as Omega(g(n)) for any g(n). -- wli

On Fri, Feb 04, 2005 at 03:08:51PM +0100, Henning Thielemann wrote:
On Thu, 3 Feb 2005, Dylan Thurston wrote:
On Fri, Jan 28, 2005 at 08:16:59PM +0100, Henning Thielemann wrote:
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
I don't think this can be right. Ken argued around this point, but here's a more direct argument: in
f(x) = x + 1 + O(1/x)
all the 'x's refer to the same variable; so you shouldn't go and capture the one inside the 'O'.
I didn't argue, that textually replacing all O(A) by O(\n -> A) is a general solution. For your case I suggest
(\x -> f(x) - x - 1) \in O (\x -> 1/x)
This kind of replacement on the top level is exactly what continuations (which Ken was suggesting) can acheive. If you think carefully about exactly what the big-O notation means in general expressions like this, you'll be led to the same thing.
I haven't yet seen the expression 2^(O(n)). I would interpret it as lifting (\x -> 2^x) to sets of functions, then applying it to the function set O(\n -> n). But I assume that this set can't be expressed by an O set.
That's right; for instance, in your terminology, 3^n is in 2^(O(n)).
But I see people writing f(.) + f(.-t) and they don't tell, whether this means
(\x -> f x) + (\x -> f (x-t))
or
(\x -> f x + f (x-t))
Have you really seen people use that notation with either of those meanings?
In principle, yes.
I'm curious to see examples.
That's really horrible and inconsistent. I would have interpreted f(.) + f(.-t) as
\x \y -> f(x) + f(y-t)
to be consistent with notation like .*. , which seems to mean \x \y -> x*y in my experience.
The problems with this notation are: You can't represent constant functions, which is probably no problem for most people, since they identify scalar values with constant functions. But the bigger problem is the scope of the dot: How much shall be affected by the 'functionisation' performed by the dot? The minimal scope is the dot itself, that is . would mean the id function. But in principle it could also mean the whole expression. I think there are good reasons why such a notation isn't implemented for Haskell. But I have seen it in SuperCollider.
I certainly don't want to defend this notation... Now that you mention it, Mathematica also has this notation, with explicit delimiters; for instance, `(#+2)&' is the function of adding two. Peace, Dylan

Dylan Thurston wrote:
Now that you mention it, Mathematica also has this notation, with explicit delimiters; for instance, `(#+2)&' is the function of adding two.
There's a Boost library supporting a similar notation in C++, with no explicit delimiters except to resolve ambiguity or work around C++ limitations: http://www.boost.org/doc/html/lambda.html -- Ben

On Sat, 5 Feb 2005, Dylan Thurston wrote:
On Fri, Feb 04, 2005 at 03:08:51PM +0100, Henning Thielemann wrote:
I didn't argue, that textually replacing all O(A) by O(\n -> A) is a general solution. For your case I suggest
(\x -> f(x) - x - 1) \in O (\x -> 1/x)
This kind of replacement on the top level is exactly what continuations (which Ken was suggesting) can acheive.
Ken? Ken Iverson alias APL? What's meant with continuations?
If you think carefully about exactly what the big-O notation means in general expressions like this, you'll be led to the same thing.
Whereever I have seen a formal definition of O, it is defined to be an operator with a signature like O :: (a -> a) -> Set (a -> a) I'm curious how to define an O which takes expressions rather than values as arguments.
But I see people writing f(.) + f(.-t) and they don't tell, whether this means
(\x -> f x) + (\x -> f (x-t))
or
(\x -> f x + f (x-t))
I'm curious to see examples.
http://www.math.uni-bremen.de/~teschke/ps/final_formatted.ps.gz page 6, e.g. the sum symbol in (2.8) and the scalar product in (2.15) Btw. what did you mean with monadic effects in mathematical notation? When thinking about using the same symbol or character for different purposes then I consider this sometimes as scoping issues and sometimes as overloading. I'm not sure if you meant that.

Hello This might be a trivial question, but I wonder if anybody knows how to write a function proj :: (Functor f, Functor f') => (f:*:f') (a,b) -> f a where data a:*:b o = Pair (a o) (b o) I think I really want to project out a component of F (AxB) x F' (AxB). However, this seems harder in Haskell than in category theory, but I am not 100% sure. Best Wishes, Johan Glimming

Chung-chieh Shan
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
It's a neat thought, IMHO. I usually try to quantify the variables used, making the equivalent of 'let n = .. in O(n)'
And what about the equal sign in front of most uses of big-O notation?
This is a peeve of mine; I've always preferred to view O(n) etc. as sets of functions, so that a particular function can be a *member* of this set. Otherwise, you could have: f=O(n) /\ g=O(n) => f=g :-)
With some more trickery underlying the equal sign, one can state meanings such that "O(n) = O(n^2)" is true but "O(n^2) = O(n)" is false.
I would rather say that O(n) is a subset of O(n^2).
a < b < c which is a short-cut of a < b \land b < c
What's the problem with this one? -kzm -- If I haven't seen further, it is by standing in the footprints of giants

Well, I don't know about modern works which might appeal to knowledge of FP languages, but there is a well-known, 2-volume work by Cajori: Cajori, F., A History of Mathematical Notations, The Open Court Publishing Company, Chicago, 1929 (Available from Dover). I know it through Ken Iverson (may he rest in peace), the creator of APL. (Dr. Iverson's own notations were not to everyone's taste, but I think they were a bigger influence on Backus and the recent wave of FP than is generally acknowledged.) APL *did* have "implicit maps and zipWiths" in the sense that scalar functions would be automatically extended to vectors (and similarly for higher dimensions). I think my PhD advisor, Satish Thatte, did some work on extending this sort of "notational abuse" to Hindley-Milner systems, but I don't have the citations at hand. OK then, googling on Cajori yields this quote from a math history site: "He almost single-handedly created the history of mathematics as an academic subject in the United States and, particularly with his book on the history of mathematical notation, he is still one of the most quoted historians of mathematics today." More googling on "mathematical notation" reveals that there *are* people concerned about these issues, Steven Wolfram being an easily-recognized example (he refers to Cajori's work). -- Fritz On Jan 27, 2005, at 12:14 PM, Henning Thielemann wrote:
I wonder if mathematical notation is subject of a mathematical branch and whether there are papers about this topic, e.g. how one can improve common mathematical notation with the knowledge of functional languages.

Things I'm unhappy about are for instance
f(x) \in L(\R) where f \in L(\R) is meant
F(x) = \int f(x) \dif x where x shouldn't be visible outside the integral
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming) f(.) which means \x -> f x or just f
All of these are the same notation abuse, "sometimes f x is meant to be interpreted as \x->f x" In some cases it would be really tedious to add the extra lambdas, so the expression used in its definition is used to denote the function itself.
a < b < c which is a short-cut of a < b \land b < c
Both, ambiguity and complex notation, can lead to (human) parsing problems, which is what we are trying to minimise here. J.A.

At 9:14 PM +0100 2005/1/27, Henning Thielemann wrote:
Over the past years I became more and more aware that common mathematical notation is full of inaccuracies, abuses and stupidity. I wonder if mathematical notation is subject of a mathematical branch and whether there are papers about this topic, e.g. how one can improve common mathematical notation with the knowledge of functional languages.
Your distaste for common mathematical notation was shared by Edsger W. Dijkstra. For a sampling of his writings on the subject, visit http://www.cs.utexas.edu/users/EWD/welcome.html and search the transcriptions for "notation". Or use the Advanced Search" facility to pick up other forms such as "notations" and "notational".
Things I'm unhappy about are for instance
f(x) \in L(\R) where f \in L(\R) is meant
F(x) = \int f(x) \dif x where x shouldn't be visible outside the integral
O(n) which should be O(\n -> n) (a remark by Simon Thompson in The Craft of Functional Programming)
I use lambda notation extensively in the part of my discrete math course that deals with complexity. Works fine. Moreover --anticipating a reply further down the list-- my students learn that O(f) for some function f denotes a set of functions, so that f = O(g), where f and g are functions of the same type, is simply a type error. I seem to recall that Donald Knuth made this point a few decades ago, but old habits die hard.
a < b < c which is a short-cut of a < b \land b < c
This problem has worse consequences when the operator is (=). By common convention, a = b = c is shorthand for a = b /\ b = c which is a great mistake because it obscures the extremely valuable (for equational reasoning) fact that when a, b, and c are Boolean, (=) is associative. In their textbook, _A Logical Approach to Discrete Math_, Gries and Schneider explain that (=) is conjunctional, and that an operator can't be both conjunctional and associative. Following Dijkstra, they introduce another operator, the equivalence (=) (that should display as a three-bar equality operator). It's defined only for Boolean operands, and it's not conjunctional but associative.
f(.) which means \x -> f x or just f
All of these examples expose a common misunderstanding of functions, so I assume that the pioneers of functional programming also must have worried about common mathematical notation.
As did Dijkstra, who devoted the last part of his career to "the streamlining of mathematical argument". Regards, --Ham

Stefan Monnier
OTOH I like the a
It's unambiguous even if the return value of < can be passed as an argument to <. Operators are usually left-associative, right-associative or non-associative. A non-associative operator can have an additional semantics defined when it's used multiple times, just like a,b,c in OCaml is neither a,(b,c) nor (a,b),c, or even a*b*c as a type. -- __("< Marcin Kowalczyk \__/ qrczak@knm.org.pl ^^ http://qrnik.knm.org.pl/~qrczak/

On 2005-01-29, Stefan Monnier
a < b < c which is a short-cut of a < b \land b < c
The confusion between f(x) and ?x.f(x) is indeed a real bummer. OTOH I like the a
Of course, it _is_ defined on Bools in Haskell, with True > False. But see Martin's answer. -- Aaron Denney -><-

On Tue, 25 Jan 2005, Dmitri Pissarenko wrote: (snip)
I need to read the height and width, then "cut" them from the string, create an array (or finite map) of Int's (for this I need to know the height and width), and then recursively process the pixel values (i. e. put them into the array).
The simple way is probably to use functions like "lines" and "words" and "map read". You can then use pattern-matching and recursive functions to work your way through the file. For regular expressions you can use Text.Regex in GHC. However, for fancier parsing in GHC you can look at Text.ParserCombinators.Parsec, and I recall that there was also talk on this list of a nice regular expression library with syntax that goes inline right into your Haskell code in a Perl-like way, but I also can't immediately find any reference to that. -- Mark

Thanks all for the help! -- Dmitri Pissarenko Software Engineer http://dapissarenko.com
participants (17)
-
Aaron Denney
-
Ben Rudiak-Gould
-
Chung-chieh Shan
-
Dmitri Pissarenko
-
dpt@bostoncoop.net
-
dpt@lotus.bostoncoop.net
-
Fritz Ruehr
-
Hamilton Richards
-
Henning Thielemann
-
Johan Glimming
-
Jorge Adriano Aires
-
Ketil Malde
-
Lemming
-
Marcin 'Qrczak' Kowalczyk
-
Mark Carroll
-
Stefan Monnier
-
William Lee Irwin III