Mar 23

    今天又学到一个牛B东西。你相信吗?正则表达式竟然可以用来判定素数,甚至可以用来解方程!下面这段正则表达式可以用来判断,一个字符串的长度是否为合数(假设这个字符串里全是字符'1'):
^1?$|^(11+?)\1+$
    不信的话,把下面这段代码复制到你浏览器的地址栏里运行一下,True表示这个数为合数,False表示这个数为素数:

javascript:var st="1";for(var i=2;i<100;i++)document.write(i," ",/^1?$|^(11+?)\1+$/.test(st=st+"1"),"<br/>");document.close();

    其实,它的原理很简单。加号表示匹配一次或多次(加上一个问号表示非贪婪模式),\1表示引用括号里的内容,头尾的^和$则避免了部分匹配的情况。这样,^(11+?)相当于枚举除数大小,而\1+$则用于检验整个字符串是否能按此大小恰好分完。如果除得尽,则匹配成功,字符串长度为合数。另外,前面的^1?$只是为了处理n=0或n=1时的特殊情况,而符号|则表示“或者”的意思。

    采用同样的方法,我们还可以想出正则表达式其它一些类似的用途。比如,我们可以用这个正则表达式检查方程11x + 2y + 5z = 115是否有自然数解:
^(.*)\1{10}(.*)\2{1}(.*)\3{4}$
    正则表达式中,{x}表示和前面的内容匹配x次。只要用这个表达式去检测一个有115个字符的字符串,匹配成功则表示有自然数解。它的原理和上面的基本一样,我就不再重复了。

参考资料:http://blog.stevenlevithan.com/archives/algebra-with-regexes

Jun 9

    近来可能有人需要这个,我在这里简单说一下。

    我没有找到好的同学录服务提供商,基本上都是些又打广告又骗钱的地方,并且缺乏web 2.0的基本元素。相比之下,可能有的同学会选择自己架设私人单班同学录,这样感觉更自由一些。很可惜,我也没有找到比较好的asp同学录源码,不见任何web 2.0不说,代码奇丑无比。最终我选择了才阿ASP同学录v5.3免费版,因为关键字“asp同学录”在搜索引擎里排第一的就是它。
    虽然代码非常丑,但使用起来没有发现任何后台上的问题。一个比较麻烦的前台问题是,部分页面不支持FireFox。下面是一些需要修改的地方,修改之后该asp程序基本上就可以在FireFox上使用了。

    首先是论坛显示页面严重错误。用FireFox浏览这里你会发现论坛页面的排版惨不忍睹。原因出在代码的表格宽度上,你需要改动两个文件共四处位置。删掉voteview.asp的323行和441行的width="100%",再删掉talkview.asp的318行和366行的width="100%",FireFox浏览就正常了。
    还有,部分页面的提交按钮无效。这是因为FireFox不允许JavaScript再次定义function window.onload()。一个解决方法是把函数内容放在<body onload="">里。这个问题涉及四个文件,分别是reg_fill.asp、umod.asp、talkpub.asp和talkvote.asp。删掉这四个文件中的window.onload函数,前两个文件中的<body>改成<body onload="facesel();">,后两个文件中的<body>改成<body onload="showfj();">。至此,除了无鼠标悬停效果(影响不大)外,FireFox基本上可以浏览了。

    另外,这个asp程序的安全问题很严重,建议大家更改数据库位置(同时需要修改in_conn_db.asp文件)。更好的办法是把数据库后缀名改为.asp并插入一个防下载表。网上相关的教程很多,这里不具体说了。
    最后,可能你不希望来一大帮蜘蛛把你们班的私人信息抓个遍。写一个robots.txt是个不错的方法。

    2007.06.11 发现并修复一个新问题:和PJBlog发生冲突(也有可能与其它同一空间的asp程序发生冲突)。具体表现为时间显示混乱,日和月数字对调。这个问题产生的原因是PJBlog定义了Session.LCID,而这个同学录没有,因此访问了同一域名下的Blog后再回到同学录就出错了。解决方法是更改同学录的in_conn.asp文件,在Session.CodePage=936下面加上Session.LCID=2052。

    以后若发现还有其它问题我将在这里更新。

