481

(32 відповідей, залишених у Обговорення)

Вирішив перші два завдання на Delphi XE3.
http://не-дійсний-домен/i7/1f53b7491549873ffadce8675cb33ebb/4-55-1202/39543299/scrin_500.jpghttp://не-дійсний-домен/a3/2013-01-27-23-29/i7-4044685/500x286-r/i.gif

Прихований текст
unit MainUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  System.Generics.Collections, Vcl.ComCtrls;

type
  TMainForm = class(TForm)
    SourceMemo: TMemo;
    DisplayMemo: TMemo;
    Splitter1: TSplitter;
    BottomPanel: TPanel;
    Quest1Button: TButton;
    Quest2Button: TButton;
    Quest3Button: TButton;
    InsertSourceButton: TButton;
    CopyResultButton: TButton;
    ProgressBar1: TProgressBar;
    procedure Quest2ButtonClick(Sender: TObject);
    procedure InsertSourceButtonClick(Sender: TObject);
    procedure CopyResultButtonClick(Sender: TObject);
    procedure Quest1ButtonClick(Sender: TObject);
    procedure Quest3ButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

resourcestring
  StrFormat = 'Case #%d: %s';

const
  BoolLabel: array [Boolean] of string = ('NO', 'YES');

function ParseInt(S: string): TArray<Integer>;
var
  P, P2: PChar;
begin
  P := PChar(S);
  SetLength(Result, 0);

  while P^ <> #0 do
  begin
    while not CharInSet(P^, ['0'..'9'])  do
      Inc(P);
      
    P2 := P;
    while CharInSet(P^, ['0'..'9']) do
      Inc(P);

    if Integer(P2) < Integer(P) then
    begin    
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := StrToInt(Copy(P2, 0, P - P2));
    end;
  end;
end;

procedure TMainForm.CopyResultButtonClick(Sender: TObject);
begin
  DisplayMemo.SelectAll;
  DisplayMemo.CopyToClipboard;
end;

procedure TMainForm.InsertSourceButtonClick(Sender: TObject);
begin
  SourceMemo.Clear;
  SourceMemo.PasteFromClipboard;
end;

procedure TMainForm.Quest1ButtonClick(Sender: TObject);

  function NiceOfStr(S: string): Integer;
  var
    C: Char;
    CharsCount: array [1..26] of Integer;
    I: Integer;
  begin
    S := AnsiLowerCase(S);
    Result := 0;
    for I := 1 to 26 do CharsCount[i] := 0;      
    for C in S do
      if CharInSet(C, ['a'..'z']) then
        Inc(CharsCount[Ord(C) - Ord('a') + 1]);

    TArray.Sort<Integer>(CharsCount);
    for I := 1 to 26 do
      Inc(Result, CharsCount[i] * I);
  end;

var
  I: Integer;
begin
  DisplayMemo.Lines.Clear;
  DisplayMemo.Lines.BeginUpdate;
  ProgressBar1.Max := StrToInt(SourceMemo.Lines[0]);
  with SourceMemo do
  try
    for I := 1 to Lines.Count - 1 do
    begin
      DisplayMemo.Lines.Add(Format(StrFormat,
        [I, IntToStr(NiceOfStr(Lines[i]))]));
      ProgressBar1.Position := I;
      Application.ProcessMessages;
    end;
  finally
    DisplayMemo.Lines.EndUpdate;
  end;
end;

procedure TMainForm.Quest2ButtonClick(Sender: TObject);

  function IsBalanc(PText: PChar; Opened: Integer = 0): Boolean;
  begin
    while PText^ <> #0 do
    begin
      if (PText[0] = ':') and (CharInSet(PText[1], ['(', ')'])) then
        Exit(IsBalanc(PChar(PText + 1), Opened)           // це дужка
        or IsBalanc(PChar(PText + 2), Opened));         // це смайлик

      case PText^ of
      '(' : Inc(Opened);
      ')' : Dec(Opened);
      else end;
      if Opened < 0 then Exit(False);
      Inc(PText);
    end;
    Result := Opened = 0;
  end;

var
  I: Integer;