Matrix67原创
转贴请注明出处

May 3


    和大家一样,我也是一个G饭,将百度设为默认搜索引擎的唯一一个原因仅仅是上网看到了不认识的单词后,鼠标选中一拖(用了Drag de Go)就可以看到百度词典的链接。有时也会用一下搜狗,因为搜狗还有一个显示偏僻字读音的功能。今天没事干,打算写一个Greasemonkey脚本让Google显示搜索关键字的读音和释义(中英文都可以)。
    花了大概两个小时,具体方法是给Dict.cn发送XMLhttp请求,并把结果插入到Google页面中。我做人还算厚道,用了别人的东西是要链一下别人的,因此加了一个“View More”链接。不知道Google本身或者FireFox插件能不能实现这样的效果,反正我是没有找到。我想肯定有人需要这个,因此发布出来大家可以测试一下。

点击这里安装
注意:安装前请确认你正在使用FireFox并已经安装了Greasemonkey插件!
成功使用或有任何问题的同志在下面留个言


    目前我在FireFox 2.0和英文google环境下使用正常,大家发现Bug请帮忙报告一下。不过我好像每次叫大家报告Bug时都没人理我。
    目前已知问题:由于编码问题,中文关键字的“View More”链接无效。
    Matrix67原创,转贴请注明出处。

Mar 24

Update: 现在已经不用PJBlog了,文章中的很多链接已经失效。需要什么帮助请直接联系我。

  
1. 去掉UBB斜体标签

    经常在Blog发布代码的同志会发现斜体标签[i]很恶心,一旦你代码里的某个数组遇上了循环变量,原本整齐的代码就会歪掉一大半。考虑到反正平时不太需要斜体,估计一定有人会像我一样想去掉这个UBB标签。
    去掉它要改两个地方。在common\ubbcode.asp中去掉下面这两行
re.Pattern="\[i\]([^\r]*?)\[\/i\]"
strContent=re.Replace(strContent,"<i>$1</i>")

    还有一个地方要修改,就是common\function.asp中的自动闭合UBB那一段。你需要去掉function closeUBB(strContent)函数中arrTags数组里的"i"。也就是说,找到
arrTags=array("code","quote","list","color","align","font","size","b","i","u","html")
    并替换成
arrTags=array("code","quote","list","color","align","font","size","b","u","html")
    如果不做这一个操作的话,你会发现有多余的[/i]出现。


2. Blog顶部调用Twitter最近三条信息

    最近Twitter确实是火了一把,估计有人需要下面这段代码。为了加快Blog载入速度(Twitter慢死了),我将把JavaScript放在footer中调用。
    添加一个模块并且设为内容栏置顶,代码如下(红色部分需要自己修改):
<div style="PADDING-RIGHT: 4px; PADDING-LEFT: 4px; PADDING-BOTTOM: 4px; PADDING-TOP: 4px; TEXT-ALIGN: left; OVERFLOW:hidden; WHITE-SPACE:nowrap;" >
WHAT AM I DOING NOW by <a href="http://twitter.com/matrix67" target="_blank">twitter.com</a><br/>
<span id="stat0"></span>, <span id="stat0_time"></span> |
<span id="stat1"></span>, <span id="stat1_time"></span> |
<span id="stat2"></span>, <span id="stat2_time"></span>
</div>

    然后在footer.asp中添加如下代码:
<script type="text/javascript" src="http://www.twitter.com/t/status/user_timeline/1758881?count=3&named_obj"></script>
<script type="text/javascript"><!--
document.getElementById('stat0').innerHTML = Twitter.posts[0].text;
document.getElementById('stat0_time').innerHTML = Twitter.posts[0].relative_created_at;
document.getElementById('stat1').innerHTML = Twitter.posts[1].text;
document.getElementById('stat1_time').innerHTML = Twitter.posts[1].relative_created_at;
document.getElementById('stat2').innerHTML = Twitter.posts[2].text;
document.getElementById('stat2_time').innerHTML = Twitter.posts[2].relative_created_at;
--></script>

    这样的效果是两行文字,第二行不换行,让它超出边界不管(我觉得这样好看些)。Twitter太慢了,我玩了一天就不玩了,因此不给demo了,这里只贴个效果图:




3. PJBlog自带的一种悬停提示框特效

    header中有一段被注释掉了的js文件引用。把header.asp中的
<!--<script type="text/javascript" src="common/nicetitle.js"></script>-->
    改成
<script type="text/javascript" src="common/nicetitle.js"></script>
    然后你就能看到效果了。控制提示框样式的css在皮肤文件的typography.css中的div.nicetitle一段,你可以参考我所修改的样式(改为灰色背景)。
/*提示框CSS*/
   div.nicetitle {
    position: absolute;
    padding: 4px !important;
    padding: 6px 4px 4px 4px;
    top: 0;
    left: 0;
    font-family:Tahoma, Verdana;
    font-size: 12px;
    width: 15em;
    background: #CCCCCC;
    color: #222222;
    border: 1px solid #888888;
    text-align: left;
}



4. 把PJBlog的验证码改为算式验证码(两位加法)

    我研究这个研究了半天,把GetCode.asp改过去改过来调了半天终于搞出来了,效果见我的登陆界面matrix67.com/blog/login.asp。在分析BMP文件格式时头疼死了,后来才知道每一行输出像素必须是4的倍数(即使图象宽度不是4的倍数,不足的话要用0填空补足)。
    下载下面这个rar文件,解压缩后替换common\GetCode.asp文件。
点击下载此文件
    这样改后,图片宽度增加了,很多地方无法对齐,于是在common\function.asp中需要把
Function getcode()
    getcode= "<img src=""common/getcode.asp"" alt="""" style=""margin-right:40px;""/>"        
End Function

    改为
Function getcode()
    getcode= "<img src=""common/getcode.asp"" alt="""" style=""margin-right:8px;""/>"    
End Function

    这样才能和用户名、密码的输入框对齐。

    你可能还需要在文件内容中搜索所有出现过的“验证码:”并改为“算一算:”。
    昨天发现改了验证码后居然还有垃圾留言,没想通是为什么。



5. 让你的PJBlog支持语法高亮

    不同于网上流行的那个JS,我使用的是这个JS,它要简单一些(只有一个JS文件),而且使用也非常简单(自动查找HTML的<code>标签)。它仅仅是对语法进行高亮,并没有显示行号和折叠等功能。但同时它只对代码颜色进行修改,更加整洁,兼容PJBlog本身的代码显示效果。这里是我的一个效果演示(Pascal代码高亮)。
    你可以在这里下载这个JS脚本的最新版本。这个文件里还带有一份该脚本详细的使用说明。它可以支持的语言我列在了下面,脚本文件总共37KB,因此你可能需要从中删除一些语言支持。至于怎么删除部分语言,你看了那个JS源码后就知道了。

  • Python
  • Ruby
  • Perl
  • PHP
  • HTML
  • CSS
  • Javascript
  • VBScript
  • Delphi
  • Java
  • C++


    这个JS存在一个问题,它的某个定义与PJBlog重复了,前者的comment类是指的注释,而后者的comment是指的评论。你需要把JS文件中所有的'comment'替换为'comments'避免冲突(替换操作时要包括引号,因为我们只替换各个字符串定义)。
    我另外写了一个Pascal的关键字列表,比Delphi的关键字多一些,更适合Pascal语言。你可以把它加在JS文件里,需要的同学可以参考一下(顺便展示JS代码的高亮效果):