begin
  DisplayMemo.Lines.Clear;
  DisplayMemo.Lines.BeginUpdate;
  ProgressBar1.Max := StrToInt(SourceMemo.Lines[0]);
  with SourceMemo do
  try
    for I := 1 to Lines.Count - 1 do
    begin
      DisplayMemo.Lines.Add(Format(StrFormat,
        [I, BoolLabel[IsBalanc(PChar(Lines[i]))]]));
      ProgressBar1.Position := I;
      Application.ProcessMessages;
    end;
  finally
    DisplayMemo.Lines.EndUpdate;
  end;
end;

procedure TMainForm.Quest3ButtonClick(Sender: TObject);

  function GetItem(n, k, a, b, c, r: Int64): Int64;

    function InitM(Ak: Int64): TArray<Int64>;
    var
      I: Integer;
    begin
      Inc(Ak);
      SetLength(Result, Ak);
      Result[0] := -1;
      Result[1] := a;
      for I := 2 to Ak -1 do
        Result[i] := (b * Result[I -1] + c) mod r;
    end;

    procedure InitFirstKValues(AUsesNumbers: TList<Int64>;
      SecondNums: TQueue<Int64>);
    var
      I: Integer;
      m: TArray<Int64>;
//      J: Int64;
    begin
      m := InitM(k);
      for I := 1 to High(m) do
        SecondNums.Enqueue(m[i]);

      AUsesNumbers.AddRange(SecondNums.ToArray);
      AUsesNumbers.Sort;

      {TArray.Sort<Int64>(m);


      for I := 0 to High(m) -1 do
        if (m[i]) < (m[I + 1] -1) then
        begin
          J := m[i] + 1;
          while J < (m[I + 1]) do
          begin
            FreeNumbers.Add(J);
            Inc(J);
          end;
        end;
      for I := FreeNumbers.Last to K + 1 do
        FreeNumbers.Add(I);
      FreeNumbers.Capacity := K + 1;}
    end;

  var
    UsesNumbers: TList<Int64>;
    SecondKValues: TQueue<Int64>;
    I: Integer;
    tmp: Integer;

    J: Int64;
  begin
    UsesNumbers := TList<Int64>.Create;
    SecondKValues := TQueue<Int64>.Create;
    try
      InitFirstKValues(UsesNumbers, SecondKValues);

      I := k + 1;
      J := 0;
      tmp := -1;
      while I <= n -1 + 1 do
      begin
        J := 0;
        while True do
          if not UsesNumbers.BinarySearch(J, tmp) then
            Break
          else
            Inc(J);
        SecondKValues.Enqueue(J);
        UsesNumbers.Insert(tmp, J);
//        if SecondKValues.Peek < J then
//          J := SecondKValues.Peek
//        else
        UsesNumbers.BinarySearch(SecondKValues.Extract, tmp);
        UsesNumbers.Delete(tmp);
        Inc(I);
      end;
      Result := J;{}
    finally
      UsesNumbers.Free;
      SecondKValues.Free;
    end;
  end;

var
  I, J: Integer;
  ATime: Integer;
begin
  DisplayMemo.Lines.Clear;
  DisplayMemo.Lines.BeginUpdate;
  ProgressBar1.Max := StrToInt(SourceMemo.Lines[0]);
  ATime := GetTickCount;
  with SourceMemo do
  try
    for I := 1 to (Lines.Count - 1) div 2 do
    begin
      DisplayMemo.Lines.Add(Format(StrFormat,
        [I, IntToStr(GetItem( ParseInt(Lines[I * 2 - 1])[0],
                              ParseInt(Lines[I * 2 - 1])[1],
                              ParseInt(Lines[I * 2])[0],
                              ParseInt(Lines[I * 2])[1],
                              ParseInt(Lines[I * 2])[2],
                              ParseInt(Lines[I * 2])[3]))]));
      ProgressBar1.Position := I;
      Application.ProcessMessages;
    end;
  finally
    DisplayMemo.Lines.EndUpdate;
  end;
  ShowMessage(IntToStr(GetTickCount - ATime));
end;

end.

третє завдання рахується надто довго. Там треба по іншому робити (після якогось н-го елемента всі елементи посортовані від 1 до k -1)