var PASCAL_KEYWORDS = {'abs': 1,'addr': 1,'and': 1,'ansichar': 1,'ansistring': 1,'array': 1,'as': 1,'asm': 1,'begin': 1,'boolean': 1,'byte': 1,'cardinal': 1,'case': 1,'char': 1,'class': 1,'comp': 1,'const': 1,'constructor': 1,'currency': 1,'destructor': 1,'div': 1,'do': 1,'double': 1,'downto': 1,'else': 1,'end': 1,'except': 1,'exports': 1,'extended': 1,'false': 1,'file': 1,'finalization': 1,'finally': 1,'for': 1,'function': 1,'goto': 1,'if': 1,'implementation': 1,'in': 1,'inherited': 1,'int64': 1,'initialization': 1,'integer': 1,'interface': 1,'is': 1,'label': 1,'library': 1,'longint': 1,'longword': 1,'mod': 1,'nil': 1,'not': 1,'object': 1,'of': 1,'on': 1,'or': 1,'packed': 1,'pansichar': 1,'pansistring': 1,'pchar': 1,'pcurrency': 1,'pdatetime': 1,'pextended': 1,'pint64': 1,'pointer': 1,'private': 1,'procedure': 1,'program': 1,'property': 1,'pshortstring': 1,'pstring': 1,'pvariant': 1,'pwidechar': 1,'pwidestring': 1,'protected': 1,'public': 1,'published': 1,'raise': 1,'real': 1,'real48': 1,'record': 1,'repeat': 1,'set': 1,'shl': 1,'shortint': 1,'shortstring': 1,'shr': 1,'single': 1,'smallint': 1,'string': 1,'then': 1,'threadvar': 1,'to': 1,'true': 1,'type': 1,'unit': 1,'until': 1,'uses': 1,'val': 1,'var': 1,'varirnt': 1,'while': 1,'widechar': 1,'widestring': 1,'with': 1,'word': 1,'write': 1,'writeln': 1,'xor': 1,'assign': 1,'reset': 1,'rewrite': 1,'exit': 1,'halt': 1,'break': 1,'read': 1,'readln': 1,'new': 1,'length': 1,'append': 1,'close': 1};

LANGUAGES.pascal = {
  defaultMode: {
    lexems: [IDENT_RE],
    illegal: '("|\\$[G-Zg-z]|\\/\\*|</)',
    contains: ['comments', 'string', 'number', 'function', 'class'],
    keywords: PASCAL_KEYWORDS
  },
  case_insensitive: true,
  modes: [
    {
      className: 'comments',
      begin: '{', end: '}'
    },
    {
      className: 'comments',
      begin: '\\(\\*', end: '\\*\\)',
      relevance: 10
    },
    C_LINE_COMMENT_MODE,
    {
      className: 'number',
      begin: NUMBER_RE, end: '^',
      relevance: 0
    },
    {
      className: 'string',
      begin: '\'', end: '\'',
      contains: ['quote'],
      relevance: 0
    },
    {
      className: 'quote',
      begin: '\'\'', end: '^'
    },
    {
      className: 'function',
      begin: 'function', end: '[:;]',
      lexems: [IDENT_RE],
      keywords: {'function': 1},
      contains: ['title', 'params', 'comments'],
      relevance: 0
    },
    {
      className: 'function',
      begin: '(procedure|constructor|destructor)', end: ';',
      lexems: [IDENT_RE],
      keywords: {'constructor': 1, 'destructor': 1, 'procedure': 1},
      contains: ['title', 'params', 'comments'],
      relevance: 10
    },
    {
      className: 'title',
      begin: IDENT_RE, end: '^'
    },
    {
      className: 'params',
      begin: '\\(', end: '\\)',
      lexems: [IDENT_RE],
      keywords: PASCAL_KEYWORDS,
      contains: ['string']
    }
  ]
};//pascal, written by matrix67.com


    下面这个压缩包里的css文件定义了各种类型的高亮颜色。各种颜色具体的值是我自己定的,你不喜欢可以修改一下以符合你的界面风格。
点击下载此文件

    现在你需要把这个highlight.css文件连同前面的highlight.js文件保存在common目录下。然后在common\ubbcode.asp中找到
re.Pattern="\[quote\](.*?)\[\/quote\]"
    在它上面加入以下代码:
re.Pattern="\[code=(.[^\]]*)\](.*?)\[\/code\]"
strContent= re.Replace(strContent,"<div class=""UBBPanel""><div class=""UBBTitle""><img src=""images/quote.gif"" style=""margin:0px 2px -3px 0px"" alt=""程序代码""/> 程序代码</div><div class=""UBBContent""><pre><code class=""$1"">$2</code></pre></div></div>")

    然后在header.asp中找到
<link rel="stylesheet" rev="stylesheet" href="skins/<%=Skins%>/UBB/editor.css" type="text/css" media="all" /><!--UBB编辑器代码-->
    在其下面加入这一行代码:
<link rel="stylesheet" rev="stylesheet" href="common/highlight.css" type="text/css" media="all" />
    最后在footer.asp中加入以下代码:
<script type="text/javascript" src="common/highlight.js"></script>
<script type="text/javascript">
   initHighlightingOnLoad();
</script>


    以后你就可以通过使用形如[ code=delphi] TheOneILove:=SexyMM [ /code]的UBB标签来高亮各种语言的代码。
    目前已知的问题:由于这个脚本需要用<pre>,而用了<pre>后将导致无法换行,因此你可能会想为这个UBB框单独设一个css强制换行。我最讨厌换行的问题了,IE和FireFox总是不能兼顾,后来干脆把overflow设成hidden,两边看上去都顺眼,超了右边界的就让它去吧。


6. 让你的TagsCloud看起来更明显,更大

    看看我的标签云,你会发现虽然每个标签的文章也不多,但大小同样很明显。更改tag.asp可以让你的Tags在日志数不多的情况下大小对比同样强烈。
    在tag.asp中找到
<%
  function getTagSize(c)
   dim i
   for i=1 to 10
    if int(c)<i*2.5 then
        getTagSize=12+i
        exit function
    end if
   next
   getTagSize=22
  end function
%>

    改成
<%
  function getTagSize(c)
   dim i
   for i=1 to 20
    if int(c)<i*1.5 then
        getTagSize=12+i
        exit function
    end if
   next
   getTagSize=34
  end function
%>

    说明一下,改了之后的意思为,标签大小共有20个等级,从12px起,每多1.5篇文章字体就大一号,有1.5 x 20=30篇文章时字号达到12+20=32,如果文章数超过30了标签字体大小都是34px。你可以自己改这几个数字直到满意位置。
    字体变大后会引起一个问题:标签过于挤了一些,行与行之间的空隙窄得难以忍受。你可能会想为标签云单独设一个css。还是tag.asp文件,你需要把
<div class="Content-body">
    改成
<div class="Content-tagscloud">
    并把你的皮肤文件夹内layout.css文件中对Content-body的定义复制一份,修改line-height属性并重命名为Content-tagscloud。参考我的改法(不同的皮肤具体的内容不同)。

    我所用的皮肤中相关的定义如下:
  /*---日志内容框--*/
  .Content-body{margin:8px 2px 2px 8px;overflow:hidden;text-align:left;width:98%;line-height: 160%;background-image: url();background-repeat: repeat-y;background-position: right;color: #292929;}

    在它下面添加一段代码,整个内容变成这样:
  /*---日志内容框--*/
  .Content-body{margin:8px 2px 2px 8px;overflow:hidden;text-align:left;width:98%;line-height: 160%; background-image: url();background-repeat: repeat-y;background-position: right;color: #292929;}
  .Content-tagscloud{margin:8px 2px 2px 8px;overflow:hidden; text-align:left;width:98%; line-height: 35px;background-image: url();background-repeat: repeat-y; background-position: right;color: #292929;}

    这样,标签云的行距就拉开了。


发现Bug或者有任何问题请在下面报告一下。

Matrix67原创
转贴请注明出处。

Mar 21

    寒假时没事写了这几个代码,算是我几个月后重操键盘了。这是几道经典题目,可能有人需要,再加上昨天搞JavaScript改过去改过来把PJBlog改得面目全非终于实现了代码高亮忍不住想Show一下,于是把这些代码(连同题目)发了上来。

标准的网络流题目代码

Problem : goods
货物运输

问题描述
    你第一天接手一个大型商业公司就发生了一件倒霉的事情:公司不小心发送了一批次品。很不幸,你发现这件事的时候,这些次品已经进入了送货网。这个送货网很大,而且关系复杂。你知道这批次品要发给哪个零售商,但是要把这批次品送到他手中有许多种途径。送货网由一些仓库和运输卡车组成,每辆卡车都在各自固定的两个仓库之间单向运输货物。在追查这些次品的时候,有必要保证它不被送到零售商手里,所以必须使某些运输卡车停止运输,但是停止每辆卡车都会有一定的经济损失。你的任务是,在保证次品无法送到零售商的前提下,制定出停止卡车运输的方案,使损失最小。

输入格式
    第一行:两个用空格分开的整数N(0<=N<=200)和M(2<=M<=200)。N为运输卡车的数目,M为仓库的数目。1号仓库是公司发货的出口,仓库M属于零售商。
    第二行到第N+1行:每行有三个整数,Si、Ei和Ci。Si和Ei(1<=Si,Ei<=M)分别表示这辆卡车的出发仓库和目的仓库,Ci(0<=Ci<=10,000,000)是让这辆卡车停止运输的损失。

输出格式
    输出一个整数,即最小的损失数。

样例输入
5 4
1 2 40
1 4 20
2 4 20
2 3 30
3 4 10

样例输出
50

样例说明
         40
      1------>2
      |      /|
      |     / |
    20|    /  |30
      |  20   |
      |  /    |
      | /     |
      \/_     V
      4<------3
          10


    如图,停止1->4、2->4、3->4三条卡车运输线路可以阻止货物从仓库1运输到仓库4,代价为20+20+10=50。

数据规模
    对于50%的数据,N,M<=25
    对于100%的数据,N,M<=200



program goods;

const
   MaxN=200;
   MaxM=200;
   Infinite=Maxlongint;

type
   rec=record
         node,father:integer;
         minf:longint;
       end;

var
   f,c:array[1..MaxN,1..MaxN]of longint;
   queue:array[1..MaxN]of rec;
   hash:array[1..MaxN]of boolean;
   n,m,closed,open:integer;

procedure readp;
var
   i,x,y:integer;
   t:longint;
begin
   readln(m,n);
   for i:=1 to m do
   begin
      readln(x,y,t);
      c[x,y]:=c[x,y]+t;
   end;
end;

function FindPath:boolean;

   procedure Init;
   begin
      fillchar(hash,sizeof(hash),0);
      fillchar(queue,sizeof(queue),0);
      closed:=0;
      open:=1;
      queue[1].node:=1;
      queue[1].father:=0;
      queue[1].minf:=Infinite;
      hash[1]:=true;
   end;

   function min(a,b:longint):longint;
   begin
      if a<b then min:=a
      else min:=b;
   end;

var
   i,NodeNow:integer;
begin
   Init;
   repeat
      inc(closed);
      NodeNow:=queue[closed].node;
      for i:=1 to n do if not hash[i] then
         if (f[NodeNow,i]<c[NodeNow,i]) then
         begin
            inc(open);
            queue[open].node:=i;
            queue[open].father:=closed;
            queue[open].minf:=min(queue[closed].minf,c[NodeNow,i]-f[NodeNow,i]);
            hash[i]:=true;
            if i=n then exit(true);
         end;
   until closed>=open;
   exit(false);
end;

procedure AddPath;
var
   i,j:integer;
   delta:longint;
begin
   delta:=queue[open].minf;
   i:=open;
   repeat
      j:=queue[i].father;
      inc(f[queue[j].node,queue[i].node],delta);
      dec(f[queue[i].node,queue[j].node],delta);
      i:=j;
   until i=0;
end;

procedure writep;
var
   i:integer;
   ans:longint=0;
begin
   for i:=1 to n do
      ans:=ans+f[1,i];
   writeln(ans);
end;

{====main====}
begin
   assign(input,'goods.in');
   reset(input);
   readp;
   close(input);

   while FindPath do AddPath;

   assign(output,'goods.out');
   rewrite(output);
   writep;
   close(output);
end.



统计逆序对 Treap版

Problem : inverse
逆序对

问题描述
    在一个排列中,前面出现的某个数比它后面的某个数大,即当Ai>Aj且i<j时,则我们称Ai和Aj为一个逆序对。给出一个1到N的排列,编程求出逆序对的个数。

输入格式
    第一行输入一个正整数N;
    第二行有N个用空格隔开的正整数,这是一个1到N的排列。

输出格式
    输出输入数据中逆序对的个数。

样例输入
4
3 1 4 2

样例输出
3

样例说明
    在输入数据中,(3,1)、(3,2)和(4,2)是仅有的三个逆序对。

数据规模
    对于30%的数据,N<=1000;
    对于100%的数据,N<=100 000。


program inverse;

const
   MaxH=Maxlongint;
  
type
   p=^rec;
   rec=record
          v,s,h:longint;
          left,right:p;
       end;

var
   header:p=nil;
   ans:int64=0;

procedure CalcuS(var w:p);
begin
   w^.s:=1;
   if w^.right<>nil then inc(w^.s,w^.right^.s);
   if w^.left<>nil then inc(w^.s,w^.left^.s);
end;

function RotateLeft(w:p):p;
var
   tmp:p;
begin
   tmp:=w^.left;
   w^.left:=tmp^.right;
   tmp^.right:=w;
   exit(tmp);
end;

function RotateRight(w:p):p;
var
   tmp:p;
begin
   tmp:=w^.right;
   w^.right:=tmp^.left;
   tmp^.left:=w;
   exit(tmp);
end;

function Insert(a:longint;w:p):p;
begin
  if w=nil then
  begin
     new(w);
     w^.v:=a;
     w^.h:=random(MaxH);
     w^.s:=1;
     w^.left:=nil;
     w^.right:=nil;
  end

  else if a<w^.v then
  begin
     ans:=ans+1;
     if w^.right<>nil then ans:=ans+w^.right^.s;
     w^.left:=Insert(a,w^.left);
     if w^.left^.h<w^.h then
     begin
        w:=RotateLeft(w);
        CalcuS(w^.right);
     end else
        CalcuS(w^.left);
  end

  else if a>w^.v then
  begin
     w^.right:=Insert(a,w^.right);
     if w^.right^.h<w^.h then
     begin
        w:=RotateRight(w);
        CalcuS(w^.left);
     end else
        CalcuS(w^.right);
  end;

  exit(w);
end;

{====main====}
var
   n,i,t:longint;
begin
   randseed:=2910238;
  
   assign(input,'inverse.in');
   reset(input);
   readln(n);
   for i:=1 to n do
   begin
      read(t);
      header:=Insert(t,header);
   end;
   close(input);

   assign(output,'inverse.out');
   rewrite(output);
   writeln(ans);
   close(output);
end.


USACO经典题目:矩形颜色(离散化+扫描)

Problem : rect
矩形颜色

问题描述
  N个不同颜色的不透明长方形(1<=N<=1000)被放置在一张宽为A长为B的白纸上。这些长方形被放置时,保证了它们的边与白纸的边缘平行。所有的长方形都放置在白纸内,所以我们会看到不同形状的各种颜色。坐标系统的原点(0,0)设在这张白纸的左下角,而坐标轴则平行于边缘。

输入数据
    每行输入的是放置长方形的方法。第一行输入的是那个放在最底下的长方形(即白纸)。
    第一行:A、B和N,由空格分开(1<=A,B<=10,000)
    第二到N+1行:每行为五个整数llx,lly,urx,ury,color。这是一个长方形的左下角坐标,右上角坐标和颜色。颜色1和底部白纸的颜色相同。

输出数据
    输出文件应该包含一个所有能被看到的颜色连同该颜色的总面积的清单(即使颜色的区域不是连续的),按color的增序顺序。
    不要打印出最后不能看到的颜色。

样例输入
20 20 3
2 2 18 18 2
0 8 19 19 3
8 0 10 19 4

样例输出
1 91
2 84
3 187
4 38

数据规模
    对于50%的数据,A,B<=300,N<=60;
    对于100%的数据,A,B<=10000,N<=1000。



program rect;

const
   MaxN=1000;       { Rect number in the Worst Case }
   MaxCol=1000;     { Color number in the Worst Case }
   Infinity=Maxint; { Set to be Heap[0] }

type
   RecSeg=record
            y,x1,x2,order:integer;
          end;
var
   xar,heap:array[0..MaxN*2+2]of integer; { Array of All X-Value and Heap, respectively }
   color:array[1..MaxN+1]of integer;      { Index of Color corresponding to order}
   ans:array[1..MaxCol]of longint;        { Answers to be print }
   seg:array[0..MaxN*2+2]of RecSeg;       { Horizontal Segments }
   hash:array[1..MaxN*2+2]of boolean;     { Determine if a Segment has been scanned }
   n,HeapSize:integer;

procedure SwapInt(var a,b:integer);
var
   tmp:integer;
begin
   tmp:=a;
   a:=b;
   b:=tmp;
end;

procedure SwapRec(var a,b:RecSeg);
var
   tmp:RecSeg;
begin
   tmp:=a;
   a:=b;
   b:=tmp;
end;

procedure DataInsert(start,x1,y1,x2,y2,col,order:integer);
var
   tmp:RecSeg;
begin
   xar[start]:=x1;
   xar[start+1]:=x2;
   color[start div 2+1]:=col;

   tmp.order:=order;
   tmp.y:=y1;
   tmp.x1:=x1;
   tmp.x2:=x2;
   seg[start]:=tmp;

   tmp.y:=y2;
   seg[start+1]:=tmp;
end;

procedure Readp;
var
   a,b,x1,x2,y1,y2,col,i:integer;
begin
   readln(a,b,n);
   n:=n+1;
   DataInsert(1,0,0,a,b,1,1);
   for i:=2 to n do
   begin
      readln(x1,y1,x2,y2,col);
      DataInsert(2*i-1,x1,y1,x2,y2,col,i);
   end;
end;

procedure SortXar;
var
   i,j:integer;
begin
   for i:=1 to 2*n do
   for j:=1 to 2*n-1 do
      if xar[j]>xar[j+1] then SwapInt(xar[j],xar[j+1]);
end;

procedure SortSeg;
var
   i,j:integer;
begin
   for i:=1 to 2*n do
   for j:=1 to 2*n-1 do
      if seg[j].y>seg[j+1].y then SwapRec(seg[j],seg[j+1]);
end;

procedure HeapInsert(x:integer);
var
   w:integer;
begin
   inc(HeapSize);
   w:=HeapSize;
   while Heap[w shr 1]<x do
   begin
      Heap[w]:=Heap[w shr 1];
      w:=w shr 1;
   end;
   Heap[w]:=x;
end;

procedure HeapDelete;
var
   x:integer;
   w:integer=1;
begin
   x:=Heap[HeapSize];
   dec(HeapSize);
   while w shl 1<=HeapSize do
   begin
      w:=w shl 1;
      if (w<>HeapSize) and (Heap[w+1]>Heap[w]) then inc(w);
      if Heap[w]>x then Heap[w shr 1]:=Heap[w]
      else begin
         w:=w shr 1;
         break;
      end;
   end;
   Heap[w]:=x;
end;

procedure Scan(x1,x2:integer);
var
   i:integer;
   j:integer=0;
begin
   for i:=1 to 2*n do if (seg[i].x1<=x1) and (seg[i].x2>=x2) then
   begin
      inc(ans[Color[Heap[1]]],(x2-x1)*(seg[i].y-seg[j].y));
      hash[seg[i].order]:=not hash[seg[i].order];
      if hash[seg[i].order] then HeapInsert(seg[i].order)
         else while (HeapSize>0) and not hash[Heap[1]] do HeapDelete;
      j:=i;
   end;
end;

procedure Solve;
var
   i:integer;
begin
   for i:=1 to 2*n-1 do if xar[i]<xar[i+1] then
   begin
      fillchar(Heap,Sizeof(Heap),0);
      fillchar(hash,Sizeof(hash),0);
      HeapSize:=0;
      Heap[0]:=Infinity;
      Scan(xar[i],xar[i+1]);
   end;
end;

procedure Writep;
var
   i:integer;
begin
   for i:=1 to MaxCol do
      if ans[i]>0 then writeln(i,' ',ans[i]);
end;

{====main====}
begin
   assign(input,'rect.in');
   reset(input);
   assign(output,'rect.out');
   rewrite(output);

   Readp;
   SortXar;
   SortSeg;
   Solve;
   Writep;

   close(input);
   close(output);
end.


    这几天大家发现我改PJBlog改错了什么东西导致Bug的话麻烦帮忙报告一下。事实上很有可能有人发现有Bug但是不能报告,因为我很有可能把验证码系统也搞坏了。
    如果这几天大家没有发现问题的话,我把这几天我的PJBlog个性修改方法和心得写出来分享一下(越来越喜欢搞Web Design了)。

做人要厚道
转贴请注明出处
(这篇日志没什么技术含量,感觉写上这两句很别扭)